Automatic commit from picoLisp.tgz, From: Thu, 22 Apr 2010 11:32:31 GMT - picolisp - Unnamed repository; edit this file to name it for gitweb.

commit 3291fb0890008ab8a3d26e1917b1449c21bb170e
parent 2804ee02f9ddb3c273360e2ff9bef0a774f09351
Author: Commit-Bot <unknown>
Date:   Thu, 22 Apr 2010 14:32:31 +0000

Automatic commit from picoLisp.tgz, From: Thu, 22 Apr 2010 11:32:31 GMT
Diffstat:
A CHANGES  | 404 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A COPYING  | 280 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A CREDITS  | 23 +++++++++++++++++++++++
A INSTALL  | 103 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A README  | 105 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A ReleaseNotes  | 18 ++++++++++++++++++
A app/cusu.l  | 43 +++++++++++++++++++++++++++++++++++++++++++
A app/er.l  | 167 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A app/gui.l  | 243 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A app/init.l  | 81 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A app/inventory.l  | 55 +++++++++++++++++++++++++++++++++++++++++++++++++++++++
A app/item.l  | 40 ++++++++++++++++++++++++++++++++++++++++
A app/lib.l  | 62 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A app/loc/ar  | 5 +++++
A app/loc/ch  | 4 ++++
A app/loc/de  | 86 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A app/loc/es  | 86 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A app/loc/jp  | 86 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A app/loc/no  | 86 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A app/loc/ru  | 86 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A app/main.l  | 61 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A app/ord.l  | 58 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A app/role.l  | 33 +++++++++++++++++++++++++++++++++
A app/sal.l  | 21 +++++++++++++++++++++
A app/sales.l  | 56 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A app/user.l  | 36 ++++++++++++++++++++++++++++++++++++
A bin/pil  | 2 ++
A bin/psh  | 14 ++++++++++++++
A bin/replica  | 31 +++++++++++++++++++++++++++++++
A bin/scrape  | 11 +++++++++++
A bin/watchdog  | 68 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A cygwin/README  | 170 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A cygwin/tcc.l  | 22 ++++++++++++++++++++++
A dbg  | 2 ++
A dbg.l  | 16 ++++++++++++++++
A doc/app.html  | 2551 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A doc/apply  | 30 ++++++++++++++++++++++++++++++
A doc/db  | 91 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A doc/doc.css  | 12 ++++++++++++
A doc/family.l  | 242 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A doc/family/1  | 0 
A doc/family/2  | 0 
A doc/family/3  | 0 
A doc/family/4  | 0 
A doc/faq.html  | 664 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A doc/fun.l  | 9 +++++++++
A doc/hello.l  | 5 +++++
A doc/index.html  | 108 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A doc/model  | 57 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A doc/quine  | 24 ++++++++++++++++++++++++
A doc/ref.html  | 2455 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A doc/refA.html  | 567 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A doc/refB.html  | 319 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A doc/refC.html  | 657 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A doc/refD.html  | 748 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A doc/refE.html  | 486 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A doc/refF.html  | 512 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A doc/refG.html  | 188 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A doc/refH.html  | 216 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A doc/refI.html  | 389 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A doc/refJ.html  | 81 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A doc/refK.html  | 58 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A doc/refL.html  | 531 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A doc/refM.html  | 621 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A doc/refN.html  | 399 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A doc/refO.html  | 262 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A doc/refP.html  | 816 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A doc/refQ.html  | 107 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A doc/refR.html  | 713 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A doc/refS.html  | 870 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A doc/refT.html  | 565 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A doc/refU.html  | 356 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A doc/refV.html  | 163 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A doc/refW.html  | 196 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A doc/refX.html  | 57 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A doc/refY.html  | 30 ++++++++++++++++++++++++++++++
A doc/refZ.html  | 102 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A doc/ref_.html  | 546 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A doc/rlook.html  | 67 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A doc/select.html  | 490 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A doc/shape.l  | 59 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A doc/structures  | 90 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A doc/toc.html  | 41 +++++++++++++++++++++++++++++++++++++++++
A doc/travel  | 24 ++++++++++++++++++++++++
A doc/tut.html  | 2402 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A doc/utf8  | 39 +++++++++++++++++++++++++++++++++++++++
A doc64/README  | 136 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A doc64/asm  | 194 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A doc64/structures  | 308 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A ext.l  | 6 ++++++
A favicon.ico  | 0 
A games/README  | 233 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A games/chess.l  | 566 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A games/mine.l  | 126 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A games/nim.l  | 27 +++++++++++++++++++++++++++
A games/sudoku.l  | 73 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A games/ttt.l  | 72 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A games/xchess  | 49 +++++++++++++++++++++++++++++++++++++++++++++++++
A img/7fach.eps  | 474 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A img/7fach.gif  | 0 
A img/go.png  | 0 
A img/no.png  | 0 
A lib.css  | 194 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A lib.l  | 369 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A lib/adm.l  | 71 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A lib/app.l  | 34 ++++++++++++++++++++++++++++++++++
A lib/boss.l  | 16 ++++++++++++++++
A lib/btree.l  | 438 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A lib/cal.l  | 79 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A lib/conDbgc.l  | 69 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A lib/db.l  | 1125 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A lib/db32-64.l  | 73 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A lib/dbase.l  | 59 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A lib/debug.l  | 362 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A lib/ed.l  | 47 +++++++++++++++++++++++++++++++++++++++++++++++
A lib/edit.l  | 66 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A lib/el/inferior-picolisp.el  | 312 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A lib/el/paredit.el.diff  | 89 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A lib/el/picolisp.el  | 536 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A lib/el/tsm.el  | 130 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A lib/form.js  | 352 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A lib/form.l  | 2069 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A lib/gcc.l  | 40 ++++++++++++++++++++++++++++++++++++++++
A lib/glyphlist.txt  | 4322 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A lib/head.ps  | 28 ++++++++++++++++++++++++++++
A lib/heartbeat.l  | 19 +++++++++++++++++++
A lib/http.l  | 440 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A lib/import.l  | 30 ++++++++++++++++++++++++++++++
A lib/led.l  | 431 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A lib/led.min.l  | 23 +++++++++++++++++++++++
A lib/lint.l  | 257 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A lib/math.l  | 11 +++++++++++
A lib/math32.l  | 22 ++++++++++++++++++++++
A lib/math64.l  | 44 ++++++++++++++++++++++++++++++++++++++++++++
A lib/misc.l  | 480 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A lib/native.l  | 23 +++++++++++++++++++++++
A lib/pilog.l  | 550 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A lib/prof.l  | 51 +++++++++++++++++++++++++++++++++++++++++++++++++++
A lib/ps.l  | 318 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A lib/readline.l  | 28 ++++++++++++++++++++++++++++
A lib/rsa.l  | 109 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A lib/scrape.l  | 160 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A lib/simul.l  | 154 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A lib/sq.l  | 131 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A lib/tags  | 346 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A lib/term.l  | 47 +++++++++++++++++++++++++++++++++++++++++++++++
A lib/test.l  | 31 +++++++++++++++++++++++++++++++
A lib/tex.l  | 164 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A lib/too.l  | 487 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A lib/xhtml.l  | 669 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A lib/xm.l  | 115 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A lib/xml.l  | 286 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A lib/xmlrpc.l  | 63 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A loc/AR.l  | 7 +++++++
A loc/CH.l  | 7 +++++++
A loc/DE.l  | 7 +++++++
A loc/ES.l  | 7 +++++++
A loc/JP.l  | 7 +++++++
A loc/NIL.l  | 7 +++++++
A loc/NO.l  | 7 +++++++
A loc/RU.l  | 7 +++++++
A loc/UK.l  | 7 +++++++
A loc/US.l  | 7 +++++++
A loc/ar  | 1 +
A loc/ch  | 4 ++++
A loc/de  | 77 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A loc/es  | 52 ++++++++++++++++++++++++++++++++++++++++++++++++++++
A loc/jp  | 77 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A loc/no  | 77 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A loc/ru  | 77 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A misc/bigtest  | 103 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A misc/calc  | 12 ++++++++++++
A misc/calc.l  | 73 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A misc/chat  | 32 ++++++++++++++++++++++++++++++++
A misc/crc.l  | 23 +++++++++++++++++++++++
A misc/dining.l  | 42 ++++++++++++++++++++++++++++++++++++++++++
A misc/dirTree.l  | 19 +++++++++++++++++++
A misc/fannkuch.l  | 38 ++++++++++++++++++++++++++++++++++++++
A misc/fibo.l  | 50 ++++++++++++++++++++++++++++++++++++++++++++++++++
A misc/hanoi.l  | 24 ++++++++++++++++++++++++
A misc/life.l  | 54 ++++++++++++++++++++++++++++++++++++++++++++++++++++++
A misc/mailing  | 93 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A misc/maze.l  | 33 +++++++++++++++++++++++++++++++++
A misc/pi.l  | 23 +++++++++++++++++++++++
A misc/pilog.l  | 125 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A misc/reverse.l  | 16 ++++++++++++++++
A misc/setf.l  | 49 +++++++++++++++++++++++++++++++++++++++++++++++++
A misc/sieve.l  | 14 ++++++++++++++
A misc/stress.l  | 68 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A misc/travel.l  | 51 +++++++++++++++++++++++++++++++++++++++++++++++++++
A misc/trip.l  | 84 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A opt/pilog.l  | 15 +++++++++++++++
A p  | 2 ++
A plmod  | 2 ++
A plmod.l  | 10 ++++++++++
A rcsim/README  | 125 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A rcsim/env.l  | 103 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A rcsim/fokker.l  | 456 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A rcsim/lib.l  | 255 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A rcsim/main.l  | 124 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A rcsim/tone  | 41 +++++++++++++++++++++++++++++++++++++++++
A simul/lib.l  | 90 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A simul/rgb.l  | 29 +++++++++++++++++++++++++++++
A src/Makefile  | 145 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A src/apply.c  | 676 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A src/balance.c  | 94 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A src/big.c  | 1137 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A src/ext.c  | 182 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A src/flow.c  | 1688 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A src/gc.c  | 185 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A src/ht.c  | 368 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A src/httpGate.c  | 309 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A src/io.c  | 3543 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A src/lat1.c  | 75 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A src/main.c  | 1140 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A src/net.c  | 204 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A src/pico.h  | 852 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A src/ssl.c  | 241 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A src/start.c  | 10 ++++++++++
A src/subr.c  | 1686 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A src/sym.c  | 1991 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A src/tab.c  | 410 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A src/utf2.c  | 68 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A src/z3d.c  | 468 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A src/z3dClient.c  | 532 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A src64/Makefile  | 65 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A src64/apply.l  | 1606 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A src64/arch/x86-64.l  | 772 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A src64/big.l  | 2673 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A src64/db.l  | 2249 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A src64/defs.l  | 65 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A src64/err.l  | 726 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A src64/ext.l  | 248 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A src64/flow.l  | 3150 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A src64/gc.l  | 1002 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A src64/glob.l  | 1078 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A src64/ht.l  | 727 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A src64/io.l  | 5001 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A src64/lib/asm.l  | 546 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A src64/main.l  | 2605 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A src64/mkAsm  | 14 ++++++++++++++
A src64/net.l  | 336 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A src64/subr.l  | 4013 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A src64/sym.l  | 3417 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A src64/sys/linux.code.l  | 39 +++++++++++++++++++++++++++++++++++++++
A src64/sys/linux.defs.l  | 145 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A src64/version.l  | 6 ++++++
A test/lib.l  | 201 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A test/lib/lint.l  | 21 +++++++++++++++++++++
A test/lib/misc.l  | 213 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A test/src/apply.l  | 107 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A test/src/big.l  | 159 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A test/src/db.l  | 43 +++++++++++++++++++++++++++++++++++++++++++
A test/src/ext.l  | 22 ++++++++++++++++++++++
A test/src/ext2.l  | 31 +++++++++++++++++++++++++++++++
A test/src/flow.l  | 434 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A test/src/ht.l  | 46 ++++++++++++++++++++++++++++++++++++++++++++++
A test/src/io.l  | 220 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A test/src/main.l  | 150 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A test/src/net.l  | 25 +++++++++++++++++++++++++
A test/src/subr.l  | 477 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A test/src/sym.l  | 368 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

262 files changed, 93029 insertions(+), 0 deletions(-)
diff --git a/CHANGES b/CHANGES
@@ -0,0 +1,404 @@
+* XXjun10 picoLisp-3.0.3
+
+* 30mar10 picoLisp-3.0.2
+   Simple incrementing form of 'for'
+   Changed 'scl' to set '*Scl' globally
+   'acquire' and 'release' mutex functions
+   Changed 'state' syntax
+   'version' function (64-bit)
+   C 'lisp()' callback function (64-bit)
+   Bug in 'member' for circular lists (64-bit)
+   "lib/tags" for 'vi' source access
+   Bug in 'next' and 'arg' (64-bit)
+   Bug in comma read macro (64-bit)
+   Bug in binary read functions (64-bit)
+   'hax' function
+   Bug when deleting external symbols (64-bit)
+   Bug in external symbol names (64-bit)
+   Bug in '|' and 'x|' (32-bit)
+
+* 31dec09 picoLisp-3.0.1
+   '*Tsm' transient symbol markup
+   'range' function
+   'gcc' for 64-bit in "lib/native.l"
+   'flip' optional 'cnt' argument
+   Up to four letters in 'c[ad]*ar' and 'c[ad]*dr'
+   Fixed sporadic GUI errors
+   GUI 'onchange' handling
+
+* 07oct09 picoLisp-3.0
+   64-bit version for x86-64
+   Allowed '.' in symbol names
+   Changed GUI to Post/Redirect/Get pattern
+   Changed event handling to non-blocking I/O
+   Extension ".l" on localization country files
+   Deprecated 'begin' and 'nagle'
+
+* 30jun09 picoLisp-2.3.7
+   'dbg' startup script
+   Removed 'stk' function
+   Bug in GUI history "back" handling
+   Multi-line (block) comments
+   Improved external hash table
+   Transient characters no longer interned
+   'getd' loads shared library code
+
+* 31mar09 picoLisp-2.3.6
+   'lines' returns 'NIL' on failure
+   Only numeric argument to 'hear'
+   'sort' optional 'fun' argument
+   Bugs in 'evList()' and 'date'
+
+* 31dec08 picoLisp-2.3.5
+   Bug in 'pipe'
+   Bug in 'later'
+   Dialog and chart bugs in "lib/form.l"
+   HTTP protocol bug in "lib/http.l"
+   Bugs in 'inc' and 'bigCmp()'
+   'abort' function
+   'eval' and 'run' optional 'lst' argument
+
+* 30sep08 picoLisp-2.3.4
+   'once' function
+   'hex' and 'oct' negative arguments
+   Bug in 'pool'
+   'cmd' function
+   'script' function
+   Bug in 'idx'
+   Bug in 'lit'
+   'extract' function
+
+* 29jun08 picoLisp-2.3.3
+   Removed '*Rst' global variable
+   Catch error messages
+   Remote Pilog queries
+   DB extension with '*Ext' and 'ext'
+   Extended 'put'-syntax to zero keys
+   Wrong '@@' result in 'load'
+   Handling of "#" in 'str'
+
+* 29mar08 picoLisp-2.3.2
+   Ctrl-D termination
+   Improved termios restore
+   'file' function
+   ';' function
+   Changed (time T) semantics
+   Bugs in 'idx' and 'lup'
+   DB synchronous transaction log
+   Handling of 'bind' in 'debug'
+
+* 30dec07 picoLisp-2.3.1
+   'str' extended to parse tokens
+   '*Hup' global variable
+   Changed/extended 'all' semantics
+   Replaced 'die' with 'alarm'
+   Bug in 'glue'
+   Improved '@' handling
+   Bug in 'bye()'
+   'eol' end-of-line function
+   Escape delimiter characters in symbol names
+   'lint' also file contents
+   'noLint' function
+
+* 30sep07 picoLisp-2.3.0
+   Extended "lib/test.l" unit tests
+   'full' function
+   Bug in 'wipe'
+   Bug in 'digSub1()'
+   Changed internal symbol structure
+   'pid' selector for 'tell'
+   'vi' and 'ld' source code access
+   Restored 'in'/'out' negative channel offsets
+   Abandoned 'stdio' in I/O functions
+   Improved signal handling
+   'leaf' function
+   Restored 'gc' unit to "megabytes"
+   Changed 'heap' return values
+   Bug in 'tell'
+   'chess' XBoard interface
+   '*Sig1', '*Sig2' global variables
+   'ipid' and 'opid' functions
+   Bug in writing blobs
+   Timeout bug in 'httpGate'
+   '*Zap' global variable
+   '*OS' global variable
+
+* 30jun07 picoLisp-2.2.7
+   Extended "doc/ref.html"
+   'cons' multiple arguments
+   'yoke' function
+   'up' optional 'cnt' argument
+
+* 01apr07 picoLisp-2.2.6
+   'app' reference application
+   Bug in 'text'
+   Family IPC redesign
+   Gave up 'in'/'out' negative channel offsets
+   Changed 'keep>' and 'lose>' methods
+   Gave up '*Tsm' transient symbol markup
+   'sect' and 'diff' in C
+   'gc' unit changed to "million cells"
+
+* 31dec06 picoLisp-2.2.5
+   Persistent HTTP Connections
+   Extended 'tick' to count system time
+   Chunked HTTP transfers
+   Changed '*Key' to '*Run'
+   'fifo' function
+   'die' alarm function
+   'line' carriage return handling
+   Pre- and post-arguments to 'commit'
+   'text' function
+   'glue' in C
+   Ajax GUI in "lib/form.l", "lib/form.js"
+   'push1' function (deprecates '?push')
+   Bug in 'ht:Fmt'
+
+* 30sep06 picoLisp-2.2.4
+   Cygwin/Win32 port (Doug Snead)
+   Changed 'bind' argument
+   'fish' function
+   'rd' optional 'sym' argument
+   Bug in 'lock' (unlock all)
+   'free' function
+   Extended 'seq' to return first symbol
+   Simple 'udp' function
+   'usec' function
+   Bug in 'isLife()'
+   '*PPid' global variable
+   'nagle' network function
+   Extended 'get'-syntax to 'asoq'
+
+* 30jun06 picoLisp-2.2.3
+   "redefined" messages go to stderr
+   Bug in 'argv'
+   Deprecated "lib/tree.l"
+   Restored '*Solo' global variable
+   '(get lst 0)' returns 'NIL'
+   Bug in 'extern'
+   'nond' (negated 'cond') function
+   'ge0' function
+   Bug in 'lose>' and 'keep>' for '+Joint'
+   '*Rst' global variable
+   Bug in 'next'/'arg'
+   Changed 'env' and 'job'
+   Bug in B-Tree 'step'
+   Changed 'mark' return value
+   Changed 'close' return value
+
+* 29mar06 picoLisp-2.2.2
+   Mac OS X (Darwin) port (Rick Hanson)
+   'pwd' function
+   'if2' flow function
+   'rpc' function
+   'one' function
+   Changed 'space' return value
+   'up' symbol binding lookup function
+   Bug in 'eval' and 'run' environment offset
+   'onOff' function
+   'path' substitution function
+   '*Tsm' transient symbol markup
+   Underlining transient symbols
+
+* 30dec05 picoLisp-2.2.1
+   'eof' end-of-file function
+   Changed 'line' EOF return value
+   Deprecated 'whilst' and 'until=T'
+   'read' extended to parse tokens
+   'raw' console mode function
+   'later' multiprocessing function
+   Bug in nested 'fork' and 'pipe'
+   Extended 'gcc' arguments
+   Bug in 'boxWord2()'
+   'id' external symbol function
+   Extended 'dm' syntax for object argument
+   'size' changed to return bytes instead of blocks in DB
+   Executable renamed to "picolisp"
+   'lieu' predicate function
+   Bug in 'compare()'
+
+* 29sep05 picoLisp-2.2.0
+   FreeBSD port
+   B-Trees
+   Multi-file DB
+   Configurable DB block size
+   Generalized 'pipe' semantics
+   Changed 'rank' to sorted lists
+   Removed '*Solo' global variable
+   Relaxed 'wipe' "modified" error condition
+   DB-I/O changed to 'pread()' and 'pwrite()'
+   Extended 'get'-syntax to zero and negative keys
+   'by' attribute map function
+   Swing GUI in "java2/" and "lib/gui2.l"
+   'box?' predicate function
+   Bug in 'compare()'
+   'balance' C-utility
+
+* 30jun05 picoLisp-2.1.2
+   GC non-recursive
+   'lup' lookup in 'idx' trees
+   Applet colors
+   'try' to send messages
+   'x|' function
+   Tooltips in applets
+   Binding environment offset for 'eval' and 'run'
+   XHTML/CSS support in "lib/xhtml.l"
+   Separated "lib/html.l" from "lib/http.l"
+   Removed "lib/http.l" from "ext.l"
+   Bug in 'isa'
+   Bug in 'lose>' and 'keep>' for '+Bag'
+   Security hole in 'http'
+   Bug in 'rel>' for '+Hook'
+
+* 30mar05 picoLisp-2.1.1
+   'protect' function
+   DB journaling
+   'chess' demo
+   Predicates return their argument instead of 'T', if possible
+   Bug in 'fun?'
+   Improved 'lint' heuristics
+   I/O-Multiplexing also for plain stdin
+   'dir' in C
+   Self-adjusting applet size
+   Bug in 'pack()'
+
+* 30dec04 picoLisp-2.1.0
+   'pipe' function
+   Bugs in bignum arithmetic
+   'arg' optional 'cnt' argument
+   '+Aux' auxiliary index keys
+   '*Solo' global variable
+   'flg?' predicate function
+   'fin' access function
+   Bug in 'compare()'
+   'cd' returns old directory
+   'inc' and 'dec' numeric argument
+   Next 'opt' command line arg
+   'finally' exception cleanup
+   Implied 'upd' argument in transactions 'put!>', 'del!>' etc.
+   Bug in 'idx' for empty trees
+   'curry' function
+   Anonymous recursion with 'recur' and 'recurse'
+   Extended 'env' to return bindings
+   Second argument to 'fill'
+   Optional comment character argument for 'skip'
+   'flip' destructive list reversal
+
+* 01oct04 picoLisp-2.0.14
+   '<tree>' HTML function
+   Finite 'state' machine function
+   Extended 'for' functionality
+   'rcsim' toy RC flight simulator
+   Bug in 'sym', 'str' and '*/'
+   Extended 'dbck' return value
+
+* 03aug04 picoLisp-2.0.13
+   Changed rounding and argument policy of '*/'
+   Applet protocol revised
+   Extended 'head' and 'tail' to predicate functionality
+   Changed 'accu' default from 1 to 0
+   Dialog handling revised
+   Multiple JAR files per applet
+   Fixed "Last-Modified:" format in 'httpEcho'
+
+* 29may04 picoLisp-2.0.12
+   Fixed 'boss' mechanism
+   'del' delete-and-set function
+   '*Fork' global variable
+   Changed URL encoding of Lisp objects
+   Removed traffic throttle from 'httpGate'
+   Synchronized ".picoHistory" in "lib/led.l"
+   Fixed exception handling in debug breakpoint
+   Revised subclass handling in 'db' and 'collect'
+   Applet font/size parameters
+
+* 07apr04 picoLisp-2.0.11
+   Bug in 'append'
+   Modal dialogs revised
+   Bug in 'lose>' and 'keep>' for '+Bag'
+   'poll' (no block-on-read-) check function
+   Inline 'gcc' C-function compilation
+
+* 01feb04 picoLisp-2.0.10
+   'wr' raw byte output function
+   Improved modal dialogs
+   Comma ',' read-macro, replacing the '_' function
+   'let?' conditional flow/bind function
+   'accept' non-blocking, with timeout
+   Optional method-defining arguments to '+Form's
+   '+Bool' relation class
+   '+Ref2' backing index prefix class
+   'size' returns number of DB blocks for external symbols
+   '+ListTextField' split parameter
+
+* 06dec03 picoLisp-2.0.9
+   'Tele' java client
+   Closed leaking file descriptors in 'fork'
+   Changed applet protocol to individual server connections
+   Decoupled applet init from HTML page load
+
+* 14oct03 picoLisp-2.0.8b
+   Bug in 'put>', 'rel>', 'lose>' and 'keep>' for '+List'
+   Bug in 'lose>' and 'keep>' for '+Bag'
+
+* 01oct03 picoLisp-2.0.8
+   '+Hook' handling in '+Bag'
+   Unicode case conversions
+   '+Hook' changed to prefix class
+   Telephone number locales
+   CR-LF in HTTP headers
+   'date' and 'time' return UTC for 'T' argument
+   'clk>' (doubleclick) for '+DrawField'
+   Improved Hook support in Pilog
+   Optional 'NIL' argument to 'html' for "no Cache-Control"
+
+* 03aug03 picoLisp-2.0.7
+   Extended 'in' and 'out' for negative channel offset arguments
+   Changed internal database index tree function API
+   Changed 'info' to return 'T' for the directory size
+   Interrupt signal handling in 'ctty', 'psh' and "bin/psh"
+   Generic 'help>' method for '+Form' class in "lib/gui.l"
+   Fixed 'ht:Prin' bug (NULL-Bytes)
+   'argv' optional symbolic arguments
+   Changed 'idx' return value
+   Better tracing and profiling of C-functions
+
+* 08jun03 picoLisp-2.0.6
+   Allowed '#' in symbol names
+   Changed 'eps' in "lib/ps.l"
+   Interactive DB tools in "lib/sq.l"
+   'revise' line editor function
+   'circ' changed to individual arguments
+   Moved code-libraries to "lib/"
+   Moved *.jar-files to "java/"
+
+* 23apr03 picoLisp-2.0.5
+   'mail' changed to direct SMTP
+   'sys' environment access function
+   Plain HTML-GUI "lib/htm.l" (experimental)
+   Semantics of 'do NIL' changed from enless- to zero-loop
+
+* 03mar03 picoLisp-2.0.4
+   Changed and extended '+IndexChart'
+   '=0', 'lt0' and 'gt0' return numeric argument instead of 'T'
+   'cut' changed to be non-desctructive
+   'ssl' replication mechanism
+   'ctl' file control primitives
+   'ext?' and 'extern' check for physical existence of external symbol
+
+* 01feb03 picoLisp-2.0.3
+   Extension and redesign of the HTML API
+   'loop' function as a synonym for 'do NIL'
+
+* 17jan03 picoLisp-2.0.2
+   The example files for the tutorial were in the wrong directory
+   Bind '*Key' in debug breakpoint
+   Localization bug in "misc/tax.l"
+
+* 27dec02 picoLisp-2.0.1
+   Default locale 'NIL'
+   Pilog documentation
+   Example family database
+
+* 16dec02 picoLisp-2.0
+   Initial release
diff --git a/COPYING b/COPYING
@@ -0,0 +1,280 @@
+		    GNU GENERAL PUBLIC LICENSE
+		       Version 2, June 1991
+
+ Copyright (C) 1989, 1991 Free Software Foundation, Inc.
+                       59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+ Everyone is permitted to copy and distribute verbatim copies
+ of this license document, but changing it is not allowed.
+
+			    Preamble
+
+  The licenses for most software are designed to take away your
+freedom to share and change it.  By contrast, the GNU General Public
+License is intended to guarantee your freedom to share and change free
+software--to make sure the software is free for all its users.  This
+General Public License applies to most of the Free Software
+Foundation's software and to any other program whose authors commit to
+using it.  (Some other Free Software Foundation software is covered by
+the GNU Library General Public License instead.)  You can apply it to
+your programs, too.
+
+  When we speak of free software, we are referring to freedom, not
+price.  Our General Public Licenses are designed to make sure that you
+have the freedom to distribute copies of free software (and charge for
+this service if you wish), that you receive source code or can get it
+if you want it, that you can change the software or use pieces of it
+in new free programs; and that you know you can do these things.
+
+  To protect your rights, we need to make restrictions that forbid
+anyone to deny you these rights or to ask you to surrender the rights.
+These restrictions translate to certain responsibilities for you if you
+distribute copies of the software, or if you modify it.
+
+  For example, if you distribute copies of such a program, whether
+gratis or for a fee, you must give the recipients all the rights that
+you have.  You must make sure that they, too, receive or can get the
+source code.  And you must show them these terms so they know their
+rights.
+
+  We protect your rights with two steps: (1) copyright the software, and
+(2) offer you this license which gives you legal permission to copy,
+distribute and/or modify the software.
+
+  Also, for each author's protection and ours, we want to make certain
+that everyone understands that there is no warranty for this free
+software.  If the software is modified by someone else and passed on, we
+want its recipients to know that what they have is not the original, so
+that any problems introduced by others will not reflect on the original
+authors' reputations.
+
+  Finally, any free program is threatened constantly by software
+patents.  We wish to avoid the danger that redistributors of a free
+program will individually obtain patent licenses, in effect making the
+program proprietary.  To prevent this, we have made it clear that any
+patent must be licensed for everyone's free use or not licensed at all.
+
+  The precise terms and conditions for copying, distribution and
+modification follow.
+
+		    GNU GENERAL PUBLIC LICENSE
+   TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
+
+  0. This License applies to any program or other work which contains
+a notice placed by the copyright holder saying it may be distributed
+under the terms of this General Public License.  The "Program", below,
+refers to any such program or work, and a "work based on the Program"
+means either the Program or any derivative work under copyright law:
+that is to say, a work containing the Program or a portion of it,
+either verbatim or with modifications and/or translated into another
+language.  (Hereinafter, translation is included without limitation in
+the term "modification".)  Each licensee is addressed as "you".
+
+Activities other than copying, distribution and modification are not
+covered by this License; they are outside its scope.  The act of
+running the Program is not restricted, and the output from the Program
+is covered only if its contents constitute a work based on the
+Program (independent of having been made by running the Program).
+Whether that is true depends on what the Program does.
+
+  1. You may copy and distribute verbatim copies of the Program's
+source code as you receive it, in any medium, provided that you
+conspicuously and appropriately publish on each copy an appropriate
+copyright notice and disclaimer of warranty; keep intact all the
+notices that refer to this License and to the absence of any warranty;
+and give any other recipients of the Program a copy of this License
+along with the Program.
+
+You may charge a fee for the physical act of transferring a copy, and
+you may at your option offer warranty protection in exchange for a fee.
+
+  2. You may modify your copy or copies of the Program or any portion
+of it, thus forming a work based on the Program, and copy and
+distribute such modifications or work under the terms of Section 1
+above, provided that you also meet all of these conditions:
+
+    a) You must cause the modified files to carry prominent notices
+    stating that you changed the files and the date of any change.
+
+    b) You must cause any work that you distribute or publish, that in
+    whole or in part contains or is derived from the Program or any
+    part thereof, to be licensed as a whole at no charge to all third
+    parties under the terms of this License.
+
+    c) If the modified program normally reads commands interactively
+    when run, you must cause it, when started running for such
+    interactive use in the most ordinary way, to print or display an
+    announcement including an appropriate copyright notice and a
+    notice that there is no warranty (or else, saying that you provide
+    a warranty) and that users may redistribute the program under
+    these conditions, and telling the user how to view a copy of this
+    License.  (Exception: if the Program itself is interactive but
+    does not normally print such an announcement, your work based on
+    the Program is not required to print an announcement.)
+
+These requirements apply to the modified work as a whole.  If
+identifiable sections of that work are not derived from the Program,
+and can be reasonably considered independent and separate works in
+themselves, then this License, and its terms, do not apply to those
+sections when you distribute them as separate works.  But when you
+distribute the same sections as part of a whole which is a work based
+on the Program, the distribution of the whole must be on the terms of
+this License, whose permissions for other licensees extend to the
+entire whole, and thus to each and every part regardless of who wrote it.
+
+Thus, it is not the intent of this section to claim rights or contest
+your rights to work written entirely by you; rather, the intent is to
+exercise the right to control the distribution of derivative or
+collective works based on the Program.
+
+In addition, mere aggregation of another work not based on the Program
+with the Program (or with a work based on the Program) on a volume of
+a storage or distribution medium does not bring the other work under
+the scope of this License.
+
+  3. You may copy and distribute the Program (or a work based on it,
+under Section 2) in object code or executable form under the terms of
+Sections 1 and 2 above provided that you also do one of the following:
+
+    a) Accompany it with the complete corresponding machine-readable
+    source code, which must be distributed under the terms of Sections
+    1 and 2 above on a medium customarily used for software interchange; or,
+
+    b) Accompany it with a written offer, valid for at least three
+    years, to give any third party, for a charge no more than your
+    cost of physically performing source distribution, a complete
+    machine-readable copy of the corresponding source code, to be
+    distributed under the terms of Sections 1 and 2 above on a medium
+    customarily used for software interchange; or,
+
+    c) Accompany it with the information you received as to the offer
+    to distribute corresponding source code.  (This alternative is
+    allowed only for noncommercial distribution and only if you
+    received the program in object code or executable form with such
+    an offer, in accord with Subsection b above.)
+
+The source code for a work means the preferred form of the work for
+making modifications to it.  For an executable work, complete source
+code means all the source code for all modules it contains, plus any
+associated interface definition files, plus the scripts used to
+control compilation and installation of the executable.  However, as a
+special exception, the source code distributed need not include
+anything that is normally distributed (in either source or binary
+form) with the major components (compiler, kernel, and so on) of the
+operating system on which the executable runs, unless that component
+itself accompanies the executable.
+
+If distribution of executable or object code is made by offering
+access to copy from a designated place, then offering equivalent
+access to copy the source code from the same place counts as
+distribution of the source code, even though third parties are not
+compelled to copy the source along with the object code.
+
+  4. You may not copy, modify, sublicense, or distribute the Program
+except as expressly provided under this License.  Any attempt
+otherwise to copy, modify, sublicense or distribute the Program is
+void, and will automatically terminate your rights under this License.
+However, parties who have received copies, or rights, from you under
+this License will not have their licenses terminated so long as such
+parties remain in full compliance.
+
+  5. You are not required to accept this License, since you have not
+signed it.  However, nothing else grants you permission to modify or
+distribute the Program or its derivative works.  These actions are
+prohibited by law if you do not accept this License.  Therefore, by
+modifying or distributing the Program (or any work based on the
+Program), you indicate your acceptance of this License to do so, and
+all its terms and conditions for copying, distributing or modifying
+the Program or works based on it.
+
+  6. Each time you redistribute the Program (or any work based on the
+Program), the recipient automatically receives a license from the
+original licensor to copy, distribute or modify the Program subject to
+these terms and conditions.  You may not impose any further
+restrictions on the recipients' exercise of the rights granted herein.
+You are not responsible for enforcing compliance by third parties to
+this License.
+
+  7. If, as a consequence of a court judgment or allegation of patent
+infringement or for any other reason (not limited to patent issues),
+conditions are imposed on you (whether by court order, agreement or
+otherwise) that contradict the conditions of this License, they do not
+excuse you from the conditions of this License.  If you cannot
+distribute so as to satisfy simultaneously your obligations under this
+License and any other pertinent obligations, then as a consequence you
+may not distribute the Program at all.  For example, if a patent
+license would not permit royalty-free redistribution of the Program by
+all those who receive copies directly or indirectly through you, then
+the only way you could satisfy both it and this License would be to
+refrain entirely from distribution of the Program.
+
+If any portion of this section is held invalid or unenforceable under
+any particular circumstance, the balance of the section is intended to
+apply and the section as a whole is intended to apply in other
+circumstances.
+
+It is not the purpose of this section to induce you to infringe any
+patents or other property right claims or to contest validity of any
+such claims; this section has the sole purpose of protecting the
+integrity of the free software distribution system, which is
+implemented by public license practices.  Many people have made
+generous contributions to the wide range of software distributed
+through that system in reliance on consistent application of that
+system; it is up to the author/donor to decide if he or she is willing
+to distribute software through any other system and a licensee cannot
+impose that choice.
+
+This section is intended to make thoroughly clear what is believed to
+be a consequence of the rest of this License.
+
+  8. If the distribution and/or use of the Program is restricted in
+certain countries either by patents or by copyrighted interfaces, the
+original copyright holder who places the Program under this License
+may add an explicit geographical distribution limitation excluding
+those countries, so that distribution is permitted only in or among
+countries not thus excluded.  In such case, this License incorporates
+the limitation as if written in the body of this License.
+
+  9. The Free Software Foundation may publish revised and/or new versions
+of the General Public License from time to time.  Such new versions will
+be similar in spirit to the present version, but may differ in detail to
+address new problems or concerns.
+
+Each version is given a distinguishing version number.  If the Program
+specifies a version number of this License which applies to it and "any
+later version", you have the option of following the terms and conditions
+either of that version or of any later version published by the Free
+Software Foundation.  If the Program does not specify a version number of
+this License, you may choose any version ever published by the Free Software
+Foundation.
+
+  10. If you wish to incorporate parts of the Program into other free
+programs whose distribution conditions are different, write to the author
+to ask for permission.  For software which is copyrighted by the Free
+Software Foundation, write to the Free Software Foundation; we sometimes
+make exceptions for this.  Our decision will be guided by the two goals
+of preserving the free status of all derivatives of our free software and
+of promoting the sharing and reuse of software generally.
+
+			    NO WARRANTY
+
+  11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
+FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW.  EXCEPT WHEN
+OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
+PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED
+OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
+MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.  THE ENTIRE RISK AS
+TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU.  SHOULD THE
+PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING,
+REPAIR OR CORRECTION.
+
+  12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
+WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
+REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES,
+INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING
+OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED
+TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY
+YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER
+PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE
+POSSIBILITY OF SUCH DAMAGES.
+
+		     END OF TERMS AND CONDITIONS
diff --git a/CREDITS b/CREDITS
@@ -0,0 +1,23 @@
+# The PicoLisp system is originally written and maintained by
+Alexander Burger <abu@software-lab.de>
+
+# For many years, ideas and application concepts were contributed by
+Josef Bartl <josef.bartl@7fach.org>
+
+# Build procedure for Mac OS X (Darwin)
+Rick Hanson <rick@tamos.net>
+
+# Port to Cygwin/Win32
+Doug Snead <doug@drugsense.org>
+
+# Documentation, Mac OS support, OpenGL library, Norwegian localization
+Jon Kleiser <jon.kleiser@usit.uio.no>
+
+# Russian localization
+Mansur Mamkin <mmamkin@mail.ru>
+
+# XML parser (and other) improvements
+Tomas Hlavaty <kvietaag@seznam.cz>
+
+# Spanish localization and emacs picolisp-mode
+Armadillo <tc.rucho@gmail.com>
diff --git a/INSTALL b/INSTALL
@@ -0,0 +1,103 @@
+16mar10abu
+(c) Software Lab. Alexander Burger
+
+
+         PicoLisp Installation
+         =====================
+
+There is no 'configure' procedure, but the PicoLisp file structure is simple
+enough to get along without it (we hope). It should compile and run on
+GNU/Linux, FreeBSD, Mac OS X (Darwin), Cygwin/Win32, and possibly other systems
+without problems.
+
+By default, PicoLisp installs completely in a local directory. No need to touch
+any system locations, so you don't have to be root.
+
+
+Please follow these steps:
+
+1. Unpack the distribution
+
+      $ tar xfz picoLisp-XXX.tgz
+
+2. Change the directory
+
+      $ cd picoLisp-XXX
+
+3. Compile the PicoLisp interpreter
+
+      $ (cd src; make picolisp)
+
+   or, if you have an x86-64 Linux system, build the 64-bit version
+
+      $ (cd src64; make picolisp)
+
+   In both cases the executable bin/picolisp will be created.
+
+   Note that on the BSD family of operating systems, 'gmake' must be used
+   instead of 'make'.
+
+4. Optional (but recommended) are two symbolic links from /usr/lib and /usr/bin
+   to the installation directory
+
+      # ln -s /<installdir> /usr/lib/picolisp
+      # ln -s /usr/lib/picolisp/bin/picolisp /usr/bin/picolisp
+
+   In that case, you might also copy the script bin/pil to /usr/bin, for a
+   convenient global invocation.
+
+
+      Invocation
+      ----------
+
+The shell script 'dbg' is usually called to start up PicoLisp in interactive
+debugging mode
+
+   $ ./dbg
+   :
+
+The colon ':' is PicoLisp's prompt. You may enter some Lisp expression,
+
+   : (+ 1 2 3)
+   -> 6
+
+To exit the interpreter, enter
+
+   : (bye)
+
+or simply type an empy line (Return).
+
+
+         Console Underlines
+         ==================
+
+In case that your console (terminal) does not support underlining, you might
+want to remove or replace the first statement int "ext.l" which uses the
+terminfo database to initialize the global variable '*Tsm' (transient symbol
+markup). Unfortunately, the VGA text mode does not properly support underlines.
+
+
+      Documentation
+      -------------
+
+For further information, please look at "doc/index.html". There you find the
+PicoLisp Reference Manual (doc/ref.html), the PicoLisp tutorials (doc/tut.html
+and doc/app.html), and the frequently asked questions (doc/faq.html).
+
+For details about the 64-bit version, refer to "doc64/README", "doc64/asm" and
+"doc64/structures".
+
+As always, the most accurate and complete documentation is the source code ;-)
+Included in the distribution are many utilities and pet projects, including
+tests, demo databases and servers, games (chess, minesweeper), 3D animation
+(flight simulator), and more.
+
+Any feedback is welcome!
+Hope you enjoy :-)
+
+--------------------------------------------------------------------------------
+
+   Alexander Burger
+   Software Lab. / 7fach GmbH
+   Bahnhofstr. 24a, D-86462 Langweid
+   abu@software-lab.de, http://www.software-lab.de, +49 8230 5060
diff --git a/README b/README
@@ -0,0 +1,105 @@
+12nov09abu
+(c) Software Lab. Alexander Burger
+
+                                                          Perfection is attained
+                                           not when there is nothing left to add
+                                     but when there is nothing left to take away
+                                                     (Antoine de Saint-Exupery)
+         The PicoLisp System
+         ===================
+
+     _PI_co Lisp is not _CO_mmon Lisp
+
+PicoLisp can be viewed from two different aspects: As a general purpose
+programming language, and a dedicated application server framework.
+
+
+(1) As a programming language, PicoLisp provides a 1-to-1 mapping of a clean
+and powerful Lisp derivate, to a simple and efficient virtual machine. It
+supports persistent objects as a first class data type, resulting in a database
+system of Entity/Relation classes and a Prolog-like query language tightly
+integrated into the system.
+
+The virtual machine was designed to be
+   Simple
+      The internal data structure should be as simple as possible. Only one
+      single data structure is used to build all higher level constructs.
+   Unlimited
+      There are no limits imposed upon the language due to limitations of the
+      virtual machine architecture. That is, there is no upper bound in symbol
+      name length, number digit counts, or data structure and buffer sizes,
+      except for the total memory size of the host machine.
+   Dynamic
+      Behavior should be as dynamic as possible ("run"-time vs. "compile"-time).
+      All decisions are delayed till runtime where possible. This involves
+      matters like memory management, dynamic symbol binding, and late method
+      binding.
+   Practical
+      PicoLisp is not just a toy of theoretical value. PicoLisp is used since
+      1988 in actual application development, research and production.
+
+The language inherits the major advantages of classical Lisp systems like
+   - Dynamic data types and structures
+   - Formal equivalence of code and data
+   - Functional programming style
+   - An interactive environment
+
+PicoLisp is very different from any other Lisp dialect. This is partly due to
+the above design principles, and partly due to its long development history
+since 1984.
+
+You can download the latest release version at
+"http://software-lab.de/down.html".
+
+
+(2) As an application server framework, PicoLisp provides for
+   Database Management
+      Index trees
+      Object local indexes
+      Entity/Relation classes
+      Pilog (PicoLisp Prolog) queries
+      Multi-user synchronization
+      DB Garbage collection
+      Journaling, Replication
+   User Interface
+      Browser GUI
+      (X)HTML/CSS
+      XMLHttpRequest/JavaScript
+   Application Server
+      Process management
+      Process family communication
+      XML I/O
+      Import/export
+      User administration
+      Internationalization
+      Security
+      Object linkage
+      Postscript/Printing
+
+PicoLisp is not an IDE. All program development in Software Lab. is done using
+the console, bash, vim and the Lisp interpreter.
+
+The only type of GUI supported for applications is through a browser via HTML.
+This makes the client side completely platform independent. The GUI is created
+dynamically. Though it uses JavaScript and XMLHttpRequest for speed
+improvements, it is fully functional also without JavaScript or CSS.
+
+The GUI is deeply integrated with - and generated dynamically from - the
+application's data model. Because the application logic runs on the server,
+multiple users can view and modify the same database object without conflicts,
+everyone seeing changes done by other users on her screen immediately due to the
+internal process and database synchronization.
+
+PicoLisp is free software, and you are welcome to redistribute it under the
+conditions of the GNU General Public License (GPL).
+
+It compiles and runs on current 32-bit GNU/Linux, FreeBSD, Mac OS X (Darwin),
+Cygwin/Win32 (and possibly other) systems. A native 64-bit version is available
+for Linux on x86-64.
+
+--------------------------------------------------------------------------------
+
+   Alexander Burger
+   Software Lab. / 7fach GmbH
+   Bahnhofstr. 24a, D-86462 Langweid
+   abu@software-lab.de, http://www.software-lab.de, +49 8230 5060
diff --git a/ReleaseNotes b/ReleaseNotes
@@ -0,0 +1,18 @@
+19apr10abu
+(c) Software Lab. Alexander Burger
+
+
+         Release Notes for picoLisp-3.0.3
+         ================================
+
+A. The underlined display of transient symbols in the documentation is changed
+   back to double quotes, to allow an easier copy/paste of example code
+   fragments.
+
+B. The function 'not' is included in the group of flow- and logic-functions
+   which store non-NIL results of their conditional expressions in '@' (see the
+   chapter "@ Result" in "doc/ref.html"). This makes it consistent with 'nand'
+   and 'nor'.
+
+C. The line editor "lib/led.l" cycles with TAB also through path names (in
+   addition to internal symbols).
diff --git a/app/cusu.l b/app/cusu.l
@@ -0,0 +1,43 @@
+# 05nov09abu
+# (c) Software Lab. Alexander Burger
+
+(must "Customer/Supplier" Customer)
+
+(menu ,"Customer/Supplier"
+   (ifn *ID
+      (prog
+         (<h3> NIL ,"Select" " " ,"Customer/Supplier")
+         (form 'dialog (choCuSu)) )
+      (<h3> NIL ,"Customer/Supplier")
+      (form NIL
+         (<h2> NIL (<id> (: nr) " -- " (: nm)))
+         (panel T (pack ,"Customer/Supplier" " @1") '(may Delete) '(choCuSu) 'nr '+CuSu)
+         (<hr>)
+         (<tab>
+            (,"Name"
+               (<grid> 3
+                  ,"Number" NIL (gui '(+E/R +NumField) '(nr : home obj) 10)
+                  ,"Salutation"
+                  (gui '(+Hint) ,"Salutation"
+                     '(mapcar '((This) (cons (: nm) This)) (collect 'nm '+Sal)) )
+                  (gui '(+Hint2 +E/R +Obj +TextField) '(sal : home obj) '(nm +Sal) 20)
+                  ,"Name" NIL (gui '(+E/R +Cue +TextField) '(nm : home obj) ,"Name" 40)
+                  ,"Name 2" NIL (gui '(+E/R +TextField) '(nm2 : home obj) 40) ) )
+            (,"Address"
+               (<grid> 2
+                  ,"Street" (gui '(+E/R +TextField) '(str : home obj) 40)
+                  NIL NIL
+                  ,"Zip" (gui '(+E/R +TextField) '(plz : home obj) 10)
+                  ,"City" (gui '(+E/R +TextField) '(ort : home obj) 40) ) )
+            (,"Contact"
+               (<grid> 2
+                  ,"Phone" (gui '(+E/R +TelField) '(tel : home obj) 40)
+                  ,"Fax" (gui '(+E/R +TelField) '(fax : home obj) 40)
+                  ,"Mobile" (gui '(+E/R +TelField) '(mob : home obj) 40)
+                  ,"EMail" (gui '(+E/R +MailField) '(em : home obj) 40) ) )
+            ((pack (and (: obj txt) "@ ") ,"Memo")
+               (gui '(+BlobField) '(txt : home obj) 60 8) ) )
+         (<hr>)
+         (<spread> NIL (editButton T)) ) ) )
+
+# vi:et:ts=3:sw=3
diff --git a/app/er.l b/app/er.l
@@ -0,0 +1,167 @@
+# 01dec09abu
+# (c) Software Lab. Alexander Burger
+
+### Entity/Relations ###
+#
+#           nr    nm                   nr    nm               nm
+#            |    |                     |    |                |
+#          +-*----*-+                 +-*----*-+           +--*-----+
+#          |        |             sup |        |           |        |
+#    str --*  CuSu  O-----------------*  Item  *-- inv     |  Role  @-- perm
+#          |        |                 |        |           |        |
+#          +-*-*--O-+                 +----O---+           +----@---+
+#            | |  |                        |                    | usr
+#   nm  tel -+ |  |                        |                    |
+#    |         |  |                        | itm                | role
+#  +-*-----+   |  |   +-------+        +---*---+           +----*---+
+#  |       |   |  |   |       |    ord |       |           |        |
+#  |  Sal  +---+  +---*  Ord  @--------*  Pos  |      nm --*  User  *-- pw
+#  |       |      cus |       | pos    |       |           |        |
+#  +-*---*-+          +-*---*-+        +-*---*-+           +--------+
+#    |   |              |   |            |   |
+#   hi   sex           nr  dat          pr   cnt
+
+(extend +Role)
+
+(dm url> (Tab)
+   (and (may RoleAdmin) (list "app/role.l" '*ID This)) )
+
+
+(extend +User)
+(rel nam (+String))                    # Full Name
+(rel tel (+String))                    # Phone
+(rel em (+String))                     # EMail
+
+(dm url> (Tab)
+   (and (may UserAdmin) (list "app/user.l" '*ID This)) )
+
+
+# Salutation
+(class +Sal +Entity)
+(rel nm (+Key +String))                # Salutation
+(rel hi (+String))                     # Greeting
+(rel sex (+Any))                       # T:male, 0:female
+
+(dm url> (Tab)
+   (and (may Customer) (list "app/sal.l" '*ID This)) )
+
+(dm hi> (Nm)
+   (or (text (: hi) Nm) ,"Dear Sir or Madam,") )
+
+
+# Customer/Supplier
+(class +CuSu +Entity)
+(rel nr (+Need +Key +Number))          # Customer/Supplier Number
+(rel sal (+Link) (+Sal))               # Salutation
+(rel nm (+Sn +Idx +String))            # Name
+(rel nm2 (+String))                    # Name 2
+(rel str (+String))                    # Street
+(rel plz (+Ref +String))               # Zip
+(rel ort (+Fold +Idx +String))         # City
+(rel tel (+Fold +Ref +String))         # Phone
+(rel fax (+String))                    # Fax
+(rel mob (+Fold +Ref +String))         # Mobile
+(rel em (+String))                     # EMail
+(rel txt (+Blob))                      # Memo
+
+(dm url> (Tab)
+   (and (may Customer) (list "app/cusu.l"  '*Tab Tab  '*ID This)) )
+
+(dm check> ()
+   (make
+      (or (: nr) (link ,"No customer number"))
+      (or (: nm) (link ,"No customer name"))
+      (unless (and (: str) (: plz) (: ort))
+         (link ,"Incomplete customer address") ) ) )
+
+
+# Item
+(class +Item +Entity)
+(rel nr (+Need +Key +Number))          # Item Number
+(rel nm (+Fold +Idx +String))          # Item Description
+(rel sup (+Ref +Link) NIL (+CuSu))     # Supplier
+(rel inv (+Number))                    # Inventory
+(rel pr (+Ref +Number) NIL 2)          # Price
+(rel txt (+Blob))                      # Memo
+(rel jpg (+Blob))                      # Picture
+
+(dm url> (Tab)
+   (and (may Item) (list "app/item.l" '*ID This)) )
+
+(dm cnt> ()
+   (-
+      (or (: inv) 0)
+      (sum '((This) (: cnt))
+         (collect 'itm '+Pos This) ) ) )
+
+(dm check> ()
+   (make
+      (or (: nr) (link ,"No item number"))
+      (or (: nm) (link ,"No item description")) ) )
+
+
+# Order
+(class +Ord +Entity)
+(rel nr (+Need +Key +Number))          # Order Number
+(rel dat (+Need +Ref +Date))           # Order date
+(rel cus (+Ref +Link) NIL (+CuSu))     # Customer
+(rel pos (+List +Joint) ord (+Pos))    # Positions
+
+(dm lose> ()
+   (mapc 'lose> (: pos))
+   (super) )
+
+(dm url> (Tab)
+   (and (may Order) (list "app/ord.l" '*ID This)) )
+
+(dm sum> ()
+   (sum 'sum> (: pos)) )
+
+(dm check> ()
+   (make
+      (or (: nr) (link ,"No order number"))
+      (or (: dat) (link ,"No order date"))
+      (if (: cus)
+         (chain (check> @))
+         (link ,"No customer") )
+      (if (: pos)
+         (chain (mapcan 'check> @))
+         (link ,"No positions") ) ) )
+
+
+(class +Pos +Entity)
+(rel ord (+Dep +Joint)                 # Order
+   (itm)
+   pos (+Ord) )
+(rel itm (+Ref +Link) NIL (+Item))     # Item
+(rel pr (+Number) 2)                   # Price
+(rel cnt (+Number))                    # Quantity
+
+(dm sum> ()
+   (* (: pr) (: cnt)) )
+
+(dm check> ()
+   (make
+      (if (: itm)
+         (chain (check> @))
+         (link ,"Position without item") )
+      (or (: pr) (link ,"Position without price"))
+      (or (: cnt) (link ,"Position without quantity")) ) )
+
+
+# Database sizes
+(dbs
+   (1 +Role +User +Sal)                         # (1 . 128)
+   (2 +CuSu)                                    # (2 . 256)
+   (1 +Item +Ord)                               # (3 . 128)
+   (0 +Pos)                                     # (4 . 64)
+   (2 (+Role nm) (+User nm) (+Sal nm))          # (5 . 256)
+   (4 (+CuSu nr plz tel mob))                   # (6 . 1024)
+   (4 (+CuSu nm))                               # (7 . 1024)
+   (4 (+CuSu ort))                              # (8 . 1024)
+   (4 (+Item nr sup pr))                        # (9 . 1024)
+   (4 (+Item nm))                               # (10 . 1024)
+   (4 (+Ord nr dat cus))                        # (11 . 1024)
+   (4 (+Pos itm)) )                             # (12 . 1024)
+
+# vi:et:ts=3:sw=3
diff --git a/app/gui.l b/app/gui.l
@@ -0,0 +1,243 @@
+# 20apr10abu
+# (c) Software Lab. Alexander Burger
+
+### GUI ###
+(de menu (Ttl . Prg)
+   (action
+      (html 0 Ttl *Css NIL
+         (<div> '(id . menu)
+            (expires)
+            (<menu>
+               (,"Home" "@start")
+               (,"logout" (and *Login "@stop"))
+               (NIL (<hr>))
+               (T ,"Data"
+                  (,"Orders" (and (may Order) "app/ord.l"))
+                  (,"Items" (and (may Item) "app/item.l"))
+                  (,"Customers/Suppliers" (and (may Customer) "app/cusu.l"))
+                  (,"Salutations" (and (may Customer) "app/sal.l")) )
+               (T ,"Report"
+                  (,"Inventory" (and (may Report) "app/inventory.l"))
+                  (,"Sales" (and (may Report) "app/sales.l")) )
+               (T ,"System"
+                  (,"Role Administration" (and (may RoleAdmin) "app/role.l"))
+                  (,"User Administration" (and (may UserAdmin) "app/user.l")) ) ) )
+         (<div> '(id . main) (run Prg 1)) ) ) )
+
+(de start ()
+   (setq *Url "@start")
+   (and (app) (setq *Menu 3))
+   (menu "PicoLisp App"
+      (<h2> NIL "PicoLisp App")
+      (<img> "img/7fach.gif" "7fach Logo")
+      (----)
+      (form NIL
+         (gui '(+Init +Map +TextField)
+            (cons *Ctry *Lang)
+            *Locales
+            (mapcar car *Locales)
+            ',"Language" )
+         (gui '(+Button) ',"Change"
+            '(let V (val> (field -1))
+               (locale (car V) (cdr V) "app/loc/") ) ) )
+      (form NIL
+         (<grid> 2
+            ,"Name" (gui 'nm '(+Focus +Able +TextField) '(not *Login) 20)
+            ,"Password" (gui 'pw '(+Able +PwField) '(not *Login) 20) )
+         (--)
+         (gui '(+Button) '(if *Login ,"logout" ,"login")
+            '(cond
+               (*Login (logout))
+               ((login (val> (: home nm)) (val> (: home pw)))
+                  (clr> (: home pw)) )
+               (T (err ,"Permission denied")) ) )
+         (when *Login
+            (<nbsp> 4)
+            (<span> "bold green"
+               (<big> (ht:Prin "'" (; *Login nm) ,"' logged in")) ) ) ) ) )
+
+(de stop ()
+   (logout)
+   (start) )
+
+# Search dialogs
+(de choCuSu (Dst)
+   (diaform '(Dst)
+      (<grid> "--.-.-."
+         ,"Number" (gui 'nr '(+Var +NumField) '*CuSuNr 10)
+         ,"Name" (gui 'nm '(+Focus +Var +TextField) '*CuSuNm 30)
+         ,"Phone" (gui 'tel '(+Var +TelField) '*CuSuTel 20)
+         (searchButton '(init> (: home query)))
+         ,"Zip" (gui 'plz '(+Var +TextField) '*CuSuPlz 10)
+         ,"City" (gui 'ort '(+Var +TextField) '*CuSuOrt 30)
+         ,"Mobile" (gui 'mob '(+Var +TelField) '*CuSuMob 20)
+         (resetButton '(nr nm tel plz ort mob query)) )
+      (gui 'query '(+QueryChart) (cho)
+         '(goal
+            (quote
+               @Nr (and *CuSuNr (cons @ T))
+               @Nm *CuSuNm
+               @Tel *CuSuTel
+               @Plz *CuSuPlz
+               @Ort *CuSuOrt
+               @Mob *CuSuMob
+               (select (@@)
+                  ((nr +CuSu @Nr) (nm +CuSu @Nm) (tel +CuSu @Tel)
+                     (plz +CuSu @Plz) (ort +CuSu @Ort) (mob +CuSu @Mob) )
+                  (range @Nr @@ nr)
+                  (tolr @Nm @@ nm)
+                  (fold @Tel @@ tel)
+                  (head @Plz @@ plz)
+                  (part @Ort @@ ort)
+                  (fold @Mob @@ mob) ) ) )
+         9
+         '((This) (list This (: nr) This (: nm2) (: em) (: plz) (: ort) (: tel) (: mob))) )
+      (<table> 'chart (choTtl ,"Customers/Suppliers" 'nr '+CuSu)
+         (quote
+            (btn)
+            (align "#")
+            (NIL ,"Name")
+            (NIL)
+            (NIL ,"EMail")
+            (NIL ,"Zip")
+            (NIL ,"City")
+            (NIL ,"Phone")
+            (NIL ,"Mobile") )
+         (do (cho)
+            (<row> (alternating)
+               (gui 1 '(+DstButton) Dst)
+               (gui 2 '(+NumField))
+               (gui 3 '(+ObjView +TextField) '(: nm))
+               (gui 4 '(+TextField))
+               (gui 5 '(+MailField))
+               (gui 6 '(+TextField))
+               (gui 7 '(+TextField))
+               (gui 8 '(+TelField))
+               (gui 9 '(+TelField)) ) ) )
+      (<spread>
+         (scroll (cho))
+         (newButton T Dst '(+CuSu)
+            '(nr genKey 'nr '+CuSu)
+            'nm *CuSuNm
+            'plz *CuSuPlz
+            'ort *CuSuOrt
+            'tel *CuSuTel
+            'mob *CuSuMob )
+         (cancelButton) ) ) )
+
+(de choItem (Dst)
+   (diaform '(Dst)
+      (<grid> "--.-."
+         ,"Number" (gui 'nr '(+Focus +Var +NumField) '*ItemNr 10)
+         ,"Supplier" (gui 'sup '(+Var +TextField) '*ItemSup 20)
+         (searchButton '(init> (: home query)))
+         ,"Description" (gui 'nm '(+Var +TextField) '*ItemNm 30)
+         ,"Price" (gui 'pr '(+Var +FixField) '*ItemPr 2 12)
+         (resetButton '(nr nm pr sup query)) )
+      (gui 'query '(+QueryChart) (cho)
+         '(goal
+            (quote
+               @Nr (and *ItemNr (cons @ T))
+               @Nm *ItemNm
+               @Pr (and *ItemPr (cons @ T))
+               @Sup *ItemSup
+               (select (@@)
+                  ((nr +Item @Nr) (nm +Item @Nm) (pr +Item @Pr) (nm +CuSu @Sup (sup +Item)))
+                  (range @Nr @@ nr)
+                  (part @Nm @@ nm)
+                  (range @Pr @@ pr)
+                  (tolr @Sup @@ sup nm) ) ) )
+         6
+         '((This) (list This (: nr) This (: sup) (: sup ort) (: pr))) )
+      (<table> 'chart (choTtl ,"Items" 'nr '+Item)
+         (quote
+            (btn)
+            (align "#")
+            (NIL ,"Description")
+            (NIL ,"Supplier")
+            (NIL ,"City")
+            (align ,"Price") )
+         (do (cho)
+            (<row> (alternating)
+               (gui 1 '(+DstButton) Dst)
+               (gui 2 '(+NumField))
+               (gui 3 '(+ObjView +TextField) '(: nm))
+               (gui 4 '(+ObjView +TextField) '(: nm))
+               (gui 5 '(+TextField))
+               (gui 6 '(+FixField) 2) ) ) )
+      (<spread>
+         (scroll (cho))
+         (newButton T Dst '(+Item)
+            '(nr genKey 'nr '+Item)
+            'nm *ItemNm
+            'pr *ItemPr )
+         (cancelButton) ) ) )
+
+(de choOrd (Dst)
+   (diaform '(Dst)
+      (<grid> "--.-.-."
+         ,"Number" (gui 'nr '(+Focus +Var +NumField) '*OrdNr 10)
+         ,"Customer" (gui 'cus '(+Var +TextField) '*OrdCus 20)
+         ,"City" (gui 'ort '(+Var +TextField) '*OrdOrt 20)
+         (searchButton '(init> (: home query)))
+         ,"Date" (gui 'dat '(+Var +DateField) '*OrdDat 10)
+         ,"Supplier" (gui 'sup '(+Var +TextField) '*OrdSup 20)
+         ,"Item" (gui 'item '(+Var +TextField) '*OrdItem 20)
+         (resetButton '(nr cus ort dat sup item query)) )
+      (gui 'query '(+QueryChart) (cho)
+         '(goal
+            (quote
+               @Nr (cons (or *OrdNr T))
+               @Dat (cons (or *OrdDat T))
+               @Cus *OrdCus
+               @Ort *OrdOrt
+               @Sup *OrdSup
+               @Item *OrdItem
+               (select (@@)
+                  ((nr +Ord @Nr) (dat +Ord @Dat)
+                     (nm +CuSu @Cus (cus +Ord))
+                     (ort +CuSu @Ort (cus +Ord))
+                     (nm +Item @Item (itm +Pos) ord)
+                     (nm +CuSu @Sup (sup +Item) (itm +Pos) ord) )
+                  (range @Nr @@ nr)
+                  (range @Dat @@ dat)
+                  (tolr @Cus @@ cus nm)
+                  (part @Ort @@ cus ort)
+                  (part @Item @@ pos itm nm)
+                  (tolr @Sup @@ pos itm sup nm) ) ) )
+         9
+         '((This)
+            (list This (: nr) This
+               (: cus) (: cus ort)
+               (: pos 1 itm sup) (: pos 1 itm)
+               (: pos 2 itm sup) (: pos 2 itm) ) ) )
+      (<table> 'chart (choTtl ,"Orders" 'nr '+Ord)
+         (quote
+            (btn)
+            (align "#")
+            (NIL ,"Date")
+            (NIL ,"Customer")
+            (NIL ,"City")
+            (NIL ,"Supplier" "(1)")
+            (NIL ,"Item" "(1)")
+            (NIL ,"Supplier" "(2)")
+            (NIL ,"Item" "(2)") )
+         (do (cho)
+            (<row> (alternating)
+               (gui 1 '(+DstButton) Dst)
+               (gui 2 '(+NumField))
+               (gui 3 '(+ObjView +DateField) '(: dat))
+               (gui 4 '(+ObjView +TextField) '(: nm))
+               (gui 5 '(+TextField))
+               (gui 6 '(+ObjView +TextField) '(: nm))
+               (gui 7 '(+ObjView +TextField) '(: nm))
+               (gui 8 '(+ObjView +TextField) '(: nm))
+               (gui 9 '(+ObjView +TextField) '(: nm)) ) ) )
+      (<spread>
+         (scroll (cho))
+         (newButton T Dst '(+Ord)
+            '(nr genKey 'nr '+Ord)
+            'dat (date) )
+         (cancelButton) ) ) )
+
+# vi:et:ts=3:sw=3
diff --git a/app/init.l b/app/init.l
@@ -0,0 +1,81 @@
+# 14jan10abu
+# (c) Software Lab. Alexander Burger
+
+### Role ###
+(obj ((+Role) nm "Administration") perm `*Perms)
+(obj ((+Role) nm "Accounting") perm (Customer Item Order Report Delete))
+(obj ((+Role) nm "Assistance") perm (Order))
+(commit)
+
+### User ###
+(obj ((+User) nm "admin") pw "admin" nam "Administrator" role `(db 'nm '+Role "Administration"))
+(obj ((+User) nm "ben") pw "ben" nam "Ben Affleck" role `(db 'nm '+Role "Accounting"))
+(obj ((+User) nm "jodie") pw "jodie" nam "Jodie Foster" role `(db 'nm '+Role "Accounting"))
+(obj ((+User) nm "sandy") pw "sandy" nam "Sandra Bullock" role `(db 'nm '+Role "Accounting"))
+(obj ((+User) nm "depp") pw "depp" nam "Johnny Depp" role `(db 'nm '+Role "Assistance"))
+(obj ((+User) nm "tom") pw "tom" nam "Tom Hanks" role `(db 'nm '+Role "Assistance"))
+(commit)
+
+(obj ((+Sal) nm "Department") hi "Dear Sir or Madam,")
+(obj ((+Sal) nm "Mr.") hi "Dear Mr. @1,"  sex T)
+(obj ((+Sal) nm "Mrs.") hi "Dear Mrs. @1,"  sex 0)
+(obj ((+Sal) nm "Ms.") hi "Dear Ms. @1,"  sex 0)
+(obj ((+Sal) nm "Mme") hi "Bonjour Mme @1,"  sex 0)
+(obj ((+Sal) nm "Herr") hi "Sehr geehrter Herr @1,"  sex T)
+(obj ((+Sal) nm "Herr Dr.") hi "Sehr geehrter Herr Dr. @1,"  sex T)
+(obj ((+Sal) nm "Frau") hi "Sehr geehrte Frau @1,"  sex 0)
+(obj ((+Sal) nm "Frau Dr.") hi "Sehr geehrte Frau Dr. @1,"  sex 0)
+(obj ((+Sal) nm "Señor") hi "Estimado Señor @1,"  sex T)
+(obj ((+Sal) nm "Señora") hi "Estimada Señora @1,"  sex 0)
+(commit)
+
+### Customer/Supplier ###
+(obj ((+CuSu) nr 1)
+   nm "Active Parts Inc."
+   nm2 "East Division"
+   str "Wildcat Lane"
+   plz "3425"
+   ort "Freetown"
+   tel "37 4967 6846-0"
+   fax "37 4967 68462"
+   mob "37 176 86303"
+   em "info@api.tld" )
+(obj ((+CuSu) nr 2)
+   nm "Seven Oaks Ltd."
+   str "Sunny Side Heights 202"
+   plz "1795"
+   ort "Winterburg"
+   tel "37 6295 5855-0"
+   fax "37 6295 58557"
+   em "info@7oaks.tld" )
+(obj ((+CuSu) nr 3)
+   sal `(db 'nm '+Sal "Mr.")
+   nm "Miller"
+   nm2 "Thomas Edwin"
+   str "Running Lane 17"
+   plz "1208"
+   ort "Kaufstadt"
+   tel "37 4773 82534"
+   mob "37 129 276877"
+   em "tem@shoppers.tld" )
+(commit)
+
+### Item ###
+(obj ((+Item) nr 1) nm "Main Part" sup `(db 'nr '+CuSu 1) inv 100 pr 29900)
+(obj ((+Item) nr 2) nm "Spare Part" sup `(db 'nr '+CuSu 2) inv 100 pr 1250)
+(obj ((+Item) nr 3) nm "Auxiliary Construction" sup `(db 'nr '+CuSu 1) inv 100 pr 15700)
+(obj ((+Item) nr 4) nm "Enhancement Additive" sup `(db 'nr '+CuSu 2) inv 100 pr 999)
+(obj ((+Item) nr 5) nm "Metal Fittings" sup `(db 'nr '+CuSu 1) inv 100 pr 7980)
+(obj ((+Item) nr 6) nm "Gadget Appliance" sup `(db 'nr '+CuSu 2) inv 100 pr 12500)
+(commit)
+
+### Order ###
+(let Ord (new (db: +Ord) '(+Ord) 'nr 1  'dat (date 2007 2 14)  'cus (db 'nr '+CuSu 3))
+   (put> Ord 'pos
+      (list
+         (new (db: +Pos) '(+Pos) 'itm (db 'nr '+Item 1)  'pr 29900  'cnt 1)
+         (new (db: +Pos) '(+Pos) 'itm (db 'nr '+Item 2)  'pr 1250  'cnt 8)
+         (new (db: +Pos) '(+Pos) 'itm (db 'nr '+Item 4)  'pr 999  'cnt 20) ) ) )
+(commit)
+
+# vi:et:ts=3:sw=3
diff --git a/app/inventory.l b/app/inventory.l
@@ -0,0 +1,55 @@
+# 08mar10abu
+# (c) Software Lab. Alexander Burger
+
+(must "Inventory" Report)
+
+(menu ,"Inventory"
+   (<h3> NIL ,"Inventory")
+   (form NIL
+      (<grid> "-.-"
+         ,"Number" NIL
+         (prog
+            (gui '(+Var +NumField) '*InvFrom 10)
+            (prin " - ")
+            (gui '(+Var +NumField) '*InvTill 10) )
+         ,"Description" NIL (gui '(+Var +TextField) '*InvNm 30)
+         ,"Supplier" (gui '(+ChoButton) '(choCuSu (field 1)))
+         (gui '(+Var +Obj +TextField) '*InvSup '(nm +CuSu) 30) )
+      (--)
+      (gui '(+ShowButton) NIL
+         '(csv ,"Inventory"
+            (<table> 'chart NIL
+               (<!>
+                  (quote
+                     (align)
+                     (NIL ,"Description")
+                     (align ,"Inventory")
+                     (NIL ,"Supplier")
+                     NIL
+                     (NIL ,"Zip")
+                     (NIL ,"City")
+                     (align ,"Price") ) )
+               (catch NIL
+                  (pilog
+                     (quote
+                        @Rng (cons *InvFrom (or *InvTill T))
+                        @Nm *InvNm
+                        @Sup *InvSup
+                        (select (@Item)
+                           ((nr +Item @Rng) (nm +Item @Nm) (sup +Item @Sup))
+                           (range @Rng @Item nr)
+                           (tolr @Nm @Item nm)
+                           (same @Sup @Item sup) ) )
+                     (with @Item
+                        (<row> (alternating)
+                           (<+> (: nr) This)
+                           (<+> (: nm) This)
+                           (<+> (cnt> This))
+                           (<+> (: sup nm) (: sup))
+                           (<+> (: sup nm2))
+                           (<+> (: sup plz))
+                           (<+> (: sup ort))
+                           (<-> (money (: pr))) ) )
+                     (at (0 . 10000) (or (flush) (throw))) ) ) ) ) ) ) )
+
+# vi:et:ts=3:sw=3
diff --git a/app/item.l b/app/item.l
@@ -0,0 +1,40 @@
+# 03jan09abu
+# (c) Software Lab. Alexander Burger
+
+(must "Item" Item)
+
+(menu ,"Item"
+   (ifn *ID
+      (prog
+         (<h3> NIL ,"Select" " " ,"Item")
+         (form 'dialog (choItem)) )
+      (<h3> NIL ,"Item")
+      (form NIL
+         (<h2> NIL (<id> (: nr) " -- " (: nm)))
+         (panel T (pack ,"Item" " @1") '(may Delete) '(choItem) 'nr '+Item)
+         (<grid> 4
+            ,"Number" NIL (gui '(+E/R +NumField) '(nr : home obj) 10) NIL
+            ,"Description" NIL (gui '(+E/R +Cue +TextField) '(nm : home obj) ,"Item" 30) NIL
+            ,"Supplier" (gui '(+ChoButton) '(choCuSu (field 1)))
+            (gui '(+E/R +Obj +TextField) '(sup : home obj) '(nm +CuSu) 30)
+            (gui '(+View +TextField) '(field -1 'obj 'ort) 30)
+            ,"Inventory" NIL (gui '(+E/R +NumField) '(inv : home obj) 12)
+            (gui '(+View +NumField) '(cnt> (: home obj)) 12)
+            ,"Price" NIL (gui '(+E/R +FixField) '(pr : home obj) 2 12) )
+         (--)
+         (<grid> 2
+            ,"Memo" (gui '(+BlobField) '(txt : home obj) 60 8)
+            ,"Picture"
+            (prog
+               (gui '(+Able +UpField) '(not (: home obj jpg)) 30)
+               (gui '(+Button) '(if (: home obj jpg) ,"Uninstall" ,"Install")
+                  '(if (: home obj jpg)
+                     (ask ,"Uninstall Picture?"
+                        (put!> (: home top 1 obj) 'jpg NIL) )
+                     (let? F (val> (field -1))
+                        (blob! (: home obj) 'jpg (tmp F)) ) ) ) ) )
+         (<spread> NIL (editButton T))
+         (when (: obj jpg)
+            (<img> (allow (blob (: obj) 'jpg)) ,"Picture") ) ) ) )
+
+# vi:et:ts=3:sw=3
diff --git a/app/lib.l b/app/lib.l
@@ -0,0 +1,62 @@
+# 22jan08abu
+# (c) Software Lab. Alexander Burger
+
+### PDF-Print ###
+(dm (ps> . +Ord) ()
+   (a4)
+   (font (12 . "Helvetica"))
+   (eps "img/7fach.eps" 340 150 75)
+   (window 380 120 120 30
+      (font (21 . "Times-Roman") (ps ,"Order" 0)) )
+   (brief NIL 8 "7fach GmbH, Bawaria"
+      (ps)
+      (with (: cus)
+         (ps
+            (pack
+               (and (: sal) (pack (: sal nm) " "))
+               (: nm2) " " (: nm) ) )
+         (ps (: str))
+         (ps (pack (: plz) " " (: ort))) ) )
+   (window 360 280 240 60
+      (let Fmt (80 12 60)
+         (table Fmt ,"Customer" ":" (ps (: cus nr)))
+         (table Fmt ,"Order" ":" (ps (: nr)))
+         (table Fmt ,"Date" ":" (ps (datStr (: dat)))) ) )
+   (down 360)
+   (indent 60 60)
+   (let (Page 1  Fmt (14 6 200 80 80 80))
+      (width "0.5"
+         (hline 0 470 -8)
+         (font "Helvetica-Bold"
+            (table Fmt NIL NIL
+               (ps ,"Item")
+               (ps ,"Price" T)
+               (ps ,"Quantity" T)
+               (ps ,"Total" T) ) )
+         (hline 4 470 -8)
+         (pages 720
+            (hline 0 470 -8)
+            (down 12)
+            (font 9 (ps (text ,"Continued on page @1" (inc 'Page))))
+            (page T)
+            (eps "img/7fach.eps" 340 150 75)
+            (down 40)
+            (font 9 (ps (text ,"Page @1" Page)))
+            (down 80)
+            (hline 0 470 -8) )
+         (for (I . This) (: pos)
+            (down 4)
+            (table Fmt
+               (ps I T) NIL
+               (ps (: itm nm))
+               (ps (money (: pr)) T)
+               (ps (: cnt) T)
+               (ps (money (sum> This)) T) ) )
+         (pages)
+         (hline 4 470 -8)
+         (down 4)
+         (table Fmt NIL NIL NIL NIL NIL (ps (money (sum> This)) T))
+         (hline 4 470 -8) ) )
+   (page) )
+
+# vi:et:ts=3:sw=3
diff --git a/app/loc/ar b/app/loc/ar
@@ -0,0 +1,5 @@
+# 26aug09art
+# Armadillo <tc.rucho@gmail.com>
+
+T "@app/loc/es"
+"Mobile" "Celular"
diff --git a/app/loc/ch b/app/loc/ch
@@ -0,0 +1,4 @@
+# 10may08abu
+# (c) Software Lab. Alexander Burger
+
+T "app/loc/de"
diff --git a/app/loc/de b/app/loc/de
@@ -0,0 +1,86 @@
+# 09may08abu
+# (c) Software Lab. Alexander Burger
+
+"(@1 Positions)" "(@1 Positionen)"
+
+"Address" "Adresse"
+
+"Can't print order" "Beleg kann nicht gedruckt werden"
+"Change" "Ändern"
+"City" "Ort"
+"Contact" "Kontakt"
+"Continued on page @1" "Fortsetzung auf Seite @1"
+"Country" "Land"
+"Customer" "Kunde"
+"Customer/Supplier" "Kunde/Lieferant"
+"Customers/Suppliers" "Kunden/Lieferanten"
+
+"Data" "Daten"
+"Date" "Datum"
+"Dear Sir or Madam," "Sehr geehrte Damen und Herren,"
+"Description" "Bezeichnung"
+
+"eMail" "eMail"
+
+"Fax" "Fax"
+"Full Name" "Vollständiger Name"
+
+"Greeting" "Gruß"
+
+"Home" "Startseite"
+
+"Incomplete customer address" "Unvollständige Kundenadresse"
+"Install" "Installieren"
+"Inventory" "Lagerbestand"
+"Item" "Artikel"
+"Items" "Artikel"
+
+"Login Name" "Login-Name"
+
+"Memo" "Memo"
+"Mobile" "Mobil"
+
+"Name" "Name"
+"Name 2" "Name 2"
+"No customer" "Kunde fehlt"
+"No customer name" "Kundenname fehlt"
+"No customer number" "Kundennummer fehlt"
+"No item description" "Artikelbezeichnung fehlt"
+"No item number" "Artikelnummer fehlt"
+"No order date" "Belegdatum fehlt"
+"No order number" "Belegnummer fehlt"
+"No positions" "Keine Positionen"
+"Number" "Nummer"
+
+"Order" "Bestellung"
+"Orders" "Bestellungen"
+
+"Page @1" "Seite @1"
+"PDF-Print" "PDF-Druck"
+"Phone" "Telefon"
+"Picture" "Bild"
+"Position without item" "Position ohne Artikel"
+"Position without price" "Position ohne Preis"
+"Position without quantity" "Position ohne Menge"
+"Price" "Preis"
+
+"Quantity" "Menge"
+
+"Report" "Auswertung"
+"Role Administration" "Rollenverwaltung"
+
+"Sales" "Verkauf"
+"Salutation" "Anrede"
+"Salutations" "Anreden"
+"Sex" "Geschlecht"
+"Street" "Straße"
+"Supplier" "Lieferant"
+"System" "System"
+
+"Total" "Gesamt"
+
+"Uninstall" "De-installieren"
+"Uninstall Picture?" "Bild de-installieren?"
+"User Administration" "Benutzerverwaltung"
+
+"Zip" "PLZ"
diff --git a/app/loc/es b/app/loc/es
@@ -0,0 +1,86 @@
+# 20aug09art
+# Armadillo <tc.rucho@gmail.com>
+
+"(@1 Positions)" "(@1 Posiciones)"
+
+"Address" "Dirección"
+
+"Can't print order" "No se puede imprimir la órden"
+"Change" "Cambiar"
+"City" "Ciudad"
+"Contact" "Contacto"
+"Continued on page @1" "Continuado en la página @1"
+"Country" "País"
+"Customer" "Cliente"
+"Customer/Supplier" "Cliente/Proveedor"
+"Customers/Suppliers" "Clientes/Proveedores"
+
+"Data" "Datos"
+"Date" "Fecha"
+"Dear Sir or Madam," "Estimado/a Sr/a,"
+"Description" "Descripción"
+
+"eMail" "eMail"
+
+"Fax" "Fax"
+"Full Name" "Nombre Completo"
+
+"Greeting" "Saludos"
+
+"Home" "Inicio"
+
+"Incomplete customer address" "Dirección del cliente incompleta"
+"Install" "Instalar"
+"Inventory" "Inventario"
+"Item" "Artículo"
+"Items" "Artículos"
+
+"Login Name" "Nombre de usuario"
+
+"Memo" "Memo"
+"Mobile" "Móbil"
+
+"Name" "Nombre"
+"Name 2" "Segundo nombre"
+"No customer" "No cliente"
+"No customer name" "Nombre de cliente indefinido"
+"No customer number" "Número de cliente indefinido"
+"No item description" "Descripción de artículo indefinida"
+"No item number" "Número de artículo no definido"
+"No order date" "Fecha de órden, indefinida"
+"No order number" "Número de órden indefinido"
+"No positions" "Posiciones indefinidas"
+"Number" "Número"
+
+"Order" "Orden"
+"Orders" "Órdenes"
+
+"Page @1" "Página @1"
+"PDF-Print" "Imprimir-PDF"
+"Phone" "Teléfono"
+"Picture" "Foto"
+"Position without item" "Posición sin artículo"
+"Position without price" "Posición sin precio"
+"Position without quantity" "Posición sin cantidad"
+"Price" "Precio"
+
+"Quantity" "Cantidad"
+
+"Report" "Reporte"
+"Role Administration" "Administración de roles"
+
+"Sales" "Ventas"
+"Salutation" "Saludo"
+"Salutations" "Saludos"
+"Sex" "Género"
+"Street" "Calle"
+"Supplier" "Proveedor"
+"System" "Sistema"
+
+"Total" "Total"
+
+"Uninstall" "Desinstalar"
+"Uninstall Picture?" "Desinstalar foto?"
+"User Administration" "Administración de usuarios"
+
+"Zip" "Código Postal"
diff --git a/app/loc/jp b/app/loc/jp
@@ -0,0 +1,86 @@
+# 09may08abu
+# (c) Software Lab. Alexander Burger
+
+"(@1 Positions)" "(ポジション数：@1)"
+
+"Address" "住所"
+
+"Can't print order" "注文書の印刷ができない"
+"Change" "変換"
+"City" "都市"
+"Contact" "問い合わせ"
+"Continued on page @1" "@1ページに続く"
+"Country" "国"
+"Customer" "カスタマー"
+"Customer/Supplier" "カスタマー/注文先"
+"Customers/Suppliers" "カスタマー/注文先"
+
+"Data" "データ"
+"Date" "日付"
+"Dear Sir or Madam," "拝啓,"
+"Description" "仕様"
+
+"eMail" "eメール"
+
+"Fax" "Fax"
+"Full Name" "フルネーム"
+
+"Greeting" "手紙の書きだし"
+
+"Home" "ホーム"
+
+"Incomplete customer address" "カスタマーの住所不十分"
+"Install" "インストール"
+"Inventory" "在庫目録"
+"Item" "商品"
+"Items" "商品"
+
+"Login Name" "ログイン名"
+
+"Memo" "メモ"
+"Mobile" "携帯電話"
+
+"Name" "名前"
+"Name 2" "名前 2"
+"No customer" "カスタマーなし"
+"No customer name" "カスタマー名なし"
+"No customer number" "カスタマー番号なし"
+"No item description" "商品仕様なし"
+"No item number" "商品番号なし"
+"No order date" "注文書日付なし"
+"No order number" "注文番号なし"
+"No positions" "ポジションなし"
+"Number" "番号"
+
+"Order" "注文"
+"Orders" "注文"
+
+"Page @1" "@1 ページ"
+"PDF-Print" "PDF印刷"
+"Phone" "電話番号"
+"Picture" "写真"
+"Position without item" "ポジションに商品がない"
+"Position without price" "ポジションに価格がない"
+"Position without quantity" "ポジションに数量がない"
+"Price" "価格"
+
+"Quantity" "数量"
+
+"Report" "レポート"
+"Role Administration" "役割管理"
+
+"Sales" "セールス"
+"Salutation" "敬称"
+"Salutations" "敬称"
+"Sex" "性別"
+"Street" "住所"
+"Supplier" "注文先"
+"System" "システム"
+
+"Total" "総計"
+
+"Uninstall" "アンインストール"
+"Uninstall Picture?" "写真をアンインストールしますか？"
+"User Administration" "ユーザー管理"
+
+"Zip" "郵便番号"
diff --git a/app/loc/no b/app/loc/no
@@ -0,0 +1,86 @@
+# 14jan10jk
+# Jon Kleiser, jon.kleiser@usit.uio.no
+
+"(@1 Positions)" "(@1 Posisjoner)"
+
+"Address" "Adresse"
+
+"Can't print order" "Kan ikke skrive ut bestilling"
+"Change" "Endre"
+"City" "By"
+"Contact" "Kontakt"
+"Continued on page @1" "Fortsettes på side @1"
+"Country" "Land"
+"Customer" "Kunde"
+"Customer/Supplier" "Kunde/Leverandør"
+"Customers/Suppliers" "Kunder/Leverandører"
+
+"Data" "Data"
+"Date" "Dato"
+"Dear Sir or Madam," "Kjære frue/herre,"
+"Description" "Beskrivelse"
+
+"eMail" "e-post"
+
+"Fax" "Fax"
+"Full Name" "Fullt navn"
+
+"Greeting" "Hilsen"
+
+"Home" "Startside"
+
+"Incomplete customer address" "Ufullstendig kundeadresse"
+"Install" "Installer"
+"Inventory" "Lagerbeholdning"
+"Item" "Artikkel"
+"Items" "Artikler"
+
+"Login Name" "Innloggingsnavn"
+
+"Memo" "Merknad"
+"Mobile" "Mobil"
+
+"Name" "Navn"
+"Name 2" "Navn 2"
+"No customer" "Kunde mangler"
+"No customer name" "Kundenavn mangler"
+"No customer number" "Kundenummer mangler"
+"No item description" "Artikkelbeskrivelse mangler"
+"No item number" "Artikkelnummer mangler"
+"No order date" "Bestillingsdato mangler"
+"No order number" "Bestillingsnummer mangler"
+"No positions" "Ingen posisjoner"
+"Number" "Nummer"
+
+"Order" "Bestilling"
+"Orders" "Bestillinger"
+
+"Page @1" "Side @1"
+"PDF-Print" "PDF-utskrift"
+"Phone" "Telefon"
+"Picture" "Bilde"
+"Position without item" "Posisjon uten artikkel"
+"Position without price" "Posisjon uten pris"
+"Position without quantity" "Posisjon uten antall"
+"Price" "Pris"
+
+"Quantity" "Antall"
+
+"Report" "Rapport"
+"Role Administration" "Rolle-administrasjon"
+
+"Sales" "Salg"
+"Salutation" "Titulering"
+"Salutations" "Tituleringer"
+"Sex" "Kjønn"
+"Street" "Gate"
+"Supplier" "Leverandør"
+"System" "System"
+
+"Total" "Total"
+
+"Uninstall" "Av-installer"
+"Uninstall Picture?" "Av-installere bilde?"
+"User Administration" "Bruker-administrasjon"
+
+"Zip" "Postnr."
diff --git a/app/loc/ru b/app/loc/ru
@@ -0,0 +1,86 @@
+# 25apr08
+# Mansur Mamkin <mmamkin@mail.ru>
+
+"(@1 Positions)" "(@1 позиций)"
+
+"Address" "Адрес"
+
+"Can't print order" "Невозможно напечатать заказ"
+"Change" "Изменить"
+"City" "Город"
+"Contact" "Контакт"
+"Continued on page @1" "Продолжение на странице @1"
+"Country" "Страна"
+"Customer" "Покупатель"
+"Customer/Supplier" "Покупатель/Поставщик"
+"Customers/Suppliers" "Покупатели/Поставщики"
+
+"Data" "Данные"
+"Date" "Дата"
+"Dear Sir or Madam," "Уважаемый(ая)"
+"Description" "Описание"
+
+"eMail" "емейл"
+
+"Fax" "Факс"
+"Full Name" "Полное имя"
+
+"Greeting" "Приветствие"
+
+"Home" "Домой"
+
+"Incomplete customer address" "Неполный адрес покупателя"
+"Install" "Установить"
+"Inventory" "Инвентаризация"
+"Item" "Товар"
+"Items" "Товары"
+
+"Login Name" "Имя регистрации"
+
+"Memo" "Мемо"
+"Mobile" "Мобильный"
+
+"Name" "Имя"
+"Name 2" "Имя 2"
+"No customer" "Нет покупателя"
+"No customer name" "Нет имени покупателя"
+"No customer number" "Нет номера покупателя"
+"No item description" "Нет описания товара"
+"No item number" "Нет номера товара"
+"No order date" "Нет даты заказа"
+"No order number" "Нет номера заказа"
+"No positions" "Нет позиций"
+"Number" "Номер"
+
+"Order" "Заказ"
+"Orders" "Заказы"
+
+"Page @1" "Страница @1"
+"PDF-Print" "Печать PDF"
+"Phone" "Телефон"
+"Picture" "Картинка"
+"Position without item" "Позиция без товара"
+"Position without price" "Позиция без цены"
+"Position without quantity" "Позиция без количества"
+"Price" "Цена"
+
+"Quantity" "Количество"
+
+"Report" "Отчет"
+"Role Administration" "Управление ролями"
+
+"Sales" "Продажи"
+"Salutation" "Приветствие"
+"Salutations" "Приветствия"
+"Sex" "Пол"
+"Street" "Улица"
+"Supplier" "Поставщик"
+"System" "Система"
+
+"Total" "Всего"
+
+"Uninstall" "Удалить"
+"Uninstall Picture?" "Удалить картинку?"
+"User Administration" "Управление пользователями"
+
+"Zip" "Индекс"
diff --git a/app/main.l b/app/main.l
@@ -0,0 +1,61 @@
+# 14jan10abu
+# (c) Software Lab. Alexander Burger
+
+(allowed ("app/" "img/")
+   "@start" "@stop" "favicon.ico" "lib.css" "@psh" )
+
+(load "lib/http.l" "lib/xhtml.l" "lib/form.l" "lib/ps.l" "lib/adm.l")
+
+(setq
+   *Scl 2
+   *Css "lib.css"
+   *Blob "blob/app/" )
+
+(load "app/er.l" "app/lib.l" "app/gui.l")
+
+(permission
+   Customer    ,"Customer"
+   Item        ,"Item"
+   Order       ,"Order"
+   Report      ,"Report"
+   RoleAdmin   ,"Role Administration"
+   UserAdmin   ,"User Administration"
+   Password    ,"Password"
+   Delete      ,"Delete" )
+
+(de *Locales
+   ("English" NIL)
+   ("English (US)" "US")
+   ("English (UK)" "UK")
+   ("Español (AR)" "AR" . "ar")
+   ("Español (ES)" "ES" . "es")
+   ("Deutsch (DE)" "DE" . "de")
+   ("Deutsch (CH)" "CH" . "ch")
+   ("Norsk" "NO" . "no")
+   ("Русский" "RU" . "ru")
+   ("日本語" "JP" . "jp") )
+
+# Entry point
+(de main ()
+   (call 'mkdir "-p" "db/app/" *Blob)
+   (pool "db/app/" *Dbs)
+   (unless (seq *DB)
+      (load "app/init.l") ) )
+
+(de go ()
+   (pw 12)
+   (task (port 4040)  # Set up query server in the background
+      (let? Sock (accept @)
+         (unless (fork)  # Child process
+            (in Sock
+               (while (rd)
+                  (sync)
+                  (out Sock
+                     (pr (eval @)) ) ) )
+            (bye) )
+         (close Sock) ) )
+   (forked)
+   (rollback)
+   (server 8080 "@start") )
+
+# vi:et:ts=3:sw=3
diff --git a/app/ord.l b/app/ord.l
@@ -0,0 +1,58 @@
+# 03sep09abu
+# (c) Software Lab. Alexander Burger
+
+(must "Order" Order)
+
+(menu ,"Order"
+   (ifn *ID
+      (prog
+         (<h3> NIL ,"Select" " " ,"Order")
+         (form 'dialog (choOrd)) )
+      (<h3> NIL ,"Order")
+      (form NIL
+         (<h2> NIL (<id> (: nr)))
+         (panel T (pack ,"Order" " @1") '(may Delete) '(choOrd) 'nr '+Ord)
+         (<grid> 4
+            ,"Date" NIL
+            (gui '(+E/R +DateField) '(dat : home obj) 10)
+            (gui '(+View +TextField)
+               '(text ,"(@1 Positions)" (length (: home obj pos))) )
+            ,"Customer" (gui '(+ChoButton) '(choCuSu (field 1)))
+            (gui '(+E/R +Obj +TextField) '(cus : home obj) '(nm +CuSu) 30)
+            (gui '(+View +TextField) '(field -1 'obj 'ort) 30) )
+         (--)
+         (gui '(+Set +E/R +Chart) '((L) (filter bool L)) '(pos : home obj) 8
+            '((Pos I)
+               (with Pos
+                  (list I NIL (: itm) (or (: pr) (: itm pr)) (: cnt) (sum> Pos)) ) )
+            '((L D)
+               (cond
+                  (D
+                     (put!> D 'itm (caddr L))
+                     (put!> D 'pr (cadddr L))
+                     (put!> D 'cnt (; L 5))
+                     (and (; D itm) D) )
+                  ((caddr L)
+                     (new! '(+Pos) 'itm (caddr L)) ) ) ) )
+         (<table> NIL NIL
+            '((align) (btn) (NIL ,"Item") (NIL ,"Price") (NIL ,"Quantity") (NIL ,"Total"))
+            (do 8
+               (<row> NIL
+                  (gui 1 '(+NumField))
+                  (gui 2 '(+ChoButton) '(choItem (field 1)))
+                  (gui 3 '(+Obj +TextField) '(nm +Item) 30)
+                  (gui 4 '(+FixField) 2 12)
+                  (gui 5 '(+NumField) 8)
+                  (gui 6 '(+Sgn +Lock +FixField) 2 12)
+                  (gui 7 '(+DelRowButton))
+                  (gui 8 '(+BubbleButton)) ) )
+            (<row> NIL NIL NIL (scroll 8 T) NIL NIL
+               (gui '(+Sgn +View +FixField) '(sum> (: home obj)) 2 12) ) )
+         (<spread>
+            (gui '(+Rid +Button) ,"PDF-Print"
+               '(if (check> (: home obj))
+                  (note ,"Can't print order" (uniq @))
+                  (psOut 0 ,"Order" (ps> (: home obj))) ) )
+            (editButton T) ) ) ) )
+
+# vi:et:ts=3:sw=3
diff --git a/app/role.l b/app/role.l
@@ -0,0 +1,33 @@
+# 22apr10abu
+# (c) Software Lab. Alexander Burger
+
+(must "Role Administration" RoleAdmin)
+
+(menu ,"Role Administration"
+   (ifn *ID
+      (prog
+         (<h3> NIL ,"Select" " " ,"Role")
+         (form 'dialog (choDlg NIL ,"Roles" '(nm +Role))) )
+      (<h3> NIL ,"Role Administration")
+      (form NIL
+         (<h2> NIL (<id> (: nm)))
+         (panel T (pack ,"Role" " '@1'") '(may Delete) '(choDlg NIL ,"Roles" '(nm +Role)) 'nm '+Role)
+         (gui '(+E/R +Cue +TextField) '(nm : home obj) ,"Role" 30 ,"Name")
+         (<table> NIL NIL NIL
+            (gui '(+E/R +Fmt +Chart)
+               '(perm : home obj)
+               '((Val) (mapcar '((S) (list S (memq S Val))) *Perms))
+               '((Lst) (extract '((L P) (and (cadr L) P)) Lst *Perms))
+               2 )
+            (do (length *Perms)
+               (<row> NIL
+                  (gui 1 '(+Set +TextField) '((Sym) (val (val Sym))))
+                  (gui 2 '(+Checkbox)) ) ) )
+         (gui '(+/R +Chart) '(usr : home obj) 1 list)
+         (<table> 'chart ,"User" NIL
+            (do 8
+               (<row> (alternating)
+                  (gui 1 '(+Obj +TextField) '(nm +User)) ) ) )
+         (<spread> (scroll 8 T) (editButton T)) ) ) )
+
+# vi:et:ts=3:sw=3
diff --git a/app/sal.l b/app/sal.l
@@ -0,0 +1,21 @@
+# 03jan09abu
+# (c) Software Lab. Alexander Burger
+
+(must "Salutation" Customer)
+
+(menu ,"Salutation"
+   (ifn *ID
+      (prog
+         (<h3> NIL ,"Select" " " ,"Salutation")
+         (form 'dialog (choDlg NIL ,"Salutations" '(nm +Sal))) )
+      (<h3> NIL ,"Salutation")
+      (form NIL
+         (<h2> NIL (<id> (: nm)))
+         (panel T (pack ,"Salutation" " '@1'") '(may Delete) '(choDlg NIL ,"Salutations" '(nm +Sal)) 'nm '+Sal)
+         (<grid> 2
+            ,"Salutation" (gui '(+E/R +Cue +TextField) '(nm : home obj) ,"Salutation" 40)
+            ,"Greeting" (gui '(+E/R +TextField) '(hi : home obj) 40)
+            ,"Sex" (gui '(+E/R +SexField) '(sex : home obj)) )
+         (<spread> NIL (editButton T)) ) ) )
+
+# vi:et:ts=3:sw=3
diff --git a/app/sales.l b/app/sales.l
@@ -0,0 +1,56 @@
+# 08mar10abu
+# (c) Software Lab. Alexander Burger
+
+(must "Sales" Report)
+
+(menu ,"Sales"
+   (<h3> NIL ,"Sales")
+   (form NIL
+      (<grid> "-.-"
+         ,"Date" NIL
+         (prog
+            (gui '(+Var +DateField) '*SalFrom 10)
+            (prin " - ")
+            (gui '(+Var +DateField) '*SalTill 10) )
+         ,"Customer" (gui '(+ChoButton) '(choCuSu (field 1)))
+         (gui '(+Var +Obj +TextField) '*SalCus '(nm +CuSu) 30) )
+      (--)
+      (gui '(+ShowButton) NIL
+         '(csv ,"Sales"
+            (<table> 'chart NIL
+               (<!>
+                  (quote
+                     (align)
+                     (NIL ,"Date")
+                     (NIL ,"Customer")
+                     NIL
+                     (NIL ,"Zip")
+                     (NIL ,"City")
+                     (align ,"Total") ) )
+               (catch NIL
+                  (let Sum 0
+                     (pilog
+                        (quote
+                           @Rng (cons *SalFrom (or *SalTill T))
+                           @Cus *SalCus
+                           (select (@Ord)
+                              ((dat +Ord @Rng) (cus +Ord @Cus))
+                              (range @Rng @Ord dat)
+                              (same @Cus @Ord cus) ) )
+                        (with @Ord
+                           (let N (sum> This)
+                              (<row> (alternating)
+                                 (<+> (: nr) This)
+                                 (<+> (datStr (: dat)) This)
+                                 (<+> (: cus nm) (: cus))
+                                 (<+> (: cus nm2))
+                                 (<+> (: cus plz))
+                                 (<+> (: cus ort))
+                                 (<-> (money N)) )
+                              (inc 'Sum N) ) )
+                        (at (0 . 10000) (or (flush) (throw))) )
+                     (<row> 'nil
+                        (<strong> ,"Total") - - - - -
+                        (<strong> (prin (money Sum))) ) ) ) ) ) ) ) )
+
+# vi:et:ts=3:sw=3
diff --git a/app/user.l b/app/user.l
@@ -0,0 +1,36 @@
+# 03jan09abu
+# (c) Software Lab. Alexander Burger
+
+(must "User Administration" UserAdmin)
+
+(menu ,"User Administration"
+   (ifn *ID
+      (prog
+         (<h3> NIL ,"Select" " " ,"User")
+         (form 'dialog (choDlg NIL ,"Users" '(nm +User))) )
+      (<h3> NIL ,"User Administration")
+      (form NIL
+         (<h2> NIL (<id> (: nm)))
+         (panel T (pack ,"User" " '@1'") '(may Delete) '(choDlg NIL ,"Users" '(nm +User)) 'nm '+User)
+         (<grid> 2
+            ,"Login Name" (gui '(+E/R +Cue +TextField) '(nm : home obj) ,"User" 30)
+            ,"Password"
+            (gui '(+Tip +Able +E/R +Fmt +TextField)
+               '(and (may Password) (val> This))
+               '(may Password)
+               '(pw : home obj)
+               '((V) (and V "****"))
+               '((V) (if (= V "****") (: home obj pw) V))
+               30 )
+            ,"Role"
+            (gui '(+Able +E/R +Obj +TextField)
+               '(may RoleAdmin)
+               '(role : home obj)
+               '(nm +Role)
+               T )
+            ,"Full Name" (gui '(+E/R +TextField) '(nam : home obj) 40)
+            ,"Phone" (gui '(+E/R +TelField) '(tel : home obj) 40)
+            ,"EMail" (gui '(+E/R +MailField) '(em : home obj) 40) )
+         (<spread> NIL (editButton T)) ) ) )
+
+# vi:et:ts=3:sw=3
diff --git a/bin/pil b/bin/pil
@@ -0,0 +1,2 @@
+#!/usr/bin/picolisp /usr/lib/picolisp/lib.l
+(load "@lib/misc.l" "@lib/btree.l" "@lib/db.l" "@lib/pilog.l")
diff --git a/bin/psh b/bin/psh
@@ -0,0 +1,14 @@
+#!bin/picolisp lib.l
+# 28sep07abu
+# (c) Software Lab. Alexander Burger
+
+(load "@lib/misc.l" "@lib/http.l")
+
+(raw T)
+(let *Dbg NIL
+   (client "localhost" (format (opt))
+      (pack "@psh?" (pw) "&" (in '("tty") (line T)))
+      (ctty (read))
+      (line)
+      (line) ) )
+(bye)
diff --git a/bin/replica b/bin/replica
@@ -0,0 +1,31 @@
+#!bin/picolisp lib.l
+# 21aug07abu
+# Use: bin/replica <port> <keyFile> <journal> <dbFile> <blob/app/> [dbs1 ..]
+#    : bin/ssl <host> 443 <port>/@replica <keyFile> <journal> <blob/app/> 60
+
+(load "@lib/misc.l" "@lib/http.l")
+
+(allowed NIL "@replica")
+
+(argv *Port *KeyFile *Journal *Pool *Blob . *Dbs)
+
+(setq
+   *Port (format *Port)
+   *SSLKey (in *KeyFile (line T)) )
+
+(de replica ()
+   (ctl *KeyFile
+      (protect
+         (when (= (line T) *SSLKey)
+            (let? X (line T)
+               (if (format X)
+                  (when (out (tmp 'replica) (echo @))    # Journal
+                     (prin (peek))
+                     (flush)
+                     (journal (tmp 'replica)) )
+                  (let Blob (pack *Blob X)               # Blob
+                     (call 'mkdir "-p" (dirname Blob))
+                     (out Blob (echo)) ) ) ) ) ) ) )
+
+(pool *Pool (mapcar format *Dbs) *Journal)
+(server *Port)
diff --git a/bin/scrape b/bin/scrape
@@ -0,0 +1,11 @@
+#!bin/picolisp lib.l
+# 07oct08abu
+# (c) Software Lab. Alexander Burger
+
+(load "ext.l" "dbg.l" "lib/http.l" "lib/scrape.l")
+
+(scrape
+   (or (opt) "localhost")
+   (or (format (opt)) 8080) )
+
+# vi:et:ts=3:sw=3
diff --git a/bin/watchdog b/bin/watchdog
@@ -0,0 +1,68 @@
+#!bin/picolisp lib.l
+# 09mar08abu
+# (c) Software Lab. Alexander Burger
+# Use: bin/watchdog <host> <port> <from> <to1> <to2> ..
+
+(load "@lib/misc.l")
+
+# *MailHost *MailPort *MailFrom *MailTo *Watch
+
+(argv *MailHost *MailPort *MailFrom .  *MailTo)
+(setq *MailPort (format *MailPort))
+
+(unless (call 'test "-p" "fifo/beat")
+   (call 'mkdir "-p" "fifo")
+   (call 'rm "-f" "fifo/beat")
+   (call 'mkfifo "fifo/beat") )
+
+(push1 '*Bye '(call 'rm "fifo/beat"))
+
+(de *Err
+   (prin (stamp))
+   (space)
+   (println *Watch) )
+
+(task (open "fifo/beat")
+   (in @
+      (let X (rd)
+         (cond
+            ((not X) (bye))
+            ((num? X)
+               (del (assoc X *Watch) '*Watch) )
+            ((atom X)  # bin/picolisp -"out 'fifo/beat (pr '$(tty))" -bye
+               (let D (+ (* 86400 (date T)) (time T))
+                  (out X
+                     (for W *Watch
+                        (prinl
+                           (align 5 (car W))
+                           " "
+                           (- (cadr W) D)
+                           " "
+                           (or (caddr W) "o")
+                           " "
+                           (cdddr W) ) ) ) ) )
+            ((assoc (car X) *Watch)    # X = (Pid Tim . Any)
+               (let W @                # W = (Pid Tim Flg . Any)
+                  (when (caddr W)
+                     (msg (car W) " " (stamp) " resumed") )
+                  (set (cdr W) (cadr X))
+                  (set (cddr W))
+                  (con (cddr W) (or (cddr X) (cdddr W))) ) )
+            (T (push '*Watch (list (car X) (cadr X) NIL (cddr X)))) ) ) ) )
+
+(task -54321 54321
+   (let D (+ (* 86400 (date T)) (time T))
+      (for W (filter '((X) (> D (cadr X))) *Watch)
+         (if (caddr W)
+            (prog
+               (msg (car W) " " (stamp)
+                  (if (kill (car W) 15) " killed" " gone") )
+               (del W '*Watch) )
+            (inc (cdr W) 3600)
+            (set (cddr W) T)
+            (let Sub (pack "Timeout " (car W) " " (cdddr W))
+               (msg (car W) " " (stamp))
+               (unless (mail *MailHost *MailPort *MailFrom *MailTo Sub)
+                  (msg (cons Sub *MailTo) " mail failed " (stamp)) ) ) ) ) ) )
+
+(wait)
diff --git a/cygwin/README b/cygwin/README
@@ -0,0 +1,170 @@
+Porting PicoLisp to Cygwin
+
+A few months back, I was looking at Lisp programming language
+offerings for the MS Windows environment. I want an interpreter
+that is fast and powerful, yet small. I want it to work well in
+the Cygwin/Win32 environment.
+
+Enter PicoLisp. http://software-lab.de/down.html
+
+According to the PicoLisp FAQ, "PicoLisp is for programmers
+who want to control their programming environment, at all
+levels, from the application domain down to the bare metal."
+Yes! That's part of what I want a Lisp for. Especially a Lisp I
+might embed in other applications. I want control. PicoLisp
+looked promising.
+
+PicoLisp is designed with a philosophy of "succinctness",
+according to the literature on the site. Although there are
+even smaller Lisp interpreters available, PicoLisp seemed to
+strike a balance between terseness and functionality.
+
+PicoLisp is written using standard C, and the author
+(Alexander Burger) distributes it as C source code under the
+GNU General Public License. That means if you want to use
+PicoLisp, you'll need to compile it yourself, or otherwise obtain
+the executables. PicoLisp comes in two flavours: picolisp, and
+an even smaller version: mini picolisp. (More about mini
+picolisp in a bit.)
+
+When you do build PicoLisp for yourself, you'll get a
+powerhouse of a Lisp including APIs for building web servers,
+gui web application servers (for browser clients running java
+and/or javascript) integrated relational databases, prolog db
+access, and much more. PicoLisp even comes with two example
+versions of a flight simulator: one which runs under X-Windows,
+the other which uses a client's browser/java for the display.
+There's a chess game written in PicoLisp and Prolog.
+
+Lest one think that PicoLisp is a mere toy, consider this. In
+2006, PicoLisp won second prize in the German-language C't
+Magazine database contest, beating entries written using DB2
+and Oracle. Industrial-strength databases with tightly
+integrated web applications have been crafted with PicoLisp.
+http://tinyurl.com/y9wu39
+
+PicoLisp has some drawbacks and limitations. As the FAQ warns,
+PicoLisp "does not pretend to be easy to learn." It is not a
+Common Lisp flavor. It is not "some standard, 'safe' black-box,
+which may be easier to learn."  Also, for my purposes, I want
+software that runs not only on Linux, but also on PCs with the
+MS-Windows operating systems. And there was the rub: PicoLisp
+isn't distributed with binaries or Windows exe files.
+
+Even worse (for Windows users), PicoLisp wasn't ported to
+Cygwin. I have a growing list of portable apps that will run on
+a flash drive, many of them I compiled from source from using
+Cygwin tools like make, gcc, etc.
+
+Cygwin provides a POSIX emulation layer in the form of
+cygwin1.dll and other libraries. This lets a PC running Windows
+look like much like a Linux or UNIX box to programs which have
+been compiled for Cygwin.  I'd compiled hundreds of programs
+for Cygwin and here was PicoLisp which I wanted to have
+running on all my PCs, Linux ones as well as the MS-Windows
+PCs, too.
+
+So this was beginning to look like a challenge. I'd just take a
+little peek at porting PicoLisp to Cygwin, and see how it
+would go. I'd ported everything from sox to busybox to fluxbox
+to Cygwin, so I felt ready for porting PicoLisp.
+
+PicoLisp comes in two flavors. Mini picolisp and full
+picolisp.
+
+Mini PicoLisp is a kind of a "pure" PicoLisp without
+system-dependent functions like databases, UTF-8, bignums, IPC,
+and networking. This seemed like a good place to start my
+PicoLisp porting adventures. I first tried a straight Cygwin/gcc
+build, and that worked fine, no hitches.
+
+Then I remembered the -mno-cygwin compiler flag for Cygwin's
+gcc. When you compile with -mno-cygwin, gcc causes the
+resulting executable to be built without Cygwin dll library
+dependances. For C code that relies heavily upon the POSIX
+emulation aspects of Cygwin, this might not work. But why not
+try building mini picolisp with the -mno-cygwin option?
+
+The C code for mini picolisp is free from Linux/POSIX system
+calls, and it compiled with no problems using -mno-cygwin. It
+produced a mini picolisp exe file of about 73K, which is not
+dependant upon any Cygwin DLLs.
+
+Porting the full PicoLisp interpreter proved to be more of a
+challenge. Whereas the mini picolisp was careful to avoid Linux
+system calls, PicoLisp takes the opposite approach and uses
+Linux (UNIX/POSIX) system functions where needed.
+
+Additionally, PicoLisp has the ability to dynamically load
+shared libraries for various extensions.
+
+Since we need to use shared libraries anyway, I wanted for all
+of picolisp to go into a single DLL.  Then the picolisp exe
+would be a just small stub that uses that the shared library,
+picolisp.dll. PicoLisp applications often use fork, so this
+should also be more efficient when forking.
+
+Splitting up PicoLisp this way (a DLL and an exe stub) would
+allow the picolisp.dll to be used as a Lisp library. As a
+shared library, it would then be possible for other
+applications to treat PicoLisp as an embedded interpreter,
+somewhat like librep, but much smaller and more portable.
+
+Wanting to see how much I could squeeze down the size of the
+executables and libraries under Cygwin, I used gcc's -Os
+option, which requests that gcc optimize by making the smallest
+possible code. Doing this resulted in a picolisp dll of just
+150K, and a picolisp exe stub of only 2K.
+
+Of course, if you want this full PicoLisp to run on a Windows
+PC which does not already have Cygwin installed, you'll need to
+obtain a few Cygwin DLLs which provide the POSIX emulation
+layer for PicoLisp.
+
+For the most part, the port to Win32/Cygwin went smoothly.
+There were just a few differences between Linux and Cygwin that
+were handled with macro ifdef statements in the C code that
+allow something to be done differently for the Cygwin
+compilation.
+
+In the end it turned out that the biggest problem was the fcntl
+system function that does file and record locking. This was
+especially frustrating, as time and time again, I thought I'd
+found a solution or a work-around to the differences in
+semantics of the fcntl call between Linux and Cygwin, only to
+have the my "solution" fail with more rigorous testing.
+
+The locking problem was finally just circumvented for Windows
+by simply not using fcntl locking. So, there is no file or
+record locking for PicoLisp running under Windows. (See the
+locking notes in http://www.sqlite.org/lockingv3.html for
+another perspective on locking system functions in Windows.)
+However, all the example applications run fine, running in a
+special (Solo) mode in PicoLisp, in the few places it even
+matters. This avoids depending on buggy or non-existent record
+locking functionality with the various Windows versions and
+file system types.
+
+So, what do we have at this point? PicoLisp is running on the
+PC. A working, industrial-strength Lisp interpreter is
+PicoLisp, ready for writing applications that are succinct yet
+powerful. PicoLisp comes with a Prolog interpreter and
+relational databases and flight simulators and chess games and
+web servers and chat servers and sendmail and much more.
+
+And PicoLisp itself is written in highly portable C, running
+on Linux and Windows. PicoLisp is readily embedable, and will
+be useful to add scripting languages (Lisp, Prolog) to other
+applications, either statically linked, or as a shared library
+(DLL).
+
+PicoLisp is a little dynamo. It even has the ability to use
+in-line C code which is compiled on-the-fly into a shared
+library. This in-line C ability uses gcc. (And it works with
+tcc, the Tiny C Compiler, too.)
+
+With the tremendous number of PCs out there now able to run
+PicoLisp, watch out! PicoLisp may be small, but sometimes
+very powerful things come in small packages.
+
+Doug Snead, Jan. 2007
diff --git a/cygwin/tcc.l b/cygwin/tcc.l
@@ -0,0 +1,22 @@
+# 21jan07abu
+# (c) Software Lab. Alexander Burger
+
+# use the Tiny C Compiler http://fabrice.bellard.free.fr/tcc
+(de tcc (S L . @)
+   (out (tmp S ".c")
+      (chdir '@ (prinl "#include <pico.h>"))
+      (here "/**/") )
+   (apply call L 'tcc "-shared" "-rdynamic"
+      (pack "-I" (dospath "/usr/include"))
+      (pack "-I" (dospath (path "@/src")))
+      "-falign-functions" "-fomit-frame-pointer"
+      "-W" "-Wimplicit" "-Wreturn-type" "-Wunused" "-Wformat"
+      "-Wuninitialized" "-Wstrict-prototypes" "-pipe"
+      "-D_GNU_SOURCE" "-D_FILE_OFFSET_BITS=64" "-DNOWAIT"
+      "-o" (tmp S ".dll") (tmp S ".c")
+      (dospath (path "@/bin/picolisp.def")))
+   (while (args)
+      (def (next) (def (tmp S ': (arg)))) ) )
+
+(de dospath (p)
+   (in '("cygpath" "-m" p) (line T)) )
diff --git a/dbg b/dbg
@@ -0,0 +1,2 @@
+#!/bin/sh
+exec ${0%/*}/bin/picolisp -"on *Dbg" ${0%/*}/lib.l @ext.l @dbg.l "$@"
diff --git a/dbg.l b/dbg.l
@@ -0,0 +1,16 @@
+# 14apr10abu
+# (c) Software Lab. Alexander Burger
+
+(on *Dbg)
+
+(when (sys "TERM")
+   (setq *Tsm
+      (cons
+         (in '("tput" "smul") (line T))
+         (in '("tput" "rmul") (line T)) ) ) )
+
+(load "@lib/debug.l" "@lib/led.l" "@lib/edit.l" "@lib/lint.l" "@lib/sq.l")
+
+(noLint 'later (loc "@Prg" later))
+
+# vi:et:ts=3:sw=3
diff --git a/doc/app.html b/doc/app.html
@@ -0,0 +1,2551 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN" "http://www.w3.org/TR/1998/REC-html40-19980424/loose.dtd">
+<html lang="en">
+<head>
+<meta http-equiv="Content-Type" content="text/html; charset=utf-8">
+<title>PicoLisp Application Development</title>
+<link rel="stylesheet" href="doc.css" type="text/css">
+</head>
+<body>
+<a href="mailto:abu@software-lab.de">abu@software-lab.de</a>
+
+<h1>PicoLisp Application Development</h1>
+
+<p align=right>(c) Software Lab. Alexander Burger
+
+<p>This document presents an introduction to writing browser-based applications
+in PicoLisp.
+
+<p>It concentrates on the XHTML/CSS GUI-Framework (as opposed to the previous
+Java-AWT, Java-Swing and Plain-HTML frameworks), which is easier to use, more
+flexible in layout design, and does not depend on plug-ins, JavaScript or
+cookies.
+
+<p>A plain HTTP/HTML GUI has various advantages: It runs on any browser, and can
+be fully driven by scripts ("lib/scrape.l").
+
+<p>To be precise: CSS <i>can</i> be used to enhance the layout. And browsers
+<i>with</i> JavaScript will respond faster and smoother. But this framework
+works just fine in browsers which do not know anything about CSS or JavaScript.
+All examples were also tested using the w3m text browser.
+
+<p>For basic informations about the PicoLisp system please look at the <a
+href="ref.html">PicoLisp Reference</a> and the <a href="tut.html">PicoLisp
+Tutorial</a>. Knowledge of HTML, and a bit of CSS and HTTP is assumed.
+
+<p>Throughout this document, transient symbols will be displayed with <code><a
+href="refT.html#*Tsm">*Tsm</a></code> turned off, i.e. as "Name" (double-quoted)
+instead of <u>Name</u> (underlined), to make it easier to copy/paste the
+examples.
+
+<p><ul>
+<li><a href="#static">Static Pages</a>
+   <ul>
+   <li><a href="#hello">Hello World</a>
+      <ul>
+      <li><a href="#server">Start the application server</a>
+      <li><a href="#how">How does it work?</a>
+      </ul>
+   <li><a href="#urlSyntax">URL Syntax</a>
+   <li><a href="#security">Security</a>
+      <ul>
+      <li><a href="#pw">The ".pw" File</a>
+      </ul>
+   <li><a href="#htmlFoo">The <code>html</code> Function</a>
+   <li><a href="#cssAttr">CSS Attributes</a>
+   <li><a href="#tags">Tag Functions</a>
+      <ul>
+      <li><a href="#simple">Simple Tags</a>
+      <li><a href="#lists">(Un)ordered Lists</a>
+      <li><a href="#tables">Tables</a>
+      <li><a href="#menus">Menus and Tabs</a>
+      </ul>
+   </ul>
+<li><a href="#forms">Interactive Forms</a>
+   <ul>
+   <li><a href="#sessions">Sessions</a>
+   <li><a href="#actionForms">Action Forms</a>
+      <ul>
+      <li><a href="#guiFoo">The <code>gui</code> Function</a>
+      <li><a href="#ctlFlow">Control Flow</a>
+      <li><a href="#switching">Switching URLs</a>
+      <li><a href="#dialogs">Alerts and Dialogs</a>
+      <li><a href="#calc">A Calculator Example</a>
+      </ul>
+   <li><a href="#charts">Charts</a>
+      <ul>
+      <li><a href="#scrolling">Scrolling</a>
+      <li><a href="#putGet">Put and Get Functions</a>
+      </ul>
+   </ul>
+<li><a href="#guiClasses">GUI Classes</a>
+   <ul>
+   <li><a href="#inputFields">Input Fields</a>
+      <ul>
+      <li><a href="#numberFields">Numeric Input Fields</a>
+      <li><a href="#timeDateFields">Time &amp; Date</a>
+      <li><a href="#telFields">Telephone Numbers</a>
+      <li><a href="#checkboxes">Checkboxes</a>
+      </ul>
+   <li><a href="#fieldPrefix">Field Prefix Classes</a>
+      <ul>
+      <li><a href="#initPrefix">Initialization</a>
+      <li><a href="#ablePrefix">Disabling and Enabling</a>
+      <li><a href="#formatPrefix">Formatting</a>
+      <li><a href="#sideEffects">Side Effects</a>
+      <li><a href="#validPrefix">Validation</a>
+      <li><a href="#linkage">Data Linkage</a>
+      </ul>
+   <li><a href="#buttons">Buttons</a>
+      <ul>
+      <li><a href="#dialogButtons">Dialog Buttons</a>
+      <li><a href="#jsButtons">Active JavaScript</a>
+      </ul>
+   </ul>
+<a name="minAppRef"></a>
+<li><a href="#minApp">A Minimal Complete Application</a>
+   <ul>
+   <li><a href="#getStarted">Getting Started</a>
+      <ul>
+      <li><a href="#localization">Localization</a>
+      <li><a href="#navigation">Navigation</a>
+      <li><a href="#choosing">Choosing Objects</a>
+      <li><a href="#editing">Editing</a>
+      <li><a href="#btnLinks">Buttons vs. Links</a>
+      </ul>
+   <li><a href="#dataModel">The Data Model</a>
+   <li><a href="#usage">Usage</a>
+      <ul>
+      <li><a href="#cuSu">Customer/Supplier</a>
+      <li><a href="#item">Item</a>
+      <li><a href="#order">Order</a>
+      <li><a href="#reports">Reports</a>
+      </ul>
+   <li><a href="#bugs">Bugs</a>
+   </ul>
+</ul>
+
+
+<p><hr>
+<h2><a name="static">Static Pages</a></h2>
+
+<p>You can use PicoLisp to generate static HTML pages. This does not make much
+sense in itself, because you could directly write HTML code as well, but it
+forms the base for interactive applications, and allows us to introduce the
+application server and other fundamental concepts.
+
+<p><hr>
+<h3><a name="hello">Hello World</a></h3>
+
+<p>To begin with a minimal application, please enter the following two lines
+into a generic source file named "project.l" in the PicoLisp installation
+directory.
+
+<pre><code>
+########################################################################
+(html 0 "Hello" "lib.css" NIL
+   "Hello World!" )
+########################################################################
+</code></pre>
+
+<p>(We will modify and use this file in all following examples and experiments.
+Whenever you find such a program snippet between hash ('#') lines, just copy and
+paste it into your "project.l" file, and press the "reload" button of your
+browser to view the effects)
+
+
+<h4><a name="server">Start the application server</a></h4>
+
+<p>Open a second terminal window, and start a PicoLisp application server
+
+<pre><code>
+$ ./dbg lib/http.l lib/xhtml.l lib/form.l -'server 8080 "project.l"'
+</code></pre>
+
+<p>No prompt appears. The server just sits, and waits for connections. You can
+stop it later by hitting <code>Ctrl-C</code> in that terminal, or by executing
+'<code>killall picolisp</code>' in some other window.
+
+<p>(In the following, we assume that this HTTP server is up and running)
+
+<p>Now open the URL '<code><a
+href="http://localhost:8080">http://localhost:8080</a></code>' with your
+browser. You should see an empty page with a single line of text.
+
+
+<h4><a name="how">How does it work?</a></h4>
+
+<p>The above line loads the debugger ('./dbg', which is equivalent to "./p
+dbg.l"), the HTTP server code ("lib/http.l"), the XHTML functions
+("lib/xhtml.l") and the input form framework ("lib/form.l", it will be needed
+later for <a href="#forms">interactive forms</a>).
+
+<p>Then the <code>server</code> function is called with a port number and a
+default URL. It will listen on that port for incoming HTTP requests in an
+endless loop. Whenever a GET request arrives on port 8080, the file "project.l"
+will be <code><a href="refL.html#load">(load)</a></code>ed, causing the
+evaluation (= execution) of all its Lisp expressions.
+
+<p>During that execution, all data written to the current output channel is sent
+directly to to the browser. The code in "project.l" is responsible to produce
+HTML (or anything else the browser can understand).
+
+
+<p><hr>
+<h3><a name="urlSyntax">URL Syntax</a></h3>
+
+<p>The PicoLisp application server uses a slightly specialized syntax when
+communicating URLs to and from a client. The "path" part of an URL - which
+remains when
+
+<p><ul>
+<li>the preceding protocol, host and port specifications,
+<li>and the trailing question mark plus arguments
+</ul>
+
+are stripped off - is interpreted according so some rules. The most prominent
+ones are:
+
+<p><ul>
+<li>If a path starts with an at-mark ('@'), the rest (without the '@') is taken
+as the name of a Lisp function to be called. All arguments following the
+question mark are passed to that function.
+
+<li>If a path ends with ".l" (a dot and a lower case 'L'), it is taken as a Lisp
+source file name to be <code><a href="refL.html#load">(load)</a></code>ed. This
+is the most common case, and we use it in our example "project.l".
+
+<li>If the extension of a file name matches an entry in the global mime type
+table <code>*Mimes</code>, the file is sent to the client with mime-type and
+max-age values taken from that table.
+
+<li>Otherwise, the file is sent to the client with a mime-type of
+"application/octet-stream" and a max-age of 1 second.
+
+</ul>
+
+<p>An application is free to extend or modify the <code>*Mimes</code> table with
+the <code>mime</code> function. For example
+
+<pre><code>
+(mime "doc" "application/msword" 60)
+</code></pre>
+
+<p>defines a new mime type with a max-age of one minute.
+
+<p>Argument values in URLs, following the path and the question mark, are
+encoded in such a way that Lisp data types are preserved:
+
+<p><ul>
+<li>An internal symbol starts with a dollar sign ('$')
+<li>A number starts with a plus sign ('+')
+<li>An external (database) symbol starts with dash ('-')
+<li>A list (one level only) is encoded with underscores ('_')
+<li>Otherwise, it is a transient symbol (a plain string)
+
+</ul>
+
+<p>In that way, high-level data types can be directly passed to functions
+encoded in the URL, or assigned to global variables before a file is loaded.
+
+
+<p><hr>
+<h3><a name="security">Security</a></h3>
+
+<p>It is, of course, a huge security hole that - directly from the URL - any
+Lisp source file can be loaded, and any Lisp function can be called. For that
+reason, applications must take care to declare exactly which files and functions
+are to be allowed in URLs. The server checks a global variable <code><a
+href="refA.html#*Allow">*Allow</a></code>, and - when its value is
+non-<code>NIL</code> - denies access to anything that does not match its
+contents.
+
+<p>Normally, <code>*Allow</code> is not manipulated directly, but set with the
+<code><a href="refA.html#allowed">allowed</a></code> and <code><a
+href="refA.html#allow">allow</a></code> functions
+
+<pre><code>
+(allowed ("img/" "demo/")
+   "favicon.ico" "lib.css"
+   "@start" "customer.l" "article.l")
+</code></pre>
+
+<p>This is usually called in the beginning of an application, and allows access
+to the directories "img/" and "demo/", to the function 'start', and to the files
+"favicon.ico", "lib.css", "customer.l" and "article.l".
+
+<p>Later in the program, <code>*Allow</code> may be dynamically extended with
+<code>allow</code>
+
+<pre><code>
+(allow "@foo")
+(allow "newdir/" T)
+</code></pre>
+
+<p>This adds the function 'foo', and the directory "newdir/", to the set of
+allowed items.
+
+
+<h4><a name="pw">The ".pw" File</a></h4>
+
+<p>For a variety of security checks (most notably for using the <code>psh</code>
+function, as in some later examples) it is necessary to create a file named
+".pw" in the PicoLisp installation directory. This file should contain a single
+line of arbitrary data, to be used as a password for identifying local
+resources.
+
+<p>The recommeded way to create this file is to call the <code>pw</code>
+function, defined in "lib/http.l"
+
+<pre><code>
+$ ./p lib/http.l -'pw 12' -bye
+</code></pre>
+
+<p>Please execute this command.
+
+
+<p><hr>
+<h3><a name="htmlFoo">The <code>html</code> Function</a></h3>
+
+<p>Now back to our "Hello World" example. In principle, you could write
+"project.l" as a sequence of print statements
+
+<pre><code>
+########################################################################
+(prinl "HTTP/1.0 200 OK^M")
+(prinl "Content-Type: text/html; charset=utf-8")
+(prinl "^M")
+(prinl "&lt;html&gt;")
+(prinl "Hello World!")
+(prinl "&lt;/html&gt;")
+########################################################################
+</code></pre>
+
+<p>but using the <code>html</code> function is much more convenient.
+
+<p>Moreover, <code>html</code> <b>is</b> nothing more than a printing function.
+You can see this easily if you connect a PicoLisp Shell (<code>psh</code>) to
+the server process (you must have generated a <a href="#pw">".pw" file</a> for
+this), and enter the <code>html</code> statement
+
+<pre><code>
+$ bin/psh 8080
+: (html 0 "Hello" "lib.css" NIL "Hello World!")
+HTTP/1.0 200 OK
+Server: PicoLisp
+Date: Fri, 29 Dec 2006 07:28:58 GMT
+Cache-Control: max-age=0
+Cache-Control: no-cache
+Content-Type: text/html; charset=utf-8
+
+&lt;!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd"&gt;
+&lt;html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en"&gt;
+&lt;head&gt;
+&lt;title&gt;Hello&lt;/title&gt;
+&lt;base href="http://localhost:8080/"/&gt;
+&lt;link rel="stylesheet" href="http://localhost:8080/lib.css" type="text/css"/&gt;
+&lt;/head&gt;
+&lt;body&gt;Hello World!&lt;/body&gt;
+&lt;/html&gt;
+-&gt; &lt;/html&gt;
+:  # (type ENTER here to terminate the PicoLisp Shell)
+</code></pre>
+
+<p>These are the arguments to <code>html</code>:
+
+<ol>
+
+<li><code>0</code>: A max-age value for cache-control (in seconds, zero means
+"no-cache"). You might pass a higher value for pages that change seldom, or
+<code>NIL</code> for no cache-control at all.
+
+<li><code>"Hello"</code>: The page title.
+
+<li><code>"lib.css"</code>: A CSS-File name. Pass <code>NIL</code> if you do not want
+to use any CSS-File, or a list of file names if you want to give more than one
+CSS-File.
+
+<li><code>NIL</code>: A CSS style attribute specification (see the description
+of <a href="#cssAttr">CSS Attributes</a> below). It will be passed to the
+<code>body</code> tag.
+
+</ol>
+
+<p>After these four arguments, an arbitrary number of expressions may follow.
+They form the body of the resulting page, and are evaluated according to a
+special rule. <a name="tagRule">This rule</a> is slightly different from the
+evaluation of normal Lisp expressions:
+
+<p><ul>
+
+<li>If an argument is an atom (a number or a symbol (string)), its value is
+printed immediately.
+
+<li>Otherwise (a list), it is evaluated as a Lisp function (typically some form
+of print statement).
+
+</ul>
+
+<p>Therefore, our source file might as well be written as:
+
+<pre><code>
+########################################################################
+(html 0 "Hello" "lib.css" NIL
+   (prinl "Hello World!") )
+########################################################################
+</code></pre>
+
+<p>The most typical print statements will be some HTML-tags:
+
+<pre><code>
+########################################################################
+(html 0 "Hello" "lib.css" NIL
+   (&lt;h1&gt; NIL "Hello World!")
+   (&lt;br&gt; "This is some text.")
+   (ht:Prin "And this is a number: " (+ 1 2 3)) )
+########################################################################
+</code></pre>
+
+<p><code>&lt;h1&gt;</code> and <code>&lt;br&gt;</code> are tag functions.
+<code>&lt;h1&gt;</code> takes a CSS attribute as its first argument.
+
+<p>Note the use of <code>ht:Prin</code> instead of <code>prin</code>.
+<code>ht:Prin</code> should be used for all direct printing in HTML pages,
+because it takes care to escape special characters.
+
+
+<p><hr>
+<h3><a name="cssAttr">CSS Attributes</a></h3>
+
+<p>The <a href="#htmlFoo"><code>html</code> function</a> above, and many of the
+HTML <a href="#tags">tag functions</a>, accept a CSS attribute specification.
+This may be either an atom, a cons pair, or a list of cons pairs. We demonstrate
+the effects with the <code>&lt;h1&gt;</code> tag function.
+
+<p>An atom (usually a symbol or a string) is taken as a CSS class name
+
+<pre><code>
+: (&lt;h1&gt; 'foo "Title")
+&lt;h1 class="foo"&gt;Title&lt;/h1&gt;
+</code></pre>
+
+<p>For a cons pair, the CAR is taken as an attribute name, and the CDR as the
+attribute's value
+
+<pre><code>
+: (&lt;h1&gt; '(id . bar) "Title")
+&lt;h1 id="bar"&gt;Title&lt;/h1&gt;
+</code></pre>
+
+<p>Consequently, a list of cons pairs gives a set of attribute-value pairs
+
+<pre><code>
+: (&lt;h1&gt; '((id . "abc") (lang . "de")) "Title")
+&lt;h1 id="abc" lang="de"&gt;Title&lt;/h1&gt;
+</code></pre>
+
+
+<p><hr>
+<h3><a name="tags">Tag Functions</a></h3>
+
+<p>All pre-defined XHTML tag functions can be found in "lib/xhtml.l". We
+recommend to look at their sources, and to experiment a bit, by executing them
+at a PicoLisp prompt, or by pressing the browser's "Reload" button after editing
+the "project.l" file.
+
+<p>For a suitable PicoLisp prompt, either execute (in a separate terminal
+window) the PicoLisp Shell (<code>psh</code>) command (works only if the
+application server is running, and you did generate a <a href="#pw">".pw"
+file</a>)
+
+<pre><code>
+$ bin/psh 8080
+:
+</code></pre>
+
+<p>or start the interpreter stand-alone, with "lib/xhtml.l" loaded
+
+<pre><code>
+$ ./dbg lib/http.l lib/xhtml.l
+:
+</code></pre>
+
+<p>Note that for all these tag functions the above <a href="#tagRule">tag body
+evaluation rule</a> applies.
+
+
+<h4><a name="simple">Simple Tags</a></h4>
+
+<p>Most tag functions are simple and straightforward. Some of them just print
+their arguments
+
+<pre><code>
+: (&lt;br&gt; "Hello world")
+Hello world&lt;br/&gt;
+
+: (&lt;em&gt; "Hello world")
+&lt;em&gt;Hello world&lt;/em&gt;
+</code></pre>
+
+<p>while most of them take a <a href="#cssAttr">CSS attribute specification</a>
+as their first argument (like the <code>&lt;h1&gt;</code> tag above)
+
+<pre><code>
+: (&lt;div&gt; 'main "Hello world")
+&lt;div class="main"&gt;Hello world&lt;/div&gt;
+
+: (&lt;p&gt; NIL "Hello world")
+&lt;p&gt;Hello world&lt;/p&gt;
+
+: (&lt;p&gt; 'info "Hello world")
+&lt;p class="info"&gt;Hello world&lt;/p&gt;
+</code></pre>
+
+<p>All of these functions take an arbitrary number of arguments, and may nest to
+an arbitrary depth (as long as the resulting HTML is legal)
+
+<pre><code>
+: (&lt;div&gt; 'main
+   (&lt;h1&gt; NIL "Head")
+   (&lt;p&gt; NIL
+      (&lt;br&gt; "Line 1")
+      "Line"
+      (&lt;nbsp&gt;)
+      (+ 1 1) ) )
+&lt;div class="main"&gt;&lt;h1&gt;Head&lt;/h1&gt;
+&lt;p&gt;Line 1&lt;br/&gt;
+Line&nbsp;2&lt;/p&gt;
+&lt;/div&gt;
+</code></pre>
+
+
+<h4><a name="lists">(Un)ordered Lists</a></h4>
+
+<p>HTML-lists, implemented by the <code>&lt;ol&gt;</code> and
+<code>&lt;ul&gt;</code> tags, let you define hierarchical structures. You might
+want to paste the following code into your copy of "project.l":
+
+<pre><code>
+########################################################################
+(html 0 "Unordered List" "lib.css" NIL
+   (&lt;ul&gt; NIL
+      (&lt;li&gt; NIL "Item 1")
+      (&lt;li&gt; NIL
+         "Sublist 1"
+         (&lt;ul&gt; NIL
+            (&lt;li&gt; NIL "Item 1-1")
+            (&lt;li&gt; NIL "Item 1-2") ) )
+      (&lt;li&gt; NIL "Item 2")
+      (&lt;li&gt; NIL
+         "Sublist 2"
+         (&lt;ul&gt; NIL
+            (&lt;li&gt; NIL "Item 2-1")
+            (&lt;li&gt; NIL "Item 2-2") ) )
+      (&lt;li&gt; NIL "Item 3") ) )
+########################################################################
+</code></pre>
+
+<p>Here, too, you can put arbitrary code into each node of that tree, including
+other tag functions.
+
+
+<h4><a name="tables">Tables</a></h4>
+
+<p>Like the hierarchical structures with the list functions, you can generate
+two-dimensional tables with the <code>&lt;table&gt;</code> and
+<code>&lt;row&gt;</code> functions.
+
+<p>The following example prints a table of numbers and their squares:
+
+<pre><code>
+########################################################################
+(html 0 "Table" "lib.css" NIL
+   (&lt;table&gt; NIL NIL NIL
+      (for (N 1 (&gt;= 10 N) (inc N))              # A table with 10 rows
+         (&lt;row&gt; NIL N (prin (* N N))) ) ) )     # and 2 columns
+########################################################################
+</code></pre>
+
+<p>The first argument to <code>&lt;table&gt;</code> is the usual CSS attribute,
+the second an optional title ("caption"), and the third an optional list
+specifying the column headers. In that list, you may supply a list for a each
+column, with a CSS attribute in its CAR, and a tag body in its CDR for the
+contents of the column header.
+
+<p>The body of <code>&lt;table&gt;</code> contains calls to the
+<code>&lt;row&gt;</code> function. This function is special in that each
+expression in its body will go to a separate column of the table. If both for
+the column header and the row function an CSS attribute is given, they will be
+combined by a space and passed to the HTML <code>&lt;td&gt;</code> tag. This
+permits distinct CSS specifications for each column and row.
+
+<p>As an extension of the above table example, let's pass some attributes for
+the table itself (not recommended - better define such styles in a CSS file and
+then just pass the class name to <code>&lt;table&gt;</code>), right-align both
+columns, and print each row in an alternating red and blue color
+
+<pre><code>
+########################################################################
+(html 0 "Table" "lib.css" NIL
+   (&lt;table&gt;
+      '((width . "200px") (style . "border: dotted 1px;"))    # table style
+      "Square Numbers"                                        # caption
+      '((align "Number") (align "Square"))                    # 2 headers
+      (for (N 1 (&gt;= 10 N) (inc N))                            # 10 rows
+         (&lt;row&gt; (xchg '(red) '(blue))                         # red or blue
+            N                                                 # 2 columns
+            (prin (* N N) ) ) ) ) )
+########################################################################
+</code></pre>
+
+<p>If you wish to concatenate two or more cells in a table, so that a single
+cell spans several columns, you can pass the symbol '<code>-</code>' for the
+additional cell data to <code>&lt;row&gt;</code>. This will cause the data given
+to the left of the '<code>-</code>' symbols to expand to the right.
+
+<p>You can also directly specify table structures with the simple
+<code>&lt;th&gt;</code>, <code>&lt;tr&gt;</code> and <code>&lt;td&gt;</code> tag
+functions.
+
+<p>If you just need a two-dimensional arrangement of components, the even
+simpler <code>&lt;grid&gt;</code> function might be convenient:
+
+<pre><code>
+########################################################################
+(html 0 "Grid" "lib.css" NIL
+   (&lt;grid&gt; 3
+      "A" "B" "C"
+      123 456 789 ) )
+########################################################################
+</code></pre>
+
+<p>It just takes a specification for the number of columns (here: 3) as its
+first argument, and then a single expression for each cell. Instead of a number,
+you can also pass a list of CSS attributes. Then the length of that list will
+determine the number of columns. You can change the second line in the above
+example to
+
+<pre><code>
+   (&lt;grid&gt; '(NIL NIL right)
+</code></pre>
+
+<p>Then the third column will be right aligned.
+
+
+<h4><a name="menus">Menus and Tabs</a></h4>
+
+<p>The two most powerful tag functions are <code>&lt;menu&gt;</code> and
+<code>&lt;tab&gt;</code>. Used separately or in combination, they form a
+navigation framework with
+
+<p><ul>
+<li>menu items which open and close submenus
+<li>submenu items which switch to different pages
+<li>tabs which switch to different subpages
+</ul>
+
+<p>The following example is not very useful, because the URLs of all items link
+to the same "project.l" page, but it should suffice to demonstrate the
+functionality:
+
+<pre><code>
+########################################################################
+(html 0 "Menu+Tab" "lib.css" NIL
+   (&lt;div&gt; '(id . menu)
+      (&lt;menu&gt;
+         ("Item" "project.l")                      # Top level item
+         (NIL (&lt;hr&gt;))                              # Plain HTML
+         (T "Submenu 1"                            # Submenu
+            ("Subitem 1.1" "project.l")
+            (T "Submenu 1.2"
+               ("Subitem 1.2.1" "project.l")
+               ("Subitem 1.2.2" "project.l")
+               ("Subitem 1.2.3" "project.l") )
+            ("Subitem 1.3" "project.l") )
+         (T "Submenu 2"
+            ("Subitem 2.1" "project.l")
+            ("Subitem 2.2" "project.l") ) ) )
+   (&lt;div&gt; '(id . main)
+      (&lt;h1&gt; NIL "Menu+Tab")
+      (&lt;tab&gt;
+         ("Tab1"
+            (&lt;h3&gt; NIL "This is Tab 1") )
+         ("Tab2"
+            (&lt;h3&gt; NIL "This is Tab 2") )
+         ("Tab3"
+            (&lt;h3&gt; NIL "This is Tab 3") ) ) ) )
+########################################################################
+</code></pre>
+
+<p><code>&lt;menu&gt;</code> takes a sequence of menu items. Each menu item is a
+list, with its CAR either
+
+<p><ul>
+<li><code>NIL</code>: The entry is not an active menu item, and the rest of the
+list may consist of arbitrary code (usually HTML tags).
+
+<li><code>T</code>: The second element is taken as a submenu name, and a click
+on that name will open or close the corresponding submenu. The rest of the list
+recursively specifies the submenu items (may nest to arbitrary depth).
+
+<li>Otherwise: The menu item specifies a direct action (instead of opening a
+submenu), where the first list element gives the item's name, and the second
+element the corresponding URL.
+
+</ul>
+
+<p><code>&lt;tab&gt;</code> takes a list of subpages. Each page is simply a tab
+name, followed by arbitrary code (typically HTML tags).
+
+<p>Note that only a single menu and a single tab may be active at the same time.
+
+
+<p><hr>
+<h2><a name="forms">Interactive Forms</a></h2>
+
+<p>In HTML, the only possibility for user input is via <code>&lt;form&gt;</code>
+and <code>&lt;input&gt;</code> elements, using the HTTP POST method to
+communicate with the server.
+
+<p>"lib/xhtml.l" defines a function called <code>&lt;post&gt;</code>, and a
+collection of input tag functions, which allow direct programming of HTML forms.
+We will supply only one simple example:
+
+<pre><code>
+########################################################################
+(html 0 "Simple Form" "lib.css" NIL
+   (&lt;post&gt; NIL "project.l"
+      (&lt;field&gt; 10 '*Text)
+      (&lt;submit&gt; "Save") ) )
+########################################################################
+</code></pre>
+
+<p>This associates a text input field with a global variable <code>*Text</code>.
+The field displays the current value of <code>*Text</code>, and pressing the
+submit button causes a reload of "project.l" with <code>*Text</code> set to any
+string entered by the user.
+
+<p>An application program could then use that variable to do something useful,
+for example store its value in a database.
+
+<p>The problem with such a straightforward use of forms is that
+
+<p><ol>
+<li>they require the application programmer to take care of maintaining lots of
+global variables. Each input field on the page needs an associated variable for
+the round trip between server and client.
+
+<li>they do not preserve an application's internal state. Each POST request
+spawns an individual process on the server, which sets the global variables to
+their new values, generates the HTML page, and terminates thereafter. The
+application state has to be passed along explicitly, e.g. using
+<code>&lt;hidden&gt;</code> tags.
+
+<li>they are not very interactive. There is typically only a single submit
+button. The user fills out a possibly large number of input fields, but changes
+will take effect only when the submit button is pressed.
+
+</ol>
+
+<p>Though we wrote a few applications in that style, we recommend the GUI
+framework provided by "lib/form.l". It does not need any variables for the
+client/server communication, but implements a class hierarchy of GUI components
+for the abstraction of application logic, button actions and data linkage.
+
+
+<p><hr>
+<h3><a name="sessions">Sessions</a></h3>
+
+<p>First of all, we need to establish a persistent environment on the server, to
+handle each individual session (for each connected client).
+
+<p>Technically, this is just a child process of the server we started <a
+href="#server">above</a>, which does not terminate immediately after it sent its
+page to the browser. It is achieved by calling the <code>app</code> function
+somewhere in the application's startup code.
+
+<pre><code>
+########################################################################
+(app)  # Start a session
+
+(html 0 "Simple Session" "lib.css" NIL
+   (&lt;post&gt; NIL "project.l"
+      (&lt;field&gt; 10 '*Text)
+      (&lt;submit&gt; "Save") ) )
+########################################################################
+</code></pre>
+
+<p>Nothing else changed from the previous example. However, when you connect
+your browser and then look at the terminal window where you started the
+application server, you'll notice a colon, the PicoLisp prompt
+
+<pre><code>
+$ ./dbg lib/http.l lib/xhtml.l lib/form.l -'server 8080 "project.l"'
+:
+</code></pre>
+
+<p>Tools like the Unix <code>ps</code> utility will tell you that now two
+<code>picolisp</code> processes are running, the first being the parent of the
+second.
+
+<p>If you enter some text, say "abcdef", into the text field in the browser
+window, press the submit button, and inspect the Lisp <code>*Text</code>
+variable,
+
+<pre><code>
+: *Text
+-> "abcdef"
+</code></pre>
+
+<p>you see that we now have a dedicated PicoLisp process, "connected" to the
+client.
+
+<p>You can terminate this process (like any interactive PicoLisp) by hitting
+ENTER on an empty line. Otherwise, it will terminate by itself if no other
+browser requests arrive within a default timeout period of 5 minutes.
+
+<p>To start a (non-debug) production version, the server is commonly started not
+as 'dbg' but with a 'p', and with <code>-wait</code>
+
+<pre><code>
+$ ./p lib/http.l lib/xhtml.l lib/form.l -'server 8080 "project.l"' -wait
+</code></pre>
+
+<p>In that way, no command line prompt appears when a client connects.
+
+
+<p><hr>
+<h3><a name="actionForms">Action Forms</a></h3>
+
+<p>Now that we have a persistent session for each client, we can set up an
+active GUI framework.
+
+<p>This is done by wrapping the call to the <code>html</code> function with
+<code>action</code>. Inside the body of <code>html</code> can be - in addition
+to all other kinds of tag functions - one or more calls to <code>form</code>
+
+<pre><code>
+########################################################################
+(app)                                              # Start session
+
+(action                                            # Action handler
+   (html 0 "Form" "lib.css" NIL                    # HTTP/HTML protocol
+      (form NIL                                    # Form
+         (gui 'a '(+TextField) 10)                 # Text Field
+         (gui '(+Button) "Print"                   # Button
+            '(msg (val&gt; (: home a))) ) ) ) )
+########################################################################
+</code></pre>
+
+<p>Note that there is no longer a global variable like <code>*Text</code> to
+hold the contents of the input field. Instead, we gave a local, symbolic name
+'<code>a</code>' to a <code>+TextField</code> component
+
+<pre><code>
+         (gui 'a '(+TextField) 10)                 # Text Field
+</code></pre>
+
+<p>Other components can refer to it
+
+<pre><code>
+            '(msg (val&gt; (: home a)))
+</code></pre>
+
+<p><code>(: home)</code> is always the form which contains this GUI component.
+So <code>(: home a)</code> evaluates to the component '<code>a</code>' in the
+current form. As <code><a href="refM.html#msg">msg</a></code> prints its
+argument to standard error, and the <code>val&gt;</code> method retrieves the
+current contents of a component, we will see on the console the text typed into
+the text field when we press the button.
+
+<p>An <code>action</code> without embedded <code>form</code>s - or a
+<code>form</code> without a surrounding <code>action</code> - does not make much
+sense by itself. Inside <code>html</code> and <code>form</code>, however, calls
+to HTML functions (and any other Lisp functions, for that matter) can be freely
+mixed.
+
+<p>In general, a typical page may have the form
+
+<pre><code>
+(action                                            # Action handler
+   (html ..                                        # HTTP/HTML protocol
+      (&lt;h1&gt; ..)                                    # HTML tags
+      (form NIL                                    # Form
+         (&lt;h3&gt; ..)
+         (gui ..)                                  # GUI component(s)
+         (gui ..)
+         .. )
+      (&lt;h2&gt; ..)
+      (form NIL                                    # Another form
+         (&lt;h3&gt; ..)
+         (gui ..)                                  # GUI component(s)
+         .. )
+      (&lt;br&gt; ..)
+      .. ) )
+</code></pre>
+
+
+<h4><a name="guiFoo">The <code>gui</code> Function</a></h4>
+
+<p>The most prominent function in a <code>form</code> body is <code>gui</code>.
+It is the workhorse of GUI construction.
+
+<p>Outside of a <code>form</code> body, <code>gui</code> is undefined.
+Otherwise, it takes an optional alias name, a list of classes, and additional
+arguments as needed by the constructors of these classes. We saw this example
+before
+
+<pre><code>
+         (gui 'a '(+TextField) 10)                 # Text Field
+</code></pre>
+
+Here, '<code>a</code>' is an alias name for a component of type
+<code>(+TextField)</code>. The numeric argument <code>10</code> is passed to the
+text field, specifying its width. See the chapter on <a href="#guiClasses">GUI
+Classes</a> for more examples.
+
+<p>During a GET request, <code>gui</code> is basically a front-end to
+<code>new</code>. It builds a component, stores it in the internal structures of
+the current form, and initializes it by sending the <code>init&gt;</code>
+message to the component. Finally, it sends it the <code>show&gt;</code>
+message, to produce HTML code and transmit it to the browser.
+
+<p>During a POST request, <code>gui</code> does not build any new components.
+Instead, the existing components are re-used. So <code>gui</code> does not have
+much more to do than sending the <code>show&gt;</code> message to a component.
+
+
+<h4><a name="ctlFlow">Control Flow</a></h4>
+
+<p>HTTP has only two methods to change a browser window: GET and POST. We employ
+these two methods in a certain defined, specialized way:
+
+<p><ul>
+<li>GET means, a <b>new page</b> is being constructed. It is used when a page is
+visited for the first time, usually by entering an URL into the browser's
+address field, or by clicking on a link (which is often a <a
+href="#menus">submenu item or tab</a>).
+
+<li>POST is always directed to the <b>same page</b>. It is triggered by a button
+press, updates the corresponding form's data structures, and executes that
+button's action code.
+
+</ul>
+
+<p>A button's action code can do almost anything: Read and modify the contents
+of input fields, communicate with the database, display alerts and dialogs, or
+even fake the POST request to a GET, with the effect of showing a completely
+different document (See <a href="#switching">Switching URLs</a>).
+
+<p>GET builds up all GUI components on the server. These components are objects
+which encapsulate state and behavior of the HTML page in the browser. Whenever a
+button is pressed, the page is reloaded via a POST request. Then - before any
+output is sent to the browser - the <code>action</code> function takes control.
+It performs error checks on all components, processes possible user input on the
+HTML page, and stores the values in correct format (text, number, date, object
+etc.) in each component.
+
+<p>The state of a form is preserved over time. When the user returns to a
+previous page with the browser's BACK button, that state is reactivated, and may
+be POSTed again.
+
+<p>The following silly example displays two text fields. If you enter some text
+into the "Source" field, you can copy it in upper or lower case to the
+"Destination" field by pressing one of the buttons
+
+<pre><code>
+########################################################################
+(app)
+
+(action
+   (html 0 "Case Conversion" "lib.css" NIL
+      (form NIL
+         (&lt;grid&gt; 2
+            "Source" (gui 'src '(+TextField) 30)
+            "Destination" (gui 'dst '(+Lock +TextField) 30) )
+         (gui '(+JS +Button) "Upper Case"
+            '(set&gt; (: home dst)
+               (uppc (val&gt; (: home src))) ) )
+         (gui '(+JS +Button) "Lower Case"
+            '(set&gt; (: home dst)
+               (lowc (val&gt; (: home src))) ) ) ) ) )
+########################################################################
+</code></pre>
+
+<p>The <code>+Lock</code> prefix class in the "Destination" field makes that
+field read-only. The only way to get some text into that field is by using one
+of the buttons.
+
+
+<h4><a name="switching">Switching URLs</a></h4>
+
+<p>Because an action code runs before <code>html</code> has a chance to output
+an HTTP header, it can abort the current page and present something different to
+the user. This might, of course, be another HTML page, but would not be very
+interesting as a normal link would suffice. Instead, it can cause the download
+of dynamically generated data.
+
+<p>The next example shows a text area and two buttons. Any text entered into the
+text area is exported either as a text file via the first button, or a PDF
+document via the second button
+
+<pre><code>
+########################################################################
+(load "lib/ps.l")
+
+(app)
+
+(action
+   (html 0 "Export" "lib.css" NIL
+      (form NIL
+         (gui '(+TextField) 30 8)
+         (gui '(+Button) "Text"
+            '(let Txt (tmp "export.txt")
+               (out Txt (prinl (val&gt; (: home gui 1))))
+               (url Txt) ) )
+         (gui '(+Button) "PDF"
+            '(psOut NIL "foo"
+               (a4)
+               (indent 40 40)
+               (down 60)
+               (hline 3)
+               (font (14 . "Times-Roman")
+                  (ps (val&gt; (: home gui 1))) )
+               (hline 3)
+               (page) ) ) ) ) )
+########################################################################
+</code></pre>
+
+<p>(a text area is built when you supply two numeric arguments (columns and
+rows) to a <code>+TextField</code> class)
+
+<p>The action code of the first button creates a temporary file (i.e. a file
+named "export.txt" in the current process's temporary space), prints the value
+of the text area (this time we did not bother to give it a name, we simply refer
+to it as the form's first gui list element) into that file, and then calls the
+<code>url</code> function with the file name.
+
+<p>The second button uses the PostScript library "lib/ps.l" to create a
+temporary file "foo.pdf". Here, the temporary file creation and the call to the
+<code>url</code> function is hidden in the internal mechanisms of
+<code>psOut</code>. The effect is that the browser receives a PDF document and
+displays it.
+
+
+<h4><a name="dialogs">Alerts and Dialogs</a></h4>
+
+<p>Alerts and dialogs are not really what they used to be ;-)
+
+<p>They do not "pop up". In this framework, they are just a kind of
+simple-to-use, pre-fabricated form. They can be invoked by a button's action
+code, and appear always on the current page, immediately preceding the form
+which created them.
+
+<p>Let's look at an example which uses two alerts and a dialog. In the
+beginning, it displays a simple form, with a locked text field, and two buttons
+
+<pre><code>
+########################################################################
+(app)
+
+(action
+   (html 0 "Alerts and Dialogs" "lib.css" NIL
+      (form NIL
+         (gui '(+Init +Lock +TextField) "Initial Text" 20 "My Text")
+         (gui '(+Button) "Alert"
+            '(alert NIL "This is an alert " (okButton)) )
+         (gui '(+Button) "Dialog"
+            '(dialog NIL
+               (&lt;br&gt; "This is a dialog.")
+               (&lt;br&gt;
+                  "You can change the text here "
+                  (gui '(+Init +TextField) (val&gt; (: top 1 gui 1)) 20) )
+               (&lt;br&gt; "and then re-submit it to the form.")
+               (gui '(+Button) "Re-Submit"
+                  '(alert NIL "Are you sure? "
+                     (yesButton
+                        '(set&gt; (: home top 2 gui 1)
+                           (val&gt; (: home top 1 gui 1)) ) )
+                     (noButton) ) )
+               (cancelButton) ) ) ) ) )
+########################################################################
+</code></pre>
+
+<p>The <code>+Init</code> prefix class initializes the "My Text" field with the
+string "Initial Text". As the field is locked, you cannot modify this value
+directly.
+
+<p>The first button brings up an alert saying "This is an alert.". You can
+dispose it by pressing "OK".
+
+<p>The second button brings up a dialog with an editable text field, containing
+a copy of the value from the form's locked text field. You can modify this
+value, and send it back to the form, if you press "Re-Submit" and answer "Yes"
+to the "Are you sure?" alert.
+
+
+<h4><a name="calc">A Calculator Example</a></h4>
+
+<p>Now let's forget our "project.l" test file for a moment, and move on to a
+more substantial and practical, stand-alone, example. Using what we have learned
+so far, we want to build a simple bignum calculator. ("bignum" because PicoLisp
+can do <i>only</i> bignums)
+
+<p>It uses a single form, a single numeric input field, and lots of buttons. It
+can be found in the PicoLisp distribution in "misc/calc.l", together with a
+directly executable wrapper script "misc/calc".
+
+<p>To use it, change to the PicoLisp installation directory, and start it as
+
+<pre><code>
+$ misc/calc
+</code></pre>
+
+<p>If you want to use it from other directories too, change the two relative
+path names in the first line to absolute paths. We recommend symbolic links in
+some global directories, as described in the <a
+href="tut.html#script">Scripting</a> section of the PicoLisp Tutorial.
+
+<p>If you like to get a PicoLisp prompt for inspection, start it instead as
+
+<pre><code>
+$ ./dbg misc/calc.l -main -go
+</code></pre>
+
+<p>Then - as before - point your browser to '<code><a
+href="http://localhost:8080">http://localhost:8080</a></code>'.
+
+<p>The code for the calculator logic and the GUI is rather straightforward. The
+entry point is the single function <code>calculator</code>. It is called
+directly (as described in <a href="#urlSyntax">URL Syntax</a>) as the server's
+default URL, and implicitly in all POST requests. No further file access is
+needed once the calculator is running.
+
+<p>Note that for a production application, we inserted an allow-statement (as
+recommended by the <a href="#security">Security</a> chapter)
+
+<pre><code>
+(allowed NIL "@calculator" "favicon.ico" "lib.css")
+</code></pre>
+
+<p>at the beginning of "misc/calc.l". This will restrict external access to that
+single function.
+
+<p>The calculator uses three global variables, <code>*Init</code>,
+<code>*Accu</code> and <code>*Stack</code>. <code>*Init</code> is a boolean flag
+set by the operator buttons to indicate that the next digit should initialize
+the accumulator to zero. <code>*Accu</code> is the accumulator. It is always
+displayed in the numeric input field, accepts user input, and it holds the
+results of calculations. <code>*Stack</code> is a push-down stack, holding
+postponed calculations (operators, priorities and intermediate results) with
+lower-priority operators, while calculations with higher-priority operators are
+performed.
+
+<p>The function <code>digit</code> is called by the digit buttons, and adds
+another digit to the accumulator.
+
+<p>The function <code>calc</code> does an actual calculation step. It pops the
+stack, checks for division by zero, and displays an error alert if necessary.
+
+<p><code>operand</code> processes an operand button, accepting a function and a
+priority as arguments. It compares the priority with that in the top-of-stack
+element, and delays the calculation if it is less.
+
+<p><code>finish</code> is used to calculate the final result.
+
+<p>The <code>calculator</code> function has one numeric input field, with a
+width of 60 characters
+
+<pre><code>
+         (gui '(+Var +NumField) '*Accu 60)
+</code></pre>
+
+<p>The <code>+Var</code> prefix class associates this field with the global
+variable <code>*Accu</code>. All changes to the field will show up in that
+variable, and modification of that variable's value will appear in the field.
+
+<p>The <a name="sqrtButton">square root operator button</a> has an
+<code>+Able</code> prefix class
+
+<pre><code>
+         (gui '(+Able +JS +Button) '(ge0 *Accu) (char 8730)
+            '(setq *Accu (sqrt *Accu)) )
+</code></pre>
+
+
+<p>with an argument expression which checks that the current value in the
+accumulator is positive, and disables the button if otherwise.
+
+<p>The rest of the form is just an array (grid) of buttons, encapsulating all
+functionality of the calculator. The user can enter numbers into the input
+field, either by using the digit buttons, or by directly typing them in, and
+perform calculations with the operator buttons. Supported operations are
+addition, subtraction, multiplication, division, sign inversion, square root and
+power (all in bignum integer arithmetic). The '<code>C</code>' button just
+clears the accumulator, while the '<code>A</code>' button also clears all
+pending calculations.
+
+<p>All that in 53 lines of code!
+
+
+<p><hr>
+<h3><a name="charts">Charts</a></h3>
+
+<p>Charts are virtual components, maintaining the internal representation of
+two-dimensional data.
+
+<p>Typically, these data are nested lists, database selections, or some kind of
+dynamically generated tabular information. Charts make it possible to view them
+in rows and columns (usually in HTML <a href="#tables">tables</a>), scroll up
+and down, and associate them with their corresponding visible GUI components.
+
+<p>In fact, the logic to handle charts makes up a substantial part of the whole
+framework, with large impact on all internal mechanisms. Each GUI component must
+know whether it is part of a chart or not, to be able to handle its contents
+properly during updates and user interactions.
+
+<p>Let's assume we want to collect textual and numerical data. We might create a
+table
+
+<pre><code>
+########################################################################
+(app)
+
+(action
+   (html 0 "Table" "lib.css" NIL
+      (form NIL
+         (&lt;table&gt; NIL NIL '((NIL "Text") (NIL "Number"))
+            (do 4
+               (&lt;row&gt; NIL
+                  (gui '(+TextField) 20)
+                  (gui '(+NumField) 10) ) ) )
+         (&lt;submit&gt; "Save") ) ) )
+########################################################################
+</code></pre>
+
+<p>with two columns "Text" and "Number", and four rows, each containing a
+<code>+TextField</code> and a <code>+NumField</code>.
+
+<p>You can enter text into the first column, and numbers into the second.
+Pressing the "Save" button stores these values in the components on the server
+(or produces an error message if a string in the second column is not a legal
+number).
+
+<p>There are two problems with this solution:
+
+<p><ol>
+<li>Though you can get at the user input for the individual fields, e.g.
+
+<pre><code>
+: (val> (get *Top 'gui 2))  # Value in the first row, second column
+-> 123
+</code></pre>
+
+there is no direct way to get the whole data structure as a single list.
+Instead, you have to traverse all GUI components and collect the data.
+
+<li>The user cannot input more than four rows of data, because there is no easy
+way to scroll down and make space for more.
+
+</ol>
+
+<p>A chart can handle these things:
+
+<pre><code>
+########################################################################
+(app)
+
+(action
+   (html 0 "Chart" "lib.css" NIL
+      (form NIL
+         (gui '(+Chart) 2)                         # Inserted a +Chart
+         (&lt;table&gt; NIL NIL '((NIL "Text") (NIL "Number"))
+            (do 4
+               (&lt;row&gt; NIL
+                  (gui 1 '(+TextField) 20)         # Inserted '1'
+                  (gui 2 '(+NumField) 10) ) ) )    # Inserted '2'
+         (&lt;submit&gt; "Save") ) ) )
+########################################################################
+</code></pre>
+
+<p>Note that we inserted a <code>+Chart</code> component before the GUI
+components which should be managed by the chart. The argument '2' tells the
+chart that it has to expect two columns.
+
+<p>Each component got an index number (here '1' and '2') as the first argument
+to <code>gui</code>, indicating the column into which this component should go
+within the chart.
+
+<p>Now - if you entered "a", "b" and "c" into the first, and 1, 2, and 3 into
+the second column - we can retrieve the chart's complete contents by sending it
+the <code>val&gt;</code> message
+
+<pre><code>
+: (val> (get *Top 'chart 1))  # Retrieve the value of the first chart
+-> (("a" 1) ("b" 2) ("c" 3))
+</code></pre>
+
+<p>BTW, a more convenient function is <code>chart</code>
+
+<pre><code>
+: (val> (chart))  # Retrieve the value of the current chart
+-> (("a" 1) ("b" 2) ("c" 3))
+</code></pre>
+
+<p><code>chart</code> can be used instead of the above construct when we want to
+access the "current" chart, i.e. the chart most recently processed in the
+current form.
+
+
+<h4><a name="scrolling">Scrolling</a></h4>
+
+<p>To enable scrolling, let's also insert two buttons. We use the pre-defined
+classes <code>+UpButton</code> and <code>+DnButton</code>
+
+<pre><code>
+########################################################################
+(app)
+
+(action
+   (html 0 "Scrollable Chart" "lib.css" NIL
+      (form NIL
+         (gui '(+Chart) 2)
+         (&lt;table&gt; NIL NIL '((NIL "Text") (NIL "Number"))
+            (do 4
+               (&lt;row&gt; NIL
+                  (gui 1 '(+TextField) 20)
+                  (gui 2 '(+NumField) 10) ) ) )
+         (gui '(+UpButton) 1)                   # Inserted two buttons
+         (gui '(+DnButton) 1)
+         (----)
+         (&lt;submit&gt; "Save") ) ) )
+########################################################################
+</code></pre>
+
+<p>to scroll down and up a single (argument '1') line at a time.
+
+<p>Now it is possible to enter a few rows of data, scroll down, and continue. It
+is not necessary (except in the beginning, when the scroll buttons are still
+disabled) to press the "Save" button, because <b>any</b> button in the form will
+send changes to the server's internal structures before any action is performed.
+
+
+<h4><a name="putGet">Put and Get Functions</a></h4>
+
+<p>As we said, a chart is a virtual component to edit two-dimensional data.
+Therefore, a chart's native data format is a list of lists: Each sublist
+represents a single row of data, and each element of a row corresponds to a
+single GUI component.
+
+<p>In the example above, we saw a row like
+
+<pre><code>
+   ("a" 1)
+</code></pre>
+
+<p>being mapped to
+
+<pre><code>
+   (gui 1 '(+TextField) 20)
+   (gui 2 '(+NumField) 10)
+</code></pre>
+
+<p>Quite often, however, such a one-to-one relationship is not desired. The
+internal data structures may have to be presented in a different form to the
+user, and user input may need conversion to an internal representation.
+
+<p>For that, a chart accepts - in addition to the "number of columns" argument -
+two optional function arguments. The first function is invoked to 'put' the
+internal representation into the GUI components, and the second to 'get' data
+from the GUI into the internal representation.
+
+<p>A typical example is a chart displaying customers in a database. While the
+internal representation is a (one-dimensional) list of customer objects, 'put'
+expands each object to a list with, say, the customer's first and second name,
+telephone number, address and so on. When the user enters a customer's name,
+'get' locates the matching object in the database and stores it in the internal
+representation. In the following, 'put' will in turn expand it to the GUI.
+
+<p>For now, let's stick with a simpler example: A chart that holds just a list
+of numbers, but expands in the GUI to show also a textual form of each number
+(in German).
+
+<pre><code>
+########################################################################
+(app)
+
+(load "lib/zahlwort.l")
+
+(action
+   (html 0 "Numerals" "lib.css" NIL
+      (form NIL
+         (gui '(+Init +Chart) (1 5 7) 2
+            '((N) (list N (zahlwort N)))
+            car )
+         (&lt;table&gt; NIL NIL '((NIL "Numeral") (NIL "German"))
+            (do 4
+               (&lt;row&gt; NIL
+                  (gui 1 '(+NumField) 9)
+                  (gui 2 '(+Lock +TextField) 90) ) ) )
+         (gui '(+UpButton) 1)
+         (gui '(+DnButton) 1)
+         (----)
+         (&lt;submit&gt; "Save") ) ) )
+########################################################################
+</code></pre>
+
+<p>"lib/zahlwort.l" defines the utility function <code>zahlwort</code>, which is
+required later by the 'put' function. <code>zahlwort</code> accepts a number and
+returns its wording in German.
+
+<p>Now look at the code
+
+<pre><code>
+         (gui '(+Init +Chart) (1 5 7) 2
+            '((N) (list N (zahlwort N)))
+            car )
+</code></pre>
+
+<p>We prefix the <code>+Chart</code> class with <code>+Init</code>, and pass it
+a list of numbers <code>(1 5 7)</code> for the initial value of the chart. Then,
+following the '2' (the chart has two columns), we pass a 'put' function
+
+<pre><code>
+            '((N) (list N (zahlwort N)))
+</code></pre>
+
+<p>which takes a number and returns a list of that number and its wording, and a
+'get' function
+
+<pre><code>
+            car )
+</code></pre>
+
+<p>which in turn accepts such a list and returns a number, which happens to be
+the list's first element.
+
+<p>You can see from this example that 'get' is the inverse function of 'put'.
+'get' can be omitted, however, if the chart is read-only (contains no (or only
+locked) input fields).
+
+<p>The field in the second column
+
+<pre><code>
+                  (gui 2 '(+Lock +TextField) 90) ) ) )
+</code></pre>
+
+<p>is locked, because it displays the text generated by 'put', and is not
+supposed to accept any user input.
+
+<p>When you start up this form in your browser, you'll see three pre-filled
+lines with "1/eins", "5/fünf" and "7/sieben", according to the
+<code>+Init</code> argument <code>(1 5 7)</code>. Typing a number somewhere into
+the first column, and pressing ENTER or one of the buttons, will show a suitable
+text in the second column.
+
+
+<p><hr>
+<h2><a name="guiClasses">GUI Classes</a></h2>
+
+<p>In previous chapters we saw examples of GUI classes like
+<code>+TextField</code>, <code>+NumField</code> or <code>+Button</code>, often
+in combination with prefix classes like <code>+Lock</code>, <code>+Init</code>
+or <code>+Able</code>. Now we take a broader look at the whole hierarchy, and
+try more examples.
+
+<p>The abstract class <code>+gui</code> is the base of all GUI classes. A live
+view of the class hierarchy can be obtained with the <code><a
+href="refD.html#dep">dep</a></code> ("dependencies") function:
+
+<pre><code>
+: (dep '+gui)
+   +JsField
+   +Button
+      +UpButton
+      +PickButton
+         +DstButton
+      +ClrButton
+      +ChoButton
+         +Hint
+      +GoButton
+      +BubbleButton
+      +DelRowButton
+      +ShowButton
+      +DnButton
+   +field
+      +Checkbox
+      +TextField
+         +FileField
+         +ClassField
+         +numField
+            +NumField
+            +FixField
+         +BlobField
+         +DateField
+         +SymField
+         +UpField
+         +MailField
+         +SexField
+         +AtomField
+         +PwField
+         +ListTextField
+         +LinesField
+         +TelField
+         +TimeField
+         +HttpField
+      +Radio
+-> +gui
+</code></pre>
+
+<p>We see, for example, that <code>+DnButton</code> is a subclass of
+<code>+Button</code>, which in turn is a subclass of <code>+gui</code>.
+Inspecting <code>+DnButton</code> directly
+
+<pre><code>
+: (dep '+DnButton)
+   +Tiny
+   +Rid
+   +JS
+   +Able
+      +gui
+   +Button
++DnButton
+-> +DnButton
+</code></pre>
+
+<p>shows that <code>+DnButton</code> inherits from <code>+Tiny</code>,
+<code>+Rid</code>, <code>+Able</code> and <code>+Button</code>. The actual
+definition of <code>+DnButton</code> can be found in "lib/form.l"
+
+<pre><code>
+(class +DnButton +Tiny +Rid +JS +Able +Button)
+...
+</code></pre>
+
+<p>In general, "lib/form.l" is the ultimate reference to the framework, and
+should be freely consulted.
+
+
+<p><hr>
+<h3><a name="inputFields">Input Fields</a></h3>
+
+<p>Input fields implement the visual display of application data, and allow -
+when enabled - input and modification of these data.
+
+<p>On the HTML level, they can take the form of
+
+<ul>
+<li>Normal text input fields
+<li>Textareas
+<li>Checkboxes
+<li>Drop-down selections
+<li>Password fields
+<li>HTML links
+<li>Plain HTML text
+</ul>
+
+<p>Except for checkboxes, which are implemented by the <a
+href="#checkboxes">Checkbox</a> class, all these HTML representations are
+generated by <code>+TextField</code> and its content-specific subclasses like
+<code>+NumField</code>, <code>+DateField</code> etc. Their actual appearance (as
+one of the above forms) depends on their arguments:
+
+<p>We saw already "normal" text fields. They are created with a single numeric
+argument. This example creates an editable field with a width of 10 characters:
+
+<pre><code>
+   (gui '(+TextField) 10)
+</code></pre>
+
+<p>If you supply a second numeric for the line count ('4' in this case), you'll
+get a text area:
+
+<pre><code>
+   (gui '(+TextField) 10 4)
+</code></pre>
+
+<p>Supplying a list of values instead of a count yields a drop-down selection
+(combo box):
+
+<pre><code>
+   (gui '(+TextField) '("Value 1" "Value 2" "Value 3"))
+</code></pre>
+
+<p>In addition to these arguments, you can pass a string. Then the field is
+created with a label:
+
+<pre><code>
+   (gui '(+TextField) 10 "Plain")
+   (gui '(+TextField) 10 4 "Text Area")
+   (gui '(+TextField) '("Value 1" "Value 2" "Value 3") "Selection")
+</code></pre>
+
+<p>Finally, without any arguments, the field will appear as a plain HTML text:
+
+<pre><code>
+   (gui '(+TextField))
+</code></pre>
+
+<p>This makes mainly sense in combination with prefix classes like
+<code>+Var</code> and <code>+Obj</code>, to manage the contents of these fields,
+and achieve special behavior as HTML links or scrollable chart values.
+
+
+<h4><a name="numberFields">Numeric Input Fields</a></h4>
+
+<p>A <code>+NumField</code> returns a number from its <code>val&gt;</code>
+method, and accepts a number for its <code>set&gt;</code> method. It issues an
+error message when user input cannot be converted to a number.
+
+<p>Large numbers are shown with a thousands-separator, as determined by the
+current locale.
+
+<pre><code>
+########################################################################
+(app)
+
+(action
+   (html 0 "+NumField" "lib.css" NIL
+      (form NIL
+         (gui '(+NumField) 10)
+         (gui '(+JS +Button) "Print value"
+            '(msg (val&gt; (: home gui 1))) )
+         (gui '(+JS +Button) "Set to 123"
+            '(set&gt; (: home gui 1) 123) ) ) ) )
+########################################################################
+</code></pre>
+
+<p>A <code>+FixField</code> needs an additional scale factor argument, and
+accepts/returns scaled fixpoint numbers.
+
+<p>The decimal separator is determined by the current locale.
+
+<pre><code>
+########################################################################
+(app)
+
+(action
+   (html 0 "+FixField" "lib.css" NIL
+      (form NIL
+         (gui '(+FixField) 3 10)
+         (gui '(+JS +Button) "Print value"
+            '(msg (format (val&gt; (: home gui 1)) 3)) )
+         (gui '(+JS +Button) "Set to 123.456"
+            '(set&gt; (: home gui 1) 123456) ) ) ) )
+########################################################################
+</code></pre>
+
+
+<h4><a name="timeDateFields">Time &amp; Date</a></h4>
+
+<p>A <code>+DateField</code> accepts and returns a <code><a
+href="refD.html#date">date</a></code> value.
+
+<pre><code>
+########################################################################
+(app)
+
+(action
+   (html 0 "+DateField" "lib.css" NIL
+      (form NIL
+         (gui '(+DateField) 10)
+         (gui '(+JS +Button) "Print value"
+            '(msg (datStr (val&gt; (: home gui 1)))) )
+         (gui '(+JS +Button) "Set to \"today\""
+            '(set&gt; (: home gui 1) (date)) ) ) ) )
+########################################################################
+</code></pre>
+
+<p>The format displayed to - and entered by - the user depends on the current
+locale (see <code><a href="refD.html#datStr">datStr</a></code> and <code><a
+href="refE.html#expDat">expDat</a></code>). You can change it, for example to
+
+<pre><code>
+: (locale "DE" "de")
+-> NIL
+</code></pre>
+
+<p>If no locale is set, the format is YYYY-MM-DD. Some pre-defined locales use
+patterns like DD.MM.YYYY (DE), YYYY/MM/DD (JP), DD/MM/YYYY (UK), or MM/DD/YYYY
+(US).
+
+<p>An error is issued when user input does not match the current locale's date
+format.
+
+<p>Independent from the locale setting, a <code>+DateField</code> tries to
+expand abbreviated input from the user. A small number is taken as that day of
+the current month, larger numbers expand to day and month, or to day, month and
+year:
+
+<ul>
+<li>"7" gives the 7th of the current month
+<li>"031" or "0301" give the 3rd of January of the current year
+<li>"311" or "3101" give the 31st of January of the current year
+<li>"0311" gives the 3rd of November of the current year
+<li>"01023" or "010203" give the first of February in the year 2003
+<li>and so on
+</ul>
+
+<p>Similar is the <code>+TimeField</code>. It accepts and returns a <code><a
+href="refT.html#time">time</a></code> value.
+
+<pre><code>
+########################################################################
+(app)
+
+(action
+   (html 0 "+TimeField" "lib.css" NIL
+      (form NIL
+         (gui '(+TimeField) 8)
+         (gui '(+JS +Button) "Print value"
+            '(msg (tim$ (val&gt; (: home gui 1)))) )
+         (gui '(+JS +Button) "Set to \"now\""
+            '(set&gt; (: home gui 1) (time)) ) ) ) )
+########################################################################
+</code></pre>
+
+<p>When the field width is '8', like in this example, time is displayed in the
+format <code>HH:MM:SS</code>. Another possible value would be '5', causing
+<code>+TimeField</code> to display its value as <code>HH:MM</code>.
+
+<p>An error is issued when user input cannot be converted to a time value.
+
+<p>The user may omit the colons. If he inputs just a small number, it should be
+between '0' and '23', and will be taken as a full hour. '125' expands to
+"12:05", '124517' to "12:45:17", and so on.
+
+
+<h4><a name="telFields">Telephone Numbers</a></h4>
+
+<p>Telephone numbers are represented internally by the country code (without a
+leading plus sign or zero) followed by the local phone number (ideally separated
+by spaces) and the phone extension (ideally separated by a hyphen). The exact
+format of the phone number string is not enforced by the GUI, but further
+processing (e.g. database searches) normally uses <code><a
+href="refF.html#fold">fold</a></code> for better reproducibility.
+
+<p>To display a phone number, <code>+TelField</code> replaces the country code
+with a single zero if it is the country code of the current locale, or prepends
+it with a plus sign if it is a foreign country (see <code><a
+href="refT.html#telStr">telStr</a></code>).
+
+<p>For user input, a plus sign or a double zero is simply dropped, while a
+single leading zero is replaced with the current locale's country code (see
+<code><a href="refE.html#expTel">expTel</a></code>).
+
+<pre><code>
+########################################################################
+(app)
+(locale "DE" "de")
+
+(action
+   (html 0 "+TelField" "lib.css" NIL
+      (form NIL
+         (gui '(+TelField) 20)
+         (gui '(+JS +Button) "Print value"
+            '(msg (val&gt; (: home gui 1))) )
+         (gui '(+JS +Button) "Set to \"49 1234 5678-0\""
+            '(set&gt; (: home gui 1) "49 1234 5678-0") ) ) ) )
+########################################################################
+</code></pre>
+
+
+<h4><a name="checkboxes">Checkboxes</a></h4>
+
+<p>A <code>+Checkbox</code> is straightforward. User interaction is restricted
+to clicking it on and off. It accepts boolean (<code>NIL</code> or
+non-<code>NIL</code>) values, and returns <code>T</code> or <code>NIL</code>.
+
+<pre><code>
+########################################################################
+(app)
+
+(action
+   (html 0 "+Checkbox" "lib.css" NIL
+      (form NIL
+         (gui '(+Checkbox))
+         (gui '(+JS +Button) "Print value"
+            '(msg (val&gt; (: home gui 1))) )
+         (gui '(+JS +Button) "On"
+            '(set&gt; (: home gui 1) T) )
+         (gui '(+JS +Button) "Off"
+            '(set&gt; (: home gui 1) NIL) ) ) ) )
+########################################################################
+</code></pre>
+
+
+<p><hr>
+<h3><a name="fieldPrefix">Field Prefix Classes</a></h3>
+
+<p>A big part of this framework's power is owed to the combinatorial flexibility
+of prefix classes for GUI- and DB-objects. They allow to surgically override
+individual methods in the inheritance tree, and can be combined in various ways
+to achieve any desired behavior.
+
+<p>Technically, there is nothing special about prefix classes. They are just
+normal classes. They are called "prefix" because they are intended to be written
+<i>before</i> other classes in a class's or object's list of superclasses.
+
+<p>Usually they take their own arguments for their <code>T</code> method from
+the list of arguments to the <code>gui</code> function.
+
+
+<h4><a name="initPrefix">Initialization</a></h4>
+
+<p><code>+Init</code> overrides the <code>init&gt;</code> method for that
+component. The <code>init&gt;</code> message is sent to a <code>+gui</code>
+component when the page is loaded for the first time (during a GET request).
+<code>+Init</code> takes an expression for the initial value of that field.
+
+<pre><code>
+   (gui '(+Init +TextField) "This is the initial text" 30)
+</code></pre>
+
+<p>Other classes which automatically give a value to a field are
+<code>+Var</code> (linking the field to a variable) and <code>+E/R</code>
+(linking the field to a database entity/relation).
+
+<p><code>+Cue</code> can be used, for example in "mandatory" fields, to give a
+hint to the user about what he is supposed to enter. It will display the
+argument value, in angular brackets, if and only if the field's value is
+<code>NIL</code>, and the <code>val&gt;</code> method will return
+<code>NIL</code> despite the fact that this value is displayed.
+
+<p>Cause an empty field to display "&lt;Please enter some text here&gt;":
+
+<pre><code>
+   (gui '(+Cue +TextField) "Please enter some text here" 30)
+</code></pre>
+
+
+<h4><a name="ablePrefix">Disabling and Enabling</a></h4>
+
+<p>An important feature of an interactive GUI is the context-sensitive disabling
+and enabling of individual components, or of a whole form.
+
+<p>The <code>+Able</code> prefix class takes an argument expression, and
+disables the component if this expression returns <code>NIL</code>. We saw an
+example for its usage already in the <a href="#sqrtButton">square root
+button</a> of the calculator example. Or, for illustration purposes, imagine a
+button which is supposed to be enabled only after Christmas
+
+<pre><code>
+   (gui '(+Able +Button)
+      '(>= (cdr (date (date))) (12 24))
+      "Close this year"
+      '(endOfYearProcessing) )
+</code></pre>
+
+<p>or a password field that is disabled as long as somebody is logged in
+
+<pre><code>
+   (gui '(+Able +PwField) '(not *Login) 10 "Password")
+</code></pre>
+
+<p>A special case is the <code>+Lock</code> prefix, which permanently and
+unconditionally disables a component. It takes no arguments
+
+<pre><code>
+   (gui '(+Lock +NumField) 10 "Count")
+</code></pre>
+
+<p>('10' and "Count" are for the <code>+NumField</code>), and creates a
+read-only field.
+
+<p>The whole form can be disabled by calling <code>disable</code> with a
+non-<code>NIL</code> argument. This affects all components in this form. Staying
+with the above example, we can make the form read-only until Christmas
+
+<pre><code>
+   (form NIL
+      (disable (> (12 24) (cdr (date (date)))))  # Disable whole form
+      (gui ..)
+      .. )
+</code></pre>
+
+<p>Even in a completely disabled form, however, it is often necessary to
+re-enable certain components, as they are needed for navigation, scrolling, or
+other activities which don't affect the contents of the form. This is done by
+prefixing these fields with <code>+Rid</code> (i.e. getting "rid" of the lock).
+
+<pre><code>
+   (form NIL
+      (disable (> (12 24) (cdr (date (date)))))
+      (gui ..)
+      ..
+      (gui '(+Rid +Button) ..)  # Button is enabled despite the disabled form
+      .. )
+</code></pre>
+
+
+<h4><a name="formatPrefix">Formatting</a></h4>
+
+<p>GUI prefix classes allow a fine-grained control of how values are stored in -
+and retrieved from - components. As in predefined classes like
+<code>+NumField</code> or <code>+DateField</code>, they override the
+<code>set&gt;</code> and/or <code>val&gt;</code> methods.
+
+<p><code>+Set</code> takes an argument function which is called whenever that
+field is set to some value. To convert all user input to upper case
+
+<pre><code>
+   (gui '(+Set +TextField) uppc 30)
+</code></pre>
+
+<p><code>+Val</code> is the complement to <code>+Set</code>. It takes a function
+which is called whenever the field's value is retrieved. To return the square of
+a field's value
+
+<pre><code>
+   (gui '(+Val +NumField) '((N) (* N N)) 10)
+</code></pre>
+
+<p><code>+Fmt</code> is just a combination of <code>+Set</code> and
+<code>+Val</code>, and takes two functional arguments. This example will display
+upper case characters, while returning lower case characters internally
+
+<pre><code>
+   (gui '(+Fmt +TextField) uppc lowc 30)
+</code></pre>
+
+<p><code>+Map</code> does (like <code>+Fmt</code>) a two-way translation. It
+uses a list of cons pairs for a linear lookup, where the CARs represent the
+displayed values which are internally mapped to the values in the CDRs. If a
+value is not found in this list during <code>set&gt;</code> or
+<code>val&gt;</code>, it is passed through unchanged.
+
+<p>Normally, <code>+Map</code> is used in combination with the combo box
+incarnation of text fields (see <a href="#inputFields">Input Fields</a>). This
+example displays "One", "Two" and "Three" to the user, but returns a number 1, 2
+or 3 internally
+
+<pre><code>
+########################################################################
+(app)
+
+(action
+   (html 0 "+Map" "lib.css" NIL
+      (form NIL
+         (gui '(+Map +TextField)
+            '(("One" . 1) ("Two" . 2) ("Three" . 3))
+            '("One" "Two" "Three") )
+         (gui '(+Button) "Print"
+            '(msg (val> (field -1))) ) ) ) )
+########################################################################
+</code></pre>
+
+
+<h4><a name="sideEffects">Side Effects</a></h4>
+
+<p>Whenever a button is pressed in the GUI, any changes caused by
+<code>action</code> in the current environment (e.g. the database or application
+state) need to be reflected in the corresponding GUI fields. For that, the
+<code>upd&gt;</code> message is sent to all components. Each component then
+takes appropriate measures (e.g. refresh from database objects, load values from
+variables, or calculate a new value) to update its value.
+
+<p>While the <code>upd&gt;</code> method is mainly used internally, it can be
+overridden in existing classes via the <code>+Upd</code> prefix class. Let's
+print updated values to standard error
+
+<pre><code>
+########################################################################
+(app)
+(default *Number 0)
+
+(action
+   (html 0 "+Upd" "lib.css" NIL
+      (form NIL
+         (gui '(+Upd +Var +NumField)
+            '(prog (extra) (msg *Number))
+            '*Number 8 )
+         (gui '(+JS +Button) "Increment"
+            '(inc '*Number) ) ) ) )
+########################################################################
+</code></pre>
+
+
+<h4><a name="validPrefix">Validation</a></h4>
+
+<p>To allow automatic validation of user input, the <code>chk&gt;</code> message
+is sent to all components at appropriate times. The corresponding method should
+return <code>NIL</code> if the value is all right, or a string describing the
+error otherwise.
+
+<p>Many of the built-in classes have a <code>chk&gt;</code> method. The
+<code>+NumField</code> class checks for legal numeric input, or the
+<code>+DateField</code> for a valid calendar date.
+
+<p>An on-the-fly check can be implemented with the <code>+Chk</code> prefix
+class. The following code only accepts numbers not bigger than 9: The
+<code>or</code> expression first delegates the check to the main
+<code>+NumField</code> class, and - if it does not give an error - returns an
+error string when the current value is greater than 9.
+
+<pre><code>
+########################################################################
+(app)
+
+(action
+   (html 0 "+Chk" "lib.css" NIL
+      (form NIL
+         (gui '(+Chk +NumField)
+            '(or
+               (extra)
+               (and (&gt; (val&gt; This) 9) "Number too big") )
+            12 )
+         (gui '(+JS +Button) "Print"
+            '(msg (val&gt; (field -1))) ) ) ) )
+########################################################################
+</code></pre>
+
+<p>A more direct kind of validation is built-in via the <code>+Limit</code>
+class. It controls the <code>maxlength</code> attribute of the generated HTML
+input field component. Thus, it is impossible to type to more characters than
+allowed into the field.
+
+<pre><code>
+########################################################################
+(app)
+
+(action
+   (html 0 "+Limit" "lib.css" NIL
+      (form NIL
+         (gui '(+Limit +TextField) 4 8)
+         (gui '(+JS +Button) "Print"
+            '(msg (val&gt; (field -1))) ) ) ) )
+########################################################################
+</code></pre>
+
+
+<h4><a name="linkage">Data Linkage</a></h4>
+
+<p>Although <code>set&gt;</code> and <code>val&gt;</code> are the official
+methods to get a value in and out of a GUI component, they are not very often
+used explicitly. Instead, components are directly linked to internal Lisp data
+structures, which are usually either variables or database objects.
+
+<p>The <code>+Var</code> prefix class takes a variable (described as the
+<code>var</code> data type - either a symbol or a cell - in the <a
+href="ref.html#fun">Function Reference</a>). In the following example, we
+initialize a global variable with the value "abc", and let a
+<code>+TextField</code> operate on it. The "Print" button can be used to display
+its current value.
+
+<pre><code>
+########################################################################
+(app)
+
+(setq *TextVariable "abc")
+
+(action
+   (html 0 "+Var" "lib.css" NIL
+      (form NIL
+         (gui '(+Var +TextField) '*TextVariable 8)
+         (gui '(+JS +Button) "Print"
+            '(msg *TextVariable) ) ) ) )
+########################################################################
+</code></pre>
+
+<p><code>+E/R</code> takes an entity/relation specification. This is a cell,
+with a relation in its CAR (e.g. <code>nm</code>, for an object's name), and an
+expression in its CDR (typically <code>(: home obj)</code>, the object stored in
+the <code>obj</code> property of the current form).
+
+<p>For an isolated, simple example, we create a temporary database, and access
+the <code>nr</code> and <code>nm</code> properties of an object stored in a
+global variable <code>*Obj</code>.
+
+<pre><code>
+########################################################################
+(when (app)                # On start of session
+   (class +Tst +Entity)    # Define data model
+   (rel nr (+Number))      # with a number
+   (rel nm (+String))      # and a string
+   (pool (tmp "db"))       # Create temporary DB
+   (setq *Obj              # and a single object
+      (new! '(+Tst) 'nr 1 'nm "New Object") ) )
+
+(action
+   (html 0 "+E/R" "lib.css" NIL
+      (form NIL
+         (gui '(+E/R +NumField) '(nr . *Obj) 8)    # Linkage to 'nr'
+         (gui '(+E/R +TextField) '(nm . *Obj) 20)  # Linkage to 'nm'
+         (gui '(+JS +Button) "Show"                # Show the object
+            '(out 2 (show *Obj)) ) ) ) )           # on standard error
+########################################################################
+</code></pre>
+
+
+<p><hr>
+<h3><a name="buttons">Buttons</a></h3>
+
+<p>Buttons are, as explained in <a href="#ctlFlow">Control Flow</a>, the only
+way (via POST requests) for an application to communicate with the server.
+
+<p>Basically, a <code>+Button</code> takes
+
+<ul>
+<li>a label, which may be either a string or the name of an image file
+<li>an optional alternative label, shown when the button is disabled
+<li>and an executable expression.
+</ul>
+
+<p>Here is a minimal button, with just a label and an expression:
+
+<pre><code>
+   (gui '(+Button) "Label" '(doSomething))
+</code></pre>
+
+<p>And this is a button displaying different labels, depending on the state:
+
+<pre><code>
+   (gui '(+Button) "Enabled" "Disabled" '(doSomething))
+</code></pre>
+
+<p>To show an image instead of plain text, the label(s) must be preceeded by the
+<code>T</code> symbol:
+
+<pre><code>
+   (gui '(+Button) T "img/enabled.png" "img/disabled.png" '(doSomething))
+</code></pre>
+
+<p>The expression will be executed during <code>action</code> handling (see <a
+href="#actionForms">Action Forms</a>), when this button was pressed.
+
+<p>Like other components, buttons can be extended and combined with prefix
+classes, and a variety of predefined classes and class combinations are
+available.
+
+
+<h4><a name="dialogButtons">Dialog Buttons</a></h4>
+
+<p>Buttons are essential for the handling of <a href="#dialogs">alerts and
+dialogs</a>. Besides buttons for normal functions, like <a
+href="#scrolling">scrolling</a> in charts or other <a href="#sideEffects">side
+effects</a>, special buttons exist which can <i>close</i> an alert or dialog in
+addition to doing their principal job.
+
+<p>Such buttons are usually subclasses of <code>+Close</code>, and most of them
+can be called easily with ready-made functions like <code>closeButton</code>,
+<code>cancelButton</code>, <code>yesButton</code> or <code>noButton</code>. We
+saw a few examples in <a href="#dialogs">Alerts and Dialogs</a>.
+
+
+<h4><a name="jsButtons">Active JavaScript</a></h4>
+
+<p>When a button inherits from the <code>+JS</code> class (and JavaScript is
+enabled in the browser), that button will possibly show a much faster response
+in its action.
+
+<p>The reason is that the activation of a <code>+JS</code> button will - instead
+of doing a normal POST - first try to send only the contents of all GUI
+components via an XMLHttpRequest to the server, and receive the updated values
+in response. This avoids the flicker caused by reloading and rendering of the
+whole page, is much faster, and also does not jump to the beginning of the page
+if it is larger than the browser window. The effect is especially noticeable
+while scrolling in charts.
+
+<p>Only if this fails, for example because an error message was issued, or a
+dialog popped up, it will fall back, and the form will be POSTed in the normal
+way.
+
+<p>Thus it makes no sense to use the <code>+JS</code> prefix for buttons that
+cause a change of the HTML code, open a dialog, or jump to another page. In such
+cases, overall performance will even be worse, because the XMLHttpRequest is
+tried first (but in vain).
+
+<p>When JavaScript is disabled int the browser, the XMLHttpRequest will not be
+tried at all. The form will be fully usable, though, with identical
+functionality and behavior, just a bit slower and not so smooth.
+
+
+<p><hr>
+<h2><a name="minApp">A Minimal Complete Application</a></h2>
+
+<p>The PicoLisp release includes in the "app/" directory a minimal, yet complete
+reference application. This application is typical, in the sense that it
+implements many of the techniques described in this document, and it can be
+easily modified and extended. In fact, we use it as templates for our own
+production application development.
+
+<p>It is a kind of simplified ERP system, containing customers/suppliers,
+products (items), orders, and other data. The order input form performs live
+updates of customer and product selections, price, inventory and totals
+calculations, and generates on-the-fly PDF documents. Fine-grained access
+permissions are controlled via users, roles and permissions. It comes localized
+in four languages (English, German, Russian and Japanese), with a some initial
+data and two sample reports.
+
+
+<p><hr>
+<h3><a name="getStarted">Getting Started</a></h3>
+
+<p>As ever, you may start up the application in debugging mode
+
+<pre><code>
+$ ./dbg app/main.l -main -go
+</code></pre>
+
+<p>or in (non-debug) production mode
+
+<pre><code>
+$ ./p app/main.l -main -go -wait
+</code></pre>
+
+<p>and go to '<code><a
+href="http://localhost:8080">http://localhost:8080</a></code>' with your
+browser. You can login as user "admin", with password "admin". The demo data
+contain several other users, but those are more restricted in their role
+permissions.
+
+<p>Another possibility is to try the online version of this application at <a
+href="http://app.7fach.de">app.7fach.de</a>.
+
+
+<h4><a name="localization">Localization</a></h4>
+
+<p>Before or after you logged in, you can select another language, and click on
+the "Change" button. This will effect all GUI components (though not text from
+the database), and also the numeric, date and telephone number formats.
+
+
+<h4><a name="navigation">Navigation</a></h4>
+
+<p>The navigation menu on the left side shows two items "Home" and "logout", and
+three submenus "Data", "Report" and "System".
+
+<p>Both "Home" and "logout" bring you back to the initial login form. Use
+"logout" if you want to switch to another user (say, for another set of
+permissions), and - more important - before you close your browser, to release
+possible locks and process resources on the server.
+
+<p>The "Data" submenu gives access to application specific data entry and
+maintenance: Orders, product items, customers and suppliers. The "Report"
+submenu contains two simple inventory and sales reports. And the "System"
+submenu leads to role and user administration.
+
+<p>You can open and close each submenu individually. Keeping more than one
+submenu open at a time lets you switch rapidly between different parts of the
+application.
+
+<p>The currently active menu item is indicated by a highlighted list style (no
+matter whether you arrived at this page directly via the menu or by clicking on
+a link somewhere else).
+
+
+<h4><a name="choosing">Choosing Objects</a></h4>
+
+<p>Each item in the "Data" or "System" submenu opens a search dialog for that
+class of entities. You can specify a search pattern, press the top right
+"Search" button (or just ENTER), and scroll through the list of results.
+
+<p>While the "Role" and "User" entities present simple dialogs (searching just
+by name), other entities can be searched by a variety of criteria. In those
+cases, a "Reset" button clears the contents of the whole dialog. A new object
+can be created with bottom right "New" button.
+
+<p>In any case, the first column will contain either a "@"-link (to jump to that
+object) or a "@"-button (to insert a reference to that object into the current
+form).
+
+<p>By default, the search will list all database objects with an attribute value
+greater than or equal to the search criterion. The comparison is done
+arithmetically for numbers, and alphabetically (case sensitive!) for text. This
+means, if you type "Free" in the "City" field of the "Customer/Supplier" dialog,
+the value of "Freetown" will be matched. On the other hand, an entry of "free"
+or "town" will yield no hits.
+
+<p>Some search fields, however, show a different behavior depending on the
+application:
+
+<ul>
+<li>The names of persons, companies or products allow a tolerant search,
+matching either a slightly misspelled name ("Mühler" instead of "Miller") or a
+substring ("Oaks" will match "Seven Oaks Ltd.").
+
+<li>The search field may specify an upper instead of a lower limit, resulting in
+a search for database objects with an attribute value less than or equal to the
+search criterion. This is useful, for example in the "Order" dialog, to list
+orders according to their number or date, by starting with the newest then and
+going backwards.
+
+</ul>
+
+<p>Using the bottom left scroll buttons, you can scroll through the result list
+without limit. Clicking on a link will bring up the corresponding object. Be
+careful here to select the right column: Some dialogs (those for "Item" and
+"Order") also provide links for related entities (e.g. "Supplier").
+
+
+<h4><a name="editing">Editing</a></h4>
+
+<p>A database object is usually displayed in its own individual form, which is
+determined by its entity class.
+
+<p>The basic layout should be consistent for all classes: Below the heading
+(which is usually the same as the invoking menu item) is the object's identifier
+(name, number, etc.), and then a row with an "Edit" button on the left, and
+"Delete" button, a "Select" button and two navigation links on the right side.
+
+<p>The form is brought up initially in read-only mode. This is necessary to
+prevent more than one user from modifying an object at the same time (and
+contrary to the previous PicoLisp Java frameworks, where this was not a problem
+because all changes were immediately reflected in the GUIs of other users).
+
+<p>So if you want to modify an object, you have to gain exclusive access by
+clicking on the "Edit" button. The form will be enabled, and the "Edit" button
+changes to "Done". Should any other user already have reserved this object, you
+will see a message telling his name and process ID.
+
+<p>An exception to this are objects that were just created with "New". They will
+automatically be reserved for you, and the "Edit" button will show up as "Done".
+
+<p>The "Delete" button pops up an alert, asking for confirmation. If the object
+is indeed deleted, this button changes to "Restore" and allows to undelete the
+object. Note that objects are never completely deleted from the database as long
+as there are any references from other objects. When a "deleted" object is
+shown, its identifier appears in square brackets.
+
+<p>The "Select" button (re-)displays the search dialog for this class of
+entities. The search criteria are preserved between invocations of each dialog,
+so that you can conveniently browse objects in this context.
+
+<p>The navigation links, pointing left and right, serve a similar purpose. They
+let you step sequentially through all objects of this class, in the order of the
+identifier's index.
+
+<p>Other buttons, depending on the entity, are usually arranged at the bottom of
+the form. The bottom rightmost one should always be another "Edit" / "Done"
+button.
+
+<p>As we said in the chapter on <a href="#scrolling">Scrolling</a>, any button
+in the form will save changes to the underlying data model. As a special case,
+however, the "Done" button releases the object and reverts to "Edit". Besides
+this, the edit mode will also cease as soon as another object is displayed, be
+it by clicking on an object link (the pencil icon), the top right navigation
+links, or a link in a search dialog.
+
+
+<h4><a name="btnLinks">Buttons vs. Links</a></h4>
+
+<p>The only way to interact with a HTTP-based application server is to click
+either on a HTML link, or on a submit button (see also <a
+href="#ctlFlow">Control Flow</a>). It is essential to understand the different
+effects of such a click on data entered or modified in the current form.
+
+<ul>
+<li>A click on a link will leave or reload the page. Changes are discarded.
+<li>A click on a button will commit changes, and perform the associated action.
+</ul>
+
+<p>For that reason the layout design should clearly differentiate between links
+and buttons. Image buttons are not a good idea when in other places images are
+used for links. The standard button components should be preferred; they are
+usually rendered by the browser in a non-ambiguous three-dimensional look and
+feel.
+
+<p>Note that if JavaScript is enabled in the browser, changes will be
+automatically committed to the server.
+
+<p>The enabled or disabled state of a button is an integral part of the
+application logic. It must be indicated to the user with appropriate styles.
+
+
+<p><hr>
+<h3><a name="dataModel">The Data Model</a></h3>
+
+<p>The data model for this mini application consists of only six entity classes
+(see the E/R diagram at the beginning of "app/er.l"):
+
+<ul>
+<li>The three main entities are <code>+CuSu</code> (Customer/Supplier),
+<code>+Item</code> (Product Item) and <code>+Ord</code> (Order).
+
+<li>A <code>+Pos</code> object is a single position in an order.
+
+<li><code>+Role</code> and <code>+User</code> objects are needed for
+authentication and authorization.
+
+</ul>
+
+<p>The classes <code>+Role</code> and <code>+User</code> are defined in
+"lib/adm.l". A <code>+Role</code> has a name, a list of permissions, and a list
+of users assigned to this role. A <code>+User</code> has a name, a password and
+a role.
+
+<p>In "app/er.l", the <code>+Role</code> class is extended to define an
+<code>url&gt;</code> method for it. Any object whose class has such a method is
+able to display itself in the GUI. In this case, the file "app/role.l" will be
+loaded - with the global variable <code>*ID</code> pointing to it - whenever an
+HTML link to this role object is activated.
+
+<p>The <code>+User</code> class is also extended. In addition to the login name,
+a full name, telephone number and email address is declared. And, of course, the
+ubiquitous <code>url&gt;</code> method.
+
+<p>The application logic is centered around orders. An order has a number, a
+date, a customer (an instance of <code>+CuSu</code>) and a list of positions
+(<code>+Pos</code> objects). The <code>sum&gt;</code> method calculates the
+total amount of this order.
+
+<p>Each position has an <code>+Item</code> object, a price and a quantity. The
+price in the position overrides the default price from the item.
+
+<p>Each item has a number, a description, a supplier (also an instance of
+<code>+CuSu</code>), an inventory count (the number of these items that were
+counted at the last inventory taking), and a price. The <code>cnt&gt;</code>
+method calculates the current stock of this item as the difference of the
+inventory and the sold item counts.
+
+<p>The call to <code>dbs</code> at the end of "app/er.l" configures the physical
+database storage. Each of the supplied lists has a number in its CAR which
+determines the block size as (64 &lt;&lt; N) of the corresponding database file.
+The CDR says that the instances of this class (if the element is a class symbol)
+or the tree nodes (if the element is a list of a class symbol and a property
+name) are to be placed into that file. This allows for some optimizations in the
+database layout.
+
+
+<p><hr>
+<h3><a name="usage">Usage</a></h3>
+
+<p>When you are connected to the application (see <a href="#getStarted">Getting
+Started</a>) you might try to do some "real" work with it. Via the "Data" menu
+(see <a href="#navigation">Navigation</a>) you can create or modify customers,
+suppliers, items and orders, and produce simple overviews via the "Report" menu.
+
+
+<h4><a name="cuSu">Customer/Supplier</a></h4>
+
+<p align=right>Source in "app/cusu.l"
+
+<p>The Customer/Supplier search dialog (<code>choCuSu</code> in "app/gui.l")
+supports a lot of search criteria. These become necessary when the database
+contains a large number of customers, and can filter by zip, by phone number
+prefixes, and so on.
+
+<p>In addition to the basic layout (see <a href="#editing">Editing</a>), the
+form is divided into four separate tabs. Splitting a form into several tabs
+helps to reduce traffic, with possibly better GUI response. In this case, four
+tabs are perhaps overkill, but ok for demonstration purposes, and they leave
+room for extensions.
+
+<p>Be aware that when data were modified in one of the tabs, the "Done" button
+has to be pressed before another tab is clicked, because tabs are implemented as
+HTML links (see <a href="#btnLinks">Buttons vs. Links</a>).
+
+<p>New customers or suppliers will automatically be assigned the next free
+number. You can enter another number, but an error will result if you try to use
+an existing number. The "Name" field is mandatory, you need to overwrite the
+"&lt;Name&gt;" clue.
+
+<p>Phone and fax numbers in the "Contact" tab must be entered in the correct
+format, depending on the locale (see <a href="#telFields">Telephone
+Numbers</a>).
+
+<p>The "Memo" tab contains a single text area. It is no problem to use it for
+large pieces of text, as it gets stored in a database blob internally.
+
+
+<h4><a name="item">Item</a></h4>
+
+<p align=right>Source in "app/item.l"
+
+<p>Items also have a unique number, and a mandatory "Description" field.
+
+<p>To assign a supplier, click on the "+" button. The Customer/Supplier search
+dialog will appear, and you can pick the desired supplier with the "@" button in
+the first column. Alternatively, if you are sure to know the exact spelling of
+the supplier's name, you can also enter it directly into the text field.
+
+<p>In the search dialog you may also click on a link, for example to inspect a
+possible supplier, and then return to the search dialog with the browser's back
+button. The "Edit" mode will then be lost, however, as another object has been
+visited (this is described in the last part of <a href="#editing">Editing</a>).
+
+<p>You can enter an inventory count, the number of items currently in stock. The
+following field will automatically reflect the remaining pieces after some of
+these items were sold (i.e. referenced in order positions). It cannot be changed
+manually.
+
+<p>The price should be entered with the decimal separator according to the
+current locale. It will be formatted with two places after the decimal
+separator.
+
+<p>The "Memo" is for an arbitrary info text, like in <a
+href="#cuSu">Customer/Supplier</a> above, stored in a database blob.
+
+<p>Finally, a JPEG picture can be stored in a blob for this item. Choose a file
+with the browser's file select control, and click on the "Install" button. The
+picture will appear at the bottom of the page, and the "Install" button changes
+to "Uninstall", allowing the picture's removal.
+
+
+<h4><a name="order">Order</a></h4>
+
+<p align=right>Source in "app/ord.l"
+
+<p>Oders are identified by number and date.
+
+<p>The number must be unique. It is assigned when the order is created, and
+cannot be changed for compliance reasons.
+
+<p>The date is initialized to "today" for a newly created order, but may be
+changed manually. The date format depends on the locale. It is YYYY-MM-DD (ISO)
+by default, DD.MM.YYYY in the German and YYYY/MM/DD in the Japanese locale. As
+described in <a href="#timeDateFields">Time &amp; Date</a>, this field allows
+input shortcuts, e.g. just enter the day to get the full date in the current
+month.
+
+<p>To assign a customer to this order, click on the "+" button. The
+Customer/Supplier search dialog will appear, and you can pick the desired
+customer with the "@" button in the first column (or enter the name directly
+into the text field), just as described above for <a href="#item">Item</a>s.
+
+<p>Now enter order the positions: Choose an item with the "+" button. The
+"Price" field will be preset with the item's default price, you may change it
+manually. Then enter a quantity, and click a button (typically the "+" button to
+select the next item, or a scroll button go down in the chart). The form will be
+automatically recalculated to show the total prices for this position and the
+whole order.
+
+<p>Instead of the "+" or scroll buttons, as recommended above, you could of
+course also press the "Done" button to commit changes. This is all right, but
+has the disadvantage that the button must be pressed a second time (now "Edit")
+if you want to continue with the entry of more positions.
+
+<p>The "x" button at the right of each position deletes that position without
+further confirmation. It has to be used with care!
+
+<p>The "^" button is a "bubble" button. It exchanges a row with the row above it.
+Therefore, it can be used to rearrange all items in a chart, by "bubbling" them
+to their desired positions.
+
+<p>The "PDF-Print" button generates and displays a PDF document for this order.
+The browser should be configured to display downloaded PDF documents in an
+appropriate viewer. The source for the postscript generating method is in
+"app/lib.l". It produces one or several A4 sized pages, depending on the number
+of positions.
+
+
+<h4><a name="reports">Reports</a></h4>
+
+<p align=right>Sources in "app/inventory.l and "app/sales.l"
+
+<p>The two reports ("Inventory" and "Sales") come up with a few search fields
+and a "Show" button.
+
+<p>If no search criteria are entered, the "Show" button will produce a listing
+of the relevant part of the whole database. This may take a long time and cause
+a heavy load on the browser if the database is large.
+
+<p>So in the normal case, you will limit the domain by stating a range of item
+numbers, a description pattern, and/or a supplier for the inventory report, or a
+range of order dates and/or a customer for the sales report. If a value in a
+range specification is omitted, the range is considered open in that direction.
+
+<p>At the end of each report appears a "CSV" link. It downloads a file with the
+TAB-separated values generated by this report.
+
+</body>
+</html>
diff --git a/doc/apply b/doc/apply
@@ -0,0 +1,30 @@
+         Apply/Mapping
+
+
+      ApplyBody
+      |
+      V
+      +-----+-----+
+      |  /  |  |  |
+      +-----+--+--+
+               |
+   +-----------+
+   |
+   |                       +--------------------------+
+   |                       |                          |
+   |     +--------------------------+                 |
+   |     |                 |        |                 |
+   |     V                 V        |                 |
+   |     +-----+-----+     +-----+--+--+     +-----+--+--+
+   |     |  |  |  /  |     |  |  |  |  |     |  |  |  |  |  <-- ApplyArgs
+   |     +--+--+-----+     +--+--+-----+     +--+--+-----+
+   |        |                 |                 |
+   |        V                 V                 V
+   |        +-----+-----+     +-----+-----+     +-----+-----+
+   +------> |  |  |  ---+---> |  |  |  ---+---> |  |  |  /  |
+            +--+--+-----+     +--+--+-----+     +--+--+-----+
+               |                 |                 |
+               V                 V                 V
+         +-----+-----+     +-----+-----+     +-----+-----+
+         |  1  |  /  |     |  2  |  /  |     |  3  |  /  |
+         +-----+-----+     +-----+-----+     +-----+-----+
diff --git a/doc/db b/doc/db
@@ -0,0 +1,91 @@
+   Max DB-Size: 7 digits -> 2**42 (4 Tera) Blocks
+      Blocksize 64 -> (2**48 Bytes (256 TB))
+
+   Tree
+      NIL               -> (val *DB)
+      {x}               -> (val '{x})
+      (var . {x})       -> (get '{x} 'var)
+      (var . +Cls)      -> (get *DB '+Cls 'var)
+      (var +Cls . {x})  -> (get '{x} '+Cls 'var)
+
+   B-Tree root:
+      (cnt . node)
+
+   B-Tree node:
+      (less (key more . value) (key more . value) ..)
+
+   Per node
+      <Link> BEG EXTERN <6> .. NIX
+      6+1+1+6+1 = 15
+
+   Per key
+      BEG TRANSIENT <key> EXTERN <7> DOT EXTERN <7>
+      1+1+<key>+1+6+1+1+7 = 18 + <key>
+
+
+   Key Arguments for DB- and Pilog-functions:
+
+      123, {abc}     -> (123) (123 . T)
+      T              -> All
+      "abc"          -> ("abc") ("abcT" . T)
+
+      (a b)          -> (a b) (a b . T)
+      ((a 1) b 2)    -> (a 1) (b 2 . T)
+
+      (a . b)        -> (a) (b . T)
+      (b . a)        -> (b . T) (a)
+
+
+   loaded/dirty/deleted
+
+            |                 |                 |                 |
+            |       (1)       |       (2)       |       (3)       |
+            |                 |                 |                 |
+   ---------+-----------------+-----------------+-----------------+
+            |  load           |  load           |  empty          |
+    NIL     |  -> loaded      |  -> dirty       |  -> deleted     |
+            |                 |                 |                 |
+   ---------+-----------------+-----------------+-----------------+
+            |                 |                 |  empty          |
+    loaded  |                 |  -> dirty       |  -> deleted     |
+            |                 |                 |                 |
+   ---------+-----------------+-----------------+-----------------+
+            |                 |                 |  empty          |
+    dirty   |                 |                 |  -> deleted     |
+            |                 |                 |                 |
+   ---------+-----------------+-----------------+-----------------+
+            |                 |                 |                 |
+    deleted |                 |                 |                 |
+            |                 |                 |                 |
+
+
+                |                 |                 |
+                |     commit      |    rollback     |
+                |                 |                 |
+   -------------+-----------------+-----------------+
+                |                 |                 |
+        NIL     |                 |                 |
+                |                 |                 |
+   -------------+-----------------+-----------------+
+                |                 |  empty          |
+    (1) loaded  |                 |  -> NIL         |
+                |                 |                 |
+   -------------+-----------------+-----------------+
+                |  save           |  empty          |
+    (2) dirty   |  -> loaded      |  -> NIL         |
+                |                 |                 |
+   -------------+-----------------+-----------------+
+                |  empty          |  empty          |
+    (3) deleted |  -> NIL         |  -> NIL         |
+                |                 |                 |
+
+
+
+   +-----+-----+
+   | V1  |  |  |
+   +-----+--+--+
+            |
+            V
+         +-----+-----+     +-----+-----+
+         | P1  |  ---+---> |  N  |  ---+---> @@
+         +-----+-----+     +-----+-----+
diff --git a/doc/doc.css b/doc/doc.css
@@ -0,0 +1,12 @@
+/* 19may07abu
+ * (c) Software Lab. Alexander Burger
+ */
+
+body {
+   margin-left: 80px;
+   margin-right: 60px
+}
+
+code {
+   color: rgb(0%,40%,0%);
+}
diff --git a/doc/family.l b/doc/family.l
@@ -0,0 +1,242 @@
+# 04feb10abu
+# (c) Software Lab. Alexander Burger
+
+(load "lib/http.l" "lib/xhtml.l" "lib/form.l" "lib/ps.l")
+
+### DB ###
+(class +Person +Entity)
+(rel nm (+Need +Sn +Idx +String))      # Name
+(rel pa (+Joint) kids (+Man))          # Father
+(rel ma (+Joint) kids (+Woman))        # Mother
+(rel mate (+Joint) mate (+Person))     # Partner
+(rel job (+Ref +String))               # Occupation
+(rel dat (+Ref +Date))                 # born
+(rel fin (+Ref +Date))                 # died
+(rel txt (+String))                    # Info
+
+(dm url> (Tab)
+   (list "@person" '*ID This) )
+
+
+(class +Man +Person)
+(rel kids (+List +Joint) pa (+Person)) # Children
+
+(class +Woman +Person)
+(rel kids (+List +Joint) ma (+Person)) # Children
+
+(dbs
+   (0)                                 # (1 . 64)
+   (2 +Person)                         # (2 . 256)
+   (3 (+Person nm))                    # (3 . 512)
+   (3 (+Person job dat fin)) )         # (4 . 512)
+
+
+### GUI ###
+(de choPerson (Dst)
+   (diaform '(Dst)
+      (<grid> "--.-.-."
+         "Name" (gui 'nm '(+Focus +Var +TextField) '*PrsNm 20)
+         "Occupation" (gui 'job '(+Var +TextField) '*PrsJob 20)
+         "born" (prog
+            (gui 'dat1 '(+Var +DateField) '*PrsDat1 10)
+            (gui 'dat2 '(+Var +DateField) '*PrsDat2 10) )
+         (searchButton '(init> (: home query)))
+         "Father" (gui 'pa '(+Var +TextField) '*PrsPa 20)
+         "Mother" (gui 'ma '(+Var +TextField) '*PrsMa 20)
+         "Partner" (gui 'mate '(+Var +TextField) '*PrsMate 20)
+         (resetButton '(nm pa ma mate job dat1 dat2 query)) )
+      (gui 'query '(+QueryChart) (cho)
+         '(goal
+            (quote
+               @Nm *PrsNm
+               @Pa *PrsPa
+               @Ma *PrsMa
+               @Mate *PrsMate
+               @Job *PrsJob
+               @Dat (and (or *PrsDat1 *PrsDat2) (cons *PrsDat1 (or *PrsDat2 T)))
+               (select (@@)
+                  ((nm +Person @Nm)
+                     (nm +Person @Pa kids)
+                     (nm +Person @Ma kids)
+                     (nm +Person @Mate mate)
+                     (job +Person @Job)
+                     (dat +Person @Dat) )
+                  (tolr @Nm @@ nm)
+                  (tolr @Pa @@ pa nm)
+                  (tolr @Ma @@ ma nm)
+                  (tolr @Mate @@ mate nm)
+                  (head @Job @@ job)
+                  (range @Dat @@ dat) ) ) )
+         7
+         '((This) (list This This (: pa) (: ma) (: mate) (: job) (: dat))) )
+      (<table> 'chart NIL
+         '((btn) (NIL "Name") (NIL "Father") (NIL "Mother") (NIL "Partner") (NIL "Occupation") (NIL "born"))
+         (do (cho)
+            (<row> (alternating)
+               (gui 1 '(+DstButton) Dst)
+               (gui 2 '(+ObjView +TextField) '(: nm))
+               (gui 3 '(+ObjView +TextField) '(: nm))
+               (gui 4 '(+ObjView +TextField) '(: nm))
+               (gui 5 '(+ObjView +TextField) '(: nm))
+               (gui 6 '(+TextField))
+               (gui 7 '(+DateField)) ) ) )
+      (<spread>
+         (scroll (cho))
+         (<nbsp> 4)
+         (prin "Man")
+         (newButton T Dst '(+Man) 'nm *PrsNm)
+         (<nbsp>)
+         (prin "Woman")
+         (newButton T Dst '(+Woman) 'nm *PrsNm)
+         (<nbsp> 4)
+         (cancelButton) ) ) )
+
+# Person HTML Page
+(de person ()
+   (app)
+   (action
+      (html 0 (get (default *ID (val *DB)) 'nm) "lib.css" NIL
+         (form NIL
+            (<h2> NIL (<id> (: nm)))
+            (panel T "Person '@1'" T '(choPerson) 'nm '+Person)
+            (<p> NIL
+               (gui '(+E/R +TextField) '(nm : home obj) 40 "Name")
+               (gui '(+ClassField) '(: home obj) '(("Male" +Man) ("Female" +Woman))) )
+            (<grid> 5
+               "Occupation" (gui '(+E/R +TextField) '(job : home obj) 20)
+               "Father" (gui '(+ChoButton) '(choPerson (field 1)))
+               (gui '(+E/R +Obj +TextField) '(pa : home obj) '(nm +Man) 30)
+               "born" (gui '(+E/R +DateField) '(dat : home obj) 10)
+               "Mother" (gui '(+ChoButton) '(choPerson (field 1)))
+               (gui '(+E/R +Obj +TextField) '(ma : home obj) '(nm +Woman) 30)
+               "died" (gui '(+E/R +DateField) '(fin : home obj) 10)
+               "Partner" (gui '(+ChoButton) '(choPerson (field 1)))
+               (gui '(+E/R +Obj +TextField) '(mate : home obj) '(nm +Person) 30) )
+            (gui '(+E/R +Chart) '(kids : home obj) 5
+               '((This) (list NIL This (: dat) (: pa) (: ma)))
+               cadr )
+            (<table> NIL NIL
+               '(NIL (NIL "Children") (NIL "born") (NIL "Father") (NIL "Mother"))
+               (do 4
+                  (<row> NIL
+                     (gui 1 '(+ChoButton) '(choPerson (field 1)))
+                     (gui 2 '(+Obj +TextField) '(nm +Person) 20)
+                     (gui 3 '(+E/R +DateField) '(dat curr) 10)
+                     (gui 4 '(+ObjView +TextField) '(: nm) 20)
+                     (gui 5 '(+ObjView +TextField) '(: nm) 20) ) )
+               (<row> NIL NIL (scroll 4)) )
+            (----)
+            (gui '(+E/R +TextField) '(txt : home obj) 40 4)
+            (gui '(+Rid +Button) "Contemporaries"
+               '(url "@contemporaries" (: home obj)) )
+            (gui '(+Rid +Button) "Tree View"
+               '(url "@treeReport" (: home obj)) )
+            (editButton T) ) ) ) )
+
+
+### Reports ###
+# Show all contemporaries of a person
+(de contemporaries (*ID)
+   (action
+      (html 0 "Contemporaries" "lib.css" NIL
+         (form NIL
+            (<h3> NIL (<id> "Contemporaries of " (: nm)))
+            (ifn (: obj dat)
+               (<h3> NIL (ht:Prin "No birth date for " (: obj nm)))
+               (gui '(+QueryChart) 12
+                  '(goal
+                     (quote
+                        @Obj (: home obj)
+                        @Dat (: home obj dat)
+                        @Beg (- (: home obj dat) 36525)
+                        @Fin (or (: home obj fin) (+ (: home obj dat) 36525))
+                        (db dat +Person (@Beg . @Fin) @@)
+                        (different @@ @Obj)
+                        (@ >= (get (-> @@) 'fin) (-> @Dat))
+                        (@ <= (get (-> @@) 'dat) (-> @Fin)) ) )
+                  7
+                  '((This)
+                     (list This (: job) (: dat) (: fin) (: pa) (: ma) (: mate)) ) )
+               (<table> NIL (pack (datStr (: obj dat)) " - " (datStr (: obj fin)))
+                  (quote
+                     (NIL "Name") (NIL "Occupation") (NIL "born") (NIL "died")
+                     (NIL "Father") (NIL "Mother") (NIL "Partner") )
+                  (do 12
+                     (<row> NIL
+                        (gui 1 '(+ObjView +TextField) '(: nm))
+                        (gui 2 '(+TextField))
+                        (gui 3 '(+DateField))
+                        (gui 4 '(+DateField))
+                        (gui 5 '(+ObjView +TextField) '(: nm))
+                        (gui 6 '(+ObjView +TextField) '(: nm))
+                        (gui 7 '(+ObjView +TextField) '(: nm)) ) ) )
+               (scroll 12)
+               (----)
+               (gui '(+Rid +Button) "Textfile"
+                  '(let Txt (tmp "Contemporaries.txt")
+                     (out Txt (txt> (chart)))
+                     (url Txt) ) )
+               (gui '(+Rid +Button) "PDF"
+                  '(psOut NIL "Contemporaries"
+                     (out (tmp "Contemporaries.txt")
+                        (txt> (chart)) )
+                     (in (tmp "Contemporaries.txt")
+                        (let (Page 1  Fmt (200 120 50 50 120 120 120)  Ttl (line T))
+                           (a4L)
+                           (font (7 . "Helvetica"))
+                           (indent 30 10)
+                           (down 12)
+                           (font 9 (ps Ttl))
+                           (down 12)
+                           (table Fmt
+                              "Name" "Occupation" "born" "died" "Father" "Mother" "Partner" )
+                           (down 6)
+                           (pages 560
+                              (page T)
+                              (down 12)
+                              (ps (pack Ttl ", Page " (inc 'Page)))
+                              (down 12) )
+                           (until (eof)
+                              (let L (split (line) "^I")
+                                 (down 8)
+                                 (table Fmt
+                                    (font "Helvetica-Bold" (ps (head 50 (car L))))
+                                    (ps (head 30 (cadr L)))
+                                    (ps (get L 3))
+                                    (ps (get L 4))
+                                    (ps (head 30 (get L 5)))
+                                    (ps (head 30 (get L 6)))
+                                    (ps (head 30 (get L 7))) )
+                                 (down 4) ) ) ) )
+                     (page) ) ) ) ) ) ) )
+
+# Tree display of a person's descendants
+(de treeReport (This)
+   (html 0 "Family Tree View" "lib.css" NIL
+      (<h3> NIL "Family Tree View")
+      (<ul> NIL
+         (recur (This)
+            (when (try 'url> This 1)
+               (<li> NIL
+                  (<href> (: nm) (mkUrl @))
+                  (when (try 'url> (: mate) 1)
+                     (prin " -- ")
+                     (<href> (: mate nm) (mkUrl @)) ) )
+               (when (: kids)
+                  (<ul> NIL (mapc recurse (: kids))) ) ) ) ) ) )
+
+### RUN ###
+(de main ()
+   (pool "doc/family/" *Dbs)
+   (unless (val *DB)
+      (put>
+         (set *DB (request '(+Man) 'nm "Adam"))
+         'mate
+         (request '(+Woman) 'nm "Eve") )
+      (commit) ) )
+
+(de go ()
+   (rollback)
+   (server 8080 "@person") )
+
+# vi:et:ts=3:sw=3
diff --git a/doc/family/1 b/doc/family/1
Binary files differ.
diff --git a/doc/family/2 b/doc/family/2
Binary files differ.
diff --git a/doc/family/3 b/doc/family/3
Binary files differ.
diff --git a/doc/family/4 b/doc/family/4
Binary files differ.
diff --git a/doc/faq.html b/doc/faq.html
@@ -0,0 +1,664 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN" "http://www.w3.org/TR/1998/REC-html40-19980424/loose.dtd">
+<html lang="en">
+<head>
+<meta http-equiv="Content-Type" content="text/html; charset=utf-8">
+<title>PicoLisp FAQ</title>
+<link rel="stylesheet" href="doc.css" type="text/css">
+</head>
+<body>
+<a href="mailto:abu@software-lab.de">abu@software-lab.de</a>
+
+<p align=right>
+<i>Monk: "If I have nothing in my mind, what shall I do?"</i><br>
+<i>Joshu: "Throw it out."</i><br>
+<i>Monk: "But if there is nothing, how can I throw it out?"</i><br>
+<i>Joshu: "Well, then carry it out."</i><br>
+<i>(Zen koan)</i><br>
+
+<h1>PicoLisp Frequently Asked Questions</h1>
+
+<p align=right>(c) Software Lab. Alexander Burger
+
+<p><ul>
+<li><a href="#yet">Why did you write yet another Lisp?</a>
+<li><a href="#who">Who can use PicoLisp?</a>
+<li><a href="#advantages">What are the advantages over other Lisp systems?</a>
+<li><a href="#performance">How is the performance compared to other Lisp systems?</a>
+<li><a href="#interpreted">What means "interpreted"?</a>
+<li><a href="#compiler">Is there (or will be in the future) a compiler available?</a>
+<li><a href="#portable">Is it portable?</a>
+<li><a href="#webServer">Is PicoLisp a web server?</a>
+<li><a href="#lambda">I cannot find the LAMBDA keyword in PicoLisp</a>
+<li><a href="#dynamic">Why do you use dynamic variable binding?</a>
+<li><a href="#problems">Are there no problems caused by dynamic binding?</a>
+<li><a href="#closures">But with dynamic binding I cannot implement closures!</a>
+<li><a href="#macros">Do you have macros?</a>
+<li><a href="#strings">Why are there no strings?</a>
+<li><a href="#arrays">What about arrays?</a>
+<li><a href="#bind">What happens when I locally bind a symbol which has a function definition?</a>
+<li><a href="#hardware">Would it make sense to build PicoLisp in hardware?</a>
+<li><a href="#ask">Where can I ask questions?</a>
+</ul>
+
+<p><hr>
+<h2><a name="yet">Why did you write yet another Lisp?</a></h2>
+
+<p>Because other Lisps are not the way I'd like them to be. They concentrate on
+efficient compilation, and lost the one-to-one relationship of language and
+virtual machine of an interpreted system, gave up power and flexibility, and
+impose unnecessary limitations on the freedom of the programmer. Other reasons
+are the case-insensitivity and complexity of current Lisp systems.
+
+
+<p><hr>
+<h2><a name="who">Who can use PicoLisp?</a></h2>
+
+<p>PicoLisp is for programmers who want to control their programming
+environment, at all levels, from the application domain down to the bare metal.
+Who want use a transparent and simple - yet universal - programming model, and
+want to know exactly what is going on. This is an aspect influenced by Forth.
+
+<p>It does <i>not</i> pretend to be easy to learn. There are already plenty of
+languages that do so. It is not for people who don't care what's under the hood,
+who just want to get their application running. They are better served with some
+standard, "safe" black-box, which may be easier to learn, and which allegedly
+better protects them from their own mistakes.
+
+
+<p><hr>
+<h2><a name="advantages">What are the advantages over other Lisp systems?</a></h2>
+
+<h3>Simplicity</h3>
+<p>PicoLisp is easy to understand and adapt. There is no compiler enforcing
+special rules, and the interpreter is simple and straightforward. There are only
+three data types: Numbers, symbols and lists ("LISP" means "List-, Integer- and
+Symbol Processing" after all ;-). The memory footprint is minimal, and the
+tarball size of the whole system is just a few hundred kilobytes.
+
+<h3>A Clear Model</h3>
+<p>Most other systems define the language, and leave it up to the implementation
+to follow the specifications. Therefore, language designers try to be as
+abstract and general as possible, leaving many questions and ambiguities to the
+users of the language.
+
+<p>PicoLisp does the opposite. Initially, only the single-cell data structure
+was defined, and then the structure of numbers, symbols and lists as they are
+composed of these cells. Everything else in the whole system follows from these
+axioms. This is documented in the chapter about the <a href="ref.html#vm">The
+PicoLisp Machine</a> in the reference manual.
+
+<h3>Orthogonality</h3>
+<p>There is only one symbolic data type, no distinction (confusion) between
+symbols, strings, variables, special variables and identifiers.
+
+<p>Most data-manipulation functions operate on the value cells of symbols as
+well as the CARs of list cells:
+
+<pre><code>
+: (let (N 7  L (7 7 7)) (inc 'N) (inc (cdr L)) (cons N L))
+-> (8 7 8 7)
+</code></pre>
+
+<p>There is only a single functional type, no "special forms". As there is no
+compiler, functions can be used instead of macros. No special "syntax"
+constructs are needed. This allows a completely orthogonal use of functions. For
+example, most other Lisps do not allow calls like
+
+<pre><code>
+: (mapcar if '(T NIL T NIL) '(1 2 3 4) '(5 6 7 8))
+-> (1 6 3 8)
+</code></pre>
+
+<p>PicoLisp has no such restrictions. It favors the principle of "Least
+Astonishment".
+
+<h3>Object System</h3>
+<p>The OOP system is very powerful, because it is fully dynamic, yet extremely
+simple:
+
+<p><ul>
+<li>In other systems you have to statically declare "slots". In PicoLisp,
+classes and objects are completely dynamic, they are created and extended at
+runtime. "Slots" don't even exist at creation time. They spring into existence
+purely dynamically. You can add any new property or any new method to any single
+object, at any time, regardless of its class.
+
+<li>The multiple inheritance is such that not only classes can have several
+superclasses, but each individual object can be of more than one class.
+
+<li>Prefix classes can surgically change the inheritance tree for any class or
+object. They behave like Mixins in this regard.
+
+<li>Fine-control of inheritance in methods with <code><a
+href="refS.html#super">super</a></code> and <code><a
+href="refE.html#extra">extra</a></code>.
+
+</ul>
+
+<h3>Pragmatism</h3>
+<p>PicoLisp has many practical features not found in other Lisp dialects. Among
+them are:
+
+<p><ul>
+<li>Auto-quoting of lists when the CAR is a number. Instead of <code>'(1 2
+3)</code> you can just write <code>(1 2 3)</code>. This is possible because a
+number never makes sense as a function name, and has to be checked at runtime
+anyway.
+
+<li>The <code><a href="refQ.html#quote">quote</a></code> function returns all
+unevaluated arguments, instead of just the first one. This is both faster
+(<code>quote</code> does not have to take the CAR of its argument list) and
+smaller (a single cell instead of two). For example, <code>'A</code> expands to
+<code>(quote . A)</code> and <code>'(A B C)</code> expands to <code>(quote A B
+C)</code>.
+
+<li>The symbol <code><a href="ref.html#atres">@</a></code> is automatically
+maintained as a local variable, and set implicitly in certain flow- and
+logic-functions. This makes it often unnecessary to allocate and assign local
+variables.
+
+<li><a href="tut.html#funio">Functional I/O</a> is more convenient than
+explicitly passing around file descriptors.
+
+<li>A well-defined <a href="ref.html#cmp">ordinal relationship</a> between
+arbitrary data types facilitates generalized comparing and sorting.
+
+<li>Uniform handling of <code>var</code> locations (i.e. values of symbols and
+CARs of list cells).
+
+<li>The universality and usefulness of symbol properties is enforced and
+extended with implicit and explicit bindings of the symbol <code><a
+href="refT.html#This">This</a></code> in combination with the access functions
+<code><a href="ref_.html#=:">=:</a></code>, <code><a
+href="ref_.html#:">:</a></code> and <code><a href="ref_.html#::">::</a></code>.
+
+<li>A very convenient list-building machinery, using the <code><a
+href="refL.html#link">link</a></code>, <code><a
+href="refY.html#yoke">yoke</a></code>, <code><a
+href="refC.html#chain">chain</a></code> and <code><a
+href="refM.html#made">made</a></code> functions in the <code><a
+href="refM.html#make">make</a></code> environment.
+
+<li>The syntax of often-used functions is kept non-verbose. For example, instead
+of <code>(let ((A 1) (B 2) C 3) ..)</code> you write <code>(let (A 1 B 2 C 3)
+..)</code>, or just <code>(let A 1 ..)</code> if there is only a single
+variable.
+
+<li>The use of the hash (<code>#</code>) as a comment character is more adequate
+today, and allows a clean hash-bang (<code>#!</code>) syntax for stand-alone
+scripts.
+
+<li>The interpreter is <a href="ref.html#invoc">invoked</a> with a simple and
+flexible syntax, where command line arguments are either files to be interpreted
+or functions to be directly executed. With that, many tasks can be performed
+without writing a separate <a href="tut.html#script">script</a>.
+
+<li>A sophisticated system of interprocess communication, file locking and
+synchronization allows multi-user access to database applications.
+
+<li>A Prolog interpreter is tightly integrated into the language. Prolog
+clauses can call Lisp expressions and vice versa, and a self-adjusting
+depth-first search predicate <code>select</code> can be used in database
+queries.
+
+</ul>
+
+<h3>Persistent Symbols</h3>
+<p>Database objects ("external" symbols) are a primary data type in PicoLisp.
+They look like normal symbols to the programmer, but are managed (fetched from,
+and stored to, the data base) automatically by the system. Symbol manipulation
+functions like <code>set</code>, <code>put</code> or <code>get</code>, the
+garbage collector, and other parts of the interpreter know about them.
+
+<h3>Application Server</h3>
+<p>Stand-alone system: Does not depend on external programs like Apache or
+MySQL. Provides a "live" user interface on the client side, with an application
+server session for each connected client. The GUI layout and behavior is
+described with s-expressions, generated dynamically at runtime, and interacts
+directly with the database structures.
+
+<h3>Localization</h3>
+<p>Internal exclusive and full use of UTF-8 encoding, and self-translating <a
+href="ref.html#transient-io">transient symbols</a> (strings), make it easy to
+write country- and language-independent applications.
+
+
+<p><hr>
+<h2><a name="performance">How is the performance compared to other Lisp systems?</a></h2>
+
+<p>Despite the fact that PicoLisp is an interpreted-only system, the performance
+is quite good. Typical Lisp programs, operating on list data structures, execute
+in (interpreted) PicoLisp at about the same speed as in (compiled) CMUCL, and
+about two or three times faster than in CLisp or Scheme48. Programs with lots of
+numeric calculations, however, are several times slower, mainly due to
+PicoLisp's somewhat inefficient implementation of bignums in the 32-bit version.
+
+<p>But in practice, speed was never a problem, even with the first versions of
+PicoLisp in 1988 on a Mac II with a 12 MHz CPU. And certain things are cleaner
+and easier to do in plain C anyway. It is very easy to write C functions in
+PicoLisp, either in the kernel, as shared object libraries, or even inline in
+the Lisp code.
+
+<p>PicoLisp is very space-effective. Other Lisp systems reserve heap space twice
+as much as needed, or use rather large internal structures to store cells and
+symbols. Each cell or minimal symbol in PicoLisp consists of only two pointers.
+No additional tags are stored, because they are implied in the pointer
+encodings. No gaps remain in the heap during allocation, as there are only
+objects of a single size. As a result, consing and garbage collection are very
+fast, and overall performance benefits from a better cache efficiency. Heap and
+stack grow automatically, and are limited only by hardware and operating system
+constraints.
+
+
+<p><hr>
+<h2><a name="interpreted">What means "interpreted"?</a></h2>
+
+<p>It means to directly execute Lisp data as program code. No transformation to
+another representation of the code (e.g. compilation), and no structural
+modifications of these data, takes place.
+
+<p>Lisp data are the "real" things, like numbers, symbols and lists, which can
+be directly handled by the system. They are <i>not</i> the textual
+representation of these structures (which is outside the Lisp realm and taken
+care of the <code><a href="refR.html#read">read</a></code>ing and <code><a
+href="refP.html#print">print</a></code>ing interfaces).
+
+<p>The following example builds a function and immediately calls it with two
+arguments:
+
+<pre><code>
+: ((list (list 'X 'Y) (list '* 'X 'Y)) 3 4)
+-> 12
+</code></pre>
+
+<p>Note that no time is wasted to build up a lexical environment. Variable
+bindings take place dynamically during interpretation.
+
+<p>A PicoLisp function is able to inspect or modify itself while it is running
+(though this is rarely done in application programming). The following function
+modifies itself by incrementing the '0' in its body:
+
+<pre><code>
+(de incMe ()
+   (do 8
+      (printsp 0)
+      (inc (cdadr (cdadr incMe))) ) )
+
+: (incMe)
+0 1 2 3 4 5 6 7 -> 8
+: (incMe)
+8 9 10 11 12 13 14 15 -> 16
+</code></pre>
+
+<p>Only an interpreted Lisp can fully support such "Equivalence of Code and
+Data". If executable pieces of data are used frequently, like in PicoLisp's
+dynamically generated GUI, a fast interpreter is preferable over any compiler.
+
+
+<p><hr>
+<h2><a name="compiler">Is there (or will be in the future) a compiler available?</a></h2>
+
+<p>No. That would contradict the idea of PicoLisp's simple virtual machine
+structure. A compiler transforms it to another (physical) machine, with the
+result that many assumptions about the machine's behavior won't hold any more.
+Besides that, PicoLisp primitive functions evaluate their arguments
+independently and are not very much suited for being called from compiled code.
+Finally, the gain in execution speed would probably not be worth the effort.
+Typical PicoLisp applications often use single-pass code which is loaded,
+executed and thrown away; a process that would be considerably slowed down by
+compilation.
+
+
+<p><hr>
+<h2><a name="portable">Is it portable?</a></h2>
+
+<p>Yes and No. Though we wrote and tested PicoLisp originally only on Linux, it
+now also runs on FreeBSD, Mac OS X (Darwin), Cygwin/Win32, and probably other
+POSIX systems. The first versions were even fully portable between DOS, SCO-Unix
+and Macintosh systems. But today we have Linux. Linux itself is very portable,
+and you can get access to a Linux system almost everywhere. So why bother?
+
+<p>The GUI is completely platform independent (Browser), and in the times of
+Internet an application <u>server</u> does not really need to be portable.
+
+
+<p><hr>
+<h2><a name="webServer">Is PicoLisp a web server?</a></h2>
+
+<p>Not really, but it evolved a great deal into that direction.
+
+<p>Historically it was the other way round: We had a plain X11 GUI for our
+applications, and needed something platform independent. The solution was
+obvious: Browsers are installed virtually everywhere. So we developed a protocol
+which persuades a browser to function as a GUI front-end to our applications.
+This is much simpler than to develop a full-blown web server.
+
+<p>In a sense, PicoLisp is a "pure" application server, not a web server
+handling "web applications".
+
+
+<p><hr>
+<h2><a name="lambda">I cannot find the LAMBDA keyword in PicoLisp</a></h2>
+
+<p>Because it isn't there. The reason is that it is redundant; it is equivalent
+to the <code>quote</code> function in any aspect, because there's no distinction
+between code and data in PicoLisp, and <code>quote</code> returns the whole
+(unevaluated) argument list. If you insist on it, you can define your own
+<code>lambda</code>:
+
+<pre><code>
+: (def 'lambda quote)
+-> lambda
+: ((lambda (X Y) (+ X Y)) 3 4)
+-> 7
+: (mapcar (lambda (X) (+ 1 X)) '(1 2 3 4 5))
+-> (2 3 4 5 6)
+</code></pre>
+
+
+<p><hr>
+<h2><a name="dynamic">Why do you use dynamic variable binding?</a></h2>
+
+<p>Dynamic binding is very powerful, because there is only one single,
+dynamically changing environment active all the time. This makes it possible
+(e.g. for program snippets, interspersed with application data and/or passed
+over the network) to access the whole application context, freely, yet in a
+dynamically controlled manner. And (shallow) dynamic binding is the fastest
+method for a Lisp interpreter.
+
+<p>Lexical binding is more limited by definition, because each environment is
+deliberately restricted to the visible (textual) static scope within its
+establishing form. Therefore, most Lisps with lexical binding introduce "special
+variables" to support dynamic binding as well, and constructs like
+<code>labels</code> to extend the scope of variables beyond a single function.
+
+<p>In PicoLisp, function definitions are normal symbol values. They can be
+dynamically rebound like other variables. As a useful real-world example, take
+this little gem:
+
+<pre><code>
+(de recur recurse
+   (run (cdr recurse)) )
+</code></pre>
+
+<p>It implements anonymous recursion, by defining <code>recur</code> statically
+and <code>recurse</code> dynamically. Usually it is very cumbersome to think up
+a name for a function (like the following one) which is used only in a single
+place. But with <code>recur</code> and <code>recurse</code> you can simply
+write:
+
+<pre><code>
+: (mapcar
+   '((N)
+      (recur (N)
+         (if (=0 N)
+            1
+            (* N (recurse (- N 1))) ) ) )
+   (1 2 3 4 5 6 7 8) )
+-> (1 2 6 24 120 720 5040 40320)
+</code></pre>
+
+<p>Needless to say, the call to <code>recurse</code> does not have to reside in
+the same function as the corresponding <code>recur</code>. Can you implement
+anonymous recursion so elegantly with lexical binding?
+
+
+<p><hr>
+<h2><a name="problems">Are there no problems caused by dynamic binding?</a></h2>
+
+<p>You mean the <i>funarg</i> problem, or problems that arise when a variable
+might be bound to <i>itself</i>? For that reason we have a convention in
+PicoLisp to use <a href="ref.html#transient-io">transient symbols</a> (instead
+of internal symbols)
+
+<ol>
+
+<li>for all parameters and locals, when functional arguments or executable lists
+are passed through the current dynamic bindings
+
+<li>for a parameter or local, when that symbol might possibly be (directly or
+indirectly) bound to itself, and the bound symbol's value is accessed in the
+dynamic context
+
+</ol>
+
+<p>This is a form of lexical <i>scoping</i> - though we still have dynamic
+<i>binding</i> - of symbols, similar to the <code>static</code> keyword in C.
+
+<p>In fact, these problems are a real threat, and may lead to mysterious bugs
+(other Lisps have similar problems, e.g. with symbol capture in macros). They
+can be avoided, however, when the above conventions are observed. As an example,
+consider a function which doubles the value in a variable:
+
+<pre><code>
+(de double (Var)
+   (set Var (* 2 (val Var))) )
+</code></pre>
+
+<p>This works fine, as long as we call it as <code>(double 'X)</code>, but will
+break if we call it as <code>(double 'Var)</code>. Therefore, the correct
+implementation of <code>double</code> should be:
+
+<pre><code>
+(de double (<u>Var</u>)
+   (set <u>Var</u> (* 2 (val <u>Var</u>))) )
+</code></pre>
+
+<p>If <code>double</code> is defined that way in a separate source file, and/or
+isolated via the <code><a href="ref_.html#====">====</a></code> function, then
+the symbol <code><u>Var</u></code> is locked into a private lexical context
+and cannot conflict with other symbols.
+
+<p>Admittedly, there are two disadvantages with this solution:
+
+<ol>
+
+<li>The rules for when to use transient symbols are a bit complicated. Though it
+is safe to use them even when not necessary, it will take more space then and be
+more difficult to debug.
+
+<li>The string-like syntax of transient symbols as variables may look strange to
+alumni of other languages. Therefore, the use of <a
+href="refT.html#*Tsm">transient symbol markup</a> is recommended.
+
+</ol>
+
+Fortunately, these pitfalls do not occur so very often, and seem more likely in
+utilities than in production code, so that they can be easily encapsulated.
+
+
+<p><hr>
+<h2><a name="closures">But with dynamic binding I cannot implement closures!</a></h2>
+
+<p>This is not true. Closures are a matter of scope, not of binding.
+
+<p>For a closure it is necessary to build and maintain an environment. For
+lexical bindings, this has <i>always</i> to be done, and in case of compiled
+code it is the most efficient strategy anyway, because it is done once by the
+compiler, and can then be accessed as stack frames at runtime.
+
+<p>For an interpreter, however, this is quite an overhead. So it should not be
+done automatically at each and every function invocation, but only if needed.
+
+<p>You have several options in PicoLisp. For simple cases, you can take
+advantage of the static scope of <a href="ref.html#transient-io">transient
+symbols</a>. For the general case, PicoLisp has built-in functions like <code><a
+href="refB.html#bind">bind</a></code> or <code><a
+href="refJ.html#job">job</a></code>, which dynamically manage statically scoped
+environments.
+
+<p>As an example, consider a currying function:
+
+<pre><code>
+(de curry Args
+   (list (car Args)
+      (list 'list
+         (lit (cadr Args))
+         (list 'cons ''job
+            (list 'cons
+               (list 'lit (list 'env (lit (car Args))))
+               (lit (cddr Args)) ) ) ) ) )
+</code></pre>
+
+<p>When called, it returns a function-building function which may be applied to
+some argument:
+
+<pre><code>
+: ((curry (X) (N) (* X N)) 3)
+-> ((N) (job '((X . 3)) (* X N)))
+</code></pre>
+
+<p>or used as:
+
+<pre><code>
+: (((curry (X) (N) (* X N)) 3) 4)
+-> 12
+</code></pre>
+
+<p>In other cases, you are free to choose a shorter and faster solution. If (as
+in the example above) the curried argument is known to be immutable:
+
+<pre><code>
+(de curry Args
+   (list
+      (cadr Args)
+      (list 'fill
+         (lit (cons (car Args) (cddr Args)))
+         (lit (cadr Args)) ) ) )
+</code></pre>
+
+<p>Then the function built above will just be:
+
+<pre><code>
+: ((curry (X) (N) (* X N)) 3)
+-> ((X) (* X 3))
+</code></pre>
+
+<p>In that case, the "environment build-up" is reduced by a simple (lexical)
+constant substitution with zero runtime overhead.
+
+<p>Note that the actual <code><a href="refC.html#curry">curry</a></code>
+function is simpler and more pragmatic. It combines both strategies (to use
+<code>job</code>, or to substitute), deciding at runtime what kind of function
+to build.
+
+
+<p><hr>
+<h2><a name="macros">Do you have macros?</a></h2>
+
+<p>Yes, there is a macro mechanism in PicoLisp, to build and immediately execute
+a list of expressions. But it is seldom used. Macros are a kludge. Most things
+where you need macros in other Lisps are directly expressible as functions in
+PicoLisp, which (as opposed to macros) can be applied, passed around, and
+debugged.
+
+
+<p><hr>
+<h2><a name="strings">Why are there no strings?</a></h2>
+
+<p>Because PicoLisp has something better: <a
+href="ref.html#transient-io">Transient symbols</a>. They look and behave like
+strings in any respect, but are nevertheless true symbols, with a value cell and
+a property list.
+
+<p>This leads to interesting opportunities. The value cell, for example, can
+point to other data that represent the string's the translation. This is used
+extensively for localization. When a program calls
+
+<pre><code>
+   (prinl "Good morning!")
+</code></pre>
+
+<p>then changing the value of the symbol <code>"Good morning!"</code> to its
+translation will change the program's output at runtime.
+
+<p>Transient symbols are also quite memory-conservative. As they are stored in
+normal heap cells, no additional overhead for memory management is induced. The
+cell holds the symbol's value in its CDR, and the tail in its CAR. If the string
+is not longer than 7 bytes, it fits (on the 64-bit version) completely into the
+tail, and a single cell suffices. Up to 15 bytes take up two cells, 23 bytes
+three etc., so that long strings are not very efficient (needing twice the
+memory on the avarage), but this disadvantage is made up by simplicity and
+uniformity. And lots of extremely long strings are not the common case, as they
+are split up anyway during processing, and stored as plain byte sequences in
+external files and databases.
+
+<p>Because transient symbols are temporarily interned (while <code><a
+href="refL.html#load">load</a></code>ing the current source file), they are
+shared within the same source and occupy that space only once, even if they
+occur multiple times within the same file.
+
+
+<p><hr>
+<h2><a name="arrays">What about arrays?</a></h2>
+
+<p>PicoLisp has no array or vector data type. Instead, lists must be used for
+any type of sequentially arranged data.
+
+<p>We believe that arrays are usually overrated. Textbook wisdom tells that they
+have a constant access time O(1) when the index is known. Many other operations
+like splits or insertions are rather expensive. Access with a known (numeric)
+index is not really typical for Lisp, and even then the advantage of an array is
+significant only if it is relatively long. Holding lots of data in long arrays,
+however, smells quite like a program design error, and we suspect that often
+more structured representations like trees or interconnected objects would be
+better.
+
+<p>In practice, most arrays are rather short, or the program can be designed in
+such a way that long arrays (or at least an indexed access) are avoided.
+
+<p>Using lists, on the other hand, has advantages. We have so many concerted
+functions that uniformly operate on lists. There is no separate data type that
+has to be handled by the interpreter, garbage collector, I/O, database and so
+on. Lists can be made circular. And lists don't cause memory fragmentation.
+
+
+<p><hr>
+<h2><a name="bind">What happens when I locally bind a symbol which has a function definition?</a></h2>
+
+<p>That's not a good idea. The next time that function gets executed within the
+dynamic context the system may crash. Therefore we have a convention to use an
+upper case first letter for locally bound symbols:
+
+<pre><code>
+(de findCar (Car List)
+   (when (member Car (cdr List))
+      (list Car (car List)) ) )
+</code></pre>
+
+;-)
+
+
+<p><hr>
+<h2><a name="hardware">Would it make sense to build PicoLisp in hardware?</a></h2>
+
+<p>At least it should be interesting. It would be a machine executing list
+(tree) structures instead of linear instruction sequences. "Instruction
+prefetch" would look down the CAR- and CDR-chains, and perhaps need only a
+single cache for both data and instructions.
+
+<p>Primitive functions like <code>set</code>, <code>val</code>, <code>if</code>
+and <code>while</code>, which are written in <Code>C</code> or assembly language
+now, would be implemented in microcode. Plus a few I/O functions for hardware
+access. <code>EVAL</code> itself would be a microcode subroutine.
+
+<p>Only a single heap and a single stack is needed. They grow towards each
+other, and cause garbage collection if they get too close. Heap compaction is
+trivial due to the single cell size.
+
+<p>There would be no assembly-language. The lowest level (above the hardware and
+microcode levels) are s-expressions: The machine language is <i>Lisp</i>.
+
+
+<p><hr>
+<h2><a name="ask">Where can I ask questions?</a></h2>
+
+<p>The best place is the <a
+href="mailto:picolisp@software-lab.de?subject=Subscribe">PicoLisp Mailing
+List</a> (see also <a
+href="http://www.mail-archive.com/picolisp@software-lab.de/">The Mail
+Archive</a>), or the IRC <a href="irc://irc.freenode.net/picolisp">#picolisp</a>
+channel on FreeNode.net.
+
+</body>
+</html>
diff --git a/doc/fun.l b/doc/fun.l
@@ -0,0 +1,9 @@
+# 25jun07abu
+# (c) Software Lab. Alexander Burger
+
+(de fact (N)
+   (if (=0 N)
+      1
+      (* N (fact (dec N))) ) )
+
+# vi:et:ts=3:sw=3
diff --git a/doc/hello.l b/doc/hello.l
@@ -0,0 +1,5 @@
+(load "lib/xhtml.l")
+
+(html 0 "Hello" NIL NIL
+   (<h3> NIL "Hello world")
+   "This is PicoLisp" )
diff --git a/doc/index.html b/doc/index.html
@@ -0,0 +1,108 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN"
+        "http://www.w3.org/TR/html4/loose.dtd">
+<html>
+<head>
+	<meta http-equiv="content-type" content="text/html; charset=utf-8">
+	<title>PicoLisp Docs</title>
+	<meta name="generator" content="BBEdit 8.6">
+	<script type="text/javascript" language="javascript">
+	<!--
+function frameIdAsVariable(aFrame) {
+	// IE hack
+	// http://www.greymagic.com/security/advisories/gm011-ie/
+	if (aFrame.name == "toc") return tocfid;
+	if (aFrame.name == "upper") return upfid;
+}
+
+function contentDoc(aFrame) {
+	if (aFrame.contentDocument) {
+		return aFrame.contentDocument;
+	} else {
+		var fid = frameIdAsVariable(aFrame);
+		if (fid) {
+			return fid.document;
+		}
+	}
+	alert("Couldn't access a frame's document for this kind of browser.");
+}
+
+function doTocSublists(upDoc) {
+	var tocDoc = contentDoc(document.getElementById("tocfid"));
+	var ul = tocDoc.getElementById("upperul");
+	var oldExp = null;
+	var newSub = null;
+	for (var i=0; i<ul.childNodes.length; i++) {
+		var cni = ul.childNodes[i];
+		if (cni.firstChild) {
+			// cni.firstChild is an anchor
+			if (cni.firstChild.href == upDoc.URL) {
+				// Found TOC anchor that matches upper document
+				if (upDoc.URL.indexOf("#") < 0) {
+					if (cni.lastChild.nodeName != "UL") {
+						// Expansion required, making sub-list ...
+						newSub = tocDoc.createElement("ul");
+						newSub.className = "sub";
+						for (var j=0; j<upDoc.anchors.length; j++) {
+							var ajText = null;
+							if (upDoc.anchors[j].innerText) {
+								ajText = upDoc.anchors[j].innerText;
+							} else if (upDoc.anchors[j].text) {
+								ajText = upDoc.anchors[j].text;
+							}
+							if (ajText) {
+								var li = tocDoc.createElement("li");
+								var a = tocDoc.createElement("a");
+								a.href = upDoc.URL + "#" + upDoc.anchors[j].name;
+								a.target = "upper";
+								a.appendChild(tocDoc.createTextNode(ajText));
+								li.appendChild(a);
+								newSub.appendChild(li);
+							}
+						}
+						cni.appendChild(newSub);
+					}
+				}
+			} else if (cni.lastChild.nodeName == "UL") {
+				oldExp = cni;
+			}
+		}
+	}
+	if ((oldExp != null) && (newSub != null)) {
+		// Remove old sub-list to save TOC space ...
+		oldExp.removeChild(oldExp.lastChild);
+	}
+}
+
+function upperLoad(upperFrame) {
+	try {
+		var upDoc = contentDoc(upperFrame);
+		// First modify the targets of the ref anchors ...
+		var anchors = upDoc.getElementsByTagName("a");
+		for (var i=0; i<anchors.length; i++) {
+			var ai = anchors[i];
+			if (ai.href.match(/\/ref\w\.html/)) {
+				ai.target = "lower";
+			}
+		}
+		doTocSublists(upDoc);
+	} catch (e) {
+		alert(e);
+	}
+}
+	//-->
+</script>
+</head>
+<frameset cols="15%,85%">
+	<frameset rows="*,80">
+		<frame id="tocfid" name="toc" src="toc.html">
+		<frame name="reflook" src="rlook.html">
+	</frameset>
+	
+	<frameset rows="50%,50%">
+		<frame id="upfid" name="upper" src="ref.html#fun" onload="upperLoad(this);">
+		<frame name="lower" src="ref.html">
+	</frameset>
+
+</frameset>
+
+</html>
diff --git a/doc/model b/doc/model
@@ -0,0 +1,57 @@
+# 20aug04abu
+# (c) Software Lab. Alexander Burger
+
+Sym Val -> Model list:
+(
+   pos.x pos.y pos.z                                              # Position
+   rot.a.x rot.a.y rot.a.z                                        # Orientation
+   rot.b.x rot.b.y rot.b.z
+   rot.c.x rot.c.y rot.c.z
+   sym                                                            # Submodel
+   ..
+   (col1 col2 ["text"]  p1.x p1.y p1.z  p2.x p2.y p2.z ..)        # Face
+   ..
+   sym                                                            # Submodel
+   ..
+   (col1 col2  p1.x p1.y p1.z  p2.x p2.y p2.z  p3.x p3.y p3.z ..) # Face
+   ..
+)
+
+<col> <col>    # Both sides visible
+<col>  NIL     # Backface culling
+ NIL  <col>    # Foreside culling
+ NIL   NIL     # Transparent
+ NIL    T      # Shadow
+
+
+Transmission format:
+   hor sky gnd
+   cnt  x y z  "text"  x y z  x y z  ..  col
+   cnt  x y z  NIL  x y z  x y z  x y z  ..  col
+   ..
+   0 32767 | 0 snx sny
+
+Transmission size:
+   (4 + 2 * polygons + 3 * points) * 4 bytes
+
+
+Polygon design rules:
+
+- All polygons should be convex
+  (split concave polygons if necessary)
+
+- Points loop right when seen from the front side
+  (if the two faces should have different colors)
+
+- The first three points must not be on a straight line
+  (to allow the calculation of the normal vector)
+
+- The first point cannot be the local origin
+  (if 'aRot' is to be used)
+
+
+z3dField .graf
+((x y . "string") ..)
+
+Transmission format:
+   cnt  x y "string" ..
diff --git a/doc/quine b/doc/quine
@@ -0,0 +1,24 @@
+With lambda (= 'quote'):
+   : ('((X) (list (lit X) (lit X))) '((X) (list (lit X) (lit X))))
+   -> ('((X) (list (lit X) (lit X))) '((X) (list (lit X) (lit X))))
+
+
+With 'let':
+   : (let X '(list 'let 'X (lit X) X) (list 'let 'X (lit X) X))
+   -> (let X '(list 'let 'X (lit X) X) (list 'let 'X (lit X) X))
+
+
+Cheating:
+   : (de quine NIL
+      (pp 'quine) )
+   -> quine
+
+   : (quine)
+   (de quine NIL
+      (pp 'quine) )
+   -> quine
+
+
+Succinct:
+   : T
+   -> T
diff --git a/doc/ref.html b/doc/ref.html
@@ -0,0 +1,2455 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN" "http://www.w3.org/TR/1998/REC-html40-19980424/loose.dtd">
+<html lang="en">
+<head>
+<meta http-equiv="Content-Type" content="text/html; charset=utf-8">
+<title>PicoLisp Reference</title>
+<link rel="stylesheet" href="doc.css" type="text/css">
+</head>
+<body>
+<a href="mailto:abu@software-lab.de">abu@software-lab.de</a>
+
+<p align=right>
+<i>Perfection is attained</i><br>
+<i>not when there is nothing left to add</i><br>
+<i>but when there is nothing left to take away</i><br>
+<i>(Antoine de Saint-Exupéry)</i><br>
+
+
+<h1>The PicoLisp Reference</h1>
+
+<p align=right>(c) Software Lab. Alexander Burger
+
+<p>This document describes the concepts, data types, and kernel functions of the
+<a href="http://software-lab.de/down.html">PicoLisp</a> system.
+
+<p>This is <i>not</i> a Lisp tutorial. For an introduction to Lisp, a
+traditional Lisp book like "Lisp" by Winston/Horn (Addison-Wesley 1981) is
+recommended. Note, however, that there are significant differences between
+PicoLisp and Maclisp (and even greater differences to Common Lisp).
+
+<p>Please take a look at the <a href="tut.html">PicoLisp Tutorial</a> for an
+explanation of some aspects of PicoLisp, and scan through the list of <a
+href="faq.html">Frequently Asked Questions (FAQ)</a>.
+
+<p><ul>
+<li><a href="#intro">Introduction</a>
+<li><a href="#vm">The PicoLisp Machine</a>
+   <ul>
+   <li><a href="#cell">The Cell</a>
+   <li><a href="#data">Data Types</a>
+      <ul>
+      <li><a href="#number">Numbers</a>
+      <li><a href="#symbol">Symbols</a>
+         <ul>
+         <li><a href="#nilSym">NIL</a>
+         <li><a href="#internal">Internal Symbols</a>
+         <li><a href="#transient">Transient Symbols</a>
+         <li><a href="#external">External Symbols</a>
+         </ul>
+      <li><a href="#lst">Lists</a>
+      </ul>
+   <li><a href="#mem">Memory Management</a>
+   </ul>
+<li><a href="#penv">Programming Environment</a>
+   <ul>
+   <li><a href="#invoc">Invocation</a>
+   <li><a href="#io">Input/Output</a>
+      <ul>
+      <li><a href="#num-io">Numbers</a>
+      <li><a href="#sym-io">Symbols</a>
+         <ul>
+         <li><a href="#nilSym-io">NIL</a>
+         <li><a href="#internal-io">Internal Symbols</a>
+         <li><a href="#transient-io">Transient Symbols</a>
+         <li><a href="#external-io">External Symbols</a>
+         </ul>
+      <li><a href="#lst-io">Lists</a>
+      <li><a href="#macro-io">Read-Macros</a>
+      </ul>
+   <li><a href="#ev">Evaluation</a>
+   <li><a href="#int">Interrupt</a>
+   <li><a href="#errors">Error Handling</a>
+   <li><a href="#atres">@ Result</a>
+   <li><a href="#cmp">Comparing</a>
+   <li><a href="#oop">OO Concepts</a>
+   <li><a href="#dbase">Database</a>
+      <ul>
+      <li><a href="#trans">Transactions</a>
+      <li><a href="#er">Entities / Relations</a>
+      </ul>
+   <li><a href="#pilog">Pilog (PicoLisp Prolog)</a>
+   <li><a href="#conv">Naming Conventions</a>
+   <li><a href="#trad">Breaking Traditions</a>
+   <li><a href="#bugs">Bugs</a>
+   </ul>
+<li><a href="#fun">Function Reference</a>
+<li><a href="#down">Download</a>
+</ul>
+
+
+<p><hr>
+<h2><a name="intro">Introduction</a></h2>
+
+<p>PicoLisp is the result of a language design study, trying to answer the
+question "What is a minimal but useful architecture for a virtual machine?".
+Because opinions differ about what is meant by "minimal" and "useful", there are
+many answers to that question, and people might consider other solutions more
+"minimal" or more "useful". But from a practical point of view, PicoLisp has
+proven to be a valuable answer to that question.
+
+<p>First of all, PicoLisp is a virtual machine architecture, and then a
+programming language. It was designed in a "bottom up" way, and "bottom up" is
+also the most natural way to understand and to use it: <i>Form Follows
+Function</i>.
+
+<p>PicoLisp has been used in several commercial and research programming
+projects since 1988. Its internal structures are simple enough, allowing an
+experienced programmer always to fully understand what's going on under the
+hood, and its language features, efficiency and extensibility make it suitable
+for almost any practical programming task.
+
+<p>In a nutshell, emphasis was put on four design objectives. The PicoLisp
+system should be
+
+<p><dl>
+
+<dt>Simple
+<dd>The internal data structure should be as simple as possible. Only one single
+data structure is used to build all higher level constructs.
+
+<dt>Unlimited
+<dd>There are no limits imposed upon the language due to limitations of the
+virtual machine architecture. That is, there is no upper bound in symbol name
+length, number digit counts, stack depth, or data structure and buffer sizes,
+except for the total memory size of the host machine.
+
+<dt>Dynamic
+<dd>Behavior should be as dynamic as possible ("run"-time vs. "compile"-time).
+All decisions are delayed till runtime where possible. This involves matters
+like memory management, dynamic symbol binding, and late method binding.
+
+<dt>Practical
+<dd>PicoLisp is not just a toy of theoretical value. It is in use since 1988 in
+actual application development, research and production.
+
+</dl>
+
+
+<p><hr>
+<h2><a name="vm">The PicoLisp Machine</a></h2>
+
+<p>An important point in the PicoLisp philosophy is the knowledge about the
+architecture and data structures of the internal machinery. The high-level
+constructs of the programming language directly map to that machinery, making
+the whole system both understandable and predictable.
+
+<p>This is similar to assembly language programming, where the programmer has
+complete control over the machine.
+
+
+<p><hr>
+<h3><a name="cell">The Cell</a></h3>
+
+<p>The PicoLisp virtual machine is both simpler and more powerful than most
+current (hardware) processors. At the lowest level, it is constructed from a
+single data structure called "cell":
+
+<pre><code>
+         +-----+-----+
+         | CAR | CDR |
+         +-----+-----+
+</code></pre>
+
+<p>A cell is a pair of machine words, which traditionally are called CAR and CDR
+in the Lisp terminology. These words can represent either a numeric value
+(scalar) or the address of another cell (pointer). All higher level data
+structures are built out of cells.
+
+<p>The type information of higher level data is contained in the pointers to
+these data. Assuming the implementation on a byte-addressed physical machine,
+and a pointer size of typically 4 bytes, each cell has a size of 8 bytes.
+Therefore, the pointer to a cell must point to an 8-byte boundary, and its
+bit-representation will look like:
+
+<pre><code>
+      xxxxxxxxxxxxxxxxxxxxxxxxxxxxx000
+</code></pre>
+
+<p>(the <code>'x'</code> means "don't care"). For the individual data types, the
+pointer is adjusted to point to other parts of a cell, in effect setting some of
+the lower three bits to non-zero values. These bits are then used by the
+interpreter to determine the data type.
+
+<p>In any case, bit(0) - the least significant of these bits - is reserved as a
+mark bit for garbage collection.
+
+<p>Initially, all cells in the memory are unused (free), and linked together to
+form a "free list". To create higher level data types at runtime, cells are
+taken from that free list, and returned by the garbage collector when they are
+no longer needed. All memory management is done via that free list; there are no
+additional buffers, string spaces or special memory areas (With two exceptions:
+A certain fixed area of memory is set aside to contain the executable code and
+global variables of the interpreter itself, and a standard push down stack for
+return addresses and temporary storage. Both are not directly accessible by the
+programmer).
+
+
+<p><hr>
+<h3><a name="data">Data Types</a></h3>
+
+<p>On the virtual machine level, PicoLisp supports
+
+<p><ul>
+<li>three base data types: Numbers, Symbols and Cons Pairs (Lists)
+<li>the three scope variations of symbols: Internal, Transient and External
+<li>and the special symbol <code>NIL</code>.
+</ul>
+
+<p>They are all built from the single cell data structure, and all runtime data
+cannot consist of any other types than these three.
+
+<p>The following diagram shows the complete data type hierarchy, consisting of
+the three base types and the symbol variations:
+
+<pre><code>
+                    cell
+                     |
+            +--------+--------+
+            |        |        |
+         Number    Symbol    List
+                     |
+                     |
+   +--------+--------+--------+
+   |        |        |        |
+  NIL   Internal Transient External
+</code></pre>
+
+
+<p><hr>
+<h4><a name="number">Numbers</a></h4>
+
+<p>A number can represent a signed integral value of arbitrary size. The CARs of
+one or more cells hold the number's "digits" (each in the machine's word size),
+to store the number's binary representation.
+
+<pre><code>
+         Number
+         |
+         V
+      +-----+-----+     +-----+-----+     +-----+-----+
+      |'DIG'|  ---+---> |'DIG'|  ---+---> |'DIG'|  /  |
+      +-----+-----+     +-----+-----+     +-----+-----+
+</code></pre>
+
+<p>The first cell holds the least significant digit. The least significant bit
+of that digit represents the sign.
+
+<p>The pointer to a number points into the middle of the CAR, with an offset of
+2 from the cell's start address. Therefore, the bit pattern of a number will be:
+
+<pre><code>
+      xxxxxxxxxxxxxxxxxxxxxxxxxxxxx010
+</code></pre>
+
+<p>Thus, a number is recognized by the interpreter when bit(1) is non-zero.
+
+
+<p><hr>
+<h4><a name="symbol">Symbols</a></h4>
+
+<p>A symbol is more complex than a number. Each symbol has a value, and
+optionally a name and an arbitrary number of properties. The CDR of a symbol
+cell is also called VAL, and the CAR points to the symbol's tail. As a minimum,
+a symbol consists of a single cell, and has no name or properties:
+
+<pre><code>
+            Symbol
+            |
+            V
+      +-----+-----+
+      |  /  | VAL |
+      +-----+-----+
+</code></pre>
+
+<p>That is, the symbol's tail is empty (points to <code>NIL</code>, as indicated
+by the '/' character).
+
+<p>The pointer to a symbol points to the CDR of the cell, with an offset of 4
+from the cell's start address. Therefore, the bit pattern of a symbol will be:
+
+<pre><code>
+      xxxxxxxxxxxxxxxxxxxxxxxxxxxxx100
+</code></pre>
+
+<p>Thus, a symbol is recognized by the interpreter when bit(2) is non-zero.
+
+<p>A property is a key-value-pair, represented as a cell in the symbol's tail.
+This is called a "property list". The property list may be terminated by a
+number representing the symbol's name. In the following example, a symbol with
+the name <code>"abc"</code> has three properties:
+
+<pre><code>
+            Symbol
+            |
+            V
+      +-----+-----+
+      |  |  | VAL |
+      +--+--+-----+
+         | tail
+         |
+         V                                                      name
+         +-----+-----+     +-----+-----+     +-----+-----+     +-----+-----+
+         |  |  |  ---+---> | KEY |  ---+---> |  |  |  ---+---> |'cba'|  /  |
+         +--+--+-----+     +-----+-----+     +--+--+-----+     +-----+-----+
+            |                                   |
+            V                                   V
+            +-----+-----+                       +-----+-----+
+            | VAL | KEY |                       | VAL | KEY |
+            +-----+-----+                       +-----+-----+
+</code></pre>
+
+<p>Each property in a symbol's tail is either a symbol (then it represents a
+boolean value), or a cell with the property key in its CDR and the property
+value in its CAR. In both cases, the key should be a symbol, because searches in
+the property list are performed using pointer comparisons.
+
+<p>The name of a symbol is stored as a number at the end of the tail. It
+contains the characters of the name in UTF-8 encoding, using between one and
+three 8-bit-bytes per character. The first byte of the first character is stored
+in the lowest 8 bits of the number.
+
+<p>All symbols have the above structure, but depending on scope and
+accessibility there are actually four types of symbols: <code><a
+href="#nilSym">NIL</a></code>, <a href="#internal">internal</a>, <a
+href="#transient">transient</a> and <a href="#external">external</a> symbols.
+
+
+<p><hr>
+<h5><a name="nilSym">NIL</a></h5>
+
+<p><code>NIL</code> is a special symbol which exists exactly once in the whole
+system. It is used
+
+<p><ul>
+<li>as an end-of-list marker
+<li>to represent the empty list
+<li>to represent the boolean value "false"
+<li>to represent a string of length zero
+<li>to represent the value "Not a Number"
+<li>as the root of all class hierarchies
+</ul>
+
+<p>For that, <code>NIL</code> has a special structure:
+
+<pre><code>
+      NIL:  /
+            |
+            V
+      +-----+-----+-----+-----+
+      |  /  |  /  |  /  |  /  |
+      +-----+--+--+-----+-----+
+</code></pre>
+
+<p>The reason for that structure is <code>NIL</code>'s dual nature both as a
+symbol and as a list:
+
+<p><ul>
+<li>As a symbol, it should give <code>NIL</code> for its VAL, and be without
+properties
+
+<li>For the empty list, <code>NIL</code> should give <code>NIL</code> both for
+its CAR and for its CDR
+
+</ul>
+
+<p>These requirements are fulfilled by the above structure.
+
+
+<p><hr>
+<h5><a name="internal">Internal Symbols</a></h5>
+
+<p>Internal Symbols are all those "normal" symbols, as they are used for
+function definitions and variable names. They are "interned" into an index
+structure, so that it is possible to find an internal symbol by searching for
+its name.
+
+<p>There cannot be two different internal symbols with the same name.
+
+<p>Initially, a new internal symbol's VAL is <code>NIL</code>.
+
+
+<p><hr>
+<h5><a name="transient">Transient Symbols</a></h5>
+
+<p>Transient symbols are only interned into a index structure for a certain time
+(e.g. while reading the current source file), and are released after that. That
+means, a transient symbol cannot be accessed then by its name, and there may be
+several transient symbols in the system having the same name.
+
+<p>Transient symbols are used
+
+<p><ul>
+<li>as text strings
+
+<li>as identifiers with a limited access scope (like, for example,
+<code>static</code> identifiers in the C language family)
+
+<li>as anonymous, dynamically created objects (without a name)
+
+</ul>
+
+<p>Initially, a new transient symbol's VAL is that symbol itself.
+
+<p>A transient symbol without a name can be created with the <code><a
+href="refB.html#box">box</a></code> or <code><a
+href="refN.html#new">new</a></code> functions.
+
+
+<p><hr>
+<h5><a name="external">External Symbols</a></h5>
+
+<p>External symbols reside in a database file (or a similar resources (see
+<code><a href="refE.html#*Ext">*Ext</a></code>)), and are loaded into memory -
+and written back to the file - dynamically as needed, and transparent to the
+programmer.
+
+<p>The interpreter recognizes external symbols internally by an additional tag
+bit in the tail structure.
+
+<p>There cannot be two different external symbols with the same name. External
+symbols are maintained in index structures while they are loaded into memory,
+and have their external location (disk file and block offset) directly coded
+into their names.
+
+<p>Initially, a new external symbol's VAL is <code>NIL</code>, unless otherwise
+specified at creation time.
+
+
+<p><hr>
+<h4><a name="lst">Lists</a></h4>
+
+<p>A list is a sequence of one or more cells, holding numbers, symbols, or
+lists. Lists are used in PicoLisp to emulate composite data structures like
+arrays, trees, stacks or queues.
+
+<p>In contrast to lists, numbers and symbols are collectively called "Atoms".
+
+<p>Typically, the CDR of each cell in a list points to the following cell,
+except for the last cell which points <code>NIL</code>. If, however, the CDR of
+the last cell points to an atom, that cell is called a "dotted pair" (because of
+its I/O syntax with a dot '.' between the two values).
+
+
+<p><hr>
+<h3><a name="mem">Memory Management</a></h3>
+
+<p>The PicoLisp interpreter has complete knowledge of all data in the system,
+due to the type information associated with every pointer. Therefore, an
+efficient garbage collector mechanism can easily be implemented. PicoLisp
+employs a simple but fast mark-and-sweep garbage collector.
+
+<p>As the collection process is very fast (in the order of milliseconds per
+megabyte), it was not necessary to develop more complicated, time-consuming and
+error-prone garbage collection algorithms (e.g. incremental collection). A
+compacting garbage collector is also not necessary, because the single cell data
+type cannot cause heap fragmentation.
+
+
+<p><hr>
+<h2><a name="penv">Programming Environment</a></h2>
+
+<p>Lisp was chosen as the programming language, because of its clear and simple
+structure.
+
+<p>In some previous versions, a Forth-like syntax was also implemented on top of
+a similar virtual machine (Lifo). Though that language was more flexible and
+expressive, the traditional Lisp syntax proved easier to handle, and the virtual
+machine can be kept considerably simpler.
+
+PicoLisp inherits the major advantages of classical Lisp systems like
+
+<p><ul>
+<li>Dynamic data types and structures
+<li>Formal equivalence of code and data
+<li>Functional programming style
+<li>An interactive environment
+</ul>
+
+<p>In the following, some concepts and peculiarities of the PicoLisp language
+and environment are described.
+
+
+<p><hr>
+<h3><a name="invoc">Invocation</a></h3>
+
+<p>When PicoLisp is invoked from the command line, an arbitrary number of
+arguments may follow the command name.
+
+<p>By default, each argument is the name of a file to be executed by the
+interpreter. If, however, the argument's first character is a hyphen '-', then
+the rest of that argument is taken as a Lisp function call (without the
+surrounding parentheses). A hyphen by itself as an argument stops evaluation of
+the rest of the command line (it may be processed later using the <code><a
+href="refA.html#argv">argv</a></code> and <code><a
+href="refO.html#opt">opt</a></code> functions). This mechanism corresponds to
+calling <code>(<a href="refL.html#load">load</a> T)</code>.
+
+<p>As a convention, PicoLisp source files have the extension "<code>.l</code>".
+
+<p>Note that the PicoLisp executable itself does not expect or accept any
+command line flags or options. They are reserved for application programs.
+
+<p>The simplest and shortest invocation of PicoLisp does nothing, and exits
+immediately by calling <code><a href="refB.html#bye">bye</a></code>:
+
+<pre><code>
+$ bin/picolisp -bye
+$
+</code></pre>
+
+<p>In interactive mode, the PicoLisp interpreter (see <code><a
+href="refL.html#load">load</a></code>) will also exit when an empty line is
+entered:
+
+<pre><code>
+$ bin/picolisp
+:                       # Typed ENTER
+$
+</code></pre>
+
+<p>To start up the standard PicoLisp environment, several files should be
+loaded. The most commonly used things are in "lib.l" and in a bunch of other
+files, which are in turn loaded by "ext.l". Thus, a typical call would be:
+
+<pre><code>
+$ bin/picolisp lib.l ext.l
+</code></pre>
+
+<p>The recommended way, however, is to call the "p" shell script, which includes
+"lib.l" and "ext.l". Given that your current project is loaded by some file
+"myProject.l" and your startup function is <code>main</code>, your invocation
+would look like:
+
+<pre><code>
+$ ./p myProject.l -main
+</code></pre>
+
+<p>For interactive development and debugging it is recommended also to load
+"dbg.l" (or use './dbg' instead of './p'), to get the vi-style command line
+editor, single-stepping, tracing and other debugging utilities.
+
+<pre><code>
+$ ./dbg myProject.l -main
+</code></pre>
+
+<p>In any case, the directory part of the first file name supplied on the
+command line (normally, the path to "lib.l") is remembered internally as the
+<u>PicoLisp Home Directory</u>. This path is later automatically substituted for
+any leading "<code>@</code>" character in file name arguments to I/O functions
+(see <code><a href="refP.html#path">path</a></code>).
+
+
+<p><hr>
+<h3><a name="io">Input/Output</a></h3>
+
+<p>In Lisp, each internal data structure has a well-defined external
+representation in human-readable format. All kinds of data can be written to a
+file, and restored later to their original form by reading that file.
+
+<p>In normal operation, the PicoLisp interpreter continuously executes an
+infinite "read-eval-print loop". It reads one expression at a time, evaluates
+it, and prints the result to the console. Any input into the system, like data
+structures and function definitions, is done in a consistent way no matter
+whether it is entered at the console or read from a file.
+
+<p>Comments can be embedded in the input stream with the hash <code>#</code>
+character. Everything up to the end of that line will be ignored by the reader.
+
+<pre><code>
+: (* 1 2 3)  # This is a comment
+-> 6
+</code></pre>
+
+<p>A comment spanning several lines may be enclosed between <code>#{</code> and
+<code>}#</code>.
+
+
+<p>Here is the I/O syntax for the individual PicoLisp data types:
+
+
+<p><hr>
+<h4><a name="num-io">Numbers</a></h4>
+
+<p>A number consists of an arbitrary number of digits (<code>'0'</code> through
+<code>'9'</code>), optionally preceded by a sign character (<code>'+'</code> or
+<code>'-'</code>). Legal number input is:
+
+<pre><code>
+: 7
+-> 7
+: -12345678901245678901234567890
+-> -12345678901245678901234567890
+</code></pre>
+
+<p>Fixed-point numbers can be input by embedding a decimal point
+<code>'.'</code>, and setting the global variable <code><a
+href="refS.html#*Scl">*Scl</a></code> appropriately:
+
+<pre><code>
+: *Scl
+-> 0
+
+: 123.45
+-> 123
+: 456.78
+-> 457
+
+: (setq *Scl 3)
+-> 3
+: 123.45
+-> 123450
+: 456.78
+-> 456780
+</code></pre>
+
+<p>Thus, fixed-point input simply scales the number to an integer value
+corresponding to the number of digits in <code><a
+href="refS.html#*Scl">*Scl</a></code>.
+
+<p>Formatted output of scaled fixed-point values can be done with the <code><a
+href="refF.html#format">format</a></code> function:
+
+<pre><code>
+: (format 1234567890 2)
+-> "12345678.90"
+: (format 1234567890 2 "." ",")
+-> "12,345,678.90"
+</code></pre>
+
+
+<p><hr>
+<h4><a name="sym-io">Symbols</a></h4>
+
+<p>The reader is able to recognize the individual symbol types from their
+syntactic form. A symbol name should - of course - not look like a legal number
+(see above).
+
+<p>In general, symbol names are case-sensitive. <code>car</code> is not the same
+as CAR.
+
+
+<p><hr>
+<h5><a name="nilSym-io">NIL</a></h5>
+
+<p>Besides for standard normal form, <code>NIL</code> is also recognized as
+<code>()</code>, <code>[]</code> or <code>""</code>.
+
+<pre><code>
+: NIL
+-> NIL
+: ()
+-> NIL
+: ""
+-> NIL
+</code></pre>
+
+<p>Output will always appear as <code>NIL</code>.
+
+
+<p><hr>
+<h5><a name="internal-io">Internal Symbols</a></h5>
+
+<p>Internal symbol names can consist of any printable (non-whitespace)
+character, except for the following meta characters:
+
+<pre><code>
+   "  '  (  )  ,  [  ]  `  ~ { }
+</code></pre>
+
+<p>It is possible, though, to include these special characters into symbol names
+by escaping them with a backslash '<code>\</code>'.
+
+<p>The dot '<code>.</code>' has a dual nature. It is a meta character when
+standing alone, denoting a <a href="#dotted">dotted pair</a>, but can otherwise
+be used in symbol names.
+
+<p>As a rule, anything not recognized by the reader as another data type will be
+returned as an internal symbol.
+
+
+<p><hr>
+<h5><a name="transient-io">Transient Symbols</a></h5>
+
+<p>In an interactive environment (console), transient symbols should appear as
+an <u>underlined</u> sequence of characters. Where this is not possible (e.g.
+for representation in files), or inconvenient (while editing), double quotes
+'<code>"</code>' are used instead of underlining.
+
+<p>The underlining of transient symbols is controlled by the global variable
+<code><a href="refT.html#*Tsm">*Tsm</a></code>, and can be switched off
+completely with
+
+<pre><code>
+: (off *Tsm)
+</code></pre>
+
+<p>Keyboard input of transient symbols is always via the double quote key.
+
+<p>A transient symbol may be used (and, in double quote representation, also
+look) like a string constant in other languages. However, it is a real symbol,
+and may be assigned a value or a function definition, and properties.
+
+<p>Initially, a transient symbol's value is that symbol itself, so that it does
+not need to be quoted for evaluation:
+
+<pre><code>
+: <u>This is a string</u>   # "This is a string" if *Tsm is off
+-> <u>This is a string</u>
+</code></pre>
+
+<p>However, care must be taken when assigning a value to a transient symbol.
+This may cause unexpected behavior:
+
+<pre><code>
+: (setq <u>This is a string</u> 12345)  # (setq "This is a string" 12345)
+-> 12345
+: <u>This is a string</u>
+-> 12345
+</code></pre>
+
+<p>The name of a transient symbol can contain any character except zero. A
+double quote character can be escaped with a backslash '<code>\</code>', and a
+backslash itself has to be escaped with another backslash. Control characters
+can be written with a preceding hat '<code>^</code>' character.
+
+<pre><code>
+: <u>We^Ird\\Str\"ing</u>
+-> <u>We^Ird\\Str"ing</u>
+: (chop @)
+-> (<u>W</u> <u>e</u> <u>^I</u> <u>r</u> <u>d</u> <u>\\</u> <u>S</u> <u>t</u> <u>r</u> <u>"</u> <u>i</u> <u>n</u> <u>g</u>)
+</code></pre>
+
+<p>The index for transient symbols is cleared automatically before and after
+<code><a href="refL.html#load">load</a></code>ing a source file, or it can be
+reset explicitly with the <code><a href="ref_.html#====">====</a></code>
+function. With that mechanism, it is possible to create symbols with a local
+access scope, not accessible from other parts of the program.
+
+<p>A special case of transient symbols are <i>anonymous symbols</i>. These are
+symbols without name (see <code><a href="refB.html#box">box</a></code>, <code><a
+href="refB.html#box?">box?</a></code> or <code><a
+href="refN.html#new">new</a></code>). They print as a dollar sign
+(<code>$</code>) followed by a decimal digit string (actually their machine
+address).
+
+<p>To allow an easier copy/paste of the examples, most of the documentation uses
+the double quote notation for transient symbols.
+
+
+<p><hr>
+<h5><a name="external-io">External Symbols</a></h5>
+
+<p>External symbol names are surrounded by braces (<code>'{'</code> and
+<code>'}'</code>). The characters of the symbol's name itself identify the
+physical location of the external object. This is
+
+<ul>
+<li>in the 32-bit version: The number of the database file, and - separated by a
+hyphen - the starting block in the database file. Both numbers are encoded in
+base-64 notation (characters '<code>0</code>' through '<code>9</code>',
+'<code>:</code>', '<code>;</code>', '<code>A</code>' through '<code>Z</code>'
+and '<code>a</code>' through '<code>z</code>').
+
+<li>in the 64-bit version: The number of the database file minus 1 in "hax"
+notation (i.e. hexadecimal/alpha notation, where '@' is zero, 'A' is 1 and 'O'
+is 15 (from "alpha" to "omega")), immediately followed (without a hyphen) the
+starting block in octal ('0' through '7').
+
+</ul>
+
+<p>In both cases, the database file (and possibly the hypen) are omitted for the
+first (default) file.
+
+<p><hr>
+<h4><a name="lst-io">Lists</a></h4>
+
+<p>Lists are surrounded by parentheses (<code>'('</code> and <code>')'</code>).
+
+<p><code>(A)</code> is a list consisting of a single cell, with the symbol
+<code>A</code> in its CAR, and <code>NIL</code> in its CDR.
+
+<p><code>(A B C)</code> is a list consisting of three cells, with the symbols
+<code>A</code>, <code>B</code> and <code>C</code> respectively in their CAR, and
+<code>NIL</code> in the last cell's CDR.
+
+<p><a name="dotted"><code>(A . B)</code></a> is a "dotted pair", a list
+consisting of a single cell, with the symbol <code>A</code> in its CAR, and
+<code>B</code> in its CDR.
+
+<p>PicoLisp has built-in support for reading and printing simple circular lists.
+If the dot in a dotted-pair notation is immediately followed by a closing
+parenthesis, it indicates that the CDR of the last cell points back to the
+beginning of that list.
+
+<pre><code>
+: (let L '(a b c) (conc L L))
+-> (a b c .)
+: (cdr '(a b c .))
+-> (b c a .)
+: (cddddr '(a b c .))
+-> (b c a .)
+</code></pre>
+
+<p>A similar result can be achieved with the function <code><a
+href="refC.html#circ">circ</a></code>. Such lists must be used with care,
+because many functions won't terminate or will crash when given such a list.
+
+
+<p><hr>
+<h4><a name="macro-io">Read-Macros</a></h4>
+
+<p>Read-macros in PicoLisp are special forms that are recognized by the reader,
+and modify its behavior. Note that they take effect immediately while reading an
+expression, and are not seen by the <code>eval</code> in the main loop.
+
+<p>The most prominent read-macro in Lisp is the single quote character
+<code>'</code>, which expands to a call of the <code><a
+href="refQ.html#quote">quote</a></code> function. Note that the single quote
+character is also printed instead of the full function name.
+
+<pre><code>
+: '(a b c)
+-> (a b c)
+: '(quote . a)
+-> 'a
+: (cons 'quote 'a)   # (quote . a)
+-> 'a
+: (list 'quote 'a)   # (quote a)
+-> '(a)
+</code></pre>
+
+<p>A comma (<code>,</code>) will cause the reader to collect the following data
+item into an <code><a href="refI.html#idx">idx</a></code> tree in the global
+variable <code><a href="refU.html#*Uni">*Uni</a></code>, and to return a
+previously inserted equal item if present. This makes it possible to create a
+unique list of references to data which do normally not follow the rules of
+pointer equality.
+
+<p>A single backquote character <code>`</code> will cause the reader to evaluate
+the following expression, and return the result.
+
+<pre><code>
+: '(a `(+ 1 2 3) z)
+-> (a 6 z)
+</code></pre>
+
+<p>A tilde character <code>~</code> inside a list will cause the reader to
+evaluate the following expression, and splice the result into the list.
+
+<pre><code>
+: '(a b c ~(list 'd 'e 'f) g h i)
+-> (a b c d e f g h i)
+</code></pre>
+
+<p>Brackets (<code>'['</code> and <code>']'</code>) can be used as super
+parentheses. A closing bracket will match the innermost opening bracket, or all
+currently open parentheses.
+
+<pre><code>
+: '(a (b (c (d]
+-> (a (b (c (d))))
+: '(a (b [c (d]))
+-> (a (b (c (d))))
+</code></pre>
+
+<p>Finally, reading the sequence '<code>{}</code>' will result in a new
+anonymous symbol with value <code>NIL</code>, equivalent to a call to <code><a
+href="refB.html#box">box</a></code> without arguments.
+
+<pre><code>
+: '({} {} {})
+-> ($134599965 $134599967 $134599969)
+: (mapcar val @)
+-> (NIL NIL NIL)
+</code></pre>
+
+
+<p><hr>
+<h3><a name="ev">Evaluation</a></h3>
+
+<p>PicoLisp tries to evaluate any expression encountered in the read-eval-print
+loop. Basically, it does so by applying the following three rules:
+
+<p><ul>
+<li>A number evaluates to itself.
+
+<li>A symbol evaluates to its value (VAL).
+
+<li>A list is evaluated as a function call, with the CAR as the function and the
+CDR the arguments to that function. These arguments are in turn evaluated
+according to these three rules.
+
+</ul>
+
+<pre><code>
+: 1234
+-> 1234        # Number evaluates to itself
+: *Pid
+-> 22972       # Symbol evaluates to its VAL
+: (+ 1 2 3)
+-> 6           # List is evaluated as a function call
+</code></pre>
+
+<p>For the third rule, however, things get a bit more involved. First - as a
+special case - if the CAR of the list is a number, the whole list is returned as
+it is:
+
+<pre><code>
+: (1 2 3 4 5 6)
+-> (1 2 3 4 5 6)
+</code></pre>
+
+<p>This is not really a function call but just a convenience to avoid having to
+quote simple data lists.
+
+<p>Otherwise, if the CAR is a symbol or a list, PicoLisp tries to obtain an
+executable function from that, by either using the symbol's value, or by
+evaluating the list.
+
+<p>What is an executable function? Or, said in another way, what can be applied
+to a list of arguments, to result in a function call? A legal function in
+PicoLisp is
+
+<p><dl>
+<dt>either
+<dd>a <u>number</u>. When a number is used as a function, it is simply taken as
+a pointer to executable code that will be called with the list of (unevaluated)
+arguments as its single parameter. It is up to that code to evaluate the
+arguments, or not. Some functions do not evaluate their arguments (e.g.
+<code>quote</code>) or evaluate only some of their arguments (e.g.
+<code>setq</code>).
+
+<dt>or
+<dd>a <u>lambda expression</u>. A lambda expression is a list, whose CAR is
+either a symbol or a list of symbols, and whose CDR is a list of expressions.
+Note: In contrast to other Lisp implementations, the symbol LAMBDA itself does
+not exist in PicoLisp but is implied from context.
+
+</dl>
+
+<p>A few examples should help to understand the practical consequences of these
+rules. In the most common case, the CAR will be a symbol defined as a function,
+like the <code>*</code> in:
+
+<pre><code>
+: (* 1 2 3)    # Call the function '*'
+-> 6
+</code></pre>
+
+<p>Inspecting the VAL of <code>*</code>, however, gives
+
+<pre><code>
+: *            # Get the VAL of the symbol '*'
+-> 67291944
+</code></pre>
+
+<p>The VAL of <code>*</code> is a number. In fact, it is the numeric
+representation of a C-function pointer, i.e. a pointer to executable code. This
+is the case for all built-in functions of PicoLisp.
+
+<p>Other functions in turn are written as Lisp expressions:
+
+<pre><code>
+: (de foo (X Y)            # Define the function 'foo'
+   (* (+ X Y) (+ X Y)) )
+-> foo
+: (foo 2 3)                # Call the function 'foo'
+-> 25
+: foo                      # Get the VAL of the symbol 'foo'
+-> ((X Y) (* (+ X Y) (+ X Y)))
+</code></pre>
+
+<p>The VAL of <code>foo</code> is a list. It is the list that was assigned to
+<code>foo</code> with the <code>de</code> function. It would be perfectly legal
+to use <code>setq</code> instead of <code>de</code>:
+
+<pre><code>
+: (setq foo '((X Y) (* (+ X Y) (+ X Y))))
+-> ((X Y) (* (+ X Y) (+ X Y)))
+: (foo 2 3)
+-> 25
+</code></pre>
+
+<p>If the VAL of <code>foo</code> were another symbol, that symbol's VAL would
+be used instead to search for an executable function.
+
+<p>As we said above, if the CAR of the evaluated expression is not a symbol but
+a list, that list is evaluated to obtain an executable function.
+
+<pre><code>
+: ((intern (pack "c" "a" "r")) (1 2 3))
+-> 1
+</code></pre>
+
+<p>Here, the <code>intern</code> function returns the symbol <code>car</code>
+whose VAL is used then. It is also legal, though quite dangerous, to use the
+code-pointer directly:
+
+<pre><code>
+: car
+-> 67306152
+: ((* 2 33653076) (1 2 3))
+-> 1
+</code></pre>
+
+<p>When an executable function is defined in Lisp itself, we call it a <a
+name="lambda"><u>lambda expression</u></a>. A lambda expression always has a
+list of executable expressions as its CDR. The CAR, however, must be a either a
+list of symbols, or a single symbol, and it controls the evaluation of the
+arguments to the executable function according to the following rules:
+
+<p><dl>
+
+<dt>When the CAR is a list of symbols
+<dd>For each of these symbols an argument is evaluated, then the symbols are
+bound simultaneously to the results. The body of the lambda expression is
+executed, then the VAL's of the symbols are restored to their original values.
+This is the most common case, a fixed number of arguments is passed to the
+function.
+
+<dt>Otherwise, when the CAR is the symbol <code>@</code>
+<dd>All arguments are evaluated and the results kept internally in a list. The
+body of the lambda expression is executed, and the evaluated arguments can be
+accessed sequentially with the <code><a href="refA.html#args">args</a></code>,
+<code><a href="refN.html#next">next</a></code>, <code><a
+href="refA.html#arg">arg</a></code> and <code><a
+href="refR.html#rest">rest</a></code> functions. This allows to define functions
+with a variable number of evaluated arguments.
+
+<dt>Otherwise, when the CAR is a single symbol
+<dd>The symbol is bound to the whole unevaluated argument list. The body of the
+lambda expression is executed, then the symbol is restored to its original
+value. This allows to define functions with unevaluated arguments. Any kind of
+interpretation and evaluation of the argument list can be done inside the
+expression body.
+
+</dl>
+
+<p>In all cases, the return value is the result of the last expression in the
+body.
+
+<pre><code>
+: (de foo (X Y Z)                   # CAR is a list of symbols
+   (list X Y Z) )                   # Return a list of all arguments
+-> foo
+: (foo (+ 1 2) (+ 3 4) (+ 5 6))
+-> (3 7 11)                         # all arguments are evaluated
+</code></pre>
+
+<pre><code>
+: (de foo X                         # CAR is a single symbol
+   X )                              # Return the argument
+-> foo
+: (foo (+ 1 2) (+ 3 4) (+ 5 6))
+-> ((+ 1 2) (+ 3 4) (+ 5 6))        # the whole unevaluated list is returned
+</code></pre>
+
+<pre><code>
+: (de foo @                         # CAR is the symbol '@'
+   (list (next) (next) (next)) )    # Return the first three arguments
+-> foo
+: (foo (+ 1 2) (+ 3 4) (+ 5 6))
+-> (3 7 11)                         # all arguments are evaluated
+</code></pre>
+
+<p>Note that these forms can also be combined. For example, to evaluate only the
+first two arguments, bind the results to <code>X</code> and <code>Y</code>, and
+bind all other arguments (unevaluated) to <code>Z</code>:
+
+<pre><code>
+: (de foo (X Y . Z)                 # CAR is a list with a dotted-pair tail
+   (list X Y Z) )                   # Return a list of all arguments
+-> foo
+: (foo (+ 1 2) (+ 3 4) (+ 5 6))
+-> (3 7 ((+ 5 6)))                  # two arguments are evaluated
+</code></pre>
+
+<p>Or, a single argument followed by a variable number of arguments:
+
+<pre><code>
+: (de foo (X . @)                   # CAR is a dotted-pair with '@'
+   (println X)                      # print the first evaluated argument
+   (while (args)                    # while there are more arguments
+      (println (next)) ) )          # print the next one
+-> foo
+: (foo (+ 1 2) (+ 3 4) (+ 5 6))
+3                                   # X
+7                                   # Next arg
+11
+-> 11
+</code></pre>
+
+<p>In general, if more than the expected number of arguments is supplied to a
+function, these extra arguments will be ignored. Missing arguments default to
+<code>NIL</code>.
+
+
+<p><hr>
+<h3><a name="int">Interrupt</a></h3>
+
+<p>During the evaluation of an expression, the PicoLisp interpreter can be
+interrupted at any time by hitting <code>Ctrl-C</code>. It will then enter the
+breakpoint routine, as if <code><a href="ref_.html#!">!</a></code> were called.
+
+<p>Hitting ENTER at that point will continue evaluation, while <code>(<a
+href="refQ.html#quit">quit</a>)</code> will abort evaluation and return the
+interpreter to the top level. See also <code><a
+href="refD.html#debug">debug</a></code>, <code><a
+href="refE.html#e">e</a></code>, <code><a href="ref_.html#^">^</a></code> and
+<code><a href="refD.html#*Dbg">*Dbg</a></code>
+
+
+<p><hr>
+<h3><a name="errors">Error Handling</a></h3>
+
+<p>When a runtime error occurs, execution is stopped and an error handler is
+entered.
+
+<p>The error handler resets the I/O channels to the console, and displays the
+location (if possible) and the reason of the error, followed by an error
+message. That message is also stored in the global <code><a
+href="refM.html#*Msg">*Msg</a></code>, and the location of the error in <code><a
+href="ref_.html#^">^</a></code>. If the VAL of the global <code><a
+href="refE.html#*Err">*Err</a></code> is non-<code>NIL</code> it is executed as
+a <code>prg</code> body. If the standard input is from a terminal, a
+read-eval-print loop (with a question mark "<code>?</code>" as prompt) is
+entered (the loop is exited when an empty line is input). Then all pending
+<code><a href="refF.html#finally">finally</a></code> expressions are executed,
+all variable bindings restored, and all files closed. If the standard input is
+not from a terminal, the interpreter terminates. Otherwise it is reset to its
+top-level state.
+
+<pre><code>
+: (de foo (A B) (badFoo A B))       # 'foo' calls an undefined symbol
+-> foo
+: (foo 3 4)                         # Call 'foo'
+!? (badFoo A B)                     # Error handler entered
+badFoo -- Undefined
+? A                                 # Inspect 'A'
+-> 3
+? B                                 # Inspect 'B'
+-> 4
+?                                   # Empty line: Exit
+:
+</code></pre>
+
+<p>Errors can be caught with <code><a href="refC.html#catch">catch</a></code>,
+if a list of substrings of possible error messages is supplied for the first
+argument. In such a case, the matching substring (or the whole error message if
+the substring is <code>NIL</code>) is returned.
+
+
+<p><hr>
+<h3><a name="atres">@ Result</a></h3>
+
+<p>In certain situations, the result of the last evaluation is stored in the VAL
+of the symbol <code>@</code>. This can be very convenient, because it often
+makes the assignment to temporary variables unnecessary.
+
+<p><dl>
+
+<dt><code><a href="refL.html#load">load</a></code>
+<dd>In read-eval loops, the last three results which were printed at the console
+are available in <code>@@@</code>, <code>@@</code> and <code>@</code>, in that
+order (i.e the latest result is in <code>@</code>).
+
+<pre><code>
+: (+ 1 2 3)
+-> 6
+: (/ 128 4)
+-> 32
+: (- @ @@)        # Subtract the last two results
+-> 26
+</code></pre>
+
+<p><dt>Flow functions
+<dd>Flow- and logic-functions store the result of their controlling expression -
+respectively non-<code>NIL</code> results of their conditional expression - in
+<code>@</code>.
+
+<pre><code>
+: (while (read) (println 'got: @))
+abc            # User input
+got: abc       # print result
+123            # User input
+got: 123       # print result
+NIL
+-> 123
+
+: (setq L (1 2 3 4 5 1 2 3 4 5))
+-> (1 2 3 4 5 1 2 3 4 5)
+: (and (member 3 L) (member 3 (cdr @)) (set @ 999))
+-> 999
+: L
+-> (1 2 3 4 5 1 2 999 4 5)
+</code></pre>
+
+<p>Functions with controlling expressions are
+   <a href="refC.html#case">case</a>,
+   <a href="refP.html#prog1">prog1</a>,
+   <a href="refP.html#prog2">prog2</a>,
+and the bodies of <code><a href="refR.html#*Run">*Run</a></code> tasks.
+
+<p>Functions with conditional expressions are
+   <a href="refA.html#and">and</a>,
+   <a href="refC.html#cond">cond</a>,
+   <a href="refD.html#do">do</a>,
+   <a href="refF.html#for">for</a>,
+   <a href="refI.html#if">if</a>,
+   <a href="refI.html#if2">if2</a>,
+   <a href="refI.html#ifn">ifn</a>,
+   <a href="refL.html#loop">loop</a>,
+   <a href="refN.html#nand">nand</a>,
+   <a href="refN.html#nond">nond</a>,
+   <a href="refN.html#nor">nor</a>,
+   <a href="refN.html#not">not</a>,
+   <a href="refO.html#or">or</a>,
+   <a href="refS.html#state">state</a>,
+   <a href="refU.html#unless">unless</a>,
+   <a href="refU.html#until">until</a>,
+   <a href="refW.html#when">when</a> and
+   <a href="refW.html#while">while</a>.
+
+</dl>
+
+<p><code>@</code> is generally local to functions and methods, its value is
+automatically saved upon function entry and restored at exit.
+
+
+<p><hr>
+<h3><a name="cmp">Comparing</a></h3>
+
+<p>In PicoLisp, it is legal to compare data items of arbitrary type. Any two
+items are either
+
+<p><dl>
+
+<dt>Identical
+<dd>They are the same memory object (pointer equality). For example, two
+internal symbols with the same name are identical. In the 64-bit version, also
+short numbers (up to 60 bits) are pointer-equal.
+
+<dt>Equal
+<dd>They are equal in every respect (structure equality), but need not to be
+identical. Examples are numbers with the same value, transient symbols with the
+same name or lists with equal elements.
+
+<dt>Or they have a well-defined ordinal relationship
+<dd>Numbers are comparable by their numeric value, strings by their name, and
+lists recursively by their elements (if the CAR's are equal, their CDR's are
+compared). For differing types, the following rule applies: Numbers are less
+than symbols, and symbols are less than lists. As special cases,
+<code>NIL</code> is always less than anything else, and <code>T</code> is always
+greater than anything else.
+
+</dl>
+
+<p>To demonstrate this, <code><a href="refS.html#sort">sort</a></code> a list of
+mixed data types:
+
+<pre><code>
+: (sort '("abc" T (d e f) NIL 123 DEF))
+-> (NIL 123 DEF "abc" (d e f) T)
+</code></pre>
+
+<p>See also <code><a href="refM.html#max">max</a></code>, <code><a
+href="refM.html#min">min</a></code>, <code><a
+href="refR.html#rank">rank</a></code>, <code><a href="ref_.html#<"><</a></code>,
+<code><a href="ref_.html#=">=</a></code>, <code><a
+href="ref_.html#>">></a></code> etc.
+
+
+<p><hr>
+<h3><a name="oop">OO Concepts</a></h3>
+
+<p>PicoLisp comes with built-in object oriented extensions. There seems to be a
+common agreement upon three criteria for object orientation:
+
+<p><dl>
+<dt>Encapsulation
+<dd>Code and data are encapsulated into <u>objects</u>, giving them both a
+<u>behavior</u> and a <u>state</u>. Objects communicate by sending and receiving
+<u>messages</u>.
+
+<dt>Inheritance
+<dd>Objects are organized into <u>classes</u>. The behavior of an object is
+inherited from its class(es) and superclass(es).
+
+<dt>Polymorphism
+<dd>Objects of different classes may behave differently in response to the same
+message. For that, classes may define different methods for each message.
+
+</dl>
+
+<p>PicoLisp implements both objects and classes with symbols. Object-local data
+are stored in the symbol's property list, while the code (methods) and links to
+the superclasses are stored in the symbol's VAL (encapsulation).
+
+<p>In fact, there is no formal difference between objects and classes (except
+that objects usually are anonymous symbols containing mostly local data, while
+classes are named internal symbols with an emphasis on method definitions). At
+any time, a class may be assigned its own local data (class variables), and any
+object can receive individual method definitions in addition to (or overriding)
+those inherited from its (super)classes.
+
+<p>PicoLisp supports multiple inheritance. The VAL of each object is a (possibly
+empty) association list of message symbols and method bodies, concatenated with
+a list of classes. When a message is sent to an object, it is searched in the
+object's own method list, and then (with a left-to-right depth-first search) in
+the tree of its classes and superclasses. The first method found is executed and
+the search stops. The search may be explicitly continued with the <code><a
+href="refE.html#extra">extra</a></code> and <code><a
+href="refS.html#super">super</a></code> functions.
+
+<p>Thus, which method is actually executed when a message is sent to an object
+depends on the classes that the object is currently linked to (polymorphism). As
+the method search is fully dynamic (late binding), an object's type (i.e. its
+classes and method definitions) can be changed even at runtime!
+
+<p>While a method body is being executed, the global variable <code><a
+href="refT.html#This">This</a></code> is set to the current object, allowing
+the use of the short-cut property functions <code><a
+href="ref_.html#=:">=:</a></code>, <code><a href="ref_.html#:">:</a></code>
+and <code><a href="ref_.html#::">::</a></code>.
+
+
+<p><hr>
+<h3><a name="dbase">Database</a></h3>
+
+<p>On the lowest level, a PicoLisp database is just a collection of <a
+href="#external">external symbols</a>. They reside in a database file, and are
+dynamically swapped in and out of memory. Only one database can be open at a
+time (<code><a href="refP.html#pool">pool</a></code>).
+
+<p>In addition, further external symbols can be specified to originate from
+arbitrary sources via the <code><a href="refE.html#*Ext">*Ext</a></code>
+mechanism.
+
+<p>Whenever an external symbol's value or property list is accessed, it will be
+automatically fetched into memory, and can then be used like any other symbol.
+Modifications will be written to disk only when <code><a
+href="refC.html#commit">commit</a></code> is called. Alternatively, all
+modifications since the last call to <code>commit</code> can be discarded by
+calling <code><a href="refR.html#rollback">rollback</a></code>.
+
+<p><hr>
+<h4><a name="trans">Transactions</a></h4>
+
+<p>In the typical case there will be multiple processes operating on the same
+database. These processes should be all children of the same parent process,
+which takes care of synchronizing read/write operations and heap contents. Then
+a database transaction is normally initiated by calling <code>(<a
+href="refD.html#dbSync">dbSync</a>)</code>, and closed by calling <code>(<a
+href="refC.html#commit">commit</a> 'upd)</code>. Short transactions, involving
+only a single DB operation, are available in functions like <code><a
+href="refN.html#new!">new!</a></code> and methods like <code><a
+href="refE.html#entityMesssages">put!></a></code> (by convention with an
+exclamation mark), which implicitly call <code>(dbSync)</code> and <code>(commit
+'upd)</code> themselves.
+
+<p>A transaction proceeds through five phases:
+
+<p><ol>
+<li><code><a href="refD.html#dbSync">dbSync</a></code> waits to get a <code><a
+href="refL.html#lock">lock</a></code> on the root object <code><a
+href="refD.html#*DB">*DB</a></code>. Other processes continue reading and
+writing meanwhile.
+
+<li><code><a href="refD.html#dbSync">dbSync</a></code> calls <code><a
+href="refS.html#sync">sync</a></code> to synchronize with changes from other
+processes. We hold the shared lock, but other processes may continue reading.
+
+<li>We make modifications to the internal state of external symbols with
+<code><a href="refE.html#entityMesssages">put>, set>, lose></a></code> etc. We -
+and also other processes - can still read the DB.
+
+<li>We call <code>(<a href="refC.html#commit">commit</a> 'upd)</code>.
+<code>commit</code> obtains an exclusive lock (no more read operations by other
+processes), writes an optional transaction log, and then all modified symbols.
+As <code><a href="refU.html#upd">upd</a></code> is passed to 'commit', other
+processes synchronize with these changes.
+
+<li>Finally, all locks are released by 'commit'
+
+</ol>
+
+<p><hr>
+<h4><a name="er">Entities / Relations</a></h4>
+
+<p>The symbols in a database can be used to store arbitrary information
+structures. In typical use, some symbols represent nodes of search trees, by
+holding keys, values, and links to subtrees in their VAL's. Such a search tree
+in the database is called <u>index</u>.
+
+<p>For the most part, other symbols in the database are objects derived from the
+<code><a href="refE.html#+Entity">+Entity</a></code> class.
+
+<p>Entities depend on objects of the <code><a
+href="refR.html#+relation">+relation</a></code> class hierarchy.
+Relation-objects manage the property values of entities, they define the
+application database model and are responsible for the integrity of mutual
+object references and index trees.
+
+<p>Relations are stored as properties in the entity classes, their methods are
+invoked as daemons whenever property values in an entity are changed. When
+defining an <code><a href="refE.html#+Entity">+Entity</a></code> class, relations are defined - in addition to
+the method definitions of a normal class - with the <code><a
+href="refR.html#rel">rel</a></code> function. Predefined relation classes
+include
+
+<p><ul>
+<li>Primitive types like
+   <dl>
+   <dt><code><a href="refS.html#+Symbol">+Symbol</a></code>
+   <dd>Symbolic data
+   <dt><code><a href="refS.html#+String">+String</a></code>
+   <dd>Strings (just a general case of symbols)
+   <dt><code><a href="refN.html#+Number">+Number</a></code>
+   <dd>Integers and fixed-point numbers
+   <dt><code><a href="refD.html#+Date">+Date</a></code>
+   <dd>Calendar date values, represented by a number
+   <dt><code><a href="refT.html#+Time">+Time</a></code>
+   <dd>Time-of-the-day values, represented by a number
+   <dt><code><a href="refB.html#+Blob">+Blob</a></code>
+   <dd>"Binary large objects" stored in separate files
+   </dl>
+<li>Object-to-object relations
+   <dl>
+   <dt><code><a href="refL.html#+Link">+Link</a></code>
+   <dd>A reference to some other entity
+   <dt><code><a href="refH.html#+Hook">+Hook</a></code>
+   <dd>A reference to an entity holding object-local index trees
+   <dt><code><a href="refJ.html#+Joint">+Joint</a></code>
+   <dd>A bi-directional reference to some other entity
+   </dl>
+<li>Container prefix classes like
+   <dl>
+   <dt><code><a href="refL.html#+List">+List</a></code>
+   <dd>A list of any of the other primitive or object relation types
+   <dt><code><a href="refB.html#+Bag">+Bag</a></code>
+   <dd>A list containing a mixture of any of the other types
+   </dl>
+<li>Index prefix classes
+   <dl>
+   <dt><code><a href="refR.html#+Ref">+Ref</a></code>
+   <dd>An index with other primitives or entities as key
+   <dt><code><a href="refK.html#+Key">+Key</a></code>
+   <dd>A unique index with other primitives or entities as key
+   <dt><code><a href="refI.html#+Idx">+Idx</a></code>
+   <dd>A full-text index, typically for strings
+   <dt><code><a href="refS.html#+Sn">+Sn</a></code>
+   <dd>Tolerant index, using a modified Soundex-Algorithm
+   </dl>
+<li>Booleans
+   <dl>
+   <dt><code><a href="refB.html#+Bool">+Bool</a></code>
+   <dd><code>T</code> or <code>NIL</code>
+   </dl>
+<li>And a catch-all class
+   <dl>
+   <dt><code><a href="refA.html#+Any">+Any</a></code>
+   <dd>Not specified, may be any of the above relations
+   </dl>
+</ul>
+
+
+<p><hr>
+<h3><a name="pilog">Pilog (PicoLisp Prolog)</a></h3>
+
+<p>A declarative language is built on top of PicoLisp, that has the semantics of
+Prolog, but uses the syntax of Lisp.
+
+<p>For an explanation of Prolog's declarative programming style, an introduction
+like "Programming in Prolog" by Clocksin/Mellish (Springer-Verlag 1981) is
+recommended.
+
+<p>Facts and rules can be declared with the <code><a
+href="refB.html#be">be</a></code> function. For example, a Prolog fact
+'<code>likes(john,mary).</code>' is written in Pilog as:
+
+<pre><code>
+(be likes (John Mary))
+</code></pre>
+
+<p>and a rule '<code>likes(john,X) :- likes(X,wine), likes(X,food).</code>' is
+in Pilog:
+
+<pre><code>
+(be likes (John @X) (likes @X wine) (likes @X food))
+</code></pre>
+
+<p>As in Prolog, the difference between facts and rules is that the latter ones
+have conditions, and usually contain variables.
+
+<p>A variable in Pilog is any symbol starting with an at-mark character
+("<code>@</code>"). The symbol <code>@</code> itself can be used as an anonymous
+variable: It will match during unification, but will not be bound to the matched
+values.
+
+<p>The <i>cut</i> operator of Prolog (usually written as an exclamation mark
+(<code>!</code>)) is the symbol <code>T</code> in Pilog.
+
+<p>An interactive query can be done with the <code><a
+href="ref_.html#?">?</a></code> function:
+
+<pre><code>
+(? (likes John @X))
+</code></pre>
+
+<p>This will print all solutions, waiting for user input after each line. If a
+non-empty line (not just a ENTER key, but for example a dot (<code>.</code>)
+followed by ENTER) is typed, it will terminate.
+
+<p>Pilog can be called from Lisp and vice versa:
+
+<ul>
+
+<li>The interface from Lisp is via the functions <code><a
+href="refG.html#goal">goal</a></code> (prepare a query from Lisp data) and
+<code><a href="refP.html#prove">prove</a></code> (return an association list of
+successful bindings), and the application level functions <code><a
+href="refP.html#pilog">pilog</a></code> and <code><a
+href="refS.html#solve">solve</a></code>.
+
+<li>When the CAR of a Pilog clause is a Pilog variable, the CDR is executed as a
+Lisp expression and the result unified with that variable.
+
+<li>Within such a Lisp expression in a Pilog clause, the current bindings of
+Pilog variables can be accessed with the <code><a
+href="ref_.html#->">-&gt</a></code> function.
+
+</ul>
+
+<p><hr>
+<h3><a name="conv">Naming Conventions</a></h3>
+
+<p>It was necessary to introduce - and adhere to - a set of conventions for
+PicoLisp symbol names. Because all (internal) symbols have a global scope (there
+are no packages or name spaces), and each symbol can only have either a value or
+function definition, it would otherwise be very easy to introduce name
+conflicts. Besides this, source code readability is increased when the scope of
+a symbol is indicated by its name.
+
+<p>These conventions are not hard-coded into the language, but should be so into
+the head of the programmer. Here are the most commonly used ones:
+
+<p><ul>
+<li>Global variables start with an asterisk "<code>*</code>"
+<li>Functions and other global symbols start with a lower case letter
+<li>Locally bound symbols start with an upper case letter
+<li>Local functions start with an underscore "<code>_</code>"
+<li>Classes start with a plus-sign "<code>+</code>", where the first letter
+   <ul>
+   <li>is in lower case for abstract classes
+   <li>and in upper case for normal classes
+   </ul>
+<li>Methods end with a right arrow "<code>></code>"
+<li>Class variables may be indicated by an upper case letter
+</ul>
+
+<p>For historical reasons, the global constant symbols <code>T</code> and
+<code>NIL</code> do not obey these rules, and are written in upper case.
+
+<p>For example, a local variable could easily overshadow a function definition:
+
+<pre><code>
+: (de max-speed (car)
+   (.. (get car 'speeds) ..) )
+-> max-speed
+</code></pre>
+
+<p>Inside the body of <code>max-speed</code> (and all other functions called
+during that execution) the kernel function <code>car</code> is redefined to some
+other value, and will surely crash if something like <code>(car Lst)</code> is
+executed. Instead, it is safe to write:
+
+<pre><code>
+: (de max-speed (Car)            # 'Car' with upper case first letter
+   (.. (get Car 'speeds) ..) )
+-> max-speed
+</code></pre>
+
+<p>Note that there are also some strict naming rules (as opposed to the
+voluntary conventions) that are required by the corresponding kernel
+functionalities, like:
+
+<p><ul>
+<li>Transient symbols are enclosed in double quotes (see <a
+href="#transient-io">Transient Symbols</a>) <li>External symbols are enclosed in
+braces (see <a href="#external-io">External Symbols</a>) <li>Pattern-Wildcards
+start with an at-mark "<code>@</code>" (see <a href="refM.html#match">match</a>
+and <a href="refF.html#fill">fill</a>) <li>Symbols referring to a shared library
+contain a colon "<code>lib:sym</code>" </ul>
+
+<p>With that, the last of the above conventions (local functions start with an
+underscore) is not really necessary, because true local scope can be enforced
+with transient symbols.
+
+
+<p><hr>
+<h3><a name="trad">Breaking Traditions</a></h3>
+
+<p>PicoLisp does not try very hard to be compatible with traditional Lisp
+systems. If you are used to some other Lisp dialects, you may notice the
+following differences:
+
+<p><dl>
+
+<dt>Case Sensitivity
+<dd>PicoLisp distinguishes between upper case and lower case characters in
+symbol names. Thus, <code>CAR</code> and <code>car</code> are different symbols,
+which was not the case in traditional Lisp systems.
+
+<dt><code>QUOTE</code>
+<dd>In traditional Lisp, the <code>QUOTE</code> function returns its
+<i>first</i> unevaluated argument. In PicoLisp, on the other hand,
+<code>quote</code> returns <i>all</i> (unevaluated) argument(s).
+
+<dt><code>LAMBDA</code>
+<dd>The <code>LAMBDA</code> function, in some way at the heart of traditional
+Lisp, is completely missing (and <code>quote</code> is used instead).
+
+<dt><code>PROG</code>
+<dd>The <code>PROG</code> function of traditional Lisp, with its GOTO and ENTER
+functionality, is also missing. PicoLisp's <code>prog</code> function is just a
+simple sequencer (as <code>PROGN</code> in some Lisps).
+
+<dt>Function/Value
+<dd>In PicoLisp, a symbol cannot have a value <i>and</i> a function definition
+at the same time. Though this is a disadvantage at first sight, it allows a
+completely uniform handling of functional data.
+
+</dl>
+
+
+<p><hr>
+<h3><a name="bugs">Bugs</a></h3>
+
+<p>The names of the symbols <code>T</code> and <code>NIL</code> violate the <a
+href="#conv">naming conventions</a>. They are global symbols, and should
+therefore start with an asterisk "<code>*</code>". It is too easy to bind them
+to some other value by mistake:
+
+<pre><code>
+(de foo (R S T)
+   ...
+</code></pre>
+
+<p>However, <code><a href="refL.html#lint">lint</a></code> will issue a warning
+in such a case.
+
+
+<p><hr>
+<h2><a name="fun">Function Reference</a></h2>
+
+<p>This section provides a reference manual for the kernel functions, and some
+extensions. See the thematically grouped list of indexes below.
+
+<p>Though PicoLisp is a dynamically typed language (resolved at runtime, as
+opposed to statically (compile-time) typed languages), many functions can only
+accept and/or return a certain set of data types. For each function, the
+expected argument types and return values are described with the following
+abbreviations:
+
+<p>The primary data types:
+
+<p><ul>
+<li><code>num</code> - Number
+<li><code>sym</code> - Symbol
+<li><code>lst</code> - List
+</ul>
+
+<p>Other (derived) data types
+
+<p><ul>
+<li><code>any</code> - Anything: Any primary data type
+<li><code>flg</code> - Flag: Boolean value (<code>NIL</code> or non-<code>NIL</code>)
+<li><code>cnt</code> - A count or a small number
+<li><code>dat</code> - Date: Days since first of March, in the year 0 A.D.
+<li><code>tim</code> - Time: Seconds since midnight
+<li><code>obj</code> - Object/Class: A symbol with methods and/or classes
+<li><code>var</code> - Variable: Either a symbol or a cell
+<li><code>exe</code> - Executable: A list as executable expression (<code>eval</code>)
+<li><code>prg</code> - Prog-Body: A list of executable expressions (<code>run</code>)
+<li><code>fun</code> - Function: Either a number (code-pointer), a symbol (message) or a list (lambda)
+<li><code>msg</code> - Message: A symbol sent to an object (to invoke a method)
+<li><code>cls</code> - Class: A symbol defined as an object's class
+<li><code>typ</code> - Type: A list of <code>cls</code> symbols
+<li><code>pat</code> - Pattern: A symbol whose name starts with an at-mark "<code>@</code>"
+<li><code>pid</code> - Process ID: A number, the ID of a Unix process
+<li><code>tree</code> - Database index tree specification
+<li><code>hook</code> - Database hook object
+</ul>
+
+<p>
+<a href="refA.html">A</a>
+<a href="refB.html">B</a>
+<a href="refC.html">C</a>
+<a href="refD.html">D</a>
+<a href="refE.html">E</a>
+<a href="refF.html">F</a>
+<a href="refG.html">G</a>
+<a href="refH.html">H</a>
+<a href="refI.html">I</a>
+<a href="refJ.html">J</a>
+<a href="refK.html">K</a>
+<a href="refL.html">L</a>
+<a href="refM.html">M</a>
+<a href="refN.html">N</a>
+<a href="refO.html">O</a>
+<a href="refP.html">P</a>
+<a href="refQ.html">Q</a>
+<a href="refR.html">R</a>
+<a href="refS.html">S</a>
+<a href="refT.html">T</a>
+<a href="refU.html">U</a>
+<a href="refV.html">V</a>
+<a href="refW.html">W</a>
+<a href="refX.html">X</a>
+<a href="refY.html">Y</a>
+<a href="refZ.html">Z</a>
+<a href="ref_.html">Other</a>
+
+<p><dl>
+
+<dt>Symbol Functions
+<dd><code>
+   <a href="refN.html#new">new</a>
+   <a href="refS.html#sym">sym</a>
+   <a href="refS.html#str">str</a>
+   <a href="refC.html#char">char</a>
+   <a href="refN.html#name">name</a>
+   <a href="refS.html#sp?">sp?</a>
+   <a href="refP.html#pat?">pat?</a>
+   <a href="refF.html#fun?">fun?</a>
+   <a href="refA.html#all">all</a>
+   <a href="refI.html#intern">intern</a>
+   <a href="refE.html#extern">extern</a>
+   <a href="ref_.html#====">====</a>
+   <a href="refQ.html#qsym">qsym</a>
+   <a href="refL.html#loc">loc</a>
+   <a href="refB.html#box?">box?</a>
+   <a href="refS.html#str?">str?</a>
+   <a href="refE.html#ext?">ext?</a>
+   <a href="refT.html#touch">touch</a>
+   <a href="refZ.html#zap">zap</a>
+   <a href="refL.html#length">length</a>
+   <a href="refS.html#size">size</a>
+   <a href="refF.html#format">format</a>
+   <a href="refC.html#chop">chop</a>
+   <a href="refP.html#pack">pack</a>
+   <a href="refG.html#glue">glue</a>
+   <a href="refP.html#pad">pad</a>
+   <a href="refA.html#align">align</a>
+   <a href="refC.html#center">center</a>
+   <a href="refT.html#text">text</a>
+   <a href="refW.html#wrap">wrap</a>
+   <a href="refP.html#pre?">pre?</a>
+   <a href="refS.html#sub?">sub?</a>
+   <a href="refL.html#low?">low?</a>
+   <a href="refU.html#upp?">upp?</a>
+   <a href="refL.html#lowc">lowc</a>
+   <a href="refU.html#uppc">uppc</a>
+   <a href="refF.html#fold">fold</a>
+   <a href="refV.html#val">val</a>
+   <a href="refG.html#getd">getd</a>
+   <a href="refS.html#set">set</a>
+   <a href="refS.html#setq">setq</a>
+   <a href="refD.html#def">def</a>
+   <a href="refD.html#de">de</a>
+   <a href="refD.html#dm">dm</a>
+   <a href="refR.html#recur">recur</a>
+   <a href="refU.html#undef">undef</a>
+   <a href="refR.html#redef">redef</a>
+   <a href="refD.html#daemon">daemon</a>
+   <a href="refP.html#patch">patch</a>
+   <a href="refX.html#xchg">xchg</a>
+   <a href="refO.html#on">on</a>
+   <a href="refO.html#off">off</a>
+   <a href="refO.html#onOff">onOff</a>
+   <a href="refZ.html#zero">zero</a>
+   <a href="refO.html#one">one</a>
+   <a href="refD.html#default">default</a>
+   <a href="refE.html#expr">expr</a>
+   <a href="refS.html#subr">subr</a>
+   <a href="refL.html#let">let</a>
+   <a href="refL.html#let?">let?</a>
+   <a href="refU.html#use">use</a>
+   <a href="refA.html#accu">accu</a>
+   <a href="refP.html#push">push</a>
+   <a href="refP.html#push1">push1</a>
+   <a href="refP.html#pop">pop</a>
+   <a href="refC.html#cut">cut</a>
+   <a href="refD.html#del">del</a>
+   <a href="refQ.html#queue">queue</a>
+   <a href="refF.html#fifo">fifo</a>
+   <a href="refI.html#idx">idx</a>
+   <a href="refL.html#lup">lup</a>
+   <a href="refC.html#cache">cache</a>
+   <a href="refL.html#locale">locale</a>
+   <a href="refD.html#dirname">dirname</a>
+</code>
+
+<dt>Property Access
+<dd><code>
+   <a href="refP.html#put">put</a>
+   <a href="refG.html#get">get</a>
+   <a href="refP.html#prop">prop</a>
+   <a href="ref_.html#;">;</a>
+   <a href="ref_.html#=:">=:</a>
+   <a href="ref_.html#:">:</a>
+   <a href="ref_.html#::">::</a>
+   <a href="refP.html#putl">putl</a>
+   <a href="refG.html#getl">getl</a>
+   <a href="refW.html#wipe">wipe</a>
+   <a href="refM.html#meta">meta</a>
+</code>
+
+<dt>Predicates
+<dd><code>
+   <a href="refA.html#atom">atom</a>
+   <a href="refP.html#pair">pair</a>
+   <a href="refL.html#lst?">lst?</a>
+   <a href="refN.html#num?">num?</a>
+   <a href="refS.html#sym?">sym?</a>
+   <a href="refF.html#flg?">flg?</a>
+   <a href="refS.html#sp?">sp?</a>
+   <a href="refP.html#pat?">pat?</a>
+   <a href="refF.html#fun?">fun?</a>
+   <a href="refB.html#box?">box?</a>
+   <a href="refS.html#str?">str?</a>
+   <a href="refE.html#ext?">ext?</a>
+   <a href="refB.html#bool">bool</a>
+   <a href="refN.html#not">not</a>
+   <a href="ref_.html#==">==</a>
+   <a href="refN.html#n==">n==</a>
+   <a href="ref_.html#=">=</a>
+   <a href="ref_.html#<>"><&gt</a>
+   <a href="ref_.html#=0">=0</a>
+   <a href="ref_.html#=T">=T</a>
+   <a href="refN.html#n0">n0</a>
+   <a href="refN.html#nT">nT</a>
+   <a href="ref_.html#<">&lt;</a>
+   <a href="ref_.html#<=">&lt;=</a>
+   <a href="ref_.html#>">&gt;</a>
+   <a href="ref_.html#>=">&gt;=</a>
+   <a href="refM.html#match">match</a>
+</code>
+
+<dt>Arithmetics
+<dd><code>
+   <a href="ref_.html#+">+</a>
+   <a href="ref_.html#-">-</a>
+   <a href="ref_.html#*">*</a>
+   <a href="ref_.html#/">/</a>
+   <a href="ref_.html#%">%</a>
+   <a href="ref_.html#*/">*/</a>
+   <a href="ref_.html#**">**</a>
+   <a href="refI.html#inc">inc</a>
+   <a href="refD.html#dec">dec</a>
+   <a href="ref_.html#>>">>></a>
+   <a href="refL.html#lt0">lt0</a>
+   <a href="refG.html#ge0">ge0</a>
+   <a href="refG.html#gt0">gt0</a>
+   <a href="refA.html#abs">abs</a>
+   <a href="refB.html#bit?">bit?</a>
+   <a href="ref_.html#&">&</a>
+   <a href="ref_.html#|">|</a>
+   <a href="refX.html#x|">x|</a>
+   <a href="refS.html#sqrt">sqrt</a>
+   <a href="refS.html#seed">seed</a>
+   <a href="refR.html#rand">rand</a>
+   <a href="refM.html#max">max</a>
+   <a href="refM.html#min">min</a>
+   <a href="refL.html#length">length</a>
+   <a href="refS.html#size">size</a>
+   <a href="refA.html#accu">accu</a>
+   <a href="refF.html#format">format</a>
+   <a href="refP.html#pad">pad</a>
+   <a href="refO.html#oct">oct</a>
+   <a href="refH.html#hex">hex</a>
+   <a href="refF.html#fmt64">fmt64</a>
+   <a href="refM.html#money">money</a>
+</code>
+
+<dt>List Processing
+<dd><code>
+   <a href="refC.html#car">car</a>
+   <a href="refC.html#cdr">cdr</a>
+   <a href="refC.html#caar">caar</a>
+   <a href="refC.html#cadr">cadr</a>
+   <a href="refC.html#cdar">cdar</a>
+   <a href="refC.html#cddr">cddr</a>
+   <a href="refC.html#caaar">caaar</a>
+   <a href="refC.html#caadr">caadr</a>
+   <a href="refC.html#cadar">cadar</a>
+   <a href="refC.html#caddr">caddr</a>
+   <a href="refC.html#cdaar">cdaar</a>
+   <a href="refC.html#cdadr">cdadr</a>
+   <a href="refC.html#cddar">cddar</a>
+   <a href="refC.html#cdddr">cdddr</a>
+   <a href="refC.html#cadddr">cadddr</a>
+   <a href="refC.html#cddddr">cddddr</a>
+   <a href="refN.html#nth">nth</a>
+   <a href="refC.html#con">con</a>
+   <a href="refC.html#cons">cons</a>
+   <a href="refC.html#conc">conc</a>
+   <a href="refC.html#circ">circ</a>
+   <a href="refR.html#rot">rot</a>
+   <a href="refL.html#list">list</a>
+   <a href="refN.html#need">need</a>
+   <a href="refR.html#range">range</a>
+   <a href="refF.html#full">full</a>
+   <a href="refM.html#make">make</a>
+   <a href="refM.html#made">made</a>
+   <a href="refC.html#chain">chain</a>
+   <a href="refL.html#link">link</a>
+   <a href="refY.html#yoke">yoke</a>
+   <a href="refC.html#copy">copy</a>
+   <a href="refM.html#mix">mix</a>
+   <a href="refA.html#append">append</a>
+   <a href="refD.html#delete">delete</a>
+   <a href="refD.html#delq">delq</a>
+   <a href="refR.html#replace">replace</a>
+   <a href="refI.html#insert">insert</a>
+   <a href="refR.html#remove">remove</a>
+   <a href="refP.html#place">place</a>
+   <a href="refS.html#strip">strip</a>
+   <a href="refS.html#split">split</a>
+   <a href="refR.html#reverse">reverse</a>
+   <a href="refF.html#flip">flip</a>
+   <a href="refT.html#trim">trim</a>
+   <a href="refC.html#clip">clip</a>
+   <a href="refH.html#head">head</a>
+   <a href="refT.html#tail">tail</a>
+   <a href="refS.html#stem">stem</a>
+   <a href="refF.html#fin">fin</a>
+   <a href="refL.html#last">last</a>
+   <a href="refM.html#member">member</a>
+   <a href="refM.html#memq">memq</a>
+   <a href="refM.html#mmeq">mmeq</a>
+   <a href="refS.html#sect">sect</a>
+   <a href="refD.html#diff">diff</a>
+   <a href="refI.html#index">index</a>
+   <a href="refO.html#offset">offset</a>
+   <a href="refA.html#assoc">assoc</a>
+   <a href="refA.html#asoq">asoq</a>
+   <a href="refR.html#rank">rank</a>
+   <a href="refS.html#sort">sort</a>
+   <a href="refU.html#uniq">uniq</a>
+   <a href="refG.html#group">group</a>
+   <a href="refL.html#length">length</a>
+   <a href="refS.html#size">size</a>
+   <a href="refV.html#val">val</a>
+   <a href="refS.html#set">set</a>
+   <a href="refX.html#xchg">xchg</a>
+   <a href="refP.html#push">push</a>
+   <a href="refP.html#push1">push1</a>
+   <a href="refP.html#pop">pop</a>
+   <a href="refC.html#cut">cut</a>
+   <a href="refQ.html#queue">queue</a>
+   <a href="refF.html#fifo">fifo</a>
+   <a href="refI.html#idx">idx</a>
+   <a href="refB.html#balance">balance</a>
+   <a href="refG.html#get">get</a>
+   <a href="refF.html#fill">fill</a>
+   <a href="refA.html#apply">apply</a>
+</code>
+
+<dt>Control Flow
+<dd><code>
+   <a href="refL.html#load">load</a>
+   <a href="refA.html#args">args</a>
+   <a href="refN.html#next">next</a>
+   <a href="refA.html#arg">arg</a>
+   <a href="refR.html#rest">rest</a>
+   <a href="refP.html#pass">pass</a>
+   <a href="refQ.html#quote">quote</a>
+   <a href="refA.html#as">as</a>
+   <a href="refP.html#pid">pid</a>
+   <a href="refL.html#lit">lit</a>
+   <a href="refE.html#eval">eval</a>
+   <a href="refR.html#run">run</a>
+   <a href="refM.html#macro">macro</a>
+   <a href="refC.html#curry">curry</a>
+   <a href="refD.html#def">def</a>
+   <a href="refD.html#de">de</a>
+   <a href="refD.html#dm">dm</a>
+   <a href="refR.html#recur">recur</a>
+   <a href="refR.html#recurse">recurse</a>
+   <a href="refU.html#undef">undef</a>
+   <a href="refB.html#box">box</a>
+   <a href="refN.html#new">new</a>
+   <a href="refT.html#type">type</a>
+   <a href="refI.html#isa">isa</a>
+   <a href="refM.html#method">method</a>
+   <a href="refM.html#meth">meth</a>
+   <a href="refS.html#send">send</a>
+   <a href="refT.html#try">try</a>
+   <a href="refS.html#super">super</a>
+   <a href="refE.html#extra">extra</a>
+   <a href="refW.html#with">with</a>
+   <a href="refB.html#bind">bind</a>
+   <a href="refJ.html#job">job</a>
+   <a href="refL.html#let">let</a>
+   <a href="refL.html#let?">let?</a>
+   <a href="refU.html#use">use</a>
+   <a href="refA.html#and">and</a>
+   <a href="refO.html#or">or</a>
+   <a href="refN.html#nand">nand</a>
+   <a href="refN.html#nor">nor</a>
+   <a href="refX.html#xor">xor</a>
+   <a href="refB.html#bool">bool</a>
+   <a href="refN.html#not">not</a>
+   <a href="refN.html#nil">nil</a>
+   <a href="refT.html#t">t</a>
+   <a href="refP.html#prog">prog</a>
+   <a href="refP.html#prog1">prog1</a>
+   <a href="refP.html#prog2">prog2</a>
+   <a href="refI.html#if">if</a>
+   <a href="refI.html#if2">if2</a>
+   <a href="refI.html#ifn">ifn</a>
+   <a href="refW.html#when">when</a>
+   <a href="refU.html#unless">unless</a>
+   <a href="refC.html#cond">cond</a>
+   <a href="refN.html#nond">nond</a>
+   <a href="refC.html#case">case</a>
+   <a href="refS.html#state">state</a>
+   <a href="refW.html#while">while</a>
+   <a href="refU.html#until">until</a>
+   <a href="refL.html#loop">loop</a>
+   <a href="refD.html#do">do</a>
+   <a href="refA.html#at">at</a>
+   <a href="refF.html#for">for</a>
+   <a href="refC.html#catch">catch</a>
+   <a href="refT.html#throw">throw</a>
+   <a href="refF.html#finally">finally</a>
+   <a href="ref_.html#!">!</a>
+   <a href="refE.html#e">e</a>
+   <a href="ref_.html#$">$</a>
+   <a href="refS.html#sys">sys</a>
+   <a href="refC.html#call">call</a>
+   <a href="refT.html#tick">tick</a>
+   <a href="refI.html#ipid">ipid</a>
+   <a href="refO.html#opid">opid</a>
+   <a href="refK.html#kill">kill</a>
+   <a href="refQ.html#quit">quit</a>
+   <a href="refT.html#task">task</a>
+   <a href="refF.html#fork">fork</a>
+   <a href="refP.html#pipe">pipe</a>
+   <a href="refL.html#later">later</a>
+   <a href="refT.html#timeout">timeout</a>
+   <a href="refA.html#abort">abort</a>
+   <a href="refB.html#bye">bye</a>
+</code>
+
+<dt>Mapping
+<dd><code>
+   <a href="refA.html#apply">apply</a>
+   <a href="refP.html#pass">pass</a>
+   <a href="refM.html#maps">maps</a>
+   <a href="refM.html#map">map</a>
+   <a href="refM.html#mapc">mapc</a>
+   <a href="refM.html#maplist">maplist</a>
+   <a href="refM.html#mapcar">mapcar</a>
+   <a href="refM.html#mapcon">mapcon</a>
+   <a href="refM.html#mapcan">mapcan</a>
+   <a href="refF.html#filter">filter</a>
+   <a href="refE.html#extract">extract</a>
+   <a href="refS.html#seek">seek</a>
+   <a href="refF.html#find">find</a>
+   <a href="refP.html#pick">pick</a>
+   <a href="refC.html#cnt">cnt</a>
+   <a href="refS.html#sum">sum</a>
+   <a href="refM.html#maxi">maxi</a>
+   <a href="refM.html#mini">mini</a>
+   <a href="refF.html#fish">fish</a>
+   <a href="refB.html#by">by</a>
+</code>
+
+<dt>Input/Output
+<dd><code>
+   <a href="refP.html#path">path</a>
+   <a href="refI.html#in">in</a>
+   <a href="refI.html#ipid">ipid</a>
+   <a href="refO.html#out">out</a>
+   <a href="refO.html#opid">opid</a>
+   <a href="refP.html#pipe">pipe</a>
+   <a href="refC.html#ctl">ctl</a>
+   <a href="refA.html#any">any</a>
+   <a href="refS.html#sym">sym</a>
+   <a href="refS.html#str">str</a>
+   <a href="refL.html#load">load</a>
+   <a href="refH.html#hear">hear</a>
+   <a href="refT.html#tell">tell</a>
+   <a href="refK.html#key">key</a>
+   <a href="refP.html#poll">poll</a>
+   <a href="refP.html#peek">peek</a>
+   <a href="refC.html#char">char</a>
+   <a href="refS.html#skip">skip</a>
+   <a href="refE.html#eol">eol</a>
+   <a href="refE.html#eof">eof</a>
+   <a href="refF.html#from">from</a>
+   <a href="refT.html#till">till</a>
+   <a href="refL.html#line">line</a>
+   <a href="refF.html#format">format</a>
+   <a href="refS.html#scl">scl</a>
+   <a href="refR.html#read">read</a>
+   <a href="refP.html#print">print</a>
+   <a href="refP.html#println">println</a>
+   <a href="refP.html#printsp">printsp</a>
+   <a href="refP.html#prin">prin</a>
+   <a href="refP.html#prinl">prinl</a>
+   <a href="refM.html#msg">msg</a>
+   <a href="refS.html#space">space</a>
+   <a href="refB.html#beep">beep</a>
+   <a href="refT.html#tab">tab</a>
+   <a href="refF.html#flush">flush</a>
+   <a href="refR.html#rewind">rewind</a>
+   <a href="refR.html#rd">rd</a>
+   <a href="refP.html#pr">pr</a>
+   <a href="refW.html#wr">wr</a>
+   <a href="refR.html#rpc">rpc</a>
+   <a href="refW.html#wait">wait</a>
+   <a href="refS.html#sync">sync</a>
+   <a href="refE.html#echo">echo</a>
+   <a href="refI.html#info">info</a>
+   <a href="refF.html#file">file</a>
+   <a href="refD.html#dir">dir</a>
+   <a href="refL.html#lines">lines</a>
+   <a href="refO.html#open">open</a>
+   <a href="refC.html#close">close</a>
+   <a href="refP.html#port">port</a>
+   <a href="refL.html#listen">listen</a>
+   <a href="refA.html#accept">accept</a>
+   <a href="refH.html#host">host</a>
+   <a href="refC.html#connect">connect</a>
+   <a href="refU.html#udp">udp</a>
+   <a href="refS.html#script">script</a>
+   <a href="refO.html#once">once</a>
+   <a href="refR.html#rc">rc</a>
+   <a href="refA.html#acquire">acquire</a>
+   <a href="refR.html#release">release</a>
+   <a href="refP.html#pretty">pretty</a>
+   <a href="refP.html#pp">pp</a>
+   <a href="refS.html#show">show</a>
+   <a href="refV.html#view">view</a>
+   <a href="refH.html#here">here</a>
+   <a href="refP.html#prEval">prEval</a>
+   <a href="refM.html#mail">mail</a>
+</code>
+
+<dt>Object Orientation
+<dd><code>
+   <a href="refC.html#*Class">*Class</a>
+   <a href="refC.html#class">class</a>
+   <a href="refD.html#dm">dm</a>
+   <a href="refR.html#rel">rel</a>
+   <a href="refV.html#var">var</a>
+   <a href="refV.html#var:">var:</a>
+   <a href="refN.html#new">new</a>
+   <a href="refT.html#type">type</a>
+   <a href="refI.html#isa">isa</a>
+   <a href="refM.html#method">method</a>
+   <a href="refM.html#meth">meth</a>
+   <a href="refS.html#send">send</a>
+   <a href="refT.html#try">try</a>
+   <a href="refO.html#object">object</a>
+   <a href="refE.html#extend">extend</a>
+   <a href="refS.html#super">super</a>
+   <a href="refE.html#extra">extra</a>
+   <a href="refW.html#with">with</a>
+   <a href="refT.html#This">This</a>
+   <a href="refC.html#can">can</a>
+   <a href="refD.html#dep">dep</a>
+</code>
+
+<dt>Database
+<dd><code>
+   <a href="refP.html#pool">pool</a>
+   <a href="refJ.html#journal">journal</a>
+   <a href="refI.html#id">id</a>
+   <a href="refS.html#seq">seq</a>
+   <a href="refL.html#lieu">lieu</a>
+   <a href="refL.html#lock">lock</a>
+   <a href="refC.html#commit">commit</a>
+   <a href="refR.html#rollback">rollback</a>
+   <a href="refM.html#mark">mark</a>
+   <a href="refF.html#free">free</a>
+   <a href="refD.html#dbck">dbck</a>
+   <a href="refD.html#dbs">dbs</a>
+   <a href="refD.html#dbs+">dbs+</a>
+   <a href="refD.html#db:">db:</a>
+   <a href="refT.html#tree">tree</a>
+   <a href="refD.html#db">db</a>
+   <a href="refA.html#aux">aux</a>
+   <a href="refC.html#collect">collect</a>
+   <a href="refG.html#genKey">genKey</a>
+   <a href="refU.html#useKey">useKey</a>
+   <a href="refR.html#+relation">+relation</a>
+   <a href="refA.html#+Any">+Any</a>
+   <a href="refB.html#+Bag">+Bag</a>
+   <a href="refB.html#+Bool">+Bool</a>
+   <a href="refN.html#+Number">+Number</a>
+   <a href="refD.html#+Date">+Date</a>
+   <a href="refT.html#+Time">+Time</a>
+   <a href="refS.html#+Symbol">+Symbol</a>
+   <a href="refS.html#+String">+String</a>
+   <a href="refL.html#+Link">+Link</a>
+   <a href="refJ.html#+Joint">+Joint</a>
+   <a href="refB.html#+Blob">+Blob</a>
+   <a href="refH.html#+Hook">+Hook</a>
+   <a href="refI.html#+index">+index</a>
+   <a href="refK.html#+Key">+Key</a>
+   <a href="refR.html#+Ref">+Ref</a>
+   <a href="refR.html#+Ref2">+Ref2</a>
+   <a href="refI.html#+Idx">+Idx</a>
+   <a href="refS.html#+Sn">+Sn</a>
+   <a href="refF.html#+Fold">+Fold</a>
+   <a href="refA.html#+Aux">+Aux</a>
+   <a href="refD.html#+Dep">+Dep</a>
+   <a href="refL.html#+List">+List</a>
+   <a href="refN.html#+Need">+Need</a>
+   <a href="refM.html#+Mis">+Mis</a>
+   <a href="refA.html#+Alt">+Alt</a>
+   <a href="refB.html#blob">blob</a>
+   <a href="refD.html#dbSync">dbSync</a>
+   <a href="refN.html#new!">new!</a>
+   <a href="refS.html#set!">set!</a>
+   <a href="refP.html#put!">put!</a>
+   <a href="refI.html#inc!">inc!</a>
+   <a href="refB.html#blob!">blob!</a>
+   <a href="refU.html#upd">upd</a>
+   <a href="refR.html#rel">rel</a>
+   <a href="refR.html#request">request</a>
+   <a href="refO.html#obj">obj</a>
+   <a href="refF.html#fmt64">fmt64</a>
+   <a href="refR.html#root">root</a>
+   <a href="refF.html#fetch">fetch</a>
+   <a href="refS.html#store">store</a>
+   <a href="refC.html#count">count</a>
+   <a href="refL.html#leaf">leaf</a>
+   <a href="refM.html#minKey">minKey</a>
+   <a href="refM.html#maxKey">maxKey</a>
+   <a href="refI.html#init">init</a>
+   <a href="refS.html#step">step</a>
+   <a href="refS.html#scan">scan</a>
+   <a href="refI.html#iter">iter</a>
+   <a href="refP.html#prune">prune</a>
+   <a href="refZ.html#zapTree">zapTree</a>
+   <a href="refC.html#chkTree">chkTree</a>
+   <a href="refD.html#db/3">db/3</a>
+   <a href="refD.html#db/4">db/4</a>
+   <a href="refD.html#db/5">db/5</a>
+   <a href="refV.html#val/3">val/3</a>
+   <a href="refL.html#lst/3">lst/3</a>
+   <a href="refM.html#map/3">map/3</a>
+   <a href="refI.html#isa/2">isa/2</a>
+   <a href="refS.html#same/3">same/3</a>
+   <a href="refB.html#bool/3">bool/3</a>
+   <a href="refR.html#range/3">range/3</a>
+   <a href="refH.html#head/3">head/3</a>
+   <a href="refF.html#fold/3">fold/3</a>
+   <a href="refP.html#part/3">part/3</a>
+   <a href="refT.html#tolr/3">tolr/3</a>
+   <a href="refS.html#select/3">select/3</a>
+   <a href="refR.html#remote/2">remote/2</a>
+</code>
+
+<dt>Pilog
+<dd><code>
+   <a href="refP.html#prove">prove</a>
+   <a href="ref_.html#->">-&gt</a>
+   <a href="refU.html#unify">unify</a>
+   <a href="refB.html#be">be</a>
+   <a href="refR.html#repeat">repeat</a>
+   <a href="refA.html#asserta">asserta</a>
+   <a href="refA.html#assertz">assertz</a>
+   <a href="refR.html#retract">retract</a>
+   <a href="refR.html#rules">rules</a>
+   <a href="refG.html#goal">goal</a>
+   <a href="refF.html#fail">fail</a>
+   <a href="refP.html#pilog">pilog</a>
+   <a href="refS.html#solve">solve</a>
+   <a href="refQ.html#query">query</a>
+   <a href="ref_.html#?">?</a>
+   <a href="refR.html#repeat/0">repeat/0</a>
+   <a href="refF.html#fail/0">fail/0</a>
+   <a href="refT.html#true/0">true/0</a>
+   <a href="refN.html#not/1">not/1</a>
+   <a href="refC.html#call/1">call/1</a>
+   <a href="refO.html#or/2">or/2</a>
+   <a href="refN.html#nil/1">nil/1</a>
+   <a href="refE.html#equal/2">equal/2</a>
+   <a href="refD.html#different/2">different/2</a>
+   <a href="refA.html#append/3">append/3</a>
+   <a href="refM.html#member/2">member/2</a>
+   <a href="refD.html#delete/3">delete/3</a>
+   <a href="refP.html#permute/2">permute/2</a>
+   <a href="refU.html#uniq/2">uniq/2</a>
+   <a href="refA.html#asserta/1">asserta/1</a>
+   <a href="refA.html#assertz/1">assertz/1</a>
+   <a href="refR.html#retract/1">retract/1</a>
+   <a href="refC.html#clause/2">clause/2</a>
+   <a href="refS.html#show/1">show/1</a>
+   <a href="refD.html#db/3">db/3</a>
+   <a href="refD.html#db/4">db/4</a>
+   <a href="refD.html#db/5">db/5</a>
+   <a href="refV.html#val/3">val/3</a>
+   <a href="refL.html#lst/3">lst/3</a>
+   <a href="refM.html#map/3">map/3</a>
+   <a href="refI.html#isa/2">isa/2</a>
+   <a href="refS.html#same/3">same/3</a>
+   <a href="refB.html#bool/3">bool/3</a>
+   <a href="refR.html#range/3">range/3</a>
+   <a href="refH.html#head/3">head/3</a>
+   <a href="refF.html#fold/3">fold/3</a>
+   <a href="refP.html#part/3">part/3</a>
+   <a href="refT.html#tolr/3">tolr/3</a>
+   <a href="refS.html#select/3">select/3</a>
+   <a href="refR.html#remote/2">remote/2</a>
+</code>
+
+<dt>Debugging
+<dd><code>
+   <a href="refP.html#pretty">pretty</a>
+   <a href="refP.html#pp">pp</a>
+   <a href="refS.html#show">show</a>
+   <a href="refL.html#loc">loc</a>
+   <a href="refD.html#*Dbg">*Dbg</a>
+   <a href="refD.html#doc">doc</a>
+   <a href="refM.html#more">more</a>
+   <a href="refD.html#depth">depth</a>
+   <a href="refW.html#what">what</a>
+   <a href="refW.html#who">who</a>
+   <a href="refC.html#can">can</a>
+   <a href="refD.html#dep">dep</a>
+   <a href="refD.html#debug">debug</a>
+   <a href="refD.html#d">d</a>
+   <a href="refU.html#unbug">unbug</a>
+   <a href="refU.html#u">u</a>
+   <a href="refV.html#vi">vi</a>
+   <a href="refL.html#ld">ld</a>
+   <a href="refT.html#trace">trace</a>
+   <a href="refU.html#untrace">untrace</a>
+   <a href="refT.html#traceAll">traceAll</a>
+   <a href="refP.html#proc">proc</a>
+   <a href="refH.html#hd">hd</a>
+   <a href="refB.html#bench">bench</a>
+   <a href="refE.html#edit">edit</a>
+   <a href="refL.html#lint">lint</a>
+   <a href="refL.html#lintAll">lintAll</a>
+   <a href="refS.html#select">select</a>
+   <a href="refU.html#update">update</a>
+</code>
+
+<dt>System Functions
+<dd><code>
+   <a href="refC.html#cmd">cmd</a>
+   <a href="refA.html#argv">argv</a>
+   <a href="refO.html#opt">opt</a>
+   <a href="refV.html#version">version</a>
+   <a href="refG.html#gc">gc</a>
+   <a href="refR.html#raw">raw</a>
+   <a href="refA.html#alarm">alarm</a>
+   <a href="refP.html#protect">protect</a>
+   <a href="refH.html#heap">heap</a>
+   <a href="refE.html#env">env</a>
+   <a href="refU.html#up">up</a>
+   <a href="refD.html#date">date</a>
+   <a href="refT.html#time">time</a>
+   <a href="refU.html#usec">usec</a>
+   <a href="refS.html#stamp">stamp</a>
+   <a href="refD.html#dat$">dat$</a>
+   <a href="ref_.html#$dat">$dat</a>
+   <a href="refD.html#datSym">datSym</a>
+   <a href="refD.html#datStr">datStr</a>
+   <a href="refS.html#strDat">strDat</a>
+   <a href="refE.html#expDat">expDat</a>
+   <a href="refD.html#day">day</a>
+   <a href="refW.html#week">week</a>
+   <a href="refU.html#ultimo">ultimo</a>
+   <a href="refT.html#tim$">tim$</a>
+   <a href="ref_.html#$tim">$tim</a>
+   <a href="refT.html#telStr">telStr</a>
+   <a href="refE.html#expTel">expTel</a>
+   <a href="refL.html#locale">locale</a>
+   <a href="refA.html#allowed">allowed</a>
+   <a href="refA.html#allow">allow</a>
+   <a href="refP.html#pwd">pwd</a>
+   <a href="refC.html#cd">cd</a>
+   <a href="refC.html#chdir">chdir</a>
+   <a href="refC.html#ctty">ctty</a>
+   <a href="refI.html#info">info</a>
+   <a href="refD.html#dir">dir</a>
+   <a href="refD.html#dirname">dirname</a>
+   <a href="refE.html#errno">errno</a>
+   <a href="refN.html#native">native</a>
+   <a href="refC.html#call">call</a>
+   <a href="refT.html#tick">tick</a>
+   <a href="refK.html#kill">kill</a>
+   <a href="refQ.html#quit">quit</a>
+   <a href="refT.html#task">task</a>
+   <a href="refF.html#fork">fork</a>
+   <a href="refF.html#forked">forked</a>
+   <a href="refP.html#pipe">pipe</a>
+   <a href="refT.html#timeout">timeout</a>
+   <a href="refM.html#mail">mail</a>
+   <a href="refT.html#test">test</a>
+   <a href="refB.html#bye">bye</a>
+</code>
+
+<dt>Globals
+<dd><code>
+   <a href="#nilSym">NIL</a>
+   <a href="refO.html#*OS">*OS</a>
+   <a href="refD.html#*DB">*DB</a>
+   <a href="refT.html#T">T</a>
+   <a href="refS.html#*Solo">*Solo</a>
+   <a href="refP.html#*PPid">*PPid</a>
+   <a href="refP.html#*Pid">*Pid</a>
+   <a href="ref_.html#@">@</a>
+   <a href="ref_.html#@@">@@</a>
+   <a href="ref_.html#@@@">@@@</a>
+   <a href="refT.html#This">This</a>
+   <a href="refD.html#*Dbg">*Dbg</a>
+   <a href="refZ.html#*Zap">*Zap</a>
+   <a href="refS.html#*Scl">*Scl</a>
+   <a href="refC.html#*Class">*Class</a>
+   <a href="refD.html#*Dbs">*Dbs</a>
+   <a href="refR.html#*Run">*Run</a>
+   <a href="refR.html#*Hup">*Hup</a>
+   <a href="refS.html#*Sig1">*Sig1</a>
+   <a href="refS.html#*Sig2">*Sig2</a>
+   <a href="ref_.html#^">^</a>
+   <a href="refE.html#*Err">*Err</a>
+   <a href="refM.html#*Msg">*Msg</a>
+   <a href="refU.html#*Uni">*Uni</a>
+   <a href="refL.html#*Led">*Led</a>
+   <a href="refT.html#*Tsm">*Tsm</a>
+   <a href="refA.html#*Adr">*Adr</a>
+   <a href="refA.html#*Allow">*Allow</a>
+   <a href="refF.html#*Fork">*Fork</a>
+   <a href="refB.html#*Bye">*Bye</a>
+</code>
+
+</dl>
+
+<p><hr>
+<h2><a name="down">Download</a></h2>
+
+<p>The <code>PicoLisp</code> system can be downloaded from the <a
+href="http://software-lab.de/down.html">PicoLisp Download</a> page.
+
+</body>
+</html>
diff --git a/doc/refA.html b/doc/refA.html
@@ -0,0 +1,567 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN" "http://www.w3.org/TR/1998/REC-html40-19980424/loose.dtd">
+<html lang="en">
+<head>
+<meta http-equiv="Content-Type" content="text/html; charset=utf-8">
+<title>A</title>
+<link rel="stylesheet" href="doc.css" type="text/css">
+</head>
+<body>
+
+<h1>A</h1>
+
+<dl>
+
+<dt><a name="*Adr"><code>*Adr</code></a>
+<dd>A global variable holding the IP address of last recently accepted client.
+See also <code><a href="refL.html#listen">listen</a></code> and <code><a
+href="refA.html#accept">accept</a></code>.
+
+<pre><code>
+: *Adr
+-> "127.0.0.1"
+</code></pre>
+
+<dt><a name="*Allow"><code>*Allow</code></a>
+<dd>A global variable holding allowed access patterns. If its value is
+non-<code>NIL</code>, it should contain a list where the CAR is an <code><a
+href="refI.html#idx">idx</a></code> tree of allowed items, and the CDR a list of
+prefix strings. See also <code><a href="refA.html#allow">allow</a></code>,
+<code><a href="refA.html#allowed">allowed</a></code> and <code><a
+href="refP.html#pre?">pre?</a></code>.
+
+<pre><code>
+: (allowed ("app/" "img/")  # Initialize
+   "@start" "@stop" "favicon.ico" "lib.css" "@psh" )
+-> NIL
+: (allow "@myFoo")  # additional item
+-> "@myFoo"
+: (allow "myDir/" T)  # additional prefix
+-> "myDir/"
+
+: *Allow
+-> (("@stop" ("@psh" ("@myFoo") "@start") "favicon.ico" NIL "lib.css") "app/" "img/" "myDir/")
+
+: (idx *Allow)  # items
+-> ("@myFoo" "@psh" "@start" "@stop" "favicon.ico" "lib.css")
+: (cdr *Allow)  # prefixes
+-> ("app/" "img/" "myDir/")
+</code></pre>
+
+<dt><a name="+Alt"><code>+Alt</code></a>
+<dd>Prefix class specifying an alternative class for a <code><a
+href="refR.html#+relation">+relation</a></code>. This allows indexes or other
+side effects to be maintained in a class different from the current one. See
+also <code><a href="ref.html#dbase">Database</a></code>.
+
+<pre><code>
+(class +EuOrd +Ord)                    # EU-specific order subclass
+(rel nr (+Alt +Key +Number) +XyOrd)    # Maintain the key in the +XyOrd index
+</code></pre>
+
+<dt><a name="+Any"><code>+Any</code></a>
+<dd>Class for unspecified relations, a subclass of <code><a
+href="refR.html#+relation">+relation</a></code>. Objects of that class accept
+and maintain any type of Lisp data. Used often when there is no other suitable
+relation class available. See also <code><a
+href="ref.html#dbase">Database</a></code>.
+
+<p>In the following example <code>+Any</code> is used simply for the reason that
+there is no direct way to specify dotted pairs:
+
+<pre><code>
+(rel loc (+Any))  # Locale, e.g. ("DE" . "de")
+</code></pre>
+
+<dt><a name="+Aux"><code>+Aux</code></a>
+<dd>Prefix class maintaining auxiliary keys for <code><a
+href="refR.html#+relation">+relation</a></code>s, in addition to <code><a
+href="refR.html#+Ref">+Ref</a></code> or <code><a
+href="refI.html#+Idx">+Idx</a></code> indexes. Expects a list of auxiliary
+attributes of the same object, and combines all keys in that order into a single
+index key. See also <code><a href="refA.html#aux">aux</a></code> and <code><a
+href="ref.html#dbase">Database</a></code>.
+
+<pre><code>
+(rel nr (+Ref +Number))                # Normal, non-unique index
+(rel nm (+Aux +Ref +String) (nr txt))  # Combined name/number/text index
+(rel txt (+Aux +Sn +Idx +String) (nr)) # Text/number plus tolerant text index
+</code></pre>
+
+<dt><a name="abort"><code>(abort 'cnt . prg) -> any</code></a>
+<dd>Aborts the execution of <code>prg</code> if it takes longer than
+<code>cnt</code> seconds, and returns <code>NIL</code>. Otherwise, the result of
+<code>prg</code> is returned. <code><a href="refA.html#alarm">alarm</a></code>
+is used internally, so care must be taken not to interfer with other calls to
+<code>alarm</code>.
+
+<pre><code>
+: (abort 20 (in Sock (rd)))  # Wait maximally 20 seconds for socket data
+</code></pre>
+
+<dt><a name="abs"><code>(abs 'num) -> num</code></a>
+<dd>Returns the absolute value of the <code>num</code> argument.
+
+<pre><code>
+: (abs -7)
+-> 7
+: (abs 7)
+-> 7
+</code></pre>
+
+<dt><a name="accept"><code>(accept 'cnt) -> cnt | NIL</code></a>
+<dd>Accepts a connection on descriptor <code>cnt</code> (as received by <code><a
+href="refP.html#port">port</a></code>), and returns the new socket descriptor
+<code>cnt</code>. The global variable <code>*Adr</code> is set to the IP address
+of the client. See also <code><a href="refL.html#listen">listen</a></code>,
+<code><a href="refC.html#connect">connect</a></code> and <code><a
+href="refA.html#*Adr">*Adr</a></code>.
+
+<pre><code>
+: (setq *Socket
+   (accept (port 6789)) )  # Accept connection at port 6789
+-> 4
+</code></pre>
+
+<dt><a name="accu"><code>(accu 'var 'any 'num)</code></a>
+<dd>Accumulates <code>num</code> into a sum, using the key <code>any</code> in
+an association list stored in <code>var</code>. See also <code><a
+href="refA.html#assoc">assoc</a></code>.
+
+<pre><code>
+: (off Sum)
+-> NIL
+: (accu 'Sum 'a 1)
+-> (a . 1)
+: (accu 'Sum 'a 5)
+-> 6
+: (accu 'Sum 22 100)
+-> (22 . 100)
+: Sum
+-> ((22 . 100) (a . 6))
+</code></pre>
+
+<dt><a name="acquire"><code>(acquire 'sym) -> flg</code></a>
+<dd>Tries to acquire the mutex represented by the file <code>sym</code>, by
+obtaining an exclusive lock on that file with <code><a
+href="refC.html#ctl">ctl</a></code>, and then trying to write the PID of the
+current process into that file. It fails if the file already holds the PID of
+some other existing process. See also <code><a
+href="refR.html#release">release</a></code>, <code><a
+href="refP.html#*Pid">*Pid</a></code> and <code><a
+href="refR.html#rc">rc</a></code>.
+
+<pre><code>
+: (acquire "sema1")
+-> 28255
+</code></pre>
+
+<dt><a name="alarm"><code>(alarm 'cnt . prg) -> cnt</code></a>
+<dd>Sets an alarm timer scheduling <code>prg</code> to be executed after
+<code>cnt</code> seconds, and returns the number of seconds remaining until any
+previously scheduled alarm was due to be delivered. Calling <code>(alarm
+0)</code> will cancel an alarm.
+
+<pre><code>
+: (prinl (tim$ (time) T)) (alarm 10 (prinl (tim$ (time) T)))
+16:36:14
+-> 0
+: 16:36:24
+
+: (alarm 10 (bye 0))
+-> 0
+$
+</code></pre>
+
+<dt><a name="align"><code>(align 'cnt 'any) -> sym</code></a>
+<dt><code>(align 'lst 'any ..) -> sym</code>
+<dd>Returns a transient symbol with all <code>any</code> arguments <code><a
+href="refP.html#pack">pack</a></code>ed in an aligned format. In the first form,
+<code>any</code> will be left-aligned if <code>cnt</code> ist negative,
+otherwise right-aligned. In the second form, all <code>any</code> arguments are
+packed according to the numbers in <code>lst</code>. See also <code><a
+href="refT.html#tab">tab</a></code>, <code><a
+href="refC.html#center">center</a></code> and <code><a
+href="refW.html#wrap">wrap</a></code>.
+
+<pre><code>
+: (align 4 "a")
+-> "   a"
+: (align -4 12)
+-> "12  "
+: (align (4 4 4) "a" 12 "b")
+-> "   a  12   b"
+</code></pre>
+
+<dt><a name="all"><code>(all ['T | '0]) -> lst</code></a>
+<dd>Returns a new list of all <a href="ref.html#internal">internal</a> symbols
+in the system (if called without arguments, or with <code>NIL</code>). Otherwise
+(if the argument is <code>T</code>), all current <a
+href="ref.html#transient">transient</a> symbols are returned. Else all current
+<a href="ref.html#external">external</a> symbols are returned.
+
+<pre><code>
+: (all)  # All internal symbols
+-> (inc> leaf nil inc! accept ...
+
+# Find all symbols starting with an underscore character
+: (filter '((X) (= "_" (car (chop X)))) (all))
+-> (_put _nacs _oct _lintq _lst _map _iter _dbg2 _getLine _led ...
+</code></pre>
+
+<dt><a name="allow"><code>(allow 'sym ['flg]) -> sym</code></a>
+<dd>Maintains an index structure of allowed access patterns in the global
+variable <code><a href="refA.html#*Allow">*Allow</a></code>. If the value of
+<code>*Allow</code> is non-<code>NIL</code>, <code>sym</code> is added to the
+<code><a href="refI.html#idx">idx</a></code> tree in the CAR of
+<code>*Allow</code> (if <code>flg</code> is <code>NIL</code>), or to the list of
+prefix strings (if <code>flg</code> is non-<code>NIL</code>). See also <code><a
+href="refA.html#allowed">allowed</a></code>.
+
+<pre><code>
+: *Allow
+-> (("@stop" ("@psh" NIL "@start") "favicon.ico" NIL "lib.css") "app/" "img/")
+: (allow "@myFoo")  # additionally allowed item
+-> "@myFoo"
+: (allow "myDir/" T)  # additionally allowed prefix
+-> "myDir/"
+</code></pre>
+
+<dt><a name="allowed"><code>(allowed lst [sym ..])</code></a>
+<dd>Creates an index structure of allowed access patterns in the global variable
+<code><a href="refA.html#*Allow">*Allow</a></code>. <code>lst</code> should
+consist of prefix strings (to be checked at runtime with <code><a
+href="refP.html#pre?">pre?</a></code>), and the <code>sym</code> arguments
+should specify the initially allowed items. See also <code><a
+href="refA.html#allow">allow</a></code>.
+
+<pre><code>
+: (allowed ("app/" "img/")  # allowed prefixes
+   "@start" "@stop" "favicon.ico" "lib.css" "@psh" )  # allowed items
+-> NIL
+</code></pre>
+
+<dt><a name="and"><code>(and 'any ..) -> any</code></a>
+<dd>Logical AND. The expressions <code>any</code> are evaluated from left to
+right. If <code>NIL</code> is encountered, <code>NIL</code> is returned
+immediately. Else the result of the last expression is returned.
+
+<pre><code>
+: (and (= 3 3) (read))
+abc  # User input
+-> abc
+: (and (= 3 4) (read))
+-> NIL
+</code></pre>
+
+<dt><a name="any"><code>(any 'sym) -> any</code></a>
+<dd>Parses <code>any</code> from the name of <code>sym</code>. This is the
+reverse operation of <code><a href="refS.html#sym">sym</a></code>. See also
+<code><a href="refS.html#str">str</a></code>.
+
+<pre><code>
+: (any "(a b # Comment^Jc d)")
+-> (a b c d)
+: (any "\"A String\"")
+-> "A String"
+</code></pre>
+
+<dt><a name="append"><code>(append 'lst ..) -> lst</code></a>
+<dd>Appends all argument lists. See also <code><a
+href="refC.html#conc">conc</a></code>, <code><a
+href="refI.html#insert">insert</a></code>, <code><a
+href="refD.html#delete">delete</a></code> and <code><a
+href="refR.html#remove">remove</a></code>.
+
+<pre><code>
+: (append '(a b c) (1 2 3))
+-> (a b c 1 2 3)
+: (append (1) (2) (3) 4)
+-> (1 2 3 . 4)
+</code></pre>
+
+<dt><a name="append/3"><code>append/3</code></a>
+<dd><a href="ref.html#pilog">Pilog</a> predicate that succeeds if appending the
+first two list arguments is equal to the third argument. See also <code><a
+href="refA.html#append">append</a></code> and <code><a
+href="refM.html#member/2">member/2</a></code>.
+
+<pre><code>
+: (? (append @X @Y (a b c)))
+ @X=NIL @Y=(a b c)
+ @X=(a) @Y=(b c)
+ @X=(a b) @Y=(c)
+ @X=(a b c) @Y=NIL
+-> NIL
+</code></pre>
+
+<dt><a name="apply"><code>(apply 'fun 'lst ['any ..]) -> any</code></a>
+<dd>Applies <code>fun</code> to <code>lst</code>. If additional <code>any</code>
+arguments are given, they are applied as leading elements of <code>lst</code>.
+<code>(apply 'fun 'lst 'any1 'any2)</code> is equivalent to <code>(apply 'fun
+(cons 'any1 'any2 'lst))</code>.
+
+<pre><code>
+: (apply + (1 2 3))
+-> 6
+: (apply * (5 6) 3 4)
+-> 360
+: (apply '((X Y Z) (* X (+ Y Z))) (3 4 5))
+-> 27
+: (apply println (3 4) 1 2)
+1 2 3 4
+-> 4
+</code></pre>
+
+<dt><a name="arg"><code>(arg ['cnt]) -> any</code></a>
+<dd>Can only be used inside functions with a variable number of arguments (with
+<code>@</code>). If <code>cnt</code> is not given, the value that was returned
+from the last call to <code>next</code>) is returned. Otherwise, the
+<code>cnt</code>'th remaining argument is returned. See also <code><a
+href="refA.html#args">args</a></code>, <code><a
+href="refN.html#next">next</a></code>, <code><a
+href="refR.html#rest">rest</a></code> and <code><a
+href="refP.html#pass">pass</a></code>.
+
+<pre><code>
+: (de foo @ (println (next) (arg)))    # Print argument twice
+-> foo
+: (foo 123)
+123 123
+-> 123
+: (de foo @
+   (println (arg 1) (arg 2))
+   (println (next))
+   (println (arg 1) (arg 2)) )
+-> foo
+: (foo 'a 'b 'c)
+a b
+a
+b c
+-> c
+</code></pre>
+
+<dt><a name="args"><code>(args) -> flg</code></a>
+<dd>Can only be used inside functions with a variable number of arguments (with
+<code>@</code>). Returns <code>T</code> when there are more arguments to be
+fetched from the internal list. See also <code><a
+href="refN.html#next">next</a></code>, <code><a
+href="refA.html#arg">arg</a></code>, <code><a
+href="refR.html#rest">rest</a></code> and <code><a
+href="refP.html#pass">pass</a></code>.
+
+<pre><code>
+: (de foo @ (println (args)))       # Test for arguments
+-> foo
+: (foo)                             # No arguments
+NIL
+-> NIL
+: (foo NIL)                         # One argument
+T
+-> T
+: (foo 123)                         # One argument
+T
+-> T
+</code></pre>
+
+<dt><a name="argv"><code>(argv [var ..] [. sym]) -> lst|sym</code></a>
+<dd>If called without arguments, <code>argv</code> returns a list of strings
+containing all remaining command line arguments. Otherwise, the
+<code>var/sym</code> arguments are subsequently bound to the command line
+arguments. A hyphen "<code>-</code>" can be used to stop <code>load</code>ing
+further arguments. See also <code><a href="refC.html#cmd">cmd</a></code>,
+<code><a href="ref.html#invoc">Invocation</a></code> and <code><a
+href="refO.html#opt">opt</a></code>.
+
+<pre><code>
+$ ./p -"println 'OK" - abc 123
+OK
+: (argv)
+-> ("abc" "123")
+: (argv A B)
+-> "123"
+: A
+-> "abc"
+: B
+-> "123"
+: (argv . Lst)
+-> ("abc" "123")
+: Lst
+-> ("abc" "123")
+</code></pre>
+
+<dt><a name="as"><code>(as 'any1 . any2) -> any2 | NIL</code></a>
+<dd>Returns <code>any2</code> unevaluated when <code>any1</code> evaluates to
+non-<code>NIL</code>. Otherwise <code>NIL</code> is returned. <code>(as Flg A B
+C)</code> is equivalent to <code>(and Flg '(A B C))</code>. See also <code><a
+href="refQ.html#quote">quote</a></code>.
+
+<pre><code>
+: (as (= 3 3) A B C)
+-> (A B C)
+</code></pre>
+
+<dt><a name="asoq"><code>(asoq 'any 'lst) -> lst</code></a>
+<dd>Searches an association list. Returns the first element from
+<code>lst</code> with <code>any</code> as its CAR, or <code>NIL</code> if no
+match is found. <code><a href="ref_.html#==">==</a></code> is used for
+comparison (pointer equality). See also <code><a
+href="refA.html#assoc">assoc</a></code>, <code><a
+href="refD.html#delq">delq</a></code>, <code><a
+href="refM.html#memq">memq</a></code>, <code><a
+href="refM.html#mmeq">mmeq</a></code> and <a href="ref.html#cmp">Comparing</a>.
+
+<pre><code>
+: (asoq 999 '((999 1 2 3) (b . 7) ("ok" "Hello")))
+-> NIL
+: (asoq 'b '((999 1 2 3) (b . 7) ("ok" "Hello")))
+-> (b . 7)
+</code></pre>
+
+<dt><a name="asserta"><code>(asserta 'lst) -> lst</code></a>
+<dd>Inserts a new <a href="ref.html#pilog">Pilog</a> fact or rule before all
+other rules. See also <code><a href="refB.html#be">be</a></code>, <code><a
+href="refA.html#assertz">assertz</a></code> and <code><a
+href="refR.html#retract">retract</a></code>.
+
+<pre><code>
+: (be a (2))            # Define two facts
+-> a
+: (be a (3))
+-> a
+
+: (asserta '(a (1)))    # Insert new fact in front
+-> (((1)) ((2)) ((3)))
+
+: (? (a @N))            # Query
+ @N=1
+ @N=2
+ @N=3
+-> NIL
+</code></pre>
+
+<dt><a name="asserta/1"><code>asserta/1</code></a>
+<dd><a href="ref.html#pilog">Pilog</a> predicate that inserts a new fact or rule
+before all other rules. See also <code><a
+href="refA.html#asserta">asserta</a></code>, <code><a
+href="refA.html#assertz/1">assertz/1</a></code> and <code><a
+href="refR.html#retract/1">retract/1</a></code>.
+
+<pre><code>
+: (? (asserta (a (2))))
+-> T
+: (? (asserta (a (1))))
+-> T
+: (rules 'a)
+1 (be a (1))
+2 (be a (2))
+-> a
+</code></pre>
+
+<dt><a name="assertz"><code>(assertz 'lst) -> lst</code></a>
+<dd>Appends a new <a href="ref.html#pilog">Pilog</a> fact or rule behind all
+other rules. See also <code><a href="refB.html#be">be</a></code>, <code><a
+href="refA.html#asserta">asserta</a></code> and <code><a
+href="refR.html#retract">retract</a></code>.
+
+<pre><code>
+: (be a (1))            # Define two facts
+-> a
+: (be a (2))
+-> a
+
+: (assertz '(a (3)))    # Append new fact at the end
+-> (((1)) ((2)) ((3)))
+
+: (? (a @N))            # Query
+ @N=1
+ @N=2
+ @N=3
+-> NIL
+</code></pre>
+
+<dt><a name="assertz/1"><code>assertz/1</code></a>
+<dd><a href="ref.html#pilog">Pilog</a> predicate that appends a new fact or rule
+behind all other rules. See also <code><a
+href="refA.html#assertz">assertz</a></code>, <code><a
+href="refA.html#asserta/1">asserta/1</a></code> and <code><a
+href="refR.html#retract/1">retract/1</a></code>.
+
+<pre><code>
+: (? (assertz (a (1))))
+-> T
+: (? (assertz (a (2))))
+-> T
+: (rules 'a)
+1 (be a (1))
+2 (be a (2))
+-> a
+</code></pre>
+
+<dt><a name="assoc"><code>(assoc 'any 'lst) -> lst</code></a> <dd>Searches an
+association list. Returns the first element from <code>lst</code> with its CAR
+equal to <code>any</code>, or <code>NIL</code> if no match is found. See also
+<code><a href="refA.html#asoq">asoq</a></code>.
+
+<pre><code>
+: (assoc "b" '((999 1 2 3) ("b" . 7) ("ok" "Hello")))
+-> ("b" . 7)
+: (assoc 999 '((999 1 2 3) ("b" . 7) ("ok" "Hello")))
+-> (999 1 2 3)
+: (assoc 'u '((999 1 2 3) ("b" . 7) ("ok" "Hello")))
+-> NIL
+</code></pre>
+
+<dt><a name="at"><code>(at '(cnt1 . cnt2) . prg) -> any</code></a>
+<dd>Increments <code>cnt1</code> (destructively), and returns <code>NIL</code>
+when it is less than <code>cnt2</code>. Otherwise, <code>cnt1</code> is reset to
+zero and <code>prg</code> is executed. Returns the result of <code>prg</code>.
+
+<pre><code>
+: (do 11 (prin ".") (at (0 . 3) (prin "!")))
+...!...!...!..-> NIL
+</code></pre>
+
+<dt><a name="atom"><code>(atom 'any) -> flg</code></a>
+<dd>Returns <code>T</code> when the argument <code>any</code> is an atom (a
+number or a symbol). See also <code><a href="refP.html#pair">pair</a></code>.
+
+<pre><code>
+: (atom 123)
+-> T
+: (atom 'a)
+-> T
+: (atom NIL)
+-> T
+: (atom (123))
+-> NIL
+</code></pre>
+
+<dt><a name="aux"><code>(aux 'var 'cls ['hook] 'any ..) -> sym</code></a>
+<dd>Returns a database object of class <code>cls</code>, where the value for
+<code>var</code> corresponds to <code>any</code> and the following arguments.
+<code>var</code>, <code>cls</code> and <code>hook</code> should specify a
+<code><a href="refT.html#tree">tree</a></code> for <code>cls</code> or one of
+its superclasses, for a relation with auxiliary keys. For multi-key accesses,
+<code>aux</code> is simlar to - but faster than - <code>db</code>, because it
+can use a single tree access. See also <code><a
+href="refD.html#db">db</a></code>, <code><a
+href="refC.html#collect">collect</a></code>, <code><a
+href="refF.html#fetch">fetch</a></code>, <code><a
+href="refI.html#init">init</a></code>, <code><a
+href="refS.html#step">step</a></code> and <code><a
+href="refA.html#+Aux">+Aux</a></code>.
+
+<pre><code>
+(class +PS +Entity)
+(rel par    (+Dep +Joint) (sup) ps (+Part))     # Part
+(rel sup    (+Aux +Ref +Link) (par) NIL (+Supp))# Supplier
+...
+   (aux 'sup '+PS                               # Access PS object
+      (db 'nr '+Supp 1234)
+      (db 'nr '+Part 5678) )
+</code></pre>
+
+</dl>
+
+</body>
+</html>
diff --git a/doc/refB.html b/doc/refB.html
@@ -0,0 +1,319 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN" "http://www.w3.org/TR/1998/REC-html40-19980424/loose.dtd">
+<html lang="en">
+<head>
+<meta http-equiv="Content-Type" content="text/html; charset=utf-8">
+<title>B</title>
+<link rel="stylesheet" href="doc.css" type="text/css">
+</head>
+<body>
+
+<h1>B</h1>
+
+<dl>
+
+<dt><a name="*Blob"><code>*Blob</code></a>
+<dd>A global variable holding the pathname of the database blob directory. See
+also <code><a href="refB.html#blob">blob</a></code>.
+
+<pre><code>
+: *Blob
+-> "blob/app/"
+</code></pre>
+
+<dt><a name="*Bye"><code>*Bye</code></a>
+<dd>A global variable holding a (possibly empty) <code>prg</code> body, to be
+executed just before the termination of the PicoLisp interpreter. See also
+<code><a href="refB.html#bye">bye</a></code> and <code><a
+href="refT.html#tmp">tmp</a></code>.
+
+<pre><code>
+: (push1 '*Bye '(call 'rm "myfile.tmp"))  # Remove a temporary file
+-> (call 'rm "myfile.tmp")
+</code></pre>
+
+<dt><a name="+Bag"><code>+Bag</code></a>
+<dd>Class for a list of arbitrary relations, a subclass of <code><a
+href="refR.html#+relation">+relation</a></code>. Objects of that class maintain
+a list of heterogeneous relations. Typically used in combination with the
+<code><a href="refL.html#+List">+List</a></code> prefix class, to maintain small
+two-dimensional tables within oubjects. See also <code><a
+href="ref.html#dbase">Database</a></code>.
+
+<pre><code>
+(rel pos (+List +Bag)         # Positions
+   ((+Ref +Link) NIL (+Item))    # Item
+   ((+Number) 2)                 # Price
+   ((+Number))                   # Quantity
+   ((+String))                   # Memo text
+   ((+Number) 2) )               # Total amount
+</code></pre>
+
+<dt><a name="+Blob"><code>+Blob</code></a>
+<dd>Class for blob relations, a subclass of <code><a
+href="refR.html#+relation">+relation</a></code>. Objects of that class maintain
+blobs, as stubs in database objects pointing to actual files for arbitrary
+(often binary) data. The files themselves reside below the path specified by the
+<code><a href="refB.html#*Blob">*Blob</a></code> variable. See also <code><a
+href="ref.html#dbase">Database</a></code>.
+
+<pre><code>
+(rel jpg (+Blob))  # Picture
+</code></pre>
+
+<dt><a name="+Bool">+Bool<code></code></a>
+<dd>Class for boolean relations, a subclass of <code><a
+href="refR.html#+relation">+relation</a></code>. Objects of that class expect
+either <code>T</code> or <code>NIL</code> as value (though, as always, only
+non-<code>NIL</code> will be physically stored in objects). See also <code><a
+href="ref.html#dbase">Database</a></code>.
+
+<pre><code>
+(rel ok (+Ref +Bool))  # Indexed flag
+</code></pre>
+
+<dt><a name="balance"><code>(balance 'var 'lst ['flg])</code></a>
+<dd>Builds a balanced binary <code><a href="refI.html#idx">idx</a></code> tree
+in <code>var</code>, from the sorted list in <code>lst</code>. Normally (if
+random or, in the worst case, ordered data) are inserted with <code>idx</code>,
+the tree will not be balanced. But if <code>lst</code> is properly sorted, its
+contents will be inserted in an optimally balanced way. If <code>flg</code> is
+non-<code>NIL</code>, the index tree will be augmented instead of being
+overwritten. See also <code><a href="ref.html#cmp">Comparing</a></code> and
+<code><a href="refS.html#sort">sort</a></code>.
+
+<pre><code>
+# Normal idx insert
+: (off I)
+-> NIL
+: (for X (1 4 2 5 3 6 7 9 8) (idx 'I X T))
+-> NIL
+: (depth I)
+-> 7
+
+# Balanced insert
+: (balance 'I (sort (1 4 2 5 3 6 7 9 8)))
+-> NIL
+: (depth I)
+-> 4
+
+# Augment
+: (balance 'I (sort (10 40 20 50 30 60 70 90 80)) T)
+-> NIL
+: (idx 'I)
+-> (1 2 3 4 5 6 7 8 9 10 20 30 40 50 60 70 80 90)
+</code></pre>
+
+<dt><a name="be"><code>(be sym . any) -> sym</code></a>
+<dd>Declares a <a href="ref.html#pilog">Pilog</a> fact or rule for the
+<code>sym</code> argument, by concatenating the <code>any</code> argument to the
+<code>T</code> property of <code>sym</code>. See also <code><a
+href="refA.html#asserta">asserta</a></code>, <code><a
+href="refA.html#assertz">assertz</a></code>, <code><a
+href="refR.html#retract">retract</a></code>, <code><a
+href="refG.html#goal">goal</a></code> and <code><a
+href="refP.html#prove">prove</a></code>.
+
+<pre><code>
+: (be likes (John Mary))
+-> likes
+: (be likes (John @X) (likes @X wine) (likes @X food))
+-> likes
+: (get 'likes T)
+-> (((John Mary)) ((John @X) (likes @X wine) (likes @X food)))
+: (? (likes John @X))
+ @X=Mary
+-> NIL
+</code></pre>
+
+<dt><a name="beep"><code>(beep) -> any</code></a>
+<dd>Send the bell character to the console. See also <code><a
+href="refP.html#prin">prin</a></code> and <code><a
+href="refC.html#char">char</a></code>.
+
+<pre><code>
+: (beep)
+-> "^G"
+</code></pre>
+
+<dt><a name="bench"><code>(bench . prg) -> any</code></a>
+<dd>Benchmarks <code>prg</code>, by printing the time it took to execute, and
+returns the result. See also <code><a href="refU.html#usec">usec</a></code>.
+
+<pre><code>
+: (bench (wait 2000))
+1.996 sec
+-> NIL
+</code></pre>
+
+<dt><a name="bind"><code>(bind 'sym|lst . prg) -> any</code></a>
+<dd>Binds value(s) to symbol(s). The first argument must evaluate to a symbol,
+or a list of symbols or symbol-value pairs. The values of these symbols are
+saved (and the symbols bound to the values in the case of pairs),
+<code>prg</code> is executed, then the symbols are restored to their original
+values. During execution of <code>prg</code>, the values of the symbols can be
+temporarily modified. The return value is the result of <code>prg</code>. See
+also <code><a href="refL.html#let">let</a></code>, <code><a
+href="refJ.html#job">job</a></code> and <code><a
+href="refU.html#use">use</a></code>.
+
+<pre><code>
+: (setq X 123)                               # X is 123
+-> 123
+: (bind 'X (setq X "Hello") (println X))  # Set X to "Hello", print it
+"Hello"
+-> "Hello"
+: (bind '((X . 3) (Y . 4)) (println X Y) (* X Y))
+3 4
+-> 12
+: X
+-> 123                                       # X is restored to 123
+</code></pre>
+
+<dt><a name="bit?"><code>(bit? 'num ..) -> num | NIL</code></a>
+<dd>Returns the first <code>num</code> argument when all bits which are 1 in the
+first argument are also 1 in all following arguments. When one of those
+arguments evaluates to <code>NIL</code>, it is returned immediately. See also
+<code><a href="ref_.html#&">&</a></code>, <code><a
+href="ref_.html#|">|</a></code> and <code><a href="refX.html#x|">x|</a></code>.
+
+<pre><code>
+: (bit? 7 15 255)
+-> 7
+: (bit? 1 3)
+-> 1
+: (bit? 1 2)
+-> NIL
+</code></pre>
+
+<dt><a name="blob"><code>(blob 'obj 'sym) -> sym</code></a>
+<dd>Returns the blob file name for <code>var</code> in <code>obj</code>. See
+also <code><a href="refB.html#*Blob">*Blob</a></code>, <code><a
+href="refB.html#blob!">blob!</a></code> and <code><a
+href="refP.html#pack">pack</a></code>.
+
+<pre><code>
+: (show (db 'nr '+Item 1))
+{3-1} (+Item)
+   jpg
+   pr 29900
+   inv 100
+   sup {2-1}
+   nm "Main Part"
+   nr 1
+-> {3-1}
+: (blob '{3-1} 'jpg)
+-> "blob/app/3/-/1.jpg"
+</code></pre>
+
+<dt><a name="blob!"><code>(blob! 'obj 'sym 'file)</code></a>
+<dd>Stores the contents of <code>file</code> in a <code><a
+href="refB.html#blob">blob</a></code>. See also <code><a
+href="refE.html#entityMesssages">put!></a></code>.
+
+<pre><code>
+(blob! *ID 'jpg "picture.jpg")
+</code></pre>
+
+<dt><a name="bool"><code>(bool 'any) -> flg</code></a>
+<dd>Returns <code>T</code> when the argument <code>any</code> is
+non-<code>NIL</code>. This function is only needed when <code>T</code> is
+strictly required for a "true" condition (Usually, any non-<code>NIL</code>
+value is considered to be "true"). See also <code><a
+href="refF.html#flg?">flg?</a></code>.
+
+<pre><code>
+: (and 3 4)
+-> 4
+: (bool (and 3 4))
+-> T
+</code></pre>
+
+<dt><a name="bool/3"><code>bool/3</code></a>
+<dd><a href="ref.html#pilog">Pilog</a> predicate that succeeds if the first
+argument has the same truth value as the result of applying the <code><a
+href="refG.html#get">get</a></code> algorithm to the following arguments.
+Typically used as filter predicate in <code><a
+href="refS.html#select/3">select/3</a></code> database queries. See also
+<code><a href="refB.html#bool">bool</a></code>, <code><a
+href="refI.html#isa/2">isa/2</a></code>, <code><a
+href="refS.html#same/3">same/3</a></code>, <code><a
+href="refR.html#range/3">range/3</a></code>, <code><a
+href="refH.html#head/3">head/3</a></code>, <code><a
+href="refF.html#fold/3">fold/3</a></code>, <code><a
+href="refP.html#part/3">part/3</a></code> and <code><a
+href="refT.html#tolr/3">tolr/3</a></code>.
+
+<pre><code>
+: (? @OK NIL         # Find orders where the 'ok' flag is not set
+   (db nr +Ord @Ord)
+   (bool @OK @Ord ok) )
+ @OK=NIL @Ord={3-7}
+-> NIL
+</code></pre>
+
+<dt><a name="box"><code>(box 'any) -> sym</code></a>
+<dd>Creates and returns a new anonymous symbol. The initial value is set to the
+<code>any</code> argument. See also <code><a href="refN.html#new">new</a></code>
+and <code><a href="refB.html#box?">box?</a></code>.
+
+<pre><code>
+: (show (box '(A B C)))
+$134425627 (A B C)
+-> $134425627
+</code></pre>
+
+<dt><a name="box?"><code>(box? 'any) -> sym | NIL</code></a>
+<dd>Returns the argument <code>any</code> when it is an anonymous symbol,
+otherwise <code>NIL</code>. See also <code><a
+href="refB.html#box">box</a></code>, <code><a
+href="refS.html#str?">str?</a></code> and <code><a
+href="refE.html#ext?">ext?</a></code>.
+
+<pre><code>
+: (box? (new))
+-> $134563468
+: (box? 123)
+-> NIL
+: (box? 'a)
+-> NIL
+: (box? NIL)
+-> NIL
+</code></pre>
+
+<dt><a name="by"><code>(by 'fun1 'fun2 'lst ..) -> lst</code></a>
+<dd>Applies <code>fun1</code> to each element of <code>lst</code>. When
+additional <code>lst</code> arguments are given, their elements are also passed
+to <code>fun1</code>. Each result of <code>fun1</code> is CONSed with its
+corresponding argument form the original <code>lst</code>, and collected into a
+list which is passed to <code>fun2</code>. For the list returned from
+<code>fun2</code>, the CAR elements returned by <code>fun1</code> are
+(destructively) removed from each element.
+
+<pre><code>
+: (let (A 1 B 2 C 3) (by val sort '(C A B)))
+-> (A B C)
+: (by '((N) (bit? 1 N)) group (3 11 6 2 9 5 4 10 12 7 8 1))
+-> ((3 11 9 5 7 1) (6 2 4 10 12 8))
+</code></pre>
+
+<dt><a name="bye"><code>(bye 'cnt|NIL)</code></a>
+<dd>Executes all pending <code><a href="refF.html#finally">finally</a></code>
+expressions, closes all open files, executes the <code>VAL</code> of the global
+variable <code><a href="refB.html#*Bye">*Bye</a></code> (should be a
+<code>prg</code>), flushes standard output, and then exits the PicoLisp
+interpreter. The process return value is <code>cnt</code>, or 0 if the argument
+is missing or <code>NIL</code>.
+
+<pre><code>
+: (setq *Bye '((println 'OK) (println 'bye)))
+-> ((println 'OK) (println 'bye))
+: (bye)
+OK
+bye
+$
+</code></pre>
+
+</dl>
+
+</body>
+</html>
diff --git a/doc/refC.html b/doc/refC.html
@@ -0,0 +1,657 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN" "http://www.w3.org/TR/1998/REC-html40-19980424/loose.dtd">
+<html lang="en">
+<head>
+<meta http-equiv="Content-Type" content="text/html; charset=utf-8">
+<title>C</title>
+<link rel="stylesheet" href="doc.css" type="text/css">
+</head>
+<body>
+
+<h1>C</h1>
+
+<dl>
+
+<dt><a name="*Class"><code>*Class</code></a>
+<dd>A global variable holding the current class. See also <code><a
+href="ref.html#oop">OO Concepts</a></code>, <code><a
+href="refC.html#class">class</a></code>, <code><a
+href="refE.html#extend">extend</a></code>, <code><a
+href="refD.html#dm">dm</a></code> and <code><a
+href="refV.html#var">var</a></code> and <code><a
+href="refR.html#rel">rel</a></code>.
+
+<pre><code>
+: (class +Test)
+-> +Test
+: *Class
+-> +Test
+</code></pre>
+
+<dt><a name="cache"><code>(cache 'var 'sym . prg) -> any</code></a>
+<dd>Speeds up some calculations, by holding previously calculated results in an
+<code><a href="refI.html#idx">idx</a></code> tree structure. <code>sym</code>
+must be a transient symbol representing a unique key for the argument(s) to the
+calculation.
+
+<pre><code>
+: (de fibonacci (N)
+   (cache '*Fibonacci (format N)
+      (if (> 2 N)
+         1
+         (+
+            (fibonacci (dec N))
+            (fibonacci (- N 2)) ) ) ) )
+-> fibonacci
+: (fibonacci 22)
+-> 28657
+: (fibonacci 10000)
+-> 5443837311356528133873426099375038013538 ...  # (2090 digits)
+</code></pre>
+
+<dt><a name="call"><code>(call 'any ..) -> flg</code></a>
+<dd>Calls an external system command. The <code>any</code> arguments specify the
+command and its arguments. Returns <code>T</code> if the command was executed
+successfully.
+
+<pre><code>
+: (when (call 'test "-r" "file.l")  # Test if file exists and is readable
+   (load "file.l")  # Load it
+   (call 'rm "file.l") )  # Remove it
+</code></pre>
+
+<dt><a name="call/1"><code>call/1</code></a>
+<dd><a href="ref.html#pilog">Pilog</a> predicate that succeeds if the argument
+term can be proven.
+
+<pre><code>
+: (be mapcar (@ NIL NIL))
+-> mapcar
+: (be mapcar (@P (@X . @L) (@Y . @M))
+   (call @P @X @Y)                        # Call the given predicate
+   (mapcar @P @L @M) )
+-> mapcar
+:  (? (mapcar change (you are a computer) @Z))
+-> NIL
+:  (? (mapcar change (you are a computer) @Z) T)
+-> NIL
+:  (? (mapcar permute ((a b c) (d e f)) @X))
+ @X=((a b c) (d e f))
+ @X=((a b c) (d f e))
+ @X=((a b c) (e d f))
+ ...
+ @X=((a c b) (d e f))
+ @X=((a c b) (d f e))
+ @X=((a c b) (e d f))
+ ...
+</code></pre>
+
+<dt><a name="can"><code>(can 'msg) -> lst</code></a>
+<dd>Returns a list of all classes that accept the message <code>msg</code>. See
+also <code><a href="ref.html#oop">OO Concepts</a></code>, <code><a
+href="refC.html#class">class</a></code>, <code><a
+href="refD.html#dep">dep</a></code>, <code><a
+href="refW.html#what">what</a></code> and <code><a
+href="refW.html#who">who</a></code>.
+
+<pre><code>
+: (can 'zap>)
+-> ((zap> . +relation) (zap> . +Blob) (zap> . +Entity))
+: (more @ pp)
+(dm (zap> . +relation) (Obj Val))
+
+(dm (zap> . +Blob) (Obj Val)
+   (and
+      Val
+      (call 'rm "-f" (blob Obj (: var))) ) )
+
+(dm (zap> . +Entity) NIL
+   (for X (getl This)
+      (let V (or (atom X) (pop 'X))
+         (and (meta This X) (zap> @ This V)) ) ) )
+
+-> NIL
+</code></pre>
+
+<dt><a name="car"><code>(car 'var) -> any</code></a>
+<dd>List access: Returns the value of <code>var</code> if it is a symbol, or the
+first element if it is a list. See also <code><a
+href="refC.html#cdr">cdr</a></code> and <code><a
+href="refC.html#cXr">c..r</a></code>.
+
+<pre><code>
+: (car (1 2 3 4 5 6))
+-> 1
+</code></pre>
+
+<dt><a name="cXr"><code>(c[ad]*ar 'var) -> any</code></a>
+<dt><code>(c[ad]*dr 'lst) -> any</code>
+<dd>List access shortcuts. Combinations of the <code><a
+href="refC.html#car">car</a></code> and <code><a
+href="refC.html#cdr">cdr</a></code> functions, with up to four letters 'a' and
+'d'.
+
+<pre><code>
+: (cdar '((1 . 2) . 3))
+-> 2
+</code></pre>
+
+<dt><a name="case"><code>(case 'any (any1 . prg1) (any2 . prg2) ..) -> any</code></a>
+<dd>Multi-way branch: <code>any</code> is evaluated and compared to the CAR
+elements <code>anyN</code> of each clause. If one of them is a list,
+<code>any</code> is in turn compared to all elements of that list.
+<code>T</code> is a catch-all for any value. If a comparison succeeds,
+<code>prgN</code> is executed, and the result returned. Otherwise
+<code>NIL</code> is returned. See also <code><a
+href="refS.html#state">state</a></code>.
+
+<pre><code>
+: (case (char 66) ("A" (+ 1 2 3)) (("B" "C") "Bambi") ("D" (* 1 2 3)))
+-> "Bambi"
+</code></pre>
+
+<dt><a name="catch"><code>(catch 'any . prg) -> any</code></a>
+<dd>Sets up the environment for a non-local jump which may be caused by <code><a
+href="refT.html#throw">throw</a></code> or by a runtime error. If
+<code>any</code> is an atom, it is used by <code>throw</code> as a jump label
+(with <code>T</code> being a catch-all for any label), and a <code>throw</code>
+called during the execution of <code>prg</code> will immediately return the
+thrown value. Otherwise, <code>any</code> should be a list of strings, to catch
+any error whose message contains one of these strings, and this will immediately
+return the matching string. If neither <code>throw</code> nor an error occurs,
+the result of <code>prg</code> is returned. See also <code><a
+href="refF.html#finally">finally</a></code>, <code><a
+href="refQ.html#quit">quit</a></code> and
+<code><a href="ref.html#errors">Error Handling</a></code>.
+
+<pre><code>
+: (catch 'OK (println 1) (throw 'OK 999) (println 2))
+1
+-> 999
+: (catch '("No such file") (in "doesntExist" (foo)))
+-> "No such file"
+</code></pre>
+
+<dt><a name="cd"><code>(cd 'any) -> sym</code></a>
+<dd>Changes the current directory to <code>any</code>. The old directory is
+returned on success, otherwise <code>NIL</code>. See also <code><a
+href="refD.html#dir">dir</a></code> and <code><a
+href="refP.html#pwd">pwd</a></code>.
+
+<pre><code>
+: (when (cd "lib")
+   (println (sum lines (dir)))
+   (cd @) )
+10955
+</code></pre>
+
+<dt><a name="cdr"><code>(cdr 'lst) -> any</code></a>
+<dd>List access: Returns all but the first element of <code>lst</code>. See also
+<code><a href="refC.html#car">car</a></code> and <code><a
+href="refC.html#cXr">c..r</a></code>.
+
+<pre><code>
+: (cdr (1 2 3 4 5 6))
+-> (2 3 4 5 6)
+</code></pre>
+
+<dt><a name="center"><code>(center 'cnt|lst 'any ..) -> sym</code></a>
+<dd>Returns a transient symbol with all <code>any</code> arguments <code><a
+href="refP.html#pack">pack</a></code>ed in a centered format. Trailing blanks
+are omitted. See also <code><a href="refA.html#align">align</a></code>, <code><a
+href="refT.html#tab">tab</a></code> and <code><a
+href="refW.html#wrap">wrap</a></code>.
+
+<pre><code>
+: (center 4 12)
+-> " 12"
+: (center 4 "a")
+-> " a"
+: (center 7 "a")
+-> "   a"
+: (center (3 3 3) "a" "b" "c")
+-> " a  b  c"
+</code></pre>
+
+<dt><a name="chain"><code>(chain 'lst ..) -> lst</code></a>
+<dd>Concatenates (destructively) one or several new list elements
+<code>lst</code> to the end of the list in the current <code><a
+href="refM.html#make">make</a></code> environment. This operation is efficient
+also for long lists, because a pointer to the last element of the result list is
+maintained. <code>chain</code> returns the last linked argument. See also
+<code><a href="refL.html#link">link</a></code>, <code><a
+href="refY.html#yoke">yoke</a></code> and <code><a
+href="refM.html#made">made</a></code>.
+
+<pre><code>
+: (make (chain (list 1 2 3) NIL (cons 4)) (chain (list 5 6)))
+-> (1 2 3 4 5 6)
+</code></pre>
+
+<dt><a name="char"><code>(char) -> sym</code></a>
+<dt><code>(char 'cnt) -> sym</code>
+<dt><code>(char T) -> sym</code>
+<dt><code>(char 'sym) -> cnt</code>
+<dd>When called without arguments, the next character from the current input
+stream is returned as a single-character transient symbol, or <code>NIL</code>
+upon end of file. When called with a number <code>cnt</code>, a character with
+the corresponding unicode value is returned. As a special case, <code>T</code>
+is accepted to produce a byte value greater than any first byte in a UTF-8
+character (used as a top value in comparisons). Otherwise, when called with a
+symbol <code>sym</code>, the numeric unicode value of the first character of the
+name of that symbol is returned. See also <code><a
+href="refP.html#peek">peek</a></code>, <code><a
+href="refS.html#skip">skip</a></code>, <code><a
+href="refK.html#key">key</a></code>, <code><a
+href="refL.html#line">line</a></code>, <code><a
+href="refT.html#till">till</a></code> and <code><a
+href="refE.html#eof">eof</a></code>.
+
+<pre><code>
+: (char)                   # Read character from console
+A                          # (typed 'A' and a space/return)
+-> "A"
+: (char 100)               # Convert unicode to symbol
+-> "d"
+: (char T)                 # Special case, catch all
+-> # (not printable)
+: (char "d")               # Convert symbol to unicode
+-> 100
+</code></pre>
+
+<dt><a name="chdir"><code>(chdir 'any . prg) -> any</code></a>
+<dd>Changes the current directory to <code>any</code> with <code><a
+href="refC.html#cd">cd</a></code> during the execution of <code>prg</code>. Then
+the previous directory will be restored and the result of <code>prg</code>
+returned. See also <code><a href="refD.html#dir">dir</a></code> and <code><a
+href="refP.html#pwd">pwd</a></code>.
+
+<pre><code>
+: (pwd)
+-> "/usr/abu/pico"
+: (chdir "src" (pwd))
+-> "/usr/abu/pico/src"
+: (pwd)
+-> "/usr/abu/pico"
+</code></pre>
+
+<dt><a name="chkTree"><code>(chkTree 'sym ['fun]) -> num</code></a>
+<dd>Checks a database tree node (and recursively all sub-nodes) for consistency.
+Returns the total number of nodes checked. Optionally, <code>fun</code> is
+called with the key and value of each node, and should return <code>NIL</code>
+for failure. See also <code><a href="refT.html#tree">tree</a></code> and
+<code><a href="refR.html#root">root</a></code>.
+
+<pre><code>
+: (show *DB '+Item)
+{C} NIL
+   sup (7 . {7-3})
+   nr (7 . {7-1})    # 7 nodes in the 'nr' tree, base node is {7-1}
+   pr (7 . {7-4})
+   nm (77 . {7-6})
+-> {C}
+: (chkTree '{7-1})   # Check that node
+-> 7
+</code></pre>
+
+<dt><a name="chop"><code>(chop 'any) -> lst</code></a>
+<dd>Returns <code>any</code> as a list of single-character strings. If
+<code>any</code> is <code>NIL</code> or a symbol with no name, <code>NIL</code>
+is returned. A list argument is returned unchanged.
+
+<pre><code>
+: (chop 'car)
+-> ("c" "a" "r")
+: (chop "Hello")
+-> ("H" "e" "l" "l" "o")
+</code></pre>
+
+<dt><a name="circ"><code>(circ 'any ..) -> lst</code></a>
+<dd>Produces a circular list of all <code>any</code> arguments by <code><a
+href="refC.html#cons">cons</a></code>ing them to a list and then connecting the
+CDR of the last cell to the first cell. See also <code><a
+href="refL.html#list">list</a></code>.
+
+<pre><code>
+: (circ 'a 'b 'c)
+-> (a b c .)
+</code></pre>
+
+<dt><a name="class"><code>(class sym . typ) -> obj</code></a>
+<dd>Defines <code>sym</code> as a class with the superclass(es)
+<code>typ</code>. As a side effect, the global variable <code><a
+href="refC.html#*Class">*Class</a></code> is set to <code>obj</code>. See also
+<code><a href="refE.html#extend">extend</a></code>, <code><a
+href="refD.html#dm">dm</a></code>, <code><a href="refV.html#var">var</a></code>,
+<code><a href="refR.html#rel">rel</a></code>, <code><a
+href="refT.html#type">type</a></code>, <code><a
+href="refI.html#isa">isa</a></code> and <code><a
+href="refO.html#object">object</a></code>.
+
+<pre><code>
+: (class +A +B +C +D)
+-> +A
+: +A
+-> (+B +C +D)
+: (dm foo> (X) (bar X))
+-> foo>
+: +A
+-> ((foo> (X) (bar X)) +B +C +D)
+</code></pre>
+
+<dt><a name="clause/2"><code>clause/2</code></a>
+<dd><a href="ref.html#pilog">Pilog</a> predicate that succeeds if the first
+argument is a predicate which has the second argument defined as a clause.
+
+<pre><code>
+: (? (clause append ((NIL @X @X))))
+-> T
+
+: (? (clause append @C))
+ @C=((NIL @X @X))
+ @C=(((@A . @X) @Y (@A . @Z)) (append @X @Y @Z))
+-> NIL
+</code></pre>
+
+<dt><a name="clip"><code>(clip 'lst) -> lst</code></a>
+<dd>Returns a copy of <code>lst</code> with all white space characters or
+<code>NIL</code> elements removed from both sides. See also <code><a
+href="refT.html#trim">trim</a></code>.
+
+<pre><code>
+: (clip '(NIL 1 NIL 2 NIL))
+-> (1 NIL 2)
+: (clip '(" " a " " b " "))
+-> (a " " b)
+</code></pre>
+
+<dt><a name="close"><code>(close 'cnt) -> cnt | NIL</code></a>
+<dd>Closes a file descriptor <code>cnt</code>, and returns it when successful.
+Should not be called inside an <code><a href="refO.html#out">out</a></code> body
+for that descriptor. See also <code><a href="refO.html#open">open</a></code>,
+<code><a href="refL.html#listen">listen</a></code> and <code><a
+href="refC.html#connect">connect</a></code>.
+
+<pre><code>
+: (close 2)                            # Close standard error
+-> 2
+</code></pre>
+
+<dt><a name="cmd"><code>(cmd ['any]) -> sym</code></a>
+<dd>When called without an argument, the name of the command that invoked the
+picolisp interpreter is returned. Otherwise, the command name is set to
+<code>any</code>. Setting the name may not work on some operating systems. Note
+that the new name must not be longer than the original one. See also <code><a
+href="refA.html#argv">argv</a></code> and <code><a
+href="ref.html#invoc">Invocation</a></code>.
+
+<pre><code>
+$ ./dbg
+: (cmd)
+-> "./bin/picolisp"
+: (cmd "!/bin/picolust")
+-> "!/bin/picolust"
+: (cmd)
+-> "!/bin/picolust"
+</code></pre>
+
+<dt><a name="cnt"><code>(cnt 'fun 'lst ..) -> cnt</code></a>
+<dd>Applies <code>fun</code> to each element of <code>lst</code>. When
+additional <code>lst</code> arguments are given, their elements are also passed
+to <code>fun</code>. Returns the count of non-<code>NIL</code> values returned
+from <code>fun</code>.
+
+<pre><code>
+: (cnt cdr '((1 . T) (2) (3 4) (5)))
+-> 2
+</code></pre>
+
+<dt><a name="collect"><code>(collect 'var 'cls ['hook] ['any|beg ['end [var ..]]])</code></a>
+<dd>Returns a list of all database objects of class <code>cls</code>, where the
+values for the <code>var</code> arguments correspond to the <code>any</code>
+arguments, or where the values for the <code>var</code> arguments are in the
+range <code>beg</code> .. <code>end</code>. <code>var</code>, <code>cls</code>
+and <code>hook</code> should specify a <code><a
+href="refT.html#tree">tree</a></code> for <code>cls</code> or one of its
+superclasses. If additional <code>var</code> arguments are given, the final
+values for the result list are obtained by applying the <code><a
+href="refG.html#get">get</a></code> algorithm. See also <code><a
+href="refD.html#db">db</a></code>, <code><a href="refA.html#aux">aux</a></code>,
+<code><a href="refF.html#fetch">fetch</a></code>, <code><a
+href="refI.html#init">init</a></code> and <code><a
+href="refS.html#step">step</a></code>.
+
+<pre><code>
+: (collect 'nr '+Item)
+-> ({3-1} {3-2} {3-3} {3-4} {3-5} {3-6} {3-8})
+: (collect 'nr '+Item 3 6 'nr)
+-> (3 4 5 6)
+: (collect 'nr '+Item 3 6 'nm)
+-> ("Auxiliary Construction" "Enhancement Additive" "Metal Fittings" "Gadget Appliance")
+: (collect 'nm '+Item "Main Part")
+-> ({3-1})
+</code></pre>
+
+<dt><a name="commit"><code>(commit ['any] [exe1] [exe2]) -> T</code></a>
+<dd>Closes a transaction, by writing all new or modified external symbols to,
+and removing all deleted external symbols from the database. When
+<code>any</code> is given, it is implicitly sent (with all modified objects) via
+the <code><a href="refT.html#tell">tell</a></code> mechanism to all family
+members. If <code>exe1</code> or <code>exe2</code> are given, they are executed
+as pre- or post-expressions while the database is <code><a
+href="refL.html#lock">lock</a></code>ed and <code><a
+href="refP.html#protect">protect</a></code>ed. See also <code><a
+href="refR.html#rollback">rollback</a></code>.
+
+<pre><code>
+: (pool "db")
+-> T
+: (put '{1} 'str "Hello")
+-> "Hello"
+: (commit)
+-> T
+</code></pre>
+
+<dt><a name="con"><code>(con 'lst 'any) -> any</code></a>
+<dd>Connects <code>any</code> to the first cell of <code>lst</code>, by
+(destructively) storing <code>any</code> in the CDR of <code>lst</code>. See
+also <code><a href="refC.html#conc">conc</a></code>.
+
+<pre><code>
+: (setq C (1 . a))
+-> (1 . a)
+: (con C '(b c d))
+-> (b c d)
+: C
+-> (1 b c d)
+</code></pre>
+
+<dt><a name="conc"><code>(conc 'lst ..) -> lst</code></a>
+<dd>Concatenates all argument lists (destructively). See also <code><a
+href="refA.html#append">append</a></code> and <code><a
+href="refC.html#con">con</a></code>.
+
+<pre><code>
+: (setq  A (1 2 3)  B '(a b c))
+-> (a b c)
+: (conc A B)                        # Concatenate lists in 'A' and 'B'
+-> (1 2 3 a b c)
+: A
+-> (1 2 3 a b c)                    # Side effect: List in 'A' is modified!
+</code></pre>
+
+<dt><a name="cond"><code>(cond ('any1 . prg1) ('any2 . prg2) ..) -> any</code></a>
+<dd>Multi-way conditional: If any of the <code>anyN</code> conditions evaluates
+to non-<code>NIL</code>, <code>prgN</code> is executed and the result returned.
+Otherwise (all conditions evaluate to <code>NIL</code>), <code>NIL</code> is
+returned. See also <code><a href="refN.html#nond">nond</a></code>, <code><a
+href="refI.html#if">if</a></code>, <code><a href="refI.html#if2">if2</a></code>
+and <code><a href="refW.html#when">when</a></code>.
+
+<pre><code>
+: (cond
+   ((= 3 4) (println 1))
+   ((= 3 3) (println 2))
+   (T (println 3)) )
+2
+-> 2
+</code></pre>
+
+<dt><a name="connect"><code>(connect 'any 'cnt) -> cnt | NIL</code></a>
+<dd>Tries to establish a TCP/IP connection to a server listening at host
+<code>any</code>, port <code>cnt</code>. <code>any</code> may be either a
+hostname or a standard internet address in numbers-and-dots notation. Returns a
+socket descriptor <code>cnt</code>, or <code>NIL</code> if the connection cannot
+be established. See also <code><a href="refL.html#listen">listen</a></code>.
+
+<pre><code>
+: (connect "localhost" 4444)
+-> 3
+</code></pre>
+
+<dt><a name="cons"><code>(cons 'any ['any ..]) -> lst</code></a>
+<dd>Constructs a new list cell with the first argument in the CAR and the second
+argument in the CDR. If more than two arguments are given, a corresponding chain
+of cells is built. <code>(cons 'a 'b 'c 'd)</code> is equivalent to <code>(cons
+'a (cons 'b (cons 'c 'd)))</code>. See also <code><a
+href="refL.html#list">list</a></code>.
+
+<pre><code>
+: (cons 1 2)
+-> (1 . 2)
+: (cons 'a '(b c d))
+-> (a b c d)
+: (cons '(a b) '(c d))
+-> ((a b) c d)
+: (cons 'a 'b 'c 'd)
+-> (a b c . d)
+</code></pre>
+
+<dt><a name="copy"><code>(copy 'any) -> any</code></a>
+<dd>Copies the argument <code>any</code>. For lists, the top level cells are
+copied, while atoms are returned unchanged.
+
+<pre><code>
+: (=T (copy T))               # Atoms are not copied
+-> T
+: (setq L (1 2 3))
+-> (1 2 3)
+: (== L L)
+-> T
+: (== L (copy L))             # The copy is not identical to the original
+-> NIL
+: (= L (copy L))              # But the copy is equal to the original
+-> T
+</code></pre>
+
+<dt><a name="count"><code>(count 'tree) -> num</code></a>
+<dd>Returns the number of nodes in a database tree. See also <code><a
+href="refT.html#tree">tree</a></code> and <code><a
+href="refR.html#root">root</a></code>.
+
+<pre><code>
+: (count (tree 'nr '+Item))
+-> 7
+</code></pre>
+
+<dt><a name="ctl"><code>(ctl 'sym . prg) -> any</code></a>
+<dd>Waits until a write (exclusive) lock (or a read (shared) lock if the first
+character of <code>sym</code> is "<code>+</code>") can be set on the file
+<code>sym</code>, then executes <code>prg</code> and releases the lock. If the
+files does not exist, it will be created. When <code>sym</code> is
+<code>NIL</code>, a shared lock is tried on the current innermost I/O channel,
+and when it is <code>T</code>, an exclusive lock is tried instead. See also
+<code><a href="refI.html#in">in</a></code>, <code><a
+href="refP.html#pipe">pipe</a></code> and <code><a
+href="refO.html#out">out</a></code>.
+
+<pre><code>
+$ echo 9 >count                           # Write '9' to file "count"
+$ ./dbg
+: (ctl ".ctl"                             # Exclusive control, using ".ctl"
+   (in "count"
+      (let Cnt (read)                     # Read '9'
+         (out "count"
+            (println (dec Cnt)) ) ) ) )   # Write '8'
+-> 8
+:
+$ cat count                               # Check "count"
+8
+</code></pre>
+
+<dt><a name="ctty"><code>(ctty 'sym|pid) -> flg</code></a>
+<dd>When called with a symbolic argument, <code>ctty</code> changes the current
+TTY device to <code>sym</code>. Otherwise, the local console is prepared for
+serving the PicoLisp process with the process ID <code>pid</code>. See also
+<code><a href="refR.html#raw">raw</a></code>.
+
+<pre><code>
+: (ctty "/dev/tty")
+-> T
+</code></pre>
+
+<dt><a name="curry"><code>(curry lst . fun) -> fun</code></a>
+<dd>Builds a new function from the list of symbols <code>lst</code> and the
+functional expression <code>fun</code>. Each member in <code>lst</code> that is
+a <code><a href="refP.html#pat?">pat?</a></code> symbol is substituted inside
+<code>fun</code> by its value. All other symbols in <code>lst</code> are
+collected into a <code><a href="refJ.html#job">job</a></code> environment.
+
+<pre><code>
+: (de multiplier (@X)
+   (curry (@X) (N) (* @X N)) )
+-> multiplier
+: (multiplier 7)
+-> ((N) (* 7 N))
+: ((multiplier 7) 3))
+-> 21
+
+: (let (N1 0  N2 1)
+   (def 'fiboCounter
+      (curry (N1 N2) (Cnt)
+         (do Cnt
+            (println
+               (prog1
+                  (+ N1 N2)
+                  (setq N1 N2  N2 @) ) ) ) ) ) )
+-> fiboCounter
+: (pp 'fiboCounter)
+(de fiboCounter (Cnt)
+   (job '((N2 . 1) (N1 . 0))
+      (do Cnt
+         (println
+            (prog1 (+ N1 N2) (setq N1 N2 N2 @)) ) ) ) )
+-> fiboCounter
+: (fiboCounter 5)
+1
+2
+3
+5
+8
+-> 8
+: (fiboCounter 5)
+13
+21
+34
+55
+89
+-> 89
+</code></pre>
+
+<dt><a name="cut"><code>(cut 'cnt 'var) -> lst</code></a>
+<dd>Pops the first <code>cnt</code> elements (CAR) from the stack in
+<code>var</code>. See also <code><a href="refP.html#pop">pop</a></code> and
+<code><a href="refD.html#del">del</a></code>.
+
+<pre><code>
+: (setq S '(1 2 3 4 5 6 7 8))
+-> (1 2 3 4 5 6 7 8)
+: (cut 3 'S)
+-> (1 2 3)
+: S
+-> (4 5 6 7 8)
+</code></pre>
+
+</dl>
+
+</body>
+</html>
diff --git a/doc/refD.html b/doc/refD.html
@@ -0,0 +1,748 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN" "http://www.w3.org/TR/1998/REC-html40-19980424/loose.dtd">
+<html lang="en">
+<head>
+<meta http-equiv="Content-Type" content="text/html; charset=utf-8">
+<title>D</title>
+<link rel="stylesheet" href="doc.css" type="text/css">
+</head>
+<body>
+
+<h1>D</h1>
+
+<dl>
+
+<dt><a name="*DB"><code>*DB</code></a>
+<dd>A global constant holding the external symbol <code>{1}</code>, the database
+root. All transient symbols in a database can be reached from that root. Except
+during debugging, any explicit literal access to symbols in the database should
+be avoided, because otherwise a memory leak might occur (The garbage collector
+temporarily sets <code>*DB</code> to <code>NIL</code> and restores its value
+after collection, thus disposing of all external symbols not currently used in
+the program).
+
+<pre><code>
+: (show *DB)
+{1} NIL
+   +City {P}
+   +Person {3}
+-> {1}
+: (show '{P})
+{P} NIL
+   nm (566 . {AhDx})
+-> {P}
+: (show '{3})
+{3} NIL
+   tel (681376 . {Agyl})
+   nm (1461322 . {2gu7})
+-> {3}
+</code></pre>
+
+<dt><a name="*Dbg"><code>*Dbg</code></a>
+<dd>A boolean variable indicating "debug mode". When non-<code>NIL</code>, the
+<code><a href="ref_.html#$">$</a></code> (tracing) and <code><a
+href="ref_.html#!">!</a></code> (breakpoint) functions are enabled, and the
+current line number and file name will be stored in symbol properties by
+<code><a href="refD.html#de">de</a></code>, <code><a
+href="refD.html#def">def</a></code> and <code><a
+href="refD.html#dm">dm</a></code>. See also <code><a
+href="refD.html#debug">debug</a></code>, <code><a
+href="refT.html#trace">trace</a></code> and <code><a
+href="refL.html#lint">lint</a></code>.
+
+<pre><code>
+: (de foo (A B) (* A B))
+-> foo
+: (trace 'foo)
+-> foo
+: (foo 3 4)
+ foo : 3 4
+ foo = 12
+-> 12
+: (let *Dbg NIL (foo 3 4))
+-> 12
+</code></pre>
+
+<dt><a name="*Dbs"><code>*Dbs</code></a>
+<dd>A global variable holding a list of numbers (block size scale factors, as
+needed by <code><a href="refP.html#pool">pool</a></code>). It is typically set
+by <code><a href="refD.html#dbs">dbs</a></code>
+and <code><a href="refD.html#dbs+">dbs+</a></code>.
+
+<pre><code>
+: *Dbs
+-> (1 2 1 0 2 3 3 3)
+</code></pre>
+
+<dt><a name="+Date"><code>+Date</code></a>
+<dd>Class for calender dates (as calculated by <code><a
+href="refD.html#date">date</a></code>), a subclass of <code><a
+href="refN.html#+Number">+Number</a></code>. See also <code><a
+href="ref.html#dbase">Database</a></code>.
+
+<pre><code>
+(rel dat (+Ref +Date))  # Indexed date
+</code></pre>
+
+<dt><a name="+Dep"><code>+Dep</code></a>
+<dd>Prefix class for maintaining depenencies between <code><a
+href="refR.html#+relation">+relation</a></code>s. Expects a list of (symbolic)
+attributes that depend on this relation. Whenever this relations is cleared
+(receives a value of <code>NIL</code>, or the whole entity is deleted with
+<code>lose&gt;</code>), the dependent relations will also be cleared, triggering
+all required side-effects. See also <code><a
+href="ref.html#dbase">Database</a></code>.
+
+<p>In the following example, the index entry for the item pointing to the
+position (and, therefore, to the order) is cleared in case the order is deleted,
+or this position is deleted from the order:
+
+<pre><code>
+(class +Pos +Entity)                # Position class
+(rel ord (+Dep +Joint)              # Order of that position
+   (itm)                               # 'itm' specifies the dependency
+   pos (+Ord) )                        # Arguments to '+Joint'
+(rel itm (+Ref +Link) NIL (+Item))  # Item depends on the order
+</code></pre>
+
+<dt><a name="d"><code>(d) -> T</code></a>
+<dd>Inserts <code><a href="ref_.html#!">!</a></code> breakpoints into all
+subexpressions of the current breakpoint. Typically used when single-stepping a
+function or method with <code><a href="refD.html#debug">debug</a></code>. See
+also <code><a href="refU.html#u">u</a></code> and <code><a
+href="refU.html#unbug">unbug</a></code>.
+
+<pre><code>
+! (d)                            # Debug subexpression(s) at breakpoint
+-> T
+</code></pre>
+
+<dt><a name="daemon"><code>(daemon 'sym . prg) -> fun</code></a>
+<dt><code>(daemon '(sym . cls) . prg) -> fun</code>
+<dt><code>(daemon '(sym sym2 [. cls]) . prg) -> fun</code>
+<dd>Inserts <code>prg</code> in the beginning of the function (first form), the
+method body of <code>sym</code> in <code>cls</code> (second form) or in the
+class obtained by <code><a href="refG.html#get">get</a></code>ing
+<code>sym2</code> from <code><a href="refC.html#*Class">*Class</a></code> (or
+<code>cls</code> if given) (third form). Built-in functions (C-function pointer)
+are automatically converted to Lisp expressions. See also <code><a
+href="refE.html#expr">expr</a></code>, <code><a
+href="refP.html#patch">patch</a></code> and <code><a
+href="refR.html#redef">redef</a></code>.
+
+<pre><code>
+: (de hello () (prinl "Hello world!"))
+-> hello
+
+: (daemon 'hello (prinl "# This is the hello world program"))
+-> (NIL (prinl "# This is the hello world program") (prinl "Hello world!"))
+: (hello)
+# This is the hello world program
+Hello world!
+-> "Hello world!"
+
+: (daemon '* (msg 'Multiplying))
+-> (@ (msg 'Multiplying) (pass $134532148))
+: *
+-> (@ (msg 'Multiplying) (pass $134532148))
+: (* 1 2 3)
+Multiplying
+-> 6
+</code></pre>
+
+<dt><a name="dat$"><code>(dat$ 'dat ['sym]) -> sym</code></a>
+<dd>Formats a <code><a href="refD.html#date">date</a></code> <code>dat</code> in
+ISO format, with an optional delimiter character <code>sym</code>. See also
+<code><a href="ref_.html#$dat">$dat</a></code>, <code><a
+href="refT.html#tim$">tim$</a></code>, <code><a
+href="refD.html#datStr">datStr</a></code> and <code><a
+href="refD.html#datSym">datSym</a></code>.
+
+<pre><code>
+: (dat$ (date))
+-> "20070601"
+: (dat$ (date) "-")
+-> "2007-06-01"
+</code></pre>
+
+<dt><a name="datStr"><code>(datStr 'dat ['flg]) -> sym</code></a>
+<dd>Formats a <code><a href="refD.html#date">date</a></code> according to the
+current <code><a href="refL.html#locale">locale</a></code>. If <code>flg</code>
+is non-<code>NIL</code>, the year will be formatted modulo 100. See also
+<code><a href="refD.html#dat$">dat$</a></code>, <code><a
+href="refD.html#datSym">datSym</a></code>, <code><a
+href="refS.html#strDat">strDat</a></code>, <code><a
+href="refE.html#expDat">expDat</a></code>, <code><a
+href="refE.html#expTel">expTel</a></code> and <code><a
+href="refD.html#day">day</a></code>.
+
+<pre><code>
+: (datStr (date))
+-> "2007-06-01"
+: (locale "DE" "de")
+-> NIL
+: (datStr (date))
+-> "01.06.2007"
+: (datStr (date) T)
+-> "01.06.07"
+</code></pre>
+
+<dt><a name="datSym"><code>(datSym 'dat) -> sym</code></a>
+<dd>Formats a <code><a href="refD.html#date">date</a></code> <code>dat</code> in
+in symbolic format (DDmmmYY). See also <code><a
+href="refD.html#dat$">dat$</a></code> and <code><a
+href="refD.html#datStr">datStr</a></code>.
+
+<pre><code>
+: (datSym (date))
+-> "01jun07"
+</code></pre>
+
+<dt><a name="date"><code>(date ['T]) -> dat</code></a>
+<dt><code>(date 'dat) -> (y m d)</code>
+<dt><code>(date 'y 'm 'd) -> dat | NIL</code>
+<dt><code>(date '(y m d)) -> dat | NIL</code>
+<dd>Calculates a (gregorian) calendar date, represented as the number of days
+since first of March in the year 0. When called without arguments, the current
+date is returned. When called with a <code>T</code> argument, the current
+Coordinated Universal Time (UTC) is returned. When called with a single number
+<code>dat</code>, it is taken as a date and a list with the corresponding year,
+month and day is returned. When called with three numbers (or a list of three
+numbers) for the year, month and day, the corresponding date is returned (or
+<code>NIL</code> if they do not represent a legal date). See also <code><a
+href="refT.html#time">time</a></code>, <code><a
+href="ref_.html#$dat">$dat</a></code>, <code><a
+href="refD.html#dat$">dat$</a></code>, <code><a
+href="refD.html#datSym">datSym</a></code>, <code><a
+href="refD.html#datStr">datStr</a></code>, <code><a
+href="refS.html#strDat">strDat</a></code>, <code><a
+href="refE.html#expDat">expDat</a></code>, <code><a
+href="refD.html#day">day</a></code>, <code><a
+href="refW.html#week">week</a></code> and <code><a
+href="refU.html#ultimo">ultimo</a></code>.
+
+<pre><code>
+: (date)                         # Today
+-> 730589
+: (date 2000 6 12)               # 12-06-2000
+-> 730589
+: (date 2000 22 5)               # Illegal date
+-> NIL
+: (date (date))                  # Today's year, month and day
+-> (2000 6 12)
+: (- (date) (date 2000 1 1))     # Number of days since first of January
+-> 163
+</code></pre>
+
+<dt><a name="day"><code>(day 'dat ['lst]) -> sym</code></a>
+<dd>Returns the name of the day for a given <code><a
+href="refD.html#date">date</a></code> <code>dat</code>, in the language of the
+current <code><a href="refL.html#locale">locale</a></code>. If <code>lst</code>
+is given, it should be a list of alternative weekday names. See also <code><a
+href="refW.html#week">week</a></code>, <code><a
+href="refD.html#datStr">datStr</a></code> and <code><a
+href="refS.html#strDat">strDat</a></code>.
+
+<pre><code>
+: (day (date))
+-> "Friday"
+: (locale "DE" "de")
+-> NIL
+: (day (date))
+-> "Freitag"
+: (day (date) '("Mo" "Tu" "We" "Th" "Fr" "Sa" "Su"))
+-> "Fr"
+</code></pre>
+
+<dt><a name="db"><code>(db 'var 'cls ['hook] 'any ['var 'any ..]) -> sym | NIL</code></a>
+<dd>Returns a database object of class <code>cls</code>, where the values for
+the <code>var</code> arguments correspond to the <code>any</code> arguments. If
+a matching object cannot be found, <code>NIL</code> is returned.
+<code>var</code>, <code>cls</code> and <code>hook</code> should specify a
+<code><a href="refT.html#tree">tree</a></code> for <code>cls</code> or one of
+its superclasses. See also <code><a href="refA.html#aux">aux</a></code>,
+<code><a href="refC.html#collect">collect</a></code>, <code><a
+href="refR.html#request">request</a></code>, <code><a
+href="refF.html#fetch">fetch</a></code>, <code><a
+href="refI.html#init">init</a></code> and <code><a
+href="refF.html#step">step</a></code>.
+
+<pre><code>
+: (db 'nr '+Item 1)
+-> {3-1}
+: (db 'nm '+Item "Main Part")
+-> {3-1}
+</code></pre>
+
+<dt><a name="db/3"><code>db/3</code></a>
+<dt><a name="db/4"><code>db/4</code></a>
+<dt><a name="db/5"><code>db/5</code></a>
+<dd><a href="ref.html#pilog">Pilog</a> database predicate that returns objects
+matching the given key/value (and optional hook) relation. The relation should
+be of type <code><a href="refI.html#+index">+index</a></code>. For the key
+pattern applies:
+
+<p><ul>
+<li>a symbol (string) returns all entries which start with that string
+<li>other atoms (numbers, external symbols) match as they are
+<li>cons pairs constitute a range, returning objects
+   <ul>
+   <li>in increasing order if the CDR is greater than the CAR
+   <li>in decreasing order otherwise
+   </ul>
+<li>other lists are matched for <code><a href="refA.html#+Aux">+Aux</a></code>
+key combinations
+</ul>
+
+<p>The optional hook can be supplied as the third argument. See also <code><a
+href="refS.html#select/3">select/3</a></code> and <code><a
+href="refR.html#remote/2">remote/2</a></code>.
+
+<pre><code>
+: (? (db nr +Item @Item))              # No value given
+ @Item={3-1}
+ @Item={3-2}
+ @Item={3-3}
+ @Item={3-4}
+ @Item={3-5}
+ @Item={3-6}
+-> NIL
+
+: (? (db nr +Item 2 @Item))            # Get item no. 2
+ @Item={3-2}
+-> NIL
+
+: (? (db nm +Item Spare @Item) (show @Item))  # Search for "Spare.."
+{3-2} (+Item)
+   pr 1250
+   inv 100
+   sup {2-2}
+   nm "Spare Part"
+   nr 2
+ @Item={3-2}
+-> NIL
+</code></pre>
+
+<dt><a name="db:"><code>(db: cls ..) -> num</code></a>
+<dd>Returns the database file number for objects of the type given by the
+<code>cls</code> argument(s). Needed, for example, for the creation of <code><a
+href="refN.html#new">new</a></code> objects. See also <code><a
+href="refD.html#dbs">dbs</a></code>.
+
+<pre><code>
+: (db: +Item)
+-> 3
+</code></pre>
+
+<dt><a name="dbSync"><code>(dbSync) -> flg</code></a>
+<dd>Starts a database transaction, by trying to obtain a <code><a
+href="refL.html#lock">lock</a></code> on the database root object <code><a
+href="refD.html#*DB">*DB</a></code>, and then calling <code><a
+href="refS.html#sync">sync</a></code> to synchronize with possible changes from
+other processes. When all desired modifications to external symbols are done,
+<code>(<a href="refC.html#commit">commit</a> 'upd)</code> should be called. See
+also <code><a href="ref.html#dbase">Database</a></code>.
+
+<pre><code>
+(let? Obj (rd)             # Get object?
+   (dbSync)                # Yes: Start transaction
+   (put> Obj 'nm (rd))     # Update
+   (put> Obj 'nr (rd))
+   (put> Obj 'val (rd))
+   (commit 'upd) )         # Close transaction
+</code></pre>
+
+<dt><a name="dbck"><code>(dbck ['cnt] 'flg) -> any</code></a>
+<dd>Performs a low-level integrity check of the current (or <code>cnt</code>'th)
+database file, and returns <code>NIL</code> (or the number of blocks and symbols
+if <code>flg</code> is non-<code>NIL</code>) if everything seems correct.
+Otherwise, a string indicating an error is returned. As a side effect, possibly
+unused blocks (as there might be when a <code><a
+href="refR.html#rollback">rollback</a></code> is done before <code><a
+href="refC.html#commit">commit</a></code>ing newly allocated (<code><a
+href="refN.html#new">new</a></code>) external symbols) are appended to the free
+list.
+
+<pre><code>
+: (pool "db")
+-> T
+: (dbck)
+-> NIL
+</code></pre>
+
+<dt><a name="dbs"><code>(dbs . lst)</code></a>
+<dd>Initializes the global variable <code><a
+href="refD.html#*Dbs">*Dbs</a></code>. Each element in <code>lst</code> has a
+number in its CAR (the block size scale factor of a database file, to be stored
+in <code>*Dbs</code>). The CDR elements are either classes (so that objects of
+that class are later stored in the corresponding file), or lists with a class in
+the CARs and a list of relations in the CDRs (so that index trees for these
+relations go into that file). See also <code><a
+href="refD.html#dbs+">dbs+</a></code> and <code><a
+href="refP.html#pool">pool</a></code>.
+
+<pre><code>
+(dbs
+   (1 +Role +User +Sal)                         # (1 . 128)
+   (2 +CuSu)                                    # (2 . 256)
+   (1 +Item +Ord)                               # (3 . 128)
+   (0 +Pos)                                     # (4 . 64)
+   (2 (+Role nm) (+User nm) (+Sal nm))          # (5 . 256)
+   (4 (+CuSu nr plz tel mob))                   # (6 . 1024)
+   (4 (+CuSu nm))                               # (7 . 1024)
+   (4 (+CuSu ort))                              # (8 . 1024)
+   (4 (+Item nr sup pr))                        # (9 . 1024)
+   (4 (+Item nm))                               # (10 . 1024)
+   (4 (+Ord nr dat cus))                        # (11 . 1024)
+   (4 (+Pos itm)) )                             # (12 . 1024)
+
+: *Dbs
+-> (1 2 1 0 2 4 4 4 4 4 4 4)
+: (get '+Item 'Dbf)
+-> (3 . 128)
+: (get '+Item 'nr 'dbf)
+-> (9 . 1024)
+</code></pre>
+
+<dt><a name="dbs+"><code>(dbs+ 'num . lst)</code></a>
+<dd>Extends the list of database sizes stored in <code><a
+href="refD.html#*Dbs">*Dbs</a></code>. <code>num</code> is the initial offset
+into the list. See also <code><a href="refD.html#dbs">dbs</a></code>.
+
+<pre><code>
+(dbs+ 9
+   (1 +NewCls)                                  # (9 . 128)
+   (3 (+NewCls nr nm)) )                        # (10 . 512)
+</code></pre>
+
+<dt><a name="de"><code>(de sym . any) -> sym</code></a>
+<dd>Assigns a definition to the <code>sym</code> argument, by setting its
+<code>VAL</code> to the <code>any</code> argument. If the symbol has already
+another value, a "redefined" message is issued. When the value of the global
+variable <a href="refD.html#*Dbg">*Dbg</a> is non-<code>NIL</code>, the current
+line number and file name (if any) are stored in the <code>*Dbg</code> property
+of <code>sym</code>. <code>de</code> is the standard way to define a function.
+See also <code><a href="refD.html#def">def</a></code>, <code><a
+href="refD.html#dm">dm</a></code> and <code><a
+href="refU.html#undef">undef</a></code>.
+
+<pre><code>
+: (de foo (X Y) (* X (+ X Y)))  # Define a function
+-> foo
+: (foo 3 4)
+-> 21
+
+: (de *Var . 123)  # Define a variable value
+: *Var
+-> 123
+</code></pre>
+
+<dt><a name="debug"><code>(debug 'sym) -> T</code></a>
+<dt><code>(debug 'sym 'cls) -> T</code>
+<dt><code>(debug '(sym . cls)) -> T</code>
+<dd>Inserts a <code><a href="ref_.html#!">!</a></code> breakpoint function call
+at the beginning and all top-level expressions of the function or method body of
+<code>sym</code>, to allow a stepwise execution. Typing <code>(<a
+href="refD.html#d">d</a>)</code> at a breakpoint will also debug the current
+subexpression, and <code>(<a href="refE.html#e">e</a>)</code> will evaluate the
+current subexpression. The current subexpression is stored in the global
+variable <code><a href="ref_.html#^">^</a></code>. See also <code><a
+href="refU.html#unbug">unbug</a></code>, <code><a
+href="refD.html#*Dbg">*Dbg</a></code>, <code><a
+href="refT.html#trace">trace</a></code> and <code><a
+href="refL.html#lint">lint</a></code>.
+
+<pre><code>
+: (de tst (N)                    # Define tst
+   (println (+ 3 N)) )
+-> tst
+: (debug 'tst)                   # Set breakpoints
+-> T
+: (pp 'tst)
+(de tst (N)
+   (! println (+ 3 N)) )         # Breakpoint '!'
+-> tst
+: (tst 7)                        # Execute
+(println (+ 3 N))                # Stopped at beginning of 'tst'
+! (d)                            # Debug subexpression
+-> T
+!                                # Continue
+(+ 3 N)                          # Stopped in subexpression
+! N                              # Inspect variable 'N'
+-> 7
+!                                # Continue
+10                               # Output of print statement
+-> 10                            # Done
+: (unbug 'tst)
+-> T
+: (pp 'tst)                      # Restore to original
+(de tst (N)
+   (println (+ 3 N)) )
+-> tst
+</code></pre>
+
+<dt><a name="dec"><code>(dec 'num) -> num</code></a>
+<dt><code>(dec 'var ['num]) -> num</code>
+<dd>The first form returns the value of <code>num</code> decremented by 1. The
+second form decrements the <code>VAL</code> of <code>var</code> by 1, or by
+<code>num</code>. If the first argument is <code>NIL</code>, it is returned
+immediately. <code>(dec 'num)</code> is equivalent to <code>(- 'num 1)</code>
+and <code>(dec 'var)</code> is equivalent to <code>(set 'var (- var 1))</code>.
+See also <code><a href="refI.html#inc">inc</a></code> and <code><a
+href="ref_.html#-">-</a></code>.
+
+<pre><code>
+: (dec -1)
+-> -2
+: (dec 7)
+-> 6
+: (setq N 7)
+-> 7
+: (dec 'N)
+-> 6
+: (dec 'N 3)
+-> 3
+</code></pre>
+
+<dt><a name="def"><code>(def 'sym 'any) -> sym</code></a>
+<dt><code>(def 'sym1 'sym2 'any) -> sym1</code>
+<dd>The first form assigns a definition to the first <code>sym</code> argument,
+by setting its <code>VAL</code>'s to <code>any</code>. The second form defines a
+property value <code>any</code> for the first argument's <code>sym2</code> key.
+If any of these values existed and was changed in the process, a "redefined"
+message is issued. When the value of the global variable <a
+href="refD.html#*Dbg">*Dbg</a> is non-<code>NIL</code>, the current line number
+and file name (if any) are stored in the <code>*Dbg</code> property of
+<code>sym</code>. See also <code><a href="refD.html#de">de</a></code> and
+<code><a href="refD.html#dm">dm</a></code>.
+
+<pre><code>
+: (def 'b '((X Y) (* X (+ X Y))))
+-> b
+: (def 'b 999)
+# b redefined
+-> b
+</code></pre>
+
+<dt><a name="default"><code>(default var 'any ..) -> any</code></a>
+<dd>Stores new values <code>any</code> in the <code>var</code> arguments only if
+their current values are <code>NIL</code>. Otherwise, their values are left
+unchanged. <code>default</code> is used typically in functions to initialize
+optional arguments.
+
+<pre><code>
+: (de foo (A B)               # Function with two optional arguments
+   (default  A 1  B 2)        # The default values are 1 and 2
+   (list A B) )
+-> foo
+: (foo 333 444)               # Called with two arguments
+-> (333 444)
+: (foo 333)                   # Called with one arguments
+-> (333 2)
+: (foo)                       # Called without arguments
+-> (1 2)
+</code></pre>
+
+<dt><a name="del"><code>(del 'any 'var) -> lst</code></a>
+<dd>Deletes <code>any</code> from the list in the value of <code>var</code>, and
+returns the remaining list. <code>(del 'any 'var)</code> is equivalent to
+<code>(set 'var (delete 'any var))</code>. See also <code><a
+href="refD.html#delete">delete</a></code>, <code><a
+href="refC.html#cut">cut</a></code> and <code><a
+href="refP.html#pop">pop</a></code>.
+
+<pre><code>
+: (setq S '((a b c) (d e f)))
+-> ((a b c) (d e f))
+: (del '(d e f) 'S)
+-> ((a b c))
+: (del 'b S)
+-> (a c)
+</code></pre>
+
+<dt><a name="delete"><code>(delete 'any 'lst) -> lst</code></a>
+<dd>Deletes <code>any</code> from <code>lst</code>. If <code>any</code> is
+contained more than once in <code>lst</code>, only the first occurrence is
+deleted. See also <code><a href="refD.html#delq">delq</a></code>, <code><a
+href="refR.html#remove">remove</a></code> and <code><a
+href="refI.html#insert">insert</a></code>.
+
+<pre><code>
+: (delete 2 (1 2 3))
+-> (1 3)
+: (delete (3 4) '((1 2) (3 4) (5 6) (3 4)))
+-> ((1 2) (5 6) (3 4))
+</code></pre>
+
+<dt><a name="delete/3"><code>delete/3</code></a>
+<dd><a href="ref.html#pilog">Pilog</a> predicate that succeeds if deleting the
+first argument from the list in the second argument is equal to the third
+argument. See also <code><a href="refD.html#delete">delete</a></code> and
+<code><a href="refM.html#member/2">member/2</a></code>.
+
+<pre><code>
+: (? (delete b (a b c) @X))
+ @X=(a c)
+-> NIL
+</code></pre>
+
+<dt><a name="delq"><code>(delq 'any 'lst) -> lst</code></a>
+<dd>Deletes <code>any</code> from <code>lst</code>. If <code>any</code> is
+contained more than once in <code>lst</code>, only the first occurrence is
+deleted. <code><a href="ref_.html#==">==</a></code> is used for comparison
+(pointer equality). See also <code><a href="refD.html#delete">delete</a></code>,
+<code><a href="refA.html#asoq">asoq</a></code>, <code><a
+href="refM.html#memq">memq</a></code>, <code><a
+href="refM.html#mmeq">mmeq</a></code> and <a href="ref.html#cmp">Comparing</a>.
+
+<pre><code>
+: (delq 'b '(a b c))
+-> (a c)
+: (delq (2) (1 (2) 3))
+-> (1 (2) 3)
+</code></pre>
+
+<dt><a name="dep"><code>(dep 'cls) -> cls</code></a>
+<dd>Displays the "dependencies" of <code>cls</code>, i.e. the tree of
+superclasses and the tree of subclasses. See also <code><a
+href="ref.html#oop">OO Concepts</a></code>, <code><a
+href="refC.html#class">class</a></code> and <code><a
+href="refC.html#can">can</a></code>.
+
+<pre><code>
+: (dep '+Number)           # Dependencies of '+Number'
+   +relation               # Single superclass is '+relation'
++Number
+   +Date                   # Subclasses are '+Date' and '+Time'
+   +Time
+-> +Number
+</code></pre>
+
+<dt><a name="depth"><code>(depth 'lst) -> (cnt1 . cnt2)</code></a>
+<dd>Returns the maximal (<code>cnt1</code>) and the average (<code>cnt2</code>)
+"depth" of a tree structure as maintained by <code><a
+href="refI.html#idx">idx</a></code>. See also <code><a
+href="refL.html#length">length</a></code> and <code><a
+href="refS.html#size">size</a></code>.
+
+<pre><code>
+: (off X)                                    # Clear variable
+-> NIL
+: (for N (1 2 3 4 5 6 7) (idx 'X N T))       # Build a degenerated tree
+-> NIL
+: X
+-> (1 NIL 2 NIL 3 NIL 4 NIL 5 NIL 6 NIL 7)   # Only right branches
+: (depth X)
+-> (7 . 4)                                   # Depth is 7, average 4
+</code></pre>
+
+<dt><a name="diff"><code>(diff 'lst 'lst) -> lst</code></a>
+<dd>Returns the difference of the <code>lst</code> arguments. See also <code><a
+href="refS.html#sect">sect</a></code>.
+
+<pre><code>
+: (diff (1 2 3 4 5) (2 4))
+-> (1 3 5)
+: (diff (1 2 3) (1 2 3))
+-> NIL
+</code></pre>
+
+<dt><a name="different/2"><code>different/2</code></a>
+<dd><a href="ref.html#pilog">Pilog</a> predicate that succeeds if the two
+arguments are different. See also <code><a
+href="refE.html#equal/2">equal/2</a></code>.
+
+<pre><code>
+: (? (different 3 4))
+-> T
+</code></pre>
+
+<dt><a name="dir"><code>(dir ['any]) -> lst</code></a>
+<dd>Returns a list of all filenames in the directory <code>any</code>. Names
+starting with a dot '<code>.</code>' are ignored. See also <code><a
+href="refC.html#cd">cd</a></code> and <code><a
+href="refI.html#info">info</a></code>.
+
+<pre><code>
+: (filter '((F) (tail '(. c) (chop F))) (dir "src/"))
+-> ("main.c" "subr.c" "gc.c" "io.c" "big.c" "sym.c" "tab.c" "flow.c" ..
+</code></pre>
+
+<dt><a name="dirname"><code>(dirname 'any) -> sym</code></a>
+<dd>Returns the directory part of a path name <code>any</code>.
+See also <code><a href="refP.html#path">path</a></code>.
+
+<pre><code>
+: (dirname "a/b/c/d")
+-> "a/b/c/"
+</code></pre>
+
+<dt><a name="dm"><code>(dm sym . fun|cls2) -> sym</code></a>
+<dt><code>(dm (sym . cls) . fun|cls2) -> sym</code>
+<dt><code>(dm (sym sym2 [. cls]) . fun|cls2) -> sym</code>
+<dd>Defines a method for the message <code>sym</code> in the current class,
+implicitly given by the value of the global variable <code><a
+href="refC.html#*Class">*Class</a></code>, or - in the second form - for the
+explicitly given class <code>cls</code>. In the third form, the class object is
+obtained by <code><a href="refG.html#get">get</a></code>ing <code>sym2</code>
+from <code><a href="refC.html#*Class">*Class</a></code> (or <code>cls</code> if
+given). If the method for that class existed and was changed in the process, a
+"redefined" message is issued. If - instead of a method <code>fun</code> - a
+symbol specifying another class <code>cls2</code> is given, the method from that
+class is used (explicit inheritance). When the value of the global variable <a
+href="refD.html#*Dbg">*Dbg</a> is non-<code>NIL</code>, the current line number
+and file name (if any) are stored in the <code>*Dbg</code> property of
+<code>sym</code>. See also <code><a href="ref.html#oop">OO Concepts</a></code>,
+<code><a href="refD.html#de">de</a></code>, <code><a
+href="refU.html#undef">undef</a></code>, <a href="refC.html#class">class</a>, <a
+href="refR.html#rel">rel</a>, <a href="refV.html#var">var</a>, <a
+href="refM.html#method">method</a>, <a href="refS.html#send">send</a> and <a
+href="refT.html#try">try</a>.
+
+<pre><code>
+: (dm start> ()
+   (super)
+   (mapc 'start> (: fields))
+   (mapc 'start> (: arrays)) )
+
+: (dm foo> . +OtherClass)  # Explicitly inherit 'foo>' from '+OtherClass'
+</code></pre>
+
+<dt><a name="do"><code>(do 'flg|num ['any | (NIL 'any . prg) | (T 'any . prg) ..]) -> any</code></a>
+<dd>Counted loop with multiple conditional exits: The body is executed at most
+<code>num</code> times (or never (if the first argument is <code>NIL</code>), or
+an infinite number of times (if the first argument is <code>T</code>)). If a
+clause has <code>NIL</code> or <code>T</code> as its CAR, the clause's second
+element is evaluated as a condition and - if the result is <code>NIL</code> or
+non-<code>NIL</code>, respectively - the <code>prg</code> is executed and the
+result returned. Otherwise (if count drops to zero), the result of the last
+expression is returned. See also <code><a href="refL.html#loop">loop</a></code>
+and <code><a href="refF.html#for">for</a></code>.
+
+<pre><code>
+: (do 4 (printsp 'OK))
+OK OK OK OK -> OK
+: (do 4 (printsp 'OK) (T (= 3 3) (printsp 'done)))
+OK done -> done
+</code></pre>
+
+<dt><a name="doc"><code>(doc 'sym1 ['sym2])</code></a>
+<dd>Opens a browser, and tries to display the reference documentation for
+<code>sym1</code>. <code>sym2</code> may be the name of a browser. If not given,
+the value of the environment variable <code>BROWSER</code>, or the
+<code>w3m</code> browser is tried. See also <code><a
+href="ref.html#fun">Function Reference</a></code> and <code><a
+href="refV.html#vi">vi</a></code>.
+
+<pre><code>
+: (doc '+)  # Function reference
+-> T
+: (doc '+relation)  # Class reference
+-> T
+:  (doc 'vi "firefox")  # Use alternative browser
+-> T
+</code></pre>
+
+</dl>
+
+</body>
+</html>
diff --git a/doc/refE.html b/doc/refE.html
@@ -0,0 +1,486 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN" "http://www.w3.org/TR/1998/REC-html40-19980424/loose.dtd">
+<html lang="en">
+<head>
+<meta http-equiv="Content-Type" content="text/html; charset=utf-8">
+<title>E</title>
+<link rel="stylesheet" href="doc.css" type="text/css">
+</head>
+<body>
+
+<h1>E</h1>
+
+<dl>
+
+<dt><a name="*Err"><code>*Err</code></a>
+<dd>A global variable holding a (possibly empty) <code>prg</code> body, which
+will be executed during error processing. See also <code><a
+href="ref.html#errors">Error Handling</a></code>, <code><a
+href="refM.html#*Msg">*Msg</a></code> and <code><a
+href="ref_.html#^">^</a></code>.
+
+<pre><code>
+: (de *Err (prinl "Fatal error!"))
+-> ((prinl "Fatal error!"))
+: (/ 3 0)
+!? (/ 3 0)
+Div/0
+Fatal error!
+$
+</code></pre>
+
+<dt><a name="*Ext"><code>*Ext</code></a>
+<dd>A global variable holding a sorted list of cons pairs. The CAR of each pair
+specifies an external symbol offset (suitable for <code><a
+href="refE.html#ext">ext</a></code>), and the CDR should be a function taking a
+single external symbol as an argument. This function should return a list, with
+the value for that symbol in its CAR, and the property list (in the format used
+by <code><a href="refG.html#getl">getl</a></code> and <code><a
+href="refP.html#putl">putl</a></code>) in its CDR. The symbol will be set to
+this value and property list upon access. Typically this function will access
+the corresponding symbol in a remote database process. See also <code><a
+href="refQ.html#qsym">qsym</a></code> and <code><a
+href="ref.html#external">external symbols</a></code>.
+
+<pre><code>
+### On the local machine ###
+: (setq *Ext  # Define extension functions
+   (mapcar
+      '((@Host @Ext)
+         (let Sock NIL
+            (cons @Ext
+               (curry (@Host @Ext Sock) (Obj)
+                  (when (or Sock (setq Sock (connect @Host 4040)))
+                     (ext @Ext
+                        (out Sock (pr (cons 'qsym Obj)))
+                        (prog1 (in Sock (rd))
+                           (unless @
+                              (close Sock)
+                              (off Sock) ) ) ) ) ) ) ) )
+      '("10.10.12.1" "10.10.12.2" "10.10.12.3" "10.10.12.4")
+      (20 40 60 80) ) )
+
+### On the remote machines ###
+(de go ()
+   ...
+   (task (port 4040)                      # Set up background query server
+      (let? Sock (accept @)               # Accept a connection
+         (unless (fork)                   # In child process
+            (in Sock
+               (while (rd)                # Handle requests
+                  (sync)
+                  (out Sock
+                     (pr (eval @)) ) ) )
+            (bye) )                       # Exit child process
+         (close Sock) ) )
+   (forked)                               # Close task in children
+   ...
+
+</code></pre>
+
+<dt><a name="+Entity"><code>+Entity</code></a>
+<dd>Base class of all database objects. See also <code><a
+href="refR.html#+relation">+relation</a></code> and <code><a
+href="ref.html#dbase">Database</a></code>.
+
+<p><a name="entityMesssages">Messages</a> to entity objects include
+
+<pre><code>
+zap> ()              # Clean up relational structures, for removal from the DB
+url> (Tab)           # Call the GUI on that object (in optional Tab)
+upd> (X Old)         # Callback method when object is created/modified/deleted
+has> (Var Val)       # Check if value is present
+put> (Var Val)       # Put a new value
+put!> (Var Val)      # Put a new value, single transaction
+del> (Var Val)       # Delete value (also partial)
+del!> (Var Val)      # Delete value (also partial), single transaction
+inc> (Var Val)       # Increment numeric value
+inc!> (Var Val)      # Increment numeric value, single transaction
+dec> (Var Val)       # Decrement numeric value
+dec!> (Var Val)      # Decrement numeric value, single transaction
+mis> (Var Val)       # Return error message if value or type mismatch
+lose1> (Var)         # Delete relational structures for a single attribute
+lose> (Lst)          # Delete relational structures (excluding 'Lst')
+lose!> ()            # Delete relational structures, single transaction
+keep1> (Var)         # Restore relational structures for single attribute
+keep> (Lst)          # Restore relational structures (excluding 'Lst')
+keep?> (Lst)         # Test for restauration (excluding 'Lst')
+keep!> ()            # Restore relational structures, single transaction
+set> (Val)           # Set the value (type, i.e. class list)
+set!> (Val)          # Set the value, single transaction
+clone> ()            # Object copy
+clone!> ()           # Object copy, single transaction
+</code></pre>
+
+<dt><a name="e"><code>(e . prg) -> any</code></a>
+<dd>Used in a breakpoint. Evaluates <code>prg</code> in the execution
+environment, or the currently executed expression if <code>prg</code> is not
+given. See also <code><a href="refD.html#debug">debug</a></code>, <code><a
+href="ref_.html#!">!</a></code>, <code><a href="ref_.html#^">^</a></code> and
+<code><a href="refD.html#*Dbg">*Dbg</a></code>.
+
+<pre><code>
+: (! + 3 4)
+(+ 3 4)
+! (e)
+-> 7
+</code></pre>
+
+<dt><a name="echo"><code>(echo ['cnt ['cnt]] | ['sym ..]) -> sym</code></a>
+<dd>Reads the current input channel, and writes to the current output channel.
+If <code>cnt</code> is given, only that many bytes are actually echoed. In case
+of two <code>cnt</code> arguments, the first one specifies the number of bytes
+to skip in the input stream. Otherwise, if one or more <code>sym</code>
+arguments are given, the echo process stops as soon as one of the symbol's names
+is encountered in the input stream (in that case, the name will be read (and
+that symbol returned), but not written). Returns non-<code>NIL</code> if the
+operation was successfully completed.
+
+<pre><code>
+: (in "x.l" (echo))  # Display file on console
+ ..
+
+: (out "x2.l" (in "x.l" (echo)))  # Copy file "x.l" to "x2.l"
+</code></pre>
+
+<dt><a name="edit"><code>(edit 'sym ..) -> NIL</code></a>
+<dd>Edits the value and property list of the argument symbol(s) by calling the
+<code>vim</code> editor on a temporary file with these data. When closing the
+editor, the modified data are read and stored into the symbol(s). During the
+edit session, individual symbols are separated by the pattern
+<code>(********)</code>. These separators should not be modified. When moving
+the cursor to the beginning of a symbol (no matter if internal, transient or
+external), and hitting '<code>K</code>', that symbol is added to the currently
+edited symbols. Hitting '<code>Q</code>' will go back one step and return to the
+previously edited list of symbols.
+
+<p><code>edit</code> is especially useful for browsing through the database
+(with '<code>K</code>' and '<code>Q</code>'), inspecting external symbols, but
+care must be taken when modifying any data as then the <a
+href="ref.html#er">entity/relation</a> mechanisms are circumvented, and
+<code><a href="refC.html#commit">commit</a></code> has to be called manually if
+the changes should be persistent.
+
+<p>Another typical use case is inserting or removing <code><a
+href="ref_.html#!">!</a></code> breakpoints at arbitrary code locations, or
+doing other temporary changes to the code for debugging purposes.
+
+<p>See also <code><a href="refU.html#update">update</a></code> and <code><a
+href="refS.html#show">show</a></code>.
+
+<pre><code>
+: (edit (db 'nr '+Item 1))  # Edit a database symbol
+### 'vim' shows this ###
+{3-1} (+Item)
+   nr 1
+   inv 100
+   pr 29900
+   sup {2-1}  # (+CuSu)
+   nm "Main Part"
+
+(********)
+### Hitting 'K' on the '{' of '{2-1} ###
+{2-1} (+CuSu)
+   nr 1
+   plz "3425"
+   mob "37 176 86303"
+   tel "37 4967 6846-0"
+   fax "37 4967 68462"
+   nm "Active Parts Inc."
+   nm2 "East Division"
+   ort "Freetown"
+   str "Wildcat Lane"
+   em "info@api.tld"
+
+(********)
+
+{3-1} (+Item)
+   nr 1
+   inv 100
+   pr 29900
+   sup {2-1}  # (+CuSu)
+   nm "Main Part"
+
+(********)
+### Entering ':q' in vim ###
+-> NIL
+</code></pre>
+
+<dt><a name="env"><code>(env ['lst] | ['sym 'val] ..) -> lst</code></a>
+<dd>Return a list of symbol-value pairs of all dynamically bound symbols if
+called without arguments, or of the symbols in <code>lst</code>, or the
+explicitly given <code>sym</code>-<code>val</code> arguments. See also <code><a
+href="refB.html#bind">bind</a></code> and <code><a
+href="refJ.html#job">job</a></code>.
+
+<pre><code>
+: (env)
+-> NIL
+: (let (A 1 B 2) (env))
+-> ((A . 1) (B . 2))
+: (let (A 1 B 2) (env '(A B)))
+-> ((B . 2) (A . 1))
+: (let (A 1 B 2) (env 'X 7 '(A B) 'Y 8))
+-> ((Y . 8) (B . 2) (A . 1) (X . 7))
+</code></pre>
+
+<dt><a name="eof"><code>(eof ['flg]) -> flg</code></a>
+<dd>Returns the end-of-file status of the current input channel. If
+<code>flg</code> is non-<code>NIL</code>, the channel's status is forced to
+end-of-file, so that the next call to <code>eof</code> will return
+<code>T</code>, and calls to <code><a href="refC.html#char">char</a></code>,
+<code><a href="refP.html#peek">peek</a></code>, <code><a
+href="refL.html#line">line</a></code>, <code><a
+href="refF.html#from">from</a></code>, <code><a
+href="refT.html#till">till</a></code>, <code><a
+href="refR.html#read">read</a></code> or <code><a
+href="refS.html#skip">skip</a></code> will return <code>NIL</code>. Note that
+<code>eof</code> cannot be used with the binary <code><a
+href="refR.html#rd">rd</a></code> function. See also <code><a
+href="refE.html#eol">eol</a></code>.
+
+<pre><code>
+: (in "file" (until (eof) (println (line T))))
+...
+</code></pre>
+
+<dt><a name="eol"><code>(eol) -> flg</code></a>
+<dd>Returns the end-of-line status of the current input channel.
+See also <code><a href="refE.html#eof">eof</a></code>.
+
+<pre><code>
+: (make (until (prog (link (read)) (eol))))  # Read line into a list
+a b c (d e f) 123
+-> (a b c (d e f) 123)
+</code></pre>
+
+<dt><a name="equal/2"><code>equal/2</code></a>
+<dd><a href="ref.html#pilog">Pilog</a> predicate that succeeds if the two
+arguments are equal. See also <code><a href="ref_.html#=">=</a></code>, <code><a
+href="refD.html#different/2">different/2</a></code> and <code><a
+href="refM.html#member/2">member/2</a></code>.
+
+<pre><code>
+: (? (equal 3 4))
+-> NIL
+: (? (equal @N 7))
+ @N=7
+-> NIL
+</code></pre>
+
+<dt><a name="errno"><code>(errno) -> cnt</code></a>
+<dd>(64-bit version only) Returns the value of the standard I/O 'errno'
+variable.
+
+<pre><code>
+: (in "foo")                           # Produce an error
+!? (in "foo")
+"foo" -- Open error: No such file or directory
+? (errno)
+-> 2                                   # Returned 'ENOENT'
+</code></pre>
+
+<dt><a name="eval"><code>(eval 'any ['cnt ['lst]]) -> any</code></a>
+<dd>Evaluates <code>any</code>. Note that because of the standard argument
+evaluation, <code>any</code> is actually evaluated twice. If a binding
+environment offset <code>cnt</code> is given, the second evaluation takes place
+in the corresponding environment, and an optional <code>lst</code> of excluded
+symbols can be supplied. See also <code><a href="refR.html#run">run</a></code>
+and <code><a href="refU.html#up">up</a></code>.
+
+<pre><code>
+: (eval (list '+ 1 2 3))
+-> 6
+: (setq X 'Y  Y 7)
+-> 7
+: X
+-> Y
+: Y
+-> 7
+: (eval X)
+-> 7
+</code></pre>
+
+<dt><a name="expDat"><code>(expDat 'sym) -> dat</code></a>
+<dd>Expands a <code><a href="refD.html#date">date</a></code> string according to
+the current <code><a href="refL.html#locale">locale</a></code> (delimiter, and
+order of year, month and day). Accepts abbreviated input, without delimiter and
+with only the day, or the day and month, or the day, month and year of current
+century. See also <code><a href="refD.html#datStr">datStr</a></code>, <code><a
+href="refD.html#day">day</a></code>, <code><a
+href="refE.html#expTel">expTel</a></code>.
+
+<pre><code>
+: (date)
+-> 733133
+: (date (date))
+-> (2007 5 31)
+: (expDat "31")
+-> 733133
+: (expDat "315")
+-> 733133
+: (expDat "3105")
+-> 733133
+: (expDat "31057")
+-> 733133
+: (expDat "310507")
+-> 733133
+: (expDat "2007-05-31")
+-> 733133
+: (expDat "7-5-31")
+-> 733133
+
+: (locale "DE" "de")
+-> NIL
+: (expDat "31.5")
+-> 733133
+: (expDat "31.5.7")
+-> 733133
+</code></pre>
+
+<dt><a name="expTel"><code>(expTel 'sym) -> sym</code></a>
+<dd>Expands a telephone number string. Multiple spaces or hyphens are coalesced.
+A leading <code>+</code> or <code>00</code> is removed, a leading <code>0</code>
+is replaced with the current country code. Otherwise, <code>NIL</code> is
+returned. See also <code><a href="refT.html#telStr">telStr</a></code>, <code><a
+href="refE.html#expDat">expDat</a></code> and <code><a
+href="refL.html#locale">locale</a></code>.
+
+<pre><code>
+: (expTel "+49 1234 5678-0")
+-> "49 1234 5678-0"
+: (expTel "0049 1234 5678-0")
+-> "49 1234 5678-0"
+: (expTel "01234 5678-0")
+-> NIL
+: (locale "DE" "de")
+-> NIL
+: (expTel "01234 5678-0")
+-> "49 1234 5678-0"
+</code></pre>
+
+<dt><a name="expr"><code>(expr 'sym) -> fun</code></a>
+<dd>Converts a C-function ("subr") to a Lisp-function. Useful only for normal
+functions (i.e. functions that evaluate all arguments). See also <code><a
+href="refS.html#subr">subr</a></code>.
+
+<pre><code>
+: car
+-> 67313448
+: (expr 'car)
+-> (@ (pass $385260187))
+: (car (1 2 3))
+-> 1
+</code></pre>
+
+<dt><a name="ext"><code>(ext 'cnt . prg) -> any</code></a>
+<dd>During the execution of <code>prg</code>, all <code><a
+href="ref.html#external">external symbols</a></code> processed by <code><a
+href="refR.html#rd">rd</a></code>, <code><a href="refP.html#pr">pr</a></code>,
+<code><a href="refR.html#rpc">rpc</a></code> or <code><a
+href="refU.html#udp">udp</a></code> are modified by an offset <code>cnt</code>
+suitable for mapping via the <code><a href="refE.html#*Ext">*Ext</a></code>
+mechanism. All external symbol's file numbers are decremented by
+<code>cnt</code> during output, and incremented by <code>cnt</code> during
+input.
+
+<pre><code>
+: (out 'a (ext 5 (pr '({6-2} ({8-9} . a) ({7-7} . b)))))
+-> ({6-2} ({8-9} . a) ({7-7} . b))
+
+: (in 'a (rd))
+-> ({2} ({3-9} . a) ({2-7} . b))
+
+: (in 'a (ext 5 (rd)))
+-> ({6-2} ({8-9} . a) ({7-7} . b))
+</code></pre>
+
+<dt><a name="ext?"><code>(ext? 'any) -> sym | NIL</code></a>
+<dd>Returns the argument <code>any</code> when it is an existing external
+symbol, otherwise <code>NIL</code>. See also <code><a
+href="refS.html#sym?">sym?</a></code>, <code><a
+href="refB.html#box?">box?</a></code>, <code><a
+href="refS.html#str?">str?</a></code>, <code><a
+href="refE.html#extern">extern</a></code> and <code><a
+href="refL.html#lieu">lieu</a></code>.
+
+<pre><code>
+: (ext? *DB)
+-> {1}
+: (ext? 'abc)
+-> NIL
+: (ext? "abc")
+-> NIL
+: (ext? 123)
+-> NIL
+</code></pre>
+
+<dt><a name="extend"><code>(extend cls) -> cls</code></a>
+<dd>Extends the class <code>cls</code>, by storing it in the global variable
+<code><a href="refC.html#*Class">*Class</a></code>. As a consequence, all
+following method, relation and class variable definitions are applied to that
+class. See also <code><a href="ref.html#oop">OO Concepts</a></code>, <code><a
+href="refC.html#class">class</a></code>, <code><a
+href="refD.html#dm">dm</a></code>, <code><a href="refV.html#var">var</a></code>,
+<code><a href="refR.html#rel">rel</a></code>, <code><a
+href="refT.html#type">type</a></code> and <code><a
+href="refI.html#isa">isa</a></code>.
+
+<pre><code>
+</code></pre>
+
+<dt><a name="extern"><code>(extern 'sym) -> sym | NIL</code></a>
+<dd>Creates or finds an external symbol. If a symbol with the name
+<code>sym</code> is already extern, it is returned. Otherwise, a new external
+symbol is returned. <code>NIL</code> is returned if <code>sym</code> does not
+exist in the database. See also <code><a
+href="refI.html#intern">intern</a></code> and <code><a
+href="refE.html#ext?">ext?</a></code>.
+
+<pre><code>
+: (extern "A1b")
+-> {A1b}
+: (extern "{A1b}")
+-> {A1b}
+</code></pre>
+
+<dt><a name="extra"><code>(extra ['any ..]) -> any</code></a>
+<dd>Can only be used inside methods. Sends the current message to the current
+object <code>This</code>, this time starting the search for a method at the
+remaining branches of the inheritance tree of the class where the current method
+was found. See also <code><a href="ref.html#oop">OO Concepts</a></code>,
+<code><a href="refS.html#super">super</a></code>, <code><a
+href="refM.html#method">method</a></code>, <code><a
+href="refM.html#meth">meth</a></code>, <code><a
+href="refS.html#send">send</a></code> and <code><a
+href="refT.html#try">try</a></code>.
+
+<pre><code>
+(dm key> (C)            # 'key>' method of the '+Uppc' class
+   (uppc (extra C)) )   # Convert 'key>' of extra classes to upper case
+</code></pre>
+
+<dt><a name="extract"><code>(extract 'fun 'lst ..) -> lst</code></a>
+<dd>Applies <code>fun</code> to each element of <code>lst</code>. When
+additional <code>lst</code> arguments are given, their elements are also passed
+to <code>fun</code>. Returns a list of all non-<code>NIL</code> values returned
+by <code>fun</code>. <code>(extract 'fun 'lst)</code> is equivalent to
+<code>(mapcar 'fun (filter 'fun 'lst))</code> or, for non-NIL results, to
+<code>(mapcan '((X) (and (fun X) (cons @))) 'lst)</code>. See also <code><a
+href="refF.html#filter">filter</a></code>, <code><a
+href="refF.html#find">find</a></code>, <code><a
+href="refP.html#pick">pick</a></code> and <code><a
+href="refM.html#mapcan">mapcan</a></code>.
+
+<pre><code>
+: (setq A NIL  B 1  C NIL  D 2  E NIL  F 3)
+-> 3
+: (filter val '(A B C D E F))
+-> (B D F)
+: (extract val '(A B C D E F))
+-> (1 2 3)
+</code></pre>
+
+</dl>
+
+</body>
+</html>
diff --git a/doc/refF.html b/doc/refF.html
@@ -0,0 +1,512 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN" "http://www.w3.org/TR/1998/REC-html40-19980424/loose.dtd">
+<html lang="en">
+<head>
+<meta http-equiv="Content-Type" content="text/html; charset=utf-8">
+<title>F</title>
+<link rel="stylesheet" href="doc.css" type="text/css">
+</head>
+<body>
+
+<h1>F</h1>
+
+<dl>
+
+<dt><a name="*Fork"><code>*Fork</code></a>
+<dd>A global variable holding a (possibly empty) <code>prg</code> body, to be
+executed after a call to <code><a href="refF.html#fork">fork</a></code> in the
+child process.
+
+<pre><code>
+: (push '*Fork '(off *Tmp))   # Clear '*Tmp' in child process
+-> (off *Tmp)
+</code></pre>
+
+<dt><a name="+Fold"><code>+Fold</code></a>
+<dd>Prefix class for maintaining <code><a
+href="refF.html#fold">fold</a></code>ed indexes to <code><a
+href="refS.html#+String">+String</a></code> relations. Typically used in
+combination with the <code><a href="refR.html#+Ref">+Ref</a></code> or <code><a
+href="refI.html#+Idx">+Idx</a></code> prefix classes. See also <code><a
+href="ref.html#dbase">Database</a></code>.
+
+<pre><code>
+(rel nm (+Fold +Idx +String))   # Item Description
+...
+(rel tel (+Fold +Ref +String))  # Phone number
+</code></pre>
+
+<dt><a name="fail"><code>(fail) -> lst</code></a>
+<dd>Constructs an empty <a href="ref.html#pilog">Pilog</a> query, i.e. a query
+that will aways fail. See also <code><a href="refG.html#goal">goal</a></code>.
+
+<pre><code>
+(dm clr> ()                # Clear query chart in search dialogs
+   (query> This (fail)) )
+</code></pre>
+
+<dt><a name="fail/0"><code>fail/0</code></a>
+<dd><a href="ref.html#pilog">Pilog</a> predicate that always fails. See also
+<code><a href="refT.html#true/0">true/0</a></code>.
+
+<pre><code>
+:  (? (fail))
+-> NIL
+</code></pre>
+
+<dt><a name="fetch"><code>(fetch 'tree 'any) -> any</code></a>
+<dd>Fetches a value for the key <code>any</code> from a database tree. See also
+<code><a href="refT.html#tree">tree</a></code> and <code><a
+href="refS.html#store">store</a></code>.
+
+<pre><code>
+: (fetch (tree 'nr '+Item) 2)
+-> {3-2}
+</code></pre>
+
+<dt><a name="fifo"><code>(fifo 'var ['any ..]) -> any</code></a>
+<dd>Implements a first-in-first-out structure using a circular list. When called
+with <code>any</code> arguments, they will be concatenated to end of the
+structure. Otherwise, the first element is removed from the structure and
+returned. See also <code><a href="refQ.html#queue">queue</a></code>, <code><a
+href="refP.html#push">push</a></code>, <code><a
+href="refP.html#pop">pop</a></code>, <code><a
+href="refR.html#rot">rot</a></code> and <code><a
+href="refC.html#circ">circ</a></code>.
+
+<pre><code>
+: (fifo 'X 1)
+-> 1
+: (fifo 'X 2 3)
+-> 3
+: X
+-> (3 1 2 .)
+: (fifo 'X)
+-> 1
+: (fifo 'X)
+-> 2
+: X
+-> (3 .)
+</code></pre>
+
+<dt><a name="file"><code>(file) -> (sym1 sym2 . num) | NIL</code></a>
+<dd>Returns for the current input channel the path name <code>sym1</code>, the
+file name <code>sym2</code>, and the current line number <code>num</code>. If
+the current input channel is not a file, <code>NIL</code> is returned. See also
+<code><a href="refI.html#info">info</a></code>, <code><a
+href="refI.html#in">in</a></code> and <code><a
+href="refL.html#load">load</a></code>.
+
+<pre><code>
+: (load (pack (car (file)) "localFile.l"))  # Load a file in same directory
+</code></pre>
+
+<dt><a name="fill"><code>(fill 'any ['sym|lst]) -> any</code></a>
+<dd>Fills a pattern <code>any</code>, by substituting <code>sym</code>, or all
+symbols in <code>lst</code>, or - if no second argument is given - each pattern
+symbol in <code>any</code> (see <code><a href="refP.html#pat?">pat?</a></code>),
+with its current value. In that case, <code>@</code> itself is not considered a
+pattern symbol. See also <code><a href="refM.html#match">match</a></code>.
+
+<pre><code>
+: (setq  @X 1234  @Y (1 2 3 4))
+-> (1 2 3 4)
+: (fill '@X)
+-> 1234
+: (fill '(a b (c @X) ((@Y . d) e)))
+-> (a b (c 1234) (((1 2 3 4) . d) e))
+: (let X 2 (fill (1 X 3) 'X))
+-> (1 2 3)
+</code></pre>
+
+<dt><a name="filter"><code>(filter 'fun 'lst ..) -> lst</code></a>
+<dd>Applies <code>fun</code> to each element of <code>lst</code>. When
+additional <code>lst</code> arguments are given, their elements are also passed
+to <code>fun</code>. Returns a list of all elements of <code>lst</code> where
+<code>fun</code> returned non-<code>NIL</code>. See also <code><a
+href="refF.html#fish">fish</a></code>, <code><a
+href="refF.html#find">find</a></code>, <code><a
+href="refP.html#pick">pick</a></code> and <code><a
+href="refE.html#extract">extract</a></code>.
+
+<pre><code>
+: (filter num? (1 A 2 (B) 3 CDE))
+-> (1 2 3)
+</code></pre>
+
+<dt><a name="fin"><code>(fin 'any) -> num|sym</code></a>
+<dd>Returns <code>any</code> if it is an atom, otherwise the CDR of its last
+cell. See also <code><a href="refL.html#last">last</a></code> and <code><a
+href="refT.html#tail">tail</a></code>.
+
+<pre><code>
+: (fin 'a)
+-> a
+: (fin '(a . b))
+-> b
+: (fin '(a b . c))
+-> c
+: (fin '(a b c))
+-> NIL
+</code></pre>
+
+<dt><a name="finally"><code>(finally exe . prg) -> any</code></a>
+<dd><code>prg</code> is executed, then <code>exe</code> is evaluated, and the
+result of <code>prg</code> is returned. <code>exe</code> will also be evaluated
+if <code>prg</code> does not terminate normally due to a runtime error or a call
+to <code><a href="refT.html#throw">throw</a></code>. See also <code><a
+href="refB.html#bye">bye</a></code>, <code><a
+href="refC.html#catch">catch</a></code>, <code><a
+href="refQ.html#quit">quit</a></code> and <code><a href="ref.html#errors">Error
+Handling</a></code>.
+
+<pre><code>
+: (finally (prinl "Done!")
+   (println 123)
+   (quit)
+   (println 456) )
+123
+Done!
+: (catch 'A
+   (finally (prinl "Done!")
+      (println 1)
+      (throw 'A 123)
+      (println 2) ) )
+1
+Done!
+-> 123
+</code></pre>
+
+<dt><a name="find"><code>(find 'fun 'lst ..) -> any</code></a>
+<dd>Applies <code>fun</code> to successive elements of <code>lst</code> until
+non-<code>NIL</code> is returned. Returns that element, or <code>NIL</code> if
+<code>fun</code> did not return non-<code>NIL</code> for any element of
+<code>lst</code>. When additional <code>lst</code> arguments are given, their
+elements are also passed to <code>fun</code>. See also <code><a
+href="refS.html#seek">seek</a></code>, <code><a
+href="refP.html#pick">pick</a></code> and <code><a
+href="refF.html#filter">filter</a></code>.
+
+<pre><code>
+: (find pair (1 A 2 (B) 3 CDE))
+-> (B)
+: (find '((A B) (> A B)) (1 2 3 4 5 6) (6 5 4 3 2 1))
+-> 4
+: (find > (1 2 3 4 5 6) (6 5 4 3 2 1))  # shorter
+-> 4
+</code></pre>
+
+<dt><a name="fish"><code>(fish 'fun 'any) -> lst</code></a>
+<dd>Applies <code>fun</code> to each element - and recursively to all sublists -
+of <code>lst</code>. Returns a list of all items where <code>fun</code> returned
+non-<code>NIL</code>. See also <code><a
+href="refF.html#filter">filter</a></code>.
+
+<pre><code>
+: (fish gt0 '(a -2 (1 b (-3 c 2)) 3 d -1))
+-> (1 2 3)
+: (fish sym? '(a -2 (1 b (-3 c 2)) 3 d -1))
+-> (a b c d)
+</code></pre>
+
+<dt><a name="flg?"><code>(flg? 'any) -> flg</code></a>
+<dd>Returns <code>T</code> when the argument <code>any</code> is either
+<code>NIL</code> or <code>T</code>. See also <code><a
+href="refB.html#bool">bool</a></code>. <code>(flg? X)</code> is equivalent to
+<code>(or (not X) (=T X))</code>.
+
+<pre><code>
+: (flg? (= 3 3))
+-> T
+: (flg? (= 3 4))
+-> T
+: (flg? (+ 3 4))
+-> NIL
+</code></pre>
+
+<dt><a name="flip"><code>(flip 'lst ['cnt]) -> lst</code></a>
+<dd>Returns <code>lst</code> (destructively) reversed. Without the optional
+<code>cnt</code> argument, the whole list is flipped, otherwise only the first
+<code>cnt</code> elements. See also <code><a
+href="refR.html#reverse">reverse</a></code> and <code><a
+href="refR.html#rot">rot</a></code>.
+
+<pre><code>
+: (flip (1 2 3 4))         # Flip all  four elements
+-> (4 3 2 1)
+: (flip (1 2 3 4 5 6) 3)   # Flip only the first three elements
+-> (3 2 1 4 5 6)
+</code></pre>
+
+<dt><a name="flush"><code>(flush) -> flg</code></a>
+<dd>Flushes the current output stream by writing all buffered data. A call to
+<code>flush</code> for standard output is done automatically before a call to
+<code><a href="refK.html#key">key</a></code>. Returns <code>T</code> when
+successful. See also <code><a href="refR.html#rewind">rewind</a></code>.
+
+<pre><code>
+: (flush)
+-> T
+</code></pre>
+
+<dt><a name="fmt64"><code>(fmt64 'num) -> sym</code></a>
+<dt><code>(fmt64 'sym) -> num</code>
+<dd>Converts a number <code>num</code> to a string in base-64 notation, or a
+base-64 formatted string to a number. The digits are represented with the
+characters <code>0</code> - <code>9</code>, <code>:</code>, <code>;</code>,
+<code>A</code> - <code>Z</code> and <code>a</code> - <code>z</code>. This format
+is used internally for the names of <code><a
+href="ref.html#external-io">external symbols</a></code> in the 32-bit version.
+See also <code><a href="refH.html#hax">hax</a></code>, <code><a
+href="refH.html#hex">hex</a></code> and <code><a
+href="refO.html#oct">oct</a></code>.
+
+<pre><code>
+: (fmt64 9)
+-> "9"
+: (fmt64 10)
+-> ":"
+: (fmt64 11)
+-> ";"
+: (fmt64 12)
+-> "A"
+: (fmt64 "100")
+-> 4096
+</code></pre>
+
+<dt><a name="fold"><code>(fold 'any ['cnt]) -> sym</code></a>
+<dd>Folding to a canonical form: If <code>any</code> is not a symbol,
+<code>NIL</code> is returned. Otherwise, a new transient symbol with all digits
+and all letters of <code>any</code>, converted to lower case, is returned. If
+the <code>cnt</code> argument is given, the result is truncated to that length
+(or not truncated if <code>cnt</code> is zero). Otherwise <code>cnt</code>
+defaults to 24. See also <code><a href="refL.html#lowc">lowc</a></code>.
+
+<pre><code>
+: (fold " 1A 2-b/3")
+-> "1a2b3"
+: (fold " 1A 2-B/3" 3)
+-> "1a2"
+</code></pre>
+
+<dt><a name="fold/3"><code>fold/3</code></a>
+<dd><a href="ref.html#pilog">Pilog</a> predicate that succeeds if the first
+argument, after <code><a href="refF.html#fold">fold</a></code>ing it to a
+canonical form, is a <i>prefix</i> of the folded string representation of the
+result of applying the <code><a href="refG.html#get">get</a></code> algorithm to
+the following arguments. Typically used as filter predicate in <code><a
+href="refS.html#select/3">select/3</a></code> database queries. See also
+<code><a href="refP.html#pre?">pre?</a></code>, <code><a
+href="refI.html#isa/2">isa/2</a></code>, <code><a
+href="refS.html#same/3">same/3</a></code>, <code><a
+href="refB.html#bool/3">bool/3</a></code>, <code><a
+href="refR.html#range/3">range/3</a></code>, <code><a
+href="refH.html#head/3">head/3</a></code>, <code><a
+href="refP.html#part/3">part/3</a></code> and <code><a
+href="refT.html#tolr/3">tolr/3</a></code>.
+
+<pre><code>
+: (?
+   @Nr (1 . 5)
+   @Nm "main"
+   (select (@Item)
+      ((nr +Item @Nr) (nm +Item @Nm))
+      (range @Nr @Item nr)
+      (fold @Nm @Item nm) ) )
+ @Nr=(1 . 5) @Nm="main" @Item={3-1}
+-> NIL
+</code></pre>
+
+<dt><a name="for"><code>(for sym 'num ['any | (NIL 'any . prg) | (T 'any . prg) ..]) -> any</code></a>
+<dt><code>(for sym|(sym2 . sym) 'lst ['any | (NIL 'any . prg) | (T 'any . prg) ..]) -> any</code>
+<dt><code>(for (sym|(sym2 . sym) 'any1 'any2 [. prg]) ['any | (NIL 'any . prg) | (T 'any . prg) ..]) -> any</code>
+<dd>Conditional loop with local variable(s) and multiple conditional exits: In
+the first form, the value of <code>sym</code> is saved, <code>sym</code> is
+bound to <code>1</code>, and the body is executed with increasing values up to
+(and including) <code>num</code>. In the second form, the value of
+<code>sym</code> is saved, <code>sym</code> is subsequently bound to the
+elements of <code>lst</code>, and the body is executed each time. In the third
+form, the value of <code>sym</code> is saved, and <code>sym</code> is bound to
+<code>any1</code>. If <code>sym2</code> is given, it is treated as a counter
+variable, first bound to 1 and then incremented for each execution of the body.
+While the condition <code>any2</code> evaluates to non-<code>NIL</code>, the
+body is repeatedly executed and, if <code>prg</code> is given, <code>sym</code>
+is re-bound to the result of its evaluation. If a clause has <code>NIL</code> or
+<code>T</code> as its CAR, the clause's second element is evaluated as a
+condition and - if the result is <code>NIL</code> or non-<code>NIL</code>,
+respectively - the <code>prg</code> is executed and the result returned. If the
+body is never executed, <code>NIL</code> is returned. See also <code><a
+href="refD.html#do">do</a></code> and <code><a
+href="refL.html#loop">loop</a></code>.
+
+<pre><code>
+: (for (N 1 (>= 8 N) (inc N)) (printsp N))
+1 2 3 4 5 6 7 8 -> 8
+: (for (L (1 2 3 4 5 6 7 8) L) (printsp (pop 'L)))
+1 2 3 4 5 6 7 8 -> 8
+: (for X (1 a 2 b) (printsp X))
+1 a 2 b -> b
+: (for ((I . L) '(a b c d e f) L (cddr L)) (println I L))
+1 (a b c d e f)
+2 (c d e f)
+3 (e f)
+-> (e f)
+: (for (I . X) '(a b c d e f) (println I X))
+1 a
+2 b
+3 c
+4 d
+5 e
+6 f
+-> f
+</code></pre>
+
+<dt><a name="fork"><code>(fork) -> pid | NIL</code></a>
+<dd>Forks a child process. Returns <code>NIL</code> in the child, and the
+child's process ID <code>pid</code> in the parent. In the child, the
+<code>VAL</code> of the global variable <code><a
+href="refF.html#*Fork">*Fork</a></code> (should be a <code>prg</code>) is
+executed. See also <code><a href="refP.html#pipe">pipe</a></code> and <code><a
+href="refT.html#tell">tell</a></code>.
+
+<pre><code>
+: (unless (fork) (do 5 (println 'OK) (wait 1000)) (bye))
+-> NIL
+OK                                              # Child's output
+: OK
+OK
+OK
+OK
+</code></pre>
+
+<dt><a name="forked"><code>(forked)</code></a>
+<dd>Installs maintenance code in <code><a
+href="refF.html#*Fork">*Fork</a></code> to close server sockets and clean up
+<code><a href="refR.html#*Run">*Run</a></code> code in child processes. Should
+only be called immediately after <code><a href="refT.html#task">task</a></code>.
+
+<pre><code>
+: (task -60000 60000 (msg 'OK))     # Install timer task
+-> (-60000 60000 (msg 'OK))
+: (forked)                          # No timer in child processes
+-> (task -60000)
+: *Run
+-> ((-60000 56432 (msg 'OK)))
+: *Fork
+-> ((task -60000) (del '(saveHistory) '*Bye))
+</code></pre>
+
+<dt><a name="format"><code>(format 'num ['cnt ['sym1 ['sym2]]]) -> sym</code></a>
+<dt><code>(format 'sym ['cnt ['sym1 ['sym2]]]) -> num</code>
+<dd>Converts a number <code>num</code> to a string, or a string <code>sym</code>
+to a number. In both cases, optionally a precision <code>cnt</code>, a
+decimal-separator <code>sym1</code> and a thousands-separator <code>sym2</code>
+can be supplied. Returns <code>NIL</code> if the conversion is unsuccessful. See
+also <code><a href="ref.html#num-io">Numbers</a></code>.
+
+<pre><code>
+: (format 123456789)                   # Integer conversion
+-> "123456789"
+: (format 123456789 2)                 # Fixed point
+-> "1234567.89"
+: (format 123456789 2 ",")             # Comma as decimal-separator
+-> "1234567,89"
+: (format 123456789 2 "," ".")         # and period as thousands-separator
+-> "1.234.567,89"
+
+: (format "123456789")                 # String to number
+-> 123456789
+: (format "1234567.89" 4)              # scaled to four digits
+-> 12345678900
+: (format "1.234.567,89")              # separators not recognized
+-> NIL
+: (format "1234567,89" 4 ",")
+-> 12345678900
+: (format "1.234.567,89" 4 ",")        # thousands-separator not recognized
+-> NIL
+: (format "1.234.567,89" 4 "," ".")
+-> 12345678900
+</code></pre>
+
+<dt><a name="free"><code>(free 'cnt) -> (sym . lst)</code></a>
+<dd>Returns, for the <code>cnt</code>'th database file, the next available
+symbol <code>sym</code> (i.e. the first symbol greater than any symbol in the
+database), and the list <code>lst</code> of free symbols. See also <code><a
+href="refS.html#seq">seq</a></code>, <code><a
+href="refZ.html#zap">zap</a></code> and <code><a
+href="refD.html#dbck">dbck</a></code>.
+
+<pre><code>
+: (pool "x")      # A new database
+-> T
+: (new T)         # Create a new symbol
+-> {2}
+: (new T)         # Create another symbol
+-> {3}
+: (commit)        # Commit changes
+-> T
+: (zap '{2})      # Delete the first symbol
+-> {2}
+: (free 1)        # Show free list
+-> ({4})          # {3} was the last symbol allocated
+: (commit)        # Commit the deletion of {2}
+-> T
+: (free 1)        # Now {2} is in the free list
+-> ({4} {2})
+</code></pre>
+
+<dt><a name="from"><code>(from 'any ..) -> sym</code></a>
+<dd>Skips the current input channel until one of the strings <code>any</code> is
+found, and starts subsequent reading from that point. The found <code>any</code>
+argument, or <code>NIL</code> (if none is found) is returned. See also <code><a
+href="refT.html#till">till</a></code> and <code><a
+href="refE.html#echo">echo</a></code>.
+
+<pre><code>
+: (and (from "val='") (till "'" T))
+test val='abc'
+-> "abc"
+</code></pre>
+
+<dt><a name="full"><code>(full 'any) -> bool</code></a>
+<dd>Returns <code>NIL</code> if <code>any</code> is a non-empty list with at
+least one <code>NIL</code> element, otherwise <code>T</code>. <code>(full
+X)</code> is equivalent to <code>(not (memq NIL X))</code>.
+
+<pre><code>
+: (full (1 2 3))
+-> T
+: (full (1 NIL 3))
+-> NIL
+: (full 123)
+-> T
+</code></pre>
+
+<dt><a name="fun?"><code>(fun? 'any) -> any</code></a>
+<dd>Returns <code>NIL</code> when the argument <code>any</code> is neither a
+number suitable for a code-pointer, nor a list suitable for a lambda expression
+(function). Otherwise a number is returned for a code-pointer, <code>T</code>
+for a function without arguments, and a single formal parameter or a list of
+formal parameters for a function. See also <code><a
+href="refG.html#getd">getd</a></code>.
+
+<pre><code>
+: (fun? 1000000000)              # Might be a code pointer
+-> 1000000000
+: (fun? 100000000000000)         # Too big for a code pointer
+-> NIL
+: (fun? 1000000001)              # Cannot be a code pointer (odd)
+-> NIL
+: (fun? '((A B) (* A B)))        # Lambda expression
+-> (A B)
+: (fun? '((A B) (* A B) . C))    # Not a lambda expression
+-> NIL
+: (fun? '(1 2 3 4))              # Not a lambda expression
+-> NIL
+: (fun? '((A 2 B) (* A B)))      # Not a lambda expression
+-> NIL
+</code></pre>
+
+</dl>
+
+</body>
+</html>
diff --git a/doc/refG.html b/doc/refG.html
@@ -0,0 +1,188 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN" "http://www.w3.org/TR/1998/REC-html40-19980424/loose.dtd">
+<html lang="en">
+<head>
+<meta http-equiv="Content-Type" content="text/html; charset=utf-8">
+<title>G</title>
+<link rel="stylesheet" href="doc.css" type="text/css">
+</head>
+<body>
+
+<h1>G</h1>
+
+<dl>
+
+<dt><a name="gc"><code>(gc ['cnt]) -> cnt | NIL</code></a>
+<dd>Forces a garbage collection. When <code>cnt</code> is given, so many
+megabytes of free cells are reserved, increasing the heap size if necessary. If
+<code>cnt</code> is zero, all currently unused heap blocks are purged,
+decreasing the heap size if possible. See also <code><a
+href="refH.html#heap">heap</a></code>.
+
+<pre><code>
+: (gc)
+-> NIL
+: (heap)
+-> 2
+: (gc 4)
+-> 4
+: (heap)
+-> 5
+</code></pre>
+
+<dt><a name="ge0"><code>(ge0 'any) -> num | NIL</code></a>
+<dd>Returns <code>num</code> when the argument is a number and greater or equal
+zero, otherwise <code>NIL</code>. See also <code><a
+href="refG.html#gt0">gt0</a></code>, <code><a
+href="refL.html#lt0">lt0</a></code>, <code><a href="ref_.html#=0">=0</a></code>
+and <code><a href="refN.html#n0">n0</a></code>.
+
+<pre><code>
+: (ge0 -2)
+-> NIL
+: (ge0 3)
+-> 3
+: (ge0 0)
+-> 0
+</code></pre>
+
+<dt><a name="genKey"><code>(genKey 'var 'cls ['hook ['num1 ['num2]]]) -> num</code></a>
+<dd>Generates a key for a database tree. If a minimal key <code>num1</code>
+and/or a maximal key <code>num2</code> is given, the next free number in that
+range is returned. Otherwise, the current maximal key plus one is returned. See
+also <code><a href="refU.html#useKey">useKey</a></code> and <code><a
+href="refM.html#maxKey">maxKey</a></code>.
+
+<pre><code>
+: (maxKey (tree 'nr '+Item))
+-> 8
+: (genKey 'nr '+Item)
+-> 9
+</code></pre>
+
+<dt><a name="get"><code>(get 'sym1|lst ['sym2|cnt ..]) -> any</code></a>
+<dd>Fetches a value <code>any</code> from the properties of a symbol, or from a
+list. From the first argument <code>sym1|lst</code>, values are retrieved in
+successive steps by either extracting the value (if the next argument is zero)
+or a property from a symbol, the <code><a
+href="refA.html#asoq">asoq</a></code>ed element (if the next argument is a
+symbol), the n'th element (if the next argument is a positive number) or the
+n'th CDR (if the next argument is a negative number) from a list. See also
+<code><a href="refP.html#put">put</a></code>, <code><a
+href="ref_.html#;">;</a></code> and <code><a href="ref_.html#:">:</a></code>.
+
+<pre><code>
+: (put 'X 'a 1)
+-> 1
+: (get 'X 'a)
+-> 1
+: (put 'Y 'link 'X)
+-> X
+: (get 'Y 'link)
+-> X
+: (get 'Y 'link 'a)
+-> 1
+: (get '((a (b . 1) (c . 2)) (d (e . 3) (f . 4))) 'a 'b)
+-> 1
+: (get '((a (b . 1) (c . 2)) (d (e . 3) (f . 4))) 'd 'f)
+-> 4
+: (get '(X Y Z) 2)
+-> Y
+: (get '(X Y Z) 2 'link 'a)
+-> 1
+</code></pre>
+
+<dt><a name="getd"><code>(getd 'any) -> fun | NIL</code></a>
+<dd>Returns <code>fun</code> if <code>any</code> is a symbol that has a function
+definition, otherwise <code>NIL</code>. See also <code><a
+href="refF.html#fun?">fun?</a></code>.
+
+<pre><code>
+: (getd '+)
+-> 67327232
+: (getd 'script)
+-> ((File . @) (load File))
+: (getd 1)
+-> NIL
+</code></pre>
+
+<dt><a name="getl"><code>(getl 'sym1|lst1 ['sym2|cnt ..]) -> lst</code></a>
+<dd>Fetches the complete property list <code>lst</code> from a symbol. That
+symbol is <code>sym1</code> (if no other arguments are given), or a symbol found
+by applying the <code><a href="refG.html#get">get</a></code> algorithm to
+<code>sym1|lst1</code> and the following arguments. See also <code><a
+href="refP.html#putl">putl</a></code> and <code><a
+href="refM.html#maps">maps</a></code>.
+
+<pre><code>
+: (put 'X 'a 1)
+-> 1
+: (put 'X 'b 2)
+-> 2
+: (put 'X 'flg T)
+-> T
+: (getl 'X)
+-> (flg (2 . b) (1 . a))
+</code></pre>
+
+<dt><a name="glue"><code>(glue 'any 'lst) -> sym</code></a>
+<dd>Builds a new transient symbol (string) by <code><a
+href="refP.html#pack">pack</a></code>ing the <code>any</code> argument between
+the individual elements of <code>lst</code>. See also <code><a
+href="refT.html#text">text</a></code>.
+
+<pre><code>
+: (glue "," '(a b c d))
+-> "a,b,c,d"
+</code></pre>
+
+<dt><a name="goal"><code>(goal '([pat 'any ..] . lst) ['sym 'any ..]) -> lst</code></a>
+<dd>Constructs a <a href="ref.html#pilog">Pilog</a> query list from the list of
+clauses <code>lst</code>. The head of the argument list may consist of a
+sequence of pattern symbols (Pilog variables) and expressions, which are used
+together with the optional <code>sym</code> and <code>any</code> arguments to
+form an initial environment. See also <code><a
+href="refP.html#prove">prove</a></code> and <code><a
+href="refF.html#fail">fail</a></code>.
+
+<pre><code>
+: (goal '((likes John @X)))
+-> (((1 (0) NIL ((likes John @X)) NIL T)))
+: (goal '(@X 'John (likes @X @Y)))
+-> (((1 (0) NIL ((likes @X @Y)) NIL ((0 . @X) 1 . John) T)))
+</code></pre>
+
+<dt><a name="group"><code>(group 'lst) -> lst</code></a>
+<dd>Builds a list of lists, by grouping all elements of <code>lst</code> with
+the same CAR into a common sublist. See also <a
+href="ref.html#cmp">Comparing</a>, <code><a
+href="refB.html#by">by</a></code>, <code><a
+href="refS.html#sort">sort</a></code> and <code><a
+href="refU.html#uniq">uniq</a></code>.
+
+<pre><code>
+: (group '((1 . a) (1 . b) (1 . c) (2 . d) (2 . e) (2 . f)))
+-> ((1 a b c) (2 d e f))
+: (by name group '("x" "x" "y" "z" "x" "z")))
+-> (("x" "x" "x") ("y") ("z" "z"))
+: (by length group '(123 (1 2) "abcd" "xyz" (1 2 3 4) "XY"))
+-> ((123 "xyz") ((1 2) "XY") ("abcd" (1 2 3 4))
+</code></pre>
+
+<dt><a name="gt0"><code>(gt0 'any) -> num | NIL</code></a>
+<dd>Returns <code>num</code> when the argument is a number and greater than
+zero, otherwise <code>NIL</code>. See also <code><a
+href="refG.html#ge0">ge0</a></code>, <code><a
+href="refL.html#lt0">lt0</a></code>, <code><a href="ref_.html#=0">=0</a></code>
+and <code><a href="refN.html#n0">n0</a></code>.
+
+<pre><code>
+: (gt0 -2)
+-> NIL
+: (gt0 3)
+-> 3
+</code></pre>
+
+</dl>
+
+</body>
+</html>
diff --git a/doc/refH.html b/doc/refH.html
@@ -0,0 +1,216 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN" "http://www.w3.org/TR/1998/REC-html40-19980424/loose.dtd">
+<html lang="en">
+<head>
+<meta http-equiv="Content-Type" content="text/html; charset=utf-8">
+<title>H</title>
+<link rel="stylesheet" href="doc.css" type="text/css">
+</head>
+<body>
+
+<h1>H</h1>
+
+<dl>
+
+<dt><a name="*Hup"><code>*Hup</code></a>
+<dd>Global variable holding a (possibly empty) <code>prg</code> body, which will
+be executed when a SIGHUP signal is sent to the current process. Note that this
+mechanism is "unreliable", in the way that when a second signal (it may be
+SIGINT, SIGUSR1/2, SIGALRM or SIGTERM) arrives before the first signal's
+<code>prg</code> is running, the first signal will be lost. See also <code><a
+href="refA.html#alarm">alarm</a></code>, <code><a
+href="refR.html#*Run">*Run</a></code>, <code><a
+href="refS.html#*Sig1">*Sig[12]</a></code> and <code><a
+href="refE.html#*Err">*Err</a></code>.
+
+<pre><code>
+: (de *Hup (msg 'SIGHUP))
+-> *Hup
+</code></pre>
+
+<dt><a name="+Hook"><code>+Hook</code></a>
+<dd>Prefix class for <code><a href="refR.html#+relation">+relation</a></code>s,
+typically <code><a href="refL.html#+Link">+Link</a></code> or <code><a
+href="refJ.html#+Joint">+Joint</a></code>. In essence, this maintains an local
+database in the referred object. See also <code><a
+href="ref.html#dbase">Database</a></code>.
+
+<pre><code>
+(rel Sup (+Hook +Link) (+Sup))   # Supplier
+(rel nr (+Key +Number) Sup)      # Item number, unique per supplier
+(rel dsc (+Ref +String) Sup)     # Item description, indexed per supplier
+</code></pre>
+
+<dt><a name="hax"><code>(hax 'num) -> sym</code></a>
+<dt><code>(hax 'sym) -> num</code>
+<dd>Converts a number <code>num</code> to a string in hexadecimal/alpha
+notation, or a hexadecimal/alpha formatted string to a number. The digits are
+represented with the characters <code>@</code> - <code>O</code> (from "alpha" to
+"omega"). This format is used internally for the names of <code><a
+href="ref.html#external-io">external symbols</a></code> in the 64-bit version.
+See also <code><a href="refF.html#fmt64">fmt64</a></code>, <code><a
+href="refH.html#hex">hex</a></code> and <code><a
+href="refO.html#oct">oct</a></code>.
+
+<pre><code>
+: (hax 7)
+-> <u>G</u>
+: (hax 16)
+-> <u>A@</u>
+: (hax 255)
+-> <u>OO</u>
+: (hax <u>A</u>)
+-> 1
+</code></pre>
+
+<dt><a name="hd"><code>(hd 'sym ['cnt]) -> NIL</code></a>
+<dd>Displays a hexadecimal dump of the file given by <code>sym</code>, limited
+to <code>cnt</code> lines. See also <code><a
+href="refP.html#proc">proc</a></code>.
+
+<pre><code>
+:  (hd "lib.l" 4)
+00000000  23 20 32 33 64 65 63 30 39 61 62 75 0A 23 20 28  # 23dec09abu.# (
+00000010  63 29 20 53 6F 66 74 77 61 72 65 20 4C 61 62 2E  c) Software Lab.
+00000020  20 41 6C 65 78 61 6E 64 65 72 20 42 75 72 67 65   Alexander Burge
+00000030  72 0A 0A 28 64 65 20 74 61 73 6B 20 28 4B 65 79  r..(de task (Key
+-> NIL
+</code></pre>
+
+<dt><a name="head"><code>(head 'cnt|lst 'lst) -> lst</code></a>
+<dd>Returns a new list made of the first <code>cnt</code> elements of
+<code>lst</code>. If <code>cnt</code> is negative, it is added to the length of
+<code>lst</code>. If the first argument is a <code>lst</code>, <code>head</code>
+is a predicate function returning that argument list if it is <code>equal</code>
+to the head of the second argument, and <code>NIL</code> otherwise. See also
+<code><a href="refT.html#tail">tail</a></code>.
+
+<pre><code>
+: (head 3 '(a b c d e f))
+-> (a b c)
+: (head 0 '(a b c d e f))
+-> NIL
+: (head 10 '(a b c d e f))
+-> (a b c d e f)
+: (head -2 '(a b c d e f))
+-> (a b c d)
+: (head '(a b c) '(a b c d e f))
+-> (a b c)
+</code></pre>
+
+<dt><a name="head/3"><code>head/3</code></a>
+<dd><a href="ref.html#pilog">Pilog</a> predicate that succeeds if the first
+(string) argument is a prefix of the string representation of the result of
+applying the <code><a href="refG.html#get">get</a></code> algorithm to the
+following arguments. Typically used as filter predicate in <code><a
+href="refS.html#select/3">select/3</a></code> database queries. See also
+<code><a href="refP.html#pre?">pre?</a></code>, <code><a
+href="refI.html#isa/2">isa/2</a></code>, <code><a
+href="refS.html#same/3">same/3</a></code>, <code><a
+href="refB.html#bool/3">bool/3</a></code>, <code><a
+href="refR.html#range/3">range/3</a></code>, <code><a
+href="refF.html#fold/3">fold/3</a></code>, <code><a
+href="refP.html#part/3">part/3</a></code> and <code><a
+href="refT.html#tolr/3">tolr/3</a></code>.
+
+<pre><code>
+: (?
+   @Nm <u>Muller</u>
+   @Tel <u>37</u>
+   (select (@CuSu)
+      ((nm +CuSu @Nm) (tel +CuSu @Tel))
+      (tolr @Nm @CuSu nm)
+      (head @Tel @CuSu tel) )
+   (val @Name @CuSu nm)
+   (val @Phone @CuSu tel) )
+ @Nm=<u>Muller</u> @Tel=<u>37</u> @CuSu={2-3} @Name=<u>Miller</u> @Phone=<u>37 4773 82534</u>
+-> NIL
+</code></pre>
+
+<dt><a name="heap"><code>(heap 'flg) -> cnt</code></a>
+<dd>Returns the total size of the cell heap space in megabytes. If
+<code>flg</code> is non-<code>NIL</code>, the size of the currently free space
+is returned. See also <code><a href="refG.html#gc">gc</a></code>.
+
+<pre><code>
+: (gc 4)
+-> 4
+: (heap)
+-> 5
+: (heap T)
+-> 4
+</code></pre>
+
+<dt><a name="hear"><code>(hear 'cnt) -> cnt</code></a>
+<dd>Uses the file descriptor <code>cnt</code> as an asynchronous command input
+channel. Any executable list received via this channel will be executed in the
+background. As this mechanism is also used for inter-family communication (see
+<code><a href="refT.html#tell">tell</a></code>), <code>hear</code> is usually
+only called explicitly by a top level parent process.
+
+<pre><code>
+: (call 'mkfifo <u>fifo/cmd</u>)
+-> T
+: (hear (open <u>fifo/cmd</u>))
+-> 3
+</code></pre>
+
+<dt><a name="here"><code>(here ['sym]) -> sym</code></a>
+<dd>Echoes the current input stream until <code>sym</code> is encountered, or
+until end of file. See also <code><a href="refE.html#echo">echo</a></code>.
+
+<pre><code>
+$ cat hello.l
+(html 0 <u>Hello</u> <u>lib.css</u> NIL
+   (&lt;h2&gt; NIL <u>Hello</u>)
+   (here) )
+&lt;p&gt;Hello!&lt;/p&gt;
+&lt;p&gt;This is a test.&lt;/p&gt;
+
+$ ./p lib/http.l lib/xhtml.l hello.l
+HTTP/1.0 200 OK
+Server: PicoLisp
+Date: Sun, 03 Jun 2007 11:41:27 GMT
+Cache-Control: max-age=0
+Cache-Control: no-cache
+Content-Type: text/html; charset=utf-8
+
+&lt;!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd"&gt;
+&lt;html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en"&gt;
+&lt;head&gt;
+&lt;title&gt;Hello&lt;/title&gt;
+&lt;link rel="stylesheet" href="http://:/lib.css" type="text/css"/&gt;
+&lt;/head&gt;
+&lt;body&gt;&lt;h2&gt;Hello&lt;/h2&gt;
+&lt;p&gt;Hello!&lt;/p&gt;
+&lt;p&gt;This is a test.&lt;/p&gt;
+&lt;/body&gt;
+&lt;/html&gt;
+</code></pre>
+
+<dt><a name="hex"><code>(hex 'num) -> sym</code></a>
+<dt><code>(hex 'sym) -> num</code>
+<dd>Converts a number <code>num</code> to a hexadecimal string, or a hexadecimal
+string <code>sym</code> to a number. See also <code><a
+href="refO.html#oct">oct</a></code> and <code><a
+href="refF.html#format">format</a></code>.
+
+<pre><code>
+: (hex 273)
+-> <u>111</u>
+: (hex <u>111</u>)
+-> 273
+</code></pre>
+
+<dt><a name="host"><code>(host 'any) -> sym</code></a>
+<dd>Returns the hostname corresponding to the given IP address. See also
+<code><a href="refA.html#*Adr">*Adr</a></code>.
+
+<pre><code>
+: (host <u>80.190.158.9</u>)
+-> <u>www.leo.org</u>
+</code></pre>
+
+</dl>
+
+</body>
+</html>
diff --git a/doc/refI.html b/doc/refI.html
@@ -0,0 +1,389 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN" "http://www.w3.org/TR/1998/REC-html40-19980424/loose.dtd">
+<html lang="en">
+<head>
+<meta http-equiv="Content-Type" content="text/html; charset=utf-8">
+<title>I</title>
+<link rel="stylesheet" href="doc.css" type="text/css">
+</head>
+<body>
+
+<h1>I</h1>
+
+<dl>
+
+<dt><a name="+Idx"><code>+Idx</code></a>
+<dd>Prefix class for maintaining non-unique full-text indexes to <code><a
+href="refS.html#+String">+String</a></code> relations, a subclass of <code><a
+href="refR.html#+Ref">+Ref</a></code>. Accepts optional arguments for the
+minimally indexed substring length (defaults to 3), and a <code><a
+href="refH.html#+Hook">+Hook</a></code> attribute. Often used in combination
+with the <code><a href="refS.html#+Sn">+Sn</a></code> soundex index, or the
+<code><a href="refF.html#+Fold">+Fold</a></code> index prefix classes. See also
+<code><a href="ref.html#dbase">Database</a></code>.
+
+<pre><code>
+(rel nm (+Sn +Idx +String))  # Name
+</code></pre>
+
+<dt><a name="+index"><code>+index</code></a>
+<dd>Abstract base class of all database B-Tree index relations (prefix classes
+for <code><a href="refR.html#+relation">+relation</a></code>s). The class
+hierarchy includes <code><a href="refK.html#+Key">+Key</a></code>, <code><a
+href="refR.html#+Ref">+Ref</a></code> and <code><a
+href="refI.html#+Idx">+Idx</a></code>. See also <code><a
+href="ref.html#dbase">Database</a></code>.
+
+<pre><code>
+(isa '+index Rel)  # Check for an index relation
+</code></pre>
+
+<dt><a name="id"><code>(id 'num ['num]) -> sym</code></a>
+<dt><code>(id 'sym [NIL]) -> num</code>
+<dt><code>(id 'sym T) -> (num . num)</code>
+<dd>Converts one or two numbers to an external symbol, or an external symbol to
+a number or a pair of numbers.
+
+<pre><code>
+: (id 7)
+-> {7}
+: (id 1 2)
+-> {2}
+: (id '{1-2})
+-> 2
+: (id '{1-2} T)
+-> (1 . 2)
+</code></pre>
+
+<dt><a name="idx"><code>(idx 'var 'any 'flg) -> lst<br>
+(idx 'var 'any) -> lst<br>
+(idx 'var) -> lst</code></a>
+<dd>Maintains an index tree in <code>var</code>, and checks for the existence of
+<code>any</code>. If <code>any</code> is contained in <code>var</code>, the
+corresponding subtree is returned, otherwise <code>NIL</code>. In the first
+form, <code>any</code> is destructively inserted into the tree if
+<code>flg</code> is non-<code>NIL</code> (and <code>any</code> was not already
+there), or deleted from the tree if <code>flg</code> is <code>NIL</code>. The
+second form only checks for existence, but does not change the index tree. In
+the third form (when called with a single <code>var</code> argument) the
+contents of the tree are returned as a sorted list. If all elements are inserted
+in sorted order, the tree degenerates into a linear list. See also <code><a
+href="refL.html#lup">lup</a></code>, <code><a
+href="refD.html#depth">depth</a></code>, <code><a
+href="refS.html#sort">sort</a></code>, <code><a
+href="refB.html#balance">balance</a></code> and <code><a
+href="refM.html#member">member</a></code>.
+
+<pre><code>
+: (idx 'X 'd T)                              # Insert data
+-> NIL
+: (idx 'X 2 T)
+-> NIL
+: (idx 'X '(a b c) T)
+-> NIL
+: (idx 'X 17 T)
+-> NIL
+: (idx 'X 'A T)
+-> NIL
+: (idx 'X 'd T)
+-> (d (2 NIL 17 NIL A) (a b c))              # 'd' already existed
+: (idx 'X T T)
+-> NIL
+: X                                          # View the index tree
+-> (d (2 NIL 17 NIL A) (a b c) NIL T)
+: (idx 'X 'A)                                # Check for 'A'
+-> (A)
+: (idx 'X 'B)                                # Check for 'B'
+-> NIL
+: (idx 'X)
+-> (2 17 A d (a b c) T)                      # Get list
+: (idx 'X 17 NIL)                            # Delete '17'
+-> (17 NIL A)
+: X
+-> (d (2 NIL A) (a b c) NIL T)               # View it again
+: (idx 'X)
+-> (2 A d (a b c) T)                         # '17' is deleted
+</code></pre>
+
+<dt><a name="if"><code>(if 'any1 'any2 . prg) -> any</code></a>
+<dd>Conditional execution: If the condition <code>any1</code> evaluates to
+non-<code>NIL</code>, <code>any2</code> is evaluated and returned. Otherwise,
+<code>prg</code> is executed and the result returned. See also <code><a
+href="refC.html#cond">cond</a></code>, <code><a
+href="refW.html#when">when</a></code> and <code><a
+href="refI.html#if2">if2</a></code>.
+
+<pre><code>
+: (if (> 4 3) (println 'OK) (println 'Bad))
+OK
+-> OK
+: (if (> 3 4) (println 'OK) (println 'Bad))
+Bad
+-> Bad
+</code></pre>
+
+<dt><a name="if2"><code>(if2 'any1 'any2 'any3 'any4 'any5 . prg) -> any</code></a>
+<dd>Four-way conditional execution for two conditions: If both conditions
+<code>any1</code> and <code>any2</code> evaluate to non-<code>NIL</code>,
+<code>any3</code> is evaluated and returned. Otherwise, <code>any4</code> or
+<code>any5</code> is evaluated and returned if <code>any1</code> or
+<code>any2</code> evaluate to non-<code>NIL</code>, respectively. If none of the
+conditions evaluate to non-<code>NIL</code>, <code>prg</code> is executed and
+the result returned. See also <code><a href="refI.html#if">if</a></code> and
+<code><a href="refC.html#cond">cond</a></code>.
+
+<pre><code>
+: (if2 T T 'both 'first 'second 'none)
+-> both
+: (if2 T NIL 'both 'first 'second 'none)
+-> first
+: (if2 NIL T 'both 'first 'second 'none)
+-> second
+: (if2 NIL NIL 'both 'first 'second 'none)
+-> none
+</code></pre>
+
+<dt><a name="ifn"><code>(ifn 'any1 'any2 . prg) -> any</code></a>
+<dd>Conditional execution ("If not"): If the condition <code>any1</code>
+evaluates to <code>NIL</code>, <code>any2</code> is evaluated and returned.
+Otherwise, <code>prg</code> is executed and the result returned.
+
+<pre><code>
+: (ifn (= 3 4) (println 'OK) (println 'Bad))
+OK
+-> OK
+</code></pre>
+
+<dt><a name="in"><code>(in 'any . prg) -> any</code></a>
+<dd>Opens <code>any</code> as input channel during the execution of
+<code>prg</code>. The current input channel will be saved and restored
+appropriately. If the argument is <code>NIL</code>, standard input is used. If
+the argument is a symbol, it is used as a file name (opened for reading
+<i>and</i> writing if the first character is "<code>+</code>"). If it is a
+positive number, it is used as the descriptor of an open file. If it is a
+negative number, the saved input channel such many levels above the current one
+is used. Otherwise (if it is a list), it is taken as a command with arguments,
+and a pipe is opened for input. See also <code><a
+href="refI.html#ipid">ipid</a></code>, <code><a
+href="refC.html#call">call</a></code>, <code><a
+href="refL.html#load">load</a></code>, <code><a
+href="refF.html#file">file</a></code>, <code><a
+href="refO.html#out">out</a></code>, <code><a
+href="refP.html#pipe">pipe</a></code> and <code><a
+href="refC.html#ctl">ctl</a></code>.
+
+<pre><code>
+: (in "a" (list (read) (read) (read)))  # Read three items from file "a"
+-> (123 (a b c) def)
+</code></pre>
+
+<dt><a name="inc"><code>(inc 'num) -> num<br>
+(inc 'var ['num]) -> num</code></a>
+<dd>The first form returns the value of <code>num</code> incremented by 1. The
+second form increments the <code>VAL</code> of <code>var</code> by 1, or by
+<code>num</code>. If the first argument is <code>NIL</code>, it is returned
+immediately. <code>(inc 'num)</code> is equivalent to <code>(+ 'num 1)</code>
+and <code>(inc 'var)</code> is equivalent to <code>(set 'var (+ var 1))</code>.
+See also <code><a href="refD.html#dec">dec</a></code> and <code><a
+href="ref_.html#+">+</a></code>.
+
+<pre><code>
+: (inc 7)
+-> 8
+: (inc -1)
+-> 0
+: (zero N)
+-> 0
+: (inc 'N)
+-> 1
+: (inc 'N 7)
+-> 8
+: N
+-> 8
+
+: (setq L (1 2 3 4))
+-> (1 2 3 4)
+: (inc (cdr L))
+-> 3
+: L
+-> (1 3 3 4)
+</code></pre>
+
+<dt><a name="inc!"><code>(inc! 'obj 'sym ['num]) -> num</code></a>
+<dd><a href="ref.html#trans">Transaction</a> wrapper function for <code><a
+href="refI.html#inc">inc</a></code>. <code>num</code> defaults to 1. Note that
+for incrementing a property value of an entity typically the <code><a
+href="refE.html#entityMesssages">inc!></a></code> message is used. See also
+<code><a href="refN.html#new!">new!</a></code>, <code><a
+href="refS.html#set!">set!</a></code> and <code><a
+href="refP.html#put!">put!</a></code>.
+
+<pre><code>
+(inc! Obj 'cnt 0)  # Incrementing a property of a non-entity object
+</code></pre>
+
+<dt><a name="index"><code>(index 'any 'lst) -> cnt | NIL</code></a>
+<dd>Returns the <code>cnt</code> position of <code>any</code> in
+<code>lst</code>, or <code>NIL</code> if it is not found. See also <code><a
+href="refO.html#offset">offset</a></code>.
+
+<pre><code>
+: (index 'c '(a b c d e f))
+-> 3
+: (index '(5 6) '((1 2) (3 4) (5 6) (7 8)))
+-> 3
+</code></pre>
+
+<dt><a name="info"><code>(info 'any) -> (cnt|T dat . tim)</code></a>
+<dd>Returns information about a file with the name <code>any</code>: The current
+size <code>cnt</code> in bytes, and the modification date and time (UTC). For
+directories, <code>T</code> is returned instead of the a size. See also <code><a
+href="refD.html#dir">dir</a></code>, <code><a
+href="refD.html#date">date</a></code>, <code><a
+href="refT.html#time">time</a></code> and <code><a
+href="refL.html#lines">lines</a></code>.
+
+<pre><code>
+$ ls -l x.l
+-rw-r--r--   1 abu      users         208 Jun 17 08:58 x.l
+$ ./dbg
+: (info "x.l")
+-> (208 730594 . 32315)
+: (stamp 730594 32315)
+-> "2000-06-17 08:58:35"
+</code></pre>
+
+<dt><a name="init"><code>(init 'tree ['any1] ['any2]) -> lst</code></a>
+<dd>Initializes a structure for stepping iteratively through a database tree.
+<code>any1</code> and <code>any2</code> may specify a range of keys. If
+<code>any2</code> is greater than <code>any1</code>, the traversal will be in
+opposite direction. See also <code><a href="refT.html#tree">tree</a></code>,
+<code><a href="refS.html#step">step</a></code>, <code><a
+href="refI.html#iter">iter</a></code> and <code><a
+href="refS.html#scan">scan</a></code>.
+
+<pre><code>
+: (init (tree 'nr '+Item) 3 5)
+-> (((3 . 5) ((3 NIL . {3-3}) (4 NIL . {3-4}) (5 NIL . {3-5}) (6 NIL . {3-6}) (7 NIL . {3-8}))))
+</code></pre>
+
+<dt><a name="insert"><code>(insert 'cnt 'lst 'any) -> lst</code></a>
+<dd>Inserts <code>any</code> into <code>lst</code> at position <code>cnt</code>.
+See also <code><a href="refR.html#remove">remove</a></code>, <code><a
+href="refP.html#place">place</a></code>, <code><a
+href="refA.html#append">append</a></code>, <code><a
+href="refD.html#delete">delete</a></code> and <code><a
+href="refR.html#replace">replace</a></code>.
+
+<pre><code>
+: (insert 3 '(a b c d e) 777)
+-> (a b 777 c d e)
+: (insert 1 '(a b c d e) 777)
+-> (777 a b c d e)
+: (insert 9 '(a b c d e) 777)
+-> (a b c d e 777)
+</code></pre>
+
+<dt><a name="intern"><code>(intern 'sym) -> sym</code></a>
+<dd>Creates or finds an internal symbol. If a symbol with the name
+<code>sym</code> is already intern, it is returned. Otherwise, <code>sym</code>
+is interned and returned. See also <code><a href="refZ.html#zap">zap</a></code>,
+<code><a href="refE.html#extern">extern</a></code> and <code><a
+href="ref_.html#====">====</a></code>.
+
+<pre><code>
+: (intern "abc")
+-> abc
+: (intern 'car)
+-> car
+: ((intern (pack "c" "a" "r")) (1 2 3))
+-> 1
+</code></pre>
+
+<dt><a name="ipid"><code>(ipid) -> pid | NIL</code></a>
+<dd>Returns the corresponding process ID when the current input channel is
+reading from a pipe, otherwise <code>NIL</code>. See also <code><a
+href="refO.html#opid">opid</a></code>, <code><a
+href="refI.html#in">in</a></code>, <code><a
+href="refP.html#pipe">pipe</a></code> and <code><a
+href="refL.html#load">load</a></code>.
+
+<pre><code>
+: (in '(ls "-l") (println (line T)) (kill (ipid)))
+"total 7364"
+-> T
+</code></pre>
+
+<dt><a name="isa"><code>(isa 'cls|typ 'obj) -> obj | NIL</code></a>
+<dd>Returns <code>obj</code> when it is an object that inherits from
+<code>cls</code> or <code>type</code>. See also <code><a href="ref.html#oop">OO
+Concepts</a></code>, <code><a href="refC.html#class">class</a></code>, <code><a
+href="refT.html#type">type</a></code>, <code><a
+href="refN.html#new">new</a></code> and <code><a
+href="refO.html#object">object</a></code>.
+
+<pre><code>
+: (isa '+Address Obj)
+-> {1-17}
+: (isa '(+Male +Person) Obj)
+-> NIL
+</code></pre>
+
+<dt><a name="isa/2"><code>isa/2</code></a>
+<dd><a href="ref.html#pilog">Pilog</a> predicate that succeeds if the second
+argument is of the type or class given by the first argument, according to the
+<code><a href="refI.html#isa">isa</a></code> function. Typically used in
+<code><a href="refD.html#db/3">db/3</a></code> or <code><a
+href="refS.html#select/3">select/3</a></code> database queries. See also
+<code><a href="refS.html#same/3">same/3</a></code>, <code><a
+href="refB.html#bool/3">bool/3</a></code>, <code><a
+href="refR.html#range/3">range/3</a></code>, <code><a
+href="refH.html#head/3">head/3</a></code>, <code><a
+href="refF.html#fold/3">fold/3</a></code>, <code><a
+href="refP.html#part/3">part/3</a></code> and <code><a
+href="refT.html#tolr/3">tolr/3</a></code>.
+
+<pre><code>
+: (? (db nm +Person @Prs) (isa +Woman @Prs) (val @Nm @Prs nm))
+ @Prs={2-Y} @Nm="Alexandra of Denmark"
+ @Prs={2-1I} @Nm="Alice Maud Mary"
+ @Prs={2-F} @Nm="Anne"
+ @Prs={2-j} @Nm="Augusta Victoria".   # Stop
+</code></pre>
+
+<dt><a name="iter"><code>(iter 'tree ['fun] ['any1] ['any2] ['flg])</code></a>
+<dd>Iterates through a database tree by applying <code>fun</code> to all values.
+<code>fun</code> defaults to <code><a
+href="refP.html#println">println</a></code>. <code>any1</code> and
+<code>any2</code> may specify a range of keys. If <code>any2</code> is greater
+than <code>any1</code>, the traversal will be in opposite direction. If
+<code>flg</code> is non-<code>NIL</code>, partial keys are skipped. See also
+<code><a href="refT.html#tree">tree</a></code>, <code><a
+href="refS.html#scan">scan</a></code>, <code><a
+href="refI.html#init">init</a></code> and <code><a
+href="refS.html#step">step</a></code>.
+
+<pre><code>
+: (iter (tree 'nr '+Item))
+{3-1}
+{3-2}
+{3-3}
+{3-4}
+{3-5}
+{3-6}
+{3-8}
+-> {7-1}
+: (iter (tree 'nr '+Item) '((This) (println (: nm))))
+"Main Part"
+"Spare Part"
+"Auxiliary Construction"
+"Enhancement Additive"
+"Metal Fittings"
+"Gadget Appliance"
+"Testartikel"
+-> {7-1}
+</code></pre>
+
+</dl>
+
+</body>
+</html>
diff --git a/doc/refJ.html b/doc/refJ.html
@@ -0,0 +1,81 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN" "http://www.w3.org/TR/1998/REC-html40-19980424/loose.dtd">
+<html lang="en">
+<head>
+<meta http-equiv="Content-Type" content="text/html; charset=utf-8">
+<title>J</title>
+<link rel="stylesheet" href="doc.css" type="text/css">
+</head>
+<body>
+
+<h1>J</h1>
+
+<dl>
+
+<dt><a name="+Joint"><code>+Joint</code></a>
+<dd>Class for bidirectional object relations, a subclass of <code><a
+href="refL.html#+Link">+Link</a></code>. Expects a (symbolic) attribute, and
+list of classes as <code><a href="refT.html#type">type</a></code> of the
+referred database object (of class <code><a
+href="refE.html#+Entity">+Entity</a></code>). A <code>+Joint</code> corresponds
+to two <code>+Link</code>s, where the attribute argument is the relation of the
+back-link in the referred object. See also <code><a
+href="ref.html#dbase">Database</a></code>.
+
+<pre><code>
+(class +Ord +Entity)                   # Order class
+(rel pos (+List +Joint) ord (+Pos))    # List of positions in that order
+...
+(class +Pos +Entity)    # Position class
+(rel ord (+Joint)       # Back-link to the parent order
+</code></pre>
+
+<dt><a name="job"><code>(job 'lst . prg) -> any</code></a>
+<dd>Executes a job within its own environment (as specified by symbol-value
+pairs in <code>lst</code>). The current values of all symbols are saved, the
+symbols are bound to the values in <code>lst</code>, <code>prg</code> is
+executed, then the (possibly modified) symbol values are (destructively) stored
+in the environment list, and the symbols are restored to their original values.
+The return value is the result of <code>prg</code>. Typically used in <code><a
+href="refC.html#curry">curried</a></code> functions and <code><a
+href="refR.html#*Run">*Run</a></code> tasks. See also <code><a
+href="refE.html#env">env</a></code>, <code><a
+href="refB.html#bind">bind</a></code>, <code><a
+href="refL.html#let">let</a></code>, <code><a
+href="refU.html#use">use</a></code> and <code><a
+href="refS.html#state">state</a></code>.
+
+<pre><code>
+: (de tst ()
+   (job '((A . 0) (B . 0))
+      (println (inc 'A) (inc 'B 2)) ) )
+-> tst
+: (tst)
+1 2
+-> 2
+: (tst)
+2 4
+-> 4
+: (tst)
+3 6
+-> 6
+: (pp 'tst)
+(de tst NIL
+   (job '((A . 3) (B . 6))
+      (println (inc 'A) (inc 'B 2)) ) )
+-> tst
+</code></pre>
+
+<dt><a name="journal"><code>(journal 'any ..) -> T</code></a>
+<dd>Reads journal data from the files with the names <code>any</code>, and
+writes all changes to the database. See also <code><a
+href="refP.html#pool">pool</a></code>.
+
+<pre><code>
+: (journal <u>db.log</u>)
+-> T
+</code></pre>
+
+</dl>
+
+</body>
+</html>
diff --git a/doc/refK.html b/doc/refK.html
@@ -0,0 +1,58 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN" "http://www.w3.org/TR/1998/REC-html40-19980424/loose.dtd">
+<html lang="en">
+<head>
+<meta http-equiv="Content-Type" content="text/html; charset=utf-8">
+<title>K</title>
+<link rel="stylesheet" href="doc.css" type="text/css">
+</head>
+<body>
+
+<h1>K</h1>
+
+<dl>
+
+<dt><a name="+Key"><code>+Key</code></a>
+<dd>Prefix class for maintaining unique indexes to <code><a
+href="refR.html#+relation">+relation</a></code>s, a subclass of <code><a
+href="refI.html#+index">+index</a></code>. Accepts an optional argument for a
+<code><a href="refH.html#+Hook">+Hook</a></code> attribute. See also <code><a
+href="ref.html#dbase">Database</a></code>.
+
+<pre><code>
+(rel nr (+Need +Key +Number))  # Mandatory, unique Customer/Supplier number
+</code></pre>
+
+<dt><a name="key"><code>(key ['cnt]) -> sym</code></a>
+<dd>Returns the next character from standard input as a single-character
+transient symbol. The console is set to raw mode. While waiting for a key press,
+a <code>select</code> system call is executed for all file descriptors and
+timers in the <code>VAL</code> of the global variable <code><a
+href="refR.html#*Run">*Run</a></code>. If <code>cnt</code> is
+non-<code>NIL</code>, that amount of milliseconds is waited maximally, and
+<code>NIL</code> is returned upon timeout. See also <code><a
+href="refR.html#raw">raw</a></code> and <code><a
+href="refW.html#wait">wait</a></code>.
+
+<pre><code>
+: (key)                    # Wait for a key
+-> <u>a</u>                       # 'a' pressed
+</code></pre>
+
+<dt><a name="kill"><code>(kill 'pid ['cnt]) -> flg</code></a>
+<dd>Sends a signal with the signal number <code>cnt</code> (or SIGTERM if
+<code>cnt</code> is not given) to the process with the ID <code>pid</code>.
+Returns <code>T</code> if successful.
+
+<pre><code>
+: (kill *Pid 20)                                # Stop current process
+
+[2]+  Stopped               bin/picolisp        # Unix shell
+$ fg                                            # Job control: Foreground
+bin/picolisp
+-> T                                            # 'kill' was successful
+</code></pre>
+
+</dl>
+
+</body>
+</html>
diff --git a/doc/refL.html b/doc/refL.html
@@ -0,0 +1,531 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN" "http://www.w3.org/TR/1998/REC-html40-19980424/loose.dtd">
+<html lang="en">
+<head>
+<meta http-equiv="Content-Type" content="text/html; charset=utf-8">
+<title>L</title>
+<link rel="stylesheet" href="doc.css" type="text/css">
+</head>
+<body>
+
+<h1>L</h1>
+
+<dl>
+
+<dt><a name="*Led"><code>*Led</code></a>
+<dd>A global variable holding a (possibly empty) <code>prg</code> body that
+implements a "Line editor". When non-<code>NIL</code>, it should return a single
+symbol (string) upon execution.
+
+<pre><code>
+: (de *Led "(bye)")
+# *Led redefined
+-> *Led
+: $                                    # Exit
+</code></pre>
+
+<dt><a name="+Link"><code>+Link</code></a>
+<dd>Class for object relations, a subclass of <code><a
+href="refR.html#+relation">+relation</a></code>. Expects a list of classes as
+<code><a href="refT.html#type">type</a></code> of the referred database object
+(of class <code><a href="refE.html#+Entity">+Entity</a></code>). See also
+<code><a href="ref.html#dbase">Database</a></code>.
+
+<pre><code>
+(rel sup (+Ref +Link) NIL (+CuSu))  # Supplier (class Customer/Supplier)
+</code></pre>
+
+<dt><a name="+List"><code>+List</code></a>
+<dd>Prefix class for a list of identical relations. Objects of that class
+maintain a list of Lisp data of uniform type. See also <code><a
+href="ref.html#dbase">Database</a></code>.
+
+<pre><code>
+(rel pos (+List +Joint) ord (+Pos))  # Positions
+(rel nm (+List +Fold +Ref +String))  # List of folded and indexed names
+(rel val (+Ref +List +Number))       # Indexed list of numeric values
+</code></pre>
+
+<dt><a name="last"><code>(last 'lst) -> any</code></a>
+<dd>Returns the last element of <code>lst</code>. See also <code><a
+href="refF.html#fin">fin</a></code> and <code><a
+href="refT.html#tail">tail</a></code>.
+
+<pre><code>
+: (last (1 2 3 4))
+-> 4
+: (last '((a b) c (d e f)))
+-> (d e f)
+</code></pre>
+
+<dt><a name="later"><code>(later 'var . prg) -> var</code></a>
+<dd>Executes <code>prg</code> in a <code><a
+href="refP.html#pipe">pipe</a></code>'ed child process. The return value of
+<code>prg</code> will later be available in <code>var</code>.
+
+<pre><code>
+: (prog1  # Parallel background calculation of square numbers
+   (mapcan '((N) (later (cons) (* N N))) (1 2 3 4))
+   (wait NIL (full @)) )
+-> (1 4 9 16)
+</code></pre>
+
+<dt><a name="ld"><code>(ld) -> any</code></a>
+<dd><code><a href="refL.html#load">load</a></code>s the last file edited with
+<code><a href="refV.html#vi">vi</a></code>.
+
+<pre><code>
+: (vi 'main)
+-> T
+: (ld)
+# main redefined
+-> go
+</code></pre>
+
+<dt><a name="leaf"><code>(leaf 'tree) -> any</code></a>
+<dd>Returns the first leaf (i.e. the value of the smallest key) in a database
+tree. See also <code><a href="refT.html#tree">tree</a></code>, <code><a
+href="refM.html#minKey">minKey</a></code>, <code><a
+href="refM.html#maxKey">maxKey</a></code> and <code><a
+href="refS.html#step">step</a></code>.
+
+<pre><code>
+: (leaf (tree 'nr '+Item))
+-> {3-1}
+: (db 'nr '+Item (minKey (tree 'nr '+Item)))
+-> {3-1}
+</code></pre>
+
+<dt><a name="length"><code>(length 'any) -> cnt | T</code></a>
+<dd>Returns the "length" of <code>any</code>. For numbers this is the number of
+decimal digits in the value (plus 1 for negative values), for symbols it is the
+number of characters in the name, and for lists it is the number of elements (or
+<code>T</code> for circular lists). See also <code><a
+href="refS.html#size">size</a></code>.
+
+<pre><code>
+: (length "abc")
+-> 3
+: (length "äbc")
+-> 3
+: (length 123)
+-> 3
+: (length (1 (2) 3))
+-> 3
+: (length (1 2 3 .))
+-> T
+</code></pre>
+
+<dt><a name="let"><code>(let sym 'any . prg) -> any</code></a>
+<dt><code>(let (sym 'any ..) . prg) -> any</code>
+<dd>Defines local variables. The value of the symbol <code>sym</code> - or the
+values of the symbols <code>sym</code> in the list of the second form - are
+saved and the symbols are bound to the evaluated <code>any</code> arguments.
+<code>prg</code> is executed, then the symbols are restored to their original
+values. The result of <code>prg</code> is returned. It is an error condition to
+pass <code>NIL</code> as a <code>sym</code> argument. See also <code><a
+href="refL.html#let?">let?</a></code>, <code><a
+href="refB.html#bind">bind</a></code>, <code><a
+href="refR.html#recur">recur</a></code>, <code><a
+href="refJ.html#job">job</a></code> and <code><a
+href="refU.html#use">use</a></code>.
+
+<pre><code>
+: (setq  X 123  Y 456)
+-> 456
+: (let X "Hello" (println X))
+"Hello"
+-> "Hello"
+: (let (X "Hello" Y "world") (prinl X " " Y))
+Hello world
+-> "world"
+: X
+-> 123
+: Y
+-> 456
+</code></pre>
+
+<dt><a name="let?"><code>(let? sym 'any . prg) -> any</code></a>
+<dd>Conditional local variable binding and execution: If <code>any</code>
+evalutes to <code>NIL</code>, <code>NIL</code> is returned. Otherwise, the value
+of the symbol <code>sym</code> is saved and <code>sym</code> is bound to the
+evaluated <code>any</code> argument. <code>prg</code> is executed, then
+<code>sym</code> is restored to its original value. The result of
+<code>prg</code> is returned. It is an error condition to pass <code>NIL</code>
+as the <code>sym</code> argument. <code>(let? sym 'any ..)</code> is equivalent
+to <code>(when 'any (let sym @ ..))</code>. See also <code><a
+href="refL.html#let">let</a></code>, <code><a
+href="refB.html#bind">bind</a></code>, <code><a
+href="refJ.html#job">job</a></code> and <code><a
+href="refU.html#use">use</a></code>.
+
+<pre><code>
+: (setq Lst (1 NIL 2 NIL 3))
+-> (1 NIL 2 NIL 3)
+: (let? A (pop 'Lst) (println 'A A))
+A 1
+-> 1
+: (let? A (pop 'Lst) (println 'A A))
+-> NIL
+</code></pre>
+
+<dt><a name="lieu"><code>(lieu 'any) -> sym | NIL</code></a>
+<dd>Returns the argument <code>any</code> when it is an external symbol and
+currently manifest in heap space, otherwise <code>NIL</code>. See also <code><a
+href="refE.html#ext?">ext?</a></code>.
+
+<pre><code>
+: (lieu *DB)
+-> {1}
+</code></pre>
+
+<dt><a name="line"><code>(line 'flg ['cnt ..]) -> lst|sym</code></a>
+<dd>Reads a line of characters from the current input channel. End of line is
+recognized as linefeed (hex "0A"), carriage return (hex "0D"), or the
+combination of both. (Note that a single carriage return may not work on network
+connections, because the character look-ahead to distinguish from
+return+linefeed can block the connection.) If <code>flg</code> is
+<code>NIL</code>, a list of single-character transient symbols is returned. When
+<code>cnt</code> arguments are given, subsequent characters of the input line
+are grouped into sublists, to allow parsing of fixed field length records. If
+<code>flg</code> is non-<code>NIL</code>, strings are returned instead of
+single-character lists. <code>NIL</code> is returned upon end of file. See also
+<code><a href="refC.html#char">char</a></code>, <code><a
+href="refT.html#till">till</a></code> and <code><a
+href="refE.html#eof">eof</a></code>.
+
+<pre><code>
+: (line)
+abcdefghijkl
+-> ("a" "b" "c" "d" "e" "f" "g" "h" "i" "j" "k" "l")
+: (line T)
+abcdefghijkl
+-> "abcdefghijkl"
+: (line NIL 1 2 3)
+abcdefghijkl
+-> (("a") ("b" "c") ("d" "e" "f") "g" "h" "i" "j" "k" "l")
+: (line T 1 2 3)
+abcdefghijkl
+-> ("a" "bc" "def" "g" "h" "i" "j" "k" "l")
+</code></pre>
+
+<dt><a name="lines"><code>(lines 'any ..) -> cnt</code></a>
+<dd>Returns the sum of the number of lines in the files with the names
+<code>any</code>, or <code>NIL</code> if none was found. See also <code><a
+href="refI.html#info">info</a></code>.
+
+<pre><code>
+: (lines "x.l")
+-> 11
+</code></pre>
+
+<dt><a name="link"><code>(link 'any ..) -> any</code></a>
+<dd>Links one or several new elements <code>any</code> to the end of the list in
+the current <code><a href="refM.html#make">make</a></code> environment. This
+operation is efficient also for long lists, because a pointer to the last
+element of the list is maintained. <code>link</code> returns the last linked
+argument. See also <code><a href="refY.html#yoke">yoke</a></code>, <code><a
+href="refC.html#chain">chain</a></code> and <code><a
+href="refM.html#made">made</a></code>.
+
+<pre><code>
+: (make
+   (println (link 1))
+   (println (link 2 3)) )
+1
+3
+-> (1 2 3)
+</code></pre>
+
+<dt><a name="lint"><code>(lint 'sym) -> lst</code></a>
+<dt><code>(lint 'sym 'cls) -> lst</code>
+<dt><code>(lint '(sym . cls)) -> lst</code>
+<dd>Checks the function definition or file contents (in the first form), or the
+method body of sym (second and third form), for possible pitfalls. Returns a
+list of diagnoses, where <code>var</code> indicates improper variables,
+<code>dup</code> duplicate parameters, <code>def</code> an undefined function,
+<code>bnd</code> an unbound variable, and <code>use</code> unused variables. See
+also <code><a href="refN.html#noLint">noLint</a></code>, <code><a
+href="refL.html#lintAll">lintAll</a></code>, <code><a
+href="refD.html#debug">debug</a></code>, <code><a
+href="refT.html#trace">trace</a></code> and <code><a
+href="refD.html#*Dbg">*Dbg</a></code>.
+
+<pre><code>
+: (de foo (R S T R)     # 'T' is a improper parameter, 'R' is duplicated
+   (let N 7             # 'N' is unused
+      (bar X Y) ) )     # 'bar' is undefined, 'X' and 'Y' are not bound
+-> foo
+: (lint 'foo)
+-> ((var T) (dup R) (def bar) (bnd Y X) (use N))
+</code></pre>
+
+<dt><a name="lintAll"><code>(lintAll ['sym ..]) -> lst</code></a>
+<dd>Applies <code><a href="refL.html#lint">lint</a></code> to <code><a
+href="refA.html#all">all</a></code> internal symbols - and optionally to all
+files <code>sym</code> - and returns a list of diagnoses. See also <code><a
+href="refN.html#noLint">noLint</a></code>.
+
+<pre><code>
+: (more (lintAll "file1.l" "file2.l"))
+...
+</code></pre>
+
+<dt><a name="list"><code>(list 'any ['any ..]) -> lst</code></a>
+<dd>Returns a list of all <code>any</code> arguments. See also <code><a
+href="refC.html#cons">cons</a></code>.
+
+<pre><code>
+: (list 1 2 3 4)
+-> (1 2 3 4)
+: (list 'a (2 3) "OK")
+-> (a (2 3) "OK")
+</code></pre>
+
+<dt><a name="lst/3"><code>lst/3</code></a>
+<dd><a href="ref.html#pilog">Pilog</a> predicate that returns subsequent list
+elements, after applying the <code><a href="refG.html#get">get</a></code>
+algorithm to that object and the following arguments. Often used in database
+queries. See also <code><a href="refM.html#map/3">map/3</a></code>.
+
+<pre><code>
+: (? (db nr +Ord 1 @Ord) (lst @Pos @Ord pos))
+ @Ord={3-7} @Pos={4-1}
+ @Ord={3-7} @Pos={4-2}
+ @Ord={3-7} @Pos={4-3}
+-> NIL
+</code></pre>
+
+<dt><a name="lst?"><code>(lst? 'any) -> flg</code></a>
+<dd>Returns <code>T</code> when the argument <code>any</code> is a (possibly
+empty) list (<code>NIL</code> or a cons pair cell). See also <code><a
+href="refP.html#pair">pair</a></code>.
+
+<pre><code>
+: (lst? NIL)
+-> T
+: (lst? (1 . 2))
+-> T
+: (lst? (1 2 3))
+-> T
+</code></pre>
+
+<dt><a name="listen"><code>(listen 'cnt1 ['cnt2]) -> cnt | NIL</code></a>
+<dd>Listens at a socket descriptor <code>cnt1</code> (as received by <code><a
+href="refP.html#port">port</a></code>) for an incoming connection, and returns
+the new socket descriptor <code>cnt</code>. While waiting for a connection, a
+<code>select</code> system call is executed for all file descriptors and timers
+in the <code>VAL</code> of the global variable <code><a
+href="refR.html#*Run">*Run</a></code>. If <code>cnt2</code> is
+non-<code>NIL</code>, that amount of milliseconds is waited maximally, and
+<code>NIL</code> is returned upon timeout. The global variable <code>*Adr</code>
+is set to the IP address of the client. See also <code><a
+href="refA.html#accept">accept</a></code>, <code><a
+href="refC.html#connect">connect</a></code>, <code><a
+href="refA.html#*Adr">*Adr</a></code>.
+
+<pre><code>
+: (setq *Socket
+   (listen (port 6789) 60000) )  # Listen at port 6789 for max 60 seconds
+-> 4
+: *Adr
+-> "127.0.0.1"
+</code></pre>
+
+<dt><a name="lit"><code>(lit 'any) -> any</code></a>
+<dd>Returns the literal (i.e. quoted) value of <code>any</code>, by
+<code>cons</code>ing it with the <code><a
+href="refQ.html#quote">quote</a></code> function if necessary.
+
+<pre><code>
+: (lit T)
+-> T
+: (lit 1)
+-> 1
+: (lit '(1))
+-> (1)
+: (lit '(a))
+-> '(a)
+</code></pre>
+
+<dt><a name="load"><code>(load 'any ..) -> any</code></a>
+<dd>Loads all <code>any</code> arguments. Normally, the name of each argument is
+taken as a file to be executed in a read-eval loop. The argument semantics are
+identical to that of <code><a href="refI.html#in">in</a></code>, with the
+exception that if an argument is a symbol and its first character is a hyphen
+'-', then that argument is parsed as an executable list (without the surrounding
+parentheses). When <code>any</code> is <code>T</code>, all remaining command
+line arguments are loaded recursively. When <code>any</code> is
+<code>NIL</code>, standard input is read, a prompt is issued before each read
+operation, the results are printed to standard output (read-eval-print loop),
+and <code>load</code> terminates when an empty line is entered. In any case,
+<code>load</code> terminates upon end of file, or when <code>NIL</code> is read.
+The index for transient symbols is cleared before and after the load, so that
+all transient symbols in the file have a local scope. Returns the value of the
+last evaluated expression. See also <code><a
+href="refS.html#script">script</a></code>, <code><a
+href="refI.html#ipid">ipid</a></code>, <code><a
+href="refC.html#call">call</a></code>, <code><a
+href="refF.html#file">file</a></code>, <code><a
+href="refI.html#in">in</a></code>, <code><a href="refO.html#out">out</a></code>
+and <code><a href="refS.html#str">str</a></code>.
+
+<pre><code>
+: (load "lib.l" "-* 1 2 3")
+-> 6
+</code></pre>
+
+<dt><a name="loc"><code>(loc 'sym 'lst) -> sym</code></a>
+<dd>Locates in <code>lst</code> a <code><a
+href="ref.html#transient">transient</a></code> symbol with the same name as
+<code>sym</code>. Allows to get hold of otherwise inaccessible symbols. See also
+<code><a href="ref_.html#====">====</a></code>.
+
+<pre><code>
+: (loc "X" curry)
+-> "X"
+: (== @ "X")
+-> NIL
+</code></pre>
+
+<dt><a name="locale"><code>(locale 'sym1 'sym2 ['sym3])</code></a>
+<dd>Sets the current locale to that given by the country file <code>sym1</code>
+and the language file <code>sym2</code> (both located in the "loc/" directory),
+and an optional application-specific directory <code>sym3</code>. The locale
+influences the language, and numerical, date and other formats. See also
+<code><a href="refU.html#*Uni">*Uni</a></code>, <code><a
+href="refD.html#datStr">datStr</a></code>, <code><a
+href="refS.html#strDat">strDat</a></code>, <code><a
+href="refE.html#expDat">expDat</a></code>, <code><a
+href="refD.html#day">day</a></code>, <code><a
+href="refT.html#telStr">telStr</a></code>, <code><a
+href="refE.html#expTel">expTel</a></code> and and <code><a
+href="refM.html#money">money</a></code>.
+
+<pre><code>
+: (locale "DE" "de" "app/loc/")
+-> "Zip"
+: ,"Yes"
+-> "Ja"
+</code></pre>
+
+<dt><a name="lock"><code>(lock ['sym]) -> cnt | NIL</code></a>
+<dd>Write-locks an external symbol <code>sym</code> (file record locking), or
+the whole database root file if <code>sym</code> is <code>NIL</code>. Returns
+<code>NIL</code> if successful, or the ID of the process currently holding the
+lock. When <code>sym</code> is non-<code>NIL</code>, the lock is released at the
+next top level call to <code><a href="refC.html#commit">commit</a></code> or
+<code><a href="refR.html#rollback">rollback</a></code>, otherwise only when
+another database is opened with <code><a href="refP.html#pool">pool</a></code>,
+or when the process terminates. See also <code><a
+href="refS.html#*Solo">*Solo</a></code>.
+
+<pre><code>
+: (lock '{1})        # Lock single object
+-> NIL
+: (lock)             # Lock whole database
+-> NIL
+</code></pre>
+
+<dt><a name="loop"><code>(loop ['any | (NIL 'any . prg) | (T 'any . prg) ..]) -> any</code></a>
+<dd>Endless loop with multiple conditional exits: The body is executed an
+unlimited number of times. If a clause has <code>NIL</code> or <code>T</code> as
+its CAR, the clause's second element is evaluated as a condition and - if the
+result is <code>NIL</code> or non-<code>NIL</code>, respectively - the
+<code>prg</code> is executed and the result returned. See also <code><a
+href="refD.html#do">do</a></code> and <code><a
+href="refF.html#for">for</a></code>.
+
+<pre><code>
+: (let N 3
+   (loop
+      (prinl N)
+      (T (=0 (dec 'N)) 'done) ) )
+3
+2
+1
+-> done
+</code></pre>
+
+<dt><a name="low?"><code>(low? 'any) -> sym | NIL</code></a>
+<dd>Returns <code>any</code> when the argument is a string (symbol) that starts
+with a lowercase character. See also <code><a
+href="refL.html#lowc">lowc</a></code>.
+
+<pre><code>
+: (low? "a")
+-> "a"
+: (low? "A")
+-> NIL
+: (low? 123)
+-> NIL
+: (low? ".")
+-> NIL
+</code></pre>
+
+<dt><a name="lowc"><code>(lowc 'any) -> any</code></a>
+<dd>Lower case conversion: If <code>any</code> is not a symbol, it is returned
+as it is. Otherwise, a new transient symbol with all characters of
+<code>any</code>, converted to lower case, is returned. See also <code><a
+href="refU.html#uppc">uppc</a></code>, <code><a
+href="refF.html#fold">fold</a></code> and <code><a
+href="refL.html#low?">low?</a></code>.
+
+<pre><code>
+: (lowc 123)
+-> 123
+: (lowc "ABC")
+-> "abc"
+</code></pre>
+
+<dt><a name="lt0"><code>(lt0 'any) -> num | NIL</code></a>
+<dd>Returns <code>num</code> when the argument is a number and less than zero,
+otherwise <code>NIL</code>. See also <code><a
+href="refG.html#ge0">ge0</a></code>, <code><a
+href="refG.html#gt0">gt0</a></code>, <code><a href="ref_.html#=0">=0</a></code>
+and <code><a href="refN.html#n0">n0</a></code>.
+
+<pre><code>
+: (lt0 -2)
+-> -2
+: (lt0 3)
+-> NIL
+</code></pre>
+
+<dt><a name="lup"><code>(lup 'lst 'any) -> lst</code></a>
+<dt><code>(lup 'lst 'any 'any2) -> lst</code>
+<dd>Looks up <code>any</code> in the CAR-elements of cells stored in the index
+tree <code>lst</code>, as built-up by <code><a
+href="refI.html#idx">idx</a></code>. In the first form, the first found cell is
+returned, in the second form a list of all cells whose CAR is in the range
+<code>any</code> .. <code>any2</code>. See also <code><a
+href="refA.html#assoc">assoc</a></code>.
+
+<pre><code>
+: (idx 'A 'a T)
+-> NIL
+: (idx 'A (1 . b) T)
+-> NIL
+: (idx 'A 123 T)
+-> NIL
+: (idx 'A (1 . a) T)
+-> NIL
+: (idx 'A (1 . c) T)
+-> NIL
+: (idx 'A (2 . d) T)
+-> NIL
+: (idx 'A)
+-> (123 a (1 . a) (1 . b) (1 . c) (2 . d))
+: (lup A 1)
+-> (1 . b)
+: (lup A 2)
+-> (2 . d)
+: (lup A 1 1)
+-> ((1 . a) (1 . b) (1 . c))
+: (lup A 1 2)
+-> ((1 . a) (1 . b) (1 . c) (2 . d))
+</code></pre>
+
+</dl>
+
+</body>
+</html>
diff --git a/doc/refM.html b/doc/refM.html
@@ -0,0 +1,621 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN" "http://www.w3.org/TR/1998/REC-html40-19980424/loose.dtd">
+<html lang="en">
+<head>
+<meta http-equiv="Content-Type" content="text/html; charset=utf-8">
+<title>M</title>
+<link rel="stylesheet" href="doc.css" type="text/css">
+</head>
+<body>
+
+<h1>M</h1>
+
+<dl>
+
+<dt><a name="*Msg"><code>*Msg</code></a>
+<dd>A global variable holding the last recently issued error message. See also
+<code><a href="ref.html#errors">Error Handling</a></code>, <code><a
+href="refE.html#*Err">*Err</a></code> and <code><a
+href="ref_.html#^">^</a></code>.
+
+<pre><code>
+: (+ 'A 2)
+!? (+ 'A 2)
+A -- Number expected
+?
+:
+: *Msg
+-> "Number expected"
+</code></pre>
+
+<dt><a name="+Mis"><code>+Mis</code></a>
+<dd>Prefix class to explicitly specify validation functions for <code><a
+href="refR.html#+relation">+relation</a></code>s. Expects a function that takes
+a value and an entity object, and returns <code>NIL</code> if everything is
+correct, or an error string. See also <code><a
+href="ref.html#dbase">Database</a></code>.
+
+<pre><code>
+(class +Ord +Entity)            # Order class
+(rel pos (+Mis +List +Joint)    # List of positions in that order
+   ((Val Obj)
+      (when (memq NIL Val)
+         "There are empty positions" ) )
+   ord (+Pos) )
+</code></pre>
+
+<dt><a name="macro"><code>(macro prg) -> any</code></a>
+<dd>Substitues all <code><a href="refP.html#pat?">pat?</a></code> symbols in
+<code>prg</code> (using <code><a href="refF.html#fill">fill</a></code>), and
+executes the result with <code><a href="refR.html#run">run</a></code>. Used
+occasionally to call functions which otherwise do not evaluate their arguments.
+
+<pre><code>
+: (de timerMessage (@N . @Prg)
+   (setq @N (- @N))
+   (macro
+      (task @N 0 . @Prg) ) )
+-> timerMessage
+: (timerMessage 6000 (println 'Timer 6000))
+-> (-6000 0 (println 'Timer 6000))
+: (timerMessage 12000 (println 'Timer 12000))
+-> (-12000 0 (println 'Timer 12000))
+: (more *Run)
+(-12000 2616 (println 'Timer 12000))
+(-6000 2100 (println 'Timer 6000))
+-> NIL
+: Timer 6000
+Timer 12000
+...
+</code></pre>
+
+<dt><a name="made"><code>(made ['lst1 ['lst2]]) -> lst</code></a>
+<dd>Initializes a new list value for the current <code><a
+href="refM.html#make">make</a></code> environment. All list elements already
+produced with <code><a href="refC.html#chain">chain</a></code> and <code><a
+href="refL.html#link">link</a></code> are discarded, and <code>lst1</code> is
+used instead. Optionally, <code>lst2</code> can be specified as the new linkage
+cell, otherwise the last cell of <code>lst1</code> is used. When called without
+arguments, <code>made</code> does not modify the environment. In any case, the
+current list is returned.
+
+<pre><code>
+: (make
+   (link 'a 'b 'c)         # Link three items
+   (println (made))        # Print current list (a b c)
+   (made (1 2 3))          # Discard it, start new with (1 2 3)
+   (link 4) )              # Link 4
+(a b c)
+-> (1 2 3 4)
+</code></pre>
+
+<dt><a name="mail"><code>(mail 'any 'cnt 'sym1 'sym2|lst1 'sym3 'lst2 . prg)'</code></a>
+<dd>Sends an eMail via SMTP to a mail server at host <code>any</code>, port
+<code>cnt</code>. <code>sym1</code> should be the "from" address,
+<code>sym2|lst1</code> the "to" address(es), and <code>sym3</code> the subject.
+<code>lst2</code> is a list of attachments, each one specified by three elements
+for path, name and mime type. <code>prg</code> generates the mail body with
+<code><a href="refP.html#prEval">prEval</a></code>. See also <code><a
+href="refC.html#connect">connect</a></code>.
+
+<pre><code>
+(mail "localhost" 25                               # Local mail server
+   "a@bc.de"                                       # "From" address
+   "abu@software-lab.de"                           # "To" address
+   "Testmail"                                      # Subject
+   (quote
+      "img/go.png" "go.png" "image/png"            # First attachment
+      "img/7fach.gif" "7fach.gif" "image/gif" )    # Second attachment
+   "Hello,"                                        # First line
+   NIL                                             # (empty line)
+   (prinl (pack "This is mail #" (+ 3 4))) )       # Third line
+</code></pre>
+
+<dt><a name="make"><code>(make .. [(made 'lst ..)] .. [(link 'any ..)] ..) -> any</code></a>
+<dd>Initializes and executes a list-building process with the <code><a
+href="refM.html#made">made</a></code>, <code><a
+href="refC.html#chain">chain</a></code>, <code><a
+href="refL.html#link">link</a></code> and <code><a
+href="refY.html#yoke">yoke</a></code> functions, and returns the result list.
+For efficiency, pointers to the head and the tail of the list are maintained
+internally.
+
+<pre><code>
+: (make (link 1) (link 2 3) (link 4))
+-> (1 2 3 4)
+: (make (made (1 2 3)) (link 4))
+-> (1 2 3 4)
+</code></pre>
+
+<dt><a name="map"><code>(map 'fun 'lst ..) -> lst</code></a>
+<dd>Applies <code>fun</code> to <code>lst</code> and all successive CDRs. When
+additional <code>lst</code> arguments are given, they are passed to
+<code>fun</code> in the same way. Returns the result of the last application.
+See also <code><a href="refM.html#mapc">mapc</a></code>, <code><a
+href="refM.html#maplist">maplist</a></code>, <code><a
+href="refM.html#mapcar">mapcar</a></code>, <code><a
+href="refM.html#mapcon">mapcon</a></code>, <code><a
+href="refM.html#mapcan">mapcan</a></code> and <code><a
+href="refF.html#filter">filter</a></code>.
+
+<pre><code>
+: (map println (1 2 3 4) '(A B C))
+(1 2 3 4) (A B C)
+(2 3 4) (B C)
+(3 4) (C)
+(4) NIL
+-> NIL
+</code></pre>
+
+<dt><a name="map/3"><code>map/3</code></a>
+<dd><a href="ref.html#pilog">Pilog</a> predicate that returns a list and
+subsequent CDRs of that list, after applying the <code><a
+href="refG.html#get">get</a></code> algorithm to that object and the following
+arguments. Often used in database queries. See also <code><a
+href="refL.html#lst/3">lst/3</a></code>.
+
+<pre><code>
+: (? (db nr +Ord 1 @Ord) (map @L @Ord pos))
+ @Ord={3-7} @L=({4-1} {4-2} {4-3})
+ @Ord={3-7} @L=({4-2} {4-3})
+ @Ord={3-7} @L=({4-3})
+-> NIL
+</code></pre>
+
+<dt><a name="mapc"><code>(mapc 'fun 'lst ..) -> any</code></a>
+<dd>Applies <code>fun</code> to each element of <code>lst</code>. When
+additional <code>lst</code> arguments are given, their elements are also passed
+to <code>fun</code>. Returns the result of the last application. See also
+<code><a href="refM.html#map">map</a></code>, <code><a
+href="refM.html#maplist">maplist</a></code>, <code><a
+href="refM.html#mapcar">mapcar</a></code>, <code><a
+href="refM.html#mapcon">mapcon</a></code>, <code><a
+href="refM.html#mapcan">mapcan</a></code> and <code><a
+href="refF.html#filter">filter</a></code>.
+
+<pre><code>
+: (mapc println (1 2 3 4) '(A B C))
+1 A
+2 B
+3 C
+4 NIL
+-> NIL
+</code></pre>
+
+<dt><a name="mapcan"><code>(mapcan 'fun 'lst ..) -> lst</code></a>
+<dd>Applies <code>fun</code> to each element of <code>lst</code>. When
+additional <code>lst</code> arguments are given, their elements are also passed
+to <code>fun</code>. Returns a (destructively) concatenated list of all results.
+See also <code><a href="refM.html#map">map</a></code>, <code><a
+href="refM.html#mapc">mapc</a></code>, <code><a
+href="refM.html#maplist">maplist</a></code>, <code><a
+href="refM.html#mapcar">mapcar</a></code>, <code><a
+href="refM.html#mapcon">mapcon</a></code>, <code><a
+href="refF.html#filter">filter</a></code>.
+
+<pre><code>
+: (mapcan reverse '((a b c) (d e f) (g h i)))
+-> (c b a f e d i h g)
+</code></pre>
+
+<dt><a name="mapcar"><code>(mapcar 'fun 'lst ..) -> lst</code></a>
+<dd>Applies <code>fun</code> to each element of <code>lst</code>. When
+additional <code>lst</code> arguments are given, their elements are also passed
+to <code>fun</code>. Returns a list of all results. See also <code><a
+href="refM.html#map">map</a></code>, <code><a
+href="refM.html#mapc">mapc</a></code>, <code><a
+href="refM.html#maplist">maplist</a></code>, <code><a
+href="refM.html#mapcon">mapcon</a></code>, <code><a
+href="refM.html#mapcan">mapcan</a></code> and <code><a
+href="refF.html#filter">filter</a></code>.
+
+<pre><code>
+: (mapcar + (1 2 3) (4 5 6))
+-> (5 7 9)
+: (mapcar '((X Y) (+ X (* Y Y))) (1 2 3 4) (5 6 7 8))
+-> (26 38 52 68)
+</code></pre>
+
+<dt><a name="mapcon"><code>(mapcon 'fun 'lst ..) -> lst</code></a>
+<dd>Applies <code>fun</code> to <code>lst</code> and all successive CDRs. When
+additional <code>lst</code> arguments are given, they are passed to
+<code>fun</code> in the same way. Returns a (destructively) concatenated list of
+all results. See also <code><a href="refM.html#map">map</a></code>, <code><a
+href="refM.html#mapc">mapc</a></code>, <code><a
+href="refM.html#maplist">maplist</a></code>, <code><a
+href="refM.html#mapcar">mapcar</a></code>, <code><a
+href="refM.html#mapcan">mapcan</a></code> and <code><a
+href="refF.html#filter">filter</a></code>.
+
+<pre><code>
+: (mapcon copy '(1 2 3 4 5))
+-> (1 2 3 4 5 2 3 4 5 3 4 5 4 5 5)
+</code></pre>
+
+<dt><a name="maplist"><code>(maplist 'fun 'lst ..) -> lst</code></a>
+<dd>Applies <code>fun</code> to <code>lst</code> and all successive CDRs. When
+additional <code>lst</code> arguments are given, they are passed to
+<code>fun</code> in the same way. Returns a list of all results. See also
+<code><a href="refM.html#map">map</a></code>, <code><a
+href="refM.html#mapc">mapc</a></code>, <code><a
+href="refM.html#mapcar">mapcar</a></code>, <code><a
+href="refM.html#mapcon">mapcon</a></code>, <code><a
+href="refM.html#mapcan">mapcan</a></code> and <code><a
+href="refF.html#filter">filter</a></code>.
+
+<pre><code>
+: (maplist cons (1 2 3) '(A B C))
+-> (((1 2 3) A B C) ((2 3) B C) ((3) C))
+</code></pre>
+
+<dt><a name="maps"><code>(maps 'fun 'sym ['lst ..]) -> any</code></a>
+<dd>Applies <code>fun</code> to all properties of <code>sym</code>. When
+additional <code>lst</code> arguments are given, their elements are also passed
+to <code>fun</code>. Returns the result of the last application. See also
+<code><a href="refP.html#putl">putl</a></code> and <code><a
+href="refG.html#getl">getl</a></code>.
+
+<pre><code>
+: (put 'X 'a 1)
+-> 1
+: (put 'X 'b 2)
+-> 2
+: (put 'X 'flg T)
+-> T
+: (getl 'X)
+-> (flg (2 . b) (1 . a))
+: (maps println 'X '(A B))
+flg A
+(2 . b) B
+(1 . a) NIL
+-> NIL
+</code></pre>
+
+<dt><a name="mark"><code>(mark 'sym|0 ['NIL | 'T | '0]) -> flg</code></a>
+<dd>Tests, sets or resets a mark for <code>sym</code> in the database (for a
+second argument of <code>NIL</code>, <code>T</code> or <code>0</code>,
+respectively), and returns the old value. The marks are local to the current
+process (not stored in the database), and vanish when the process terminates. If
+the first argument is zero, all marks are cleared.
+
+<pre><code>
+: (pool "db")
+-> T
+: (mark '{1} T)      # Mark
+-> NIL
+: (mark '{1})        # Test
+-> T                 # -> marked
+: (mark '{1} 0)      # Unmark
+-> T
+: (mark '{1})        # Test
+-> NIL               # -> unmarked
+</code></pre>
+
+<dt><a name="match"><code>(match 'lst1 'lst2) -> flg</code></a>
+<dd>Takes <code>lst1</code> as a pattern to be matched against
+<code>lst2</code>, and returns <code>T</code> when successful. Atoms must be
+equal, and sublists must match recursively. Symbols in the pattern list with
+names starting with an at-mark "<code>@</code>" (see <code><a
+href="refP.html#pat?">pat?</a></code>) are taken as wildcards. They can match
+zero, one or more elements, and are bound to the corresponding data. See also
+<code><a href="refC.html#chop">chop</a></code>, <code><a
+href="refS.html#split">split</a></code> and <code><a
+href="refF.html#fill">fill</a></code>.
+
+<pre><code>
+: (match '(@A is @B) '(This is a test))
+-> T
+: @A
+-> (This)
+: @B
+-> (a test)
+: (match '(@X (d @Y) @Z) '((a b c) (d (e f) g) h i))
+-> T
+: @X
+-> ((a b c))
+: @Y
+-> ((e f) g)
+: @Z
+-> (h i)
+</code></pre>
+
+<dt><a name="max"><code>(max 'any ..) -> any</code></a>
+<dd>Returns the largest of all <code>any</code> arguments. See also <a
+href="refM.html#min">min</a> and <a href="ref.html#cmp">Comparing</a>.
+
+<pre><code>
+: (max 2 'a 'z 9)
+-> z
+: (max (5) (2 3) 'X)
+-> (5)
+</code></pre>
+
+<dt><a name="maxKey"><code>(maxKey 'tree ['any1 ['any2]]) -> any</code></a>
+<dd>Returns the largest key in a database tree. If a minimal key
+<code>any1</code> and/or a maximal key <code>any2</code> is given, the largest
+key from that range is returned. See also <code><a
+href="refT.html#tree">tree</a></code>, <code><a
+href="refL.html#leaf">leaf</a></code>, <code><a
+href="refM.html#minKey">minKey</a></code> and <code><a
+href="refG.html#genKey">genKey</a></code>.
+
+<pre><code>
+: (maxKey (tree 'nr '+Item))
+-> 7
+: (maxKey (tree 'nr '+Item) 3 5)
+-> 5
+</code></pre>
+
+<dt><a name="maxi"><code>(maxi 'fun 'lst ..) -> any</code></a>
+<dd>Applies <code>fun</code> to each element of <code>lst</code>. When
+additional <code>lst</code> arguments are given, their elements are also passed
+to <code>fun</code>. Returns that element from <code>lst</code> for that
+<code>fun</code> returned a maximal value. See also <code><a
+href="refM.html#mini">mini</a></code> and <code><a
+href="refS.html#sort">sort</a></code>.
+
+<pre><code>
+: (setq A 1  B 2  C 3)
+-> 3
+: (maxi val '(A B C))
+-> C
+: (maxi                          # Symbol with largest list value
+   '((X)
+      (and (pair (val X)) (size @)) )
+   (what) )
+-> *History
+</code></pre>
+
+<dt><a name="member"><code>(member 'any 'lst) -> any</code></a>
+<dd>Returns the tail of <code>lst</code> that starts with <code>any</code> when
+<code>any</code> is a member of <code>lst</code>, otherwise <code>NIL</code>.
+See also <code><a href="refM.html#memq">memq</a></code>, <code><a
+href="refA.html#assoc">assoc</a></code> and <code><a
+href="refI.html#idx">idx</a></code>.
+
+<pre><code>
+: (member 3 (1 2 3 4 5 6))
+-> (3 4 5 6)
+: (member 9 (1 2 3 4 5 6))
+-> NIL
+: (member '(d e f) '((a b c) (d e f) (g h i)))
+-> ((d e f) (g h i))
+</code></pre>
+
+<dt><a name="member/2"><code>member/2</code></a>
+<dd><a href="ref.html#pilog">Pilog</a> predicate that succeeds if the the first
+argument is a member of the list in the second argument. See also <code><a
+href="refE.html#equal/2">equal/2</a></code> and <code><a
+href="refM.html#member">member</a></code>.
+
+<pre><code>
+:  (? (member @X (a b c)))
+ @X=a
+ @X=b
+ @X=c
+-> NIL
+</code></pre>
+
+<dt><a name="memq"><code>(memq 'any 'lst) -> any</code></a>
+<dd>Returns the tail of <code>lst</code> that starts with <code>any</code> when
+<code>any</code> is a member of <code>lst</code>, otherwise <code>NIL</code>.
+<code><a href="ref_.html#==">==</a></code> is used for comparison (pointer
+equality). See also <code><a href="refM.html#member">member</a></code>, <code><a
+href="refM.html#mmeq">mmeq</a></code>, <code><a
+href="refA.html#asoq">asoq</a></code>, <code><a
+href="refD.html#delq">delq</a></code> and <a href="ref.html#cmp">Comparing</a>.
+
+<pre><code>
+: (memq 'c '(a b c d e f))
+-> (c d e f)
+: (memq (2) ((1) (2) (3)))
+-> NIL
+</code></pre>
+
+<dt><a name="meta"><code>(meta 'obj|typ 'sym ['sym2|cnt ..]) -> any</code></a>
+<dd>Fetches a property value <code>any</code>, by searching the property lists
+of the classes and superclasses of <code>obj</code>, or the classes in
+<code>typ</code>, for the property key <code>sym</code>, and by applying the
+<code><a href="refG.html#get">get</a></code> algorithm to the following optional
+arguments.
+
+<pre><code>
+: (setq A '(B))            # Be 'A' an object of class 'B'
+-> (B)
+: (put 'B 'a 123)
+-> 123
+: (meta 'A 'a)             # Fetch 'a' from 'B'
+-> 123
+</code></pre>
+
+<dt><a name="meth"><code>(meth 'obj ..) -> any</code></a>
+<dd>This function is usually not called directly, but is used by <code> <a
+href="refD.html#dm">dm</a></code> as a template to initialize the
+<code>VAL</code> of message symbols. It searches for itself in the methods of
+<code>obj</code> and its classes and superclasses, and executes that method. An
+error <code>"Bad message"</code> is issued if the search is unsuccessful. See
+also <code><a href="ref.html#oop">OO Concepts</a></code>, <code><a
+href="refM.html#method">method</a></code>, <code><a
+href="refS.html#send">send</a></code> and <code><a
+href="refT.html#try">try</a></code>.
+
+<pre><code>
+: meth
+-> 67283504    # Value of 'meth'
+: stop>
+-> 67283504    # Value of any message
+</code></pre>
+
+<dt><a name="method"><code>(method 'msg 'obj) -> fun</code></a>
+<dd>Returns the function body of the method that would be executed upon sending
+the message <code>msg</code> to the object <code>obj</code>. If the message
+cannot be located in <code>obj</code>, its classes and superclasses,
+<code>NIL</code> is returned. See also <code><a
+href="ref.html#oop">OO Concepts</a></code>, <code><a
+href="refS.html#send">send</a></code>, <code><a
+href="refT.html#try">try</a></code>, <code><a
+href="refM.html#meth">meth</a></code>, <code><a
+href="refS.html#super">super</a></code>, <code><a
+href="refE.html#extra">extra</a></code>, <code><a
+href="refC.html#class">class</a></code>.
+
+<pre><code>
+: (method 'mis> '+Number)
+-> ((Val Obj) (and Val (not (num? Val)) "Numeric input expected"))
+</code></pre>
+
+<dt><a name="min"><code>(min 'any ..) -> any</code></a>
+<dd>Returns the smallest of all <code>any</code> arguments. See also <a
+href="refM.html#max">max</a> and <a href="ref.html#cmp">Comparing</a>.
+
+<pre><code>
+: (min 2 'a 'z 9)
+-> 2
+: (min (5) (2 3) 'X)
+-> X
+</code></pre>
+
+<dt><a name="minKey"><code>(minKey 'tree ['any1 ['any2]]) -> any</code></a>
+<dd>Returns the smallest key in a database tree. If a minimal key
+<code>any1</code> and/or a maximal key <code>any2</code> is given, the smallest
+key from that range is returned. See also <code><a
+href="refT.html#tree">tree</a></code>, <code><a
+href="refL.html#leaf">leaf</a></code>, <code><a
+href="refM.html#maxKey">maxKey</a></code> and <code><a
+href="refG.html#genKey">genKey</a></code>.
+
+<pre><code>
+: (minKey (tree 'nr '+Item))
+-> 1
+: (minKey (tree 'nr '+Item) 3 5)
+-> 3
+</code></pre>
+
+<dt><a name="mini"><code>(mini 'fun 'lst ..) -> any</code></a>
+<dd>Applies <code>fun</code> to each element of <code>lst</code>. When
+additional <code>lst</code> arguments are given, their elements are also passed
+to <code>fun</code>. Returns that element from <code>lst</code> for that
+<code>fun</code> returned a minimal value. See also <code><a
+href="refM.html#maxi">maxi</a></code> and <code><a
+href="refS.html#sort">sort</a></code>.
+
+<pre><code>
+: (setq A 1  B 2  C 3)
+-> 3
+: (mini val '(A B C))
+-> A
+</code></pre>
+
+<dt><a name="mix"><code>(mix 'lst cnt|'any ..) -> lst</code></a>
+<dd>Builds a list from the elements of the argument <code>lst</code>, as
+specified by the following <code>cnt|'any</code> arguments. If such an argument
+is a number, the <code>cnt</code>'th element from <code>lst</code> is taken,
+otherwise that argument is evaluated and the result is used.
+
+<pre><code>
+: (mix '(a b c d) 3 4 1 2)
+-> (c d a b)
+: (mix '(a b c d) 1 'A 4 'D)
+-> (a A d D)
+</code></pre>
+
+<dt><a name="mmeq"><code>(mmeq 'lst 'lst) -> any</code></a>
+<dd>Returns the tail of the second argument <code>lst</code> that starts with a
+member of the first argument <code>lst</code>, otherwise <code>NIL</code>.
+<code><a href="ref_.html#==">==</a></code> is used for comparison (pointer
+equality). See also <code><a href="refM.html#member">member</a></code>, <code><a
+href="refM.html#memq">memq</a></code>, <code><a
+href="refA.html#asoq">asoq</a></code> and <code><a
+href="refD.html#delq">delq</a></code>.
+
+<pre><code>
+: (mmeq '(a b c) '(d e f))
+-> NIL
+: (mmeq '(a b c) '(d b x))
+-> (b x)
+</code></pre>
+
+<dt><a name="money"><code>(money 'num ['sym]) -> sym</code></a>
+<dd>Formats a number <code>num</code> into a digit string with two decimal
+places, according to the current <code><a
+href="refL.html#locale">locale</a></code>. If an additional currency name is
+given, it is appended (separated by a space). See also <code><a
+href="refT.html#telStr">telStr</a></code>, <code><a
+href="refD.html#datStr">datStr</a></code> and <code><a
+href="refF.html#format">format</a></code>.
+
+<pre><code>
+: (money 123456789)
+-> "1,234,567.89"
+: (money 12345 "EUR")
+-> "123.45 EUR"
+: (locale "DE" "de")
+-> NIL
+: (money 123456789 "EUR")
+-> "1.234.567,89 EUR"
+</code></pre>
+
+<dt><a name="more"><code>(more 'lst ['fun]) -> flg</code></a>
+<dt><code>(more 'cls) -> any</code>
+<dd>Displays the elements of <code>lst</code> (first form), or the type and
+methods of <code>cls</code> (second form). <code>fun</code> defaults to <code><a
+href="refP.html#print">print</a></code>. In the second form, the method
+definitions of <code>cls</code> are pretty-printed with <code><a
+href="refP.html#pp">pp</a></code>. After each step, <code>more</code> waits for
+console input, and terminates when a non-empty line is entered. In that case,
+<code>T</code> is returned, otherwise (when end of data is reached)
+<code>NIL</code>. See also <code><a href="refQ.html#query">query</a></code> and
+<code><a href="refS.html#show">show</a></code>.
+
+<pre><code>
+: (more (all))                         # Display all internal symbols
+inc>
+leaf
+nil
+inc!
+accept.                                # Stop
+-> T
+
+: (more (all) show)                    # 'show' all internal symbols
+inc> 67292896
+   *Dbg ((859 . "lib/db.l"))
+
+leaf ((Tree) (let (Node (cdr (root Tree)) X) (while (val Node) (setq X (cadr @) Node (car @))) (cddr X)))
+   *Dbg ((173 . "lib/btree.l"))
+
+nil 67284680
+   T (((@X) (@ not (-> @X))))
+.                                      # Stop
+-> T
+
+: (more '+Link)                        # Display a class
+(+relation)
+
+(dm mis> (Val Obj)
+   (and
+      Val
+      (nor (isa (: type) Val) (canQuery Val))
+      "Type error" ) )
+
+(dm T (Var Lst)
+   (unless (=: type (car Lst)) (quit "No Link" Var))
+   (super Var (cdr Lst)) )
+
+-> NIL
+</code></pre>
+
+<dt><a name="msg"><code>(msg 'any ['any ..]) -> any</code></a>
+<dd>Prints <code>any</code> with <code><a
+href="refP.html#print">print</a></code>, followed by all <code>any</code>
+arguments (printed with <code><a href="refP.html#prin">prin</a></code>) and a
+newline, to standard error. The first <code>any</code> argument is returned.
+
+<pre><code>
+: (msg (1 a 2 b 3 c) " is a mixed " "list")
+(1 a 2 b 3 c) is a mixed list
+-> (1 a 2 b 3 c)
+</code></pre>
+
+</dl>
+
+</body>
+</html>
diff --git a/doc/refN.html b/doc/refN.html
@@ -0,0 +1,399 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN" "http://www.w3.org/TR/1998/REC-html40-19980424/loose.dtd">
+<html lang="en">
+<head>
+<meta http-equiv="Content-Type" content="text/html; charset=utf-8">
+<title>N</title>
+<link rel="stylesheet" href="doc.css" type="text/css">
+</head>
+<body>
+
+<h1>N</h1>
+
+<dl>
+
+<dt><a name="+Need"><code>+Need</code></a>
+<dd>Prefix class for mandatory <code><a
+href="refR.html#+relation">+relation</a></code>s. Note that this does not
+enforce any requirements by itself, it only returns an error message if the
+<code>mis&gt;</code> message is explicitly called, e.g. by GUI functions. See
+also <code><a href="ref.html#dbase">Database</a></code>.
+
+<pre><code>
+(rel nr (+Need +Key +Number))  # Item number is mandatory
+</code></pre>
+
+<dt><a name="+Number"><code>+Number</code></a>
+<dd>Class for numeric relations, a subclass of <code><a
+href="refR.html#+relation">+relation</a></code>. Accepts an optional argument
+for the fixpoint scale (currently not used). See also <code><a
+href="ref.html#dbase">Database</a></code>.
+
+<pre><code>
+(rel pr (+Number) 2)  # Price, with two decimal places
+</code></pre>
+
+<dt><a name="n=="><code>(n== 'any ..) -> flg</code></a>
+<dd>Returns <code>T</code> when not all <code>any</code> arguments are the same
+(pointer equality). <code>(n== 'any ..)</code> is equivalent to <code>(not (==
+'any ..))</code>. See also <code><a href="ref_.html#==">==</a></code> and <a
+href="ref.html#cmp">Comparing</a>.
+
+<pre><code>
+: (n== 'a 'a)
+-> NIL
+: (n== (1) (1))
+-> T
+</code></pre>
+
+<dt><a name="n0"><code>(n0 'any) -> flg</code></a>
+<dd>Returns <code>T</code> when <code>any</code> is not a number with value
+zero. See also <code><a href="ref_.html#=0">=0</a></code>, <code><a
+href="refL.html#lt0">lt0</a></code>, <code><a
+href="refG.html#ge0">ge0</a></code> and <code><a
+href="refG.html#gt0">gt0</a></code>.
+
+<pre><code>
+: (n0 (- 6 3 2 1))
+-> NIL
+: (n0 'a)
+-> T
+</code></pre>
+
+<dt><a name="nT"><code>(nT 'any) -> flg</code></a>
+<dd>Returns <code>T</code> when <code>any</code> is not the symbol
+<code>T</code>. See also <a href="ref_.html#=T">=T</a>.
+
+<pre><code>
+: (nT 0)
+-> T
+: (nT "T")
+-> T
+: (nT T)
+-> NIL
+</code></pre>
+
+<dt><a name="name"><code>(name 'sym ['sym2]) -> sym</code></a>
+<dd>Returns, if <code>sym2</code> is not given, a new transient symbol with the
+name of <code>sym</code>. Otherwise <code>sym</code> must be a transient symbol,
+and its name is changed to that of <code>sym2</code>. See also <code><a
+href="refS.html#str">str</a></code>, <code><a
+href="refS.html#sym">sym</a></code>, <code><a
+href="refZ.html#zap">zap</a></code> and <code><a
+href="refI.html#intern">intern</a></code>.
+
+<pre><code>
+: (name 'abc)
+-> "abc"
+: (name "abc")
+-> "abc"
+: (name '{abc})
+-> "abc"
+: (name (new))
+-> NIL
+: (de foo (Lst) (car Lst))  # 'foo' calls 'car'
+-> foo
+: (intern (name (zap 'car) "xxx"))  # Globally change the name of 'car'
+-> xxx
+: (xxx (1 2 3))
+-> 1
+: (pp 'foo)
+(de foo (Lst)
+   (xxx Lst) )                      # Name changed
+-> foo
+: (foo (1 2 3))                     # 'foo' still works
+-> 1
+: (car (1 2 3))                     # Reader returns a new 'car' symbol
+!? (car (1 2 3))
+car -- Undefined
+?
+</code></pre>
+
+<dt><a name="nand"><code>(nand 'any ..) -> flg</code></a>
+<dd>Logical NAND. The expressions <code>any</code> are evaluated from left to
+right. If <code>NIL</code> is encountered, <code>T</code> is returned
+immediately. Else <code>NIL</code> is returned. <code>(nand ..)</code> is
+equivalent to <code>(not (and ..))</code>.
+
+<pre><code>
+: (nand (lt0 7) (read))
+-> T
+: (nand (lt0 -7) (read))
+abc
+-> NIL
+: (nand (lt0 -7) (read))
+NIL
+-> T
+</code></pre>
+
+<dt><a name="native"><code>(native 'cnt1|sym1 'cnt2|sym2 'sym|lst 'any ..) -> any</code></a>
+<dd>(64-bit version only) Calls a native C function. The first argument should
+specify a shared object library, either <code>"@"</code> (the current main
+program), <code>sym1</code> (a library path name), or <code>cnt1</code> (a
+library handle obtained by a previous call). The second argument should be a
+symbol name <code>sym2</code>, or a function pointer <code>cnt2</code> obtained
+by a previous call). Practically, the first two arguments will be always passed
+as transient symbols, which will get the library handle and function pointer
+assigned as values to be cached and used in subsequent calls. The third
+<code>sym|lst</code> argument is a return value specification, while all
+following arguments are the arguments to the native function.
+
+<p>The return value specification may either be one of the symbols
+
+<pre><code>
+   NIL   void
+   B     byte     # Byte (unsigned)
+   C     char     # Character (UTF-8, 1-3 bytes)
+   I     int      # Integer (32 bit)
+   N     long     # Long or pointer (64 bit)
+   S     string   # String (UTF-8)
+</code></pre>
+
+<p>or nested lists of these symbols with size specifications to denote arrays
+and structures, e.g.
+
+<pre><code>
+   (N . 4)        # long[4];           -> (1 2 3 4)
+   (N (C . 4))    # {long; char[4];}   -> (1234 ("a" "b" "c" NIL))
+   (N (B . 7))    # {long; byte[7];}   -> (1234 (1 2 3 4 5 6 7))
+</code></pre>
+
+<p>Arguments can be numbers (passed as 64-bit integers), symbols (passed as
+strings), or a list with a variable in the CAR (to recieve the returned
+structure data, ignored when the CAR is <code>NIL</code>), a cons pair for the
+size- and value-specification in the CADR, and an optional sequence of
+initialization bytes in the CDDR.
+
+<pre><code>
+: (native "@" "getenv" 'S "TERM")  # Same as (sys "TERM")
+-> "xterm"
+
+: (native "@" "printf" 'I "abc%d%s^J" (+ 3 4) (pack "X" "Y" "Z"))
+abc7XYZ
+-> 8
+
+: (use Tim
+   (native "@" "time" NIL '(Tim (8 B . 8)))  # time_t 8   # Get time_t structure
+   (native "@" "localtime" '(I . 9) (cons NIL (8) Tim)) ) # Read local time
+-> (32 18 13 31 11 109 4 364 0)  # 13:18:32, Dec. 31st, 2009
+</code></pre>
+
+<p>The C function may in turn call a function
+
+<pre><code>
+   long lisp(char*, long, long, long, long, long);
+</code></pre>
+
+<p>which accepts a symbol name as the first argument, and up to 5 numbers.
+<code>lisp()</code> calls that symbol with the five numbers, and expects a
+numeric return value. All numbers in this context should not be larger than 60
+bits (signed).
+
+<dt><a name="need"><code>(need 'cnt ['lst ['any]]) -> lst</code></a>
+<dd>Produces a list of at least <code>cnt</code> elements. When called without
+optional arguments, a list of <code>cnt</code> <code>NIL</code>'s is returned.
+When <code>lst</code> is given, it is extended to the left (if <code>cnt</code>
+is positive) or (destructively) to the right (if <code>cnt</code> is negative)
+with <code>any</code> elements. See also <code><a
+href="refR.html#range">range</a></code>.
+
+<pre><code>
+: (need 5)
+-> (NIL NIL NIL NIL NIL)  # Allocate 5 cells
+: (need 5 '(a b c))
+-> (NIL NIL a b c)
+: (need -5 '(a b c))
+-> (a b c NIL NIL)
+: (need 5 '(a b c) " ")  # String alignment
+-> (" " " " a b c)
+</code></pre>
+
+<dt><a name="new"><code>(new ['flg|num] ['typ ['any ..]]) -> obj</code></a>
+<dd>Creates and returns a new object. If <code>flg</code> is given and
+non-<code>NIL</code>, the new object will be an external symbol (created in
+database file 1 if <code>T</code>, or in the corresponding database file if
+<code>num</code> is given). <code>typ</code> (typically a list of classes) is
+assigned to the <code>VAL</code>, and the initial <code>T</code> message is sent
+with the arguments <code>any</code> to the new object. If no <code>T</code>
+message is defined for the classes in <code>typ</code> or their superclasses,
+the <code>any</code> arguments should evaluate to alternating keys and values
+for the initialization of the new object. See also <code><a
+href="refB.html#box">box</a></code>, <code><a
+href="refO.html#object">object</a></code>, <code><a
+href="refC.html#class">class</a></code>, <code><a
+href="refT.html#type">type</a></code>, <code><a
+href="refI.html#isa">isa</a></code>, <code><a
+href="refS.html#send">send</a></code> and <code><a
+href="ref.html#dbase">Database</a></code>.
+
+<pre><code>
+: (new)
+-> $134426427
+: (new T '(+Address))
+-> {1A;3}
+</code></pre>
+
+<dt><a name="new!"><code>(new! 'typ ['any ..]) -> obj</code></a>
+<dd><a href="ref.html#trans">Transaction</a> wrapper function for <code><a
+href="refN.html#new">new</a></code>. <code>(new! '(+Cls) 'key 'val ...)</code>
+is equivalent to <code>(dbSync) (new (db: +Cls) 'key 'val ...) (commit
+'upd)</code>. See also <code><a href="refS.html#set!">set!</a></code>, <code><a
+href="refP.html#put!">put!</a></code> and <code><a
+href="refI.html#inc!">inc!</a></code>.
+
+<pre><code>
+: (new! (+Item)   # Create a new item
+   'nr 2                      # Item number
+   'nm "Spare Part"           # Description
+   'sup (db 'nr '+CuSu 2)     # Supplier
+   'inv 100                   # Inventory
+   pr 12.50 )                 # Price
+</code></pre>
+
+<dt><a name="next"><code>(next) -> any</code></a>
+<dd>Can only be used inside functions with a variable number of arguments (with
+<code>@</code>). Returns the next argument from the internal list. See also
+<code><a href="refA.html#args">args</a></code>, <code><a
+href="refA.html#arg">arg</a></code>, <code><a
+href="refR.html#rest">rest</a></code>, and <code><a
+href="refP.html#pass">pass</a></code>.
+
+<pre><code>
+: (de foo @ (println (next)))          # Print next argument
+-> foo
+: (foo)
+NIL
+-> NIL
+: (foo 123)
+123
+-> 123
+</code></pre>
+
+<dt><a name="nil"><code>(nil . prg) -> NIL</code></a>
+<dd>Executes <code>prg</code>, and returns <code>NIL</code>. See also <code><a
+href="refT.html#t">t</a></code>, <code><a href="refP.html#prog">prog</a></code>,
+<code><a href="refP.html#prog1">prog1</a></code> and <code><a
+href="refP.html#prog2">prog2</a></code>.
+
+<pre><code>
+: (nil (println 'OK))
+OK
+-> NIL
+</code></pre>
+
+<dt><a name="nil/1"><code>nil/1</code></a>
+<dd><a href="ref.html#pilog">Pilog</a> predicate expects an argument variable,
+and succeeds if that variable is bound to <code>NIL</code>. See also <code><a
+href="refN.html#not/1">not/1</a></code>.
+
+<pre><code>
+: (? @X NIL (nil @X))
+ @X=NIL
+-> NIL
+</code></pre>
+
+<dt><a name="noLint"><code>(noLint 'sym)</code></a>
+<dt><code>(noLint 'sym|(sym . cls) 'sym2)</code>
+<dd>Excludes the check for a function definition of <code>sym</code> (in the
+first form), or for variable binding and usage of <code>sym2</code> in the
+function definition, file contents or method body of <code>sym</code> (second
+form), during calls to <code><a href="refL.html#lint">lint</a></code>. See also
+<code><a href="refL.html#lintAll">lintAll</a></code>.
+
+<pre><code>
+: (de foo ()
+   (bar FreeVariable) )
+-> foo
+: (lint 'foo)
+-> ((def bar) (bnd FreeVariable))
+: (noLint 'bar)
+-> bar
+: (noLint 'foo 'FreeVariable)
+-> (foo . FreeVariable)
+: (lint 'foo)
+-> NIL
+</code></pre>
+
+<dt><a name="nond"><code>(nond ('any1 . prg1) ('any2 . prg2) ..) -> any</code></a>
+<dd>Negated ("non-cond") multi-way conditional: If any of the <code>anyN</code>
+conditions evaluates to <code>NIL</code>, <code>prgN</code> is executed and the
+result returned. Otherwise (all conditions evaluate to non-<code>NIL</code>),
+<code>NIL</code> is returned. See also <code><a
+href="refC.html#cond">cond</a></code>, <code><a
+href="refI.html#ifn">ifn</a></code> and <code><a
+href="refU.html#unless">unless</a></code>.
+
+<pre><code>
+: (nond
+   ((= 3 3) (println 1))
+   ((= 3 4) (println 2))
+   (NIL (println 3)) )
+2
+-> 2
+</code></pre>
+
+<dt><a name="nor"><code>(nor 'any ..) -> flg</code></a>
+<dd>Logical NOR. The expressions <code>any</code> are evaluated from left to
+right. If a non-<code>NIL</code> value is encountered, <code>NIL</code> is
+returned immediately. Else <code>T</code> is returned. <code>(nor ..)</code> is
+equivalent to <code>(not (or ..))</code>.
+
+<pre><code>
+: (nor (lt0 7) (= 3 4))
+-> T
+</code></pre>
+
+<dt><a name="not"><code>(not 'any) -> flg</code></a>
+<dd>Logical negation. Returns <code>T</code> if <code>any</code> evaluates to
+<code>NIL</code>.
+
+<pre><code>
+: (not (== 'a 'a))
+-> NIL
+: (not (get 'a 'a))
+-> T
+</code></pre>
+
+<dt><a name="not/1"><code>not/1</code></a>
+<dd><a href="ref.html#pilog">Pilog</a> predicate that succeeds if and only if
+the goal cannot be proven. See also <code><a
+href="refN.html#nil/1">nil/1</a></code>, <code><a
+href="refT.html#true/0">true/0</a></code> and <code><a
+href="refF.html#fail/0">fail/0</a></code>.
+
+<pre><code>
+: (? (equal 3 4))
+-> NIL
+: (? (not (equal 3 4)))
+-> T
+</code></pre>
+
+<dt><a name="nth"><code>(nth 'lst 'cnt ..) -> lst</code></a>
+<dd>Returns the tail of <code>lst</code> starting from the <code>cnt</code>'th
+element of <code>lst</code>. Successive <code>cnt</code> arguments operate on
+the results in the same way. <code>(nth 'lst 2)</code> is equivalent to
+<code>(cdr 'lst)</code>. See also <code><a href="refG.html#get">get</a></code>.
+
+<pre><code>
+: (nth '(a b c d) 2)
+-> (b c d)
+: (nth '(a (b c) d) 2 2)
+-> (c)
+: (cdadr '(a (b c) d))
+-> (c)
+</code></pre>
+
+<dt><a name="num?"><code>(num? 'any) -> num | NIL</code></a>
+<dd>Returns <code>any</code> when the argument <code>any</code> is a number,
+otherwise <code>NIL</code>.
+
+<pre><code>
+: (num? 123)
+-> 123
+: (num? (1 2 3))
+-> NIL
+</code></pre>
+
+</dl>
+
+</body>
+</html>
diff --git a/doc/refO.html b/doc/refO.html
@@ -0,0 +1,262 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN" "http://www.w3.org/TR/1998/REC-html40-19980424/loose.dtd">
+<html lang="en">
+<head>
+<meta http-equiv="Content-Type" content="text/html; charset=utf-8">
+<title>O</title>
+<link rel="stylesheet" href="doc.css" type="text/css">
+</head>
+<body>
+
+<h1>O</h1>
+
+<dl>
+
+<dt><a name="*Once"><code>*Once</code></a>
+<dd>Holds an <code><a href="refI.html#idx">idx</a></code> tree of already
+<code><a href="refL.html#load">load</a></code>ed source locations (as returned
+by <code><a href="refF.html#file">file</a></code>) See also <code><a
+href="refO.html#once">once</a></code>.
+
+<pre><code>
+: *Once
+-> (("lib/" "misc.l" . 11) (("lib/" "http.l" . 9) (("lib/" "form.l" . 11))))
+</code></pre>
+
+<dt><a name="*OS"><code>*OS</code></a>
+<dd>A global constant holding the name of the operating system. Possible values
+include <code>"Linux"</code>, <code>"FreeBSD"</code>, <code>"Darwin"</code> or
+<code>"Cygwin"</code>.
+
+<pre><code>
+: *OS
+-> "Linux"
+</code></pre>
+
+<dt><a name="obj"><code>(obj (typ var [hook] val ..) var2 val2 ..) -> obj</code></a>
+<dd>Finds or creates a database object (using <code><a
+href="refR.html#request">request</a></code>) corresponding to <code>(typ var
+[hook] val ..)</code>, and initializes additional properties using the
+<code>varN</code> and <code>valN</code> arguments.
+
+<pre><code>
+: (obj ((+Item) nr 2) nm "Spare Part" sup `(db 'nr '+CuSu 2) inv 100 pr 1250)
+-> {3-2}
+</code></pre>
+
+<dt><a name="object"><code>(object 'sym 'any ['sym2 'any2 ..]) -> obj</code></a>
+<dd>Defines <code>sym</code> to be an object with the value (or type)
+<code>any</code>. The property list is initialized with all optionally supplied
+key-value pairs. See also <code><a href="ref.html#oop">OO Concepts</a></code>,
+<code><a href="refN.html#new">new</a></code>, <code><a
+href="refT.html#type">type</a></code> and <code><a
+href="refI.html#isa">isa</a></code>.
+
+<pre><code>
+: (object 'Obj '(+A +B +C) 'a 1 'b 2 'c 3)
+-> Obj
+: (show 'Obj)
+Obj (+A +B +C)
+   c 3
+   b 2
+   a 1
+-> Obj
+</code></pre>
+
+<dt><a name="oct"><code>(oct 'num) -> sym</code></a>
+<dt><code>(oct 'sym) -> num</code>
+<dd>Converts a number <code>num</code> to an octal string, or an octal string
+<code>sym</code> to a number. See also <code><a
+href="refH.html#hex">hex</a></code> and <code><a
+href="refF.html#format">format</a></code>.
+
+<pre><code>
+: (oct 73)
+-> "111"
+: (oct "111")
+-> 73
+</code></pre>
+
+<dt><a name="off"><code>(off var ..) -> NIL</code></a>
+<dd>Stores <code>NIL</code> in all <code>var</code> arguments. See also <code><a
+href="refO.html#on">on</a></code>, <code><a
+href="refO.html#onOff">onOff</a></code>, <code><a
+href="refZ.html#zero">zero</a></code> and <code><a
+href="refO.html#one">one</a></code>.
+
+<pre><code>
+: (off A B)
+-> NIL
+: A
+-> NIL
+: B
+-> NIL
+</code></pre>
+
+<dt><a name="offset"><code>(offset 'lst1 'lst2) -> cnt | NIL</code></a>
+<dd>Returns the <code>cnt</code> position of the tail list <code>lst1</code> in
+<code>lst2</code>, or <code>NIL</code> if it is not found. See also <code><a
+href="refI.html#index">index</a></code>.
+
+<pre><code>
+: (offset '(c d e f) '(a b c d e f))
+-> 3
+: (offset '(c d e) '(a b c d e f))
+-> NIL
+</code></pre>
+
+<dt><a name="on"><code>(on var ..) -> T</code></a>
+<dd>Stores <code>T</code> in all <code>var</code> arguments. See also <code><a
+href="refO.html#off">off</a></code>, <code><a
+href="refO.html#onOff">onOff</a></code>, <code><a
+href="refZ.html#zero">zero</a></code> and <code><a
+href="refO.html#one">one</a></code>.
+
+<pre><code>
+: (on A B)
+-> T
+: A
+-> T
+: B
+-> T
+</code></pre>
+
+<dt><a name="once"><code>(once . prg) -> any</code></a>
+<dd>Executes <code>prg</code> once, when the current file is <code><a
+href="refL.html#load">load</a></code>ed the first time. Subsequent loads at a
+later time will not execute <code>prg</code>, and <code>once</code> returns
+<code>NIL</code>. See also <code><a href="refO.html#*Once">*Once</a></code>.
+
+<pre><code>
+(once
+   (zero *Cnt1 *Cnt2)  # Init counters
+   (load "file1.l" "file2.l") )  # Load other files
+</code></pre>
+
+<dt><a name="one"><code>(one var ..) -> 1</code></a>
+<dd>Stores <code>1</code> in all <code>var</code> arguments. See also <code><a
+href="refZ.html#zero">zero</a></code>, <code><a
+href="refO.html#on">on</a></code>, <code><a href="refO.html#off">off</a></code>
+and <code><a href="refO.html#onOff">onOff</a></code>.
+
+<pre><code>
+: (one A B)
+-> 1
+: A
+-> 1
+: B
+-> 1
+</code></pre>
+
+<dt><a name="onOff"><code>(onOff var ..) -> flg</code></a>
+<dd>Logically negates the values of all <code>var</code> arguments. Returns the
+new value of the last symbol. See also <code><a
+href="refO.html#on">on</a></code>, <code><a href="refO.html#off">off</a></code>,
+<code><a href="refZ.html#zero">zero</a></code> and <code><a
+href="refO.html#one">one</a></code>.
+
+<pre><code>
+: (onOff A B)
+-> T
+: A
+-> T
+: B
+-> T
+: (onOff A B)
+-> NIL
+: A
+-> NIL
+: B
+-> NIL
+</code></pre>
+
+<dt><a name="open"><code>(open 'any) -> cnt | NIL</code></a>
+<dd>Opens the file with the name <code>any</code> in read/write mode, and
+returns a file descriptor <code>cnt</code> (or <code>NIL</code> on error). A
+leading "<code>@</code>" character in <code>any</code> is substituted with the
+<u>PicoLisp Home Directory</u>, as it was remembered during interpreter startup.
+If the file does not exist, it is created. The file descriptor can be used in
+subsequent calls to <code><a href="refI.html#in">in</a></code> and <code><a
+href="refO.html#out">out</a></code>. See also <code><a
+href="refC.html#close">close</a></code>.
+
+<pre><code>
+: (open "x")
+-> 3
+</code></pre>
+
+<dt><a name="opid"><code>(opid) -> pid | NIL</code></a>
+<dd>Returns the corresponding process ID when the current output channel is
+writing to a pipe, otherwise <code>NIL</code>. See also <code><a
+href="refI.html#ipid">ipid</a></code> and <code><a
+href="refO.html#out">out</a></code>.
+
+<pre><code>
+: (out '(cat) (call 'ps "-p" (opid)))
+  PID TTY          TIME CMD
+ 7127 pts/3    00:00:00 cat
+-> T
+</code></pre>
+
+<dt><a name="opt"><code>(opt) -> sym</code></a>
+<dd>Return the next command line argument (option) as a string, and remove it
+from the remaining command line arguments. See also <code><a
+href="ref.html#invoc">Invocation</a></code> and <code><a
+href="refA.html#argv">argv</a></code>.
+
+<pre><code>
+$ ./p  -"de f () (println 'opt (opt))"  -f abc  -bye
+opt "abc"
+</code></pre>
+
+<dt><a name="or"><code>(or 'any ..) -> any</code></a>
+<dd>Logical OR. The expressions <code>any</code> are evaluated from left to
+right. If a non-<code>NIL</code> value is encountered, it is returned
+immediately. Else the result of the last expression is returned.
+
+<pre><code>
+: (or (= 3 3) (read))
+-> T
+: (or (= 3 4) (read))
+abc
+-> abc
+</code></pre>
+
+<dt><a name="or/2"><code>or/2</code></a>
+<dd><a href="ref.html#pilog">Pilog</a> predicate that takes an arbitrary number
+of clauses, and succeeds if one of them can be proven. See also <code><a
+href="refN.html#not/1">not/1</a></code>.
+
+<pre><code>
+: (?
+   (or
+      ((equal 3 @X) (equal @X 4))
+      ((equal 7 @X) (equal @X 7)) ) )
+ @X=7
+-> NIL</code></pre>
+
+<dt><a name="out"><code>(out 'any . prg) -> any</code></a>
+<dd>Opens <code>any</code> as output channel during the execution of
+<code>prg</code>. The current output channel will be saved and restored
+appropriately. If the argument is <code>NIL</code>, standard output is used. If
+the argument is a symbol, it is used as a file name (opened in "append" mode if
+the first character is "<code>+</code>"). If it is a positve number, it is used
+as the descriptor of an open file. If it is a negative number, the saved output
+channel such many levels above the current one is used. Otherwise (if it is a
+list), it is taken as a command with arguments, and a pipe is opened for output.
+See also <code><a href="refO.html#opid">opid</a></code>, <code> <a
+href="refC.html#call">call</a></code>, <code><a
+href="refI.html#in">in</a></code>, <code> <a
+href="refP.html#pipe">pipe</a></code>, <code> <a
+href="refC.html#ctl">ctl</a></code>, <code><a
+href="refC.html#close">close</a></code> and <code><a
+href="refL.html#load">load</a></code>.
+
+<pre><code>
+: (out "a" (println 123 '(a b c) 'def))  # Write one line to file "a"
+-> def
+</code></pre>
+
+</dl>
+
+</body>
+</html>
diff --git a/doc/refP.html b/doc/refP.html
@@ -0,0 +1,816 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN" "http://www.w3.org/TR/1998/REC-html40-19980424/loose.dtd">
+<html lang="en">
+<head>
+<meta http-equiv="Content-Type" content="text/html; charset=utf-8">
+<title>P</title>
+<link rel="stylesheet" href="doc.css" type="text/css">
+</head>
+<body>
+
+<h1>P</h1>
+
+<dl>
+
+<dt><a name="*PPid"><code>*PPid</code></a>
+<dd>A global constant holding the process-id of the parent picolisp process, or
+<code>NIL</code> if the current process is a top level process.
+
+<pre><code>
+: (println *PPid *Pid)
+NIL 5286
+
+: (unless (fork) (println *PPid *Pid) (bye))
+5286 5522
+</code></pre>
+
+<dt><a name="*Pid"><code>*Pid</code></a>
+<dd>A global constant holding the current process-id.
+
+<pre><code>
+: *Pid
+-> 6386
+: (call "ps")  # Show processes
+  PID TTY          TIME CMD
+ .... ...      ........ .....
+ 6386 pts/1    00:00:00 bin/picolisp   # <- current process
+ 6388 pts/1    00:00:00 ps
+-> T
+</code></pre>
+
+<dt><a name="pack"><code>(pack 'any ..) -> sym</code></a>
+<dd>Returns a transient symbol whose name is concatenated from all arguments
+<code>any</code>. A <code>NIL</code> arguments contributes nothing to the result
+string, a number is converted to a digit string, a symbol supplies the
+characters of its name, and for a list its elements are taken. See also <code><a
+href="refT.html#text">text</a></code> and <code><a
+href="refG.html#glue">glue</a></code>.
+
+<pre><code>
+: (pack 'car " is " 1 '(" symbol " name))
+-> "car is 1 symbol name"
+</code></pre>
+
+<dt><a name="pad"><code>(pad 'cnt 'num) -> sym</code></a>
+<dd>Returns a transient symbol with <code>num</code> <code><a
+href="refP.html#pack">pack</a></code>ed with leading '0' characters, up to a
+field width of <code>cnt</code>. See also <code><a
+href="refF.html#format">format</a></code> and <code><a
+href="refA.html#align">align</a></code>.
+
+<pre><code>
+: (pad 5 1)
+-> "00001"
+: (pad 5 123456789)
+-> "123456789"
+</code></pre>
+
+<dt><a name="pair"><code>(pair 'any) -> any</code></a>
+<dd>Returns <code>any</code> when the argument a cons pair cell. See also
+<code><a href="refA.html#atom">atom</a></code>.
+
+<pre><code>
+: (pair NIL)
+-> NIL
+: (pair (1 . 2))
+-> (1 . 2)
+: (pair (1 2 3))
+-> (1 2 3)
+</code></pre>
+
+<dt><a name="part/3"><code>part/3</code></a>
+<dd><a href="ref.html#pilog">Pilog</a> predicate that succeeds if the first
+argument, after <code><a href="refF.html#fold">fold</a></code>ing it to a
+canonical form, is a <i>substring</i> of the folded string representation of the
+result of applying the <code><a href="refG.html#get">get</a></code> algorithm to
+the following arguments. Typically used as filter predicate in <code><a
+href="refS.html#select/3">select/3</a></code> database queries. See also
+<code><a href="refS.html#sub?">sub?</a></code>, <code><a
+href="refI.html#isa/2">isa/2</a></code>, <code><a
+href="refS.html#same/3">same/3</a></code>, <code><a
+href="refB.html#bool/3">bool/3</a></code>, <code><a
+href="refR.html#range/3">range/3</a></code>, <code><a
+href="refH.html#head/3">head/3</a></code>, <code><a
+href="refF.html#fold/3">fold/3</a></code> and <code><a
+href="refT.html#tolr/3">tolr/3</a></code>.
+
+<pre><code>
+: (?
+   @Nr (1 . 5)
+   @Nm "part"
+   (select (@Item)
+      ((nr +Item @Nr) (nm +Item @Nm))
+      (range @Nr @Item nr)
+      (part @Nm @Item nm) ) )
+ @Nr=(1 . 5) @Nm="part" @Item={3-1}                                              @Nr=(1 . 5) @Nm="part" @Item={3-2}
+-> NIL
+</code></pre>
+
+<dt><a name="pass"><code>(pass 'fun ['any ..]) -> any</code></a>
+<dd>Passes to <code>fun</code> all arguments <code>any</code>, and all remaining
+variable arguments (<code>@</code>) as they would be returned by <code><a
+href="refR.html#rest">rest</a></code>. <code>(pass 'fun 'any)</code> is
+equivalent to <code>(apply 'fun (rest) 'any)</code>. See also <code><a
+href="refA.html#apply">apply</a></code>.
+
+<pre><code>
+: (de bar (A B . @)
+   (println 'bar A B (rest)) )
+-> bar
+: (de foo (A B . @)
+   (println 'foo A B)
+   (pass bar 1)
+   (pass bar 2) )
+-> foo
+: (foo 'a 'b 'c 'd 'e 'f)
+foo a b
+bar 1 c (d e f)
+bar 2 c (d e f)
+-> (d e f)
+</code></pre>
+
+<dt><a name="pat?"><code>(pat? 'any) -> pat | NIL</code></a>
+<dd>Returns <code>any</code> when the argument <code>any</code> is a symbol
+whose name starts with an at-mark "<code>@</code>", otherwise <code>NIL</code>.
+
+<pre><code>
+: (pat? '@)
+-> @
+: (pat? "@Abc")
+-> "@Abc"
+: (pat? "ABC")
+-> NIL
+: (pat? 123)
+-> NIL
+</code></pre>
+
+<dt><a name="patch"><code>(patch 'lst 'any . prg) -> any</code></a>
+<dd>Destructively replaces all sub-expressions of <code>lst</code>, that
+<code><a href="refM.html#match">match</a></code> the pattern <code>any</code>,
+by the result of the execution of <code>prg</code>. See also <code><a
+href="refD.html#daemon">daemon</a></code> and <code><a
+href="refR.html#redef">redef</a></code>.
+
+<pre><code>
+: (pp 'hello)
+(de hello NIL
+   (prinl "Hello world!") )
+-> hello
+
+: (patch hello 'prinl 'println)
+-> NIL
+: (pp 'hello)
+(de hello NIL
+   (println "Hello world!") )
+-> hello
+
+: (patch hello '(prinl @S) (fill '(println "We said: " . @S)))
+-> NIL
+: (hello)
+We said: Hello world!
+-> "Hello world!"
+</code></pre>
+
+<dt><a name="path"><code>(path 'any) -> sym</code></a>
+<dd>Substitutes any leading "<code>@</code>" character in the <code>any</code>
+argument with the <u>PicoLisp Home Directory</u>, as it was remembered during
+interpreter startup. Optionally, the name may be preceded by a "<code>+</code>"
+character (as used by <code><a href="refO.html#out">out</a></code>). This
+mechanism is used internally by all I/O functions. See also <code><a
+href="ref.html#invoc">Invocation</a></code> and <code><a
+href="refD.html#dirname">dirname</a></code>.
+
+<pre><code>
+$ /usr/bin/picolisp /usr/lib/picolisp/lib.l
+: (path "a/b/c")
+-> "a/b/c"
+: (path "@a/b/c")
+-> "/usr/lib/picolisp/a/b/c"
+: (path "+@a/b/c")
+-> "+/usr/lib/picolisp/a/b/c"
+</code></pre>
+
+<dt><a name="peek"><code>(peek) -> sym</code></a>
+<dd>Single character look-ahead: Returns the same character as the next call to
+<code><a href="refC.html#char">char</a></code> would return. See also <code><a
+href="refS.html#skip">skip</a></code>.
+
+<pre><code>
+$ cat a
+# Comment
+abcd
+$ ./dbg
+: (in "a" (list (peek) (char)))
+-> ("#" "#")
+</code></pre>
+
+<dt><a name="permute/2"><code>permute/2</code></a>
+<dd><a href="ref.html#pilog">Pilog</a> predicate that succeeds if the second
+argument is a permutation of the list in the second argument. See also <code><a
+href="refA.html#append/3">append/3</a></code>.
+
+<pre><code>
+: (? (permute (a b c) @X))
+ @X=(a b c)
+ @X=(a c b)
+ @X=(b a c)
+ @X=(b c a)
+ @X=(c a b)
+ @X=(c b a)
+-> NIL
+</code></pre>
+
+<dt><a name="pick"><code>(pick 'fun 'lst ..) -> any</code></a>
+<dd>Applies <code>fun</code> to successive elements of <code>lst</code> until
+non-<code>NIL</code> is returned. Returns that value, or <code>NIL</code> if
+<code>fun</code> did not return non-<code>NIL</code> for any element of
+<code>lst</code>. When additional <code>lst</code> arguments are given, their
+elements are also passed to <code>fun</code>. <code>(pick 'fun 'lst)</code> is
+equivalent to <code>(fun (find 'fun 'lst))</code>. See also <code><a
+href="refS.html#seek">seek</a></code>, <code><a
+href="refF.html#find">find</a></code> and <code><a
+href="refE.html#extract">extract</a></code>.
+
+<pre><code>
+: (setq A NIL  B 1  C NIL  D 2  E NIL  F 3)
+-> 3
+: (find val '(A B C D E))
+-> B
+: (pick val '(A B C D E))
+-> 1
+</code></pre>
+
+<dt><a name="pid"><code>(pid 'pid|lst . exe) -> any</code></a>
+<dd>Evaluates <code>exe</code> when the value of the global <code><a
+href="refP.html#*Pid">*Pid</a></code> is equal to the <code>pid</code> argument,
+or a member of the <code>lst</code> argument. Used typically in combination with
+<code><a href="refT.html#tell">tell</a></code> to send a command selectively to
+another process.
+
+<pre><code>
+: (tell 'pid 20290 'gc 0)  # Tell process 20290 to purge unused heap blocks
+-> 0
+</code></pre>
+
+<dt><a name="pilog"><code>(pilog 'lst . prg) -> any</code></a>
+<dd>Evaluates a <a href="ref.html#pilog">Pilog</a> query, and executes
+<code>prg</code> for each result set with all Pilog variables bound to their
+matching values. See also <code><a href="refS.html#solve">solve</a></code>,
+<code><a href="ref_.html#?">?</a></code>, <code><a
+href="refG.html#goal">goal</a></code> and <code><a
+href="refP.html#prove">prove</a></code>.
+
+<pre><code>
+: (pilog '((append @X @Y (a b c))) (println @X '- @Y))
+NIL - (a b c)
+(a) - (b c)
+(a b) - (c)
+(a b c) - NIL
+-> NIL
+</code></pre>
+
+<dt><a name="pipe"><code>(pipe exe) -> cnt</code></a>
+<dt><code>(pipe exe . prg) -> any</code>
+<dd>Executes <code>exe</code> in a <code><a
+href="refF.html#fork">fork</a></code>'ed child process (which terminates
+thereafter). In the first form, <code>pipe</code> just returns a file descriptor
+to read from the standard output of that process. In the second form, it opens
+the standard output of that process as input channel during the execution of
+<code>prg</code>. The current input channel will be saved and restored
+appropriately. See also <code><a href="refI.html#ipid">ipid</a></code>, <code><a
+href="refI.html#in">in</a></code>, <code><a href="refO.html#out">out</a></code>
+and <code><a href="refR.html#rpc">rpc</a></code>.
+
+<pre><code>
+: (pipe                                # equivalent to 'any'
+   (prinl "(a b # Comment^Jc d)")         # (child process)
+   (read) )                               # (parent process)
+-> (a b c d)
+: (pipe                                # pipe through an external program
+   (out '(tr "[a-z]" "[A-Z]")             # (child process)
+      (prinl "abc def ghi") )
+   (line T) )                             # (parent process)
+-> "ABC DEF GHI"
+</code></pre>
+
+<dt><a name="place"><code>(place 'cnt 'lst 'any) -> lst</code></a>
+<dd>Places <code>any</code> into <code>lst</code> at position <code>cnt</code>.
+See also <code><a href="refI.html#insert">insert</a></code>, <code><a
+href="refR.html#remove">remove</a></code>, <code><a
+href="refA.html#append">append</a></code>, <code><a
+href="refD.html#delete">delete</a></code> and <code><a
+href="refR.html#replace">replace</a></code>.
+
+<pre><code>
+: (place 3 '(a b c d e) 777)
+-> (a b 777 d e)
+: (place 1 '(a b c d e) 777)
+-> (777 b c d e)
+: (place 9 '(a b c d e) 777)
+-> (a b c d e 777)
+</code></pre>
+
+<dt><a name="poll"><code>(poll 'cnt) -> cnt | NIL</code></a>
+<dd>Checks for the availability of data for reading on the file descriptor
+<code>cnt</code>. See also <code><a href="refO.html#open">open</a></code>,
+<code><a href="refI.html#in">in</a></code> and <code><a
+href="refC.html#close">close</a></code>.
+
+<pre><code>
+: (and (poll *Fd) (in @ (read)))  # Prevent blocking
+</code></pre>
+
+<dt><a name="pool"><code>(pool ['sym1 ['lst] ['sym2] ['sym3]]) -> T</code></a>
+<dd>Opens the file <code>sym1</code> as a database file in read/write mode. If
+the file does not exist, it is created. A currently open database is closed.
+<code>lst</code> is a list of block size scale factors (i.e. numbers),
+defaulting to (2) (for a single file with a 256 byte block size). If
+<code>lst</code> is given, an individual database file is opened for each item.
+If <code>sym2</code> is non-<code>NIL</code>, it is opened in append-mode as an
+asynchronous replication journal. If <code>sym3</code> is non-<code>NIL</code>,
+it is opened for reading and appending, to be used as a synchronous transaction
+log during <code><a href="refC.html#commit">commit</a></code>s. See also
+<code><a href="refD.html#dbs">dbs</a></code>, <code><a
+href="refD.html#*Dbs">*Dbs</a></code> and <code><a
+href="refJ.html#journal">journal</a></code>.
+
+<pre><code>
+: (pool "/dev/hda2")
+-> T
+
+: *Dbs
+-> (1 2 2 4)
+: (pool "dbFile" *Dbs)
+-> T
+:
+abu:~/pico  ls -l dbFile*
+-rw-r--r-- 1 abu abu 256 2007-06-11 07:57 dbFile1
+-rw-r--r-- 1 abu abu  13 2007-06-11 07:57 dbFile2
+-rw-r--r-- 1 abu abu  13 2007-06-11 07:57 dbFile3
+-rw-r--r-- 1 abu abu  13 2007-06-11 07:57 dbFile4
+</code></pre>
+
+<dt><a name="pop"><code>(pop 'var) -> any</code></a>
+<dd>Pops the first element (CAR) from the stack in <code>var</code>. See also
+<code><a href="refP.html#push">push</a></code>, <code><a
+href="refQ.html#queue">queue</a></code>, <code><a
+href="refC.html#cut">cut</a></code>, <code><a
+href="refD.html#del">del</a></code> and <code><a
+href="refF.html#fifo">fifo</a></code>.
+
+<pre><code>
+: (setq S '((a b c) (1 2 3)))
+-> ((a b c) (1 2 3))
+: (pop S)
+-> a
+: (pop (cdr S))
+-> 1
+: (pop 'S)
+-> (b c)
+: S
+-> ((2 3))
+</code></pre>
+
+<dt><a name="port"><code>(port ['T] 'cnt|(cnt . cnt) ['var]) -> cnt</code></a>
+<dd>Opens a TCP-Port <code>cnt</code> (or a UDP-Port if the first argument is
+<code>T</code>), and returns a socket descriptor suitable as an argument for
+<code><a href="refL.html#listen">listen</a></code> or <code><a
+href="refA.html#accept">accept</a></code> (or <code><a
+href="refU.html#udp">udp</a></code>, respectively). If <code>cnt</code> is zero,
+some free port number is allocated. If a pair of <code>cnt</code>s is given
+instead, it should be a range of numbers which are tried in turn. When
+<code>var</code> is given, it is bound to the port number.
+
+<pre><code>
+: (port 0 'A)                       # Allocate free port
+-> 4
+: A
+-> 1034                             # Got 1034
+: (port (4000 . 4008) 'A)           # Try one of these ports
+-> 5
+: A
+-> 4002
+</code></pre>
+
+<dt><a name="pp"><code>(pp 'sym) -> sym</code></a>
+<dt><code>(pp 'sym 'cls) -> sym</code>
+<dt><code>(pp '(sym . cls)) -> sym</code>
+<dd>Pretty-prints the function or method definition of <code>sym</code>. The
+output format would regenerate that same definition when read and executed. See
+also <code><a href="refP.html#pretty">pretty</a></code>, <code><a
+href="refD.html#debug">debug</a></code> and <code><a
+href="refV.html#vi">vi</a></code>.
+
+<pre><code>
+: (pp 'tab)
+(de tab (Lst . @)
+   (for N Lst
+      (let V (next)
+         (and (gt0 N) (space (- N (length V))))
+         (prin V)
+         (and
+            (lt0 N)
+            (space (- 0 N (length V))) ) ) )
+   (prinl) )
+-> tab
+
+: (pp 'has> '+Entity)
+(dm has> (Var Val)
+   (or
+      (nor Val (get This Var))
+      (has> (meta This Var) Val (get This Var)) ) )
+-> has>
+
+: (more (can 'has>) pp)
+(dm (has> . +relation) (Val X)
+   (and (= Val X) X) )
+
+(dm (has> . +Fold) (Val X)
+   (extra
+      Val
+      (if (= Val (fold Val)) (fold X) X) ) )
+
+(dm (has> . +Entity) (Var Val)
+   (or
+      (nor Val (get This Var))
+      (has> (meta This Var) Val (get This Var)) ) )
+
+(dm (has> . +List) (Val X)
+   (and
+      Val
+      (or
+         (extra Val X)
+         (find '((X) (extra Val X)) X) ) ) )
+
+(dm (has> . +Bag) (Val X)
+   (and
+      Val
+      (or (super Val X) (car (member Val X))) ) )
+</code></pre>
+
+<dt><a name="pr"><code>(pr 'any ..) -> any</code></a>
+<dd>Binary print: Prints all <code>any</code> arguments to the current output
+channel in encoded binary format. See also <code><a
+href="refR.html#rd">rd</a></code>, <code><a
+href="refT.html#tell">tell</a></code>, <code><a
+href="refH.html#hear">hear</a></code>, <code><a
+href="refR.html#rpc">rpc</a></code> and <code><a
+href="refW.html#wr">wr</a></code>.
+
+<pre><code>
+: (out "x" (pr 7 "abc" (1 2 3) 'a))  # Print to "x"
+-> a
+: (hd "x")
+00000000  04 0E 0E 61 62 63 01 04 02 04 04 04 06 03 05 61  ...abc.........a
+-> NIL
+</code></pre>
+
+<dt><a name="prEval"><code>(prEval 'prg ['cnt]) -> any</code></a>
+<dd>Executes <code>prg</code>, similar to <code><a
+href="refR.html#run">run</a></code>, by evaluating all expressions in
+<code>prg</code> (within the binding environment given by <code>cnt-1</code>).
+As a side effect, all atomics expression will be printed with <code><a
+href="refP.html#prinl">prinl</a></code>. See also <code><a
+href="refE.html#eval">eval</a></code>.
+
+<pre><code>
+: (let Prg 567
+   (prEval
+      '("abc" (prinl (+ 1 2 3)) Prg 987) ) )
+abc
+6
+567
+987
+-> 987
+</code></pre>
+
+<dt><a name="pre?"><code>(pre? 'any1 'any2) -> any2 | NIL</code></a>
+<dd>Returns <code>any2</code> when the string representation of
+<code>any1</code> is a prefix of the string representation of <code>any2</code>.
+See also <code><a href="refS.html#sub?">sub?</a></code>.
+
+<pre><code>
+: (pre? "abc" "abcdef")
+-> "abcdef"
+: (pre? "def" "abcdef")
+-> NIL
+: (pre? (+ 3 4) "7fach")
+-> "7fach"
+: (pre? NIL "abcdef")
+-> "abcdef"
+</code></pre>
+
+<dt><a name="pretty"><code>(pretty 'any 'cnt)</code></a>
+<dd>Pretty-prints <code>any</code>. If <code>any</code> is an atom, or a list
+with a <code><a href="refS.html#size">size</a></code> not greater than 12, it is
+<code><a href="refP.html#print">print</a></code>ed as is. Otherwise, only the
+opening parenthesis and the CAR of the list is printed, all other elementes are
+pretty-printed recursively indented by three spaces, followed by a space and the
+corresponding closing parenthesis. The initial indentation level
+<code>cnt</code> defaults to zero. See also <code><a
+href="refP.html#pp">pp</a></code>.
+
+<pre><code>
+: (pretty '(a (b c d) (e (f (g) (h) (i)) (j (k) (l) (m))) (n o p) q))
+(a
+   (b c d)
+   (e
+      (f (g) (h) (i))
+      (j (k) (l) (m)) )
+   (n o p)
+   q )-> ")"
+</code></pre>
+
+<dt><a name="prin"><code>(prin 'any ..) -> any</code></a>
+<dd>Prints the string representation of all <code>any</code> arguments to the
+current output channel. No space or newline is printed between individual items,
+or after the last item. For lists, all elements are <code>prin</code>'ted
+recursively. See also <code><a href="refP.html#prinl">prinl</a></code>.
+
+<pre><code>
+: (prin 'abc 123 '(a 1 b 2))
+abc123a1b2-> (a 1 b 2)
+</code></pre>
+
+<dt><a name="prinl"><code>(prinl 'any ..) -> any</code></a>
+<dd>Prints the string representation of all <code>any</code> arguments to the
+current output channel, followed by a newline. No space or newline is printed
+between individual items. For lists, all elements are <code>prin</code>'ted
+recursively. See also <code><a href="refP.html#prin">prin</a></code>.
+
+<pre><code>
+: (prinl 'abc 123 '(a 1 b 2))
+abc123a1b2
+-> (a 1 b 2)
+</code></pre>
+
+<dt><a name="print"><code>(print 'any ..) -> any</code></a>
+<dd>Prints all <code>any</code> arguments to the current output channel. If
+there is more than one argument, a space is printed between successive
+arguments. No space or newline is printed after the last item. See also <code><a
+href="refP.html#println">println</a></code>, <code><a
+href="refP.html#printsp">printsp</a></code>, <code><a
+href="refS.html#sym">sym</a></code> and <code><a
+href="refS.html#str">str</a></code>
+
+<pre><code>
+: (print 123)
+123-> 123
+: (print 1 2 3)
+1 2 3-> 3
+: (print '(a b c) 'def)
+(a b c) def-> def
+</code></pre>
+
+<dt><a name="println"><code>(println 'any ..) -> any</code></a>
+<dd>Prints all <code>any</code> arguments to the current output channel,
+followed by a newline. If there is more than one argument, a space is printed
+between successive arguments. See also <code><a
+href="refP.html#print">print</a></code>, <code><a
+href="refP.html#printsp">printsp</a></code>.
+
+<pre><code>
+: (println '(a b c) 'def)
+(a b c) def
+-> def
+</code></pre>
+
+<dt><a name="printsp"><code>(printsp 'any ..) -> any</code></a>
+<dd>Prints all <code>any</code> arguments to the current output channel,
+followed by a space. If there is more than one argument, a space is printed
+between successive arguments. See also <code><a
+href="refP.html#print">print</a></code>, <code><a
+href="refP.html#println">println</a></code>.
+
+<pre><code>
+: (printsp '(a b c) 'def)
+(a b c) def -> def
+</code></pre>
+
+<dt><a name="proc"><code>(proc 'sym ..) -> T</code></a>
+<dd>Shows a list of processes with command names given by the <code>sym</code>
+arguments, using the system <code>ps</code> utility. See also <code><a
+href="refH.html#hd">hd</a></code>.
+
+<pre><code>
+:  (proc 'picolisp)
+  PID  PPID  STARTED    SZ %CPU WCHAN  CMD
+ 9781  8895 16:06:53  2536  0.8 select ./bin/picolisp -on *Dbg ./lib.l @ext.l @dbg.l app/main.l lib/too.l -main -go
+ 9884  9781 16:07:01  2540  0.0 wait     ./bin/picolisp -on *Dbg ./lib.l @ext.l @dbg.l app/main.l lib/too.l -main -go
+-> T</code></pre>
+
+<dt><a name="prog"><code>(prog . prg) -> any</code></a>
+<dd>Executes <code>prg</code>, and returns the result of the last expression.
+See also <code><a href="refN.html#nil">nil</a></code>, <code><a
+href="refT.html#t">t</a></code>, <code><a
+href="refP.html#prog1">prog1</a></code> and <code><a
+href="refP.html#prog2">prog2</a></code>.
+
+<pre><code>
+: (prog (print 1) (print 2) (print 3))
+123-> 3
+</code></pre>
+
+<dt><a name="prog1"><code>(prog1 'any1 . prg) -> any1</code></a>
+<dd>Executes all arguments, and returns the result of the first expression
+<code>any1</code>. See also <code><a href="refN.html#nil">nil</a></code>,
+<code><a href="refT.html#t">t</a></code>, <code><a
+href="refP.html#prog">prog</a></code> and <code><a
+href="refP.html#prog2">prog2</a></code>.
+
+<pre><code>
+: (prog1 (print 1) (print 2) (print 3))
+123-> 1
+</code></pre>
+
+<dt><a name="prog2"><code>(prog2 'any1 'any2 . prg) -> any2</code></a>
+<dd>Executes all arguments, and returns the result of the second expression
+<code>any2</code>. See also <code><a href="refN.html#nil">nil</a></code>,
+<code><a href="refT.html#t">t</a></code>, <code><a
+href="refP.html#prog">prog</a></code> and <code><a
+href="refP.html#prog1">prog1</a></code>.
+
+<pre><code>
+: (prog2 (print 1) (print 2) (print 3))
+123-> 2
+</code></pre>
+
+<dt><a name="prop"><code>(prop 'sym1|lst ['sym2|cnt ..] 'sym) -> lst|sym</code></a>
+<dd>Fetches a property for a property key <code>sym</code> from a symbol. That
+symbol is <code>sym1</code> (if no other arguments are given), or a symbol found
+by applying the <code><a href="refG.html#get">get</a></code> algorithm to
+<code>sym1|lst</code> and the following arguments. The property (the cell, not
+just its value) is returned, suitable for direct (destructive) manipulations.
+See also <code><a href="ref_.html#::">::</a></code>.
+
+<pre><code>
+: (put 'X 'cnt 0)
+-> 0
+: (prop 'X 'cnt)
+-> (0 . cnt)
+: (inc (prop 'X 'cnt))        # Directly manipulate the property value
+-> 1
+: (get 'X 'cnt)
+-> 1
+</code></pre>
+
+<dt><a name="protect"><code>(protect . prg) -> any</code></a>
+<dd>Executes <code>prg</code>, and returns the result of the last expression. If
+a signal is received during that time, its handling will be delayed until the
+execution of <code>prg</code> is completed. See also <code><a
+href="refA.html#alarm">alarm</a></code>, <a href="refH.html#*Hup">*Hup</a>, <a
+href="refS.html#*Sig1">*Sig[12]</a> and <code><a
+href="refK.html#kill">kill</a></code>.
+
+<pre><code>
+: (protect (journal "db1.log" "db2.log"))
+-> T
+</code></pre>
+
+<dt><a name="prove"><code>(prove 'lst ['lst]) -> lst</code></a>
+<dd>The <a href="ref.html#pilog">Pilog</a> interpreter. Tries to prove the query
+list in the first argument, and returns an association list of symbol-value
+pairs, or <code>NIL</code> if not successful. The query list is modified as a
+side effect, allowing subsequent calls to <code>prove</code> for further
+results. The optional second argument may contain a list of symbols; in that
+case the successful matches of rules defined for these symbols will be traced.
+See also <code><a href="refG.html#goal">goal</a></code>, <code><a
+href="ref_.html#->">-&gt</a></code> and <code><a
+href="refU.html#unify">unify</a></code>.
+
+<pre><code>
+: (prove (goal '((equal 3 3))))
+-> T
+: (prove (goal '((equal 3 @X))))
+-> ((@X . 3))
+: (prove (goal '((equal 3 4))))
+-> NIL
+</code></pre>
+
+<dt><a name="prune"><code>(prune ['flg])</code></a>
+<dd>Optimizes memory usage by pruning in-memory leaf nodes of database trees.
+Typically called repeatedly during heavy data imports. If <code>flg</code> is
+non-<code>NIL</code>, further pruning will be disabled. See also <code><a
+href="refL.html#lieu">lieu</a></code>.
+
+<pre><code>
+(in File1
+   (while (someData)
+      (new T '(+Cls1) ..)
+      (at (0 . 10000) (commit) (prune)) ) )
+(in File2
+   (while (moreData)
+      (new T '(+Cls2) ..)
+      (at (0 . 10000) (commit) (prune)) ) )
+(commit)
+(prune T)
+</code></pre>
+
+<dt><a name="push"><code>(push 'var 'any ..) -> any</code></a>
+<dd>Implements a stack using a list in <code>var</code>. The <code>any</code>
+arguments are cons'ed in front of the value list. See also <code><a
+href="refP.html#push1">push1</a></code>, <code><a
+href="refP.html#pop">pop</a></code>, <code><a
+href="refQ.html#queue">queue</a></code> and <code><a
+href="refF.html#fifo">fifo</a></code>.
+
+<pre><code>
+: (push 'S 3)              # Use the VAL of 'S' as a stack
+-> 3
+: S
+-> (3)
+: (push 'S 2)
+-> 2
+: (push 'S 1)
+-> 1
+: S
+-> (1 2 3)
+: (push S 999)             # Now use the CAR of the list in 'S'
+-> 999
+: (push S 888 777)
+-> 777
+: S
+-> ((777 888 999 . 1) 2 3)
+</code></pre>
+
+<dt><a name="push1"><code>(push1 'var 'any ..) -> any</code></a>
+<dd>Maintains a unique list in <code>var</code>. Each <code>any</code> argument
+is cons'ed in front of the value list only if it is not already a <code><a
+href="refM.html#member">member</a></code> of that list. See also <code><a
+href="refP.html#push">push</a></code>, <code><a
+href="refP.html#pop">pop</a></code> and <code><a
+href="refQ.html#queue">queue</a></code>.
+
+<pre><code>
+: (push1 'S 1 2 3)
+-> 3
+: S
+-> (3 2 1)
+: (push1 'S 2 4)
+-> 4
+: S
+-> (4 3 2 1)
+</code></pre>
+
+<dt><a name="put"><code>(put 'sym1|lst ['sym2|cnt ..] 'sym|0 'any) -> any</code></a>
+<dd>Stores a new value <code>any</code> for a property key <code>sym</code> (or
+in the value cell for zero) in a symbol. That symbol is <code>sym1</code> (if no
+other arguments are given), or a symbol found by applying the <code><a
+href="refG.html#get">get</a></code> algorithm to <code>sym1|lst</code> and the
+following arguments. See also <code><a href="ref_.html#=:">=:</a></code>.
+
+<pre><code>
+: (put 'X 'a 1)
+-> 1
+: (get 'X 'a)
+-> 1
+: (prop 'X 'a)
+-> (1 . a)
+</code></pre>
+
+<dt><a name="put!"><code>(put! 'obj 'sym 'any) -> any</code></a>
+<dd><a href="ref.html#trans">Transaction</a> wrapper function for <code><a
+href="refP.html#put">put</a></code>. Note that for setting property values of
+entities typically the <code><a
+href="refE.html#entityMesssages">put!></a></code> message is used. See also
+<code><a href="refN.html#new!">new!</a></code>, <code><a
+href="refS.html#set!">set!</a></code> and <code><a
+href="refI.html#inc!">inc!</a></code>.
+
+<pre><code>
+(put! Obj 'cnt 0)  # Setting a property of a non-entity object
+</code></pre>
+
+<dt><a name="putl"><code>(putl 'sym1|lst1 ['sym2|cnt ..] 'lst) -> lst</code></a>
+<dd>Stores a complete new property list <code>lst</code> in a symbol. That
+symbol is <code>sym1</code> (if no other arguments are given), or a symbol found
+by applying the <code><a href="refG.html#get">get</a></code> algorithm to
+<code>sym1|lst1</code> and the following arguments. All previously defined
+properties for that symbol are lost. See also <code><a
+href="refG.html#getl">getl</a></code> and <code><a
+href="refM.html#maps">maps</a></code>.
+
+<pre><code>
+: (putl 'X '((123 . a) flg ("Hello" . b)))
+-> ((123 . a) flg ("Hello" . b))
+: (get 'X 'a)
+-> 123
+: (get 'X 'b)
+-> "Hello"
+: (get 'X 'flg)
+-> T
+</code></pre>
+
+<dt><a name="pwd"><code>(pwd) -> sym</code></a>
+<dd>Returns the path to the current working directory. See also <code><a
+href="refD.html#dir">dir</a></code> and <code><a
+href="refC.html#cd">cd</a></code>.
+
+<pre><code>
+: (pwd)
+-> "/home/app/"
+</code></pre>
+
+</dl>
+
+</body>
+</html>
diff --git a/doc/refQ.html b/doc/refQ.html
@@ -0,0 +1,107 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN" "http://www.w3.org/TR/1998/REC-html40-19980424/loose.dtd">
+<html lang="en">
+<head>
+<meta http-equiv="Content-Type" content="text/html; charset=utf-8">
+<title>Q</title>
+<link rel="stylesheet" href="doc.css" type="text/css">
+</head>
+<body>
+
+<h1>Q</h1>
+
+<dl>
+
+<dt><a name="qsym"><code>(qsym . sym) -> lst</code></a>
+<dd>Returns a cons pair of the value and property list of <code>sym</code>. See
+also <code><a href="refQ.html#quote">quote</a></code>, <code><a
+href="refV.html#val">val</a></code> and <code><a
+href="refG.html#getl">getl</a></code>.
+
+<pre><code>
+: (setq A 1234)
+-> 1234
+: (put 'A 'a 1)
+-> 1
+: (put 'A 'b 2)
+-> 2
+: (put 'A 'f T)
+-> T
+: (qsym . A)
+-> (1234 f (2 . b) (1 . a))
+</code></pre>
+
+<dt><a name="quote"><code>(quote . any) -> any</code></a>
+<dd>Returns <code>any</code> unevaluated. The reader recognizes the single quote
+char <code>'</code> as a macro for this function. See also <code><a
+href="refL.html#lit">lit</a></code>.
+
+<pre><code>
+: 'a
+-> a
+: '(foo a b c)
+-> (foo a b c)
+: (quote (quote (quote a)))
+-> ('('(a)))
+</code></pre>
+
+<dt><a name="query"><code>(query 'lst ['lst]) -> flg</code></a>
+<dd>Handles an interactive <a href="ref.html#pilog">Pilog</a> query. The two
+<code>lst</code> arguments are passed to <code><a
+href="refP.html#prove">prove</a></code>. <code>query</code> displays each
+result, waits for console input, and terminates when a non-empty line is
+entered. See also <code><a href="ref_.html#?">?</a></code>, <code><a
+href="refP.html#pilog">pilog</a></code> and <code><a
+href="refS.html#solve">solve</a></code>.
+
+<pre><code>
+: (query (goal '((append @X @Y (a b c)))))
+ @X=NIL @Y=(a b c)
+ @X=(a) @Y=(b c).   # Stop
+-> NIL
+</code></pre>
+
+<dt><a name="queue"><code>(queue 'var 'any) -> any</code></a>
+<dd>Implements a queue using a list in <code>var</code>. The <code>any</code>
+argument is (destructively) concatenated to the end of the value list. See also
+<code><a href="refP.html#push">push</a></code>, <code><a
+href="refP.html#pop">pop</a></code> and <code><a
+href="refF.html#fifo">fifo</a></code>.
+
+<pre><code>
+: (queue 'A 1)
+-> 1
+: (queue 'A 2)
+-> 2
+: (queue 'A 3)
+-> 3
+: A
+-> (1 2 3)
+: (pop 'A)
+-> 1
+: A
+-> (2 3)
+</code></pre>
+
+<dt><a name="quit"><code>(quit ['any ['any]])</code></a>
+<dd>Stops current execution. If no arguments are given, all pending <code><a
+href="refF.html#finally">finally</a></code> expressions are executed and control
+is returned to the top level read-eval-print loop. Otherwise, an error handler
+is entered. The first argument can be some error message, and the second might
+be the reason for the error. See also <code><a href="ref.html#errors">Error
+Handling</a></code>.
+
+<pre><code>
+: (de foo (X) (quit <u>Sorry, my error</u> X))
+-> foo
+: (foo 123)                                  # 'X' is bound to '123'
+123 -- Sorry, my error                       # Error entered
+? X                                          # Inspect 'X'
+-> 123
+?                                            # Empty line: Exit
+:
+</code></pre>
+
+</dl>
+
+</body>
+</html>
diff --git a/doc/refR.html b/doc/refR.html
@@ -0,0 +1,713 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN" "http://www.w3.org/TR/1998/REC-html40-19980424/loose.dtd">
+<html lang="en">
+<head>
+<meta http-equiv="Content-Type" content="text/html; charset=utf-8">
+<title>R</title>
+<link rel="stylesheet" href="doc.css" type="text/css">
+</head>
+<body>
+
+<h1>R</h1>
+
+<dl>
+
+<dt><a name="*Run"><code>*Run</code></a>
+<dd>This global variable can hold a list of <code>prg</code> expressions which
+are used during <code><a href="refK.html#key">key</a></code>, <code><a
+href="refS.html#sync">sync</a></code>, <code><a
+href="refW.html#wait">wait</a></code> and <code><a
+href="refL.html#listen">listen</a></code>. The first element of each expression
+must either be a positive number (thus denoting a file descriptor to wait for)
+or a negative number (denoting a timeout value in milliseconds (in that case
+another number must follow to hold the remaining time)). A <code>select</code>
+system call is performed with these values, and the corresponding
+<code>prg</code> body is executed when input data are available or when a
+timeout occurred. See also <code><a href="refT.html#task">task</a></code>.
+
+<pre><code>
+: (de *Run (-2000 0 (println '2sec)))     # Install 2-sec-timer
+-> *Run
+: 2sec                                    # Prints "2sec" every 2 seconds
+2sec
+2sec
+                                          # (Enter) Exit
+$
+</code></pre>
+
+<dt><a name="+Ref"><code>+Ref</code></a>
+<dd>Prefix class for maintaining non-unique indexes to <code><a
+href="refR.html#+relation">+relation</a></code>s, a subclass of <code><a
+href="refI.html#+index">+index</a></code>. Accepts an optional argument for a
+<code><a href="refH.html#+Hook">+Hook</a></code> attribute. See also <code><a
+href="ref.html#dbase">Database</a></code>.
+
+<pre><code>
+(rel tel (+Fold +Ref +String))  # Phone number with folded, non-unique index
+</code></pre>
+
+<dt><a name="+Ref2"><code>+Ref2</code></a>
+<dd>Prefix class for maintaining a secondary ("backing") index to <code><a
+href="refR.html#+relation">+relation</a></code>s. Can only be used as a prefix
+class to <code><a href="refK.html#+Key">+Key</a></code> or <code><a
+href="refR.html#+Ref">+Ref</a></code>. It maintains an index in the current
+(sub)class, in addition to that in one of the superclasses, to allow
+(sub)class-specific queries. See also <code><a
+href="ref.html#dbase">Database</a></code>.
+
+<pre><code>
+(class +Ord +Entity)             # Order class
+(rel nr (+Need +Key +Number))    # Order number
+...
+(class +EuOrd +Ord)              # EU-specific order subclass
+(rel nr (+Ref2 +Key +Number))    # Order number with backing index
+</code></pre>
+
+<dt><a name="+relation"><code>+relation</code></a>
+<dd>Abstract base class of all database releations. Relation objects are usually
+defined with <code><a href="refR.html#rel">rel</a></code>. The class hierarchy
+includes the classes <code><a href="refA.html#+Any">+Any</a></code>, <code><a
+href="refB.html#+Bag">+Bag</a></code>, <code><a
+href="refB.html#+Bool">+Bool</a></code>, <code><a
+href="refN.html#+Number">+Number</a></code>, <code><a
+href="refD.html#+Date">+Date</a></code>, <code><a
+href="refT.html#+Time">+Time</a></code>, <code><a
+href="refS.html#+Symbol">+Symbol</a></code>, <code><a
+href="refS.html#+String">+String</a></code>, <code><a
+href="refL.html#+Link">+Link</a></code>, <code><a
+href="refJ.html#+Joint">+Joint</a></code> and <code><a
+href="refB.html#+Blob">+Blob</a></code>, and the prefix classes <code><a
+href="refH.html#+Hook">+Hook</a></code>, <code><a
+href="refI.html#+index">+index</a></code>, <code><a
+href="refK.html#+Key">+Key</a></code>, <code><a
+href="refR.html#+Ref">+Ref</a></code>, <code><a
+href="refR.html#+Ref2">+Ref2</a></code>, <code><a
+href="refI.html#+Idx">+Idx</a></code>, <code><a
+href="refS.html#+Sn">+Sn</a></code>, <code><a
+href="refF.html#+Fold">+Fold</a></code>, <code><a
+href="refA.html#+Aux">+Aux</a></code>, <code><a
+href="refD.html#+Dep">+Dep</a></code>, <code><a
+href="refL.html#+List">+List</a></code>, <code><a
+href="refN.html#+Need">+Need</a></code>, <code><a
+href="refM.html#+Mis">+Mis</a></code> and <code><a
+href="refA.html#+Alt">+Alt</a></code>. See also <code><a
+href="ref.html#dbase">Database</a></code> and <code><a
+href="refE.html#+Entity">+Entity</a></code>.
+
+<p><a name="relationMesssages">Messages</a> to relation objects include
+
+<pre><code>
+mis> (Val Obj)       # Return error if mismatching type or value
+has> (Val X)         # Check if the value is present
+put> (Obj Old New)   # Put new value
+rel> (Obj Old New)   # Maintain relational strutures
+lose> (Obj Val)      # Delete relational structures
+keep> (Obj Val)      # Restore deleted relational structures
+zap> (Obj Val)       # Clean up relational structures
+</code></pre>
+
+<dt><a name="rand"><code>(rand ['cnt1 'cnt2] | ['T]) -> cnt | flg</code></a>
+<dd>Returns a pseudo random number in the range cnt1 .. cnt2 (or -2147483648 ..
++2147483647 if no arguments are given). If the argument is <code>T</code>, a
+boolean value <code>flg</code> is returned. See also <code><a
+href="refS.html#seed">seed</a></code>.
+
+<pre><code>
+: (rand 3 9)
+-> 3
+: (rand 3 9)
+-> 7
+</code></pre>
+
+<dt><a name="range"><code>(range 'num1 'num2 ['num3]) -> lst</code></a>
+<dd>Produces a list of numbers in the range <code>num1</code> through
+<code>num2</code>. When <code>num3</code> is non-<code>NIL</code>), it is used
+to increment <code>num1</code> (if it is smaller than <code>num2</code>) or to
+decrement <code>num1</code> (if it is greater than <code>num2</code>). See also
+<code><a href="refN.html#need">need</a></code>.
+
+<pre><code>
+: (range 1 6)
+-> (1 2 3 4 5 6)
+: (range 6 1)
+-> (6 5 4 3 2 1)
+: (range -3 3)
+-> (-3 -2 -1 0 1 2 3)
+: (range 3 -3 2)
+-> (3 1 -1 -3)
+</code></pre>
+
+<dt><a name="range/3"><code>range/3</code></a>
+<dd><a href="ref.html#pilog">Pilog</a> predicate that succeeds if the first
+argument is in the range of the result of applying the <code><a
+href="refG.html#get">get</a></code> algorithm to the following arguments.
+Typically used as filter predicate in <code><a
+href="refS.html#select/3">select/3</a></code> database queries. See also
+<code><a href="ref.html#cmp">Comparing</a></code>, <code><a
+href="refI.html#isa/2">isa/2</a></code>, <code><a
+href="refS.html#same/3">same/3</a></code>, <code><a
+href="refB.html#bool/3">bool/3</a></code>, <code><a
+href="refH.html#head/3">head/3</a></code>, <code><a
+href="refF.html#fold/3">fold/3</a></code>, <code><a
+href="refP.html#part/3">part/3</a></code> and <code><a
+href="refT.html#tolr/3">tolr/3</a></code>.
+
+<pre><code>
+: (?
+   @Nr (1 . 5)  # Numbers between 1 and 5
+   @Nm "part"
+   (select (@Item)
+      ((nr +Item @Nr) (nm +Item @Nm))
+      (range @Nr @Item nr)
+      (part @Nm @Item nm) ) )
+ @Nr=(1 . 5) @Nm="part" @Item={3-1}                                              @Nr=(1 . 5) @Nm="part" @Item={3-2}
+-> NIL
+</code></pre>
+
+<dt><a name="rank"><code>(rank 'any 'lst ['flg]) -> lst</code></a>
+<dd>Searches a ranking list. <code>lst</code> should be sorted. Returns the
+element from <code>lst</code> with a maximal CAR less or equal to
+<code>any</code> (if <code>flg</code> is <code>NIL</code>), or with a minimal
+CAR greater or equal to <code>any</code> (if <code>flg</code> is
+non-<code>NIL</code>), or <code>NIL</code> if no match is found. See also
+<code><a href="refA.html#assoc">assoc</a></code> and <a
+href="ref.html#cmp">Comparing</a>.
+
+<pre><code>
+: (rank 0 '((1 . a) (100 . b) (1000 . c)))
+-> NIL
+: (rank 50 '((1 . a) (100 . b) (1000 . c)))
+-> (1 . a)
+: (rank 100 '((1 . a) (100 . b) (1000 . c)))
+-> (100 . b)
+: (rank 300 '((1 . a) (100 . b) (1000 . c)))
+-> (100 . b)
+: (rank 9999 '((1 . a) (100 . b) (1000 . c)))
+-> (1000 . c)
+: (rank 50 '((1000 . a) (100 . b) (1 . c)) T)
+-> (100 . b)
+</code></pre>
+
+<dt><a name="raw"><code>(raw ['flg]) -> flg</code></a>
+<dd>Console mode control function. When called without arguments, it returns the
+current console mode (<code>NIL</code> for "cooked mode"). Otherwise, the
+console is set to the new state. See also <code><a
+href="refK.html#key">key</a></code>.
+
+<pre><code>
+$ ./p
+: (raw)
+-> NIL
+$ ./dbg
+: (raw)
+-> T
+</code></pre>
+
+<dt><a name="rc"><code>(rc 'sym 'any1 ['any2]) -> any</code></a>
+<dd>Fetches a value from a ressource file <code>sym</code>, or stores a value
+<code>any2</code> in that file, using a key <code>any1</code>. All values are
+stored in a list in the file, using <code><a
+href="refA.html#assoc">assoc</a></code>. During the whole operation, the file is
+exclusively locked with <code><a href="refC.html#ctl">ctl</a></code>.
+
+<pre><code>
+: (info "a.rc")               # File exists?
+-> NIL                        # No
+: (rc "a.rc" 'a 1)            # Store 1 for 'a'
+-> 1
+: (rc "a.rc" 'b (2 3 4))      # Store (2 3 4) for 'b'
+-> (2 3 4)
+: (rc "a.rc" 'c 'b)           # Store 'b' for 'c'
+-> b
+: (info "a.rc")               # Check file
+-> (28 733124 . 61673)
+: (in "a.rc" (echo))          # Display it
+((c . b) (b 2 3 4) (a . 1))
+-> T
+: (rc "a.rc" 'c)              # Fetch value for 'c'
+-> b
+: (rc "a.rc" @)               # Fetch value for 'b'
+-> (2 3 4)
+</code></pre>
+
+<dt><a name="rd"><code>(rd ['sym]) -> any</code></a>
+<dt><code>(rd 'cnt) -> num | NIL</code>
+<dd>Binary read: Reads one item from the current input channel in encoded binary
+format. When called with a <code>cnt</code> argument (second form), that number
+of raw bytes (in big endian format if <code>cnt</code> is positive, otherwise
+little endian) is read as a single number. Upon end of file, if the
+<code>sym</code> argument is given, it is returned, otherwise <code>NIL</code>.
+See also <code><a href="refP.html#pr">pr</a></code>, <code><a
+href="refT.html#tell">tell</a></code>, <code><a
+href="refH.html#hear">hear</a></code>, <code><a
+href="refR.html#rpc">rpc</a></code> and <code><a
+href="refW.html#wr">wr</a></code>.
+
+<pre><code>
+: (out "x" (pr 'abc "EOF" 123 "def"))
+-> "def"
+: (in "x" (rd))
+-> abc
+: (in "x"
+   (make
+      (use X
+         (until (== "EOF" (setq X (rd "EOF")))  # '==' detects end of file
+            (link X) ) ) ) )
+-> (abc "EOF" 123 "def")  # as opposed to reading a symbol "EOF"
+
+: (in "/dev/urandom" (rd 20))
+-> 396737673456823753584720194864200246115286686486
+</code></pre>
+
+<dt><a name="read"><code>(read ['sym1 ['sym2]]) -> any</code></a>
+<dd>Reads one item from the current input channel. <code>NIL</code> is returned
+upon end of file. When called without arguments, an arbitrary Lisp expression is
+read. Otherwise, a token (a number, or an internal or transient symbol) is read.
+In that case, <code>sym1</code> specifies which set of characters to accept for
+continuous symbol names (in addition to the standard alphanumerical characters),
+and <code>sym2</code> an optional comment character. See also <code><a
+href="refA.html#any">any</a></code>, <code><a
+href="refS.html#str">str</a></code>, <code><a
+href="refS.html#skip">skip</a></code> and <code><a
+href="refE.html#eof">eof</a></code>.
+
+<pre><code>
+: (list (read) (read) (read))    # Read three things from console
+123                              # a number
+abcd                             # a symbol
+(def                             # and a list
+ghi
+jkl
+)
+-> (123 abcd (def ghi jkl))
+: (make (while (read "_" "#") (link @)))
+abc = def_ghi("xyz"+-123) # Comment
+NIL
+-> (abc "=" def_ghi "(" "xyz" "+" "-" 123 ")")
+</code></pre>
+
+<dt><a name="recur"><code>(recur fun) -> any</code></a>
+<dt><a name="recurse"><code>(recurse ..) -> any</code></a>
+<dd>Implements anonymous recursion, by defining the function
+<code>recurse</code> on the fly. During the execution of <code>fun</code>, the
+symbol <code>recurse</code> is bound to the function definition
+<code>fun</code>. See also <code><a href="refL.html#let">let</a></code> and
+<code><a href="ref.html#lambda">lambda</a></code>.
+
+<pre><code>
+: (de fibonacci (N)
+   (when (lt0 N)
+      (quit "Bad fibonacci" N) )
+   (recur (N)
+      (if (< N 2)
+         1
+         (+
+            (recurse (dec N))
+            (recurse (- N 2)) ) ) ) )
+-> fibonacci
+: (fibonacci 22)
+-> 28657
+: (fibonacci -7)
+-7 -- Bad fibonacci
+</code></pre>
+
+<dt><a name="redef"><code>(redef sym . fun) -> sym</code></a>
+<dd>Redefines <code>sym</code> in terms of itself. The current definition is
+saved in a new symbol, which is substituted for each occurrence of
+<code>sym</code> in <code>fun</code>, and which is also returned. See also
+<code><a href="refD.html#de">de</a></code>, <code><a
+href="refD.html#daemon">daemon</a></code> and <code><a
+href="refP.html#patch">patch</a></code>.
+
+<pre><code>
+: (de hello () (prinl "Hello world!"))
+-> hello
+: (pp 'hello)
+(de hello NIL
+   (prinl "Hello world!") )
+-> hello
+
+: (redef hello (A B)
+   (println 'Before A)
+   (prog1 (hello) (println 'After B)) )
+-> "hello"
+: (pp 'hello)
+(de hello (A B)
+   (println 'Before A)
+   (prog1 ("hello") (println 'After B)) )
+-> hello
+: (hello 1 2)
+Before 1
+Hello world!
+After 2
+-> "Hello world!"
+
+: (redef * @
+   (msg (rest))
+   (pass *) )
+-> "*"
+: (* 1 2 3)
+(1 2 3)
+-> 6
+
+: (redef + @
+   (pass (ifn (num? (next)) pack +) (arg)) )
+-> "+"
+: (+ 1 2 3)
+-> 6
+: (+ "a" 'b '(c d e))
+-> "abcde"
+
+</code></pre>
+
+<dt><a name="rel"><code>(rel var lst [any ..]) -> any</code></a>
+<dd>Defines a relation for <code>var</code> in the current class <code><a
+href="refC.html#*Class">*Class</a></code>, using <code>lst</code> as the list of
+classes for that relation, and possibly additional arguments <code>any</code>
+for its initialization. See also <a href="ref.html#dbase">Database</a>, <a
+href="refC.html#class">class</a>, <a href="refE.html#extend">extend</a>, <a
+href="refD.html#dm">dm</a> and <a href="refV.html#var">var</a>.
+
+<pre><code>
+(class +Person +Entity)
+(rel nm  (+List +Ref +String))            # Names
+(rel tel (+Ref +String))                  # Telephone
+(rel adr (+Joint) prs (+Address))         # Address
+
+(class +Address +Entity)
+(rel Cit (+Need +Hook +Link) (+City))     # City
+(rel str (+List +Ref +String) Cit)        # Street
+(rel prs (+List +Joint) adr (+Person))    # Inhabitants
+
+(class +City +Entity)
+(rel nm  (+List +Ref +String))            # Zip / Names
+</code></pre>
+
+<dt><a name="release"><code>(release 'sym) -> NIL</code></a>
+<dd>Releases the mutex represented by the file 'sym'. This is the reverse
+operation of <code><a href="refA.html#acquire">acquire</a></code>.
+
+<pre><code>
+: (release "sema1")
+-> NIL
+</code></pre>
+
+<dt><a name="remote/2"><code>remote/2</code></a>
+<dd><a href="ref.html#pilog">Pilog</a> predicate for remote database queries. It
+takes a list and an arbitrary number of clauses. The list should contain a Pilog
+variable for the result in the CAR, and a list of resources in the CDR. The
+clauses will be evaluated on remote machines according to these resources. Each
+resource must be a cons pair of two functions, an "out" function in the CAR, and
+an "in" function in the CDR. See also <code><a
+href="refE.html#*Ext">*Ext</a></code>, <code><a
+href="refS.html#select/3">select/3</a></code> and <code><a
+href="refD.html#db/3">db/3</a></code>.
+
+<pre><code>
+(setq *Ext           # Set up external offsets
+   (mapcar
+      '((@Host @Ext)
+         (let Sock NIL
+            (cons @Ext
+               (curry (@Host @Ext Sock) (Obj)
+                  (when (or Sock (setq Sock (connect @Host 4040)))
+                     (ext @Ext
+                        (out Sock (pr (cons 'qsym Obj)))
+                        (prog1 (in Sock (rd))
+                           (unless @
+                              (close Sock)
+                              (off Sock) ) ) ) ) ) ) ) )
+      '("localhost")
+      '(20) ) )
+
+(de rsrc ()  # Simple resource handler, ignoring errors or EOFs
+   (extract
+      '((@Ext Host)
+         (let? @Sock (connect Host 4040)
+            (cons
+               (curry (@Ext @Sock) (X)  # out
+                  (ext @Ext (out @Sock (pr X))) )
+               (curry (@Ext @Sock) ()  # in
+                  (ext @Ext (in @Sock (rd))) ) ) ) )
+      '(20)
+      '("localhost") ) )
+
+: (?
+   @Nr (1 . 3)
+   @Sup 2
+   @Rsrc (rsrc)
+   (remote (@Item . @Rsrc)
+      (db nr +Item @Nr @Item)
+      (val @Sup @Item sup nr) )
+   (show @Item) )
+{L-2} (+Item)
+   pr 1250
+   inv 100
+   sup {K-2}
+   nm Spare Part
+   nr 2
+ @Nr=(1 . 3) @Sup=2 @Rsrc=((((X) (ext 20 (out 16 (pr X)))) NIL (ext 20 (in 16 (rd))))) @Item={L-2}
+-> NIL
+</code></pre>
+
+<dt><a name="remove"><code>(remove 'cnt 'lst) -> lst</code></a>
+<dd>Removes the element at position <code>cnt</code> from <code>lst</code>. See
+also <code><a href="refI.html#insert">insert</a></code>, <code><a
+href="refP.html#place">place</a></code>, <code><a
+href="refA.html#append">append</a></code>, <code><a
+href="refD.html#delete">delete</a></code> and <code><a
+href="refR.html#replace">replace</a></code>.
+
+<pre><code>
+: (remove 3 '(a b c d e))
+-> (a b d e)
+: (remove 1 '(a b c d e))
+-> (b c d e)
+: (remove 9 '(a b c d e))
+-> (a b c d e)
+</code></pre>
+
+<dt><a name="repeat"><code>(repeat) -> lst</code></a>
+<dd>Makes the current <a href="ref.html#pilog">Pilog</a> definition "tail
+recursive", by closing the previously defined clauses in the T property to a
+circular list. See also <code><a href="refB.html#be">be</a></code>.
+
+<pre><code>
+(be a (1))     # Define three facts
+(be a (2))
+(be a (3))
+(repeat)       # Unlimited supply
+
+: (? (a @N))
+ @N=1
+ @N=2
+ @N=3
+ @N=1
+ @N=2
+ @N=3.         # Stop
+-> NIL
+</code></pre>
+
+<dt><a name="repeat/0"><code>repeat/0</code></a>
+<dd><a href="ref.html#pilog">Pilog</a> predicate that always succeeds, also on
+backtracking. See also <code><a href="refR.html#repeat">repeat</a></code> and
+<code><a href="refT.html#true">true</a></code>.
+
+<pre><code>
+: (be int (@N)       # Generate unlimited supply of integers
+   (@ zero *N)
+   (repeat)          # Repeat from here
+   (@N inc '*N) )
+-> int
+
+:  (? (int @X))
+ @X=1
+ @X=2
+ @X=3
+ @X=4.               # Stop
+-> NIL
+</code></pre>
+
+<dt><a name="replace"><code>(replace 'lst 'any1 'any2 ..) -> lst</code></a>
+<dd>Replaces in <code>lst</code> all occurrences of <code>any1</code> with
+<code>any2</code>. For optional additional argument pairs, this process is
+repeated. See also <code><a href="refA.html#append">append</a></code>, <code><a
+href="refD.html#delete">delete</a></code>, <code><a
+href="refI.html#insert">insert</a></code>, <code><a
+href="refR.html#remove">remove</a></code> and <code><a
+href="refP.html#place">place</a></code>.
+
+<pre><code>
+: (replace '(a b b a) 'a 'A)
+-> (A b b A)
+: (replace '(a b b a) 'b 'B)
+-> (a B B a)
+: (replace '(a b b a) 'a 'B 'b 'A)
+-> (B A A B)
+</code></pre>
+
+<dt><a name="request"><code>(request 'typ 'var ['hook] 'val ..) -> obj</code></a>
+<dd>Returns a database object. If a matching object cannot be found (using
+<code><a href="refD.html#db">db</a></code>), a new object of the given type is
+created (using <code><a href="refN.html#new">new</a></code>). See also <code><a
+href="refO.html#obj">obj</a></code>.
+
+<pre><code>
+: (request '(+Item) 'nr 2)
+-> {3-2}
+</code></pre>
+
+<dt><a name="rest"><code>(rest) -> lst</code></a>
+<dd>Can only be used inside functions with a variable number of arguments (with
+<code>@</code>). Returns the list of all remaining arguments from the internal
+list. See also <code><a href="refA.html#args">args</a></code>, <code><a
+href="refN.html#next">next</a></code>, <code><a
+href="refA.html#arg">arg</a></code> and <code><a
+href="refP.html#pass">pass</a></code>.
+
+<pre><code>
+: (de foo @ (println (rest)))
+-> foo
+: (foo 1 2 3)
+(1 2 3)
+-> (1 2 3)
+</code></pre>
+
+<dt><a name="retract">(retract ) -> lst<code></code></a>
+<dd>Removes a <a href="ref.html#pilog">Pilog</a> fact or rule. <code><a
+href="refB.html#be">be</a></code>, <code><a
+href="refA.html#asserta">asserta</a></code> and <code><a
+href="refA.html#assertz">assertz</a></code>.
+
+<pre><code>
+: (be a (1))
+-> a
+: (be a (2))
+-> a
+: (be a (3))
+-> a
+
+: (retract '(a (2)))
+-> (((1)) ((3)))
+
+:  (? (a @N))
+ @N=1
+ @N=3
+-> NIL
+</code></pre>
+
+<dt><a name="retract/1"><code>retract/1</code></a>
+<dd><a href="ref.html#pilog">Pilog</a> predicate that removes a fact or rule.
+See also <code><a href="refR.html#retract">retract</a></code>, <code><a
+href="refA.html#asserta/1">asserta/1</a></code> and <code><a
+href="refA.html#assertz/1">assertz/1</a></code>.
+
+<pre><code>
+: (be a (1))
+-> a
+: (be a (2))
+-> a
+: (be a (3))
+-> a
+
+: (? (retract (a 2)))
+-> T
+: (rules 'a)
+1 (be a (1))
+2 (be a (3))
+-> a
+</code></pre>
+
+<dt><a name="reverse"><code>(reverse 'lst) -> lst</code></a>
+<dd>Returns a reversed copy of <code>lst</code>. See also <code><a
+href="refF.html#flip">flip</a></code>.
+
+<pre><code>
+: (reverse (1 2 3 4))
+-> (4 3 2 1)
+</code></pre>
+
+<dt><a name="rewind"><code>(rewind) -> flg</code></a>
+<dd>Sets the file position indicator for the current output stream to the
+beginning of the file, and truncates the file length to zero. Returns
+<code>T</code> when successful. See also <code><a
+href="refF.html#flush">flush</a></code>.
+
+<pre><code>
+: (out "a" (prinl "Hello world"))
+-> "Hello world"
+: (in "a" (echo))
+Hello world
+-> T
+: (info "a")
+-> (12 733216 . 53888)
+: (out "a" (rewind))
+-> T
+: (info "a")
+-> (0 733216 . 53922)
+</code></pre>
+
+<dt><a name="rollback"><code>(rollback) -> T</code></a>
+<dd>Cancels a transaction, by discarding all modifications of external symbols.
+See also <code><a href="refC.html#commit">commit</a></code>.
+
+<pre><code>
+: (pool "db")
+-> T
+# .. Modify external objects ..
+: (rollback)            # Rollback
+-> T
+</code></pre>
+
+<dt><a name="root"><code>(root 'tree) -> (num . sym)</code></a>
+<dd>Returns the root of a database index tree, with the number of entries in
+<code>num</code>, and the base node in <code>sym</code>. See also <code><a
+href="refT.html#tree">tree</a></code>.
+
+<pre><code>
+: (root (tree 'nr '+Item))
+-> (7 . {7-1})
+</code></pre>
+
+<dt><a name="rot"><code>(rot 'lst ['cnt]) -> lst</code></a>
+<dd>Rotate: The contents of the cells of <code>lst</code> are (destructively)
+shifted right, and the value from the last cell is stored in the first cell.
+Without the optional <code>cnt</code> argument, the whole list is rotated,
+otherwise only the first <code>cnt</code> elements. See also <code><a
+href="refF.html#flip">flip</a></code> .
+
+<pre><code>
+: (rot (1 2 3 4))             # Rotate all four elements
+-> (4 1 2 3)
+: (rot (1 2 3 4 5 6) 3)       # Rotate only the first three elements
+-> (3 1 2 4 5 6)
+</code></pre>
+
+<dt><a name="rpc"><code>(rpc 'sym ['any ..]) -> flg</code></a>
+<dd><i>Rapid</i> (or <i>remote</i>) procedure call: Send an executable list
+<code>(sym any ..)</code> via standard output in encoded binary format. See also
+<code><a href="refP.html#pr">pr</a></code>, <code><a
+href="refP.html#pipe">pipe</a></code>, <code><a
+href="refT.html#tell">tell</a></code> and <code><a
+href="refH.html#hear">hear</a></code>.
+
+<pre><code>
+: (hear (pipe (do 3 (wait 2000) (rpc 'println ''OK))))
+-> 3
+: OK  # every two seconds
+OK
+OK
+</code></pre>
+
+<dt><a name="rules"><code>(rules 'sym ..) -> sym</code></a>
+<dd>Prints all rules defined for the <code>sym</code> arguments. See also <a
+href="ref.html#pilog">Pilog</a> and <code><a href="refB.html#be">be</a></code>.
+
+<pre><code>
+: (rules 'member 'append)
+1 (be member (@X (@X . @)))
+2 (be member (@X (@ . @Y)) (member @X @Y))
+1 (be append (NIL @X @X))
+2 (be append ((@A . @X) @Y (@A . @Z)) (append @X @Y @Z))
+-> append
+</code></pre>
+
+<dt><a name="run"><code>(run 'any ['cnt ['lst]]) -> any</code></a>
+<dd>If <code>any</code> is an atom, <code>run</code> behaves like
+<code>eval</code>. Otherwise <code>any</code> is a list, which is evaluated in
+sequence. The last result is returned. If a binding environment offset
+<code>cnt</code> is given, that evaluation takes place in the corresponding
+environment, and an optional <code>lst</code> of excluded symbols can be
+supplied. See also <code><a href="refE.html#eval">eval</a></code> and <code><a
+href="refU.html#up">up</a></code>.
+
+<pre><code>
+: (run '((println (+ 1 2 3)) (println 'OK)))
+6
+OK
+-> OK
+</code></pre>
+
+</dl>
+
+</body>
+</html>
diff --git a/doc/refS.html b/doc/refS.html
@@ -0,0 +1,870 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN" "http://www.w3.org/TR/1998/REC-html40-19980424/loose.dtd">
+<html lang="en">
+<head>
+<meta http-equiv="Content-Type" content="text/html; charset=utf-8">
+<title>S</title>
+<link rel="stylesheet" href="doc.css" type="text/css">
+</head>
+<body>
+
+<h1>S</h1>
+
+<dl>
+
+<dt><a name="*Scl"><code>*Scl</code></a>
+<dd>A global variable holding the current fixed-point input scale. See also <a
+href="ref.html#num-io">Numbers</a> and <code><a
+href="refS.html#scl">scl</a></code>.
+
+<pre><code>
+: (str "123.45")  # Default value of '*Scl' is 0
+-> (123)
+: (setq *Scl 3)
+-> 3
+: (str "123.45")
+-> (123450)
+</code></pre>
+
+<dt><a name="*Sig1"><code>*Sig1</code></a>
+<dt><a name="*Sig2"><code>*Sig2</code></a>
+<dd>Global variables holding (possibly empty) <code>prg</code> bodies, which
+will be executed when a SIGUSR1 signal (or a SIGUSR2 signal, respectively) is
+sent to the current process. Note that this mechanism is "unreliable", in the
+way that when a second signal (it may be SIGHUP, SIGINT, another SIGUSR1/2,
+SIGALRM or SIGTERM) arrives before the first signal's <code>prg</code> is
+running, the first signal will be lost. See also <code><a
+href="refA.html#alarm">alarm</a></code>, <code><a
+href="refR.html#*Run">*Run</a></code>, <code><a
+href="refH.html#*Hup">*Hup</a></code> and <code><a
+href="refE.html#*Err">*Err</a></code>.
+
+<pre><code>
+: (de *Sig1 (msg 'SIGUSR1))
+-> *Sig1
+</code></pre>
+
+<dt><a name="*Solo"><code>*Solo</code></a>
+<dd>A global variable indicating exclusive database access. Its value is
+<code>0</code> initially, set to <code>T</code> (or <code>NIL</code>) during
+cooperative database locks when <code><a href="refL.html#lock">lock</a></code>
+is successfully called with a <code>NIL</code> (or non-<code>NIL</code>)
+argument. See also <code><a href="refZ.html#*Zap">*Zap</a></code>.
+
+<pre><code>
+: *Solo
+-> 0
+: (lock *DB)
+-> NIL
+: *Solo
+-> NIL
+: (rollback)
+-> T
+: *Solo
+-> 0
+: (lock)
+-> NIL
+: *Solo
+-> T
+: (rollback)
+-> T
+: *Solo
+-> T
+</code></pre>
+
+<dt><a name="+Sn"><code>+Sn</code></a>
+<dd>Prefix class for maintaining indexes according to a modified soundex
+algorithm, for tolerant name searches, to <code><a
+href="refS.html#+String">+String</a></code> relations. Typically used in
+combination with the <code><a href="refI.html#+Idx">+Idx</a></code> prefix
+class. See also <code><a href="ref.html#dbase">Database</a></code>.
+
+<pre><code>
+(rel nm (+Sn +Idx +String))  # Name
+</code></pre>
+
+<dt><a name="+String"><code>+String</code></a>
+<dd>Class for string (transient symbol) relations, a subclass of <code><a
+href="refS.html#+Symbol">+Symbol</a></code>. Accepts an optional argument for
+the string length (currently not used). See also <code><a
+href="ref.html#dbase">Database</a></code>.
+
+<pre><code>
+(rel nm (+Sn +Idx +String))  # Name, indexed by soundex and substrings
+</code></pre>
+
+<dt><a name="+Symbol"><code>+Symbol</code></a>
+<dd>Class for symbolic relations, a subclass of <code><a
+href="refR.html#+relation">+relation</a></code>. Objects of that class typically
+maintain internal symbols, as opposed to the more often-used <code><a
+href="refS.html#+String">+String</a></code> for transient symbols. See also
+<code><a href="ref.html#dbase">Database</a></code>.
+
+<pre><code>
+(rel perm (+List +Symbol))  # Permission list
+</code></pre>
+
+<dt><a name="same/3"><code>same/3</code></a>
+<dd><a href="ref.html#pilog">Pilog</a> predicate that succeeds if the first
+argument matches the result of applying the <code><a
+href="refG.html#get">get</a></code> algorithm to the following arguments.
+Typically used as filter predicate in <code><a
+href="refS.html#select/3">select/3</a></code> database queries. See also
+<code><a href="refI.html#isa/2">isa/2</a></code>, <code><a
+href="refB.html#bool/3">bool/3</a></code>, <code><a
+href="refR.html#range/3">range/3</a></code>, <code><a
+href="refH.html#head/3">head/3</a></code>, <code><a
+href="refF.html#fold/3">fold/3</a></code>, <code><a
+href="refP.html#part/3">part/3</a></code> and <code><a
+href="refT.html#tolr/3">tolr/3</a></code>.
+
+<pre><code>
+: (?
+   @Nr 2
+   @Nm "Spare"
+   (select (@Item)
+      ((nr +Item @Nr) (nm +Item @Nm))
+      (same @Nr @Item nr)
+      (head @Nm @Item nm) ) )
+ @Nr=2 @Nm="Spare" @Item={3-2}
+</code></pre>
+
+<dt><a name="scan"><code>(scan 'tree ['fun] ['any1] ['any2] ['flg])</code></a>
+<dd>Scans through a database tree by applying <code>fun</code> to all key-value
+pairs. <code>fun</code> should be a function accepting two arguments for key and
+value. It defaults to <code><a href="refP.html#println">println</a></code>.
+<code>any1</code> and <code>any2</code> may specify a range of keys. If
+<code>any2</code> is greater than <code>any1</code>, the traversal will be in
+opposite direction. If <code>flg</code> is non-<code>NIL</code>, partial keys
+are skipped. See also <code><a href="refT.html#tree">tree</a></code>, <code><a
+href="refI.html#iter">iter</a></code>, <code><a
+href="refI.html#init">init</a></code> and <code><a
+href="refS.html#step">step</a></code>.
+
+<pre><code>
+: (scan (tree 'nm '+Item))
+("ASLRSNSTRSTN" {3-3} . T) {3-3}
+("Additive" {3-4}) {3-4}
+("Appliance" {3-6}) {3-6}
+("Auxiliary Construction" . {3-3}) {3-3}
+("Construction" {3-3}) {3-3}
+("ENNSNNTTTF" {3-4} . T) {3-4}
+("Enhancement Additive" . {3-4}) {3-4}
+("Fittings" {3-5}) {3-5}
+("GTSTFLNS" {3-6} . T) {3-6}
+("Gadget Appliance" . {3-6}) {3-6}
+...
+
+: (scan (tree 'nm '+Item) println NIL T T)  # 'flg' is non-NIL
+("Auxiliary Construction" . {3-3}) {3-3}
+("Enhancement Additive" . {3-4}) {3-4}
+("Gadget Appliance" . {3-6}) {3-6}
+("Main Part" . {3-1}) {3-1}
+("Metal Fittings" . {3-5}) {3-5}
+("Spare Part" . {3-2}) {3-2}
+("Testartikel" . {3-8}) {3-8}
+-> {7-6}
+</code></pre>
+
+<dt><a name="scl"><code>(scl 'num) -> num</code></a>
+<dd>Sets <code><a href="refS.html#*Scl">*Scl</a></code> globally to
+<code>num</code>. See also <a href="ref.html#num-io">Numbers</a>.
+
+<pre><code>
+: (scl 0)
+-> 0
+: (str "123.45")
+-> (123)
+: (scl 1)
+-> 1
+: (read)
+123.45
+-> 1235
+: (scl 3)
+-> 3
+: (str "123.45")
+-> (123450)
+</code></pre>
+
+<dt><a name="script"><code>(script 'any ..) -> any</code></a>
+<dd>The first <code>any</code> argument is <code><a
+href="refL.html#load">load</a></code>ed, with the remaining arguments <code><a
+href="refP.html#pass">pass</a></code>ed as variable arguments. They can be
+accessed with <code><a href="refN.html#next">next</a></code>, <code><a
+href="refA.html#arg">arg</a></code>, <code><a
+href="refA.html#args">args</a></code> and <code><a
+href="refR.html#rest">rest</a></code>.
+
+<pre><code>
+$ cat x
+(* (next) (next))
+
+$ ./dbg
+:  (script "x" 3 4)
+-> 12
+</code></pre>
+
+<dt><a name="sect"><code>(sect 'lst 'lst) -> lst</code></a>
+<dd>Returns the intersection of the <code>lst</code> arguments. See also
+<code><a href="refD.html#diff">diff</a></code>.
+
+<pre><code>
+: (sect (1 2 3 4) (3 4 5 6))
+-> (3 4)
+: (sect (1 2 3) (4 5 6))
+-> NIL
+</code></pre>
+
+<dt><a name="seed"><code>(seed 'any) -> cnt</code></a>
+<dd>Initializes the random generator's seed, and returns a pseudo random number
+in the range -2147483648 .. +2147483647. See also <code><a
+href="refR.html#rand">rand</a></code>.
+
+<pre><code>
+: (seed "init string")
+-> 2015582081
+: (rand)
+-> -706917003
+: (rand)
+-> 1224196082
+
+: (seed (time))
+-> 128285383
+</code></pre>
+
+<dt><a name="seek"><code>(seek 'fun 'lst ..) -> lst</code></a>
+<dd>Applies <code>fun</code> to <code>lst</code> and all successive CDRs, until
+non-<code>NIL</code> is returned. Returns the tail of <code>lst</code> starting
+with that element, or <code>NIL</code> if <code>fun</code> did not return
+non-<code>NIL</code> for any element of <code>lst</code>. When additional
+<code>lst</code> arguments are given, they are passed to <code>fun</code> in the
+same way. See also <code><a href="refF.html#find">find</a></code>, <code><a
+href="refP.html#pick">pick</a></code>.
+
+<pre><code>
+: (seek '((X) (> (car X) 9)) (1 5 8 12 19 22))
+-> (12 19 22)
+</code></pre>
+
+<dt><a name="select"><code>(select [var ..] cls [hook|T] [var val ..]) -> obj | NIL</code></a>
+<dd>Interactive database function, loosely modelled after the SQL
+'<code>SELECT</code>' command. A (limited) front-end to the Pilog <code><a
+href="refS.html#select/3">select/3</a></code> predicate. When called with only a
+<code>cls</code> argument, <code>select</code> steps through all objects of that
+class, and <code><a href="refS.html#show">show</a></code>s their complete
+contents (this is analog to 'SELECT * from CLS'). If <code>cls</code> is
+followed by attribute/value specifications, the search is limited to these
+values (this is analog to 'SELECT * from CLS where VAR = VAL'). If between the
+<code>select</code> function and <code>cls</code> one or several attribute names
+are supplied, only these attribute (instead of the full <code>show</code>) are
+printed. These attribute specifications may also be lists, then the <code><a
+href="refG.html#get">get</a></code> algorithm will be used to retrieve related
+data. See also <code><a href="refU.html#update">update</a></code>, <code><a
+href="ref.html#dbase">Database</a></code> and <a
+href="ref.html#pilog">Pilog</a>.
+
+<pre><code>
+: (select +Item)                       # Show all items
+{3-1} (+Item)
+   nr 1
+   pr 29900
+   inv 100
+   sup {2-1}
+   nm "Main Part"
+
+{3-2} (+Item)
+   nr 2
+   pr 1250
+   inv 100
+   sup {2-2}
+   nm "Spare Part"
+.                                      # Stop
+-> {3-2}
+
+: (select +Item nr 3)                  # Show only item 3
+{3-3} (+Item)
+   nr 3
+   sup {2-1}
+   pr 15700
+   nm "Auxiliary Construction"
+   inv 100
+.                                      # Stop
+-> {3-3}
+
+# Show selected attributes for items 3 through 3
+: (select nr nm pr (sup nm) +Item nr (3 . 5))
+3 "Auxiliary Construction" 157.00 "Active Parts Inc." {3-3}
+4 "Enhancement Additive" 9.99 "Seven Oaks Ltd." {3-4}
+5 "Metal Fittings" 79.80 "Active Parts Inc." {3-5}
+-> NIL
+</code></pre>
+
+<dt><a name="select/3"><code>select/3</code></a>
+<dd><a href="ref.html#pilog">Pilog</a> database predicate that allows combined
+searches over <code><a href="refI.html#+index">+index</a></code> and other
+relations. It takes a list of Pilog variables, a list of generator clauses, and
+an arbitrary number of filter clauses. The functionality is described in detail
+in <a href="select.html">The 'select' Predicate</a>. See also <code><a
+href="refD.html#db/3">db/3</a></code>, <code><a
+href="refI.html#isa/2">isa/2</a></code>, <code><a
+href="refS.html#same/3">same/3</a></code>, <code><a
+href="refB.html#bool/3">bool/3</a></code>, <code><a
+href="refR.html#range/3">range/3</a></code>, <code><a
+href="refH.html#head/3">head/3</a></code>, <code><a
+href="refF.html#fold/3">fold/3</a></code>, <code><a
+href="refP.html#part/3">part/3</a></code>, <code><a
+href="refT.html#tolr/3">tolr/3</a></code> and <code><a
+href="refR.html#remote/2">remote/2</a></code>.
+
+<pre><code>
+: (?
+   @Nr (2 . 5)          # Select all items with numbers between 2 and 5
+   @Sup "Active"        # and suppliers matching "Active"
+   (select (@Item)                                  # Bind results to '@Item"
+      ((nr +Item @Nr) (nm +CuSu @Sup (sup +Item)))  # Generator clauses
+      (range @Nr @Item nr)                          # Filter clauses
+      (part @Sup @Item sup nm) ) )
+ @Nr=(2 . 5) @Sup="Active" @Item={3-3}
+ @Nr=(2 . 5) @Sup="Active" @Item={3-5}
+-> NIL
+</code></pre>
+
+<dt><a name="send"><code>(send 'msg 'obj ['any ..]) -> any</code></a>
+<dd>Sends the message <code>msg</code> to the object <code>obj</code>,
+optionally with arguments <code>any</code>. If the message cannot be located in
+<code>obj</code>, its classes and superclasses, an error <code>"Bad
+message"</code> is issued. See also <code><a href="ref.html#oop">OO
+Concepts</a></code>, <code><a href="refT.html#try">try</a></code>, <code><a
+href="refM.html#method">method</a></code>, <code><a
+href="refM.html#meth">meth</a></code>, <code><a
+href="refS.html#super">super</a></code> and <code><a
+href="refE.html#extra">extra</a></code>.
+
+<pre><code>
+: (send 'stop> Dlg)  # Equivalent to (stop> Dlg)
+-> NIL
+</code></pre>
+
+<dt><a name="seq"><code>(seq 'cnt|sym1) -> sym | NIL</code></a>
+<dd>Sequential single step: Returns the <i>first</i> external symbol in the
+<code>cnt</code>'th database file, or the <i>next</i> external symbol following
+<code>sym1</code> in the database, or <code>NIL</code> when the end of the
+database is reached. See also <code><a href="refF.html#free">free</a></code>.
+
+<pre><code>
+: (pool "db")
+-> T
+: (seq *DB)
+-> {2}
+: (seq @)
+-> {3}
+</code></pre>
+
+<dt><a name="set"><code>(set 'var 'any ..) -> any</code></a>
+<dd>Stores new values <code>any</code> in the <code>var</code> arguments. See
+also <code><a href="refS.html#setq">setq</a></code>, <code><a
+href="refV.html#val">val</a></code>, <code><a
+href="refC.html#con">con</a></code> and <code><a
+href="refD.html#def">def</a></code>.
+
+<pre><code>
+: (set 'L '(a b c)  (cdr L) '999)
+-> 999
+: L
+-> (a 999 c)
+</code></pre>
+
+<dt><a name="set!"><code>(set! 'obj 'any) -> any</code></a>
+<dd><a href="ref.html#trans">Transaction</a> wrapper function for <code><a
+href="refS.html#set">set</a></code>. Note that for setting the value of entities
+typically the <code><a href="refE.html#entityMesssages">set!></a></code> message
+is used. See also <code><a href="refN.html#new!">new!</a></code>, <code><a
+href="refP.html#put!">put!</a></code> and <code><a
+href="refI.html#inc!">inc!</a></code>.
+
+<pre><code>
+(set! Obj (* Count Size))  # Setting a non-entity object to a numeric value
+</code></pre>
+
+<dt><a name="setq"><code>(setq var 'any ..) -> any</code></a>
+<dd>Stores new values <code>any</code> in the <code>var</code> arguments. See
+also <code><a href="refS.html#set">set</a></code>, <code><a
+href="refV.html#val">val</a></code> and <code><a
+href="refD.html#def">def</a></code>.
+
+<pre><code>
+: (setq  A 123  B (list A A))  # Set 'A' to 123, then 'B' to (123 123)
+-> (123 123)
+</code></pre>
+
+<dt><a name="show"><code>(show 'any ['sym|cnt ..]) -> any</code></a>
+<dd>Shows the name, value and property list of a symbol found by applying the
+<code><a href="refG.html#get">get</a></code> algorithm to <code>any</code> and
+the following arguments. See also <code><a href="refE.html#edit">edit</a></code>
+and <code><a href="refV.html#view">view</a></code>.
+
+<pre><code>
+: (setq A 123456)
+-> 123456
+: (put 'A 'x 1)
+-> 1
+: (put 'A 'lst (9 8 7))
+-> (9 8 7)
+: (put 'A 'flg T)
+-> T
+
+: (show 'A)
+A 123456
+   flg
+   lst (9 8 7)
+   x 1
+-> A
+
+: (show 'A 'lst 2)
+-> 8
+</code></pre>
+
+<dt><a name="show/1"><code>show/1</code></a>
+<dd><a href="ref.html#pilog">Pilog</a> predicate that always succeeds, and shows
+the name, value and property list of the argument symbol. See also <code><a
+href="refS.html#show">show</a></code>.
+
+<pre><code>
+: (? (db nr +Item 2 @Item) (show @Item))
+{3-2} (+Item)
+   nm "Spare Part"
+   nr 2
+   pr 1250
+   inv 100
+   sup {2-2}
+ @Item={3-2}
+-> NIL
+</code></pre>
+
+<dt><a name="size"><code>(size 'any) -> cnt</code></a>
+<dd>Returns the "size" of <code>any</code>. For numbers this is the number of
+bytes needed for the value, for external symbols it is the number of bytes it
+would occupy in the database, for other symbols it is the number of bytes
+occupied in the UTF-8 representation of the name, and for lists it is the total
+number of cells in this list and all its sublists. See also <code><a
+href="refL.html#length">length</a></code>.
+
+<pre><code>
+: (size "abc")
+-> 3
+: (size "äbc")
+-> 4
+: (size 127)  # One byte
+-> 1
+: (size 128)  # Two bytes (eight bits plus sign bit!)
+-> 2
+: (size (1 (2) 3))
+-> 4
+: (size (1 2 3 .))
+-> 3
+</code></pre>
+
+<dt><a name="skip"><code>(skip ['any]) -> sym</code></a>
+<dd>Skips all white space (and comments if <code>any</code> is given) in the
+input stream. Returns the next available character, or <code>NIL</code> upon end
+of file. See also <code><a href="refP.html#peek">peek</a></code> and <code><a
+href="refE.html#eof">eof</a></code>.
+
+<pre><code>
+$ cat a
+# Comment
+abcd
+$ ./dbg
+: (in "a" (skip "#"))
+-> "a"
+</code></pre>
+
+<dt><a name="solve"><code>(solve 'lst [. prg]) -> lst</code></a>
+<dd>Evaluates a <a href="ref.html#pilog">Pilog</a> query and, returns the list
+of result sets. If <code>prg</code> is given, it is executed for each result
+set, with all Pilog variables bound to their matching values, and returns a list
+of the results. See also <code><a href="refP.html#pilog">pilog</a></code>,
+<code><a href="ref_.html#?">?</a></code>, <code><a
+href="refG.html#goal">goal</a></code> and <code><a
+href="refP.html#prove">prove</a></code>.
+
+<pre><code>
+: (solve '((append @X @Y (a b c))))
+-> (((@X) (@Y a b c)) ((@X a) (@Y b c)) ((@X a b) (@Y c)) ((@X a b c) (@Y)))
+
+: (solve '((append @X @Y (a b c))) @X)
+-> (NIL (a) (a b) (a b c))
+</code></pre>
+
+<dt><a name="sort"><code>(sort 'lst ['fun]) -> lst</code></a>
+<dd>Sorts <code>lst</code> by destructively exchanging its elements. If
+<code>fun</code> is given, it is used as a "less than" predicate for
+comparisons. Typically, <code>sort</code> is used in combination with <a
+href="refB.html#by">by</a>, giving shorter and often more efficient solutions
+than with the predicate function. See also <a href="ref.html#cmp">Comparing</a>,
+<code><a href="refG.html#group">group</a></code>, <code><a
+href="refM.html#maxi">maxi</a></code>, <code><a
+href="refM.html#mini">mini</a></code> and <code><a
+href="refU.html#uniq">uniq</a></code>.
+
+<pre><code>
+: (sort '(a 3 1 (1 2 3) d b 4 T NIL (a b c) (x y z) c 2))
+-> (NIL 1 2 3 4 a b c d (1 2 3) (a b c) (x y z) T)
+: (sort '(a 3 1 (1 2 3) d b 4 T NIL (a b c) (x y z) c 2) >)
+-> (T (x y z) (a b c) (1 2 3) d c b a 4 3 2 1 NIL)
+: (by cadr sort '((1 4 3) (5 1 3) (1 2 4) (3 8 5) (6 4 5)))
+-> ((5 1 3) (1 2 4) (1 4 3) (6 4 5) (3 8 5))
+</code></pre>
+
+<dt><a name="space"><code>(space ['cnt]) -> cnt</code></a>
+<dd>Prints <code>cnt</code> spaces, or a single space when <code>cnt</code> is
+not given.
+
+<pre><code>
+: (space)
+ -> 1
+: (space 1)
+ -> 1
+: (space 2)
+  -> 2
+</code></pre>
+
+<dt><a name="sp?"><code>(sp? 'any) -> flg</code></a>
+<dd>Returns <code>T</code> when the argument <code>any</code> is
+<code>NIL</code>, or if it is a string (symbol) that consists only of whitespace
+characters.
+
+<pre><code>
+: (sp? "  ")
+-> T
+: (sp? "ABC")
+-> NIL
+: (sp? 123)
+-> NIL
+</code></pre>
+
+<dt><a name="split"><code>(split 'lst 'any ..) -> lst</code></a>
+<dd>Splits <code>lst</code> at all places containing an element <code>any</code>
+and returns the resulting list of sublists. See also <code><a
+href="refS.html#stem">stem</a></code>.
+
+<pre><code>
+: (split (1 a 2 b 3 c 4 d 5 e 6) 'e 3 'a)
+-> ((1) (2 b) (c 4 d 5) (6))
+: (mapcar pack (split (chop "The quick brown fox") " "))
+-> ("The" "quick" "brown" "fox")
+</code></pre>
+
+<dt><a name="sqrt"><code>(sqrt 'num) -> num</code></a>
+<dd>Returns the square root of the <code>num</code> argument.
+
+<pre><code>
+: (sqrt 64)
+-> 8
+: (sqrt 1000)
+-> 31
+: (sqrt 10000000000000000000000000000000000000000)
+-> 100000000000000000000
+</code></pre>
+
+<dt><a name="stamp"><code>(stamp ['dat 'tim]) -> sym</code></a>
+<dd>Returns a date-time string in the form "YYYY-MM-DD HH:MM:SS". If
+<code>dat</code> and/or <code>tim</code> is missing, the current date or time is
+used. See also <code><a href="refD.html#date">date</a></code> and <code><a
+href="refT.html#time">time</a></code>.
+
+<pre><code>
+: (stamp)
+-> "2000-09-12 07:48:04"
+: (stamp (date) 0)
+-> "2000-09-12 00:00:00"
+: (stamp (date 2000 1 1) (time 12 0 0))
+-> "2000-01-01 12:00:00"
+</code></pre>
+
+<dt><a name="state"><code>(state 'var (sym|lst exe [. prg]) ..) -> any</code></a>
+<dd>Implements a finite state machine. The variable <code>var</code> holds the
+current state as a symbolic value. When a clause is found that contains the
+current state in its CAR <code>sym|lst</code> value, and where the
+<code>exe</code> in its CADR evaluates to non-<code>NIL</code>, the current
+state will be set to that value, the body <code>prg</code> in the CDDR will be
+executed, and the result returned. <code>T</code> is a catch-all for any state.
+If no state-condition matches, <code>NIL</code> is returned. See also <code><a
+href="refC.html#case">case</a></code>, <code><a
+href="refC.html#cond">cond</a></code> and <code><a
+href="refJ.html#job">job</a></code>.
+
+<pre><code>
+: (de tst ()
+   (job '((Cnt . 4))
+      (state '(start)
+         (start 'run
+            (printsp 'start) )
+         (run (and (gt0 (dec 'Cnt)) 'run)
+            (printsp 'run) )
+         (run 'stop
+            (printsp 'run) )
+         (stop 'start
+            (setq Cnt 4)
+            (println 'stop) ) ) ) )
+-> tst
+: (do 12 (tst))
+start run run run run stop
+start run run run run stop
+-> stop
+: (pp 'tst)
+(de tst NIL
+   (job '((Cnt . 4))
+      (state '(start)
+      ...
+-> tst
+: (do 3 (tst))
+start run run -> run
+: (pp 'tst)
+(de tst NIL
+   (job '((Cnt . 2))
+      (state '(run)
+      ...
+-> tst
+</code></pre>
+
+<dt><a name="stem"><code>(stem 'lst 'any ..) -> lst</code></a>
+<dd>Returns the tail of <code>lst</code> that does not contain any of the
+<code>any</code> arguments. <code>(stem 'lst 'any ..)</code> is equivalent to
+<code>(last (split 'lst 'any ..))</code>. See also <code><a
+href="refT.html#tail">tail</a></code> and <code><a
+href="refS.html#split">split</a></code>.
+
+<pre><code>
+: (stem (chop "abc/def\\ghi") "/" "\\")
+-> ("g" "h" "i")
+</code></pre>
+
+<dt><a name="step"><code>(step 'lst ['flg]) -> any</code></a>
+<dd>Single-steps iteratively through a database tree. <code>lst</code> is a
+structure as received from <code><a href="refI.html#init">init</a></code>. If
+<code>flg</code> is non-<code>NIL</code>, partial keys are skipped. See also
+<code><a href="refT.html#tree">tree</a></code>, <code><a
+href="refL.html#leaf">leaf</a></code> and <code><a
+href="refF.html#fetch">fetch</a></code>.
+
+<pre><code>
+: (setq Q (init (tree 'nr '+Item) 3 5))
+-> (((3 . 5) ((3 NIL . {3-3}) (4 NIL . {3-4}) (5 NIL . {3-5}) (6 NIL . {3-6}) (7 NIL . {3-8}))))
+: (get (step Q) 'nr)
+-> 3
+: (get (step Q) 'nr)
+-> 4
+: (get (step Q) 'nr)
+-> 5
+: (get (step Q) 'nr)
+-> NIL
+</code></pre>
+
+<dt><a name="store"><code>(store 'tree 'any1 'any2 ['(num1 . num2)])</code></a>
+<dd>Stores a value <code>any2</code> for the key <code>any1</code> in a database
+tree. <code>num1</code> is a database file number, as used in <code><a
+href="refN.html#new">new</a></code> (defaulting to 1), and <code>num2</code> a
+database block size (defaulting to 256). When <code>any2</code> is
+<code>NIL</code>, the corresponding entry is deleted from the tree. See also
+<code><a href="refT.html#tree">tree</a></code> and <code><a
+href="refF.html#fetch">fetch</a></code>.
+
+<pre><code>
+: (store (tree 'nr '+Item) 2 '{3-2})
+</code></pre>
+
+<dt><a name="str"><code>(str 'sym ['sym1]) -> lst</code></a>
+<dt><code>(str 'lst) -> sym</code>
+<dd>In the first form, the string <code>sym</code> is parsed into a list. This
+mechanism is also used by <code><a href="refL.html#load">load</a></code>. If
+<code>sym1</code> is given, it should specify a set of characters, and
+<code>str</code> will then return a list of tokens analog to <code><a
+href="refR.html#read">read</a></code>. The second form does the reverse
+operation by building a string from a list. See also <code><a
+href="refA.html#any">any</a></code>, <code><a
+href="refN.html#name">name</a></code> and <code><a
+href="refS.html#sym">sym</a></code>.
+
+<pre><code>
+: (str "a (1 2) b")
+-> (a (1 2) b)
+: (str '(a "Hello" DEF))
+-> "a \"Hello\" DEF"
+: (str "a*3+b*4" "_")
+-> (a "*" 3 "+" b "*" 4)
+</code></pre>
+
+<dt><a name="strDat"><code>(strDat 'sym) -> dat</code></a>
+<dd>Converts a string <code>sym</code> in the date format of the current
+<code><a href="refL.html#locale">locale</a></code> to a <code><a
+href="refD.html#date">date</a></code>. See also <code><a
+href="refE.html#expDat">expDat</a></code>, <code><a
+href="ref_.html#$dat">$dat</a></code> and <code><a
+href="refD.html#datStr">datStr</a></code>.
+
+<pre><code>
+: (strDat "2007-06-01")
+-> 733134
+: (strDat "01.06.2007")
+-> NIL
+: (locale "DE" "de")
+-> NIL
+: (strDat "01.06.2007")
+-> 733134
+: (strDat "1.6.2007")
+-> 733134
+</code></pre>
+
+<dt><a name="strip"><code>(strip 'any) -> any</code></a>
+<dd>Strips all leading <code>quote</code> symbols from <code>any</code>.
+
+<pre><code>
+: (strip 123)
+-> 123
+: (strip '''(a))
+-> (a)
+: (strip (quote quote a b c))
+-> (a b c)
+</code></pre>
+
+<dt><a name="str?"><code>(str? 'any) -> sym | NIL</code></a>
+<dd>Returns the argument <code>any</code> when it is a transient symbol
+(string), otherwise <code>NIL</code>. See also <code><a
+href="refS.html#sym?">sym?</a></code>, <code><a
+href="refB.html#box?">box?</a></code> and <code><a
+href="refE.html#ext?">ext?</a></code>.
+
+<pre><code>
+: (str? 123)
+-> NIL
+: (str? '{ABC})
+-> NIL
+: (str? 'abc)
+-> NIL
+: (str? "abc")
+-> "abc"
+</code></pre>
+
+<dt><a name="sub?"><code>(sub? 'any1 'any2) -> any2 | NIL</code></a>
+<dd>Returns <code>any2</code> when the string representation of
+<code>sym1</code> is a substring of the string representation of
+<code>sym2</code>. See also <code><a href="refP.html#pre?">pre?</a></code>.
+
+<pre><code>
+: (sub? "def" "abcdef")
+-> T
+: (sub? "abb" "abcdef")
+-> NIL
+: (sub? NIL "abcdef")
+-> T
+</code></pre>
+
+<dt><a name="subr"><code>(subr 'sym) -> num</code></a>
+<dd>Converts a Lisp-function that was previously converted with <code><a
+href="refE.html#expr">expr</a></code> back to a C-function.
+
+<pre><code>
+: car
+-> 67313448
+: (expr 'car)
+-> (@ (pass $385260187))
+: (subr 'car)
+-> 67313448
+: car
+-> 67313448
+</code></pre>
+
+<dt><a name="sum"><code>(sum 'fun 'lst ..) -> num</code></a>
+<dd>Applies <code>fun</code> to each element of <code>lst</code>. When
+additional <code>lst</code> arguments are given, their elements are also passed
+to <code>fun</code>. Returns the sum of all numeric values returned from
+<code>fun</code>.
+
+<pre><code>
+: (setq A 1  B 2  C 3)
+-> 3
+: (sum val '(A B C))
+-> 6
+: (sum                           # Total size of symbol list values
+   '((X)
+      (and (pair (val X)) (size @)) )
+   (what) )
+-> 32021
+</code></pre>
+
+<dt><a name="super"><code>(super ['any ..]) -> any</code></a>
+<dd>Can only be used inside methods. Sends the current message to the current
+object <code>This</code>, this time starting the search for a method at the
+superclass(es) of the class where the current method was found. See also
+<code><a href="ref.html#oop">OO Concepts</a></code>, <code><a
+href="refE.html#extra">extra</a></code>, <code><a
+href="refM.html#method">method</a></code>, <code><a
+href="refM.html#meth">meth</a></code>, <code><a
+href="refS.html#send">send</a></code> and <code><a
+href="refT.html#try">try</a></code>.
+
+<pre><code>
+(dm stop> ()         # 'stop>' method of current class
+   (super)           # Call the 'stop>' method of the superclass
+   ... )             # other things
+</code></pre>
+
+<dt><a name="sym"><code>(sym 'any) -> sym</code></a>
+<dd>Generate the printed representation of <code>any</code> into the name of a
+new symbol <code>sym</code>. This is the reverse operation of <code><a
+href="refA.html#any">any</a></code>. See also <code><a
+href="refN.html#name">name</a></code> and <code><a
+href="refS.html#str">str</a></code>.
+
+<pre><code>
+: (sym '(abc "Hello" 123))
+-> "(abc \"Hello\" 123)"
+</code></pre>
+
+<dt><a name="sym?"><code>(sym? 'any) -> flg</code></a>
+<dd>Returns <code>T</code> when the argument <code>any</code> is a symbol. See
+also <code><a href="refS.html#str?">str?</a></code>, <code><a
+href="refB.html#box?">box?</a></code> and <code><a
+href="refE.html#ext?">ext?</a></code>.
+
+<pre><code>
+: (sym? 'a)
+-> T
+: (sym? NIL)
+-> T
+: (sym? 123)
+-> NIL
+: (sym? '(a b))
+-> NIL
+</code></pre>
+
+<dt><a name="sync"><code>(sync) -> flg</code></a>
+<dd>Waits for pending data from all family processes. While other processes are
+still sending data (via the <code><a href="refT.html#tell">tell</a></code>
+mechanism), a <code>select</code> system call is executed for all file
+descriptors and timers in the <code>VAL</code> of the global variable <code><a
+href="refR.html#*Run">*Run</a></code>. See also <code><a
+href="refK.html#key">key</a></code> and <code><a
+href="refW.html#wait">wait</a></code>.
+
+<pre><code>
+: (or (lock) (sync))       # Ensure database consistency
+-> T                       # (numeric process-id if lock failed)
+</code></pre>
+
+<dt><a name="sys"><code>(sys 'any ['any]) -> sym</code></a>
+<dd>Returns or sets a system environment variable.
+
+<pre><code>
+: (sys "TERM")  # Get current value
+-> "xterm"
+: (sys "TERM" "vt100")  # Set new value
+-> "vt100"
+: (sys "TERM")
+-> "vt100"
+</code></pre>
+
+</dl>
+
+</body>
+</html>
diff --git a/doc/refT.html b/doc/refT.html
@@ -0,0 +1,565 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN" "http://www.w3.org/TR/1998/REC-html40-19980424/loose.dtd">
+<html lang="en">
+<head>
+<meta http-equiv="Content-Type" content="text/html; charset=utf-8">
+<title>T</title>
+<link rel="stylesheet" href="doc.css" type="text/css">
+</head>
+<body>
+
+<h1>T</h1>
+
+<dl>
+
+<dt><a name="*Tmp"><code>*Tmp</code></a>
+<dd>A global variable holding the temporary directory name created with <code><a
+href="refT.html#tmp">tmp</a></code>. See also <code><a
+href="refB.html#*Bye">*Bye</a></code>.
+
+<pre><code>
+: *Bye
+-> ((saveHistory) (and *Tmp (call 'rm "-r" *Tmp)))
+: (tmp "foo" 123)
+-> "tmp/27140/foo123"
+: *Tmp
+-> "tmp/27140/"
+</code></pre>
+
+<p><dt><a name="*Tsm"><code>*Tsm</code></a>
+<dd>A global variable which may hold a cons pair of two strings with escape
+sequences, to switch on and off an alternative transient symbol markup. If set,
+<code><a href="refP.html#print">print</a></code> will output these sequences to
+the console instead of the standard double quote markup characters.
+
+<pre><code>
+: (de *Tsm "^[[4m" . "^[[24m")   # vt100 escape sequences for underline
+-> *Tsm
+: <u>Hello world</u>
+-> <u>Hello world</u>
+: (off *Tsm)
+-> NIL
+: "Hello world"                  # No underlining
+-> "Hello world"
+</code></pre>
+
+<dt><a name="+Time"><code>+Time</code></a>
+<dd>Class for clock time values (as calculated by <code><a
+href="refT.html#time">time</a></code>), a subclass of <code><a
+href="refN.html#+Number">+Number</a></code>. See also <code><a
+href="ref.html#dbase">Database</a></code>.
+
+<pre><code>
+(rel tim (+Time))  # Time of the day
+</code></pre>
+
+<dt><a name="T"><code>T</code></a>
+<dd>A global constant, evaluating to itself. <code>T</code> is commonly returned
+as the boolean value "true" (though any non-<code>NIL</code> values could be
+used). As a property key, it is used to store <a href="ref.html#pilog">Pilog</a>
+clauses, and inside Pilog clauses it is the <i>cut</i> operator. See also
+<code><a href="ref.html#nilSym">NIL</a></code>.
+
+<pre><code>
+: T
+-> T
+: (= 123 123)
+-> T
+: (get 'not T)
+-> ((@P (1 -> @P) T (fail)) (@P))
+</code></pre>
+
+<dt><a name="This"><code>This</code></a>
+<dd>Holds the current object during method execution (see <a
+href="ref.html#oop">OO Concepts</a>), or inside the body of a <code><a
+href="refW.html#with">with</a></code> statement. As it is a normal symbol,
+however, it can be used in normal bindings anywhere. See also <code><a
+href="refI.html#isa">isa</a></code>, <code><a href="ref_.html#:">:</a></code>,
+<code><a href="ref_.html#=:">=:</a></code>, <code><a
+href="ref_.html#::">::</a></code> and <code><a
+href="refV.html#var:">var:</a></code>.
+
+<pre><code>
+: (with 'X (println 'This 'is This))
+This is X
+-> X
+: (put 'X 'a 1)
+-> 1
+: (put 'X 'b 2)
+-> 2
+: (put 'Y 'a 111)
+-> 111
+: (put 'Y 'b 222)
+-> 222
+: (mapcar '((This) (cons (: a) (: b))) '(X Y))
+-> ((1 . 2) (111 . 222))
+</code></pre>
+
+<dt><a name="t"><code>(t . prg) -> T</code></a>
+<dd>Executes <code>prg</code>, and returns <code>T</code>. See also <code><a
+href="refN.html#nil">nil</a></code>, <code><a
+href="refP.html#prog">prog</a></code>, <code><a
+href="refP.html#prog1">prog1</a></code> and <code><a
+href="refP.html#prog2">prog2</a></code>.
+
+<pre><code>
+: (t (println 'OK))
+OK
+-> T
+</code></pre>
+
+<dt><a name="tab"><code>(tab 'lst 'any ..) -> NIL</code></a>
+<dd>Print all <code>any</code> arguments in a tabular format. <code>lst</code>
+should be a list of numbers, specifying the field width for each argument. All
+items in a column will be left-aligned for negative numbers, otherwise
+right-aligned. See also <code><a href="refA.html#align">align</a></code>,
+<code><a href="refC.html#center">center</a></code> and <code><a
+href="refW.html#wrap">wrap</a></code>.
+
+<pre><code>
+: (let Fmt (-3 14 14)
+   (tab Fmt "Key" "Rand 1" "Rand 2")
+   (tab Fmt "---" "------" "------")
+   (for C '(A B C D E F)
+      (tab Fmt C (rand) (rand)) ) )
+Key        Rand 1        Rand 2
+---        ------        ------
+A               0    1481765933
+B     -1062105905    -877267386
+C      -956092119     812669700
+D       553475508   -1702133896
+E      1344887256   -1417066392
+F      1812158119   -1999783937
+-> NIL
+</code></pre>
+
+<dt><a name="tail"><code>(tail 'cnt|lst 'lst) -> lst</code></a>
+<dd>Returns the last <code>cnt</code> elements of <code>lst</code>. If
+<code>cnt</code> is negative, it is added to the length of <code>lst</code>. If
+the first argument is a <code>lst</code>, <code>tail</code> is a predicate
+function returning that argument list if it is <code>equal</code> to the tail of
+the second argument, and <code>NIL</code> otherwise. <code>(tail -2 Lst)</code>
+is equivalent to <code>(nth Lst 3)</code>. See also <code><a
+href="refH.html#head">head</a></code>, <code><a
+href="refL.html#last">last</a></code> and <code><a
+href="refS.html#stem">stem</a></code>.
+
+<pre><code>
+: (tail 3 '(a b c d e f))
+-> (d e f)
+: (tail -2 '(a b c d e f))
+-> (c d e f)
+: (tail 0 '(a b c d e f))
+-> NIL
+: (tail 10 '(a b c d e f))
+-> (a b c d e f)
+: (tail '(d e f) '(a b c d e f))
+-> (d e f)
+</code></pre>
+
+<dt><a name="task"><code>(task 'num ['num] [sym 'any ..] [. prg]) -> lst</code></a>
+<dd>A front-end to the <code><a href="refR.html#*Run">*Run</a></code> global. If
+called with only a single <code>num</code> argument, the corresponding entry is
+removed from the value of <code>*Run</code>. Otherwise, a new entry is created.
+If an entry with that key already exists, an error is issued. For negative
+numbers, a second number must be supplied. If <code>sym</code>/<code>any</code>
+arguments are given, a <code><a href="refJ.html#job">job</a></code> environment
+is built for thie <code>*Run</code> entry. See also <code><a
+href="refF.html#forked">forked</a></code> and <code><a
+href="refT.html#timeout">timeout</a></code>.
+
+<pre><code>
+: (task -10000 5000 N 0 (msg (inc 'N)))            # Install task
+-> (-10000 5000 (job '((N . 0)) (msg (inc 'N))))   # for every 10 seconds
+: 1                                                # ... after 5 seconds
+2                                                  # ... after 10 seconds
+3                                                  # ... after 10 seconds
+(task -10000)                                      # remove again
+-> NIL
+
+: (task (port T 4444) (eval (udp @)))              # Receive RPC via UDP
+-> (3 (eval (udp @)))
+
+# Another session (on the same machine)
+: (udp "localhost" 4444 '(println *Pid))  # Send RPC message
+-> (println *Pid)
+</code></pre>
+
+<dt><a name="telStr"><code>(telStr 'sym) -> sym</code></a>
+<dd>Formats a telephone number according to the current <code><a
+href="refL.html#locale">locale</a></code>. If the string head matches the local
+country code, it is replaced with <code>0</code>, otherwise <code>+</code> is
+prepended. See also <code><a href="refE.html#expTel">expTel</a></code>, <code><a
+href="refD.html#datStr">datStr</a></code>, <code><a
+href="refM.html#money">money</a></code> and <code><a
+href="refF.html#format">format</a></code>.
+
+<pre><code>
+: (telStr "49 1234 5678-0")
+-> "+49 1234 5678-0"
+: (locale "DE" "de")
+-> NIL
+: (telStr "49 1234 5678-0")
+-> "01234 5678-0"
+</code></pre>
+
+<dt><a name="tell"><code>(tell 'sym ['any ..]) -> any</code></a>
+<dd>Family IPC: Send an executable list <code>(sym any ..)</code> to all family
+members (i.e. all children of the current process, and all other children of the
+parent process, see <code><a href="refF.html#fork">fork</a></code>) for
+automatic execution. <code>tell</code> can also be used by <code><a
+href="refC.html#commit">commit</a></code> to notify about database changes. See
+also <code><a href="refH.html#hear">hear</a></code>, <code><a
+href="refP.html#pid">pid</a></code> and <code><a
+href="refR.html#rpc">rpc</a></code>.
+
+<pre><code>
+: (call 'ps "x")                            # Show processes
+  PID TTY      STAT   TIME COMMAND
+  ..
+ 1321 pts/0    S      0:00 bin/picolisp ..  # Parent process
+ 1324 pts/0    S      0:01 bin/picolisp ..  # First child
+ 1325 pts/0    S      0:01 bin/picolisp ..  # Second child
+ 1326 pts/0    R      0:00 ps x
+-> T
+: *Pid                                      # We are the second child
+-> 1325
+: (tell 'println '*Pid)                     # Ask all others to print their Pid's
+1324
+-> *Pid
+</code></pre>
+
+<dt><a name="test"><code>(test 'any . prg)</code></a>
+<dd>Executes <code>prg</code>, and issues an <code><a
+href="ref.html#errors">error</a></code> if the result does not <code><a
+href="refM.html#match">match</a></code> the <code>any</code> argument.
+
+<pre><code>
+: (test 12 (* 3 4))
+-> NIL
+: (test 12 (+ 3 4))
+((+ 3 4))
+12 -- fail
+?
+</code></pre>
+
+<dt><a name="text"><code>(text 'any1 'any ..) -> sym</code></a>
+<dd>Builds a new transient symbol (string) from the string representation of
+<code>any1</code>, by replacing all occurrences of an at-mark "<code>@</code>",
+followed by one of the letters "<code>1</code>" through "<code>9</code>", and
+"<code>A</code>" through "<code>Z</code>", with the corresponding
+<code>any</code> argument. In this context "<code>@A</code>" refers to the 10th
+argument. A literal at-mark in the text can be represented by two successive
+at-marks. See also <code><a href="refP.html#pack">pack</a></code> and <code><a
+href="refG.html#glue">glue</a></code>.
+
+<pre><code>
+: (text "abc @1 def @2" 'XYZ 123)
+-> "abc XYZ def 123"
+: (text "a@@bc.@1" "de")
+-> "a@bc.de"
+</code></pre>
+
+<dt><a name="tim$"><code>(tim$ 'tim ['flg]) -> sym</code></a>
+<dd>Formats a <code><a href="refT.html#time">time</a></code> <code>tim</code>.
+If <code>flg</code> is <code>NIL</code>, the format is HH:MM, otherwise it is
+HH:MM:SS. See also <code><a href="ref_.html#$tim">$tim</a></code> and <code><a
+href="refD.html#dat$">dat$</a></code>.
+
+<pre><code>
+: (tim$ (time))
+-> "10:57"
+: (tim$ (time) T)
+-> "10:57:56"
+</code></pre>
+
+<dt><a name="timeout"><code>(timeout ['num])</code></a>
+<dd>Sets or refreshes a timeout value in the <code><a
+href="refR.html#*Run">*Run</a></code> global, so that the current process
+executes <code><a href="refB.html#bye">bye</a></code> after the given period. If
+called without arguments, the timeout is removed. See also <code><a
+href="refT.html#task">task</a></code>.
+
+<pre><code>
+: (timeout 3600000)           # Timeout after one hour
+-> (-1 3600000 (bye))
+: *Run                        # Look after a few seconds
+-> ((-1 3574516 (bye)))
+</code></pre>
+
+<dt><a name="throw"><code>(throw 'sym 'any)</code></a>
+<dd>Non-local jump into a previous <code><a
+href="refC.html#catch">catch</a></code> environment with the jump label
+<code>sym</code> (or <code>T</code> as a catch-all). Any pending <code><a
+href="refF.html#finally">finally</a></code> expressions are executed, local
+symbol bindings are restored, open files are closed and internal data structures
+are reset appropriately, as the environment was at the time when the
+corresponding <code>catch</code> was called. Then <code>any</code> is returned
+from that <code>catch</code>.
+
+<pre><code>
+: (de foo (N)
+   (println N)
+   (throw 'OK) )
+-> foo
+: (let N 1  (catch 'OK (foo 7))  (println N))
+7
+1
+-> 1
+</code></pre>
+
+<dt><a name="tick"><code>(tick (cnt1 . cnt2) . prg) -> any</code></a>
+<dd>Executes <code>prg</code>, then (destructively) adds the number of elapsed
+user ticks to the <code>cnt1</code> parameter, and the number of elapsed system
+ticks to the <code>cnt2</code> parameter. Thus, <code>cnt1</code> and
+<code>cnt2</code> will finally contain the total number of user and system time
+ticks spent in <code>prg</code> and all functions called (this works also for
+recursive functions). For execution profiling, <code>tick</code> is usually
+inserted into words with <code>prof</code>, and removed with
+<code>unprof</code>. See also <code><a href="refU.html#usec">usec</a></code>.
+
+<pre><code>
+: (de foo ()                        # Define function with empty loop
+   (tick (0 . 0) (do 100000000)) )
+-> foo
+: (foo)                             # Execute it
+-> NIL
+: (pp 'foo)
+(de foo NIL
+   (tick (97 . 0) (do 100000000)) ) # 'tick' incremented 'cnt1' by 97
+-> foo
+</code></pre>
+
+<dt><a name="till"><code>(till 'any ['flg]) -> lst|sym</code></a>
+<dd>Reads from the current input channel till a character contained in
+<code>any</code> is found (or until end of file if <code>any</code> is
+<code>NIL</code>). If <code>flg</code> is <code>NIL</code>, a list of
+single-character transient symbols is returned. Otherwise, a single string is
+returned. See also <code><a href="refF.html#from">from</a></code> and <code><a
+href="refL.html#line">line</a></code>.
+
+<pre><code>
+: (till ":")
+abc:def
+-> ("a" "b" "c")
+: (till ":" T)
+abc:def
+-> "abc"
+</code></pre>
+
+<dt><a name="time"><code>(time ['T]) -> tim</code></a>
+<dt><code>(time 'tim) -> (h m s)</code>
+<dt><code>(time 'h 'm ['s]) -> tim | NIL</code>
+<dt><code>(time '(h m [s])) -> tim | NIL</code>
+<dd>Calculates the time of day, represented as the number of seconds since
+midnight. When called without arguments, the current local time is returned.
+When called with a <code>T</code> argument, the time of the last call to
+<code><a href="refD.html#date">date</a></code> is returned. When called with a
+single number <code>tim</code>, it is taken as a time value and a list with the
+corresponding hour, minute and second is returned. When called with two or three
+numbers (or a list of two or three numbers) for the hour, minute (and optionally
+the second), the corresponding time value is returned (or <code>NIL</code> if
+they do not represent a legal time). See also <code><a
+href="refU.html#usec">usec</a></code>, <code><a
+href="refT.html#tim$">tim$</a></code> and <code><a
+href="ref_.html#$tim">$tim</a></code>.
+
+<pre><code>
+: (time)                         # Now
+-> 32334
+: (time 32334)                   # Now
+-> (8 58 54)
+: (time 25 30)                   # Illegal time
+-> NIL
+</code></pre>
+
+<dt><a name="tmp"><code>(tmp ['any ..]) -> sym</code></a>
+<dd>Returns the path name to the <code><a
+href="refP.html#pack">pack</a></code>ed <code>any</code> arguments in a
+process-local temporary directory. The directory name consists of "tmp/"
+followed by the current process ID <code><a
+href="refP.html#*Pid">*Pid</a></code>. This directory is automatically created
+if necessary, and removed upon termination of the process (<code><a
+href="refB.html#bye">bye</a></code>). See also <code><a
+href="refT.html#*Tmp">*Tmp</a></code> and <code><a
+href="refB.html#*Bye">*Bye</a></code> .
+
+<pre><code>
+: *Bye
+-> ((saveHistory) (and *Tmp (call 'rm "-r" *Tmp)))
+: *Pid
+-> 27140
+: (tmp "foo" 123)
+-> "tmp/27140/foo123"
+: (dir "tmp/")
+-> ("27140")
+: (out (tmp "foo" 123) (println 'OK))
+-> OK
+: (dir (tmp))
+-> ("foo123")
+: (in (tmp "foo" 123) (read))
+-> OK
+</code></pre>
+
+<dt><a name="tolr/3"><code>tolr/3</code></a>
+<dd><a href="ref.html#pilog">Pilog</a> predicate that succeeds if the first
+argument is either a <i>substring</i> or a <code><a
+href="refS.html#+Sn">+Sn</a></code> <i>soundex</i> match of the result of
+applying the <code><a href="refG.html#get">get</a></code> algorithm to the
+following arguments. Typically used as filter predicate in <code><a
+href="refS.html#select/3">select/3</a></code> database queries. See also
+<code><a href="refI.html#isa/2">isa/2</a></code>, <code><a
+href="refS.html#same/3">same/3</a></code>, <code><a
+href="refB.html#bool/3">bool/3</a></code>, <code><a
+href="refR.html#range/3">range/3</a></code>, <code><a
+href="refH.html#head/3">head/3</a></code>, <code><a
+href="refF.html#fold/3">fold/3</a></code> and <code><a
+href="refP.html#part/3">part/3</a></code>.
+
+<pre><code>
+: (?
+   @Nr (1 . 5)
+   @Nm "Sven"
+   (select (@CuSu)
+      ((nr +CuSu @Nr) (nm +CuSu @Nm))
+      (range @Nr @CuSu nr)
+      (tolr @Nm @CuSu nm) )
+   (val @Name @CuSu nm) )
+ @Nr=(1 . 5) @Nm="Sven" @CuSu={2-2} @Name="Seven Oaks Ltd."
+</code></pre>
+
+<dt><a name="touch"><code>(touch 'sym) -> sym</code></a>
+<dd>When <code>sym</code> is an external symbol, it is marked as "modified" so
+that upon a later <code><a href="refC.html#commit">commit</a></code> it will be
+written to the database file. An explicit call of <code>touch</code> is only
+necessary when the value or properties of <code>sym</code> are indirectly
+modified.
+
+<pre><code>
+: (get '{2} 'lst)
+-> (1 2 3 4 5)
+: (set (cdr (get (touch '{2}) 'lst)) 999)    # Only read-access, need 'touch'
+-> 999
+: (get '{2} 'lst)                            # Modified second list element
+-> (1 999 3 4 5)
+</code></pre>
+
+<dt><a name="trace"><code>(trace 'sym) -> sym</code></a>
+<dt><code>(trace 'sym 'cls) -> sym</code>
+<dt><code>(trace '(sym . cls)) -> sym</code>
+<dd>Inserts a <code><a href="ref_.html#$">$</a></code> trace function call at
+the beginning of the function or method body of <code>sym</code>, so that trace
+information will be printed before and after execution. Built-in functions
+(C-function pointer) are automatically converted to Lisp expressions (see
+<code><a href="refE.html#expr">expr</a></code>). See also <code><a
+href="refD.html#*Dbg">*Dbg</a></code>, <code><a
+href="refT.html#traceAll">traceAll</a></code> and <code><a
+href="refU.html#untrace">untrace</a></code>, <code><a
+href="refD.html#debug">debug</a></code> and <code><a
+href="refL.html#lint">lint</a></code>.
+
+<pre><code>
+: (trace '+)
+-> +
+: (+ 3 4)
+ + : 3 4
+ + = 7
+-> 7
+</code></pre>
+
+<dt><a name="traceAll"><code>(traceAll ['lst]) -> sym</code></a>
+<dd>Traces all Lisp level functions by inserting a <code><a
+href="ref_.html#$">$</a></code> function call at the beginning. <code>lst</code>
+may contain symbols which are to be excluded from that process. In addition, all
+symbols in the global variable <code>*NoTrace</code> are excluded. See also
+<code><a href="refT.html#trace">trace</a></code>, <code><a
+href="refU.html#untrace">untrace</a></code> and <code><a
+href="refD.html#*Dbg">*Dbg</a></code>.
+
+<pre><code>
+: (traceAll)      # Trace all Lisp level functions
+-> balance
+</code></pre>
+
+<dt><a name="tree"><code>(tree 'var 'cls ['hook]) -> tree</code></a>
+<dd>Returns a data structure specifying a database index tree. <code>var</code>
+and <code>cls</code> determine the relation, with an optional <code>hook</code>
+object. See also <code><a href="refR.html#root">root</a></code>, <code><a
+href="refF.html#fetch">fetch</a></code>, <code><a
+href="refS.html#store">store</a></code>, <code><a
+href="refC.html#count">count</a></code>, <code><a
+href="refL.html#leaf">leaf</a></code>, <code><a
+href="refM.html#minKey">minKey</a></code>, <code><a
+href="refM.html#maxKey">maxKey</a></code>, <code><a
+href="refI.html#init">init</a></code>, <code><a
+href="refS.html#step">step</a></code>, <code><a
+href="refS.html#scan">scan</a></code>, <code><a
+href="refI.html#iter">iter</a></code>, <code><a
+href="refP.html#prune">prune</a></code>, <code><a
+href="refZ.html#zapTree">zapTree</a></code> and <code><a
+href="refC.html#chkTree">chkTree</a></code>.
+
+<pre><code>
+: (tree 'nm '+Item)
+-> (nm . +Item)
+</code></pre>
+
+<dt><a name="trim"><code>(trim 'lst) -> lst</code></a>
+<dd>Returns a copy of <code>lst</code> with all trailing white space characters
+or <code>NIL</code> elements removed. See also <code><a
+href="refC.html#clip">clip</a></code>.
+
+<pre><code>
+: (trim (1 NIL 2 NIL NIL))
+-> (1 NIL 2)
+: (trim '(a b " " " "))
+-> (a b)
+</code></pre>
+
+<dt><a name="true/0"><code>true/0</code></a>
+<dd><a href="ref.html#pilog">Pilog</a> predicate that always succeeds. See also
+<code><a href="refF.html#fail/0">fail/0</a></code> and <code><a
+href="refR.html#repeat/0">repeat/0</a></code>.
+
+<pre><code>
+:  (? (true))
+-> T
+</code></pre>
+
+<dt><a name="try"><code>(try 'msg 'obj ['any ..]) -> any</code></a>
+<dd>Tries to send the message <code>msg</code> to the object <code>obj</code>,
+optionally with arguments <code>any</code>. If <code>any</code> is not an
+object, or if the message cannot be located in <code>obj</code>, its classes and
+superclasses, <code>NIL</code> is returned. See also <code><a
+href="ref.html#oop">OO Concepts</a></code>, <code><a
+href="refS.html#send">send</a></code>, <code><a
+href="refM.html#method">method</a></code>, <code><a
+href="refM.html#meth">meth</a></code>, <code><a
+href="refS.html#super">super</a></code> and <code><a
+href="refE.html#extra">extra</a></code>.
+
+<pre><code>
+: (try 'msg> 123)
+-> NIL
+: (try 'html> 'a)
+-> NIL
+</code></pre>
+
+<dt><a name="type"><code>(type 'any) -> lst</code></a>
+<dd>Return the type (list of classes) of the object <code>sym</code>. See also
+<code><a href="ref.html#oop">OO Concepts</a></code>, <code><a
+href="refI.html#isa">isa</a></code>, <code><a
+href="refC.html#class">class</a></code>, <code><a
+href="refN.html#new">new</a></code> and <code><a
+href="refO.html#object">object</a></code>.
+
+<pre><code>
+: (type '{1A;3})
+(+Address)
+: (type '+DnButton)
+-> (+Tiny +Rid +JS +Able +Button)
+</code></pre>
+
+</dl>
+
+</body>
+</html>
diff --git a/doc/refU.html b/doc/refU.html
@@ -0,0 +1,356 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN" "http://www.w3.org/TR/1998/REC-html40-19980424/loose.dtd">
+<html lang="en">
+<head>
+<meta http-equiv="Content-Type" content="text/html; charset=utf-8">
+<title>U</title>
+<link rel="stylesheet" href="doc.css" type="text/css">
+</head>
+<body>
+
+<h1>U</h1>
+
+<dl>
+
+<dt><a name="*Uni"><code>*Uni</code></a>
+<dd>A global variable holding an <code><a href="refI.html#idx">idx</a></code>
+tree, with all unique data that were collected with the comma (<code>,</code>)
+read-macro. Typically used for localization. See also <code><a
+href="ref.html#macro-io">Read-Macros</a></code> and <code><a
+href="refL.html#locale">locale</a></code>.
+
+<pre><code>
+: (off *Uni)            # Clear
+-> NIL
+: ,"abc"                # Collect a transient symbol
+-> "abc"
+: ,(1 2 3)              # Collect a list
+-> (1 2 3)
+: *Uni
+-> ("abc" NIL (1 2 3))
+</code></pre>
+
+<dt><a name="u"><code>(u) -> T</code></a>
+<dd>Removes <code><a href="ref_.html#!">!</a></code> all breakpoints in all
+subexpressions of the current breakpoint. Typically used when single-stepping a
+function or method with <code><a href="refD.html#debug">debug</a></code>. See
+also <code><a href="refD.html#d">d</a></code> and <code><a
+href="refU.html#unbug">unbug</a></code>.
+
+<pre><code>
+! (u)                         # Unbug subexpression(s) at breakpoint
+-> T
+</code></pre>
+
+<dt><a name="udp"><code>(udp 'any1 'cnt 'any2) -> any</code></a>
+<dt><code>(udp 'cnt) -> any</code>
+<dd>Simple unidirectional sending/receiving of UDP packets. In the first form,
+<code>any2</code> is sent to a UDP server listening at host <code>any1</code>,
+port <code>cnt</code>. In the second form, one item is received from a UDP
+socket <code>cnt</code>, established with <code><a
+href="refP.html#port">port</a></code>. See also <code><a
+href="refC.html#connect">connect</a></code>.
+
+<pre><code>
+# First session
+: (port T 6666)
+-> 3
+: (udp 3)  # Receive a datagram
+
+# Second session (on the same machine)
+: (udp "localhost" 6666 '(a b c))
+-> (a b c)
+
+# First session
+-> (a b c)
+</code></pre>
+
+<dt><a name="ultimo"><code>(ultimo 'y 'm) -> cnt</code></a>
+<dd>Returns the <code><a href="refD.html#date">date</a></code> of the last day
+of the month <code>m</code> in the year <code>y</code>. See also <code><a
+href="refD.html#day">day</a></code> and <code><a
+href="refW.html#week">week</a></code>.
+
+<pre><code>
+: (date (ultimo 2007 1))
+-> (2007 1 31)
+: (date (ultimo 2007 2))
+-> (2007 2 28)
+: (date (ultimo 2004 2))
+-> (2004 2 29)
+: (date (ultimo 2000 2))
+-> (2000 2 29)
+: (date (ultimo 1900 2))
+-> (1900 2 28)
+</code></pre>
+
+<dt><a name="unbug"><code>(unbug 'sym) -> T</code></a>
+<dt><code>(unbug 'sym 'cls) -> T</code>
+<dt><code>(unbug '(sym . cls)) -> T</code>
+<dd>Removes all <code><a href="ref_.html#!">!</a></code> breakpoints in the
+function or method body of sym, as inserted with <code><a
+href="refD.html#debug">debug</a></code> or <code><a
+href="refD.html#d">d</a></code>, or directly with <code><a
+href="refE.html#edit">edit</a></code>. See also <code><a
+href="refU.html#u">u</a></code>.
+
+<pre><code>
+: (pp 'tst)
+(de tst (N)
+   (! println (+ 3 N)) )         # 'tst' has a breakpoint '!'
+-> tst
+: (unbug 'tst)                   # Unbug it
+-> T
+: (pp 'tst)                      # Restore
+(de tst (N)
+   (println (+ 3 N)) )
+</code></pre>
+
+<dt><a name="undef"><code>(undef 'sym) -> fun</code></a>
+<dt><code>(undef 'sym 'cls) -> fun</code>
+<dt><code>(undef '(sym . cls)) -> fun</code>
+<dd>Undefines the function or method <code>sym</code>. Returns the previous
+definition. See also <code><a href="refD.html#de">de</a></code>, <code><a
+href="refD.html#dm">dm</a></code>, <code><a href="refD.html#def">def</a></code>
+and <code><a href="refR.html#redef">redef</a></code>.
+
+<pre><code>
+: (de hello () "Hello world!")
+-> hello
+: hello
+-> (NIL "Hello world!")
+: (undef 'hello)
+-> (NIL "Hello world!")
+: hello
+-> NIL
+</code></pre>
+
+<dt><a name="unify"><code>(unify 'any) -> lst</code></a>
+<dd>Unifies <code>any</code> with the current <a href="ref.html#pilog">Pilog</a>
+environment at the current level and with a value of <code>NIL</code>, and
+returns the new environment or <code>NIL</code> if not successful. See also
+<code><a href="refP.html#prove">prove</a></code> and <code><a
+href="ref_.html#->">-&gt</a></code>.
+
+<pre><code>
+: (? (@A unify '(@B @C)))
+ @A=(((NIL . @C) 0 . @C) ((NIL . @B) 0 . @B) T)
+</code></pre>
+
+<dt><a name="uniq"><code>(uniq 'lst) -> lst</code></a>
+<dd>Returns a unique list, by eleminating all duplicate elements from
+<code>lst</code>. See also <a href="ref.html#cmp">Comparing</a>, <code><a
+href="refS.html#sort">sort</a></code> and <code><a
+href="refG.html#group">group</a></code>.
+
+<pre><code>
+: (uniq (2 4 6 1 2 3 4 5 6 1 3 5))
+-> (2 4 6 1 3 5)
+</code></pre>
+
+<dt><a name="uniq/2"><code>uniq/2</code></a>
+<dd><a href="ref.html#pilog">Pilog</a> predicate that succeeds if the first
+argument is not yet stored in the second argument's index structure. <code><a
+href="refI.html#idx">idx</a></code> is used internally storing for the values
+and checking for uniqueness. See also <code><a
+href="refM.html#member/2">member/2</a></code>.
+
+<pre><code>
+: (? (uniq a @Z))       # Remember 'a'
+ @Z=NIL                 # Succeeded
+
+: (? (uniq b @Z))       # Remember 'b'
+ @Z=NIL                 # Succeeded
+
+: (? (uniq a @Z))       # Remembered 'a'?
+-> NIL                  # Yes: Not unique
+</code></pre>
+
+<dt><a name="unless"><code>(unless 'any . prg) -> any</code></a>
+<dd>Conditional execution: When the condition <code>any</code> evaluates to
+non-<code>NIL</code>, <code>NIL</code> is returned. Otherwise <code>prg</code>
+is executed and the result returned. See also <code><a
+href="refW.html#when">when</a></code>.
+
+<pre><code>
+: (unless (= 3 3) (println 'Strange 'result))
+-> NIL
+: (unless (= 3 4) (println 'Strange 'result))
+Strange result
+-> result
+</code></pre>
+
+<dt><a name="until"><code>(until 'any . prg) -> any</code></a>
+<dd>Conditional loop: While the condition <code>any</code> evaluates to
+<code>NIL</code>, <code>prg</code> is repeatedly executed. If <code>prg</code>
+is never executed, <code>NIL</code> is returned. Otherwise the result of
+<code>prg</code> is returned. See also <code><a
+href="refW.html#while">while</a></code>.
+
+<pre><code>
+: (until (=T (setq N (read)))
+   (println 'square (* N N)) )
+4
+square 16
+9
+square 81
+T
+-> 81
+</code></pre>
+
+<dt><a name="untrace"><code>(untrace 'sym) -> sym</code></a>
+<dt><code>(untrace 'sym 'cls) -> sym</code>
+<dt><code>(untrace '(sym . cls)) -> sym</code>
+<dd>Removes the <code><a href="ref_.html#$">$</a></code> trace function call at
+the beginning of the function or method body of <code>sym</code>, so that no
+more trace information will be printed before and after execution. Built-in
+functions (C-function pointer) are automatically converted to their original
+form (see <code><a href="refS.html#subr">subr</a></code>). See also <code><a
+href="refT.html#trace">trace</a></code> and <code><a
+href="refT.html#traceAll">traceAll</a></code>.
+
+<pre><code>
+: (trace '+)                           # Trace the '+' function
+-> +
+: +
+-> (@ ($ + @ (pass $385455126)))       # Modified for tracing
+: (untrace '+)                         # Untrace '+'
+-> +
+: +
+-> 67319120                            # Back to original form
+</code></pre>
+
+<dt><a name="up"><code>(up [cnt] sym ['val]) -> any</code></a>
+<dd>Looks up (or modifies) the <code>cnt</code>'th previously saved value of
+<code>sym</code> in the corresponding enclosing environment. If <code>cnt</code>
+is not given, 1 is used. See also <code><a
+href="refE.html#eval">eval</a></code>, <code><a
+href="refR.html#run">run</a></code> and <code><a
+href="refE.html#env">env</a></code>.
+
+<pre><code>
+: (let N 1 ((quote (N) (println N (up N))) 2))
+2 1
+-> 1
+: (let N 1 ((quote (N) (println N (up N) (up N 7))) 2) N)
+2 1 7
+-> 7
+</code></pre>
+
+<dt><a name="upd"><code>(upd sym ..) -> lst</code></a>
+<dd>Synchronizes the internal state of all passed (external) symbols by passing
+them to <code><a href="refW.html#wipe">wipe</a></code>. <code>upd</code> is the
+standard function passed to <code><a href="refC.html#commit">commit</a></code>
+during database <code><a href="ref.html#trans">transactions</a></code>.
+
+<pre><code>
+(commit 'upd)  # Commit changes, informing all sister processes
+</code></pre>
+
+<dt><a name="update"><code>(update 'obj ['var]) -> obj</code></a>
+<dd>Interactive database function for modifying external symbols. When called
+only with an <code>obj</code> argument, <code>update</code> steps through the
+value and all properties of that object (and recursively also through
+substructures) and allows to edit them with the console line editor. When the
+<code>var</code> argument is given, only that single property is handed to the
+editor. To delete a propery, <code>NIL</code> must be explicitly entered.
+<code>update</code> will correctly handle all <a
+href="ref.html#er">entity/relation</a> mechanisms. See also <code><a
+href="refS.html#select">select</a></code>, <code><a
+href="refE.html#edit">edit</a></code> and <code><a
+href="ref.html#dbase">Database</a></code>.
+
+<pre><code>
+: (show '{3-1})            # Show item 1
+{3-1} (+Item)
+   nr 1
+   pr 29900
+   inv 100
+   sup {2-1}
+   nm "Main Part"
+-> {3-1}
+
+: (update '{3-1} 'pr)      # Update the prices of that item
+{3-1} pr 299.00            # The cursor is right behind "299.00"
+-> {3-1}
+</code></pre>
+
+<dt><a name="upp?"><code>(upp? 'any) -> sym | NIL</code></a>
+<dd>Returns <code>any</code> when the argument is a string (symbol) that starts
+with an uppercase character. See also <code><a
+href="refU.html#uppc">uppc</a></code>.
+
+<pre><code>
+: (upp? "A")
+-> T
+: (upp? "a")
+-> NIL
+: (upp? 123)
+-> NIL
+: (upp? ".")
+-> NIL
+</code></pre>
+
+<dt><a name="uppc"><code>(uppc 'any) -> any</code></a>
+<dd>Upper case conversion: If <code>any</code> is not a symbol, it is returned
+as it is. Otherwise, a new transient symbol with all characters of
+<code>any</code>, converted to upper case, is returned. See also <code><a
+href="refL.html#lowc">lowc</a></code>, <code><a
+href="refF.html#fold">fold</a></code> and <code><a
+href="refU.html#upp?">upp?</a></code>.
+
+<pre><code>
+: (uppc 123)
+-> 123
+: (uppc "abc")
+-> "ABC"
+: (uppc 'car)
+-> "CAR"
+</code></pre>
+
+<dt><a name="use"><code>(use sym . prg) -> any</code></a>
+<dt><code>(use (sym ..) . prg) -> any</code>
+<dd>Defines local variables. The value of the symbol <code>sym</code> - or the
+values of the symbols <code>sym</code> in the list of the second form - are
+saved, <code>prg</code> is executed, then the symbols are restored to their
+original values. During execution of <code>prg</code>, the values of the symbols
+can be temporarily modified. The return value is the result of <code>prg</code>.
+See also <code><a href="refB.html#bind">bind</a></code>, <code><a
+href="refJ.html#job">job</a></code> and <code><a
+href="refL.html#let">let</a></code>.
+
+<pre><code>
+: (setq  X 123  Y 456)
+-> 456
+: (use (X Y) (setq  X 3  Y 4) (* X Y))
+-> 12
+: X
+-> 123
+: Y
+-> 456
+</code></pre>
+
+<dt><a name="useKey"><code>(useKey 'var 'cls ['hook]) -> num</code></a>
+<dd>Generates or reuses a key for a database tree, by randomly trying to locate
+a free number. See also <code><a href="refG.html#genKey">genKey</a></code>.
+
+<pre><code>
+: (maxKey (tree 'nr '+Item))
+-> 8
+: (useKey 'nr '+Item)
+-> 12
+</code></pre>
+
+<dt><a name="usec"><code>(usec) -> num</code></a>
+<dd>Returns the number the microseconds since interpreter startup. See also
+<code><a href="refT.html#time">time</a></code> and <code><a
+href="refT.html#tick">tick</a></code>.
+
+<pre><code>
+: (usec)
+-> 1154702479219050
+</code></pre>
+
+</dl>
+
+</body>
+</html>
diff --git a/doc/refV.html b/doc/refV.html
@@ -0,0 +1,163 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN" "http://www.w3.org/TR/1998/REC-html40-19980424/loose.dtd">
+<html lang="en">
+<head>
+<meta http-equiv="Content-Type" content="text/html; charset=utf-8">
+<title>V</title>
+<link rel="stylesheet" href="doc.css" type="text/css">
+</head>
+<body>
+
+<h1>V</h1>
+
+<dl>
+
+<dt><a name="val"><code>(val 'var) -> any</code></a>
+<dd>Returns the current value of <code>var</code>. See also <code><a
+href="refS.html#setq">setq</a></code>, <code><a
+href="refS.html#set">set</a></code> and <code><a
+href="refD.html#def">def</a></code>.
+
+<pre><code>
+: (setq L '(a b c))
+-> (a b c)
+: (val 'L)
+-> (a b c)
+: (val (cdr L))
+-> b
+</code></pre>
+
+<dt><a name="val/3"><code>val/3</code></a>
+<dd><a href="ref.html#pilog">Pilog</a> predicate that returns the value of an
+object's attribute. Typically used in database queries. The first argument is a
+Pilog variable to bind the value, the second is the object, and the third and
+following arguments are used to apply the <code><a
+href="refG.html#get">get</a></code> algorithm to that object. See also <code><a
+href="refD.html#db/3">db/3</a></code> and <code><a
+href="refS.html#select/3">select/3</a></code>.
+
+<pre><code>
+: (?
+   (db nr +Item (2 . 5) @Item)   # Fetch articles 2 through 5
+   (val @Nm @Item nm)            # Get item description
+   (val @Sup @Item sup nm) )     # and supplier's name
+ @Item={3-2} @Nm="Spare Part" @Sup="Seven Oaks Ltd."                             @Item={3-3} @Nm="Auxiliary Construction" @Sup="Active Parts Inc."
+ @Item={3-4} @Nm="Enhancement Additive" @Sup="Seven Oaks Ltd."
+ @Item={3-5} @Nm="Metal Fittings" @Sup="Active Parts Inc."
+-> NIL
+</code></pre>
+
+<dt><a name="var"><code>(var sym . any) -> any</code></a>
+<dd>Defines a class variable <code>sym</code> with the initial value
+<code>any</code> for the current class (in <code><a
+href="refC.html#*Class">*Class</a></code>). See also <code><a
+href="ref.html#oop">OO Concepts</a></code> and <code><a
+href="refV.html#var:">var:</a></code>.
+
+<pre><code>
+: (class +A)
+-> +A
+: (var a . 1)
+-> 1
+: (var b . 2)
+-> 2
+: (show '+A)
++A NIL
+   b 2
+   a 1
+-> +A
+</code></pre>
+
+<dt><a name="var:"><code>(var: sym) -> any</code></a>
+<dd>Fetches the value of a class variable <code>sym</code> for the current
+object <code><a href="refT.html#This">This</a></code>, by searching the property
+lists of its class(es) and supperclasses. See also <code><a
+href="ref.html#oop">OO Concepts</a></code>, <code><a
+href="refV.html#var">var</a></code>, <code><a
+href="refW.html#with">with</a></code>, <code><a
+href="refM.html#meta">meta</a></code>, <code><a href="ref_.html#:">:</a></code>,
+<code><a href="ref_.html#=:">=:</a></code> and <code><a
+href="ref_.html#::">::</a></code>.
+
+<pre><code>
+: (object 'O '(+A) 'a 9 'b 8)
+-> O
+: (with 'O (list (: a) (: b) (var: a) (var: b)))
+-> (9 8 1 2)
+</code></pre>
+
+<dt><a name="version"><code>(version ['flg]) -> lst</code></a>
+<dd>(64-bit version only) Prints the current version as a string of
+dot-separated numbers, and returns the current version as a list of numbers.
+When <code>flg</code> is non-NIL, printing is suppressed.
+
+<pre><code>
+$ ./p -version
+3.0.1.22
+: (version T)
+-> (3 0 1 22)
+</code></pre>
+
+<dt><a name="vi"><code>(vi 'sym) -> sym</code></a>
+<dt><code>(vi 'sym 'cls) -> sym</code>
+<dt><code>(vi '(sym . cls)) -> sym</code>
+<dt><code>(vi) -> NIL</code>
+<dd>Opens the "vi" editor on the function or method definition of
+<code>sym</code>. A call to <code><a href="refL.html#ld">ld</a></code>
+thereafter will <code><a href="refL.html#load">load</a></code> the modified
+file. See also <code><a href="refD.html#doc">doc</a></code>, <code><a
+href="refP.html#pp">pp</a></code>, <code><a
+href="refD.html#*Dbg">*Dbg</a></code>, <code><a
+href="refD.html#debug">debug</a></code> and <code><a
+href="refP.html#pp">pp</a></code>.
+
+<pre><code>
+: (vi 'url> '+CuSu)  # Edit the method's source code, then exit from 'vi'
+-> T
+</code></pre>
+
+<dt><a name="view"><code>(view 'lst) -> any</code></a>
+<dd>Views <code>lst</code> as tree-structured ASCII graphics. See also <code><a
+href="refP.html#pretty">pretty</a></code> and <code><a
+href="refS.html#show">show</a></code>.
+
+<pre><code>
+: (view '(a (b c d) (e (f (g) (h) (i)) (j (k) (l) (m))) (n o p) q))
++-- a
+|
++---+-- b
+|   |
+|   +-- c
+|   |
+|   +-- d
+|
++---+-- e
+|   |
+|   +---+-- f
+|   |   |
+|   |   +---+-- g
+|   |   |
+|   |   +---+-- h
+|   |   |
+|   |   +---+-- i
+|   |
+|   +---+-- j
+|       |
+|       +---+-- k
+|       |
+|       +---+-- l
+|       |
+|       +---+-- m
+|
++---+-- n
+|   |
+|   +-- o
+|   |
+|   +-- p
+|
++-- q
+</code></pre>
+
+</dl>
+
+</body>
+</html>
diff --git a/doc/refW.html b/doc/refW.html
@@ -0,0 +1,196 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN" "http://www.w3.org/TR/1998/REC-html40-19980424/loose.dtd">
+<html lang="en">
+<head>
+<meta http-equiv="Content-Type" content="text/html; charset=utf-8">
+<title>W</title>
+<link rel="stylesheet" href="doc.css" type="text/css">
+</head>
+<body>
+
+<h1>W</h1>
+
+<dl>
+
+<dt><a name="wait"><code>(wait ['cnt] . prg) -> any</code></a>
+<dd>Waits for a condition. While the result of the execution of <code>prg</code>
+returns non-<code>NIL</code>, a <code>select</code> system call is executed for
+all file descriptors and timers in the <code>VAL</code> of the global variable
+<code><a href="refR.html#*Run">*Run</a></code>. When <code>cnt</code> is
+non-<code>NIL</code>, the waiting time is limited to <code>cnt</code>
+milliseconds. See also <code><a href="refK.html#key">key</a></code> and <code><a
+href="refS.html#sync">sync</a></code>.
+
+<pre><code>
+: (wait 2000)                                # Wait 2 seconds
+-> NIL
+: (prog
+   (zero *Cnt)
+   (setq *Run                                # Install background loop
+      '((-2000 0 (println (inc '*Cnt)))) )   # Increment '*Cnt' every 2 sec
+   (wait NIL (> *Cnt 6))                     # Wait until > 6
+   (off *Run) )
+1                                            # Waiting ..
+2
+3
+4
+5
+6
+7
+-> NIL
+</code></pre>
+
+<dt><a name="week"><code>(week 'dat) -> num</code></a>
+<dd>Returns the number of the week for a given <code><a
+href="refD.html#date">date</a></code> <code>dat</code>. See also <code><a
+href="refD.html#day">day</a></code>, <code><a
+href="refU.html#ultimo">ultimo</a></code>, <code><a
+href="refD.html#datStr">datStr</a></code> and <code><a
+href="refS.html#strDat">strDat</a></code>.
+
+<pre><code>
+: (datStr (date))
+-> <u>2007-06-01</u>
+: (week (date))
+-> 22
+</code></pre>
+
+<dt><a name="when"><code>(when 'any . prg) -> any</code></a>
+<dd>Conditional execution: When the condition <code>any</code> evaluates to
+non-<code>NIL</code>, <code>prg</code> is executed and the result is returned.
+Otherwise <code>NIL</code> is returned. See also <code><a
+href="refU.html#unless">unless</a></code>.
+
+<pre><code>
+: (when (> 4 3) (println 'OK) (println 'Good))
+OK
+Good
+-> Good
+</code></pre>
+
+<dt><a name="while"><code>(while 'any . prg) -> any</code></a>
+<dd>Conditional loop: While the condition <code>any</code> evaluates to
+non-<code>NIL</code>, <code>prg</code> is repeatedly executed. If
+<code>prg</code> is never executed, <code>NIL</code> is returned. Otherwise the
+result of <code>prg</code> is returned. See also <code><a
+href="refU.html#until">until</a></code>.
+
+<pre><code>
+: (while (read)
+   (println 'got: @) )
+abc
+got: abc
+1234
+got: 1234
+NIL
+-> 1234
+</code></pre>
+
+<dt><a name="what"><code>(what 'sym) -> lst</code></a>
+<dd>Returns a list of all internal symbols that match the pattern string
+<code>sym</code>. See also <code><a href="refM.html#match">match</a></code>,
+<code><a href="refW.html#who">who</a></code> and <code><a
+href="refC.html#can">can</a></code>.
+
+<pre><code>
+: (what <u>cd@dr</u>)
+-> (cdaddr cdaadr cddr cddddr cdddr cddadr cdadr)
+</code></pre>
+
+<dt><a name="who"><code>(who 'any) -> lst</code></a>
+<dd>Returns a list of all functions or method definitions that contain the atom
+or pattern <code>any</code>. See also <code><a
+href="refM.html#match">match</a></code>, <code><a
+href="refW.html#what">what</a></code> and <code><a
+href="refC.html#can">can</a></code>.
+
+<pre><code>
+: (who 'caddr)                         # Who is using 'caddr'?
+-> ($dat lint1 expDat datStr $tim tim$ mail _gen dat$ datSym)
+
+: (who <u>Type error</u>)
+-> ((mis> . +Link) *Uni (mis> . +Joint))
+
+: (more (who <u>Type error</u>) pp)           # Pretty print all results
+(dm (mis> . +Link) (Val Obj)
+   (and
+      Val
+      (nor (isa (: type) Val) (canQuery Val))
+      <u>Type error</u> ) )
+.                                      # Stop
+-> T
+</code></pre>
+
+<dt><a name="wipe"><code>(wipe 'sym|lst) -> sym|lst</code></a>
+<dd>Clears the <code>VAL</code> and the property list of <code>sym</code>, or of
+all symbols in the list <code>lst</code>. When a symbol is an external symbol,
+its state is also set to "not loaded". Does nothing when <code>sym</code> is an
+external symbol that has been modified or deleted ("dirty").
+
+<pre><code>
+: (setq A (1 2 3 4))
+-> (1 2 3 4)
+: (put 'A 'a 1)
+-> 1
+: (put 'A 'b 2)
+-> 2
+: (show 'A)
+A (1 2 3 4)
+   b 2
+   a 1
+-> A
+: (wipe 'A)
+-> A
+: (show 'A)
+A NIL
+-> A
+</code></pre>
+
+<dt><a name="with"><code>(with 'sym . prg) -> any</code></a>
+<dd>Saves the current object <code>This</code> and sets it to the new value
+<code>sym</code>. Then <code>prg</code> is executed, and <code>This</code> is
+restored to its previous value. The return value is the result of
+<code>prg</code>. Used typically to access the local data of <code>sym</code> in
+the same manner as inside a method body. <code>prg</code> is not executed (and
+<code>NIL</code> is returned) when <code>sym</code> is <code>NIL</code>.
+<code>(with 'X . prg)</code> is equivalent to <code>(let? This 'X . prg)</code>.
+
+<pre><code>
+: (put 'X 'a 1)
+-> 1
+: (put 'X 'b 2)
+-> 2
+: (with 'X (list (: a) (: b)))
+-> (1 2)
+</code></pre>
+
+<dt><a name="wr"><code>(wr 'cnt ..) -> cnt</code></a>
+<dd>Writes all <code>cnt</code> arguments as raw bytes to the current output
+channel. See also <code><a href="refR.html#rd">rd</a></code> and <code><a
+href="refP.html#pr">pr</a></code>.
+
+<pre><code>
+: (out <u>x</u> (wr 1 255 257))  # Write to "x"
+-> 257
+: (hd <u>x</u>)
+00000000  01 FF 01                                         ...
+-> NIL
+</code></pre>
+
+<dt><a name="wrap"><code>(wrap 'cnt 'lst) -> sym</code></a>
+<dd>Returns a transient symbol with all characters in <code>lst</code> <code><a
+href="refP.html#pack">pack</a></code>ed in lines with a maximal length of
+<code>cnt</code>. See also <code><a href="refT.html#tab">tab</a></code>,
+<code><a href="refA.html#align">align</a></code> and <code><a
+href="refC.html#center">center</a></code>.
+
+<pre><code>
+: (wrap 20 (chop <u>The quick brown fox jumps over the lazy dog</u>))
+-> <u>The quick brown fox^Jjumps over the lazy^Jdog</u>
+: (wrap 8 (chop <u>The quick brown fox jumps over the lazy dog</u>))
+-> <u>The^Jquick^Jbrown^Jfox^Jjumps^Jover the^Jlazy dog</u>
+</code></pre>
+
+</dl>
+
+</body>
+</html>
diff --git a/doc/refX.html b/doc/refX.html
@@ -0,0 +1,57 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN" "http://www.w3.org/TR/1998/REC-html40-19980424/loose.dtd">
+<html lang="en">
+<head>
+<meta http-equiv="Content-Type" content="text/html; charset=utf-8">
+<title>X</title>
+<link rel="stylesheet" href="doc.css" type="text/css">
+</head>
+<body>
+
+<h1>X</h1>
+
+<dl>
+
+<dt><a name="xchg"><code>(xchg 'var 'var ..) -> any</code></a>
+<dd>Exchange the values of successive <code>var</code> argument pairs.
+
+<pre><code>
+: (setq  A 1  B 2  C '(a b c))
+-> (a b c)
+: (xchg  'A C  'B (cdr C))
+-> 2
+: A
+-> a
+: B
+-> b
+: C
+-> (1 2 c)
+</code></pre>
+
+<dt><a name="xor"><code>(xor 'any 'any) -> flg</code></a>
+<dd>Returns T if exactly one of the arguments evaluates to non-<code>NIL</code>.
+
+<pre><code>
+: (xor T NIL)
+-> T
+: (xor T T)
+-> NIL
+</code></pre>
+
+<dt><a name="x|"><code>(x| 'num ..) -> num</code></a>
+<dd>Returns the bitwise <code>XOR</code> of all <code>num</code> arguments. When
+one of the arguments evaluates to <code>NIL</code>, it is returned immediately.
+See also <code><a href="ref_.html#&">&</a></code>, <code><a
+href="ref_.html#|">|</a></code> and <code><a
+href="refB.html#bit?">bit?</a></code>.
+
+<pre><code>
+: (x| 2 7)
+-> 5
+: (x| 2 7 1)
+-> 4
+</code></pre>
+
+</dl>
+
+</body>
+</html>
diff --git a/doc/refY.html b/doc/refY.html
@@ -0,0 +1,30 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN" "http://www.w3.org/TR/1998/REC-html40-19980424/loose.dtd">
+<html lang="en">
+<head>
+<meta http-equiv="Content-Type" content="text/html; charset=utf-8">
+<title>Y</title>
+<link rel="stylesheet" href="doc.css" type="text/css">
+</head>
+<body>
+
+<h1>Y</h1>
+
+<dl>
+
+<dt><a name="yoke"><code>(yoke 'any ..) -> any</code></a>
+<dd>Inserts one or several new elements <code>any</code> in front of the list in
+the current <code><a href="refM.html#make">make</a></code> environment.
+<code>yoke</code> returns the last inserted argument. See also <code><a
+href="refL.html#link">link</a></code>, <code><a
+href="refC.html#chain">chain</a></code> and <code><a
+href="refM.html#made">made</a></code>.
+
+<pre><code>
+: (make (link 2 3) (yoke 1) (link 4))
+-> (1 2 3 4)
+</code></pre>
+
+</dl>
+
+</body>
+</html>
diff --git a/doc/refZ.html b/doc/refZ.html
@@ -0,0 +1,102 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN" "http://www.w3.org/TR/1998/REC-html40-19980424/loose.dtd">
+<html lang="en">
+<head>
+<meta http-equiv="Content-Type" content="text/html; charset=utf-8">
+<title>Z</title>
+<link rel="stylesheet" href="doc.css" type="text/css">
+</head>
+<body>
+
+<h1>Z</h1>
+
+<dl>
+
+<dt><a name="*Zap"><code>*Zap</code></a>
+<dd>A global variable holding a list and a pathname. If given, and the value of
+<code><a href="refS.html#*Solo">*Solo</a></code> is <code>NIL</code>, external
+symbols which are no longer accessible can be collected in the CAR, e.g. during
+DB tree processing, and written to the file in the CDR at the next <code><a
+href="refC.html#commit">commit</a></code>. A (typically periodic) call to
+<code><a href="refZ.html#zap_">zap_</a></code> will clean them up later.
+
+<pre><code>
+: (setq *Zap '(NIL . "db/app/_zap"))
+-> "db/app/_zap"
+</code></pre>
+
+<dt><a name="zap"><code>(zap 'sym) -> sym</code></a>
+<dd>"Delete" the symbol <code>sym</code>. For internal symbols, that means to
+remove it from the internal index, effectively transforming it to a transient
+symbol. For external symbols, it means to mark it as "deleted", so that upon a
+later <code><a href="refC.html#commit">commit</a></code> it will be removed from
+the database file. See also <code><a href="refI.html#intern">intern</a></code>.
+
+<pre><code>
+: (de foo (Lst) (car Lst))          # 'foo' calls 'car'
+-> foo
+: (zap 'car)                        # Delete the symbol 'car'
+-> "car"
+: (pp 'foo)
+(de foo (Lst)
+   ("car" Lst) )                    # 'car' is now a transient symbol
+-> foo
+: (foo (1 2 3))                     # 'foo' still works
+-> 1
+: (car (1 2 3))                     # Reader returns a new 'car' symbol
+!? (car (1 2 3))
+car -- Undefined
+?
+</code></pre>
+
+<dt><a name="zapTree"><code>(zapTree 'sym)</code></a>
+<dd>Recursively deletes a tree structure from the database. See also <code><a
+href="refT.html#tree">tree</a></code>, <code><a
+href="refC.html#chkTree">chkTree</a></code> and <code><a
+href="refP.html#prune">prune</a></code>.
+
+<pre><code>
+: (zapTree (cdr (root (tree 'nm '+Item))))
+</code></pre>
+
+<dt><a name="zap_"><code>(zap_)</code></a>
+<dd>Delayed deletion (with <code><a href="refZ.html#zap">zap</a></code>) of
+external symbols which were collected e.g. during DB tree processing. An
+auxiliary file (with the name taken from the CDR of the value of <code><a
+href="refZ.html#*Zap">*Zap</a></code>, concatenated with a "<code>_</code>"
+character) is used as an intermediary file.
+
+<pre><code>
+: *Zap
+-> (NIL . "db/app/Z")
+: (call 'ls "-l" "db/app")
+...
+-rw-r--r-- 1 abu abu     1536 2007-06-23 12:34 Z
+-rw-r--r-- 1 abu abu     1280 2007-05-23 12:15 Z_
+...
+: (zap_)
+...
+: (call 'ls "-l" "db/app")
+...
+-rw-r--r-- 1 abu abu     1536 2007-06-23 12:34 Z_
+...
+</code></pre>
+
+<dt><a name="zero"><code>(zero var ..) -> 0</code></a>
+<dd>Stores <code>0</code> in all <code>var</code> arguments. See also <code><a
+href="refO.html#one">one</a></code>, <code><a href="refO.html#on">on</a></code>,
+<code><a href="refO.html#off">off</a></code> and <code><a
+href="refO.html#onOff">onOff</a></code>.
+
+<pre><code>
+: (zero A B)
+-> 0
+: A
+-> 0
+: B
+-> 0
+</code></pre>
+
+</dl>
+
+</body>
+</html>
diff --git a/doc/ref_.html b/doc/ref_.html
@@ -0,0 +1,546 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN" "http://www.w3.org/TR/1998/REC-html40-19980424/loose.dtd">
+<html lang="en">
+<head>
+<meta http-equiv="Content-Type" content="text/html; charset=utf-8">
+<title>Other</title>
+<link rel="stylesheet" href="doc.css" type="text/css">
+</head>
+<body>
+
+<h1>Other</h1>
+
+<dl>
+
+<dt><a name="!"><code>(! . exe) -> any</code></a>
+<dd>Low level breakpoint function: The current execution environment is saved
+and the I/O channels are redirected to the console. Then <code>exe</code> is
+displayed, and a read-eval-print-loop is entered (with <code>!</code> as its
+prompt character), to evaluate expressions and examine the current program
+environment. An empty input line terminates the read-eval-print-loop, the
+environment and I/O channels are restored, and the result of <code>exe</code> is
+returned. <code>!</code> is normally inserted into existing programs with the
+<code><a href="refD.html#debug">debug</a></code> function. See also <code><a
+href="refE.html#e">e</a></code>, <code><a href="ref_.html#^">^</a></code> and
+<code><a href="refD.html#*Dbg">*Dbg</a></code>.
+
+<pre><code>
+: (de foo (N) (and (println 1) (! println N) (println 2)))
+-> foo
+: (foo 7)
+1                 # Executed '(println 1)'
+(println N)       # Entered breakpoint
+! N               # Examine the value of 'N'
+-> 7
+! (e)             # Evaluate '^', i.e. (println N)
+7
+-> 7
+! (e @)           # Evaluate '@' -> the result of '(println 1)'
+-> 1
+!                 # Empty line: continue
+7                 # Executed '(println N)'
+2                 # Executed '(println 2)'
+-> 2
+</code></pre>
+
+<dt><a name="$"><code>($ sym|lst lst . prg) -> any</code></a>
+<dd>Low level trace function: The first argument <code>sym|lst</code> is printed
+to the console with a proper indentation, followed by a colon <code>:</code>. If
+a function is traced, the first argument is the function symbol, else if a
+method is traced, it is a cons pair of message and class. The second argument
+<code>lst</code> should be a list of symbols, identical to the function's
+argument list. The current values of these symbols are printed, followed by a
+newline. Then <code>prg</code> is executed, and its return value printed in a
+similar way (this time with an equals sign <code>=</code> instead of a colon)
+and returned. <code>$</code> is normally inserted into existing programs with
+the <code><a href="refT.html#trace">trace</a></code> function.
+
+<pre><code>
+: (de foo (A B) ($ foo (A B) (* A B)))
+-> foo
+: (foo 3 4)
+ foo : 3 4        # Function entry, arguments 3 and 4
+ foo = 12         # Function exit, return value 12
+-> 12
+</code></pre>
+
+<dt><a name="$dat"><code>($dat 'sym1 ['sym2]) -> dat</code></a>
+<dd>Converts a string <code>sym1</code> in ISO format to a <code><a
+href="refD.html#date">date</a></code>, optionally using a delimiter character
+<code>sym2</code>. See also <code><a href="refD.html#dat$">dat$</a></code>,
+<code><a href="ref_.html#$tim">$tim</a></code>, <code><a
+href="refS.html#strDat">strDat</a></code> and <code><a
+href="refE.html#expDat">expDat</a></code>.
+
+<pre><code>
+: ($dat "20070601")
+-> 733134
+: ($dat "2007-06-01" "-")
+-> 733134
+</code></pre>
+
+<dt><a name="$tim"><code>($tim 'sym) -> tim</code></a>
+<dd>Converts a string to a <code><a href="refT.html#time">time</a></code>. The
+minutes and seconds are optional and default to zero. See also <code><a
+href="refT.html#tim$">tim$</a></code> and <code><a
+href="ref_.html#$dat">$dat</a></code>.
+
+<pre><code>
+: (time ($tim "10:57:56"))
+-> (10 57 56)
+: (time ($tim "10:57"))
+-> (10 57 0)
+: (time ($tim "10"))
+-> (10 0 0)
+</code></pre>
+
+<dt><a name="%"><code>(% 'num ..) -> num</code></a>
+<dd>Returns the remainder from the divisions of successive <code>num</code>
+arguments. The sign of the result is that of the first argument. When one of the
+arguments evaluates to <code>NIL</code>, it is returned immediately. See also
+<code><a href="ref_.html#/">/</a></code> and <code><a
+href="ref_.html#*/">*/</a></code> .
+
+<pre><code>
+: (% 17 5)
+-> 2
+: (% -17 5)  # Sign is that of the first argument
+-> -2
+: (% 5 2)
+-> 1
+: (% 15 10)
+-> 5
+: (% 15 10 2)  # (% 15 10) -> 5, then (% 5 2) -> 1
+-> 1
+</code></pre>
+
+<dt><a name="&"><code>(& 'num ..) -> num</code></a>
+<dd>Returns the bitwise <code>AND</code> of all <code>num</code> arguments. When
+one of the arguments evaluates to <code>NIL</code>, it is returned immediately.
+See also <code><a href="ref_.html#|">|</a></code>, <code><a
+href="refX.html#x|">x|</a></code> and <code><a
+href="refB.html#bit?">bit?</a></code>.
+
+<pre><code>
+: (& 6 3)
+-> 2
+: (& 7 3 1)
+-> 1
+</code></pre>
+
+<dt><a name="*"><code>(* 'num ..) -> num</code></a>
+<dd>Returns the product of all <code>num</code> arguments. When one of the
+arguments evaluates to <code>NIL</code>, it is returned immediately. See also
+<code><a href="ref_.html#/">/</a></code>, <code><a
+href="ref_.html#*/">*/</a></code>, <code><a href="ref_.html#+">+</a></code> and
+<code><a href="ref_.html#-">-</a></code>.
+
+<pre><code>
+: (* 1 2 3)
+-> 6
+: (* 5 3 2 2)
+-> 60
+</code></pre>
+
+<dt><a name="**"><code>(** 'num1 'num2) -> num</code></a>
+<dd>Returns <code>num1</code> to the power of <code>num2</code>.
+
+<pre><code>
+: (** 2 3)
+-> 8
+: (** 100 100)
+-> 10000000000000000000000000000000000000000000000000000000000000000000000000000
+00000000000000000000000000000000000000000000000000000000000000000000000000000000
+00000000000000000000000000000000000000000000
+</code></pre>
+
+<dt><a name="*/"><code>(*/ 'num1 ['num2 ..] 'num3) -> num</code></a>
+<dd>Returns the product of <code>num1</code> and all following <code>num2</code>
+arguments, divided by the <code>num3</code> argument. The result is rounded to
+the nearest integer value. When one of the arguments evaluates to
+<code>NIL</code>, it is returned immediately. Note that <code>*/</code> is
+especially useful for fixed point arithmetic, by multiplying with (or dividing
+by) the scale factor. See also <code><a href="ref_.html#*">*</a></code>,
+<code><a href="ref_.html#/">/</a></code>, <code><a
+href="ref_.html#+">+</a></code> and <code><a href="ref_.html#-">-</a></code>.
+
+<pre><code>
+: (*/ 3 4 2)
+-> 6
+: (*/ 1234 2 10)
+-> 247
+: (*/ 100 6)
+-> 17
+
+: (setq *Scl 2)
+-> 2
+: (format (*/ 3.0 1.5 1.0) *Scl)
+-> "4.50"
+</code></pre>
+
+<dt><a name="+"><code>(+ 'num ..) -> num</code></a>
+<dd>Returns the sum of all <code>num</code> arguments. When one of the arguments
+evaluates to <code>NIL</code>, it is returned immediately. See also <code><a
+href="refI.html#inc">inc</a></code>, <code><a href="ref_.html#-">-</a></code>,
+<code><a href="ref_.html#*">*</a></code>, <code><a
+href="ref_.html#/">/</a></code> and <code><a href="ref_.html#*/">*/</a></code>.
+
+<pre><code>
+: (+ 1 2 3)
+-> 6
+</code></pre>
+
+<dt><a name="-"><code>(- 'num ..) -> num</code></a>
+<dd>Returns the difference of the first <code>num</code> argument and all
+following arguments. If only a single argument is given, it is negated. When one
+of the arguments evaluates to <code>NIL</code>, it is returned immediately. See
+also <code><a href="refD.html#dec">dec</a></code>, <code><a
+href="ref_.html#+">+</a></code>, <code><a href="ref_.html#*">*</a></code>,
+<code><a href="ref_.html#/">/</a></code> and <code><a
+href="ref_.html#*/">*/</a></code>.
+
+<pre><code>
+: (- 7)
+-> -7
+: (- 7 2 1)
+-> 4
+</code></pre>
+
+<dt><a name="->"><code>(-&gt sym [num]) -> any</code></a>
+<dd>Searches for the current value of the pattern variable <code>sym</code> at
+top level (or level <code>num</code>) in the current <a
+href="ref.html#pilog">Pilog</a> environment. See also <code><a
+href="refP.html#prove">prove</a></code> and <code><a
+href="refU.html#unify">unify</a></code>.
+
+<pre><code>
+: (? (append (1 2 3) (4 5 6) @X) (@ println 'X '= (-> @X)))
+X = (1 2 3 4 5 6)
+ @X=(1 2 3 4 5 6)
+-> NIL
+</code></pre>
+
+<dt><a name="/"><code>(/ 'num ..) -> num</code></a>
+<dd>Returns the first <code>num</code> argument successively divided by all
+following arguments. When one of the arguments evaluates to <code>NIL</code>, it
+is returned immediately. See also <code><a href="ref_.html#*">*</a></code>,
+<code><a href="ref_.html#*/">*/</a></code>, <code><a
+href="ref_.html#%">%</a></code>, <code><a href="ref_.html#+">+</a></code> and
+<code><a href="ref_.html#-">-</a></code>.
+
+<pre><code>
+: (/ 12 3)
+-> 4
+: (/ 60 -3 2 2)
+-> -5
+</code></pre>
+
+<dt><a name=":"><code>(: sym|0 [sym1|cnt ..]) -> any</code></a>
+<dd>Fetches a value <code>any</code> from the properties of a symbol, or from a
+list, by applying the <code><a href="refG.html#get">get</a></code> algorithm to
+<code>This</code> and the following arguments. Used typically in methods or
+<code><a href="refW.html#with">with</a></code> bodies. <code>(: ..)</code> is
+equivalent to <code>(; This ..)</code>. See also <code><a
+href="ref_.html#;">;</a></code>, <code><a href="ref_.html#=:">=:</a></code> and
+<code><a href="ref_.html#::">::</a></code>.
+
+<pre><code>
+: (put 'X 'a 1)
+-> 1
+: (with 'X (: a))
+-> 1
+</code></pre>
+
+<dt><a name="::"><code>(:: sym [sym1|cnt .. sym2]) -> lst|sym</code></a>
+<dd>Fetches a property for a property key <code>sym</code> or <code>sym2</code>
+from a symbol. That symbol is <code>This</code> (if no other arguments are
+given), or a symbol found by applying the <code><a
+href="refG.html#get">get</a></code> algorithm to <code>This</code> and the
+following arguments. The property (the cell, not just its value) is returned,
+suitable for direct (destructive) manipulations. Used typically in methods or
+<code><a href="refW.html#with">with</a></code> bodies. See also <code><a
+href="ref_.html#=:">=:</a></code>, <code><a
+href="refP.html#prop">prop</a></code> and <code><a
+href="ref_.html#:">:</a></code>.
+
+<pre><code>
+: (with 'X (=: cnt 0) (inc (:: cnt)) (: cnt))
+-> 1
+</code></pre>
+
+<dt><a name=";"><code>(; 'sym1|lst [sym2|cnt ..]) -> any</code></a>
+<dd>Fetches a value <code>any</code> from the properties of a symbol, or from a
+list, by applying the <code><a href="refG.html#get">get</a></code> algorithm to
+<code>sym1|lst</code> and the following arguments. See also <code><a
+href="ref_.html#:">:</a></code>, <code><a href="ref_.html#=:">=:</a></code> and
+<code><a href="ref_.html#::">::</a></code>.
+
+<pre><code>
+: (put 'A 'a 1)
+-> 1
+: (put 'A 'b 'B)
+-> B
+: (put 'B 'c 7)
+-> 7
+: (; 'A a)
+-> 1
+: (; 'A b c)
+-> 7
+</code></pre>
+
+<dt><a name="<"><code>(< 'any ..) -> flg</code></a>
+<dd>Returns <code>T</code> when all arguments <code>any</code> are in strictly
+increasing order. See also <a href="ref.html#cmp">Comparing</a>.
+
+<pre><code>
+: (< 3 4)
+-> T
+: (< 'a 'b 'c)
+-> T
+: (< 999 'a)
+-> T
+</code></pre>
+
+<dt><a name="<="><code>(<= 'any ..) -> flg</code></a>
+<dd>Returns <code>T</code> when all arguments <code>any</code> are in strictly
+non-decreasing order. See also <a href="ref.html#cmp">Comparing</a>.
+
+<pre><code>
+: (<= 3 3)
+-> T
+: (<= 1 2 3)
+-> T
+: (<= "abc" "abc" "def")
+-> T
+</code></pre>
+
+<dt><a name="<>"><code>(<&gt 'any ..) -> flg</code></a>
+<dd>Returns <code>T</code> when not all <code>any</code> arguments are equal
+(structure equality). <code>(<&gt 'any ..)</code> is equivalent to <code>(not (=
+'any ..))</code>. See also <a href="ref.html#cmp">Comparing</a>.
+
+<pre><code>
+: (<&gt 'a 'b)
+-> T
+: (<&gt 'a 'b 'b)
+-> T
+: (<&gt 'a 'a 'a)
+-> NIL
+</code></pre>
+
+<dt><a name="="><code>(= 'any ..) -> flg</code></a>
+<dd>Returns <code>T</code> when all <code>any</code> arguments are equal
+(structure equality). See also <a href="ref.html#cmp">Comparing</a>.
+
+<pre><code>
+: (= 6 (* 1 2 3))
+-> T
+: (= "a" "a")
+-> T
+: (== "a" "a")
+-> T
+: (= (1 (2) 3) (1 (2) 3))
+-> T
+</code></pre>
+
+<dt><a name="=0"><code>(=0 'any) -> 0 | NIL</code></a>
+<dd>Returns <code>0</code> when <code>any</code> is a number with value zero.
+See also <code><a href="refN.html#n0">n0</a></code>, <code><a
+href="refL.html#lt0">lt0</a></code>, <code><a
+href="refG.html#ge0">ge0</a></code> and <code><a
+href="refG.html#gt0">gt0</a></code>.
+
+<pre><code>
+: (=0 (- 6 3 2 1))
+-> 0
+: (=0 'a)
+-> NIL
+</code></pre>
+
+<dt><a name="=:"><code>(=: sym|0 [sym1|cnt .. sym2|0] 'any)</code></a>
+<dd>Stores a new value <code>any</code> for a property key <code>sym</code> or
+<code>sym2</code> (or in the value cell for zero) in a symbol. That symbol is
+<code>This</code> (if no other arguments are given), or a symbol found by
+applying the <code><a href="refG.html#get">get</a></code> algorithm to
+<code>This</code> and the following arguments. Used typically in methods or
+<code><a href="refW.html#with">with</a></code> bodies. See also <code><a
+href="refP.html#put">put</a></code>, <code><a href="ref_.html#:">:</a></code>
+and <code><a href="ref_.html#::">::</a></code>.
+
+<pre><code>
+: (with 'X (=: a 1) (=: b 2))
+-> 2
+: (get 'X 'a)
+-> 1
+: (get 'X 'b)
+-> 2
+</code></pre>
+
+<dt><a name="=="><code>(== 'any ..) -> flg</code></a>
+<dd>Returns <code>T</code> when all <code>any</code> arguments are the same
+(pointer equality). See also <code><a href="refN.html#n==">n==</a></code> and <a
+href="ref.html#cmp">Comparing</a>.
+
+<pre><code>
+: (== 'a 'a)
+-> T
+: (== 'NIL NIL (val NIL) (car NIL) (cdr NIL))
+-> T
+: (== (1 2 3) (1 2 3))
+-> NIL
+</code></pre>
+
+<dt><a name="===="><code>(==== ['sym ..]) -> NIL</code></a>
+<dd>Close the current transient scope by clearing the transient index. All
+transient symbols become hidden and inaccessible by the reader. Then any
+optional <code>sym</code> arguments are (re-)inserted into the transient index.
+See also <code><a href="refE.html#extern">extern</a></code> and <code><a
+href="refI.html#intern">intern</a></code>.
+
+<pre><code>
+: (setq S "abc")           # Read "abc"
+-> "abc"
+: (== S "abc")             # Read again, get the same symbol
+-> T
+: (====)                   # Close scope
+-> NIL
+: (== S "abc")             # Read again, get another symbol
+-> NIL
+</code></pre>
+
+<dt><a name="=T"><code>(=T 'any) -> flg</code></a>
+<dd>Returns <code>T</code> when <code>any</code> is the symbol <code>T</code>.
+<code>(=T X)</code> is equivalent to <code>(== T X)</code>. See also <a
+href="refN.html#nT">nT</a>.
+
+<pre><code>
+: (=T 0)
+-> NIL
+: (=T "T")
+-> NIL
+: (=T T)
+-> T
+</code></pre>
+
+<dt><a name=">"><code>(> 'any ..) -> flg</code></a>
+<dd>Returns <code>T</code> when all arguments <code>any</code> are in strictly
+decreasing order. See also <a href="ref.html#cmp">Comparing</a>.
+
+<pre><code>
+: (> 4 3)
+-> T
+: (> 'A 999)
+-> T
+</code></pre>
+
+<dt><a name=">="><code>(>= 'any ..) -> flg</code></a>
+<dd>Returns <code>T</code> when all arguments <code>any</code> are in strictly
+non-increasing order. See also <a href="ref.html#cmp">Comparing</a>.
+
+<pre><code>
+: (>= 'A 999)
+-> T
+: (>= 3 2 2 1)
+-> T
+</code></pre>
+
+<dt><a name=">>"><code>(>> 'cnt 'num) -> num</code></a>
+<dd>Shifts right the <code>num</code> argument by <code>cnt</code>
+bit-positions. If <code>cnt</code> is negative, a corresponding left shift is
+performed.
+
+<pre><code>
+: (>> 1 8)
+-> 4
+: (>> 3 16)
+-> 2
+: (>> -3 16)
+-> 128
+: (>> -1 -16)
+-> -32
+</code></pre>
+
+<dt><a name="?"><code>(? [sym ..] [pat 'any ..] . lst) -> flg</code></a>
+<dd>Top-level function for interactive <a href="ref.html#pilog">Pilog</a>
+queries. <code>?</code> is a non-evaluating front-end to the <code><a
+href="refQ.html#query">query</a></code> function. It displays each result, waits
+for console input, and terminates when a non-empty line is entered. If a
+preceding list of (non-pattern-) symbols is given, they will be taken as rules
+to be traced by <code><a href="refP.html#prove">prove</a></code>. The list of
+variable/value pairs is passed to <code><a href="refG.html#goal">goal</a></code>
+for an initial Pilog environment. See also <code><a
+href="refP.html#pilog">pilog</a></code> and <code><a
+href="refS.html#solve">solve</a></code>.
+
+<pre><code>
+: (? (append (a b c) (d e f) @X))
+ @X=(a b c d e f)
+-> NIL
+
+: (? (append @X @Y (a b c)))
+ @X=NIL @Y=(a b c)
+ @X=(a) @Y=(b c)
+ @X=(a b) @Y=(c)
+ @X=(a b c) @Y=NIL
+-> NIL
+
+: (? (append @X @Y (a b c)))
+ @X=NIL @Y=(a b c).                    # Stopped
+-> NIL
+
+: (? append (append @X @Y (a b c)))    # Trace 'append'
+1 (append NIL (a b c) (a b c))
+ @X=NIL @Y=(a b c)                                  
+2 (append (a . @X) @Y (a b c))
+1 (append NIL (b c) (b c))
+ @X=(a) @Y=(b c).                      # Stopped                       
+-> NIL
+</code></pre>
+
+<dt><a name="@"><code>@</code></a>
+<dd>Holds the result of the last top level expression in the current
+read-eval-print loop, or the result of the conditional expression during the
+evaluation of flow functions (see <code><a href="ref.html#atres">@
+Result</a></code>). When <code>@</code> is used as a formal parameter in <a
+href="ref.html#lambda">lambda expressions</a>, it denotes a variable number of
+evaluated arguments.
+
+<dt><a name="@@"><code>@@</code></a>
+<dd>Holds the result of the second last top level expression in the current
+read-eval-print loop (see <code><a href="ref.html#atres">@ Result</a></code>).
+
+<dt><a name="@@@"><code>@@@</code></a>
+<dd>Holds the result of the third last top level expression in the current
+read-eval-print loop (see <code><a href="ref.html#atres">@ Result</a></code>).
+
+<dt><a name="^"><code>^</code></a>
+<dd>Holds the currently executed expression during a breakpoint or an error. See
+also <code><a href="refD.html#debug">debug</a></code>, <code><a
+href="ref_.html#!">!</a></code>, <code><a href="refE.html#e">e</a></code> and
+<code><a href="refD.html#*Dbg">*Dbg</a></code>.
+
+<pre><code>
+: (* (+ 3 4) (/ 7 0))
+!? (/ 7 0)
+Div/0
+? ^
+-> (/ 7 0)
+</code></pre>
+
+<dt><a name="|"><code>(| 'num ..) -> num</code></a>
+<dd>Returns the bitwise <code>OR</code> of all <code>num</code> arguments. When
+one of the arguments evaluates to <code>NIL</code>, it is returned immediately.
+See also <code><a href="refX.html#x|">x|</a></code>, <code><a
+href="ref_.html#&">&</a></code> and <code><a
+href="refB.html#bit?">bit?</a></code>.
+
+<pre><code>
+: (| 1 2)
+-> 3
+: (| 1 2 4 8)
+-> 15
+</code></pre>
+
+</dl>
+
+</body>
+</html>
diff --git a/doc/rlook.html b/doc/rlook.html
@@ -0,0 +1,67 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN"
+        "http://www.w3.org/TR/html4/loose.dtd">
+<html>
+<head>
+	<meta http-equiv="content-type" content="text/html; charset=utf-8">
+	<title>PicoLisp RefLook</title>
+	<meta name="generator" content="BBEdit 8.6">
+	<style type="text/css">
+	<!--
+body {
+	margin-left: 0.5em;
+	margin-right: 0;
+	background-color: #eee;
+}
+ul {
+	margin-left: 0;
+	padding-left: 1.1em;
+}
+li {
+	margin-bottom: 0.4em;
+}
+ul.sub {
+	padding-left: 0.5em;
+	font-size: 75%;
+}
+ul.sub li {
+	margin-bottom: 0.3em;
+}
+input {
+	margin-top: 0.3em;
+}
+	-->
+	</style>
+	<script type="text/javascript" language="javascript">
+	<!--
+function searchKeyup(searchField) {
+	try {
+		var sWord = searchField.value;
+		if (sWord) {
+			var sUrl;
+			if (sWord == "NIL") {
+				sUrl = "ref.html#nilSym";
+			} else if (sWord.match(/^[a-zA-Z_]/)) {
+				sUrl = "ref" + sWord.substring(0, 1).toUpperCase() + ".html#" + sWord;
+			} else if (sWord.match(/^\*[a-zA-Z_]/)) {
+				sUrl = "ref" + sWord.substring(1, 2) + ".html#" + sWord;
+			} else {
+				sUrl = "ref_.html#" + sWord;
+			}
+			window.top.lower.location = sUrl;
+		}
+	} catch (e) {
+		alert(e);
+	}
+}
+	//-->
+	</script>
+</head>
+<body>
+	<ul>
+		<li>
+			<a href="ref.html" target="lower">Reference</a> lookup<br>
+			<input type="text" size="13" onkeyup="searchKeyup(this)">
+		</li>
+	</ul>
+</body>
+</html>
diff --git a/doc/select.html b/doc/select.html
@@ -0,0 +1,490 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN" "http://www.w3.org/TR/REC-html40/loose.dtd">
+<html lang="en">
+<head>
+<meta http-equiv="Content-Type" content="text/html; charset=utf-8">
+<title>The 'select' Predicate</title>
+<link rel="stylesheet" href="doc.css" type="text/css">
+</head>
+<body>
+<a href="mailto:abu@software-lab.de">abu@software-lab.de</a>
+
+<h1>The 'select' Predicate</h1>
+
+<p align=right>(c) Software Lab. Alexander Burger
+
+<p>The <a href="ref.html#pilog">Pilog</a> <a
+href="refS.html#select/3">select/3</a> predicate is rather complex, and quite
+different from other predicates. This document tries to explain it in detail,
+and shows some typical use cases.
+
+<p><ul>
+<li><a href="#syntax">Syntax</a>
+<li><a href="#example1">First Example</a>
+<li><a href="#univar">Unification Variables</a>
+<li><a href="#gencl">Generator Clauses</a>
+   <ul>
+   <li><a href="#db">B-Tree Stepping</a>
+   <li><a href="#interaction">Interaction of Generator Clauses</a>
+   <li><a href="#combined">Combined Indexes</a>
+   <li><a href="#associations">Indirect Object Associations</a>
+   <li><a href="#nested">Nested Pilog Queries</a>
+   </ul>
+<li><a href="#filcl">Filter Clauses</a>
+   <ul>
+   <li><a href="#little">A Little Report</a>
+   <li><a href="#filpr">Filter Predicates</a>
+   </ul>
+</ul>
+
+
+<p><hr>
+<h2><a name="syntax">Syntax</a></h2>
+
+<p><code>select</code> takes at least three arguments:
+
+<p><ul>
+<li>A list of unification variables,
+<li>a list of generator clauses
+<li>and an arbitrary number of filter clauses
+</ul>
+
+<p>We will describe these arguments in the following, but demonstrate them first
+on a concrete example.
+
+
+<p><hr>
+<h2><a name="example1">First Example</a></h2>
+
+<p>The examples in this document will use the demo application in "app/*.l" (see
+also "<a href="app.html#minApp">A Minimal Complete Application</a>"). To get an
+interactive prompt, simply start it as
+
+<pre><code>
+$ ./dbg app/main.l -main
+:
+</code></pre>
+
+<p>As ever, you can terminate the interpreter by hitting ENTER.
+
+<p>For a first, typical example, let's write a complete call to <a
+href="refS.html#solve">solve</a> that returns a list of articles with numbers
+between 1 and 4, which contain "Part" in their description, and have a price
+less than 100:
+
+<pre><code>
+(let (Nr (1 . 4)  Nm <u>Part</u>  Pr '(NIL . 100.00))
+   (solve
+      (quote
+         @Nr Nr
+         @Nm Nm
+         @Pr Pr
+         (select (@Item)
+            ((nr +Item @Nr) (nm +Item @Nm) (pr +Item @Pr))
+               (range @Nr @Item nr)
+               (part @Nm @Item nm)
+               (range @Pr @Item pr) ) )
+      @Item ) )
+</code></pre>
+
+<p>This expression will return, with the default database setup of "app/init.l",
+a list of exactly one item <code>({3-2})</code>, the item with the number 2.
+
+<p>The <code><a href="refL.html#let">let</a></code> statement assigns values to
+the search parameters for number <code>Nr</code>, description <code>Nm</code>
+and price <code>Pr</code>. The Pilog query (the first argument to
+<code>solve</code>) passes these values to the Pilog variables <code>@Nr</code>,
+<code>@Nm</code> and <code>@Pr</code>. Ranges of values are always specified by
+cons pairs, so <code>(1 . 4)</code> includes the numbers 1 through 4, while
+<code>(NIL . 100.00)</code> includes prices from minus infinite up to one
+hundred.
+
+<p>The list of unification variables is
+
+<pre><code>
+   <code>(@Item)</code>
+</code></pre>
+
+<p>The list of generator clauses is
+
+<pre><code>
+      ((nr +Item @Nr) (nm +Item @Nm) (pr +Item @Pr))
+</code></pre>
+
+<p>The filter clauses are
+
+<pre><code>
+         (range @Nr @Item nr)
+         (part @Nm @Item nm)
+         (range @Pr @Item pr)
+</code></pre>
+
+
+<p><hr>
+<h2><a name="univar">Unification Variables</a></h2>
+
+<p>As stated above, the first argument to <code>select</code> should be a list
+of variables. These variables communicate values (via <code><a
+href="refU.html#unify">unify</a></code>) from the <code>select</code>
+environment to the enclosing Pilog environment.
+
+<p>The first variable in this list (<code>@Item</code> in the above example) is
+mandatory, it takes the direct return value of <code>select</code>. Additional
+optional variables may be unified by clauses in the body of <code>select</code>,
+and return further values.
+
+
+<p><hr>
+<h2><a name="gencl">Generator Clauses</a></h2>
+
+<p>The second argument to <code>select</code> is a list of "generator clauses".
+Each of these clauses specifies some kind of database B-Tree <code><a
+href="refI.html#+index">+index</a></code>, to be traversed by
+<code>select</code>, step by step, where each step returns a suitable single
+database object. In the simplest case, they consist like here just of a relation
+name (e.g. <code>nr</code>), a class (e.g. <code>+Item</code>), an optional hook
+specifier (not in this example), and a pattern (values or ranges, e.g. (1 . 4)
+or "Part").
+
+<p>The generator clauses are the core of 'select'. In some way, they behave
+analog to <code><a href="refO.html#or/2">or/2</a></code>, as each of them
+generates a sequence of values. However, the generator clauses behave different,
+as they will not generate an exhaustive set of values upon backtracking, one
+after the other, where the next gets its turn when the previous one is
+exhausted. Instead, all clauses will generate their values quasi-parallel, with
+a built-in optimization so that successful clauses will be called with a higher
+probability. "Successful" means that the returned values successfully pass
+<code>select</code>'s filter clauses.
+
+
+<p><hr>
+<h3><a name="db">B-Tree Stepping</a></h3>
+
+<p>In its basic form, a generator clause is equivalent to the <code><a
+href="refD.html#db/3">db/3</a></code> predicate, stepping through a single
+B-Tree. The clause
+
+<pre><code>
+(nr +Item @Nr)
+</code></pre>
+
+<p>generates the same values as would be produced by a stand-alone Pilog clause
+
+<pre><code>
+(db nr +Item @Nr @Item)
+</code></pre>
+
+<p>as can be seen in the following two calls:
+
+<pre><code>
+: (? (db nr +Item (1 . 4) @Item))
+ @Item={3-1}
+ @Item={3-2}
+ @Item={3-3}
+ @Item={3-4}
+-> NIL
+: (? (select (@Item) ((nr +Item (1 . 4)))))
+ @Item={3-1}
+ @Item={3-2}
+ @Item={3-3}
+ @Item={3-4}
+-> NIL
+</code></pre>
+
+
+<p><hr>
+<h3><a name="interaction">Interaction of Generator Clauses</a></h3>
+
+<p><code>select</code> is mostly useful if more than one generator clause is
+involved. The tree search parameters of all clauses are meant to form a logical
+<code>AND</code>. Only those objects should be returned, for which all search
+parameters (and the associated filter clauses) are valid. As soon as one of the
+clauses finishes stepping through its database (sub)tree, the whole call to
+<code>select</code> will terminate, because further values returned from other
+generator clauses cannot be part of the result set.
+
+<p>Therefore, <code>select</code> would find all results most quickly if it
+could simply call only the generator clause with the smallest (sub)tree.
+Unfortunately, this is usually not known in advance. It depends on the
+distribution of the data in the database, and on the search parameters to each
+generator clause.
+
+<p>Instead, <code>select</code> single-steps each generator clause in turn, in a
+round-robin scheme, applies the filter clauses to each generated object, and
+re-arranges the order of generator clauses so that the more successful clauses
+will be preferred. This process usually converges quickly and efficiently.
+
+
+<p><hr>
+<h3><a name="combined">Combined Indexes</a></h3>
+
+<p>A generator clause can also combine several (similar) indexes into a single
+one. Then the clause is written actually as a list of clauses.
+
+<p>For example, a generator clause to search for a customer by phone number is
+
+<pre><code>
+(tel +CuSu @Tel)
+</code></pre>
+
+If we want to search for a customer without knowing whether a given number is a
+normal or a mobile phone number, then a combined generator clause searching both
+index trees could look like
+
+<pre><code>
+((tel +CuSu @Tel  mob +CuSu @Tel))
+</code></pre>
+
+<p>The generator will first traverse all matching entries in the <code><a
+href="refR.html#+Ref">+Ref</a></code> tree of the <code>tel</code> relation, and
+then, when these are exhausted, all matching entries in the <code>mob</code>
+index tree.
+
+
+<p><hr>
+<h3><a name="associations">Indirect Object Associations</a></h3>
+
+<p>But generator clauses are not limited to the direct B-Tree interaction of
+<code><a href="refD.html#db/3">db/3</a></code>. They can also traverse trees of
+associated objects, and then follow <code><a
+href="refL.html#+Link">+Link</a></code> / <code><a
+href="refJ.html#+Joint">+Joint</a></code> relations, or tree relations like
+<code><a href="refR.html#+Ref">+Ref</a></code> to arrive at database objects
+with a type suitable for return values from <code>select</code>.
+
+<p>To locate appropriate objects from associated objects, the generator clause
+can contain - in addition to the standard relation/class/pattern specification
+(see <a href="#gencl">Generator Clauses</a> above) - an arbitrary number of
+association specifiers. Each association specifier can be
+
+<ol>
+<li>A symbol. Then a <code><a href="refL.html#+Link">+Link</a></code> or
+<code><a href="refJ.html#+Joint">+Joint</a></code> will be followed, or a
+<code><a href="refL.html#+List">+List</a></code> of those will be traversed to
+locate appropriate objects.
+
+<li>A list. Then this list should hold a relation and a class (and an optional
+hook) which specify some B-Tree <code><a
+href="refI.html#+index">+index</a></code> to be traversed to locate appropriate
+objects.
+
+</ol>
+
+In this way, a single generator clause can cause the traversal of a tree of
+object relations to generate the desired sequence of objects.
+
+An example can be found in "app/gui.l", in the 'choOrd' function which
+implements the search dialog for <code>+Ord</code> (order) objects. Orders can
+be searched for order number and date, customer name and city, item description
+and supplier name:
+
+<pre><code>
+(select (@@)
+   ((nr +Ord @Nr) (dat +Ord @Dat)
+      (nm +CuSu @Cus (cus +Ord))
+      (ort +CuSu @Ort (cus +Ord))
+      (nm +Item @Item (itm +Pos) ord)
+      (nm +CuSu @Sup (sup +Item) (itm +Pos) ord) )
+</code></pre>
+
+<p>While <code>(nr +Ord @Nr)</code> and <code>(dat +Ord @Dat)</code> are direct
+index traversals, <code>(nm +CuSu @Cus (cus +Ord))</code> iterates the
+<code>nm</code> (name) index of customers/suppliers <code>+CuSu</code>, and then
+follows the <code><a href="refR.html#+Ref">+Ref</a></code> <code><a
+href="refL.html#+Link">+Link</a></code> of the <code>cus</code> relation to the
+orders. The same applies to the search for city names via <code>ort</code>.
+
+<p>The most complex example is <code>(nm +CuSu @Sup (sup +Item) (itm +Pos)
+ord)</code>, where the supplier name is searched in the <code>nm</code> tree of
+<code>+CuSu</code>, then the <code><a href="refR.html#+Ref">+Ref</a></code> tree
+<code>(sup +Item)</code> tree is followed to locate items of that supplier, then
+all positions for those items are found using <code>(itm +Pos)</code>, and
+finally the <code>ord</code> <code><a href="refJ.html#+Joint">+Joint</a></code>
+is followed to arrive at the order object(s).
+
+
+<p><hr>
+<h3><a name="nested">Nested Pilog Queries</a></h3>
+
+<p>In the most general case, a generator clause can be an arbitrary Pilog query.
+Often this is a query to a database on a remote machine, using the <code><a
+href="refR.html#remote/2">remote/2</a></code> predicate, or some other resource
+not accessible via database indexes, like iterating a <code><a
+href="refL.html#+List">+List</a></code> of <code><a
+href="refL.html#+Link">+Link</a></code>s or <code><a
+href="refJ.html#+Joint">+Joint</a></code>s.
+
+<p>Syntactically, such a generator clause is recognized by the fact that its CAR
+is a Pilog variable to denote the return value.
+
+<p>The second argument is a list of Pilog variables to communicate values (via
+<code><a href="refU.html#unify">unify</a></code>) from the surrounding
+<code>select</code> environment.
+
+<p>The third argument is the actual list of clauses for the nested query.
+
+<p>Finally, an arbitrary number of association specifiers may follow, as
+described in the <a href="#associations">Indirect Object Associations</a>
+section.
+
+<p>We can illustrate this with a somewhat useless (but simple) example, which
+replaces the standard generators for item number and supplier name
+
+<pre><code>
+(select (@Item)
+   (
+      (nr +Item @Nr)
+      (nm +CuSu @Sup (sup +Item))
+   )
+   ...
+</code></pre>
+
+<p>with the equivalent form
+
+<pre><code>
+(select (@Item)
+   (
+      (@A (@Nr) ((db nr +Item @Nr @A)))
+      (@B (@Sup) ((db nm +CuSu @Sup @B)) (sup +Item))
+   )
+</code></pre>
+
+<p>That is, a query with the <code><a href="refD.html#db/3">db/3</a></code> tree
+iteration predicate is used to generate appropriate values.
+
+
+<p><hr>
+<h2><a name="filcl">Filter Clauses</a></h2>
+
+<p>The generator clauses produce - independent from each other - lots of
+objects, which match the patterns of individual generator clauses, but not
+necessarily the desired result set of the total <code>select</code> call.
+Therefore, the filter clauses are needed to retain the good, and throw away the
+bad objects. In addition, they give feedback to the generator for optimizing its
+traversal priorities (as described in <a href="#gencl">Generator Clauses</a>).
+
+<p><code>select</code> then collects all objects which passed through the
+filters into a unique list, to avoid duplicates which would otherwise appear,
+because most objects can be found by more than one generator clause.
+
+<p>Technically, the filters are normal Pilog clauses, which just happen to be
+evaluated in the context of <code>select</code>. Arbitrary Pilog predicates can
+be used, though there exist some predicates (e.g. <code><a
+href="refI.html#isa/2">isa/2</a></code>, <code><a
+href="refS.html#same/3">same/3</a></code>, <code><a
+href="refB.html#bool/3">bool/3</a></code>, <code><a
+href="refR.html#range/3">range/3</a></code>, <code><a
+href="refH.html#head/3">head/3</a></code>, <code><a
+href="refF.html#fold/3">fold/3</a></code>, <code><a
+href="refP.html#part/3">part/3</a></code> or <code><a
+href="refT.html#tolr/3">tolr/3</a></code>) especially suited for that task.
+
+
+<p><hr>
+<h3><a name="little">A Little Report</a></h3>
+
+<p>Assume we want to know how many pieces of item #2 were sold in the year 2007.
+Then we must find all <code>+Pos</code> (position) objects referring to that
+item and at the same time belonging to orders of the year 2007 (see the class
+definition for <code>+Pos</code> in "app/er.l"). The number of sold pieces is
+then in the <code>cnt</code> property of the <code>+Pos</code> objects.
+
+<p>As shown in the complete <code>select</code> below, we will hold the item
+number in the variable <code>@Nr</code> and the date range for the year in
+<code>@Year</code>.
+
+<p>Now, all positions referred by item #2 can be found by the generator clause
+
+<pre><code>
+(nr +Item @Nr (itm +Pos))
+</code></pre>
+
+<p>and all positions sold in 2007 can be found by
+
+<pre><code>
+(dat +Ord @Year pos)
+</code></pre>
+
+<p>However, the combination of both generator clauses
+
+<pre><code>
+(select (@Pos)
+   ((nr +Item @Nr (itm +Pos)) (dat +Ord @Year pos)) )
+</code></pre>
+
+<p>will probably generate too many results, namely all positions with item #3
+<u>OR</u> from the year 2007. Thus, we need two filter clauses. With them, the
+full search expression will be:
+
+<pre><code>
+(?
+   @Nr 2                                                 # Item number
+   @Year (cons (date 2007 1 1) (date 2007 12 31))        # Date range 2007
+   (select (@Pos)
+      ((nr +Item @Nr (itm +Pos)) (dat +Ord @Year pos))   # Generator clauses
+      (same @Nr @Pos itm nr)                             # Filter item number
+      (range @Year @Pos ord dat) ) )                     # Filter order date
+</code></pre>
+
+<p>For completeness, let's calculate the total count of sold items:
+
+<pre><code>
+(let Cnt 0     # Counter variable
+   (pilog
+      (quote
+         @Nr 2
+         @Year (cons (date 2007 1 1) (date 2007 12 31))
+         (select (@Pos)
+            ((nr +Item @Nr (itm +Pos)) (dat +Ord @Year pos))
+            (same @Nr @Pos itm nr)
+            (range @Year @Pos ord dat) ) )
+      (inc 'Cnt (get @Pos 'cnt)) )  # Increment total count
+   Cnt )  # Return count
+</code></pre>
+
+
+<p><hr>
+<h3><a name="filpr">Filter Predicates</a></h3>
+
+<p>As mentioned under <a href="#filcl">Filter Clauses</a>, some predicates
+exists mainly for <code>select</code> filtering.
+
+<p>Some of these predicates are of general use: <code><a
+href="refI.html#isa/2">isa/2</a></code> can be used to check for a type,
+<code><a href="refS.html#same/3">same/3</a></code> checks for a definite vaue,
+<code><a href="refB.html#bool/3">bool/3</a></code> looks if the value is
+non-<code>NIL</code>. These predicates are rather independent of the <code><a
+href="refR.html#+relation">+relation</a></code> type.
+
+<p><code><a href="refR.html#range/3">range/3</a></code> checks whether a value
+is within a given range. This could be used with any <code><a
+href="refR.html#+relation">+relation</a></code> type, but typically it will be
+used for numeric (<code><a href="refN.html#+Number">+Number</a></code>) or time
+( <code><a href="refD.html#+Date">+Date</a></code> and <code><a
+href="refT.html#+Time">+Time</a></code>) relations.
+
+<p>Other predicates make only sense in the context of a certain <code><a
+href="refR.html#+relation">+relation</a></code> type:
+
+<ul>
+<li><code><a href="refH.html#head/3">head/3</a></code> is mainly intended for
+<code>(<a href="refK.html#+Key">+Key</a> <a
+href="refS.html#+String">+String</a>)</code> or <code>(<a
+href="refR.html#+Ref">+Ref</a> <a href="refS.html#+String">+String</a>)</code>
+relations,
+
+<li><code><a href="refF.html#fold/3">fold/3</a></code> is useful for <code>(<a
+href="refF.html#+Fold">+Fold</a> <a href="refR.html#+Ref">+Ref</a> <a
+href="refS.html#+String">+String</a>)</code> relations,
+
+<li><code><a href="refP.html#part/3">part/3</a></code> for <code>(<a
+href="refF.html#+Fold">+Fold</a> <a href="refI.html#+Idx">+Idx</a> <a
+href="refS.html#+String">+String</a>)</code> relations, and
+
+<li><code><a href="refT.html#tolr/3">tolr/3</a></code> for <code>(<a
+href="refS.html#+Sn">+Sn</a> <a href="refI.html#+Idx">+Idx</a> <a
+href="refS.html#+String">+String</a>)</code> relations.
+
+</ul>
+
+</body>
+</html>
diff --git a/doc/shape.l b/doc/shape.l
@@ -0,0 +1,59 @@
+# 25jun07abu
+# (c) Software Lab. Alexander Burger
+
+# The Shape base class
+(class +Shape)
+# x y
+
+(dm T (X Y)
+   (=: x X)
+   (=: y Y) )
+
+(dm move> (DX DY)
+   (inc (:: x) DX)
+   (inc (:: y) DY) )
+
+
+# The Rectangle class
+(class +Rectangle +Shape)
+# dx dy
+
+(dm T (X Y DX DY)
+   (super X Y)
+   (=: dx DX)
+   (=: dy DY) )
+
+(dm area> ()
+   (* (: dx) (: dy)) )
+
+(dm perimeter> ()
+   (* 2 (+ (: dx) (: dy))) )
+
+(dm draw> ()
+   (drawRect (: x) (: y) (: dx) (: dy)) ) # Hypothetical function 'drawRect'
+
+
+# The Circle class
+(class +Circle +Shape)
+# r
+
+(dm T (X Y R)
+   (super X Y)
+   (=: r R) )
+
+(dm area> ()
+   (*/ (: r) (: r) 31415927 10000000) )
+
+(dm perimeter> ()
+   (*/ 2 (: r) 31415927 10000000) )
+
+(dm draw> ()
+   (drawCircle (: x) (: y) (: r)) )       # Hypothetical function 'drawCircle'
+
+
+# The Fixed prefix class
+(class +Fixed)
+
+(dm move> (DX DY))  # A do-nothing method
+
+# vi:et:ts=3:sw=3
diff --git a/doc/structures b/doc/structures
@@ -0,0 +1,90 @@
+
+         Primary data types:
+
+      xxxxxxxxxxxxxxxxxxxxxxxxxxxxx010 Number
+      xxxxxxxxxxxxxxxxxxxxxxxxxxxxx100 Symbol
+      xxxxxxxxxxxxxxxxxxxxxxxxxxxxx000 Cell
+
+
+         Number
+         |
+         V
+      +-----+-----+     +-----+-----+     +-----+-----+
+      |'DIG'|  ---+---> |'DIG'|  ---+---> |'DIG'|  /  |
+      +-----+-----+     +-----+-----+     +-----+-----+
+
+
+      Cell
+      |
+      V
+      +-----+-----+
+      | CAR | CDR |
+      +-----+-----+
+
+
+            Symbol
+            |
+            V
+      +-----+-----+
+      |  |  | VAL |
+      +--+--+-----+
+         | tail
+         |
+         V                                                      name
+         +-----+-----+     +-----+-----+     +-----+-----+     +-----+-----+
+         |  |  |  ---+---> | KEY |  ---+---> |  |  |  ---+---> |'cba'|  /  |
+         +--+--+-----+     +-----+-----+     +--+--+-----+     +-----+-----+
+            |                                   |
+            V                                   V
+            +-----+-----+                       +-----+-----+
+            | VAL | KEY |                       | VAL | KEY |
+            +-----+-----+                       +-----+-----+
+
+
+      NIL:  /
+            |
+            V
+      +-----+-----+-----+-----+
+      |  /  |  /  |  /  |  /  |
+      +-----+--+--+-----+-----+
+
+
+
+         External Symbols:
+
+                  +-------------+-+-------------+-+----+
+      Block 0:    |   Free       0|   Next       0| << |
+                  +-------------+-+-------------+-+----+
+                  0               BLK                  2*Blk+1
+
+
+                  +-------------+-+
+      Free:       |   Link       0|
+                  +-------------+-+
+                  0
+
+
+                  +-------------+-+----
+      ID-Block:   |   Link       1| Data
+                  +-------------+-+----
+                  0              BLK
+
+
+                  +-------------+-+----
+      EXT-Block:  |   Link       n| Data
+                  +-------------+-+----
+                  0              BLK
+
+
+
+      Assumptions:
+
+   - 8 bits per byte
+   - word: sizeof(void*) == sizeof(unsigned long)
+   - word2: sizeof(unsigned long long) == 2 * sizeof(unsigned long)
+   - gcc
+      Functions aligned to 4-byte boundaries
+      Zero- or variable-length arrays
+      Conditionals with Omitted Operands
+      Unused argument attributes
+      Noreturn attributes
diff --git a/doc/toc.html b/doc/toc.html
@@ -0,0 +1,41 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN"
+        "http://www.w3.org/TR/html4/loose.dtd">
+<html>
+<head>
+	<meta http-equiv="content-type" content="text/html; charset=utf-8">
+	<title>PicoLisp Doc TOC</title>
+	<meta name="generator" content="BBEdit 8.6">
+	<style type="text/css">
+	<!--
+body {
+	margin-left: 0.5em;
+	margin-right: 0;
+	background-color: #eee;
+}
+ul {
+	margin-left: 0;
+	padding-left: 1.1em;
+}
+li {
+	margin-bottom: 0.4em;
+}
+ul.sub {
+	padding-left: 0.5em;
+	font-size: 75%;
+}
+ul.sub li {
+	margin-bottom: 0.3em;
+}
+	-->
+	</style>
+</head>
+<body>
+	<h3>PicoLisp Docs</h3>
+	<ul id="upperul">
+		<li><a href="ref.html#fun" target="upper">Function Ref.</a></li>
+		<li><a href="tut.html" target="upper">Tutorial</a></li>
+		<li><a href="app.html" target="upper">Application Dev.</a></li>
+		<li><a href="faq.html" target="upper">FAQ</a></li>
+	</ul>
+</body>
+</html>
diff --git a/doc/travel b/doc/travel
@@ -0,0 +1,24 @@
+
+   Rheine                 Osnabrueck
+      O-----------42----------O-----------------48-------------+
+      |                       |                                |
+      |39            +--------+                                |
+      |              |        |43                              |
+      |     +---51---+        |                                |
+      |     |                 | Warendorf      Guetersloh      |
+      O-----+-----28--------+-O-+--------27--------O-----16----O Bielefeld
+      | Muenster            | | |                  |           |
+      |                     | | |                  +-----+     |
+      |                  +--+ | +--+               |     |     |
+      |                  |    |    |    Rheda      |     |     |
+      |                27|    |27  +-24---O---10---+     |     |
+      |46            +---+    |           |              |31   |
+      |              |        |        +--+-----+        |     |39
+      |              |        | Beckum |  |     |        |     |
+      +--------------O---11---O-----24-+  |     |32      |     |
+               Ahlen |        |           |     |        |     |
+                     |      26|           |     +--------+-----+
+                     |        +-----38----+                    |
+                     |        |                                |
+                     +---27---O---------------41---------------+
+                            Soest                           Paderborn
diff --git a/doc/tut.html b/doc/tut.html
@@ -0,0 +1,2402 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN" "http://www.w3.org/TR/1998/REC-html40-19980424/loose.dtd">
+<html lang="en">
+<head>
+<meta http-equiv="Content-Type" content="text/html; charset=utf-8">
+<title>PicoLisp Tutorial</title>
+<link rel="stylesheet" href="doc.css" type="text/css">
+</head>
+<body>
+<a href="mailto:abu@software-lab.de">abu@software-lab.de</a>
+
+<h1>A PicoLisp Tutorial</h1>
+
+<p align=right>(c) Software Lab. Alexander Burger
+
+<p>This document demonstrates some aspects of the PicoLisp system in detail and
+example. For a general description of the PicoLisp kernel please look at the <a
+href="ref.html">PicoLisp Reference</a>.
+
+<p>This is <i>not</i> a Lisp tutorial, as it assumes some working knowledge of
+Lisp (and programming in general). It concentrates on the specialties of
+PicoLisp, and its differences to other Lisp dialects.
+
+<p>If not stated otherwise, all examples assume that PicoLisp was started in the
+installation directory from the shell prompt as
+
+<pre><code>
+$ ./dbg
+:
+</code></pre>
+
+<p>It loads the PicoLisp base system and the debugging environment, and waits
+for you to enter input lines at the interpreter prompt (<code>:</code>). You can
+terminate the interpreter and return to the shell at any time, by either hitting
+the ENTER key (i.e. by entering an empty line), or by executing the function
+<code><a href="refB.html#bye">(bye)</a></code>.
+
+<p>It is very helpful - though not absolutely necessary - when you know how to
+use the <code>vi</code> editor.
+
+<p>We notice that some people try to use Emacs - or some other IDE - as a
+front-end to the PicoLisp console. This is not recommended, because the PicoLisp
+debugging environment will set the console (tty) to raw mode by itself and do
+some special handling during character input.
+
+<p>If you feel that you absolutely have to use an input front-end, please remove
+the entry "@lib/led.l" from "dbg.l". Note that in this case, however, you will
+not have the TAB symbol completion feature available during command line
+editing.
+
+<p>We recommend that you have a terminal window open, and try the examples by
+yourself. You may either type them in, directly to the PicoLisp interpreter, or
+edit a separate source file (e.g. <code>"test.l"</code>) in a second terminal
+window and load it into PicoLisp with
+
+<pre><code>
+: (load "test.l")
+</code></pre>
+
+<p>each time you have modified and saved it.
+
+<p>Once a function is loaded from a source file, you can call 'vim' directly on
+that function with
+
+<pre><code>
+: (vi 'foo)
+</code></pre>
+
+<p>The function 'vi' opens the appropriate source file, and jumps to the right
+line where 'foo' is defined. When you modify it, you can simply call 'ld' to
+(re)load that source file
+
+<pre><code>
+: (ld)
+</code></pre>
+
+<p>If you are new to PicoLisp, you might want to read the following sections in
+the given order, as some of them assume knowledge about previous ones. Otherwise
+just jump anywhere you are interested in.
+
+<p><ul>
+<li><a href="#ledit">Command Line Editing</a>
+<li><a href="#brw">Browsing</a>
+<li><a href="#fun">Defining Functions</a>
+<li><a href="#dbg">Debugging</a>
+<li><a href="#funio">Functional I/O</a>
+<li><a href="#script">Scripting</a>
+<li><a href="#oop">Objects and Classes</a>
+<li><a href="#ext">Persistence (External Symbols)</a>
+<li><a href="#db">Database Programming</a>
+<li><a href="#gui">User Interface (GUI) Programming</a>
+<li><a href="#pilog">Pilog -- PicoLisp Prolog</a>
+<li><a href="#sql">Poor Man's SQL</a>
+<li><a href="#ref">References</a>
+</ul>
+
+
+<p><hr>
+<h2><a name="ledit">Command Line Editing</a></h2>
+
+<p>PicoLisp permanently reads input from the current input channel (i.e. the
+console in interactive mode), evaluates it, and prints the result to the current
+output channel. This is called a "read-eval-print-loop" (REPL).
+
+<p>To alleviate the task of manual line input, a command line editor is provided
+which is similar to (though much simpler than) the <code>readline</code> feature
+of the <code>bash</code> shell. Only a subset of the <code>vi</code> mode is
+supported, which is restricted to single-key commands (the "real"
+<code>vi</code> supports multi-key commands and the modification of most
+commands with count prefixes). It is loaded at startup via "dbg.l", you find its
+source in "lib/led.l".
+
+<p>You can enter lines in the normal way, correcting mistypes with the BACKSPACE
+key, and terminating them with the ENTER key. This is the <i>Insert Mode</i>.
+
+<p>If you hit ESC, you get into <i>Command Mode</i>. Now you can navigate
+horizontally in the current input line, or vertically in the history of
+previously entered lines, with key commands borrowed from the <code>vi</code>
+editor. Note, however, that there is always only a single line visible.
+
+<p>Let's say you did some calculation
+
+<pre><code>
+: (* (+ 2 3) (- 7 2))
+-> 25
+:
+</code></pre>
+
+<p>If you want to repeat a modified version of this command, using
+<code>8</code> instead of <code>7</code>, you don't have to re-type the
+whole command, but type
+
+<p><ul>
+<li>ESC to get into <i>Command Mode</i>
+<li><code>k</code> to get one line "up"
+<li><code>f</code> and <code>7</code> to "find" the character <code>7</code>
+<li><code>r</code> and <code>8</code> to "replace" with <code>8</code>
+</ul>
+
+<p>Then you hit ENTER to execute the modified line. Instead of jumping to the
+<code>7</code> with the "find" command, you may also type <code>l</code> (move
+"right") repeatedly till you reach the correct position.
+
+<p>The key commands in the <i>Command Mode</i> are listed below. Some commands
+change the mode back to <i>Insert Mode</i> as indicated in parentheses. Commands
+which operate on a "word" take either the current atom (number or symbol), or a
+whole expression when the cursor is at a left parenthesis.
+
+<p><ul>
+<li><code>k</code> - Go up one line
+<li><code>j</code> - Go down one line
+<li><code>l</code> - Go right one character
+<li><code>h</code> - Go left one character
+<li><code>w</code> - Go right one word
+<li><code>b</code> - Go back (left) one word
+<li><code>0</code> - Go to the beginning of the line
+<li><code>$</code> - Go to the end of the line
+<li><code>i</code> - Enter <i>Insert Mode</i> at the cursor position
+<li><code>a</code> - Append (<i>Insert Mode</i>) after the cursor position
+<li><code>A</code> - Append (<i>Insert Mode</i>) at the end of the line
+<li><code>I</code> - Insert (<i>Insert Mode</i>) at the beginning of the line
+<li><code>x</code> - Delete the character at the cursor position
+<li><code>X</code> - Delete the character left of the cursor position
+<li><code>r</code> - Replace the character at the cursor position with the next key
+<li><code>s</code> - Substitute the character at the cursor position (<i>Insert Mode</i>)
+<li><code>S</code> - Substitute the whole line (<i>Insert Mode</i>)
+<li><code>d</code> - Delete the word at the cursor position (<i>Insert Mode</i>)
+<li><code>D</code> - Delete the rest of the line
+<li><code>c</code> - Change the word at the cursor position (<i>Insert Mode</i>)
+<li><code>C</code> - Change the rest of the line (<i>Insert Mode</i>)
+<li><code>f</code> - Find next key in the rest of the current line
+<li><code>p</code> - Paste data deleted with <code>x</code>, <code>X</code>, <code>d</code> or <code>D</code> after the cursor position
+<li><code>P</code> - Paste data deleted with <code>x</code>, <code>X</code>, <code>d</code> or <code>D</code> before the cursor position
+<li><code>/</code> - Accept an input pattern and search the history for it
+<li><code>n</code> - Search for next occurrence of pattern (as entered with <code>/</code>)
+<li><code>N</code> - Search for previous occurrence of pattern
+<li><code>%</code> - Go to matching parenthesis
+<li><code>~</code> - Convert character to opposite (lower or upper) case and move right
+<li><code>u</code> - Undo the last change (one level only)
+<li><code>U</code> - Undo all changes of the current line
+<li><code>g</code> - Display current contents of cut buffer (not in <code>vi</code>)
+</ul>
+
+<p>Notes:
+<ul>
+
+<li>The <code>d</code> command corresponds to the <code>dw</code> command of the
+<code>vi</code> editor, and <code>c</code> corresponds to <code>cw</code>.
+
+<li>Search patterns may contain "<code>@</code>" characters as wildcards.
+
+<li>Lines shorter than 3 characters, lines beginning with a space character, or
+duplicate lines are not entered into the history.
+
+<li>The history is stored in a file named ".picoHistory" in the PicoLisp home
+directory. The length of the history is limited to 1000 lines.
+
+</ul>
+
+<p>The following two key-combinations work both in Insert and Command Mode:
+
+<p><ul>
+
+<li><code>Ctrl-D</code> will immediately terminate the current process, and also
+all of its sister processes (i.e. children of the same parent process, typically
+an application server during debugging).
+
+<li><code>Ctrl-X</code> discards all input, abandons further processing, and
+returns to the interpreter's top level (equivalent to invoking <code><a
+href="refQ.html#quit">quit</a></code>). This is also useful when the program
+stopped at a breakpoint, or after program execution was interrupted with
+<code>Ctrl-C</code>.
+
+</ul>
+
+<p>Besides these two keys, in <i>Insert Mode</i> only the following keys have a
+special meaning:
+
+<p><ul>
+
+<li>BACKSPACE (<code>Ctrl-H</code>) and DEL erase the character to the left
+
+<li><code>Ctrl-V</code> inserts the next key literally
+
+<li>TAB performs symbol and/or path completion: When a symbol (or path) name is
+entered partially and TAB is pressed subsequently, all internal symbols (and/or
+path names in the file system) matching the partial input are shown in sequence.
+
+<li>ESC terminates <i>Input Mode</i> and enters <i>Command Mode</i>
+
+</ul>
+
+<p>Please take some time to experiment and to get used to command line editing.
+It will make life much easier in the future :-)
+
+
+<p><hr>
+<h2><a name="brw">Browsing</a></h2>
+
+<p>PicoLisp provides some functionality for inspecting pieces of data and code
+within the running system.
+
+<p>Most commonly used is probably the <code><a
+href="refS.html#show">show</a></code> function. It takes a symbolic argument,
+and shows the symbol's name (if any), followed by its value cell, and then the
+contents of the property list on the following lines.
+
+<pre><code>
+: (setq A '(This is the value))  # Set the value cell of 'A'
+-> (This is the value)
+: (put 'A 'key1 'val1)           # Store property 'key1'
+-> val1
+: (put 'A 'key2 'val2)           # and 'key2'
+-> val2
+: (show 'A)                      # Now 'show' the symbol 'A'
+A (This is the value)
+   key2 val2
+   key1 val1
+-> A
+</code></pre>
+
+<p><code>show</code> accepts an arbitrary number of arguments which are
+processed according to the rules of <code><a
+href="refG.html#get">get</a></code>, resulting in a symbol which is showed then.
+
+<pre><code>
+: (put 'B 'a 'A)        # Put 'A' under the 'a'-property of 'B'
+-> A
+: (setq Lst '(A B C))   # Create a list with 'B' as second argument
+-> (A B C)
+: (show Lst 2 'a)       # Show the property 'a of the 2nd element of 'Lst'
+A (This is the value)   # (which is 'A' again)
+   key2 val2
+   key1 val1
+-> A
+</code></pre>
+
+<p>Similar to <code>show</code> is <code><a
+href="refE.html#edit">edit</a></code>. It takes an arbitrary number of symbolic
+arguments, writes them to a temporary file in a format similar to
+<code>show</code>, and starts the <code>vim</code> editor with that file.
+
+<pre><code>
+: (edit 'A 'B)
+</code></pre>
+
+<p>The <code>vim</code> window will look like
+
+<pre><code>
+A (This is the value)
+key1 val1
+key2 val2
+
+(********)
+
+B NIL
+a A  # (This is the value)
+
+(********)
+</code></pre>
+
+<p>Now you can modify values or properties. You should not touch the
+parenthesized asterisks, as they serve as delimiters. If you position the cursor
+on the first character of a symbol name and type '<code>K</code>' ("Keyword
+lookup"), the editor will be restarted with that symbol added to the editor
+window. '<code>Q</code>' (for "Quit") will bring you back to the previous view.
+
+<p><code>edit</code> is also very useful to browse in a database. You can follow
+the links between objects with '<code>K</code>', and even - e.g. for low-level
+repairs - modify the data (but only if you are really sure about what you are
+doing, and don't forget to <code><a href="refC.html#commit">commit</a></code>
+when you are done).
+
+<p><code><a href="refM.html#more">more</a></code> is a simple tool that displays
+the elements of a list one by one. It stops after each element and waits for
+input. If you just hit ENTER, <code>more</code> continues with the next element,
+otherwise (usually I type a dot (<code>.</code>) followed by ENTER) it
+terminates.
+
+<pre><code>
+: (more (1 2 3 4 5 6))
+1                          # Hit ENTER
+2.                         # Hit '.' and ENTER
+-> T                       # stopped
+</code></pre>
+
+<p>Optionally <code>more</code> takes a function as a second argument and
+applies that function to each element (instead of the default <code><a
+href="refP.html#print">print</a></code>). Here, often <code>show</code> or
+<code>pp</code> (see below) is used.
+
+<pre><code>
+: (more '(A B))            # Step through 'A' and 'B'
+A
+B
+-> NIL
+: (more '(A B) show)       # Step through 'A' and 'B' with 'show'
+A (This is the value)      # showing 'A'
+   key2 val2
+   key1 val1
+                           # Hit ENTER
+B NIL                      # showing 'B'
+   a A
+-> NIL
+</code></pre>
+
+<p>The <i>pretty-print</i> function <code><a href="refP.html#pp">pp</a></code>
+takes a symbol that has a function defined (or two symbols that specify message
+and class for a method definition), and displays that definition in a formatted
+and indented way.
+
+<pre><code>
+: (pp 'pretty)
+(de pretty (X N . @)
+   (setq N (abs (space (or N 0))))
+   (while (args)
+      (printsp (next)) )
+   (if (or (atom X) (>= 12 (size X)))
+      (print X)
+      (while (== 'quote (car X))
+         (prin "'")
+         (pop 'X) )
+      (let Z X
+         (prin "(")
+         (when (memq (print (pop 'X)) "*PP")
+            (cond
+               ((memq (car Z) "*PP1")
+                  (if (and (pair (car X)) (pair (cdar X)))
+                     (when (>= 12 (size (car X)))
+                        (space)
+                        (print (pop 'X)) )
+                     (space)
+                     (print (pop 'X))
+                     (when (or (atom (car X)) (>= 12 (size (car X))))
+                        (space)
+                        (print (pop 'X)) ) ) )
+               ((memq (car Z) "*PP2")
+                  (inc 'N 3)
+                  (loop
+                     (prinl)
+                     (pretty (cadr X) N (car X))
+                     (NIL (setq X (cddr X)) (space)) ) )
+               ((or (atom (car X)) (>= 12 (size (car X))))
+                  (space)
+                  (print (pop 'X)) ) ) )
+         (when X
+            (loop
+               (T (== Z X) (prin " ."))
+               (T (atom X) (prin " . ") (print X))
+               (prinl)
+               (pretty (pop 'X) (+ 3 N))
+               (NIL X) )
+            (space) )
+         (prin ")") ) ) )
+-> pretty
+</code></pre>
+
+<p>The style is the same as we use in source files:
+
+<ul>
+
+<li>The indentation level is three spaces
+
+<li>If a list is too long (to be precise: if its <code><a
+href="refS.html#size">size</a></code> is greater than 12), pretty-print the CAR
+on the current line, and each element of the CDR recursively on its own line.
+
+<li>A closing parenthesis a preceded by a space if the corresponding open
+parenthesis is not on the same line
+
+</ul>
+
+<p>The <code><a href="refW.html#what">what</a></code> function returns a list of
+all internal symbols in the system which match a given pattern (with
+'<code>@</code>' wildcard characters).
+
+<pre><code>
+: (what "prin@")
+-> (prin print prinl print> printsp println)
+</code></pre>
+
+<p>The function <code><a href="refW.html#who">who</a></code> returns <i>"who
+contains that"</i>, i.e. a list of symbols that contain a given argument
+somewhere in their value or property list.
+
+<pre><code>
+: (who 'print)
+-> ((print> . +relation) query show select pretty "edit" msg rules pp more
+(print> . +Date)) </code></pre>
+
+<p>A dotted pair indicates either a method definition or a property entry. So
+<code>(print> . +relation)</code> denotes the <code>print&gt;</code> method of
+the <code><a href="refR.html#+relation">+relation</a></code> class.
+
+<p><code>who</code> can be conveniently combined with <code>more</code> and
+<code>pp</code>:
+
+<pre><code>
+: (more (who 'print) pp)
+(dm (print> . +relation) (Val)   # Pretty-print these functions one by one
+   (print Val) )
+
+(de query ("Q" "Dbg")
+   ...
+</code></pre>
+
+<p>The argument to <code>who</code> may also be a pattern list (see <code><a
+href="refM.html#match">match</a></code>):
+
+<pre><code>
+: (who '(print @ (val @)))
+-> (show)
+
+: (more (who '(% @ 7)) pp)
+(de day (Dat Lst)
+   (get
+      (or Lst *DayFmt)
+      (inc (% (inc Dat) 7)) ) )
+
+(de _week (Dat)
+   (/ (- Dat (% (inc Dat) 7)) 7) )
+</code></pre>
+
+<p>The function <code><a href="refC.html#can">can</a></code> returns a list
+which indicates which classes <i>can</i> accept a given message. Again, this
+list is suitable for iteration with <code>pp</code>:
+
+<pre><code>
+: (can 'del>)                                   # Which classes accept 'del>' ?
+-> ((del> . +relation) (del> . +Entity) (del> . +List))
+: (more (can 'del>) pp)                         # Inspect the methods with 'pp'
+(dm (del> . +relation) (Obj Old Val)
+   (and (&lt;> Old Val) Val) )
+
+(dm (del> . +Entity) (Var Val)
+   (when
+      (and
+         Val
+         (has> (meta This Var) Val (get This Var)) )
+      (let Old (get This Var)
+         (rel>
+            (meta This Var)
+            This
+            Old
+            (put This Var (del> (meta This Var) This Old @)) )
+         (upd> This Var Old) ) ) )
+
+(dm (del> . +List) (Obj Old Val)
+   (and (&lt;> Old Val) (delete Val Old)) )
+</code></pre>
+
+<p><code><a href="refD.html#dep">dep</a></code> shows the dependencies in a
+class hierarchy. That is, for a given class it displays the tree of its
+(super)class(es) above it, and the tree of its subclasses below it.
+
+<p>To view the complete hierarchy of input fields, we start with the root class
+<code><a href="refR.html#+relation">+relation</a></code>:
+
+<pre><code>
+: (dep '+relation)
++relation
+   +Number
+      +Time
+      +Date
+   +Symbol
+      +String
+   +Blob
+   +Link
+      +Joint
+   +Bool
+   +Any
+   +Bag
+-> +relation
+</code></pre>
+
+<p>If we are interested in <code>+Link</code>:
+
+<pre><code>
+: (dep '+Link)
+   +relation
++Link
+   +Joint
+-> +Link
+</code></pre>
+
+<p>This says that <code>+Link</code> is a subclass of <code><a
+href="refR.html#+relation">+relation</a></code>, and has a single subclass
+(<code>+Joint</code>).
+
+
+<p><hr>
+<h2><a name="fun">Defining Functions</a></h2>
+
+<p>Most of the time during programming is spent defining functions (or methods).
+In the following we will concentrate on functions, but most will be true for
+methods as well except for using <code>dm</code> instead of <code>de</code>.
+
+<p>The notorious "Hello world" function must be defined:
+
+<pre><code>
+: (de hello ()
+   (prinl "Hello world") )
+-> hello
+</code></pre>
+
+<p>The <code>()</code> in the first line indicates a function without arguments.
+The body of the function is in the second line, consisting of a single
+statement. The last line is the return value of <code>de</code>. From now on we
+will omit the return values of examples when they are unimportant.
+
+<p>You'll know that you can call this function as
+
+<pre><code>
+: (hello)
+Hello world
+</code></pre>
+
+<p>A function with an argument might look this way:
+
+<pre><code>
+: (de hello (X)
+   (prinl "Hello " X) )
+# hello redefined
+</code></pre>
+
+<p>PicoLisp informs you that you have just redefined the function. This might be
+a useful warning in case you forgot that a bound symbol with that name already
+existed.
+
+<pre><code>
+: (hello "world")
+Hello world
+</code></pre>
+
+<pre><code>
+: (hello "Alex")
+Hello Alex
+</code></pre>
+
+<p>Normally, PicoLisp evaluates the arguments before it passes them to a
+function:
+
+<pre><code>
+: (hello (+ 1 2 3))
+Hello 6
+</code></pre>
+
+<pre><code>
+: (setq A 1  B 2)       # Set 'A' to 1 and 'B' to 2
+-> 2
+: (de foo (X Y)         # 'foo' returns the list of its arguments
+   (list X Y) )
+-> foo
+: (foo A B)             # Now call 'foo' with 'A' and 'B'
+-> (1 2)                # -> We get a list of 1 and 2, the values of 'A' and 'B'
+</code></pre>
+
+<p>In some cases you don't want that. For some functions (<code><a
+href="refS.html#setq">setq</a></code> for example) it is better if the function
+gets all arguments unevaluated, and can decide for itself what to do with them.
+
+<p>For such cases you do not define the function with a <i>list</i> of
+parameters, but give it a <i>single atomic</i> parameter instead. PicoLisp will
+then bind all (unevaluated) arguments as a list to that parameter.
+
+<pre><code>
+: (de foo X
+   (list (car X) (cadr X)) )        # 'foo' lists the first two arguments
+
+: (foo A B)                         # Now call it again
+-> (A B)                            # -> We don't get '(1 2)', but '(A B)'
+
+: (de foo X
+   (list (car X) (eval (cadr X))) ) # Now evaluate only the second argument
+
+: (foo A B)
+-> (A 2)                            # -> We get '(A 2)'
+</code></pre>
+
+<p>As a logical consequence, you can combine these principles. To define a
+function with 2 evaluated and an arbitrary number of unevaluated arguments:
+
+<pre><code>
+: (de foo (X Y . Z)     # Evaluate only the first two args
+   (list X Y Z) )
+
+: (foo A B C D E)
+-> (1 2 (C D E))        # -> Get the value of 'A' and 'B' and the remaining list
+</code></pre>
+
+<p>More common, in fact, is the case where you want to pass an arbitrary number
+of <i>evaluated</i> arguments to a function. For that, PicoLisp recognizes the
+symbol <code>@</code> as a single atomic parameter and remembers all evaluated
+arguments in an internal frame. This frame can then be accessed sequentially
+with the <code><a href="refA.html#args">args</a></code>, <code><a
+href="refN.html#next">next</a></code>, <code><a
+href="refA.html#arg">arg</a></code> and <code><a
+href="refR.html#rest">rest</a></code> functions.
+
+<pre><code>
+: (de foo @
+   (list (next) (next)) )     # Get the first two arguments
+
+: (foo A B)
+-> (1 2)
+</code></pre>
+
+<p>Again, this can be combined:
+
+<pre><code>
+: (de foo (X Y . @)
+   (list X Y (next) (next)) ) # 'X' and 'Y' are fixed arguments
+
+: (foo A B (+ 3 4) (* 3 4))
+-> (1 2 7 12)                 # All arguments are evaluated
+</code></pre>
+
+<p>These examples are not very useful, because the advantage of a variable
+number of arguments is not used. A function that prints all its evaluated
+numeric arguments, each on a line followed by its squared value:
+
+<pre><code>
+: (de foo @
+   (while (args)
+      (println (next) (* (arg) (arg))) ) )
+
+: (foo (+ 2 3) (- 7 1) 1234 (* 9 9))
+5 25
+6 36
+1234 1522756
+81 6561
+-> 6561
+</code></pre>
+
+<p>Finally, it is possible to pass all these evaluated argument to another
+function, using <code><a href="refP.html#pass">pass</a></code>:
+
+<pre><code>
+: (de foo @
+   (pass println 9 8 7)       # First print all arguments preceded by 9, 8, 7
+   (pass + 9 8 7) )           # Then add all these values
+
+: (foo (+ 2 3) (- 7 1) 1234 (* 9 9))
+9 8 7 5 6 1234 81             # Printing ...
+-> 1350                       # Return the result
+</code></pre>
+
+
+<p><hr>
+<h2><a name="dbg">Debugging</a></h2>
+
+<p>There are two major ways to debug functions (and methods) at runtime:
+<i>Tracing</i> and <i>single-stepping</i>.
+
+<p><i>Tracing</i> means letting functions of interest print their name and arguments
+when they are entered, and their name again and the return value when they are
+exited.
+
+<p>For demonstration, let's define the unavoidable factorial function (or just
+<code><a href="refL.html#load">load</a></code> the file "<code><a
+href="fun.l">doc/fun.l</a></code>"):
+
+<pre><code>
+(de fact (N)
+   (if (=0 N)
+      1
+      (* N (fact (- N 1))) ) )
+</code></pre>
+
+<p>With <code><a href="refT.html#trace">trace</a></code> we can put it in trace
+mode:
+
+<pre><code>
+: (trace 'fact)
+-> fact
+</code></pre>
+
+<p>Calling <code>fact</code> now will display its execution trace.
+
+<pre><code>
+: (fact 3)
+ fact : 3
+  fact : 2
+   fact : 1
+    fact : 0
+    fact = 1
+   fact = 1
+  fact = 2
+ fact = 6
+-> 6
+</code></pre>
+
+<p>As can be seen here, each level of function call will indent by an additional
+space. Upon function entry, the name is separated from the arguments with a
+colon (<code>:</code>), and upon function exit with an equals sign
+(<code>=</code>) from the return value.
+
+<p>Trace works by modifying the function body, so generally only for functions
+defined as lists (lambda expressions, see <a href="ref.html#ev">Evaluation</a>).
+Tracing a C-function is possible, however, when it is a function that evaluates
+all its arguments.
+
+<p>So let's trace the functions <code><a href="ref_.html#=0">=0</a></code> and
+<code><a href="ref_.html#*">*</a></code>:
+
+<pre><code>
+: (trace '=0)
+-> =0
+: (trace '*)
+-> *
+</code></pre>
+
+<p>If we call <code>fact</code> again, we see the additional output:
+
+<pre><code>
+: (fact 3)
+ fact : 3
+  =0 : 3
+  =0 = NIL
+  fact : 2
+   =0 : 2
+   =0 = NIL
+   fact : 1
+    =0 : 1
+    =0 = NIL
+    fact : 0
+     =0 : 0
+     =0 = 0
+    fact = 1
+    * : 1 1
+    * = 1
+   fact = 1
+   * : 2 1
+   * = 2
+  fact = 2
+  * : 3 2
+  * = 6
+ fact = 6
+-> 6
+</code></pre>
+
+<p>To reset a function to its untraced state, call <code><a
+href="refU.html#untrace">untrace</a></code>
+
+<pre><code>
+: (untrace 'fact)
+-> fact
+: (untrace '=0)
+-> =0
+: (untrace '*)
+-> *
+</code></pre>
+
+<p>or simply
+
+<pre><code>
+: (mapc untrace '(fact =0 *))
+-> *
+</code></pre>
+
+<p><i>Single-stepping</i> means to execute a function step by step, giving the
+programmer an opportunity to look more closely at what is happening. The
+function <code><a href="refD.html#debug">debug</a></code> inserts a breakpoint
+into each top-level expression of a function. When the function is called, it
+stops at each breakpoint, displays the expression it is about to execute next
+(this expression is also stored into the global variable <code><a
+href="ref_.html#^">^</a></code>) and enters a read-eval-loop. The programmer can
+then
+
+<ul>
+
+<li>inspect the current environment by typing variable names or calling
+functions
+
+<li>execute <code>(<a href="refD.html#d">d</a>)</code> to recursively debug the
+next expression
+
+<li>execute <code>(<a href="refE.html#e">e</a>)</code> to evaluate the next
+expression, to see what will happen without actually advancing on
+
+<li>type ENTER (: enter an empty line) to leave the read-eval loop and continue
+with the next expression
+
+</ul>
+
+<p>Thus, in the simplest case, single-stepping consists of just hitting ENTER
+repeatedly to step through the function.
+
+<p>To try it out, let's look at the <code><a
+href="refS.html#stamp">stamp</a></code> system function.
+
+<pre><code>
+: (pp 'stamp)
+(de stamp (Dat Tim)
+   (default  Dat (date)  Tim (time T))
+   (pack (dat$ Dat "-") " " (tim$ Tim T)) )
+-> stamp
+</code></pre>
+
+<pre><code>
+: (debug 'stamp)                       # Debug it
+-> T
+: (stamp)                              # Call it again
+(default Dat (date) Tim (time T))      # stopped at first expression
+!                                      # ENTER
+(pack (dat$ Dat "-") " " (tim$ ...     # second expression
+! Tim                                  # inspect 'Tim' variable
+-> 41908
+! (time Tim)                           # convert it
+-> (11 38 28)
+!                                      # ENTER
+-> "2004-10-29 11:38:28"               # done, as there are only 2 expressions
+</code></pre>
+
+<p>Now we execute it again, but this time we want to look at what's happening
+inside the second expression.
+
+<pre><code>
+: (stamp)                              # Call it again
+(default Dat (date) Tim (time T))
+!                                      # ENTER
+(pack (dat$ Dat "-") " " (tim$ ...     # here we want to look closer
+! (d)                                  # debug this expression
+-> T
+!                                      # ENTER
+(dat$ Dat "-")                         # stopped at first subexpression
+! (e)                                  # evaluate it
+-> "2004-10-29"
+!                                      # ENTER
+(tim$ Tim T)                           # stopped at second subexpression
+! (e)                                  # evaluate it
+-> "11:40:44"
+!                                      # ENTER
+-> "2004-10-29 11:40:44"               # done
+</code></pre>
+
+<p>The breakpoints still remain in the function body. We can see them when we
+pretty-print it:
+
+<pre><code>
+: (pp 'stamp)
+(de stamp (Dat Tim)
+   (! default Dat (date) Tim (time T))
+   (! pack
+      (! dat$ Dat "-")
+      " "
+      (! tim$ Tim T) ) )
+-> stamp
+</code></pre>
+
+<p>To reset the function to its normal state, call
+
+<pre><code>
+: (unbug 'stamp)
+</code></pre>
+
+<p>Often, you will not want to single-step a whole function. Just use
+<code>edit</code> (see above) to insert a single breakpoint (the exclamation
+mark followed by a space) as CAR of an expression, and run your program.
+Execution will then stop there as described above; you can inspect the
+environment and continue execution with ENTER when you are done.
+
+
+<p><hr>
+<h2><a name="funio">Functional I/O</a></h2>
+
+<p>Input and output in PicoLisp is functional, in the sense that there are not
+variables assigned to file descriptors, which need then to be passed to I/O
+functions for reading, writing and closing. Instead, these functions operate on
+implicit input and output channels, which are created and maintained as dynamic
+environments.
+
+<p>Standard input and standard output are the default channels. Try reading a
+single expression:
+
+<pre><code>
+: (read)
+(a b c)        # Console input
+-> (a b c)
+</code></pre>
+
+<p>To read from a file, we redirect the input with <code><a
+href="refI.html#in">in</a></code>. Note that comments and white space are
+automatically skipped by <code>read</code>:
+
+<pre><code>
+: (in "doc/fun.l" (read))
+-> (de fact (N) (if (=0 N) 1 (* N (fact (- N 1)))))
+</code></pre>
+
+<p>The <code><a href="refS.html#skip">skip</a></code> function can also be used
+directly. To get the first non-white character in the file with <code><a
+href="refC.html#char">char</a></code>:
+
+<pre><code>
+: (in "doc/fun.l" (skip "#") (char))
+-> "("
+</code></pre>
+
+<p><code><a href="refF.html#from">from</a></code> searches through the input
+stream for given patterns. Typically, this is not done with Lisp source files
+(there are better ways), but for a simple example let's extract all items
+immediately following <code>fact</code> in the file,
+
+<pre><code>
+: (in "doc/fun.l" (make (while (from "fact ") (link (read)))))
+-> ((N) (- N 1))
+</code></pre>
+
+<p>or the word following "(de " with <code><a
+href="refT.html#till">till</a></code>:
+
+<pre><code>
+: (in "doc/fun.l" (from "(de ") (till " " T)))
+-> "fact"
+</code></pre>
+
+
+<p>With <code><a href="refL.html#line">line</a></code>, a line of characters is
+read, either into a single transient symbol,
+
+<pre><code>
+: (in "doc/tut.html" (line T))
+-> "&lt;!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN" "http://..."
+</code></pre>
+
+<p>or into a list of symbols (characters):
+
+<pre><code>
+: (in "doc/tut.html" (line))
+-> ("&lt;" "!" "D" "O" "C" "T" "Y" "P" "E" " " "H" "T" "M" "L" ...
+</code></pre>
+
+<p><code>line</code> is typically used to read tabular data from a file.
+Additional arguments can split the line into fixed-width fields, as described in
+the <code><a href="refL.html#line">reference manual</a></code>. If, however, the
+data are of variable width, delimited by some special character, the <code><a
+href="refS.html#split">split</a></code> function can be used to extract the
+fields. A typical way to import the contents of such a file is:
+
+<pre><code>
+(load "lib/import.l")
+
+(in '("bin/utf2" "importFile.txt")              # Pipe: Convert to UTF-8
+   (until (eof)                                 # Process whole file
+      (let L (split (line) "^I")                # TAB-delimited data
+         ... use 'getStr', 'getNum' etc ...     # process them
+</code></pre>
+
+<p>Some more examples:
+
+<pre><code>
+(in "a"                                         # Copy the first 40 Bytes
+   (out "b"                                     # from file "a" to file "b"
+      (echo 40) ) )
+
+(in "doc/tut.html"                              # Show the HTTP-header
+   (line)
+   (echo "&lt;body>") )
+
+(out "file.mac"                                 # Convert to Macintosh
+   (in "file.txt"                               # from Unix or DOS format:
+      (while (char)
+         (prin
+            (case @
+               ("^M" NIL)                       # ignore CR
+               ("^J" "^M")                      # convert CR to LF
+               (T @) ) ) ) ) )                  # otherwise no change
+
+(out "c"                                        # Merge the contents of "a"
+   (in "b"                                      # and "b" into "c"
+      (in "a"
+         (while (read)                          # Read an item from "a",
+            (println @ (in -1 (read))) ) ) ) )  # print it with an item from "b"
+</code></pre>
+
+
+<p><hr>
+<h2><a name="script">Scripting</a></h2>
+
+<p>There are two possibilities to get the PicoLisp interpreter into doing useful
+work: Via command line arguments, or as a stand-alone script.
+
+<p>The command line can specify either files for execution, or arbitrary Lisp
+expressions for direct evaluation (see <code><a
+href="ref.html#invoc">Invocation</a></code>): If an argument starts with a
+hyphen, it is evaluated, otherwise <code><a
+href="refL.html#load">load</a></code>ed as a file. A typical invocation might
+look like:
+
+<pre><code>
+$ ./dbg app/file1.l -main app/file2.l
+</code></pre>
+
+<p>It loads the debugging environment, an application source file, calls the
+main function, and then loads another application source. In a typical
+development and debugging session, this line is often modified using the shell's
+history mechanisms, e.g. by inserting debugging statements:
+
+<pre><code>
+$ ./dbg app/file1.l -"trace 'foo" -main -"debug 'bar" app/file2.l
+</code></pre>
+
+<p>Another convenience during debugging and testing is to put things into the
+command line (shell history) which would otherwise have to be done each time in
+the application's user interface:
+
+<pre><code>
+$ ./dbg app/file1.l -main app/file2.l -go -'login "name" "password"'
+</code></pre>
+
+<p>The final production release of an application usually includes a shell
+script, which initializes the environment, does some bookkeeping and cleanup,
+and calls the application with a proper command line. It is no problem if the
+command line is long and complicated.
+
+<p>For small utility programs, however, this is overkill. It is better to write
+a single executable file using the mechanisms of "interpreter files": If the
+first two characters in an executable file are "<code>#!</code>", the operating
+system kernel will pass this file to an interpreter program whose pathname is
+given in the first line (optionally followed by a single argument). This is fast
+and efficient, because the overhead of a subshell is avoided.
+
+<p>Let's assume you installed PicoLisp in the directory "/home/foo/picolisp/",
+and put links to the executable and the installation directory as:
+
+<pre><code>
+$ ln -s /home/foo/picolisp /usr/lib/picolisp
+$ ln -s /usr/lib/picolisp/bin/picolisp /usr/bin/picolisp
+</code></pre>
+
+Then a simple hello-world script might look like:
+
+<pre><code>
+#!/usr/bin/picolisp /usr/lib/picolisp/lib.l
+(prinl "Hello world!")
+(bye)
+</code></pre>
+
+<p>If you write this into a text file, and use <code>chmod</code> to set it to
+"executable", it can be executed like any other command. Note that - because
+<code>#</code> is the comment character in PicoLisp - the first line will not be
+interpreted, and you can still use that file as a normal command line argument
+to PicoLisp (useful during debugging).
+
+<p>The fact that a hyphen causes evaluation of command line arguments can be
+used to simulate something like command line options. The following script
+defines two functions <code>a</code> and <code>f</code>, and then calls
+<code>(<a href="refL.html#load">load</a> T)</code> to process the rest of the
+command line (which otherwise would be ignored because of the <code>(<a
+href="refB.html#bye">bye</a>)</code> statement):
+
+<pre><code>
+#!/usr/bin/picolisp /usr/lib/picolisp/lib.l
+
+(de a ()
+   (println '-a '-> (opt)) )
+
+(de f ()
+   (println '-f '-> (opt)) )
+
+(load T)
+(bye)
+</code></pre>
+
+(<code><a href="refO.html#opt">opt</a></code> retrieves the next command line
+option)
+
+<p>Calling this script (let's say we named it "testOpts") gives:
+
+<pre><code>
+$ ./testOpts -f abc
+-f -> "abc"
+$ ./testOpts -a xxx  -f yyy
+-a -> "xxx"
+-f -> "yyy"
+</code></pre>
+
+<p>We have to be aware of the fact, however, that the aggregation of arguments
+like
+
+<pre><code>
+$ ./testOpts -axxx  -fyyy
+</code></pre>
+
+<p>or
+
+<pre><code>
+$ ./testOpts -af yyy
+</code></pre>
+
+<p>cannot be achieved with this simple and general mechanism of command line
+processing.
+
+<p>Utilities are typically used outside the context of the PicoLisp environment.
+All examples above assumed that the current working directory is the PicoLisp
+installation directory, which is usually all right for applications developed in
+that environment. Command line file arguments like "dbg.l" or "app/file1.l" will
+be properly found.
+
+<p>To allow utilities to run in arbitrary places on the host file system, the
+concept of <i>home directory substitution</i> was introduced. The interpreter
+remembers internally at start-up the pathname of its first argument (usually
+"lib.l"), and substitutes any leading "<code>@</code>" character in subsequent
+file names with that pathname. Thus, to run the above example in some other
+place, simply write:
+
+<pre><code>
+$ /home/foo/picolisp/dbg @app/file1.l -main @app/file2.l
+</code></pre>
+
+<p>that is, supply a full path name to the initial command (here 'p'), or put it
+into your <code>PATH</code> variable, and prefix each file which has to be
+loaded from the PicoLisp home directory with a <code>@</code> character.
+"Normal" files (not prefixed by <code>@</code>) will be opened or created
+relative to the current working directory as usual.
+
+<p>Stand-alone scripts will often want to load additional modules from the
+PicoLisp environment, beyond the "lib.l" we provided in the first line of the
+hello-world script. Typically, at least a call to
+
+<pre><code>
+(load "@lib/misc.l")
+</code></pre>
+
+<p>(note the home directory substitution) will be included near the beginning of
+the script.
+
+<p>As a more complete example, here is a script which extracts the date, name
+and size of the latest official PicoLisp release version from the download web
+site, and prints it to standard output:
+
+<pre><code>
+#!/usr/bin/picolisp /usr/lib/picolisp/lib.l
+
+(load "@lib/misc.l" "@lib/http.l")
+
+(use (@Date @Name @Size)
+   (when
+      (match
+         '(@Date " " "-" " " @Name " " "(" @Size ")")
+         (client "software-lab.de" 80 "down.html"
+            (from "Release Archive")
+            (from ".tgz">")
+            (till "") ) )
+      (prinl @Name)
+      (prinl @Date " -- " @Size) ) )
+
+(bye)
+</code></pre>
+
+
+<p><hr>
+<h2><a name="oop">Objects and Classes</a></h2>
+
+<p>The PicoLisp object model is very simple, yet flexible and powerful. Objects
+as well as classes are both implemented as symbols. In fact, there is no formal
+difference between objects and classes; classes are more a conceptual design
+consideration in the head of the programmer than a physical reality.
+
+<p>Having said this, we declare that normally:
+
+<ol>
+<li>A Class
+   <ul>
+   <li>Has a name (interned symbol)
+   <li>Has method definitions and superclass(es) in the value cell
+   <li>May have class variables (attributes) in the property list
+   </ul>
+<li>An Object
+   <ul>
+   <li>Has no name (anonymous symbol) or is an external symbol
+   <li>Has class(es) (and optionally method definitions) in the value cell
+   <li>Has instance variables (attributes) in the property list
+   </ul>
+</ol>
+
+<p>So the main difference between classes and objects is that the former ones
+usually are internal symbols. By convention, their names start with a
+'<code>+</code>'. Sometimes it makes sense, however, to create named objects (as
+global singletons, for example), or even anonymous classes.
+
+<p>Both classes and objects have a list in their value cell, consisting of
+method definitions (often empty for objects) and (super)class(es). And both
+classes and objects have local data in their property lists (often empty for
+classes). This implies, that any given object (as an instance of a class) may
+have private (object-local) methods defined.
+
+<p>It is rather difficult to contrive a simple OOP example. We constructed a
+hierarchy of geometric shapes, with a base class <code>+Shape</code> and two
+subclasses <code>+Rectangle</code> and <code>+Circle</code>.
+
+<p>The source code is included as "<code><a
+href="shape.l">doc/shape.l</a></code>" in the PicoLisp distribution, so you
+don't have to type it in. Just <code><a href="refL.html#load">load</a></code>
+the file, or start it from the shell as:
+
+<pre><code>
+$ ./dbg doc/shape.l
+</code></pre>
+
+<p>Let's look at it piece by piece. Here's the base class:
+
+<pre><code>
+(class +Shape)
+# x y
+
+(dm T (X Y)
+   (=: x X)
+   (=: y Y) )
+
+(dm move> (DX DY)
+   (inc (:: x) DX)
+   (inc (:: y) DY) )
+</code></pre>
+
+<p>The first line '<code>(class +Shape)</code>' defines the symbol
+<code>+Shape</code> as a class without superclasses. The following method
+definitions will go to that class.
+
+<p>The comment '<code># x y</code>' in the second line is just a convention, to
+indicate what instance variables (properties) that class uses. As PicoLisp is a
+dynamic language, a class can be extended at runtime with any number of
+properties, and there is nothing like a fixed object size or structure. This
+comment is a hint of what the programmer thinks to be essential and typical for
+that class. In the case of <code>+Shape</code>, <code>x</code> and
+<code>y</code> are the coordinates of the shape's origin.
+
+<p>Then we have two method definitions, using the keyword <code><a
+href="refD.html#dm">dm</a></code> for "define method". The first method is
+special, in that its name is <code>T</code>. Each time a new object is created,
+and a method with that name is found in its class hierarchy, that method will be
+executed. Though this looks like a "constructor" in other programming languages,
+it should probably better be called "initializer". The <code>T</code> method of
+<code>+Shape</code> takes two arguments <code>X</code> and <code>Y</code>, and
+stores them in the object's property list.
+
+<p>The second method <code>move&gt;</code> changes the object's origin by adding
+the offset values <code>DX</code> and <code>DY</code> to the object's origin.
+
+<p>Now to the first derived class:
+
+<pre><code>
+(class +Rectangle +Shape)
+# dx dy
+
+(dm T (X Y DX DY)
+   (super X Y)
+   (=: dx DX)
+   (=: dy DY) )
+
+(dm area> ()
+   (* (: dx) (: dy)) )
+
+(dm perimeter> ()
+   (* 2 (+ (: dx) (: dy))) )
+
+(dm draw> ()
+   (drawRect (: x) (: y) (: dx) (: dy)) )
+</code></pre>
+
+<p><code>+Rectangle</code> is defined as a subclass of <code>+Shape</code>.
+The comment '<code># dx dy</code>' indicates that <code>+Rectangle</code> has a
+width and a height in addition to the origin coordinates inherited from
+<code>+Shape</code>.
+
+<p>The <code>T</code> method passes the origin coordinates <code>X</code> and
+<code>Y</code> to the <code>T</code> method of the superclass
+(<code>+Shape</code>), then stores the width and height parameters into
+<code>dx</code> and <code>dy</code>.
+
+<p>Next we define the methods <code>area&gt;</code> and
+<code>perimeter&gt;</code> which do some obvious calculations, and a method
+<code>draw&gt;</code> which is supposed to draw the shape on the screen by
+calling some hypothetical function <code>drawRect</code>.
+
+<p>Finally, we define a <code>+Circle</code> class in an analog way, postulating
+the hypothetical function <code>drawCircle</code>:
+
+<pre><code>
+(class +Circle +Shape)
+# r
+
+(dm T (X Y R)
+   (super X Y)
+   (=: r R) )
+
+(dm area> ()
+   (*/ (: r) (: r) 31415927 10000000) )
+
+(dm perimeter> ()
+   (*/ 2 (: r) 31415927 10000000) )
+
+(dm draw> ()
+   (drawCircle (: x) (: y) (: r)) )
+</code></pre>
+
+<p>Now we can experiment with geometrical shapes. We create a rectangle at point
+(0,0) with a width of 30 and a height of 20, and keep it in the variable
+<code>R</code>:
+
+<pre><code>
+: (setq R (new '(+Rectangle) 0 0 30 20))  # New rectangle
+-> $134432824                             # returned anonymous symbol
+: (show R)
+$134432824 (+Rectangle)                   # Show the rectangle
+   dy 20
+   dx 30
+   y 0
+   x 0
+</code></pre>
+
+<p>We see that the symbol <code>$134432824</code> has a list of classes
+'<code>(+Rectangle)</code>' in its value cell, and the coordinates, width and
+height in is property list.
+
+<p>Sending messages to that object
+
+<pre><code>
+: (area> R)                               # Calculate area
+-> 600
+: (perimeter> R)                          # and perimeter
+-> 100
+</code></pre>
+
+<p>will return the values for area and perimeter, respectively.
+
+<p>Then we move the object's origin:
+
+<pre><code>
+: (move> R 10 5)                          # Move 10 right and 5 down
+-> 5
+: (show R)
+$134432824 (+Rectangle)
+   y 5                                    # Origin changed (0,0) -> (10,5)
+   x 10
+   dy 20
+   dx 30
+</code></pre>
+
+<p>Though a method <code>move&gt;</code> wasn't defined for the
+<code>+Rectangle</code> class, it is inherited from the <code>+Shape</code>
+superclass.
+
+<p>Similarly, we create and use a circle object:
+
+<pre><code>
+: (setq C (new '(+Circle) 10 10 30))      # New circle
+-> $134432607                             # returned anonymous symbol
+: (show C)
+$134432607 (+Circle)                      # Show the circle
+   r 30
+   y 10
+   x 10
+-> $134432607
+: (area> C)                               # Calculate area
+-> 2827
+: (perimeter> C)                          # and perimeter
+-> 188
+: (move> C 10 5)                          # Move 10 right and 5 down
+-> 15
+: (show C)
+$134432607 (+Circle)                      # Origin changed (10,10) -> (20,15)
+   y 15
+   x 20
+   r 30
+</code></pre>
+
+<p>It is also easy to send messages to objects in a list:
+
+<pre><code>
+: (mapcar 'area> (list R C))              # Get list of areas
+-> (600 2827)
+: (mapc
+   '((Shape) (move> Shape 10 10))         # Move all 10 right and down
+   (list R C) )
+-> 25
+: (show R)
+$134431493 (+Rectangle)
+   y 15
+   x 20
+   dy 20
+   dx 30
+-> $134431493
+: (show C)
+$134431523 (+Circle)
+   y 25
+   x 30
+   r 30
+</code></pre>
+
+<p>Assume that we want to extend our shape system. From time to time, we need
+shapes that behave exactly like the ones above, but are tied to a fixed
+position. That is, they do not change their position even if they receive a
+<code>move&gt;</code> message.
+
+<p>One solution would be to modify the <code>move&gt;</code> method in the
+<code>+Shape</code> class to a no-operation. But this would require to duplicate
+the whole shape hierarchy (e.g. by defining <code>+FixedShape</code>,
+<code>+FixedRectangle</code> and <code>+FixedCircle</code> classes).
+
+<p>The PicoLisp Way is the use of <u>Prefix Classes</u> through multiple
+inheritance. It uses the fact that searching for method definitions is a
+depth-first, left-to-right search of the class tree. We define a prefix class:
+
+<pre><code>
+: (class +Fixed)
+
+(dm move> (DX DY))  # A do-nothing method
+</code></pre>
+
+<p>We can now create a fixed rectangle, and try to move it:
+
+<pre><code>
+: (setq R (new '(+Fixed +Rectangle) 0 0 30 20))    # '+Fixed' prefix class
+-> $134432881
+: (move> R 10 5)                                   # Send 'move>' message
+-> NIL
+: (show R)
+$134432881 (+Fixed +Rectangle)
+   dy 20
+   dx 30
+   y 0                                             # Did not move!
+   x 0
+</code></pre>
+
+<p>We see, prefix classes can surgically change the inheritance tree for
+selected objects or classes.
+
+<p>Alternatively, if fixed rectangles are needed often, it might make sense to
+define a new class <code>+FixRect</code>:
+
+<pre><code>
+: (class +FixRect +Fixed +Rectangle)
+-> +FixRect
+</code></pre>
+
+<p>and then use it directly:
+
+<pre><code>
+: (setq R (new '(+FixRect) 0 0 30 20))
+-> $13455710
+</code></pre>
+
+
+<p><hr>
+<h2><a name="ext">Persistence (External Symbols)</a></h2>
+
+<p>PicoLisp has persistent objects built-in as a first class data type. With
+"first class" we mean not just the ability of being passed around, or returned
+from functions (that's a matter of course), but that they are a primary data
+type with their own interpreter tag bits. They are, in fact, a special type of
+symbolic atoms (called "<a href="ref.html#external">External Symbols</a>"), that
+happen to be read from pool file(s) when accessed, and written back
+automatically when modified.
+
+<p>In all other aspects they are normal symbols. They have a value cell, a
+property list and a name.
+
+<p>The name cannot be directly controlled by the programmer, as it is assigned
+when the symbol is created. It is an encoded index of the symbol's location in
+its database file. In its visual representation (output by the <code><a
+href="refP.html#print">print</a></code> functions and input by the <code><a
+href="refR.html#read">read</a></code> functions) it is surrounded by braces.
+
+<p>To make use of external symbols, you need to open a database first:
+
+<pre><code>
+: (pool "test.db")
+</code></pre>
+
+<p>If a file with that name did not exist, it got created now. Also created at
+the same moment was <code>{1}</code>, the very first symbol in the file. This
+symbol is of great importance, and is handled especially by PicoLisp. Therefore
+a global constant <code><a href="refD.html#*DB">*DB</a></code> exists, which
+points to that symbol <code>{1}</code>, which should be used exclusively to
+access the symbol <code>{1}</code>, and which should never be modified by the
+programmer.
+
+<pre><code>
+: *DB                   # The value of '*DB'
+-> {1}                  # is '{1}'
+: (show *DB)
+{1} NIL                 # Value of '{1}' is NIL, property list empty
+</code></pre>
+
+<p>Now let's put something into the value cell and property list of
+<code>{1}</code>.
+
+<pre><code>
+: (set *DB "Hello world")  # Set value of '{1}' to a transient symbol (string)
+-> "Hello world"
+: (put *DB 'a 1)           # Property 'a' to 1
+-> 1
+: (put *DB 'b 2)           # Property 'b' to 2
+-> 2
+: (show *DB)               # Now show the symbol '{1}'
+{1} "Hello world"
+   b 2
+   a 1
+</code></pre>
+
+<p>Note that instead of '<code>(set *DB "Hello world")</code>', we might
+also have written '<code>(setq {1} "Hello world")</code>', and instead of
+'<code>(put *DB 'a 1)</code>' we might have written '<code>(put '{1} 'a
+1)</code>'. This would have the same effect, but as a rule external symbols
+should never be be accessed literally in application programs, because the
+garbage collector might not be able to free these symbols and all symbols
+connected to them (and that might well be the whole database). It is all right,
+however, to access external symbols literally during interactive debugging.
+
+<p>Now we can create our first own external symbol. This can be done with
+<code><a href="refN.html#new">new</a></code> when a <code>T</code> argument is
+supplied:
+
+<pre><code>
+: (new T)
+-> {2}               # Got a new symbol
+</code></pre>
+
+<p>We store it in the database root <code>{1}</code>:
+
+<pre><code>
+: (put *DB 'newSym '{2})   # Literal '{2}' (ok during debugging)
+-> {2}
+: (show *DB)
+{1} "Hello world"
+   newSym {2}              # '{2}' is now stored in '{1}'
+   b 2
+   a 1
+</code></pre>
+
+<p>Put some property value into '{2}'
+
+<pre><code>
+: (put *DB 'newSym 'x 777) # Put 777 as 'x'-property of '{2}'
+-> 777
+: (show *DB 'newSym)       # Show '{2}' (indirectly)
+{2} NIL
+   x 777
+-> {2}
+: (show '{2})              # Show '{2}' (directly)
+{2} NIL
+   x 777
+</code></pre>
+
+<p>All modifications to - and creations of - external symbols done so far are
+not written to the database yet. We could call <code><a
+href="refR.html#rollback">rollback</a></code> (or simply exit PicoLisp) to undo
+all the changes. But as we want to keep them:
+
+<pre><code>
+: (commit)           # Commit all changes
+-> T
+: (bye)              # Exit picolisp
+$                    # back to the shell
+</code></pre>
+
+<p>So, the next time when ..
+
+<pre><code>
+$ ./dbg                 # .. we start PicoLisp
+: (pool "test.db")      # and open the database file,
+-> T
+: (show *DB)            # our two symbols are there again
+{1} "Hello world"
+   newSym {2}
+   b 2
+   a 1
+-> {1}
+: (show *DB 'newSym)
+{2} NIL
+   x 777
+-> {2}
+</code></pre>
+
+
+<p><hr>
+<h2><a name="db">Database Programming</a></h2>
+
+<p>To a database, there is more than just persistence. PicoLisp includes an
+entity/relation class framework (see also <a href="ref.html#dbase">Database</a>)
+which allows a close mapping of the application data structure to the database.
+
+<p>We provided a simple yet complete database and GUI demo application in
+<code><a href="family.l">doc/family.l</a></code>. We recommend to start it up
+for test purposes in the following way:
+
+<pre><code>
+$ ./dbg doc/family.l -main
+:
+</code></pre>
+
+<p>This loads the source file, initializes the database by calling the
+<code>main</code> function, and prompts for user input.
+
+<p>The data model is small and simple. We define a class <code>+Person</code>
+and two subclasses <code>+Man</code> and <code>+Woman</code>.
+
+<pre><code>
+(class +Person +Entity)
+</code></pre>
+
+<p><code>+Person</code> is a subclass of the <code><a
+href="refE.html#+Entity">+Entity</a></code> system class. Usually all objects in
+a database are of a direct or indirect subclass of <code><a
+href="refE.html#+Entity">+Entity</a></code>. We can then define the relations to
+other data with the <code><a href="refR.html#rel">rel</a></code> function.
+
+<pre><code>
+(rel nm (+Need +Sn +Idx +String))      # Name
+</code></pre>
+
+<p>This defines the name property (<code>nm</code>) of a person. The first
+argument to <code>rel</code> is always a list of relation classes (subclasses of
+<code><a href="refR.html#+relation">+relation</a></code>), optionally followed
+by further arguments, causing relation daemon objects be created and stored in
+the class definition. These daemon objects control the entity's behavior later
+at runtime.
+
+<p>Relation daemons are a kind of <i>metadata</i>, controlling the interactions
+between entities, and maintaining database integrity. Like other classes,
+relation classes can be extended and refined, and in combination with proper
+prefix classes a fine-grained description of the application's structure can be
+produced.
+
+<p>Besides primitive relation classes, like <code>+Number</code>,
+<code>+String</code> or <code>+Date</code>, there are
+
+<ul>
+
+<li>relations between entities, like <code>+Link</code> (unidirectional link),
+<code>+Joint</code> (bidirectional link) or <code>+Hook</code> (object-local
+index trees)
+
+<li>relations that bundle other relations into a single unit (<code>+Bag</code>)
+
+<li>a <code>+List</code> prefix class
+
+<li>a <code>+Blob</code> class for "binary large objects"
+
+<li>prefix classes that maintain index trees, like <code>+Key</code> (unique
+index), <code>+Ref</code> (non-unique index) or <code>+Idx</code> (full text
+index)
+
+<li>prefix classes which in turn modify index class behavior, like
+<code>+Sn</code> (modified soundex algorithm [<a href="#knuth73">knuth73</a>]
+for tolerant searches)
+
+<li>a <code>+Need</code> prefix class, for existence checks
+
+<li>a <code>+Dep</code> prefix class controlling dependencies between other
+relations
+
+</ul>
+
+<p>In the case of the person's name (<code>nm</code>) above, the relation object
+is of type <code>(+Need +Sn +Idx +String)</code>. Thus, the name of each person
+in this demo database is a mandatory attribute (<code>+Need</code>), searchable
+with the soundex algorithm (<code>+Sn</code>) and a full index
+(<code>+Idx</code>) of type <code>+String</code>.
+
+<pre><code>
+(rel pa (+Joint) kids (+Man))          # Father
+(rel ma (+Joint) kids (+Woman))        # Mother
+(rel mate (+Joint) mate (+Person))     # Partner
+</code></pre>
+
+<p>The attributes for <i>father</i> (<code>pa</code>), <i>Mother</i>
+(<code>ma</code>) and <i>partner</i> (<code>mate</code>) are all defined as
+<code>+Joint</code>s. A <code>+Joint</code> is probably the most powerful
+relation mechanism in PicoLisp; it establishes a bidirectional link between two
+objects.
+
+<p>The above declarations say that the <i>father</i> (<code>pa</code>) attribute
+points to an object of type <code>+Man</code>, and is joined with that object's
+<code>kids</code> attribute (which is a list of joints back to all his
+children).
+
+<p>The consistency of <code>+Joint</code>s is maintained automatically by the
+relation daemons. These become active whenever a value is stored to a person's
+<code>pa</code>, <code>ma</code>, <code>mate</code> or <code>kids</code>
+property.
+
+<p>For example, interesting things happen when a person's <code>mate</code> is
+changed to a new value. Then the <code>mate</code> property of the old mate's
+object is cleared (she has no mate after that). Now when the person pointed to
+by the new value already has a mate, then that mate's <code>mate</code> property
+gets cleared, and the happy new two mates now get their joints both set
+correctly.
+
+<p>The programmer doesn't have to care about all that. He just declares these
+relations as <code>+Joint</code>s.
+
+<p>The last four attributes of person objects are just static data:
+
+<pre><code>
+(rel job (+Ref +String))               # Occupation
+(rel dat (+Ref +Date))                 # Date of birth
+(rel fin (+Ref +Date))                 # Date of death
+(rel txt (+String))                    # Info
+</code></pre>
+
+<p>They are all searchable via a non-unique index (<code>+Ref</code>). Date
+values in PicoLisp are just numbers, representing the numbers of days since
+first of March in the year zero.
+
+<p>A method <code>url&gt;</code> is defined:
+
+<pre><code>
+(dm url> ()
+   (list "@person" '*ID This) )
+</code></pre>
+
+<p>It is needed later in the GUI, to cause a click on a link to switch to that
+object.
+
+<p>The classes <code>+Man</code> and <code>+Woman</code> are subclasses of
+<code>+Person</code>:
+
+<pre><code>
+(class +Man +Person)
+(rel kids (+List +Joint) pa (+Person)) # Children
+
+(class +Woman +Person)
+(rel kids (+List +Joint) ma (+Person)) # Children
+</code></pre>
+
+<p>They inherit everything from <code>+Person</code>, except for the
+<code>kids</code> attribute. This attribute joins with the <code>pa</code> or
+<code>ma</code> attribute of the child, depending on the parent's gender.
+
+<p>That's the whole data model for our demo database application.
+
+<p>It is followed by a call to <code><a href="refD.html#dbs">dbs</a></code>
+("database sizes"). This call is optional. If it is not present, the whole
+database will reside in a single file, with a block size of 256 bytes. If it is
+given, it should specify a list of items, each having a number in its CAR, and a
+list in its CDR. The CARs taken together will be passed later to <a
+href="refP.html#pool">pool</a>, causing an individual database file with that
+size to be created. The CDRs tell what entity classes (if an item is a symbol)
+or index trees (if an item is a list with a class in its CAR and a list of
+relations in its CDR) should be placed into that file.
+
+
+<p>A handful of access functions is provided, that know about database
+relationships and thus allows higher-level access modes to the external symbols
+in a database.
+
+<p>For one thing, the B-Trees created and maintained by the index daemons can be
+used directly. Though this is rarely done in a typical application, they form
+the base mechanisms of other access modes and should be understood first.
+
+<p>The function <code><a href="refT.html#tree">tree</a></code> returns the tree
+structure for a given relation. To iterate over the whole tree, the functions
+<code><a href="refI.html#iter">iter</a></code> and <code><a
+href="refS.html#scan">scan</a></code> can be used:
+
+<pre><code>
+(iter (tree 'dat '+Person) '((P) (println (datStr (get P 'dat)) (get P 'nm))))
+"1770-08-03" "Friedrich Wilhelm III"
+"1776-03-10" "Luise Augusta of Mecklenburg-Strelitz"
+"1797-03-22" "Wilhelm I"
+...
+</code></pre>
+
+<p>They take a function as the first argument. It will be applied to all objects
+found in the tree (to show only a part of the tree, an optional begin- and
+end-value can be supplied), producing a simple kind of report.
+
+<p>More useful is <code><a href="refC.html#collect">collect</a></code>; it
+returns a list of all objects that fall into a range of index values:
+
+<pre><code>
+: (collect 'dat '+Person (date 1982 1 1) (date 1988 12 31))
+-> ({2-M} {2-L} {2-E})
+</code></pre>
+
+<p>This returns all persons born between 1982 and 1988. Let's look at them with
+<code><a href="refS.html#show">show</a></code>:
+
+<pre><code>
+: (more (collect 'dat '+Person (date 1982 1 1) (date 1988 12 31)) show)
+{2-M} (+Man)
+   nm "William"
+   dat 724023
+   ma {2-K}
+   pa {2-J}
+   job "Heir to the throne"
+
+{2-L} (+Man)
+   nm "Henry"
+   dat 724840
+   ma {2-K}
+   pa {2-J}
+   job "Prince"
+
+{2-E} (+Woman)
+   nm "Beatrice"
+   dat 726263
+   ma {2-D}
+   job "Princess"
+   pa {2-B}
+</code></pre>
+
+<p>If you are only interested in a certain attribute, e.g. the name, you can
+return it directly:
+
+<pre><code>
+: (collect 'dat '+Person (date 1982 1 1) (date 1988 12 31) 'nm)
+-> ("William" "Henry" "Beatrice")
+</code></pre>
+
+<p>To find a single object in the database, the function <code><a
+href="refD.html#db">db</a></code> is used:
+
+<pre><code>
+: (db 'nm '+Person "Edward")
+-> {2-;}
+</code></pre>
+
+<p>If the key is not unique, additional arguments may be supplied:
+
+<pre><code>
+: (db 'nm '+Person "Edward"  'job "Prince"  'dat (date 1964 3 10))
+-> {2-;}
+</code></pre>
+
+<p>The programmer must know which combination of keys will suffice to specify
+the object uniquely. The tree search is performed using the first value
+("Edward"), while all other attributes are used for filtering. Later, in
+the <a href="#pilog">Pilog</a> section, we will show how more general (and
+possibly more efficient) searches can be performed.
+
+
+<p><hr>
+<h2><a name="gui">User Interface (GUI) Programming</a></h2>
+
+<p>The only types of GUI supported by the PicoLisp application server framework
+is either dynamically generated (but static by nature) HTML, or an interactive
+XHTML/CSS framework with the optional use of JavaScript.
+
+<p>Before we explain the GUI of our demo database application, we present a
+minimal example for a plain HTML-GUI in <code><a
+href="hello.l">doc/hello.l</a></code>. Start the application server as:
+
+<pre><code>
+$ ./p lib/http.l -'server 8080 "doc/hello.l"' -wait
+</code></pre>
+
+<p>Now point your browser to the address '<code><a
+href="http://localhost:8080">http://localhost:8080</a></code>'. You should see a
+very simple HTML page. You can come back here with the browser's BACK button.
+
+<p>You can call the page repeatedly, or concurrently with many clients if you
+like. To terminate the server, you have to send it a TERM signal (e.g.
+'<code>killall picolisp</code>'), or type the <code>Ctrl-C</code> key in the
+console window.
+
+<p>In our demo database application, a single function <code>person</code> is
+responsible for the whole GUI. Again, please look at <code><a
+href="family.l">doc/family.l</a></code>.
+
+<p>To start the database <i>and</i> the application server, call:
+
+<pre><code>
+$ ./dbg doc/family.l -main -go
+</code></pre>
+
+<p>As before, the database is opened with <code>main</code>. The function
+<code>go</code> is also defined in <code>doc/family.l</code>:
+
+<pre><code>
+(de go ()
+   (server 8080 "@person") )
+</code></pre>
+
+<p>It starts the HTTP server listening on TCP port 8080 (we did a similar thing
+in our minimal GUI example above directly on the command line). Each connect to
+that port will cause the function <code>person</code> to be invoked.
+
+<p>Again, point your browser to the address '<code><a
+href="http://localhost:8080" target="GUI">http://localhost:8080</a></code>'.
+
+<p>You should see a new browser window with an input form created by the
+function <code>person</code>. We provided an initial database in
+"doc/family/[1-4]". You can navigate through it by clicking on the pencil icons
+besides the input fields.
+
+<p>The chart with the children data can be scrolled using the down
+(<code>v</code>) and up (<code>^</code>) buttons.
+
+<p>A click on the button "Select" below opens a search dialog. You can scroll
+through the chart as before. Again, a click on a pencil will jump to that
+person. You can abort the dialog with a click on the "Cancel"-button.
+
+<p>The search fields in the upper part of the dialog allow a conjunctive search.
+If you enter "Edward" in the "Name" field and click "Search", you'll see all
+persons having the string "Edward" in their name. If you also enter "Duke" in
+the "Occupation" field, the result list will reduce to only two entries.
+
+<p>To create a new person, press the "New Man" or "New Woman" button. A new
+empty form will be displayed. Please type a name into the first field, and
+perhaps also an occupation and birth date. Any change of contents should be
+followed by a press on the "Done" button, though any other button (also Scroll
+or Select-buttons) will also do.
+
+<p>To assign a <i>father</i> attribute, you can either type a name directly into
+the field (if that person already exists in the database and you know the exact
+spelling), or use the "Set"-button (<code>-&gt;</code>) to the left of that
+field to open the search dialog. If you type in the name directly, your input
+must exactly match upper and lower case.
+
+<p>Alternatively, you may create a new person and assign a child in the
+"Children" chart.
+
+<p>On the console where you started PicoLisp, there should a prompt have
+appeared just when the browser connected. You can debug the application
+interactively while it is running. For example, the global variable
+<code>*Top</code> always contains the top level GUI object:
+
+<pre><code>
+: (show *Top)
+</code></pre>
+
+<p>To take a look at the first field on the form:
+
+<pre><code>
+: (show *Top 'gui 1)
+</code></pre>
+
+<p>A production application would be started in a slightly different way:
+
+<pre><code>
+$ ./p doc/family.l -main -go -wait
+</code></pre>
+
+<p>In that case, no debug prompt will appear. In both cases, however, two
+<code>picolisp</code> processes will be running now. One is the initial server
+process which will continue to run until it is killed. The other is a child
+process holding the state of the GUI in the browser. It will terminate some time
+after the browser is closed, or when <code>(<a
+href="refB.html#bye">bye</a>)</code> or a plain ENTER is entered at the PicoLisp
+prompt.
+
+<p>Now back to the explanation of the GUI function <code>person</code>:
+
+<pre><code>
+(de person ()
+   (app)
+   (action
+      (html 0 (get (default *ID (seq (db: +Person))) 'nm) "lib.css" NIL
+         (form NIL
+            (&lt;h3&gt; (&lt;id&gt; (: nm)))
+</code></pre>
+
+<p>For an in-depth explanation of that startup code, please refer to the guide
+to <a href="app.html">PicoLisp Application Development</a>.
+
+<p>All components like fields and buttons are controlled by <code>form</code>.
+The function <code>gui</code> creates a single GUI component and takes the type
+(a list of classes) and a variable number of arguments depending on the needs of
+these classes.
+
+<pre><code>
+   (gui '(+E/R +TextField) '(nm : home obj) 40 "Name")
+</code></pre>
+
+<p>This creates a <code>+TextField</code> with the label "Name" and a length of
+40 characters. The <code>+E/R</code> (: Entity/Relation) prefix class connects
+that field to a database object, the <code>nm</code> attribute of a person in
+this case, so that the person's name is displayed in that text field, and any
+changes entered into that field are propagated to the database automatically.
+
+<pre><code>
+   (gui '(+ClassField) '(: home obj) '(("Male" +Man) ("Female" +Woman)))
+</code></pre>
+
+<p>A <code>+ClassField</code> displays and changes the class of an object, in
+this case the person's sex from <code>+Man</code> to <code>+Woman</code> and
+vice versa.
+
+<p>As you see, there is no place where explicit accesses to the database have to
+be programmed, no <code>select</code> or <code>update</code>. This is all
+encapsulated in the GUI components, mainly in the <code>+E/R</code> prefix
+class. The above function <code>person</code> is fully functional as we present
+it and allows creation, modification and deletion of person objects in the
+database.
+
+<p>The two buttons on the bottom right generate simple reports:
+
+<p>The first one shows all contemporaries of the person that is currently
+displayed, i.e. all persons who did not die before, or were not born after that
+person. This is a typical PicoLisp report, in that in addition to the report's
+HTML page, a temporary file may be generated, suitable for download (and import
+into a spread sheet), and from which a PDF can be produced for print-out.
+
+<p>In PicoLisp, there is not a real difference between a plain HTML-GUI and a
+report. Again, the function <code>html</code> is used to generate the page.
+
+<p>The second report is much simpler. It produces a recursive structure of the
+family.
+
+<p>In both reports, links to the person objects are created which allow easy
+navigation through the database.
+
+
+<p><hr>
+<h2><a name="pilog">Pilog -- PicoLisp Prolog</a></h2>
+
+<p>This sections explains some cases of using Pilog in typical application
+programming, in combination with persistent objects and databases. Please refer
+to the <a href="ref.html#pilog">Pilog</a> section of the PicoLisp Reference for
+the basic usage of Pilog.
+
+<p>Again, we use our demo application <code><a
+href="family.l">doc/family.l</a></code> that was introduced in the <a
+href="#db">Database Programming</a> section.
+
+<p>Normally, Pilog is used either interactively to query the database during
+debugging, or in applications to generate export data and reports. In the
+following examples we use the interactive query front-end functions <code><a
+href="ref_.html#?">?</a></code> and <code><a
+href="refS.html#select">select</a></code>. An application will use <code><a
+href="refG.html#goal">goal</a></code> and <code><a
+href="refP.html#prove">prove</a></code> directly, or use convenience functions
+like <code><a href="refP.html#pilog">pilog</a></code> or <code><a
+href="refS.html#solve">solve</a></code>.
+
+<p>All Pilog access to external symbols is done via the two predicates <code><a
+href="refD.html#db/3">db/3</a></code> and <code><a
+href="refS.html#select/3">select/3</a></code>.
+
+<ul>
+
+<li><code><a href="refD.html#db/3">db/3</a></code> corresponds to the Lisp-level
+functions <code><a href="refD.html#db">db</a></code> and <code><a
+href="refC.html#collect">collect</a></code>, as it derives its data from a
+single relation. It can be used for simple database queries.
+
+<li><code><a href="refS.html#select/3">select/3</a></code> provides for
+self-optimizing parallel access to an arbitrary number of relations. There is
+also a Lisp front-end function <code><a
+href="refS.html#select">select</a></code>, for convenient calls to the Pilog
+<code>select</code> predicate.
+
+</ul>
+
+<p>A predicate <code><a href="refS.html#show/1">show/1</a></code> is pre-defined
+for debugging purposes (a simple glue to the Lisp-level function
+<code>show</code>, see <a href="#brw">Browsing</a>). Searching with <code><a
+href="refD.html#db/3">db/3</a></code> for all persons having the string "Edward"
+in their name:
+
+<pre><code>
+: (? (db nm +Person "Edward" @P) (show @P))
+{2-;} (+Man)
+   nm "Edward"
+   ma {2-:}
+   pa {2-A}
+   dat 717346
+   job "Prince"
+ @P={2-;}
+{2-1B} (+Man)
+   nm "Albert Edward"
+   kids ({2-1C} {2-1D} {2-1E} {2-1F} {2-1G} {2-1H} {2-1I} {2-g} {2-a})
+   job "Prince"
+   mate {2-f}
+   fin 680370
+   dat 664554
+ @P={2-1B}
+...               # more results
+</code></pre>
+
+<p>To search for all persons with "Edward" in their name who are married to
+somebody with occupation "Queen":
+
+<pre><code>
+: (? (db nm +Person "Edward" @P) (val "Queen" @P mate job) (show @P))
+{2-1B} (+Man)
+   mate {2-f}
+   nm "Albert Edward"
+   kids ({2-1C} {2-1D} {2-1E} {2-1F} {2-1G} {2-1H} {2-1I} {2-g} {2-a})
+   job "Prince"
+   fin 680370
+   dat 664554
+ @P={2-1B}
+-> NIL            # only one result
+</code></pre>
+
+<p>If you are interested in the names of "Albert Edward"'s children:
+
+<pre><code>
+: (? (db nm +Person "Albert Edward" @P) (lst @K @P kids) (val @Kid @K nm))
+ @P={2-1B} @K={2-1C} @Kid="Beatrice Mary Victoria"
+ @P={2-1B} @K={2-1D} @Kid="Leopold George Duncan"
+ @P={2-1B} @K={2-1E} @Kid="Arthur William Patrick"
+ @P={2-1B} @K={2-1F} @Kid="Louise Caroline Alberta"
+ @P={2-1B} @K={2-1G} @Kid="Helena Augusta Victoria"
+ @P={2-1B} @K={2-1H} @Kid="Alfred Ernest Albert"
+ @P={2-1B} @K={2-1I} @Kid="Alice Maud Mary"
+ @P={2-1B} @K={2-g} @Kid="Victoria Adelaide Mary"
+ @P={2-1B} @K={2-a} @Kid="Edward VII"
+-> NIL
+</code></pre>
+
+<p><code><a href="refD.html#db/3">db/3</a></code> can do a direct index access
+only for a single attribute (<code>nm</code> of <code>+Person</code> above). To
+search for several criteria at the same time, <code><a
+href="refS.html#select/3">select/3</a></code> has to be used:
+
+<pre><code>
+: (?
+   (select (@P)
+      ((nm +Person "Edward") (nm +Person "Augusta" pa))  # Generator clauses
+      (tolr "Edward" @P nm)                              # Filter clauses
+      (tolr "Augusta" @P kids nm) )
+   (show @P) )
+{2-1B} (+Man)
+   kids ({2-1C} {2-1D} {2-1E} {2-1F} {2-1G} {2-1H} {2-1I} {2-g} {2-a})
+   mate {2-f}
+   nm "Albert Edward"
+   job "Prince"
+   fin 680370
+   dat 664554
+ @P={2-1B}
+-> NIL
+</code></pre>
+
+<p><code><a href="refS.html#select/3">select/3</a></code> takes a list of
+generator clauses which are used to retrieve objects from the database, and a
+number of normal Pilog filter clauses. In the example above the generators are
+
+<ul>
+
+<li><code>(nm +Person "Edward")</code> to generate persons with "Edward" in
+their names, and
+
+<li><code>(nm +Person "Augusta" pa)</code> to find persons with "Augusta"
+in their names and generate persons using the <code>pa</code> ("father")
+attribute.
+
+</ul>
+
+<p>All persons generated are possible candidates for our selection. The
+<code>nm</code> index tree of <code>+Person</code> is traversed twice in
+parallel, optimizing the search in such a way that successful hits get higher
+priority in the search, depending on the filter clauses. The process will stop
+as soon as any one of the generators is exhausted. Note that this is different
+from the standard Prolog search algorithm.
+
+<p>The filter clauses in this example both use the pre-defined predicate
+<code><a href="refT.html#tolr/3">tolr/3</a></code> for <i>tolerant</i> string
+matches (according either to the soundex algorithm (see the section <a
+href="#db">Database Programming</a>) or to substring matches), and filter
+objects that
+
+<ul>
+
+<li>match "Edward" in their name: <code>(tolr "Edward" @P nm)</code>, and
+
+<li>match "Augusta" in one of their kids' names: <code>(tolr "Augusta" @P
+kids nm)</code>
+
+</ul>
+
+<p>A more typical and extensive example for the usage of <code>select</code> can
+be found in the <code>qPerson</code> function in <code><a
+href="family.l">doc/family.l</a></code>. It is used in the search dialog of the
+demo application, and searches for a person with the name, the parents' and
+partner's names, the occupation and a time range for the birth date. The
+relevant index trees in the database are searched (actually only those trees
+where the user entered a search key in the corresponding dialog field), and a
+logical AND of the search attributes is applied to the result.
+
+<p>For example, press the "Select" button, enter "Elizabeth" into the "Mother"
+search field and "Phil" in the "Partner" search field, meaning to look for all
+persons whose mother's name is like "Elizabeth" and whose partner's name is like
+"Phil". As a result, two persons ("Elizabeth II" and "Anne") will show up.
+
+<p>In principle, <code><a href="refD.html#db/3">db/3</a></code> can be seen as a
+special case of <code><a href="refS.html#select/3">select/3</a></code>. The
+following two queries are equivalent:
+
+<pre><code>
+: (? (db nm +Person "Edward" @P))
+ @P={2-;}
+ @P={2-1B}
+ @P={2-R}
+ @P={2-1K}
+ @P={2-a}
+ @P={2-T}
+-> NIL
+: (? (select (@P) ((nm +Person "Edward"))))
+ @P={2-;}
+ @P={2-1B}
+ @P={2-R}
+ @P={2-1K}
+ @P={2-a}
+ @P={2-T}
+-> NIL
+</code></pre>
+
+
+<p><hr>
+<h2><a name="sql">Poor Man's SQL</a></h2>
+
+<h3>select</h3>
+
+<p>For convenience, a <code><a href="refS.html#select">select</a></code> Lisp
+glue function is provided as a front-end to the <code>select</code> predicate.
+Note that this function does not evaluate its arguments (it is intended for
+interactive use), and that it supports only a subset of the predicate's
+functionality. The syntax resembles SELECT in the SQL language, for example:
+
+<pre><code>
+# SELECT * FROM Person
+: (select +Person)  # Step through the whole database
+{2-o} (+Man)
+   nm "Adalbert Ferdinand Berengar Viktor of Prussia"
+   dat 688253
+   ma {2-j}
+   pa {2-h}
+   fin 711698
+
+{2-1B} (+Man)
+   nm "Albert Edward"
+   dat 664554
+   job "Prince"
+   mate {2-f}
+   kids ({2-1C} {2-1D} {2-1E} {2-1F} {2-1G} {2-1H} {2-1I} {2-g} {2-a})
+   fin 680370
+...
+</code></pre>
+
+<pre><code>
+# SELECT * FROM Person WHERE nm LIKE "%Edward%"
+: (select +Person nm "Edward")  # Show all Edwards
+{2-;} (+Man)
+   nm "Edward"
+   dat 717346
+   job "Prince"
+   ma {2-:}
+   pa {2-A}
+
+{2-1B} (+Man)
+   nm "Albert Edward"
+   dat 664554
+   job "Prince"
+   kids ({2-1C} {2-1D} {2-1E} {2-1F} {2-1G} {2-1H} {2-1I} {2-g} {2-a})
+   mate {2-f}
+   fin 680370
+...
+</code></pre>
+
+<pre><code>
+# SELECT nm, dat FROM Person WHERE nm LIKE "%Edward%"
+: (select nm dat +Person nm "Edward")
+"Edward" "1964-03-10" {2-;}
+"Albert Edward" "1819-08-26" {2-1B}
+"George Edward" NIL {2-R}
+"Edward Augustus Hanover" NIL {2-1K}
+...
+</code></pre>
+
+<pre><code>
+# SELECT dat, fin, p1.nm, p2.nm
+#    FROM Person p1, Person p2
+#    WHERE p1.nm LIKE "%Edward%"
+#    AND p1.job LIKE "King%"
+#    AND p1.mate = p2.mate  -- Actually, in a SQL model we'd need
+#                           -- another table here for the join
+: (select dat fin nm (mate nm) +Person nm "Edward" job "King")
+"1894-06-23" "1972-05-28" "Edward VIII" "Wallace Simpson" {2-T}
+"1841-11-09" NIL "Edward VII" "Alexandra of Denmark" {2-a}
+-> NIL
+</code></pre>
+
+
+<h3>update</h3>
+
+<p>In addition (just to stay with the SQL terminology ;-), there is also an
+<code><a href="refU.html#update">update</a></code> function. It is a front-end
+to the <code><a href="refE.html#entityMesssages">set!></a></code> and <code><a
+href="refE.html#entityMesssages">put!></a></code> transaction methods, and
+should be used when single objects in the database have to be modified by hand.
+
+<p>In principle, it would also be possible to use the <code><a
+href="refE.html#edit">edit</a></code> function to modify a database object. This
+is not recommended, however, because <code>edit</code> does not know about
+relations to other objects (like Links, Joints and index trees) and may easily
+cause database corruption.
+
+<p>In the most general case, the value of a property in a database object is
+changed with the <code>put!></code> method. Let's look at "Edward" from the
+previous examples:
+
+<pre><code>
+: (show '{2-;})
+{2R} (+Man)
+   job "Prince"
+   nm "Edward"
+   dat 717346
+   ma {2-:}
+   pa {20A}
+-> {2-;}
+</code></pre>
+
+<p>We might change the name to "Johnny" with <code>put!></code>:
+
+<pre><code>
+: (put!> '{2-;} 'nm "Johnny")
+-> "Johnny"
+</code></pre>
+
+<p>However, an easier and less error-prone prone way - especially when more than
+one property has to be changed - is using <code><a
+href="refU.html#update">update</a></code>. It presents the value cell (the list
+of classes) and then each property on its own line, allowing the user to change
+it with the <a href="#ledit">command line editor</a>.
+
+<p>Just hitting ENTER will leave that property unchanged. To modify it, you'll
+typically hit ESC to get into command mode, and move the cursor to the point of
+change.
+
+<p>For properties with nested list structures (<code>+List +Bag</code>),
+<code>update</code> will recurse into the data structure.
+
+<pre><code>
+: (update '{2-;})
+{2-;} (+Man)      # ENTER
+nm "Johnny"       # Modified the name to "Johnny"
+ma {2-:}          # ENTER
+pa {2-A}          # ENTER
+dat 1960-03-10    # Modified the year from "1964" to "1960"
+job "Prince"      # ENTER
+-> {2-;}
+</code></pre>
+
+<p>All changes are committed immediately, observing the rules of database
+synchronization so that any another user looking at the same object will have
+his GUI updated correctly.
+
+<p>To abort <code>update</code>, hit <code>Ctrl-X</code>.
+
+<p>If only a single property has to be changed, <code>update</code> can be
+called directly for that property:
+
+<pre><code>
+: (update '{2-;} 'nm)
+{2-;} nm "Edward"
+...
+</code></pre>
+
+
+<p><hr>
+<h2><a name="ref">References</a></h2>
+
+<p><a name="knuth73">[knuth73]</a> Donald E. Knuth: ``The Art of Computer
+Programming'', Vol.3, Addison-Wesley, 1973, p. 392
+
+</body>
+</html>
diff --git a/doc/utf8 b/doc/utf8
@@ -0,0 +1,39 @@
+         UTF-8 Format
+
+# Encoding for zero is different from Java
+# Special character 0xFF (char T)
+
+   0000 .. 007F   0xxxxxxx
+                   6     0
+
+
+   0080 .. 07FF   110xxxxx 10xxxxxx
+                     A   6   5    0
+
+
+   0800 .. FFFF   1110xxxx 10xxxxxx 10xxxxxx
+                      F  C   B    6   5    0
+
+
+
+         Umlaute
+
+�
+äöüÄÖÜß
+�������
+
+�|Ä|   # C3 84  <-> C4
+�|Ö|   # C3 96  <-> D6
+�|Ü|   # C3 9C  <-> DC
+�|ä|    # C3 A4  <-> E4
+�|ö|    # C3 B6  <-> F6
+�|ü|    # C3 BC  <-> FC
+�|ß|   # C3 9F  <-> DF
+
+Paragraph         # C2 A7     <-> A7
+EUR (8364 "20AC") # E2 82 AC  <-> A4
+
+tr -d '\303' |tr '\204\226\234\244\266\274\237' '�������'
+
+(out "Nagoya"
+   (prinl (char (hex "540D")) (char (hex "53E4")) (char (hex "5C4B"))) )
diff --git a/doc64/README b/doc64/README
@@ -0,0 +1,136 @@
+12nov09abu
+(c) Software Lab. Alexander Burger
+
+
+         64-bit PicoLisp
+         ===============
+
+The 64-bit version of PicoLisp is a complete rewrite of the 32-bit version.
+
+While the 32-bit version was written in C, the 64-bit version is implemented in
+a generic assembler, which in turn is written in PicoLisp. In most respects, the
+two versions are compatible (see "Differences" below).
+
+
+      Building the Kernel
+      -------------------
+
+No C-compiler is needed to build the interpreter kernel, only a 64-bit version
+of the GNU assembler for the target architecture. The kernel sources are the
+"*.l" files in the "src64/" directory. The PicoLisp assembler parses them, and
+generates a few "*.s" files (already pre-generated in the distribution), which
+the GNU assembler accepts to build the executable binary file.
+
+In case of modifying "*.l" source files, a running PicoLisp system (32-bit or
+64-bit) is required to re-generate the "*.s" files. Due to the pre-generated
+distribution, it is not necessary to compile a 32-bit version first.
+
+The generic assembler is in "src64/lib/asm.l". It is driven by the script
+"src64/mkAsm" which is called by "src64/Makefile".
+
+The CPU registers and instruction set of the PicoLisp processor are described in
+"doc64/asm", and the internal data structures of the PicoLisp machine in
+"doc64/structures".
+
+Currently, only Linux on the x86-64 architecture is supported. The platform
+dependent files are in the "src64/arch/" for the target architecture, and in
+"src64/sys/" for the target operating system.
+
+
+      Reasons for the Use of Assembly Language
+      ----------------------------------------
+
+Contrary to the common expectation: Runtime execution speed was not a primary
+design decision factor. In general, pure code efficiency has not much influence
+on the overall execution speed of an application program, as memory bandwidth
+(and later I/O bandwidth) is the main bottleneck.
+
+The reasons to choose assembly language (instead of C) were, in decreasing order
+of importance:
+
+   1. Stack manipulations
+      Alignment to cell boundaries: To be able to directly express the desired
+      stack data structures (see "doc64/structures", e.g. "Apply frame"), a
+      better control over the stack (as compared to C) was required.
+
+      Indefinite pushs and pops: A Lisp interpreter operates on list structures
+      of unknown length all the time. The C version always required two passes,
+      the first to determine the length of the list to allocate the necessary
+      stack structures, and then the second to do the actual work. An assembly
+      version can simply push as many items as are encountered, and clean up the
+      stack with pop's and stack pointer arithmetics.
+
+   2. Alignments and memory layout control
+      Similar to the stack structures, there are also heap data structures that
+      can be directly expressed in assembly declarations (built at assembly
+      time), while a C implementation has to defer that to runtime.
+
+      Built-in functions (SUBRs) need to be aligned to to a multiple of 16+2,
+      reflecting the data type tag requirements, and thus allow direct jumps to
+      the SUBR code without further pointer arithmetic and masking, as is
+      necessary in the C version.
+
+   3. Multi-precision arithmetics (Carry-Flag)
+      The bignum functions demand an extensive use of CPU flags. Overflow and
+      carry/borrow have to emulated in C with awkward comparisons of signed
+      numbers.
+
+   4. Register allocation
+      A manual assembly implementation can probably handle register allocation
+      more flexibly, with minimal context saves and reduced stack space, and
+      multiple values can be returned from functions in registers. As mentioned
+      above, this has no measurable effect on execution speed, but the binary's
+      overall size is significantly reduced.
+
+   5. Return status register flags from functions
+      Functions can return condition codes directly. The callee does not need to
+      re-check returned values. Again, this has only a negligible impact on
+      performance.
+
+   6. Multiple function entry points
+      Some things can be handled more flexibly, and existing code may be easier
+      to re-use. This is on the same level as wild jumps within functions
+      ('goto's), but acceptable in the context of an often-used but rarely
+      modified program like a Lisp kernel.
+
+It would indeed be feasible to write only certain parts of the system in
+assembly, and the rest in C. But this would be rather unsatisfactory. And it
+gives a nice feeling to be independent of a heavy-weight C compiler.
+
+
+      Differences to the 32-bit Version
+      ---------------------------------
+
+Except for the following six cases, the 64-bit version should behave identically
+to the 32-bit version.
+
+1. Internal format and printed representation of external symbols
+   This is probably the most significant change. External (i.e. database)
+   symbols are coded more efficiently internally (occupying only a single cell),
+   and have a slightly different printed representation. Existing databases need
+   to be converted.
+
+2. Short numbers are pointer-equal
+   As there is now an internal "short number" type, an expression like
+
+      (== 64 64)
+
+   will evaluate to 'T' on a 64-bit system, but to 'NIL' on a 32-bit system.
+
+3. Bit manipulation functions may differ for negative arguments
+   Numbers are represented internally in a different format. Bit manipulations
+   are not really defined for negative numbers, but (& -15 -6) will give -6 on
+   32 bits, and 6 on 64 bits.
+
+4. 'do' takes only a 'cnt' argument (not a bignum)
+   For the sake of simplicity, a short number (60 bits) is considered to be
+   enough for counted loops.
+
+5. Calling native functions is different. Direct calls using the 'lib:fun'
+   notation is still possible (see the 'ext' and 'ht' libraries), but the
+   corresponding functions must of course be coded in assembly and not in C. To
+   call C functions, the new 'native' function should be used, which can
+   interface to native C functions directly, without the need of glue code to
+   convert arguments and return values.
+
+6. Bugs (in the implementation, or in this list ;-)
diff --git a/doc64/asm b/doc64/asm
@@ -0,0 +1,194 @@
+# 06mar10abu
+# (c) Software Lab. Alexander Burger
+
+
+   CPU Registers:
+
+      +---+---+---+---+---+---+---+---+
+      |               A           | B |  \      [A]ccumulator
+      +---+---+---+---+---+---+---+---+   D     [B]yte register
+      |               C               |  /      [C]ount register
+      +---+---+---+---+---+---+---+---+         [D]ouble register
+      |               E               |         [E]xpression register
+      +---+---+---+---+---+---+---+---+
+
+
+      +---+---+---+---+---+---+---+---+
+      |               X               |         [X] Index register
+      +---+---+---+---+---+---+---+---+         [Y] Index register
+      |               Y               |         [Z] Index register
+      +---+---+---+---+---+---+---+---+
+      |               Z               |
+      +---+---+---+---+---+---+---+---+
+
+
+      +---+---+---+---+---+---+---+---+
+      |               L               |         [L]ink register
+      +---+---+---+---+---+---+---+---+         [S]tack pointer
+      |               S               |
+      +---+---+---+---+---+---+---+---+
+
+
+      +-------------------------------+
+      |  [z]ero    [s]ign    [c]arry  |         [F]lags
+      +-------------------------------+
+
+========================================================================
+
+   Source Addressing Modes:
+      ld A 1234            # Immediate
+      ld A "(a+b-c)"
+      ld A R               # Register
+      ld A Global          # Direct
+      ld A (R)             # Indexed
+      ld A (R 8)           # Indexed with offset
+      ld A (R OFFS)
+      ld A (R Global)
+      ld A (Global)        # Indirect
+      ld A (Global OFFS)   # Indirect with offset
+      ld A ((R))           # Indexed indirect
+      ld A ((R 8))         # Indexed with offset indirect
+      ld A ((R 8) OFFS)
+      ld A ((R Global) OFFS)
+      ld A ((R OFFS) Global)
+      ...
+
+   Destination Addressing Modes:
+      ld R A               # Register
+      ld (R) A             # Indexed
+      ld (R 8) A           # Indexed with offset
+      ld (R OFFS) A
+      ld (R Global) A
+      ld (Global) A        # Indirect
+      ld (Global OFFS) A   # Indirect with offset
+      ld ((R)) A           # Indexed indirect
+      ld ((R 8)) A         # Indexed with offset indirect
+      ld ((R 8) OFFS) A
+      ld ((R Global) OFFS) A
+      ld ((R OFFS) Global) A
+      ...
+
+   Target Addressing Modes:
+      jmp 1234             # Absolute
+      jmp Label
+      jmp (R)              # Indexed
+      jmp (Global)         # Indirect
+
+========================================================================
+
+   Instruction set:
+      nop                  # No operation
+
+   Move Instructions:
+      ld dst src           # Load 'dst' from 'src'
+      ld2 src              # Load 'A' from two bytes 'src' (signed)
+      ld4 src              # Load 'A' from four bytes 'src' (signed)
+      ldc dst src          # Load if Carry 'dst' from 'src'
+      ldnc dst src         # Load if not Carry 'dst' from 'src'
+      ldz dst src          # Load if Zero 'dst' from 'src'
+      ldnz dst src         # Load if not Zero 'dst' from 'src'
+      lea dst src          # Load 'dst' with effective address of 'src'
+      st2 dst              # Store two bytes from 'A' into 'dst'
+      st4 dst              # Store four bytes from 'A' into 'dst'
+      xchg dst dst         # Exchange 'dst's
+      movm dst src end     # Move memory between 'src' and 'end' to 'dst'
+      movn dst src cnt     # Move 'cnt' bytes from 'src' to 'dst'
+      mset dst cnt         # Set 'cnt' bytes of memory to B
+
+   Arithmetics:
+      add dst src          # Add 'src' to 'dst'
+      addc dst src         # Add 'src' to 'dst' with Carry
+      sub dst src          # Subtract 'src' from 'dst'
+      subc dst src         # Subtract 'src' from 'dst' with Carry
+
+      not dst              # One's complement negation of 'dst'
+      neg dst              # Two's complement negation of 'dst'
+
+      and dst src          # Bitwise AND 'dst' with 'src'
+      or dst src           # Bitwise OR 'dst' with 'src'
+      xor dst src          # Bitwise XOR 'dst' with 'src'
+      off dst src          # Clear 'src' bits in 'src'
+      test dst src         # Bit-test 'dst' with 'src'
+
+      shl dst src          # Shift 'dst' left into Carry by 'src' bits
+      shr dst src          # Shift 'dst' right into Carry by 'src' bits
+      rol dst src          # Rotate 'dst' left by 'src' bits
+      ror dst src          # Rotate 'dst' right by 'src' bits
+      rcl dst src          # Rotate 'dst' with Carry left by 'src' bits
+      rcr dst src          # Rotate 'dst' with Carry right by 'src' bits
+
+      mul src              # Multiplication of 'A' and 'src' into 'D'
+      div src              # Division of 'D' by 'src' into 'A', 'C'
+
+      zxt                  # Zero-extend 'B' to 'A'
+      sxt                  # Sign-extend 'B' to 'A'
+      int                  # Sign-extend 32 bits to 64 bits in 'A'
+
+      setc                 # Set Carry flag
+      clrc                 # Clear Carry flag
+      setz                 # Set Zero flag
+      clrz                 # Clear Zero flag
+
+   Comparisons:
+      cmp dst src          # Compare 'dst' with 'src'
+      cmp4 src             # Compare four bytes in 'A' with 'src'
+      cmpm dst src end     # Compare 'dst' with with memory between 'src' and 'end'
+      cmpn dst src cnt     # Compare 'cnt' bytes 'dst' with 'src'
+      slen dst src         # Set 'dst' to the string length of 'src'
+      memb src cnt         # Find B in 'cnt' bytes of memory
+      null src             # Compare 'src' with 0
+      zero src             # 'z' if ZERO
+      nul4                 # Compare four bytes in 'A' with 0
+
+   Byte addressing:
+      set dst src          # Set 'dst' byte to 'src'
+      nul src              # Compare byte 'src' with 0
+
+   Types:
+      cnt src              # Non-'z' if small number
+      big src              # Non-'z' if bignum
+      num src              # Non-'z' if number
+      sym src              # Non-'z' if symbol
+      atom src             # Non-'z' if atom
+
+   Flow Control:
+      jmp adr              # Jump to 'adr'
+      jz adr               # Jump to 'adr' if Zero
+      jnz adr              # Jump to 'adr' if not Zero
+      js adr               # Jump to 'adr' if Sign
+      jns adr              # Jump to 'adr' if not Sign
+      jc adr               # Jump to 'adr' if Carry
+      jnc adr              # Jump to 'adr' if not Carry
+
+      call adr             # Call 'adr'
+      cc adr(src ..)       # C-Call to 'adr' with 'src' arguments
+      cc adr reg           # C-Call to 'adr' with end of stacked args in 'reg'
+
+      ret                  # Return
+      begin src            # Called from C-function with 'src' arguments
+      return src           # Return to C-function
+
+   Stack Manipulations:
+      push src             # Push 'src'
+      pop dst              # Pop 'dst'
+      link                 # Setup frame
+      tuck src             # Extend frame
+      drop                 # Drop frame
+
+   Evaluation:
+      eval                 # Evaluate expression in 'E'
+      eval+                # Evaluate expression in partial stack frame
+      eval/ret             # Evaluate expression and return
+      exec reg             # Execute lists in 'reg', ignore results
+      prog reg             # Evaluate expressions in 'reg', return last result
+
+   System:
+      init                 # Init runtime system
+      dbg                  # Debug breakpoint
+
+========================================================================
+
+   Naming conventions:
+
+   Lisp level functions, which would be all of the form 'doXyzE_E', are written
+   as 'doXyz' for brevity.
diff --git a/doc64/structures b/doc64/structures
@@ -0,0 +1,308 @@
+# 06mar10abu
+# (c) Software Lab. Alexander Burger
+
+
+   ### Primary data types ###
+
+   cnt   xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxS010
+   big   xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxS100
+   sym   xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx1000
+   cell  xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx0000
+
+
+         Bignum
+         |
+         V
+      +-----+-----+
+      | DIG |  |  |
+      +-----+--+--+
+               |
+               V
+            +-----+-----+
+            | DIG |  |  |
+            +-----+--+--+
+                     |
+                     V
+                  +-----+-----+
+                  | DIG | CNT |
+                  +-----+-----+
+
+
+      Cell
+      |
+      V
+      +-----+-----+
+      | CAR | CDR |
+      +-----+-----+
+
+
+            Symbol
+            |
+            V
+      +-----+-----+                                +-----+-----+
+      |  |  | VAL |                                |'cba'|'fed'|
+      +--+--+-----+                                +-----+-----+
+         | tail                                       ^
+         |                                            |
+         V                                            | name
+         +-----+-----+     +-----+-----+     +-----+--+--+
+         |  |  |  ---+---> | KEY |  ---+---> |  |  |  |  |
+         +--+--+-----+     +-----+-----+     +--+--+-----+
+            |                                   |
+            V                                   V
+            +-----+-----+                       +-----+-----+
+            | VAL | KEY |                       | VAL | KEY |
+            +-----+-----+                       +-----+-----+
+
+
+      NIL:  /
+            |
+            V
+      +-----+-----+-----+-----+
+      |'LIN'|  /  |  /  |  /  |
+      +-----+--+--+-----+-----+
+
+
+   Symbol tail
+      Internal/Transient
+         0010 Short name
+         0100 Long name
+         0000 Properties
+
+      External
+         1010 Short name
+         1000 Properties
+
+   Name final short
+      Internals, Transients
+         0000.xxxxxxx.xxxxxxx.xxxxxxx.xxxxxxx.xxxxxxx.xxxxxxx.xxxxxxx0010
+           60      52      44      36      28      20      12       4
+
+      Externals
+         42 bit Object (4 Tera objects)
+         16 bit File (64 K files)
+          2 bit Status
+            Loaded    01........
+            Dirty     10........
+            Deleted   11........
+
+         1+2 Bytes: 1 file, 64K objects                  {177777}
+         1+3 Bytes: 16 files, 1M objects               {O3777777}
+         1+4 Bytes: 256 files, 16M objects           {OO77777777}
+         1+5 Bytes: 256 files, 4G objects         {OO37777777777}
+         1+6 Bytes: 65536 files, 4G objects     {OOOO37777777777}
+         1+8 Bytes: 65536 files, 4T objects  {OOOO77777777777777}
+         (2 + 10 + 8 + 12 + 8 + 20)
+         xx.xxxxxxxxx.xxxxxxx.xxxxxxxxxxx.xxxxxxx.xxxxxxxxxxxxxxxxxxxE010
+           obj       file    obj         file    obj
+                     ^6      ^5      ^4      ^3      ^2
+
+
+   ### Heap ###
+
+      Heaps       Avail
+      |           |
+      |           |  +-----------------------+
+      |           |  |                       |
+      V           V  |                       V
+      +-----+-----+--+--+-----+-----+-----+-----+-----+---     ---+-----+
+      |           |  |  |     |           |  /  |     |    ...    |  |  |
+      +-----+-----+-----+-----+-----+-----+-----+-----+---     ---+--+--+
+                                                                     |
+                                                                     |
+                                                                     +----->
+
+
+   ### Stack ###
+
+      Saved values:
+                        ^
+                        |
+         +---> LINK ----+
+         |     val1
+         |     val2
+         |     ...
+         |     valN
+         +---- LINK  <-- L
+
+
+      Bind frame:
+                        ^
+               Bind     |
+         +---> LINK ----+
+         |     val1
+         |     sym1
+         |     ...
+         |     valN
+         |     symN
+         +---- LINK  <-- L <-- Bind
+               eswp
+
+
+      VarArgs frame:
+                        ^
+               Bind     |
+         +---> LINK ----+
+         |     val1
+         |     sym1
+         |     ...
+         |     valN
+         |     symN
+         +---- LINK <---+  <-- Bind
+               eswp     |
+               Next     |
+               Args     |
+         +---> LINK ----+  <-- Next
+         |     arg1
+         |     ...
+         |     argN        <-- Args
+         +---- LINK  <-- L
+
+
+      Apply args:
+                        ^
+                        |
+         +---> LINK ----+
+         |     ...
+         |     fun         <-- Y
+         |     arg1
+         |     ...
+         |     argN        <-- Z
+         |     ...
+         +---- LINK <-- L
+
+
+      Apply frame:
+                        ^
+               Apply    |
+         +---> LINK ----+
+         |     ...
+         | +-- cdr
+         | |   fun         <-- exe
+         | |   val1 <-+       (gc)
+         | |   zero   |
+         | |   cdr1 --|---+   (gc)
+         | +-> car1 --+   |
+         |     ...        |
+         |     valN <-+   |   (gc)
+         |     zero   |   |
+         |     NIL    |   |   (gc)
+         |     carN --+ <-+
+         +---- LINK  <-- L <-- Apply
+
+
+      Method frame:
+                        ^
+               cls      |
+               key      |
+               LINK ----+  <-- Meth
+
+
+      Catch frame:
+                        ^
+               X        |
+               Y        |
+               Z        |
+               L        |
+         <III> [env]    |
+         <II>  fin      |
+         <I>   tag      |
+               LINK ----+  <-- Catch
+
+
+      I/O frame:
+                        ^
+         <III> put/get  |
+         <II>  pid      |
+         <I>   fd       |
+               LINK ----+  <-- inFrames, outFrames, ctlFrames
+
+
+
+   ### Memory ###
+
+      inFile:
+         -->   fd       # File descriptor
+         <I>   ix       # Read index
+         <II>  cnt      # Buffer count
+         <III> next     # Next character
+         <IV>  line     # Line number
+         <V>   src      # Source line number
+         <VI>  name     # Filename
+         <VII> buf      # Buffer [BUFSIZ]
+
+      outFile:
+         -->   fd       # File descriptor
+         <I>   ix       # Read index
+         <II>  tty      # TTY flag
+         <III> buf      # Buffer [BUFSIZ]
+
+
+      child:
+         -->   pid      # Process ID
+         <I>   hear     # Pipe read end
+         <II>  tell     # Pipe write end
+         <III> ofs      # Buffer offset
+         <IV>  cnt      # Buffer count
+         <V>   buf      # Buffer pointer
+
+                  +--------------------------+ Mic
+                  |
+                  |  +-----------------+ Tell         <Child>
+                  |  |
+                  |  +-----------------> Hear
+      <Parent>    |  |
+                  |  |
+         Spkr <---+  |
+                  |  |
+                  |  |
+                  |  +-----------------+ Tell
+                  |  |
+                  |  +-----------------> Hear         <Child>
+                  |
+                  +--------------------------+ Mic
+
+
+
+   ### Database file ###
+
+                  +-------------+-+-------------+-+----+
+      Block 0:    |   Free       0|   Next       0| << |
+                  +-------------+-+-------------+-+----+
+                  0               BLK                  2*Blk+1
+
+
+                  +-------------+-+
+      Free:       |   Link       0|
+                  +-------------+-+
+                  0
+
+
+                  +-------------+-+----
+      ID-Block:   |   Link       1| Data
+                  +-------------+-+----
+                  0              BLK
+
+
+                  +-------------+-+----
+      EXT-Block:  |   Link       n| Data
+                  +-------------+-+----
+                  0              BLK
+
+      dbFile:  # Size VIII (64 bytes)
+         -->   fd       # File descriptor
+         <I>   db       # File number
+         <II>  sh       # Block shift
+         <III> siz      # Block size (64 << sh)
+         <IV>  flgs     # Flags: Lock(0), Dirty(1)
+         <V>   marks    # Mark vector size
+         <VI>  mark     # Mark bit vector
+         <VII> fluse    # Free list use count
+
+
+   ### Assumptions ###
+
+   - 8 bit per byte
+   - 64 bit per word
+   - Stack grows downwards, aligned to 64 bit
+   - Memory access legal also at 4-byte boundaries
diff --git a/ext.l b/ext.l
@@ -0,0 +1,6 @@
+# 14apr10abu
+# (c) Software Lab. Alexander Burger
+
+(load "@lib/misc.l" "@lib/btree.l" "@lib/db.l" "@lib/pilog.l")
+
+# vi:et:ts=3:sw=3
diff --git a/favicon.ico b/favicon.ico
Binary files differ.
diff --git a/games/README b/games/README
@@ -0,0 +1,233 @@
+12nov09abu
+(c) Software Lab. Alexander Burger
+
+
+         PicoLisp Demo Games
+         ===================
+
+This directory contains a few simple games. They are neither especially
+interesting, nor powerful, but may be useful as programming examples.
+
+
+
+'mine' is a simplified version of the minesweeper game. You can start it as:
+
+$ ./dbg games/mine.l -main -go
+
+It will display a 12-by-12 field with 24 (default) hidden mines. You can move
+around using the standard 'vi'-keys 'j' (down), 'k' (up), 'l' (right) and 'h'
+(left).
+
+Hit ENTER or SPACE to uncover a field, and ESC to terminate the game. In the
+latter case (of if a mine exploded), you'll get the PicoLisp prompt. Then you
+can continue the game with
+
+: (go)
+
+possibly after re-initializing it with
+
+: (main)
+
+or exit the PicoLisp interpreter with ENTER.
+
+
+
+'nim' and 'ttt' are only testbeds for the general 'game' alpha-beta search
+function (normally, these games are better implemented by directly exploring
+their underlying principles and strategies).
+
+Start 'nim' as
+
+$ ./dbg games/nim.l
+
+and then find the optimal move path for, let's say, three heaps of four matches
+each:
+
+: (nim 4 4 4)
+-> (-100 ((1 . 4) 1 . -4) ((2 . 4) 2 . -4) ((3 . 4) 3 . -4))
+
+This is a winning position (a minimal cost of -100), with three moves (in the
+CARs of the move list: Take 4 from heap 1, then 4 from heap 2, and finally 4
+from heap 3).
+
+
+
+To play Tic-Tac-Toe, enter
+
+$ ./dbg games/ttt.l -main
+
+A three-by-three board is displayed. Enter your moves with the 'go' function:
+
+: (go a 1)
+   +---+---+---+
+ 3 |   |   |   |
+   +---+---+---+
+ 2 |   |   |   |
+   +---+---+---+
+ 1 | T |   |   |
+   +---+---+---+
+     a   b   c
+
+Your positions are marked with 'T', the computer's with '0'.
+
+
+
+The 'chess' game is minimalistic (441 lines of code). Nevertheless, it plays
+some slow - though correct - chess. Start it as:
+
+$ ./dbg games/chess.l -main
+   +---+---+---+---+---+---+---+---+
+ 8 |<R>|<N>|<B>|<Q>|<K>|<B>|<N>|<R>|
+   +---+---+---+---+---+---+---+---+
+ 7 |<P>|<P>|<P>|<P>|<P>|<P>|<P>|<P>|
+   +---+---+---+---+---+---+---+---+
+ 6 |   | - |   | - |   | - |   | - |
+   +---+---+---+---+---+---+---+---+
+ 5 | - |   | - |   | - |   | - |   |
+   +---+---+---+---+---+---+---+---+
+ 4 |   | - |   | - |   | - |   | - |
+   +---+---+---+---+---+---+---+---+
+ 3 | - |   | - |   | - |   | - |   |
+   +---+---+---+---+---+---+---+---+
+ 2 | P | P | P | P | P | P | P | P |
+   +---+---+---+---+---+---+---+---+
+ 1 | R | N | B | Q | K | B | N | R |
+   +---+---+---+---+---+---+---+---+
+     a   b   c   d   e   f   g   h
+
+The pieces are indicated by the letters 'K'ing, 'Q'ueen, 'R'ook, 'B'ishop,
+k'N'ight and 'P'awn, with black pieces in angular brackets.
+
+
+Alternatively, you can also run it through XBoard (in the X Window System):
+
+$ xboard -fcp games/xchess
+
+This requires the symbolic links in "/usr/lib/" and "/usr/bin/", as recommended
+in INSTALL. If this is not an option, please modify the first line ("#!") of
+"games/xchess".
+
+
+Without XBoard, you may enter your moves with the field names (in lower case)
+for the "from" and "to" positions:
+
+: (go e2 e4)
+
+Castling may be entered by just specifying the king's move:
+
+: (go e1 g1)
+
+To undo one or several moves, enter
+
+: (go -)
+
+and to redo them
+
+: (go +)
+
+To switch sides (and have the computer play against itself), call 'go' without
+arguments:
+
+: (go)
+
+The initial board position can be restored with
+
+: (main)
+
+The global variable '*Depth' holds the maximal depth of the alpha-beta tree
+search. It defaults to 5. You may change it to some smaller value for a faster
+response, or to a larger value for a deeper search:
+
+: (setq *Depth 7)
+
+The same effect can be achieved by passing the desired depth as the first
+argument to 'main':
+
+: (main 7)
+
+The second (optional) argument to 'main' is your color ('NIL' for white and 'T'
+for black).
+
+To setup some given board position, call 'main' with a list of triples, with
+each describing:
+
+   1. The field
+   2. The piece's classes
+   3. An optional flag to indicate that the piece did not move yet
+
+: (main 5 NIL
+   (quote
+      (a2 (+White +Pawn) T)
+      (b1 (+White +King))
+      (d4 (+Black +King)) ) )
+   +---+---+---+---+---+---+---+---+
+ 8 |   | - |   | - |   | - |   | - |
+   +---+---+---+---+---+---+---+---+
+ 7 | - |   | - |   | - |   | - |   |
+   +---+---+---+---+---+---+---+---+
+ 6 |   | - |   | - |   | - |   | - |
+   +---+---+---+---+---+---+---+---+
+ 5 | - |   | - |   | - |   | - |   |
+   +---+---+---+---+---+---+---+---+
+ 4 |   | - |   |<K>|   | - |   | - |
+   +---+---+---+---+---+---+---+---+
+ 3 | - |   | - |   | - |   | - |   |
+   +---+---+---+---+---+---+---+---+
+ 2 | P | - |   | - |   | - |   | - |
+   +---+---+---+---+---+---+---+---+
+ 1 | - | K | - |   | - |   | - |   |
+   +---+---+---+---+---+---+---+---+
+     a   b   c   d   e   f   g   h
+
+At any time, you can print the current board position in the above format to a
+file with
+
+: (ppos "file")
+
+which later can be restored with
+
+: (load "file")
+
+
+
+There is also a plain 'sudoku' solver:
+
+$ ./dbg games/sudoku.l
+
+: (main
+   (quote
+      (5 3 0 0 7 0 0 0 0)
+      (6 0 0 1 9 5 0 0 0)
+      (0 9 8 0 0 0 0 6 0)
+      (8 0 0 0 6 0 0 0 3)
+      (4 0 0 8 0 3 0 0 1)
+      (7 0 0 0 2 0 0 0 6)
+      (0 6 0 0 0 0 2 8 0)
+      (0 0 0 4 1 9 0 0 5)
+      (0 0 0 0 8 0 0 7 9) ) )
+   +---+---+---+---+---+---+---+---+---+
+ 9 | 5   3     |     7     |           |
+   +   +   +   +   +   +   +   +   +   +
+ 8 | 6         | 1   9   5 |           |
+   +   +   +   +   +   +   +   +   +   +
+ 7 |     9   8 |           |     6     |
+   +---+---+---+---+---+---+---+---+---+
+ 6 | 8         |     6     |         3 |
+   +   +   +   +   +   +   +   +   +   +
+ 5 | 4         | 8       3 |         1 |
+   +   +   +   +   +   +   +   +   +   +
+ 4 | 7         |     2     |         6 |
+   +---+---+---+---+---+---+---+---+---+
+ 3 |     6     |           | 2   8     |
+   +   +   +   +   +   +   +   +   +   +
+ 2 |           | 4   1   9 |         5 |
+   +   +   +   +   +   +   +   +   +   +
+ 1 |           |     8     |     7   9 |
+   +---+---+---+---+---+---+---+---+---+
+     a   b   c   d   e   f   g   h   i
+
+Type
+
+: (go)
+
+to let it search for a solution.
diff --git a/games/chess.l b/games/chess.l
@@ -0,0 +1,566 @@
+# 04aug07abu
+# (c) Software Lab. Alexander Burger
+
+# *Board a1 .. h8
+# *White *Black *WKPos *BKPos *Pinned
+# *Depth *Moved *Undo *Redo *Me *You
+
+(load "@lib/simul.l")
+
+### Fields/Board ###
+# x y color piece whAtt blAtt
+
+(setq *Board (grid 8 8))
+
+(for (X . Lst) *Board
+   (for (Y . This) Lst
+      (=: x X)
+      (=: y Y)
+      (=: color (not (bit? 1 (+ X Y)))) ) )
+
+(de *Straight `west `east `south `north)
+
+(de *Diagonal
+   ((This) (: 0 1  1  0 -1  1))   # Southwest
+   ((This) (: 0 1  1  0 -1 -1))   # Northwest
+   ((This) (: 0 1 -1  0 -1  1))   # Southeast
+   ((This) (: 0 1 -1  0 -1 -1)) ) # Northeast
+
+(de *DiaStraight
+   ((This) (: 0 1  1  0 -1  1  0 -1  1))   # South Southwest
+   ((This) (: 0 1  1  0 -1  1  0  1  1))   # West Southwest
+   ((This) (: 0 1  1  0 -1 -1  0  1  1))   # West Northwest
+   ((This) (: 0 1  1  0 -1 -1  0 -1 -1))   # North Northwest
+   ((This) (: 0 1 -1  0 -1 -1  0 -1 -1))   # North Northeast
+   ((This) (: 0 1 -1  0 -1 -1  0  1 -1))   # East Northeast
+   ((This) (: 0 1 -1  0 -1  1  0  1 -1))   # East Southeast
+   ((This) (: 0 1 -1  0 -1  1  0 -1  1)) ) # South Southeast
+
+
+### Pieces ###
+(de piece (Typ Cnt Fld)
+   (prog1
+      (def
+         (pack (mapcar '((Cls) (cdr (chop Cls))) Typ))
+         Typ )
+      (init> @ Cnt Fld) ) )
+
+
+(class +White)
+# color ahead
+
+(dm init> (Cnt Fld)
+   (=: ahead north)
+   (extra Cnt Fld) )
+
+(dm name> ()
+   (pack " " (extra) " ") )
+
+(dm move> (Fld)
+   (adjMove '*White '*WKPos whAtt- whAtt+) )
+
+
+(class +Black)
+# color ahead
+
+(dm init> (Cnt Fld)
+   (=: color T)
+   (=: ahead south)
+   (extra Cnt Fld) )
+
+(dm name> ()
+   (pack '< (extra) '>) )
+
+(dm move> (Fld)
+   (adjMove '*Black '*BKPos blAtt- blAtt+) )
+
+
+(class +piece)
+# cnt field attacks
+
+(dm init> (Cnt Fld)
+   (=: cnt Cnt)
+   (move> This Fld) )
+
+(dm ctl> ())
+
+
+(class +King +piece)
+
+(dm name> () 'K)
+
+(dm val> () 120)
+
+(dm ctl> ()
+   (unless (=0 (: cnt)) -10) )
+
+(dm moves> ()
+   (make
+      (unless
+         (or
+            (n0 (: cnt))
+            (get (: field) (if (: color) 'whAtt 'blAtt)) )
+         (tryCastle west T)
+         (tryCastle east) )
+      (try1Move *Straight)
+      (try1Move *Diagonal) ) )
+
+(dm attacks> ()
+   (make
+      (try1Attack *Straight)
+      (try1Attack *Diagonal) ) )
+
+
+(class +Castled)
+
+(dm ctl> () 30)
+
+
+(class +Queen +piece)
+
+(dm name> () 'Q)
+
+(dm val> () 95)
+
+(dm moves> ()
+   (make
+      (tryMoves *Straight)
+      (tryMoves *Diagonal) ) )
+
+(dm attacks> ()
+   (make
+      (tryAttacks *Straight)
+      (tryAttacks *Diagonal T) ) )
+
+
+(class +Rook +piece)
+
+(dm name> () 'R)
+
+(dm val> () 50)
+
+(dm moves> ()
+   (make (tryMoves *Straight)) )
+
+(dm attacks> ()
+   (make (tryAttacks *Straight)) )
+
+
+(class +Bishop +piece)
+
+(dm name> () 'B)
+
+(dm val> () 33)
+
+(dm ctl> ()
+   (when (=0 (: cnt)) -10) )
+
+(dm moves> ()
+   (make (tryMoves *Diagonal)) )
+
+(dm attacks> ()
+   (make (tryAttacks *Diagonal T)) )
+
+
+(class +Knight +piece)
+
+(dm name> () 'N)
+
+(dm val> () 33)
+
+(dm ctl> ()
+   (when (=0 (: cnt)) -10) )
+
+(dm moves> ()
+   (make (try1Move *DiaStraight)) )
+
+(dm attacks> ()
+   (make (try1Attack *DiaStraight)) )
+
+
+(class +Pawn +piece)
+
+(dm name> () 'P)
+
+(dm val> () 10)
+
+(dm moves> ()
+   (let (Fld1 ((: ahead) (: field))  Fld2 ((: ahead) Fld1))
+      (make
+         (and
+            (tryPawnMove Fld1 Fld2)
+            (=0 (: cnt))
+            (tryPawnMove Fld2 T) )
+         (tryPawnCapt (west Fld1) Fld2 (west (: field)))
+         (tryPawnCapt (east Fld1) Fld2 (east (: field))) ) ) )
+
+(dm attacks> ()
+   (let Fld ((: ahead) (: field))
+      (make
+         (and (west Fld) (link @))
+         (and (east Fld) (link @)) ) ) )
+
+
+### Move Logic ###
+(de inCheck (Color)
+   (if Color (get *BKPos 'whAtt) (get *WKPos 'blAtt)) )
+
+(de whAtt+ (This Pce)
+   (=: whAtt (cons Pce (: whAtt))) )
+
+(de whAtt- (This Pce)
+   (=: whAtt (delq Pce (: whAtt))) )
+
+(de blAtt+ (This Pce)
+   (=: blAtt (cons Pce (: blAtt))) )
+
+(de blAtt- (This Pce)
+   (=: blAtt (delq Pce (: blAtt))) )
+
+(de adjMove (Var KPos Att- Att+)
+   (let (W (: field whAtt)  B (: field blAtt))
+      (when (: field)
+         (put @ 'piece NIL)
+         (for F (: attacks) (Att- F This)) )
+      (nond
+         (Fld (set Var (delq This (val Var))))
+         ((: field) (push Var This)) )
+      (ifn (=: field Fld)
+         (=: attacks)
+         (put Fld 'piece This)
+         (and (isa '+King This) (set KPos Fld))
+         (for F (=: attacks (attacks> This)) (Att+ F This)) )
+      (reAtttack W (: field whAtt) B (: field blAtt)) ) )
+
+(de reAtttack (W W2 B B2)
+   (for This W
+      (unless (memq This W2)
+         (for F (: attacks) (whAtt- F This))
+         (for F (=: attacks (attacks> This)) (whAtt+ F This)) ) )
+   (for This W2
+      (for F (: attacks) (whAtt- F This))
+      (for F (=: attacks (attacks> This)) (whAtt+ F This)) )
+   (for This B
+      (unless (memq This B2)
+         (for F (: attacks) (blAtt- F This))
+         (for F (=: attacks (attacks> This)) (blAtt+ F This)) ) )
+   (for This B2
+      (for F (: attacks) (blAtt- F This))
+      (for F (=: attacks (attacks> This)) (blAtt+ F This)) ) )
+
+(de try1Move (Lst)
+   (for Dir Lst
+      (let? Fld (Dir (: field))
+         (ifn (get Fld 'piece)
+            (link (list This (cons This Fld)))
+            (unless (== (: color) (get @ 'color))
+               (link
+                  (list This
+                     (cons (get Fld 'piece))
+                     (cons This Fld) ) ) ) ) ) ) )
+
+(de try1Attack (Lst)
+   (for Dir Lst
+      (and (Dir (: field)) (link @)) )  )
+
+(de tryMoves (Lst)
+   (for Dir Lst
+      (let Fld (: field)
+         (loop
+            (NIL (setq Fld (Dir Fld)))
+            (T (get Fld 'piece)
+               (unless (== (: color) (get @ 'color))
+                  (link
+                     (list This
+                        (cons (get Fld 'piece))
+                        (cons This Fld) ) ) ) )
+            (link (list This (cons This Fld))) ) ) ) )
+
+(de tryAttacks (Lst Diag)
+   (use (Pce Cls Fld2)
+      (for Dir Lst
+         (let Fld (: field)
+            (loop
+               (NIL (setq Fld (Dir Fld)))
+               (link Fld)
+               (T
+                  (and
+                     (setq Pce (get Fld 'piece))
+                     (<> (: color) (get Pce 'color)) ) )
+               (T (== '+Pawn (setq Cls (last (type Pce))))
+                  (and
+                     Diag
+                     (setq Fld2 (Dir Fld))
+                     (= (get Fld2 'y) (get ((get Pce 'ahead) Fld) 'y))
+                     (link Fld2) ) )
+               (T (memq Cls '(+Knight +Queen +King)))
+               (T (and Pce (xor Diag (== Cls '+Bishop)))) ) ) ) ) )
+
+(de tryPawnMove (Fld Flg)
+   (unless (get Fld 'piece)
+      (if Flg
+         (link (list This (cons This Fld)))
+         (for Cls '(+Queen +Knight +Rook +Bishop)
+            (link
+               (list This
+                  (cons This)
+                  (cons
+                     (piece (list (car (type This)) Cls) (: cnt))
+                     Fld ) ) ) ) ) ) )
+
+(de tryPawnCapt (Fld1 Flg Fld2)
+   (if (get Fld1 'piece)
+      (unless (== (: color) (get @ 'color))
+         (if Flg
+            (link
+               (list This
+                  (cons (get Fld1 'piece))
+                  (cons This Fld1) ) )
+            (for Cls '(+Queen +Knight +Rook +Bishop)
+               (link
+                  (list This
+                     (cons (get Fld1 'piece))
+                     (cons This)
+                     (cons
+                        (piece (list (car (type This)) Cls) (: cnt))
+                        Fld1 ) ) ) ) ) )
+      (let? Pce (get Fld2 'piece)
+         (and
+            (== Pce (car *Moved))
+            (= 1 (get Pce 'cnt))
+            (isa '+Pawn Pce)
+            (n== (: color) (get Pce 'color))
+            (link (list This (cons Pce) (cons This Fld1))) ) ) ) )
+
+(de tryCastle (Dir Long)
+   (use (Fld1 Fld2 Fld Pce)
+      (or
+         (get (setq Fld1 (Dir (: field))) 'piece)
+         (get Fld1 (if (: color) 'whAtt 'blAtt))
+         (get (setq Fld2 (Dir Fld1)  Fld Fld2) 'piece)
+         (when Long
+            (or
+               (get (setq Fld (Dir Fld)) 'piece)
+               (get Fld (if (: color) 'whAtt 'blAtt)) ) )
+         (and
+            (== '+Rook (last (type (setq Pce (get (Dir Fld) 'piece)))))
+            (=0 (get Pce 'cnt))
+            (link
+               (list This
+                  (cons This)
+                  (cons
+                     (piece (cons (car (type This)) '(+Castled +King)) 1)
+                     Fld2 )
+                  (cons Pce Fld1) ) ) ) ) ) )
+
+(de pinned (Fld Lst Color)
+   (use (Pce L P)
+      (and
+         (loop
+            (NIL (setq Fld (Dir Fld)))
+            (T (setq Pce (get Fld 'piece))
+               (and
+                  (= Color (get Pce 'color))
+                  (setq L
+                     (make
+                        (loop
+                           (NIL (setq Fld (Dir Fld)))
+                           (link Fld)
+                           (T (setq P (get Fld 'piece))) ) ) )
+                  (<> Color (get P 'color))
+                  (memq (last (type P)) Lst)
+                  (cons Pce L) ) ) )
+         (link @) ) ) )
+
+
+### Moves ###
+# Move      ((p1 (p1 . f2))        . ((p1 . f1)))
+# Capture   ((p1 (p2) (p1 . f2))   . ((p1 . f1) (p2 . f2)))
+# Castle    ((K (K) (C . f2) (R . f4)) . ((R . f3) (K . f1)))
+# Promote   ((P (P) (Q . f2))      . ((Q) (P . f1)))
+# Capt/Prom ((P (p1) (P) (Q . f2)) . ((Q) (P . f2) (p1 . f1)))
+(de moves (Color)
+   (filter
+      '((Lst)
+         (prog2
+            (move (car Lst))
+            (not (inCheck Color))
+            (move (cdr Lst)) ) )
+      (mapcan
+         '((Pce)
+            (mapcar
+               '((Lst)
+                  (cons Lst
+                     (flip
+                        (mapcar
+                           '((Mov) (cons (car Mov) (get Mov 1 'field)))
+                           (cdr Lst) ) ) ) )
+               (moves> Pce) ) )
+         (if Color *Black *White) ) ) )
+
+(de move (Lst)
+   (if (atom (car Lst))
+      (inc (prop (push '*Moved (pop 'Lst)) 'cnt))
+      (dec (prop (pop '*Moved) 'cnt)) )
+   (for Mov Lst
+      (move> (car Mov) (cdr Mov)) ) )
+
+
+### Evaluation ###
+(de mate (Color)
+   (and (inCheck Color) (not (moves Color))) )
+
+(de battle (Fld Prey Attacker Defender)
+   (use Pce
+      (loop
+         (NIL (setq Pce (mini 'val> Attacker)) 0)
+         (setq Attacker (delq Pce Attacker))
+         (NIL (and (asoq Pce *Pinned) (not (memq Fld @)))
+            (max 0 (- Prey (battle Fld (val> Pce) Defender Attacker))) ) ) ) )
+
+# Ref. Sargon, Dan and Kate Spracklen, Hayden 1978
+(de cost (Color)
+   (if (mate (not Color))
+      -9999
+      (setq *Pinned
+         (make
+            (for Dir *Straight
+               (pinned *WKPos '(+Rook +Queen))
+               (pinned *BKPos '(+Rook +Queen) T) )
+            (for Dir *Diagonal
+               (pinned *WKPos '(+Bishop +Queen))
+               (pinned *BKPos '(+Bishop +Queen) T) ) ) )
+      (let (Ctl 0  Mat 0  Lose 0  Win1 NIL  Win2 NIL  Flg NIL)
+         (use (White Black Col Same B)
+            (for Lst *Board
+               (for This Lst
+                  (setq White (: whAtt)  Black (: blAtt))
+                  ((if Color inc dec) 'Ctl (- (length White) (length Black)))
+                  (let? Val (and (: piece) (val> @))
+                     (setq Col (: piece color)  Same (== Col Color))
+                     ((if Same dec inc) 'Ctl (ctl> (: piece)))
+                     (unless
+                        (=0
+                           (setq B
+                              (if Col
+                                 (battle This Val White Black)
+                                 (battle This Val Black White) ) ) )
+                        (dec 'Val 5)
+                        (if Same
+                           (setq
+                              Lose (max Lose B)
+                              Flg (or Flg (== (: piece) (car *Moved))) )
+                           (when (> B Win1)
+                              (xchg 'B 'Win1)
+                              (setq Win2 (max Win2 B)) ) ) )
+                     ((if Same dec inc) 'Mat Val) ) ) ) )
+         (unless (=0 Lose) (dec 'Lose 5))
+         (if Flg
+            (* 4 (+ Mat Lose))
+            (when Win2
+               (dec 'Lose (>> 1 (- Win2 5))) )
+            (+ Ctl (* 4 (+ Mat Lose))) ) ) ) )
+
+
+### Game ###
+(de display (Res)
+   (when Res
+      (disp *Board T
+         '((This)
+            (cond
+               ((: piece) (name> @))
+               ((: color) " - ")
+               (T "   ") ) ) ) )
+   (and (inCheck *You) (prinl "(+)"))
+   Res )
+
+(de moved? (Lst)
+   (or
+      (> 16 (length Lst))
+      (find '((This) (n0 (: cnt))) Lst) ) )
+
+(de bookMove (From To)
+   (let Pce (get From 'piece)
+      (list 0 (list (list Pce (cons Pce To)) (cons Pce From))) ) )
+
+(de myMove ()
+   (let? M
+      (cond
+         ((moved? (if *Me *Black *White))
+            (game *Me *Depth moves move cost) )
+         (*Me
+            (if (member (get *Moved 1 'field 'x) (1 2 3 5))
+               (bookMove 'e7 'e5)
+               (bookMove 'd7 'd5) ) )
+         ((rand T) (bookMove 'e2 'e4))
+         (T (bookMove 'd2 'd4)) )
+      (move (car (push '*Undo (cadr M))))
+      (off *Redo)
+      (cons (car M) (mapcar cdar (cdr M))) ) )
+
+(de yourMove (From To)
+   (when
+      (find
+         '((Lst)
+            (and
+               (== (caar Lst) (get From 'piece))
+               (== To (pick cdr (cdar Lst))) ) )
+         (moves *You) )
+      (prog1
+         (car (push '*Undo @))
+         (off *Redo)
+         (move @) ) ) )
+
+(de undo ()
+   (move (cdr (push '*Redo (pop '*Undo)))) )
+
+(de redo ()
+   (move (car (push '*Undo (pop '*Redo)))) )
+
+(de setup (Depth You Init)
+   (setq *Depth (or Depth 5)  *You You  *Me (not You))
+   (off *White *Black *Moved *Undo *Redo)
+   (for Lst *Board
+      (for This Lst (=: piece) (=: whAtt) (=: blAtt)) )
+   (if Init
+      (for L Init
+         (with (piece (cadr L) 0 (car L))
+            (unless (caddr L)
+               (=: cnt 1)
+               (push '*Moved This) ) ) )
+      (mapc
+         '((Cls Lst)
+            (piece (list '+White Cls) 0 (car Lst))
+            (piece '(+White +Pawn) 0 (cadr Lst))
+            (piece '(+Black +Pawn) 0 (get Lst 7))
+            (piece (list '+Black Cls) 0 (get Lst 8)) )
+         '(+Rook +Knight +Bishop +Queen +King +Bishop +Knight +Rook)
+         *Board ) ) )
+
+(de main (Depth You Init)
+   (setup Depth You Init)
+   (display T) )
+
+(de go Args
+   (display
+      (cond
+         ((not Args) (xchg '*Me '*You) (myMove))
+         ((== '- (car Args)) (and *Undo (undo)))
+         ((== '+ (car Args)) (and *Redo (redo)))
+         ((yourMove (car Args) (cadr Args)) (display T) (myMove)) ) ) )
+
+# Print position to file
+(de ppos (File)
+   (out File
+      (println
+         (list 'main *Depth *You
+            (lit
+               (mapcar
+                  '((This)
+                     (list
+                        (: field)
+                        (val This)
+                        (not (memq This *Moved)) ) )
+                  (append *White *Black) ) ) ) ) ) )
+
+# vi:et:ts=3:sw=3
diff --git a/games/mine.l b/games/mine.l
@@ -0,0 +1,126 @@
+# 22mar10abu
+# (c) Software Lab. Alexander Burger
+
+(load "lib/term.l")
+
+# Spielfeldbelegung:
+# NIL    Verdeckt: Leeres Feld
+# T      Verdeckt: Mine
+# 0-8    Aufgedeckt, Nachbarminen
+
+(seed (in "/dev/urandom" (rd 8)))
+
+# Globale Konstanten
+(de *Minen . 24)  # Anzahl der Minen
+(de *FeldX . 12)  # Feldgroesse X
+(de *FeldY . 12)  # Feldgroesse Y
+
+(de *NachbarX -1  0 +1 -1  +1 -1  0 +1)
+(de *NachbarY -1 -1 -1  0   0 +1 +1 +1)
+
+# Globale Variablen
+(de *Feld)        # Datenbereich des Minenfeldes
+
+
+# Eine Mine legen
+(de legeMine ()
+   (use (X Y)
+      (while
+         (get *Feld
+            (setq Y (rand 1 *FeldY))
+            (setq X (rand 1 *FeldX)) ) )
+      (set (nth *Feld Y X) T) ) )
+
+# *Feld anzeigen
+(de anzeigen (Flg)
+   (let (N 0 Y 0)
+      (for L *Feld
+         (prin (align 2 (inc 'Y)) " ")
+         (for C L
+            (prin
+               " "
+               (cond
+                  ((not C) (inc 'N) "-")
+                  (Flg C)
+                  ((=T C) "-")
+                  (T C) ) ) )
+         (prinl) )
+      (prin "   ")
+      (for C *FeldX
+         (prin " " (char (+ 64 C))) )
+      (prinl)
+      (prinl "<" N ">  ") ) )
+
+# Ein Feld ausrechnen
+(de wertFeld (X Y)
+   (when
+      (=0
+         (set
+            (nth *Feld Y X)
+            (sum
+               '((DX DY)
+                  (if (=T (get *Feld (+ Y DY) (+ X DX)))
+                     1 0 ) )
+               *NachbarX
+               *NachbarY ) ) )
+      (mapc
+         '((DX DY)
+            (and
+               (<= 1 (inc 'DX X) *FeldX)
+               (<= 1 (inc 'DY Y) *FeldY)
+               (not (member (cons DX DY) *Visit))
+               (push '*Visit (cons DX DY))
+               (wertFeld DX DY) ) )
+         *NachbarX
+         *NachbarY ) ) )
+
+# Hauptfunktion
+(de main (N)
+   (when N
+      (setq *Minen N) )
+   (setq *Feld
+      (make (do *FeldY (link (need *FeldX)))) )
+   (do *Minen (legeMine)) )
+
+(de go ()
+   (use (K X Y)
+      (anzeigen)
+      (xtUp (+ 2 *FeldY))
+      (xtRight 4)
+      (one X Y)
+      (catch NIL
+         (until (= "^[" (setq K (key)))
+            (case K
+               ("j"
+                  (unless (= Y *FeldY)
+                     (xtDown 1)
+                     (inc 'Y) ) )
+               ("k"
+                  (unless (= Y 1)
+                     (xtUp 1)
+                     (dec 'Y) ) )
+               ("l"
+                  (unless (= X *FeldX)
+                     (xtRight 2)
+                     (inc 'X) ) )
+               ("h"
+                  (unless (= X 1)
+                     (xtLeft 2)
+                     (dec 'X) ) )
+               ((" " "^J" "^M")
+                  (xtLeft (+ 2 (* 2 X)))
+                  (xtUp (dec Y))
+                  (when (=T (get *Feld Y X))
+                     (anzeigen T)
+                     (prinl "*** BUMM ***")
+                     (throw) )
+                  (let *Visit NIL
+                     (wertFeld X Y) )
+                  (anzeigen)
+                  (unless (find '((L) (memq NIL L)) *Feld)
+                     (prinl ">>> Gewonnen! <<<")
+                     (throw) )
+                  (xtUp (- *FeldY Y -3))
+                  (xtRight (+ 2 (* 2 X))) ) ) )
+         (xtLeft (+ 2 (* 2 X)))
+         (xtDown (+ 3 (- *FeldY Y))) ) ) )
diff --git a/games/nim.l b/games/nim.l
@@ -0,0 +1,27 @@
+# 31jan08abu
+# (c) Software Lab. Alexander Burger
+
+(load "lib/simul.l")
+
+# Nim
+(de nim Pos
+   (game T NIL
+      '((Flg)  # Moves
+         (make
+            (for (I . N) Pos
+               (do N
+                  (link
+                     (cons (cons I N) I (- N)) )
+                  (dec 'N) ) ) ) )
+      '((Mov)  # Move
+         (dec (nth Pos (car Mov)) (cdr Mov)) )
+      '((Flg)  # Cost
+         (let N (apply + Pos)
+            (if (=0 N) -100 N) ) ) ) )
+
+### Test ###
+(test
+   '(-100 ((1 . 4) 1 . -4) ((2 . 4) 2 . -4) ((3 . 4) 3 . -4))
+   (nim 4 4 4) )
+
+# vi:et:ts=3:sw=3
diff --git a/games/sudoku.l b/games/sudoku.l
@@ -0,0 +1,73 @@
+# 21jan07abu
+# (c) Software Lab. Alexander Burger
+
+(load "lib/simul.l")
+
+### Fields/Board ###
+# val lst
+
+(setq
+   *Board (grid 9 9)
+   *Fields (apply append *Board) )
+
+# Init values to zero (empty)
+(for L *Board
+   (for This L
+      (=: val 0) ) )
+
+# Build lookup lists
+(for (X . L) *Board
+   (for (Y . This) L
+      (=: lst
+         (make
+            (let A (* 3 (/ (dec X) 3))
+               (do 3
+                  (inc 'A)
+                  (let B (* 3 (/ (dec Y) 3))
+                     (do 3
+                        (inc 'B)
+                        (unless (and (= A X) (= B Y))
+                           (link
+                              (prop (get *Board A B) 'val) ) ) ) ) ) )
+            (for Dir '(`west `east `south `north)
+               (for (This (Dir This)  This  (Dir This))
+                  (unless (memq (:: val) (made))
+                     (link (:: val)) ) ) ) ) ) ) )
+
+# Cut connections (for display only)
+(for (X . L) *Board
+   (for (Y . This) L
+      (when (member X (3 6))
+         (con (car (val This))) )
+      (when (member Y (4 7))
+         (set (cdr (val This))) ) ) )
+
+# Display board
+(de display ()
+   (disp *Board 0
+      '((This)
+         (if (=0 (: val))
+            "   "
+            (pack " " (: val) " ") ) ) ) )
+
+# Initialize board
+(de main (Lst)
+   (for (Y . L) Lst
+      (for (X . N) L
+         (put *Board X (- 10 Y) 'val N) ) )
+   (display) )
+
+# Find solution
+(de go ()
+   (unless
+      (recur (*Fields)
+         (with (car *Fields)
+            (if (=0 (: val))
+               (loop
+                  (NIL
+                     (or
+                        (assoc (inc (:: val)) (: lst))
+                        (recurse (cdr *Fields)) ) )
+                  (T (= 9 (: val)) (=: val 0)) )
+               (recurse (cdr *Fields)) ) ) )
+      (display) ) )
diff --git a/games/ttt.l b/games/ttt.l
@@ -0,0 +1,72 @@
+# 15may07abu
+# (c) Software Lab. Alexander Burger
+
+# *Board
+
+(load "lib/simul.l")
+
+(de display ()
+   (for Y (3 2 1)
+      (prinl "   +---+---+---+")
+      (prin " " Y)
+      (for X (1 2 3)
+         (prin " | " (or (get *Board X Y) " ")) )
+      (prinl " |") )
+   (prinl "   +---+---+---+")
+   (prinl "     a   b   c") )
+
+(de find3 (P)
+   (find
+      '((X Y DX DY)
+         (do 3
+            (NIL (= P (get *Board X Y)))
+            (inc 'X DX)
+            (inc 'Y DY)
+            T ) )
+      (1 1 1 1 2 3 1 1)
+      (1 2 3 1 1 1 1 3)
+      (1 1 1 0 0 0 1 1)
+      (0 0 0 1 1 1 1 -1) ) )
+
+(de myMove ()
+   (when
+      (game NIL 8
+         '((Flg)     # Moves
+            (unless (find3 (or (not Flg) 0))
+               (make
+                  (for (X . L) *Board
+                     (for (Y . P) L
+                        (unless P
+                           (link
+                              (cons
+                                 (cons X Y (or Flg 0))
+                                 (list X Y) ) ) ) ) ) ) ) )
+         '((Mov) # Move
+            (set (nth *Board (car Mov) (cadr Mov)) (cddr Mov)) )
+         '((Flg)     # Cost
+            (if (find3 (or Flg 0)) -100 0) ) )
+      (let Mov (caadr @)
+         (set (nth *Board (car Mov) (cadr Mov)) 0) )
+      (display) ) )
+
+(de yourMove (X Y)
+   (and
+      (sym? X)
+      (>= 3 (setq X (- (char X) 96)) 1)
+      (num? Y)
+      (>= 3 Y 1)
+      (not (get *Board X Y))
+      (set (nth *Board X Y) T)
+      (display) ) )
+
+(de main ()
+   (setq *Board (make (do 3 (link (need 3)))))
+   (display) )
+
+(de go Args
+   (cond
+      ((not (yourMove (car Args) (cadr Args)))
+         "Illegal move!" )
+      ((find3 T) "Congratulation, you won!")
+      ((not (myMove)) "No moves")
+      ((find3 0) "Sorry, you lost!") ) )
diff --git a/games/xchess b/games/xchess
@@ -0,0 +1,49 @@
+#!/usr/bin/picolisp /usr/lib/picolisp/lib.l
+# 12nov09abu
+# (c) Software Lab. Alexander Burger
+
+(load "@games/chess.l")
+
+(de reply @
+   (prinl (glue " " (rest)))
+   (flush) )
+
+(de xmove ()
+   (when (myMove)
+      (let L (car *Undo)
+         (reply "move"
+            (pack
+               (cdr (assoc (caar L) (cdr L)))
+               (pick cdr (cdar L)) ) ) ) ) )
+
+(in NIL
+   (loop
+      (case (read)
+         (protover
+            (read)
+            (reply "feature" "myname=\"PicoLisp Chess\"")
+            (reply "feature" "time=0" "sigint=0" "usermove=1")
+            (reply "feature" "done=1") )
+         (accepted (read))
+         (new
+            (seed (in "/dev/urandom" (rd 3)))
+            (setup (format (sys "XCHESS_DEPTH"))) )
+         (level (line T))
+         (sd (setup (read)))
+         (black (off *Me) (on *You))
+         (white (on *Me) (off *You))
+         (usermove
+            (let (L (line)  From (pack (head 2 L))  To (pack (head 2 (cddr L)))  F (get L 5))
+               (if (and (yourMove (intern From) (intern To)) (or (not F) (= "q" F)))
+                  (xmove)
+                  (reply "Illegal move:" (pack L)) ) ) )
+         (go (xchg '*Me '*You) (xmove))
+         (undo (undo))
+         (remove (undo) (undo))
+         (result (line T))
+         (random)
+         (hard)
+         (quit (bye))
+         (T (reply "Error (unknown command):" @)) ) ) )
+
+# vi:et:ts=3:sw=3
diff --git a/img/7fach.eps b/img/7fach.eps
@@ -0,0 +1,474 @@
+%!PS-Adobe-3.0 EPSF-3.0
+%%For: Josef Bartl
+%%CreationDate: Tue Feb 18 11:34:19 2003
+%%Title: 7fach.eps
+%%Creator: Sketch 0.6.7
+%%Pages: 1
+%%BoundingBox: 35 63 232 148
+%%Extensions: CMYK
+%%DocumentSuppliedResources: (atend)
+%%DocumentNeededResources: font NewCenturySchlbk-Italic
+%%EndComments
+
+%%BeginProlog
+%%BeginResource: procset Linux-Sketch-Procset 1.0 2
+/SketchDict 100 dict def
+SketchDict begin
+/bd { bind def } bind def
+/x { exch } bd
+/xd { exch def } bd
+/PI 3.14159265358979323846264338327 def
+/radgrad { 180 mul PI div } bd
+/skstartmatrix matrix currentmatrix def
+/tmpmat matrix def
+/ISOLatin1Encoding dup where
+{ pop pop }
+{  [/.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef
+/.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef
+/.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef
+/.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef
+/.notdef /space /exclam /quotedbl /numbersign /dollar /percent /ampersand
+/quoteright /parenleft /parenright /asterisk /plus /comma /minus /period
+/slash /zero /one /two /three /four /five /six /seven /eight /nine /colon
+/semicolon /less /equal /greater /question /at /A /B /C /D /E /F /G /H /I /J
+/K /L /M /N /O /P /Q /R /S /T /U /V /W /X /Y /Z /bracketleft /backslash
+/bracketright /asciicircum /underscore /quoteleft /a /b /c /d /e /f /g /h /i
+/j /k /l /m /n /o /p /q /r /s /t /u /v /w /x /y /z /braceleft /bar /braceright
+/asciitilde /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef
+/.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef
+/.notdef /.notdef /dotlessi /grave /acute /circumflex /tilde /macron /breve
+/dotaccent /dieresis /.notdef /ring /cedilla /.notdef /hungarumlaut /ogonek
+/caron /space /exclamdown /cent /sterling /currency /yen /brokenbar /section
+/dieresis /copyright /ordfeminine /guillemotleft /logicalnot /hyphen
+/registered /macron /degree /plusminus /twosuperior /threesuperior /acute /mu
+/paragraph /periodcentered /cedilla /onesuperior /ordmasculine /guillemotright
+/onequarter /onehalf /threequarters /questiondown /Agrave /Aacute /Acircumflex
+/Atilde /Adieresis /Aring /AE /Ccedilla /Egrave /Eacute /Ecircumflex
+/Edieresis /Igrave /Iacute /Icircumflex /Idieresis /Eth /Ntilde /Ograve
+/Oacute /Ocircumflex /Otilde /Odieresis /multiply /Oslash /Ugrave /Uacute
+/Ucircumflex /Udieresis /Yacute /Thorn /germandbls /agrave /aacute
+/acircumflex /atilde /adieresis /aring /ae /ccedilla /egrave /eacute
+/ecircumflex /edieresis /igrave /iacute /icircumflex /idieresis /eth /ntilde
+/ograve /oacute /ocircumflex /otilde /odieresis /divide /oslash /ugrave
+/uacute /ucircumflex /udieresis /yacute /thorn /ydieresis] def
+}
+ifelse
+/arct dup where
+{pop pop}
+{
+/arct {arcto pop pop pop pop} bd
+}
+ifelse
+/size 0 def
+/fontname 0 def
+/newfont 0 def
+/sf {
+/size xd
+/fontname xd
+fontname findfont
+dup /Encoding get StandardEncoding eq
+{
+dup
+length dict /newfont xd
+{
+1 index
+/FID ne
+{ newfont 3 1 roll put }
+{ pop pop }
+ifelse
+} forall
+newfont /Encoding ISOLatin1Encoding put
+fontname newfont definefont
+}
+if
+size scalefont setfont
+} bd
+/pusht {matrix currentmatrix} bd
+/popt {setmatrix} bd
+/pushc {gsave} bd
+/popc {grestore} bd
+/rgb {setrgbcolor} bd
+/w { setlinewidth } bd
+/j { setlinejoin } bd
+/J { setlinecap } bd
+/d { setdash } bd
+/F { eofill } bd
+/f { closepath F } bd
+/S {
+pusht
+skstartmatrix setmatrix stroke 
+popt
+} bd
+/s { closepath S } bd
+/m { moveto } bd
+/l { lineto } bd
+/c { curveto } bd
+/txt {
+/tmpmat tmpmat currentmatrix def
+dup type /arraytype eq {concat} {translate} ifelse
+0 0 m
+tmpmat
+} bd
+/T {txt x show popt} bd
+/P {txt x true charpath popt} bd
+/TP {txt x dup show 0 0 m true charpath popt} bd
+/C {newpath 0 360 arc} bd
+/R {
+2 copy m
+x 2 index l
+x 2 index x l
+l
+closepath
+} bd
+/ellipse { 
+dup type /arraytype eq
+{
+pusht x concat
+0 0 1.0 C 
+popt
+}	
+{
+pusht 5 1 roll
+4 -1 roll concat
+newpath
+dup 2 eq {
+0 0 m 
+} if 
+3 1 roll
+radgrad x
+radgrad x
+0 0 1   5 -2 roll
+arc
+0 ne { closepath } if
+popt
+}
+ifelse
+} bd
+/radius1 0 def
+/radius2 0 def
+/factor 0 def
+/rect {
+dup type /arraytype eq
+{
+pusht x concat
+0 0 m  1 0 l  1 1 l  0 1 l  closepath
+popt
+}
+{
+/radius2 xd
+/radius1 xd
+pusht x concat
+radius1 radius2 div  1  scale
+0 radius2 m
+0 1  radius2 1  radius2  arct
+radius2 radius1 div
+dup 1  1 index 0  radius2  arct
+0  0 0  radius2  arct
+0 0  0 1  radius2 arct
+closepath
+popt
+}
+ifelse
+} bd
+/buf 0 def
+/width 0 def
+/height 0 def
+/skcimg {
+/tmpmat tmpmat currentmatrix def
+{ concat } if
+/height xd
+/width xd
+/buf width 3 mul string def
+width height scale
+width height 8
+[width	 0   0	 height neg	  0  height]
+{ currentfile buf readhexstring pop } bind
+false 3 colorimage
+tmpmat setmatrix
+} bd
+/skgimg {
+/tmpmat tmpmat currentmatrix def
+{ concat } if
+/height xd
+/width xd
+/buf width string def
+width height scale
+width height 8
+[width	 0   0	 height neg	  0  height]
+{ currentfile buf readhexstring pop } bind
+image
+tmpmat setmatrix
+} bd
+/rclip {
+4 2 roll m
+dup 0 x rlineto
+x 0 rlineto
+neg 0 x rlineto
+closepath
+clip
+} bd
+/skeps {
+10 dict begin
+/sk_state save def
+concat
+3 index neg 3 index neg translate
+rclip
+0 setgray 0 setlinecap 1 setlinewidth 0 setlinejoin
+10 setmiterlimit [ ] 0 setdash
+newpath
+/sk_dict_count countdictstack def
+/sk_count count 1 sub def
+userdict begin
+/showpage { } def
+/languagelevel where
+{
+pop
+languagelevel 1 ne
+{
+false setstrokeadjust
+false setoverprint
+} if
+} if
+} bd 
+/skepsend {
+count sk_count sub { pop } repeat
+countdictstack sk_dict_count sub { end } repeat
+sk_state restore
+end
+} bd
+/gradidx 0 def
+/gradient { 
+3 mul array
+/gradidx 0 def
+} bd
+/$ {
+3 index gradidx       5 -1 roll put 
+2 index gradidx 1 add 4 -1 roll put 
+1 index gradidx 2 add 3 -1 roll put 
+/gradidx gradidx 3 add def
+} bd
+/! { 
+3 
+{
+dup dup gradidx dup 3 1 roll 3 sub get put
+/gradidx gradidx 1 add def
+}
+repeat
+} bd
+/gradcolor {
+3 mul dup 2 add 1 exch	% idx  1  idx+2
+{
+1 index exch	% array array i
+get		% array component
+exch		% component array
+}
+for
+4 1 roll
+} bd
+/x0 0 def /y0 0 def /x1 0 def /y1 0 def
+/left 0 def /right 0 def /top 0 def /bottom 0 def
+/numcolors 0 def
+/axial	{
+/y1 xd /x1 xd /y0 xd /x0 xd
+dup length 3 idiv /numcolors xd
+pusht exch  % ctm array
+x0 x1 ne y0 y1 ne or
+{
+x0 y0 translate
+[x1 x0 sub  y1 y0 sub	dup neg    2 index    0	    0] concat
+clippath flattenpath pathbbox
+/top xd /right xd /bottom xd /left xd
+newpath
+0 gradcolor rgb clippath f
+0 1 numcolors 1 sub
+{
+dup numcolors div
+3 1 roll
+gradcolor rgb
+exch
+bottom right top R f
+}
+for
+}
+if 
+pop
+popt
+} bd
+/r0 0 def /r1 0 def /dr 0 def
+/radial	{
+/r1 xd /r0 xd /y0 xd /x0 xd
+/dr r1 r0 sub def
+dup length 3 idiv /numcolors xd
+pusht exch  % ctm array
+r0 r1 ne
+{
+x0 y0 translate
+clippath flattenpath pathbbox
+/top xd /right xd /bottom xd /left xd
+newpath
+dr 0 gt {numcolors 1 sub}{0} ifelse gradcolor rgb
+clippath f
+dr 0 gt {numcolors 1 sub -1 0} { 0 1 numcolors 1 sub} ifelse
+{
+dup numcolors div dr mul r0 add
+3 1 roll
+gradcolor rgb
+exch
+0 0 3 -1 roll C f
+}
+for
+}
+if 
+pop
+popt
+} bd
+/max {
+2 copy lt {exch} if pop
+} bd
+/conical {
+pusht 5 1 roll
+3 1 roll /y0 xd /x0 xd
+x0 y0 translate
+radgrad rotate
+dup length 3 idiv /numcolors xd
+clippath flattenpath pathbbox newpath
+4 { abs 4 1 roll} repeat
+3 { max } repeat
+2 mul
+dup scale
+0 gradcolor rgb
+0 0 1 0 360 arc f
+1 1 numcolors 1 sub
+{
+dup numcolors div 180 mul
+3 1 roll
+gradcolor rgb
+exch
+0 0 moveto
+0 0 1  4 -1 roll  dup neg  arc
+closepath f
+}
+for
+pop
+popt
+} bd
+/XStep 0 def /YStep 0 def /imagedata 0 def /components 0 def
+/tileimage2 {
+exch 4 2 roll
+/height xd
+/width xd
+mark
+/components 2 index
+/PatternType 1
+/PaintType 1
+/TilingType 1
+/BBox [0 0 width height]
+/XStep width
+/YStep height
+/PaintProc {
+begin
+XStep YStep 8
+matrix
+imagedata
+false
+components
+colorimage
+end
+}
+counttomark 2 div cvi dup dict begin
+{ def } repeat
+pop currentdict end
+dup
+/imagedata
+4 -1 roll
+width height mul mul string
+currentfile exch readhexstring pop
+put
+exch
+makepattern
+setpattern
+clippath
+eofill
+} bd
+/tileimage1 {
+concat
+/components xd
+/height xd
+/width xd
+/imagedata
+currentfile
+width height mul components mul string
+readhexstring pop
+def
+clippath flattenpath pathbbox
+/top xd /right xd /bottom xd /left xd
+left width div floor width mul
+bottom height div floor height mul
+translate
+top bottom sub height div ceiling cvi
+{
+gsave
+right left sub width div ceiling cvi
+{
+width height 8 matrix
+components 1 eq
+{
+{ imagedata }
+image
+}
+{
+imagedata
+false components
+colorimage
+}
+ifelse
+width 0 translate
+}
+repeat
+grestore
+0 height translate
+}
+repeat
+} bd
+/makepattern where
+{
+pop
+/tileimage /tileimage2 load def
+}
+{
+/tileimage /tileimage1 load def
+}
+ifelse
+end
+%%EndResource
+%%EndProlog
+
+%%BeginSetup
+%%IncludeResource: font NewCenturySchlbk-Italic
+
+10.433 setmiterlimit
+%%EndSetup
+
+%%Page: 1 1
+SketchDict begin
+/NewCenturySchlbk-Italic 72 sf
+(7)
+[1 0.0774195 0 1 38.5322 74.5729] 0 0.475 0 rgb
+T
+(f)
+[1 0.0774195 0 1 82.704 81.2248] 0.354 0.335 0.676 rgb
+T
+(a)
+[1 0.0774195 0 1 111.793 83.4768] 0.667 0 0 rgb
+T
+(c)
+[1 0.0774195 0 1 154.887 86.8132] 0.747 0.609 0.241 rgb
+T
+(h)
+[1 0.0774195 0 1 189.363 89.4823] 0.001 0 0.67 rgb
+T
+%%PageTrailer
+%%Trailer
+end
+%%DocumentSuppliedResources: procset Linux-Sketch-Procset 1.0 2
+%%EOF
diff --git a/img/7fach.gif b/img/7fach.gif
Binary files differ.
diff --git a/img/go.png b/img/go.png
Binary files differ.
diff --git a/img/no.png b/img/no.png
Binary files differ.
diff --git a/lib.css b/lib.css
@@ -0,0 +1,194 @@
+/* 20apr10abu
+ * (c) Software Lab. Alexander Burger
+ */
+
+/* Lib */
+.left {float: left;}
+.right {float: right;}
+.clr {clear: both;}
+.norm {text-align: left;}
+.align {text-align: right;}
+.center {text-align: center;}
+.black {color: black;}
+.red {color: red;}
+.green {color: green;}
+.blue {color: blue;}
+.bold {font-weight: bold;}
+.mono {font-family: monospace;}
+
+/* Defaults */
+body {
+   font-family: Arial, Helvetica, sans-serif;
+   background-color: #F0F0F0;
+   font-size: small;
+   margin: 0;
+}
+
+img {
+   border: 0;
+}
+
+fieldset {
+   border-style: none;
+}
+
+input, textarea, select {
+   font-size: small;
+   background-color: white;
+}
+
+caption {
+   padding: 0 1em;
+   text-align: left;
+   margin-top: 2ex;
+   background-color: #D0D0D0;
+}
+
+a {
+   text-decoration: none;
+}
+
+.step a {
+   background-color: #D0D0D0;
+   padding: 2px;
+}
+
+a:hover {
+   background-color: white;
+}
+
+/* Navigation */
+#menu {
+   position: absolute;
+   top: 0;
+   left: 0;
+   width: 18em;
+   height: 100%;
+   padding: 1ex 0;
+   background-color: #D0D0D0;
+}
+
+#menu ul {
+   list-style: none;
+   padding: 0;
+   margin: 0;
+}
+
+#menu .cmd1, .act1, .cmd2, .act2, .cmd3, .act3, .cmd4, .act4 {
+   list-style-position: inside;
+	list-style-type: circle;
+   padding: 0 0 0 2em;
+}
+
+#menu .act1, .act2, .act3, .act4 {
+	list-style-type: disc;
+}
+
+#menu .sub1, .top1, .sub2, .top2, .sub3, .top3, .sub4, .top4 {
+   list-style-position: inside;
+   padding: 0 0 0 1em;
+}
+
+#expires {
+   position: absolute;
+   top: 0;
+   right: 3px;
+   color: red;
+}
+
+/* Tabulators */
+.tab {
+   margin-bottom: 1ex;
+}
+
+.tab td {
+   padding: 1ex 1em;
+}
+
+.tab .top {
+   font-weight: bold;
+   border-top: 1px solid;
+   border-left: 1px solid;
+   border-right: 1px solid;
+}
+
+.tab .sub {
+   background-color: #D0D0D0;
+   border-bottom: 1px solid;
+}
+
+/* Main area */
+#main {
+   position: absolute;
+   top: 0;
+   left: 19em;
+   padding: 1ex 0;
+}
+
+/* Charts */
+.chart {
+   width: 100%;
+   white-space: nowrap;
+}
+
+.chart td {
+   background-color: #E0E0E0;
+}
+
+.chart td.T {
+   background-color: #D0D0D0;
+}
+
+.chart td.nil {
+   background-color: white;
+}
+
+.btn {
+   width: 1em;
+}
+
+/* Buttons */
+.submit {
+   font-weight: bold;
+   background-color: #D0D0D0;
+}
+
+.edit {
+   background-color: #66FF66;
+}
+
+/* Errors */
+.err {
+   color: red;
+   background-color: yellow;
+}
+
+/* Fonts */
+.tiny {
+   font-size: smaller;
+   padding: 0;
+}
+
+.note, .ask {
+   font-weight: bold;
+}
+
+/* Alerts */
+.alert {
+   display: inline;
+   padding: 1ex;
+   margin: 1ex 0 1ex 5em;
+   background-color: yellow;
+   border: dashed thin;
+}
+
+.alert input {
+   margin-top: 1ex;
+}
+
+/* Dialogs */
+.dialog {
+   padding: 1ex;
+   margin: 1ex 5em 1ex 1em;
+   border: dashed thin;
+}
diff --git a/lib.l b/lib.l
@@ -0,0 +1,369 @@
+# 18mar10abu
+# (c) Software Lab. Alexander Burger
+
+(de task (Key . Prg)
+   (nond
+      (Prg (del (assoc Key *Run) '*Run))
+      ((num? Key) (quit "Bad Key" Key))
+      ((assoc Key *Run)
+         (push '*Run
+            (conc
+               (make
+                  (when (lt0 (link Key))
+                     (link (+ (eval (pop 'Prg) 1))) ) )
+               (ifn (sym? (car Prg))
+                  Prg
+                  (cons
+                     (cons 'job
+                        (cons
+                           (lit
+                              (make
+                                 (while (atom (car Prg))
+                                    (link
+                                       (cons (pop 'Prg) (eval (pop 'Prg) 1)) ) ) ) )
+                           Prg ) ) ) ) ) ) )
+      (NIL (quit "Key conflict" Key)) ) )
+
+(de forked ()
+   (let N (caar *Run)
+      (when (gt0 N)
+         (push '*Fork (list 'close N)) )
+      (push '*Fork (list 'task N)) ) )
+
+(de timeout (N)
+   (if2 N (assoc -1 *Run)
+      (set (cdr @) (+ N))
+      (push '*Run (list -1 (+ N) '(bye)))
+      (del @ '*Run) ) )
+
+(de abort ("N" . "Prg")
+   (catch 'abort
+      (alarm "N" (throw 'abort))
+      (finally (alarm 0) (run "Prg")) ) )
+
+(de macro "Prg"
+   (run (fill "Prg")) )
+
+(de later ("@Var" . "@Prg")
+   (macro
+      (task (pipe (pr (prog . "@Prg")))
+         (setq "@Var" (in @ (rd)))
+         (close @)
+         (task @) ) )
+   "@Var" )
+
+(de recur recurse
+   (run (cdr recurse)) )
+
+(de curry "Z"
+   (let ("X" (pop '"Z")  "Y" (pop '"Z")  "P" (filter pat? "X"))
+      (if2 "P" (diff "X" "P")
+         (list "Y" (cons 'job (lit (env @)) (fill "Z" "P")))
+         (cons "Y" (fill "Z" "P"))
+         (list "Y" (cons 'job (lit (env @)) "Z"))
+         (cons "Y" "Z") ) ) )
+
+(====)
+
+(de expr ("F")
+   (set "F"
+      (list '@ (list 'pass (box (getd "F")))) ) )
+
+(de subr ("F")
+   (set "F"
+      (getd (cadr (cadr (getd "F")))) ) )
+
+(de undef ("X" "C")
+   (when (pair "X")
+      (setq  "C" (cdr "X")  "X" (car "X")) )
+   (ifn "C"
+      (prog1 (val "X") (set "X"))
+      (prog1
+         (cdr (asoq "X" (val "C")))
+         (set "C"
+            (delq (asoq "X" (val "C")) (val "C")) ) ) ) )
+
+(de redef "Lst"
+   (let ("Old" (car "Lst")  "New" (name "Old"))
+      (set
+         "New" (getd "Old")
+         "Old" "New"
+         "Old" (fill (cdr "Lst") "Old") )
+      "New" ) )
+
+(de daemon ("X" . Prg)
+   (prog1
+      (nond
+         ((pair "X")
+            (or (pair (getd "X")) (expr "X")) )
+         ((pair (cdr "X"))
+            (method (car "X") (cdr "X")) )
+         (NIL
+            (method (car "X") (get (or (cddr "X") *Class) (cadr "X"))) ) )
+      (con @ (append Prg (cdr @))) ) )
+
+(de patch ("Lst" "Pat" . "Prg")
+   (bind (fish pat? "Pat")
+      (recur ("Lst")
+         (loop
+            (cond
+               ((match "Pat" (car "Lst"))
+                  (set "Lst" (run "Prg")) )
+               ((pair (car "Lst"))
+                  (recurse @) ) )
+            (NIL (cdr "Lst"))
+            (T (atom (cdr "Lst"))
+               (when (match "Pat" (cdr "Lst"))
+                  (con "Lst" (run "Prg")) ) )
+            (setq "Lst" (cdr "Lst")) ) ) ) )
+
+(====)
+
+(de cache ("Var" "Str" . Prg)
+   (nond
+      ((setq "Var" (car (idx "Var" "Str" T)))
+         (set "Str" "Str"  "Str" (run Prg 1)) )
+      ((n== "Var" (val "Var"))
+         (set "Var" (run Prg 1)) )
+      (NIL (val "Var")) ) )
+
+(====)
+
+(de scl (N)
+   (setq *Scl N) )
+
+### I/O ###
+(de tab (Lst . @)
+   (for N Lst
+      (let V (next)
+         (and (gt0 N) (space (- N (length V))))
+         (prin V)
+         (and (lt0 N) (args) (space (- 0 N (length V)))) ) )
+   (prinl) )
+
+(de beep ()
+   (prin "^G") )
+
+(de msg (X . @)
+   (out 2
+      (print X)
+      (pass prinl)
+      (flush) )
+   X )
+
+(de script (File . @)
+   (load File) )
+
+(de once Prg
+   (unless (idx '*Once (file) T)
+      (run Prg 1) ) )
+
+(de rc (File Key . @)
+   (ctl File
+      (let Lst (in File (read))
+         (ifn (args)
+            (cdr (assoc Key Lst))
+            (let Val (next)
+               (if (assoc Key Lst)
+                  (con @ Val)
+                  (push 'Lst (cons Key Val)) )
+               (protect
+                  (out File (println Lst)) )
+               Val ) ) ) ) )
+
+(de acquire (File)
+   (ctl File
+      (let P (in File (rd))
+         (or
+            (= P *Pid)
+            (unless (and P (kill P 0))
+               (out File (pr *Pid)) ) ) ) ) )
+
+(de release (File)
+   (ctl File (out File)) )
+
+### List ###
+(de insert (N Lst X)
+   (conc
+      (cut (dec N) 'Lst)
+      (cons X)
+      Lst ) )
+
+(de remove (N Lst)
+   (conc
+      (cut (dec N) 'Lst)
+      (cdr Lst) ) )
+
+(de place (N Lst X)
+   (conc
+      (cut (dec N) 'Lst)
+      (cons X)
+      (cdr Lst) ) )
+
+(de uniq (Lst)
+   (let R NIL
+      (filter
+         '((X) (not (idx 'R X T)))
+         Lst ) ) )
+
+(de group (Lst)
+   (make
+      (while Lst
+         (if (assoc (caar Lst) (made))
+            (conc @ (cons (cdr (pop 'Lst))))
+            (link
+               (cons (caar Lst) (cons (cdr (pop 'Lst)))) ) ) ) ) )
+
+### Symbol ###
+(de qsym "Sym"
+   (cons (val "Sym") (getl "Sym")) )
+
+(de loc (S X)
+   (if (and (str? X) (= S X))
+      X
+      (and
+         (pair X)
+         (or
+            (loc S (car X))
+            (loc S (cdr X)) ) ) ) )
+
+### OOP ###
+(de class Lst
+   (let L (val (setq *Class (car Lst)))
+      (def *Class
+         (recur (L)
+            (if (atom (car L))
+               (cdr Lst)
+               (cons (car L) (recurse (cdr L))) ) ) ) ) )
+
+(de object ("Sym" "Val" . @)
+   (def "Sym" "Val")
+   (putl "Sym")
+   (while (args)
+      (put "Sym" (next) (next)) )
+   "Sym" )
+
+(de extend X
+   (setq *Class (car X)) )
+
+# Class variables
+(de var X
+   (put *Class (car X) (cdr X)) )
+
+(de var: X
+   (apply meta X This) )
+
+### Pretty Printing ###
+(de "*PP"
+   T NIL if if2 ifn when unless while until do case state for
+   with catch finally ! setq default push job use let let?
+   prog1 later recur redef =: in out ctl tab new )
+(de "*PP1" if2 let let? for redef)
+(de "*PP2" setq default)
+
+(de pretty (X N . @)
+   (setq N (abs (space (or N 0))))
+   (while (args)
+      (printsp (next)) )
+   (if (or (atom X) (>= 12 (size X)))
+      (print X)
+      (while (== 'quote (car X))
+         (prin "'")
+         (pop 'X) )
+      (let Z X
+         (prin "(")
+         (when (memq (print (pop 'X)) "*PP")
+            (cond
+               ((memq (car Z) "*PP1")
+                  (if (and (pair (car X)) (pair (cdar X)))
+                     (when (>= 12 (size (car X)))
+                        (space)
+                        (print (pop 'X)) )
+                     (space)
+                     (print (pop 'X))
+                     (when (or (atom (car X)) (>= 12 (size (car X))))
+                        (space)
+                        (print (pop 'X)) ) ) )
+               ((memq (car Z) "*PP2")
+                  (inc 'N 3)
+                  (loop
+                     (prinl)
+                     (pretty (cadr X) N (car X))
+                     (NIL (setq X (cddr X)) (space)) ) )
+               ((or (atom (car X)) (>= 12 (size (car X))))
+                  (space)
+                  (print (pop 'X)) ) ) )
+         (when X
+            (loop
+               (T (== Z X) (prin " ."))
+               (T (atom X) (prin " . ") (print X))
+               (prinl)
+               (pretty (pop 'X) (+ 3 N))
+               (NIL X) )
+            (space) )
+         (prin ")") ) ) )
+
+(de pp ("X" C)
+   (let *Dbg NIL
+      (when (pair "X")
+         (setq C (cdr "X")) )
+      (prin "(")
+      (printsp (if C 'dm 'de))
+      (prog1
+         (printsp "X")
+         (setq "X"
+            (if C
+               (method (if (pair "X") (car "X") "X") C)
+               (val "X") ) )
+         (cond
+            ((atom "X")
+               (prin ". ")
+               (print "X") )
+            ((atom (cdr "X"))
+               (ifn (cdr "X")
+                  (print (car "X"))
+                  (print (car "X"))
+                  (prin " . ")
+                  (print @) ) )
+            (T (print (pop '"X"))
+               (while (pair "X")
+                  (prinl)
+                  (pretty (pop '"X") 3) )
+               (when "X"
+                  (prin " . ")
+                  (print "X") )
+               (space) ) )
+         (prinl ")") ) ) )
+
+(de show ("X" . @)
+   (let *Dbg NIL
+      (setq "X" (apply get (rest) "X"))
+      (when (sym? "X")
+         (print "X" (val "X"))
+         (prinl)
+         (maps
+            '((X)
+               (space 3)
+               (if (atom X)
+                  (println X)
+                  (println (cdr X) (car X)) ) )
+            "X" ) )
+      "X" ) )
+
+(de view (X L)
+   (let (Z X  *Dbg)
+      (loop
+         (T (atom X) (println X))
+         (if (atom (car X))
+            (println '+-- (pop 'X))
+            (print '+---)
+            (view
+               (pop 'X)
+               (append L (cons (if X "|   " "    "))) ) )
+         (NIL X)
+         (mapc prin L)
+         (T (== Z X) (println '*))
+         (println '|)
+         (mapc prin L) ) ) )
+
+# vi:et:ts=3:sw=3
diff --git a/lib/adm.l b/lib/adm.l
@@ -0,0 +1,71 @@
+# 26mar10abu
+# (c) Software Lab. Alexander Burger
+
+# *Login *Users *Perms
+
+### Login ###
+(de login (Nm Pw)
+   (ifn (setq *Login (db 'nm '+User Nm 'pw Pw))
+      (msg *Pid " ? " Nm)
+      (msg *Pid " * " (stamp) " " Nm)
+      (tell 'hi *Pid Nm *Adr)
+      (push1 '*Bye '(logout))
+      (push1 '*Fork '(del '(logout) '*Bye))
+      (timeout (setq *Timeout `(* 3600 1000))) )
+   *Login )
+
+(de logout ()
+   (when *Login
+      (rollback)
+      (off *Login)
+      (tell 'hi *Pid)
+      (msg *Pid " / " (stamp))
+      (timeout (setq *Timeout `(* 300 1000))) ) )
+
+(de hi (Pid Nm Adr)
+   (if (and (= Nm (get *Login 'nm)) (= Adr *Adr))
+      (bye)
+      (hi2 Pid Nm)
+      (tell 'hi2 *Pid (get *Login 'nm)) ) )
+
+(de hi2 (Pid Nm)
+   (if2 Nm (lup *Users Pid)
+      (con @ Nm)
+      (idx '*Users (cons Pid Nm) T)
+      (idx '*Users @ NIL) ) )
+
+
+### Role ###
+(class +Role +Entity)
+
+(rel nm (+Need +Key +String))          # Role name
+(rel perm (+List +Symbol))             # Permission list
+(rel usr (+List +Joint) role (+User))  # Associated users
+
+
+### User ###
+(class +User +Entity)
+
+(rel nm (+Need +Key +String))          # User name
+(rel pw (+String))                     # Password
+(rel role (+Joint) usr (+Role))        # User role
+
+
+### Permission management ###
+(de permission Lst
+   (while Lst
+      (queue '*Perms (car Lst))
+      (def (pop 'Lst) (pop 'Lst)) ) )
+
+(de may Args
+   (mmeq Args (get *Login 'role 'perm)) )
+
+(de must Args
+   (unless
+      (if (cdr Args)
+         (mmeq @ (get *Login 'role 'perm))
+         *Login )
+      (msg *Pid " No permission: " (car Args))
+      (forbidden) ) )
+
+# vi:et:ts=3:sw=3
diff --git a/lib/app.l b/lib/app.l
@@ -0,0 +1,34 @@
+# 06apr10abu
+# (c) Software Lab. Alexander Burger
+
+# Exit on error
+(de *Err
+   (prinl *Pid " ! " (stamp) " [" *Adr " " (host *Adr) "] " *Agent)
+   (show This)
+   (for "X" '(*Gate *Agent *Host *Port *PRG *Url *SesId *ConId *Tab *Gui *Btn *Get *ID)
+      (println "X" (val "X")) )
+   (and (get *Top 'focus) (println 'focus (get @ 'ix)))
+   (for "X" (env)
+      (unless (== (car "X") (cdr "X"))
+         (println (car "X") (cdr "X")) ) )
+   (rollback) )
+
+# User identification
+(de user (Pid1 Pid2 Nm To)
+   (nond
+      (Pid1 (tell 'user *Pid))
+      (Pid2
+         (tell 'user Pid1 *Pid (get *Login 'nm)
+            (/ (- *Timeout (cadr (assoc -1 *Run))) 60000) ) )
+      ((<> *Pid Pid1) (println Pid2 Nm To)) ) )
+
+# Timestamp
+(msg *Pid " + " (stamp))
+(flush)
+
+# Extend 'app' function
+(conc (last app)
+   '((msg *Pid " + " (stamp) " [" *Adr " " (host *Adr) "] " *Agent)) )
+
+# Bye message
+(push1 '*Bye '(and *SesId (msg *Pid " - " (stamp))))
diff --git a/lib/boss.l b/lib/boss.l
@@ -0,0 +1,16 @@
+# 26feb09abu
+# (c) Software Lab. Alexander Burger
+
+# "tmp+" "tmp-"
+
+(unless (info (tmp "+"))
+   (call 'mkfifo (setq "tmp+" (tmp "+")))
+   (call 'mkfifo (setq "tmp-" (tmp "-"))) )
+(hear (open "tmp+"))
+
+# (boss 'sym ['any ..])
+(de boss @
+   (out "tmp+" (pr (rest))) )
+
+(de reply Exe  #-> any
+   (out "tmp-" (pr (eval Exe))) )
diff --git a/lib/btree.l b/lib/btree.l
@@ -0,0 +1,438 @@
+# 08oct09abu
+# (c) Software Lab. Alexander Burger
+
+# *Prune
+
+(de root (Tree)
+   (cond
+      ((not Tree) (val *DB))
+      ((atom Tree) (val Tree))
+      ((ext? (cdr Tree)) (get @ (car Tree)))
+      ((atom (cdr Tree))
+         (get *DB (cdr Tree) (car Tree)) )
+      (T (get (cddr Tree) (cadr Tree) (car Tree))) ) )
+
+# Fetch
+(de fetch (Tree Key)
+   (let? Node (cdr (root Tree))
+      (and *Prune (idx '*Prune Node T))
+      (use R
+         (loop
+            (T
+               (and
+                  (setq R (rank Key (cdr (val Node))))
+                  (= Key (car R)) )
+               (or (cddr R) (fin (car R))) )
+            (NIL
+               (setq Node (if R (cadr R) (car (val Node)))) ) ) ) ) )
+
+# Store
+(de store (Tree Key Val Dbf)
+   (default Dbf (1 . 256))
+   (if (atom Tree)
+      (let Base (or Tree *DB)
+         (_store (or (val Base) (set Base (cons 0)))) )
+      (let Base
+         (if (atom (cdr Tree))
+            (or
+               (ext? (cdr Tree))
+               (get *DB (cdr Tree))
+               (put *DB (cdr Tree) (new T)) )
+            (or
+               (get (cddr Tree) (cadr Tree))
+               (put (cddr Tree) (cadr Tree) (new T)) ) )
+         (_store
+            (or
+               (get Base (car Tree))
+               (put Base (car Tree) (cons 0)) ) ) ) ) )
+
+
+(de _store (Root)
+   (and *Prune (cdr Root) (idx '*Prune @ T))
+   (ifn Val
+      (when (and (cdr Root) (_del @))
+         (touch Base)
+         (cond
+            (*Solo (zap (cdr Root)))
+            (*Zap (push @ (cdr Root))) )
+         (con Root) )
+      (and (= Val (fin Key)) (off Val))
+      (if (cdr Root)
+         (when (_put @)
+            (touch Base)
+            (con Root (def (new (car Dbf)) (list (car @) (cdr @)))) )
+         (touch Base)
+         (con Root
+            (def (new (car Dbf))
+               (list NIL (cons Key NIL Val)) ) )
+         (inc Root) ) ) )
+
+(de _put (Top)
+   (let (V (val Top)  R (rank Key (cdr V)))
+      (if (and R (= Key (car R)))
+         (nil (touch Top) (con (cdr R) Val))
+         (cond
+            (R
+               (let X (memq R V)
+                  (if (cadr R)
+                     (when (_put @)
+                        (touch Top)
+                        (set (cdr R) (car @))
+                        (con X (cons (cdr @) (cdr X)))
+                        (_splitBt) )
+                     (touch Top)
+                     (con X
+                        (cons (cons Key (cons NIL Val)) (cdr X)) )
+                     (touch Base)
+                     (inc Root)
+                     (_splitBt) ) ) )
+            ((car V)
+               (when (_put @)
+                  (touch Top)
+                  (set V (car @))
+                  (con V (cons (cdr @) (cdr V)))
+                  (_splitBt) ) )
+            (T
+               (touch Top)
+               (con V
+                  (cons (cons Key (cons NIL Val)) (cdr V)) )
+               (touch Base)
+               (inc Root)
+               (_splitBt) ) ) ) ) )
+
+(de _splitBt ()
+   (when (and (cddddr V) (> (size Top) (cdr Dbf)))
+      (let (N (>> 1 (length V))  X (get V (inc N)))
+         (set (cdr X)
+            (def (new (car Dbf))
+               (cons (cadr X) (nth V (+ 2 N))) ) )
+         (cons
+            (if *Solo
+               (prog (set Top (head N V)) Top)
+               (and *Zap (push @ Top))
+               (def (new (car Dbf)) (head N V)) )
+            X ) ) ) )
+
+# Del
+(de _del (Top)
+   (let (V (val Top)  R (rank Key (cdr V)))
+      (cond
+         ((not R)
+            (when (and (car V) (_del @))
+               (touch Top)
+               (cond
+                  (*Solo (zap (car V)))
+                  (*Zap (push @ (car V))) )
+               (set V)
+               (not (cdr V)) ) )
+         ((= Key (car R))
+            (if (cadr R)
+               (let X (val @)
+                  (while (car X) (setq X (val @)))
+                  (touch Top)
+                  (xchg R (cadr X))
+                  (con (cdr R) (cddr (cadr X)))
+                  (when (_del (cadr R))
+                     (cond
+                        (*Solo (zap (cadr R)))
+                        (*Zap (push @ (cadr R))) )
+                     (set (cdr R)) ) )
+               (touch Base)
+               (dec Root)
+               (nand
+                  (or
+                     (con V (delq R (cdr V)))
+                     (car V) )
+                  (touch Top) ) ) )
+         ((cadr R)
+            (when (_del @)
+               (touch Top)
+               (cond
+                  (*Solo (zap (cadr R)))
+                  (*Zap (push @ (cadr R))) )
+               (set (cdr R)) ) ) ) ) )
+
+
+# Delayed deletion
+(de zap_ ()
+   (let (F (cdr *Zap)  Z (pack F "_"))
+      (cond
+         ((info Z)
+            (in Z (while (rd) (zap @)))
+            (if (info F)
+               (call 'mv F Z)
+               (call 'rm Z) ) )
+         ((info F) (call 'mv F Z)) ) ) )
+
+
+# Tree node count
+(de count (Tree)
+   (or (car (root Tree)) 0) )
+
+# Return first leaf
+(de leaf (Tree)
+   (let (Node (cdr (root Tree))  X)
+      (while (val Node)
+         (setq X (cadr @)  Node (car @)) )
+      (cddr X) ) )
+
+# Reverse node
+(de revNode (Node)
+   (let? Lst (val Node)
+      (let (L (car Lst)  R)
+         (for X (cdr Lst)
+            (push 'R (cons (car X) L (cddr X)))
+            (setq L (cadr X)) )
+         (cons L R) ) ) )
+
+# Key management
+(de minKey (Tree Min Max)
+   (default Max T)
+   (let (Node (cdr (root Tree))  K)
+      (use (V R X)
+         (loop
+            (NIL (setq V (val Node)) K)
+            (T
+               (and
+                  (setq R (rank Min (cdr V)))
+                  (= Min (car R)) )
+               Min )
+            (if R
+               (prog
+                  (and
+                     (setq X (cdr (memq R V)))
+                     (>= Max (caar X))
+                     (setq K (caar X)) )
+                  (setq Node (cadr R)) )
+               (when (>= Max (caadr V))
+                  (setq K (caadr V)) )
+               (setq Node (car V)) ) ) ) ) )
+
+(de maxKey (Tree Min Max)
+   (default Max T)
+   (let (Node (cdr (root Tree))  K)
+      (use (V R X)
+         (loop
+            (NIL (setq V (revNode Node)) K)
+            (T
+               (and
+                  (setq R (rank Max (cdr V) T))
+                  (= Max (car R)) )
+               Max )
+            (if R
+               (prog
+                  (and
+                     (setq X (cdr (memq R V)))
+                     (>= (caar X) Min)
+                     (setq K (caar X)) )
+                  (setq Node (cadr R)) )
+               (when (>= (caadr V) Min)
+                  (setq K (caadr V)) )
+               (setq Node (car V)) ) ) ) ) )
+
+# Step
+(de init (Tree Beg End)
+   (or Beg End (on End))
+   (let (Node (cdr (root Tree))  Q)
+      (use (V R X)
+         (if (>= End Beg)
+            (loop
+               (NIL (setq V (val Node)))
+               (T
+                  (and
+                     (setq R (rank Beg (cdr V)))
+                     (= Beg (car R)) )
+                  (push 'Q (memq R V)) )
+               (if R
+                  (prog
+                     (and
+                        (setq X (cdr (memq R V)))
+                        (>= End (caar X))
+                        (push 'Q X) )
+                     (setq Node (cadr R)) )
+                  (and
+                     (cdr V)
+                     (>= End (caadr V))
+                     (push 'Q (cdr V)) )
+                  (setq Node (car V)) ) )
+            (loop
+               (NIL (setq V (revNode Node)))
+               (T
+                  (and
+                     (setq R (rank Beg (cdr V) T))
+                     (= Beg (car R)) )
+                  (push 'Q (memq R V)) )
+               (if R
+                  (prog
+                     (and
+                        (setq X (cdr (memq R V)))
+                        (>= (caar X) End)
+                        (push 'Q X) )
+                     (setq Node (cadr R)) )
+                  (and
+                     (cdr V)
+                     (>= (caadr V) End)
+                     (push 'Q (cdr V)) )
+                  (setq Node (car V)) ) ) ) )
+      (cons (cons (cons Beg End) Q)) ) )
+
+(de step (Q Flg)
+   (use (L F X)
+      (catch NIL
+         (loop
+            (until (cdar Q)
+               (or (cdr Q) (throw))
+               (set Q (cadr Q))
+               (con Q (cddr Q)) )
+            (setq
+               L (car Q)
+               F (>= (cdar L) (caar L))
+               X (pop (cdr L)) )
+            (or (cadr L) (con L (cddr L)))
+            (if ((if F > <) (car X) (cdar L))
+               (con (car Q))
+               (for (V (cadr X) ((if F val revNode) V) (car @))
+                  (con L (cons (cdr @) (cdr L)))
+                  (wipe V) )
+               (unless (and Flg (flg? (fin (car X))))
+                  (throw NIL
+                     (or (cddr X) (fin (car X))) ) ) ) ) ) ) )
+
+(====)
+
+# Scan tree nodes
+(de scan ("Tree" "Fun" "Beg" "End" "Flg")
+   (default "Fun" println)
+   (or "Beg" "End" (on "End"))
+   ((if (>= "End" "Beg") _scan _nacs)
+      (cdr (root "Tree")) ) )
+
+(de _scan ("Node")
+   (let? "V" (val "Node")
+      (for "X"
+         (if (rank "Beg" (cdr "V"))
+            (let "R" @
+               (if (= "Beg" (car "R"))
+                  (memq "R" (cdr "V"))
+                  (_scan (cadr "R"))
+                  (cdr (memq "R" (cdr "V"))) ) )
+            (_scan (car "V"))
+            (cdr "V") )
+         (T (> (car "X") "End"))
+         (unless (and "Flg" (flg? (fin (car "X"))))
+            ("Fun"
+               (car "X")
+               (or (cddr "X") (fin (car "X"))) ) )
+         (_scan (cadr "X")) )
+      (wipe "Node") ) )
+
+(de _nacs ("Node")
+   (let? "V" (revNode "Node")
+      (for "X"
+         (if (rank "Beg" (cdr "V") T)
+            (let "R" @
+               (if (= "Beg" (car "R"))
+                  (memq "R" (cdr "V"))
+                  (_nacs (cadr "R"))
+                  (cdr (memq "R" (cdr "V"))) ) )
+            (_nacs (car "V"))
+            (cdr "V") )
+         (T (> "End" (car "X")))
+         (unless (and "Flg" (flg? (fin (car "X"))))
+            ("Fun"
+               (car "X")
+               (or (cddr "X") (fin (car "X"))) ) )
+         (_nacs (cadr "X")) )
+      (wipe "Node") ) )
+
+(====)
+
+# Iterate tree values
+(de iter ("Tree" "Fun" "Beg" "End" "Flg")
+   (default "Fun" println)
+   (or "Beg" "End" (on "End"))
+   ((if (>= "End" "Beg") _iter _reti)
+      (cdr (root "Tree")) ) )
+
+(de _iter ("Node")
+   (let? "V" (val "Node")
+      (for "X"
+         (if (rank "Beg" (cdr "V"))
+            (let "R" @
+               (if (= "Beg" (car "R"))
+                  (memq "R" (cdr "V"))
+                  (_iter (cadr "R"))
+                  (cdr (memq "R" (cdr "V"))) ) )
+            (_iter (car "V"))
+            (cdr "V") )
+         (T (> (car "X") "End"))
+         (unless (and "Flg" (flg? (fin (car "X"))))
+            ("Fun" (or (cddr "X") (fin (car "X")))) )
+         (_iter (cadr "X")) )
+      (wipe "Node") ) )
+
+(de _reti ("Node")
+   (let? "V" (revNode "Node")
+      (for "X"
+         (if (rank "Beg" (cdr "V") T)
+            (let "R" @
+               (if (= "Beg" (car "R"))
+                  (memq "R" (cdr "V"))
+                  (_reti (cadr "R"))
+                  (cdr (memq "R" (cdr "V"))) ) )
+            (_reti (car "V"))
+            (cdr "V") )
+         (T (> "End" (car "X")))
+         (unless (and "Flg" (flg? (fin (car "X"))))
+            ("Fun" (or (cddr "X") (fin (car "X")))) )
+         (_reti (cadr "X")) )
+      (wipe "Node") ) )
+
+(====)
+
+(de prune (Done)
+   (for Node (idx '*Prune)
+      (recur (Node)
+         (let? V (val (lieu Node))
+            (if (nor (car V) (find cadr (cdr V)))
+               (wipe Node)
+               (recurse (car V))
+               (for X (cdr V)
+                  (recurse (cadr X))
+                  (wipe (lieu (cddr X))) ) ) ) ) )
+   (setq *Prune (not Done)) )
+
+# Delete Tree
+(de zapTree (Node)
+   (let? V (val Node)
+      (zapTree (car V))
+      (for L (cdr V)
+         (zapTree (cadr L)) )
+      (zap Node) ) )
+
+# Check tree structure
+(de chkTree ("Node" "Fun")
+   (let ("N" 0  "X")
+      (when "Node"
+         (recur ("Node")
+            (let "V" (val "Node")
+               (let "L" (car "V")
+                  (for "Y" (cdr "V")
+                     (when "L"
+                        (unless (ext? "L")
+                           (quit "Bad node link" "Node") )
+                        (recurse "L") )
+                     (when (>= "X" (car "Y"))
+                        (quit "Bad sequence" "Node") )
+                     (setq "X" (car "Y"))
+                     (inc '"N")
+                     (and
+                        "Fun"
+                        (not ("Fun" (car "Y") (cddr "Y")))
+                        (quit "Check fail" "Node") )
+                     (setq "L" (cadr "Y")) )
+                  (and "L" (recurse "L")) ) )
+            (wipe "Node") ) )
+      "N" ) )
+
+# vi:et:ts=3:sw=3
diff --git a/lib/cal.l b/lib/cal.l
@@ -0,0 +1,79 @@
+# 17sep02abu
+# (c) Software Lab. Alexander Burger
+
+# Easter date
+(de easter (Year)
+   (unless (<= 1900 Year 2099)
+      (quit "Illegal Year" Year) )
+   (let
+      (A (% Year 19)
+         B (% Year 4)
+         C (% Year 7)
+         D (% (+ 24 (* 19 A)) 30)
+         E (% (+ 5 (* 2 B) (* 4 C) (* 6 D)) 7)
+         Day (+ 22 D E)
+         Mon 3 )
+      (and (> Day 31) (setq  Day (+ D E -9)  Mon 4))
+      (and (= Day 26) (= Mon 4) (setq Day 19))
+      (and (= Day 25) (= Mon 4) (= D 28) (= E 6) (> A 10) (setq Day 18))
+      (date Year Mon Day) ) )
+
+# Feiertage
+(de feier (X Year)
+   (if (sym? X)
+      (case X
+         (Neujahr
+            (date Year 1 1) )
+         ((Maifeiertag "1. Mai" "Tag der Arbeit")
+            (date Year 5 1) )
+         (("Tag der deutschen Einheit" "Deutsche Einheit")
+            (date Year 10 3) )
+         ((Weihnachten "1. Weihnachtstag")
+            (date Year 12 25) )
+         ("2. Weihnachtstag"
+            (date Year 12 26) )
+         (Rosenmontag
+            (- (easter Year) 48) )
+         (Aschermittwoch
+            (- (easter Year) 46) )
+         (Karfreitag
+            (- (easter Year) 2) )
+         ((Ostern Ostersonntag)
+            (easter Year) )
+         (Ostermontag
+            (+ (easter Year) 1) )
+         ((Himmelfahrt "Christi Himmelfahrt")
+            (+ (easter Year) 39) )
+         ((Pfingsten Pfingstsonntag)
+            (+ (easter Year) 49) )
+         (Pfingstsmontag
+            (+ (easter Year) 50) )
+         (Fronleichnam
+            (+ (easter Year) 60) ) )
+      (let L (date X)
+         (cdr
+            (or
+               (assoc (cdr L)
+                  (quote
+                     ((1 1) . Neujahr)
+                     ((5 1) . Maifeiertag)
+                     ((10 3) . "Tag der deutschen Einheit")
+                     ((12 25) . Weihnachten)
+                     ((12 26) . "2. Weihnachtstag") ) )
+               (assoc (- X (easter (car L)))
+                  (quote
+                     (-48 . Rosenmontag)
+                     (-46 . Aschermittwoch)
+                     (-2 . Karfreitag)
+                     (0 . Ostern)
+                     (1 . Ostermontag)
+                     (39 . Himmelfahrt)
+                     (49 . Pfingsten)
+                     (50 . Pfingstsmontag)
+                     (60 . Fronleichnam) ) ) ) ) ) ) )
+
+# Werktag
+(de werktag (Dat)
+   (nor
+      (member (% Dat 7) (4 5))  # Sa So
+      (feier Dat) ) )
diff --git a/lib/conDbgc.l b/lib/conDbgc.l
@@ -0,0 +1,69 @@
+# 29jun07abu
+# (c) Software Lab. Alexander Burger
+
+### Concurrent DB Garbage Collector ###
+# *DbgcDly *DbgcPid
+
+(default *DbgcDly 64)
+
+(if (fork)
+   (setq *DbgcPid @)
+
+   (wait 60000)
+   (undef 'upd)
+   (de upd Lst
+      (wipe Lst)
+      (let *DbgcDly (>> 1 *DbgcDly)
+         (for S Lst
+            (when (ext? S)
+               (mark S T)
+               (markData (val S))
+               (maps markData S) )
+            (wipe S) ) ) )
+
+   (de markExt (S)
+      (unless (mark S T)
+         (wait *DbgcDly)
+         (markData (val S))
+         (maps markData S)
+         (wipe S) ) )
+
+   (de markData (X)
+      (while (pair X)
+         (markData (pop 'X)) )
+      (and (ext? X) (markExt X)) )
+
+   (loop
+      (let MS (+ (/ (usec) 1000) 86400000)
+         (markExt *DB)
+         (while (> MS (/ (usec) 1000))
+            (wait 60000) ) )
+      (let Cnt 0
+         (for (F . @) (or *Dbs (2))
+            (for (S (seq F)  S  (seq S))
+               (wait *DbgcDly)
+               (unless (mark S)
+                  (sync)
+                  (unless (mark S)
+                     (and (isa '+Entity S) (zap> S))
+                     (zap S)
+                     (commit)
+                     (inc 'Cnt) ) ) ) )
+         (when *Blob
+            (use (@S @R F S)
+               (let Pat (conc (chop *Blob) '(@S "." @R))
+                  (in (list 'find *Blob "-type" "f")
+                     (while (setq F (line))
+                        (wait *DbgcDly)
+                        (when (match Pat F)
+                           (unless
+                              (and
+                                 (setq S (extern (pack (replace @S '/))))
+                                 (get S (intern (pack @R))) )
+                              (inc 'Cnt)
+                              (call 'rm (pack F)) )
+                           (wipe S) ) ) ) ) ) )
+         (msg Cnt " conDbgc") )
+      (mark 0) ) )
+
+# vi:et:ts=3:sw=3
diff --git a/lib/db.l b/lib/db.l
@@ -0,0 +1,1125 @@
+# 08mar10abu
+# (c) Software Lab. Alexander Burger
+
+# *Dbs *Jnl *Blob upd
+
+### DB Sizes ###
+(de dbs Lst
+   (default *Dbs (_dbs 1)) )
+
+(de dbs+ (N . Lst)
+   (unless (cdr (nth *Dbs N))
+      (conc *Dbs (_dbs N)) ) )
+
+(de _dbs (N)
+   (mapcar
+      '((L)
+         (let Dbf (cons N (>> (- (car L)) 64))
+            (for Cls (cdr L)
+               (if (atom Cls)
+                  (put Cls 'Dbf Dbf)
+                  (for Var (cdr Cls)
+                     (unless (get Cls 1 Var)
+                        (quit "Bad relation" (cons Var (car Cls))) )
+                     (put (get (car Cls) Var) 'dbf Dbf) ) ) ) )
+         (inc 'N)
+         (car L) )
+      Lst ) )
+
+(de db: Typ
+   (or (meta Typ 'Dbf 1) 1) )
+
+
+### Tree Access ###
+(de tree (Var Cls Hook)
+   (cons Var
+      (if Hook
+         (cons Cls Hook)
+         Cls ) ) )
+
+(de treeRel (Var Cls)
+   (with (or (get Cls Var) (meta Cls Var))
+      (or
+         (find '((B) (isa '+index B)) (: bag))
+         This ) ) )
+
+# (db 'var 'cls ['hook] 'any ['var 'any ..]) -> sym
+(de db (Var Cls . @)
+   (with (treeRel Var Cls)
+      (let (Tree (tree (: var) (: cls) (and (: hook) (next)))  Val (next))
+         (if (isa '+Key This)
+            (if (args)
+               (and (fetch Tree Val) (pass _db @))
+               (fetch Tree Val) )
+            (let Key (cons (if (isa '+Fold This) (fold Val) Val))
+               (let? A (: aux)
+                   (for (L (rest) (and L (== (pop 'A) (pop 'L))) (cdr L))
+                     (conc Key (cons (car L))) ) )
+               (let Q (init Tree Key (append Key T))
+                  (loop
+                     (NIL (step Q T))
+                     (T (pass _db @ Var Val) @) ) ) ) ) ) ) )
+
+(de _db (Obj . @)
+   (when (isa Cls Obj)
+      (loop
+         (NIL (next) Obj)
+         (NIL (has> Obj (arg) (next))) ) ) )
+
+
+# (aux 'var 'cls ['hook] 'any ..) -> sym
+(de aux (Var Cls . @)
+   (with (treeRel Var Cls)
+      (step
+         (init (tree (: var) (: cls) (and (: hook) (next)))
+            (rest)
+            (conc (rest) T) ) ) ) )
+
+
+# (collect 'var 'cls ['hook] ['any|beg ['end [var ..]]]) -> lst
+(de collect (Var Cls . @)
+   (with (treeRel Var Cls)
+      (let
+         (Tree (tree (: var) (: cls) (and (: hook) (next)))
+            X1 (next)
+            X2 (if (args) (next) (or X1 T)) )
+         (make
+            (if (isa '+Key This)
+               (iter Tree
+                  '((X) (and (isa Cls X) (link (pass get X))))
+                  X1 X2 )
+               (if (>= X2 X1)
+                  (if (pair X1)
+                     (setq X2 (append X2 T))
+                     (setq X1 (cons X1)  X2 (cons X2 T)) )
+                  (if (pair X1)
+                     (setq X1 (append X1 T))
+                     (setq X1 (cons X1 T)  X2 (cons X2)) ) )
+               (if (isa '+Idx This)
+                  (iter Tree
+                     '((X)
+                        (and
+                           (isa Cls X)
+                           (not (memq (setq X (pass get X)) (made)))
+                           (link X) ) )
+                     X1 X2 T )
+                  (iter Tree
+                     '((X)
+                        (and (isa Cls X) (link (pass get X))) )
+                     X1 X2 ) ) ) ) ) ) )
+
+
+(de genKey (Var Cls Hook Min Max)
+   (if (lt0 Max)
+      (let K (minKey (tree Var Cls Hook) Min Max)
+         (if (lt0 K) (dec K) (or Max -1)) )
+      (let K (maxKey (tree Var Cls Hook) Min Max)
+         (if (gt0 K) (inc K) (or Min 1)) ) ) )
+
+(de useKey (Var Cls Hook)
+   (let (Tree (tree Var Cls Hook)  Max (* 2 (inc (count Tree)))  N)
+      (while (fetch Tree (setq N (rand 1 Max))))
+      N ) )
+
+
+### Relations ###
+(class +relation)
+# cls var
+
+(dm T (Var Lst)
+   (=: cls *Class)
+   (=: var Var) )
+
+# Type check
+(dm mis> (Val Obj))  #> lst
+(dm ele> (Val))
+
+# Value present?
+(dm has> (Val X)  #> any | NIL
+   (and (= Val X) X) )
+
+# Set value
+(dm put> (Obj Old New)
+   New )
+
+# Delete value
+(dm del> (Obj Old Val)
+   (and (<> Old Val) Val) )
+
+# Maintain relations
+(dm rel> (Obj Old New))
+
+(dm lose> (Obj Val))
+
+(dm keep> (Obj Val))
+
+# Finalizer
+(dm zap> (Obj Val))
+
+
+(class +Any +relation)
+
+
+# (+Bag) (cls ..) (..) (..)
+(class +Bag +relation)
+# bag
+
+(dm T (Var Lst)
+   (=: bag
+      (mapcar
+         '((L)
+            (prog1
+               (new (car L) Var (cdr L))
+               (and (get @ 'hook) (=: hook T)) ) )
+         Lst ) )
+   (super Var) )
+
+(dm mis> (Val Obj)
+   (or
+      (ifn (lst? Val) "Not a Bag")
+      (pick
+         '((This V)
+            (mis> This V Obj
+               (get
+                  (if (sym? (: hook)) Obj Val)
+                  (: hook) ) ) )
+         (: bag)
+         Val ) ) )
+
+(dm ele> (Val)
+   (and Val
+      (or
+         (atom Val)
+         (find 'ele> (: bag) Val) ) ) )
+
+(dm has> (Val X)
+   (and Val
+      (or
+         (super Val X)
+         (car (member Val X)) ) ) )
+
+(dm put> (Obj Old New)
+   (trim
+      (mapcar
+         '((X O N) (put> X Obj O N))
+         (: bag)
+         Old
+         New ) ) )
+
+(dm rel> (Obj Old New)
+   (when Old
+      (mapc
+         '((This O)
+            (rel> This Obj O NIL
+               (get
+                  (if (sym? (: hook)) Obj Old)
+                  (: hook) ) ) )
+         (: bag)
+         Old ) )
+   (when New
+      (mapc
+         '((This N)
+            (rel> This Obj NIL N
+               (get
+                  (if (sym? (: hook)) Obj New)
+                  (: hook) ) ) )
+         (: bag)
+         New ) ) )
+
+(dm lose> (Obj Val)
+   (mapc
+      '((This V)
+         (lose> This Obj V
+            (get
+               (if (sym? (: hook)) Obj Val)
+               (: hook) ) ) )
+      (: bag)
+      Val ) )
+
+(dm keep> (Obj Val)
+   (mapc
+      '((This V)
+         (keep> This Obj V
+            (get
+               (if (sym? (: hook)) Obj Val)
+               (: hook) ) ) )
+      (: bag)
+      Val ) )
+
+
+(class +Bool +relation)
+
+(dm mis> (Val Obj)
+   (and Val (nT Val) ,"Boolean input expected") )
+
+
+# (+Number) [num]
+(class +Number +relation)
+# scl
+
+(dm T (Var Lst)
+   (=: scl (car Lst))
+   (super Var (cdr Lst)) )
+
+(dm mis> (Val Obj)
+   (and Val (not (num? Val)) ,"Numeric input expected") )
+
+
+# (+Date)
+(class +Date +Number)
+
+(dm T (Var Lst)
+   (super Var (cons NIL Lst)) )
+
+
+# (+Time)
+(class +Time +Number)
+
+(dm T (Var Lst)
+   (super Var (cons NIL Lst)) )
+
+
+# (+Symbol)
+(class +Symbol +relation)
+
+(dm mis> (Val Obj)
+   (unless (sym? Val)
+      ,"Symbolic type expected" ) )
+
+
+# (+String) [num]
+(class +String +Symbol)
+# len
+
+(dm T (Var Lst)
+   (=: len (car Lst))
+   (super Var (cdr Lst)) )
+
+(dm mis> (Val Obj)
+   (and Val (not (str? Val)) ,"String type expected") )
+
+
+# (+Link) typ
+(class +Link +relation)
+# type
+
+(dm T (Var Lst)
+   (unless (=: type (car Lst))
+      (quit "No Link" Var) )
+   (super Var (cdr Lst)) )
+
+(de canQuery (Val)
+   (and
+      (pair Val)
+      (pair (car Val))
+      (not
+         (find
+            '((L)
+               (not
+                  (find
+                     '((Cls)
+                        (get
+                           Cls
+                           ((if (lst? (car L)) cadr car) L) ) )
+                     (: type) ) ) )
+            Val ) ) ) )
+
+(dm mis> (Val Obj)
+   (and
+      Val
+      (nor
+         (isa (: type) Val)
+         (canQuery Val) )
+      ,"Type error" ) )
+
+
+# (+Joint) var typ
+(class +Joint +Link)
+# slot
+
+(dm T (Var Lst)
+   (=: slot (car Lst))
+   (super Var (cdr Lst)) )
+
+(dm mis> (Val Obj)
+   (and
+      Val
+      (nor
+         (canQuery Val)
+         (and
+            (isa (: type) Val)
+            (with (meta Val (: slot))
+               (or
+                  (isa '+Joint This)
+                  (find
+                     '((B) (isa '+Joint B))
+                     (: bag) ) ) ) ) )
+      ,"Type error" ) )
+
+(dm rel> (Obj Old New)
+   (and Old (del> Old (: slot) Obj))
+   (and New
+      (not (get Obj T))
+      (put> New (: slot) Obj) ) )
+
+(dm lose> (Obj Val)
+   (when Val
+      (put Val (: slot)
+         (del> (meta Val (: slot)) Obj (get Val (: slot)) Obj) ) ) )
+
+(dm keep> (Obj Val)
+   (when Val
+      (put Val (: slot)
+         (put> (meta Val (: slot)) Obj (get Val (: slot)) Obj) ) ) )
+
+
+# +Link or +Joint prefix
+(class +Hook)
+
+(dm rel> (Obj Old New Hook)
+   (let L
+      (extract
+         '((X)
+            (and (atom X) (setq X (cons T X)))
+            (and
+               (or
+                  (== (: var) (meta Obj (cdr X) 'hook))
+                  (find
+                     '((B) (== (: var) (get B 'hook)))
+                     (meta Obj (cdr X) 'bag) ) )
+               X ) )
+         (getl Obj) )
+      (for X L
+         (rel> (meta Obj (cdr X)) Obj (car X) NIL (or Old *DB))
+         (rel> (meta Obj (cdr X)) Obj NIL (car X) (or New *DB)) ) )
+   (extra Obj Old New Hook) )
+
+
+# (+Blob)
+(class +Blob +relation)
+
+(de blob (Obj Var)
+   (pack *Blob (glue "/" (chop Obj)) "." Var) )
+
+(dm put> (Obj Old New)
+   (and
+      New
+      (dirname (blob Obj))
+      (call 'mkdir "-p" @) )
+   (if (flg? New)
+      New
+      (in New (out (blob Obj (: var)) (echo)))
+      T ) )
+
+(dm zap> (Obj Val)
+   (and Val (call 'rm "-f" (blob Obj (: var)))) )
+
+
+### Index classes ###
+(class +index)
+# hook dbf
+
+(dm T (Var Lst)
+   (=: hook (car Lst))
+   (extra Var (cdr Lst)) )
+
+
+# (+Key) hook
+(class +Key +index)
+
+(dm mis> (Val Obj Hook)
+   (or
+      (extra Val Obj Hook)
+      (and
+         Val
+         (not (has> Obj (: var) Val))
+         (fetch
+            (tree (: var) (: cls) (or Hook (get Obj (: hook))))
+            Val )
+         ,"Not unique" ) ) )
+
+(dm rel> (Obj Old New Hook)
+   (let Tree (tree (: var) (: cls) (or Hook (get Obj (: hook))))
+      (and Old
+         (= Obj (fetch Tree Old))
+         (store Tree Old NIL (: dbf)) )
+      (and New
+         (not (get Obj T))
+         (not (fetch Tree New))
+         (store Tree New Obj (: dbf)) ) )
+   (extra Obj Old New Hook) )
+
+(dm lose> (Obj Val Hook)
+   (store
+      (tree (: var) (: cls) (or Hook (get Obj (: hook))))
+      Val NIL (: dbf) )
+   (extra Obj Val Hook) )
+
+(dm keep> (Obj Val Hook)
+   (store
+      (tree (: var) (: cls) (or Hook (get Obj (: hook))))
+      Val Obj (: dbf) )
+   (extra Obj Val Hook) )
+
+
+# (+Ref) hook
+(class +Ref +index)
+# aux
+
+(dm rel> (Obj Old New Hook)
+   (let
+      (Tree (tree (: var) (: cls) (or Hook (get Obj (: hook))))
+         Aux (conc (mapcar '((S) (get Obj S)) (: aux)) Obj) )
+      (when Old
+         (store Tree (cons Old Aux) NIL (: dbf)) )
+      (and New
+         (not (get Obj T))
+         (store Tree (cons New Aux) Obj (: dbf)) ) )
+   (extra Obj Old New Hook) )
+
+(dm lose> (Obj Val Hook)
+   (store
+      (tree (: var) (: cls) (or Hook (get Obj (: hook))))
+      (cons Val (conc (mapcar '((S) (get Obj S)) (: aux)) Obj))
+      NIL (: dbf) )
+   (extra Obj Val Hook) )
+
+(dm keep> (Obj Val Hook)
+   (store
+      (tree (: var) (: cls) (or Hook (get Obj (: hook))))
+      (cons Val (conc (mapcar '((S) (get Obj S)) (: aux)) Obj))
+      Obj (: dbf) )
+   (extra Obj Val Hook) )
+
+
+# Backing index prefix
+(class +Ref2)
+
+(dm T (Var Lst)
+   (unless (meta *Class Var)
+      (quit "No Ref2" Var) )
+   (extra Var Lst) )
+
+(dm rel> (Obj Old New Hook)
+   (with (meta (: cls) (: var))
+      (let Tree (tree (: var) (: cls))
+         (when Old
+            (store Tree (cons Old Obj) NIL (: dbf)) )
+         (and New
+            (not (get Obj T))
+            (store Tree (cons New Obj) Obj (: dbf)) ) ) )
+   (extra Obj Old New Hook) )
+
+(dm lose> (Obj Val Hook)
+   (with (meta (: cls) (: var))
+      (store (tree (: var) (: cls)) (cons Val Obj) NIL (: dbf)) )
+   (extra Obj Val Hook) )
+
+(dm keep> (Obj Val Hook)
+   (with (meta (: cls) (: var))
+      (store (tree (: var) (: cls)) (cons Val Obj) Obj (: dbf)) )
+   (extra Obj Val Hook) )
+
+
+# (+Idx) cnt hook
+(class +Idx +Ref)
+# min
+
+(dm T (Var Lst)
+   (=: min (or (car Lst) 3))
+   (super Var (cdr Lst)) )
+
+(dm rel> (Obj Old New Hook)
+   (let
+      (Tree (tree (: var) (: cls) (or Hook (get Obj (: hook))))
+         Aux (conc (mapcar '((S) (get Obj S)) (: aux)) Obj) )
+      (when Old
+         (store Tree (cons Old Aux) NIL (: dbf))
+         (for S (split (cdr (chop Old)) " " "^J")
+            (while (nth S (: min))
+               (store Tree (list (pack S) Obj) NIL (: dbf))
+               (pop 'S) ) ) )
+      (when (and New (not (get Obj T)))
+         (store Tree (cons New Aux) Obj (: dbf))
+         (for S (split (cdr (chop New)) " " "^J")
+            (while (nth S (: min))
+               (store Tree (list (pack S) Obj) Obj (: dbf))
+               (pop 'S) ) ) ) )
+   (extra Obj Old New Hook) )
+
+(dm lose> (Obj Val Hook)
+   (let
+      (Tree (tree (: var) (: cls) (or Hook (get Obj (: hook))))
+         Aux (conc (mapcar '((S) (get Obj S)) (: aux)) Obj) )
+      (store Tree (cons Val Aux) NIL (: dbf))
+      (for S (split (cdr (chop Val)) " " "^J")
+         (while (nth S (: min))
+            (store Tree (list (pack S) Obj) NIL (: dbf))
+            (pop 'S) ) ) )
+   (extra Obj Val Hook) )
+
+(dm keep> (Obj Val Hook)
+   (let
+      (Tree (tree (: var) (: cls) (or Hook (get Obj (: hook))))
+         Aux (conc (mapcar '((S) (get Obj S)) (: aux)) Obj) )
+      (store Tree (cons Val Aux) Obj (: dbf))
+      (for S (split (cdr (chop Val)) " " "^J")
+         (while (nth S (: min))
+            (store Tree (list (pack S) Obj) Obj (: dbf))
+            (pop 'S) ) ) )
+   (extra Obj Val Hook) )
+
+
+
+# (+Sn +index) hook
+(class +Sn)
+
+(dm rel> (Obj Old New Hook)
+   (let Tree (tree (: var) (: cls) (or Hook (get Obj (: hook))))
+      (when Old
+         (store Tree (cons (ext:Snx Old) Obj T) NIL (: dbf)) )
+      (and New
+         (not (get Obj T))
+         (store Tree (cons (ext:Snx New) Obj T) Obj (: dbf)) ) )
+   (extra Obj Old New Hook) )
+
+(dm lose> (Obj Val Hook)
+   (store
+      (tree (: var) (: cls) (or Hook (get Obj (: hook))))
+      (cons (ext:Snx Val) Obj T)
+      NIL (: dbf) )
+   (extra Obj Val Hook) )
+
+(dm keep> (Obj Val Hook)
+   (store
+      (tree (: var) (: cls) (or Hook (get Obj (: hook))))
+      (cons (ext:Snx Val) Obj T)
+      Obj (: dbf) )
+   (extra Obj Val Hook) )
+
+
+# (+Fold +index) hook
+(class +Fold)
+
+(dm has> (Val X)
+   (extra Val
+      (if (= Val (fold Val)) (fold X) X) ) )
+
+(dm rel> (Obj Old New Hook)
+   (extra Obj (fold Old) (fold New) Hook) )
+
+(dm lose> (Obj Val Hook)
+   (extra Obj (fold Val) Hook) )
+
+(dm keep> (Obj Val Hook)
+   (extra Obj (fold Val) Hook) )
+
+
+# (+Aux) lst
+(class +Aux)
+
+(dm T (Var Lst)
+   (=: aux (car Lst))
+   (with *Class
+      (for A (car Lst)
+         (if (asoq A (: Aux))
+            (conc @ (cons Var))
+            (=: Aux
+               (conc (: Aux) (cons (list A Var))) ) ) ) )
+   (extra Var (cdr Lst)) )
+
+(de relAux (Obj Var Old Lst)
+   (for A Lst
+      (let? Val (get Obj A)
+         (with (meta Obj A)
+            (let Tree (tree (: var) (: cls) (get Obj (: hook)))
+               (store Tree
+                  (conc
+                     (cons Val
+                        (mapcar
+                           '((S)
+                              (if (== S Var) Old (get Obj S)) )
+                           (: aux) ) )
+                     Obj )
+                  NIL
+                  (: dbf) )
+               (store Tree
+                  (conc
+                     (cons Val
+                        (mapcar
+                           '((S)
+                              (if (== S Var) (get Obj Var) (get Obj S)) )
+                           (: aux) ) )
+                     Obj )
+                  Obj
+                  (: dbf) ) ) ) ) ) )
+
+
+### Relation prefix classes ###
+(class +Dep)
+# dep
+
+(dm T (Var Lst)
+   (=: dep (car Lst))
+   (extra Var (cdr Lst)) )
+
+(dm rel> (Obj Old New Hook)
+   (unless New
+      (for Var (: dep)
+         (del> Obj Var (get Obj Var)) ) )
+   (extra Obj Old New Hook) )
+
+(dm lose> (Obj Val Hook)
+   (for Var (: dep)
+      (del> Obj Var (get Obj Var)) )
+   (extra Obj Val Hook) )
+
+
+(class +List)
+
+(dm mis> (Val Obj)
+   (or
+      (ifn (lst? Val) "Not a List")
+      (pick '((V) (extra V Obj)) Val) ) )
+
+(dm ele> (Val)
+   (and Val (or (atom Val) (find extra Val))) )
+
+(dm has> (Val X)
+   (and Val
+      (or
+         (extra Val X)
+         (find '((X) (extra Val X)) X) ) ) )
+
+(dm put> (Obj Old New)
+   (if (ele> This New)
+      (cons (extra Obj Old New) Old)
+      (mapcar
+         '((N O) (extra Obj O N))
+         New
+         Old ) ) )
+
+(dm del> (Obj Old Val)
+   (and
+      (<> Old Val)
+      (delete Val Old) ) )
+
+(dm rel> (Obj Old New Hook)
+   (if (or (ele> This Old) (ele> This New))
+      (extra Obj Old New Hook)
+      (for O (diff Old New)
+         (extra Obj O NIL Hook) )
+      (for N New
+         (extra Obj NIL N Hook) ) ) )
+
+(dm lose> (Obj Val Hook)
+   (if (ele> This Val)
+      (extra Obj Val Hook)
+      (for V Val
+         (extra Obj V Hook) ) ) )
+
+(dm keep> (Obj Val Hook)
+   (if (ele> This Val)
+      (extra Obj Val Hook)
+      (for V Val
+         (extra Obj V Hook) ) ) )
+
+
+(class +Need)
+
+(dm mis> (Val Obj)
+   (ifn Val
+      ,"Input required"
+      (extra Val Obj) ) )
+
+
+(class +Mis)
+# mis
+
+(dm T (Var Lst)
+   (=: mis (car Lst))
+   (extra Var (cdr Lst)) )
+
+(dm mis> (Val Obj)
+   (or ((: mis) Val Obj) (extra Val Obj)) )
+
+
+(class +Alt)
+
+(dm T (Var Lst)
+   (extra Var (cdr Lst))
+   (=: cls (car Lst)) )
+
+
+### Entities ###
+(class +Entity)
+
+(var Dbf)
+(var Aux)
+
+(de dbSync ()
+   (let *Run NIL
+      (while (lock *DB) (wait 40))
+      (sync) ) )
+
+(de new! ("Typ" . @)
+   (prog2
+      (dbSync)
+      (pass new (or (meta "Typ" 'Dbf 1) 1) "Typ")
+      (commit 'upd) ) )
+
+(de set! (Obj Val)
+   (unless (= Val (val Obj))
+      (dbSync)
+      (set Obj Val)
+      (commit 'upd) )
+   Val )
+
+(de put! (Obj Var Val)
+   (unless (= Val (get Obj Var))
+      (dbSync)
+      (put Obj Var Val)
+      (commit 'upd) )
+   Val )
+
+(de inc! (Obj Var Val)
+   (when (num? (get Obj Var))
+      (dbSync)
+      (prog2
+         (touch Obj)
+         (inc (prop Obj Var) (or Val 1))
+         (commit 'upd) ) ) )
+
+(de blob! (Obj Var File)
+   (and *Jnl (blob+ Obj Var))
+   (put!> Obj Var File) )
+
+(de blob+ (Obj Var)
+   (chdir *Blob
+      (call 'ln "-sf"
+         (pack (glue "/" (chop Obj)) "." Var)
+         (pack (name Obj) "." Var) ) ) )
+
+(dm T @
+   (while (args)
+      (cond
+         ((=T (next)) (put This T T))
+         ((atom (arg)) (put> This (arg) (next)))
+         (T (put> This (car (arg)) (eval (cdr (arg))))) ) )
+   (upd> This (val This)) )
+
+(dm zap> ()
+   (for X (getl This)
+      (let V (or (atom X) (pop 'X))
+         (and (meta This X) (zap> @ This V)) ) ) )
+
+(dm url> (Tab))
+
+(dm upd> (X Old))
+
+(dm has> (Var Val)
+   (or
+      (nor Val (get This Var))
+      (has> (meta This Var) Val (get This Var)) ) )
+
+(dm put> (Var Val)
+   (unless (has> This Var Val)
+      (let Old (get This Var)
+         (rel> (meta This Var) This Old
+            (put This Var (put> (meta This Var) This Old Val)) )
+         (when (asoq Var (meta This 'Aux))
+            (relAux This Var Old (cdr @)) )
+         (upd> This Var Old) ) )
+   Val )
+
+(dm put!> (Var Val)
+   (unless (has> This Var Val)
+      (dbSync)
+      (let Old (get This Var)
+         (rel> (meta This Var) This Old
+            (put This Var (put> (meta This Var) This Old Val)) )
+         (when (asoq Var (meta This 'Aux))
+            (relAux This Var Old (cdr @)) )
+         (upd> This Var Old)
+         (commit 'upd) ) )
+   Val )
+
+(dm del> (Var Val)
+   (when (and Val (has> (meta This Var) Val (get This Var)))
+      (let Old (get This Var)
+         (rel> (meta This Var) This Old
+            (put This Var (del> (meta This Var) This Old @)) )
+         (when (asoq Var (meta This 'Aux))
+            (relAux This Var Old (cdr @)) )
+         (upd> This Var Old) ) ) )
+
+(dm del!> (Var Val)
+   (when (and Val (has> (meta This Var) Val (get This Var)))
+      (dbSync)
+      (let Old (get This Var)
+         (rel> (meta This Var) This Old
+            (put This Var (del> (meta This Var) This Old @)) )
+         (when (asoq Var (meta This 'Aux))
+            (relAux This Var Old (cdr @)) )
+         (upd> This Var Old)
+         (commit 'upd) ) ) )
+
+(dm inc> (Var Val)
+   (when (num? (get This Var))
+      (touch This)
+      (let Old (get This Var)
+         (rel> (meta This Var) This Old
+            (inc (prop This Var) (or Val 1)) )
+         (when (asoq Var (meta This 'Aux))
+            (relAux This Var Old (cdr @)) )
+         (upd> This Var Old) ) ) )
+
+(dm inc!> (Var Val)
+   (when (num? (get This Var))
+      (dbSync)
+      (touch This)
+      (let Old (get This Var)
+         (rel> (meta This Var) This Old
+            (inc (prop This Var) (or Val 1)) )
+         (when (asoq Var (meta This 'Aux))
+            (relAux This Var Old (cdr @)) )
+         (upd> This Var Old)
+         (commit 'upd) ) ) )
+
+(dm dec> (Var Val)
+   (when (num? (get This Var))
+      (touch This)
+      (let Old (get This Var)
+         (rel> (meta This Var) This Old
+            (dec (prop This Var) (or Val 1)) )
+         (when (asoq Var (meta This 'Aux))
+            (relAux This Var Old (cdr @)) )
+         (upd> This Var Old) ) ) )
+
+(dm dec!> (Var Val)
+   (when (num? (get This Var))
+      (dbSync)
+      (touch This)
+      (let Old (get This Var)
+         (rel> (meta This Var) This Old
+            (dec (prop This Var) (or Val 1)) )
+         (when (asoq Var (meta This 'Aux))
+            (relAux This Var Old (cdr @)) )
+         (upd> This Var Old)
+         (commit 'upd) ) ) )
+
+(dm mis> (Var Val)
+   (mis> (meta This Var) Val This) )
+
+(dm lose1> (Var)
+   (when (meta This Var)
+      (lose> @ This (get This Var)) ) )
+
+(dm lose> (Lst)
+   (unless (: T)
+      (for X (getl This)
+         (let V (or (atom X) (pop 'X))
+            (and
+               (not (memq X Lst))
+               (meta This X)
+               (lose> @ This V) ) ) )
+      (=: T T)
+      (upd> This) ) )
+
+(dm lose!> ()
+   (dbSync)
+   (lose> This)
+   (commit 'upd) )
+
+(de lose "Prg"
+   (let "Flg" (: T)
+      (=: T T)
+      (run "Prg")
+      (=: T "Flg") ) )
+
+(dm keep1> (Var)
+   (when (meta This Var)
+      (keep> @ This (get This Var)) ) )
+
+(dm keep> (Lst)
+   (when (: T)
+      (=: T)
+      (for X (getl This)
+         (let V (or (atom X) (pop 'X))
+            (and
+               (not (memq X Lst))
+               (meta This X)
+               (keep> @ This V) ) ) )
+      (upd> This T) ) )
+
+(dm keep?> (Lst)
+   (extract
+      '((X)
+         (with (and (pair X) (meta This (cdr X)))
+            (and
+               (isa '+Key This)
+               (fetch (tree (: var) (: cls) (get (up This) (: hook))) (car X))
+               (cons (car X) ,"Not unique") ) ) )
+      (getl This) ) )
+
+(dm keep!> ()
+   (dbSync)
+   (keep> This)
+   (commit 'upd) )
+
+(de keep "Prg"
+   (let "Flg" (: T)
+      (=: T)
+      (run "Prg")
+      (=: T "Flg") ) )
+
+(dm set> (Val)
+   (unless (= Val (val This))
+      (let
+         (L
+            (extract
+               '((X)
+                  (pop 'X)
+                  (unless (== (meta Val X) (meta (val This) X))
+                     X ) )
+               (getl This) )
+            V (mapcar
+               '((X)
+                  (prog1
+                     (get This X)
+                     (if (meta This X)
+                        (put> This X)
+                        (put This X) ) ) )
+               L ) )
+         (xchg This 'Val)
+         (mapc
+            '((X V)
+               (if (meta This X)
+                  (put> This X V)
+                  (put This X V) ) )
+            L V ) )
+      (upd> This (val This) Val) )
+   (val This) )
+
+(dm set!> (Val)
+   (unless (= Val (val This))
+      (dbSync)
+      (let
+         (L
+            (extract
+               '((X)
+                  (pop 'X)
+                  (unless (== (meta Val X) (meta (val This) X))
+                     X ) )
+               (getl This) )
+            V (mapcar
+               '((X)
+                  (prog1
+                     (get This X)
+                     (if (meta This X)
+                        (put> This X)
+                        (put This X) ) ) )
+               L ) )
+         (xchg This 'Val)
+         (mapc
+            '((X V)
+               (if (meta This X)
+                  (put> This X V)
+                  (put This X V) ) )
+            L V ) )
+      (upd> This (val This) Val)
+      (commit 'upd) )
+   (val This) )
+
+(dm clone> ()
+   (let Obj (new (or (var: Dbf 1) 1) (val This))
+      (for X
+         (by
+            '((X)
+               (nand
+                  (pair X)
+                  (isa '+Hook (meta This (cdr X))) ) )
+            sort
+            (getl This ) )
+         (if (atom X)
+            (ifn (meta This X)
+               (put Obj X T)
+               (let Rel @
+                  (put> Obj X T)
+                  (when (isa '+Blob Rel)
+                     (in (blob This X)
+                        (out (blob Obj X) (echo)) ) ) ) )
+            (ifn (meta This (cdr X))
+               (put Obj (cdr X) (car X))
+               (let Rel @
+                  (cond
+                     ((find '((B) (isa '+Key B)) (get Rel 'bag))
+                        (let (K @  H (get K 'hook))
+                           (put> Obj (cdr X)
+                              (mapcar
+                                 '((Lst)
+                                    (mapcar
+                                       '((B Val)
+                                          (if (== B K)
+                                             (cloneKey B (cdr X) Val
+                                                (get (if (sym? H) This Lst) H) )
+                                             Val ) )
+                                       (get Rel 'bag)
+                                       Lst ) )
+                                 (car X) ) ) ) )
+                     ((isa '+Key Rel)
+                        (put> Obj (cdr X)
+                           (cloneKey Rel (cdr X) (car X)
+                              (get This (get Rel 'hook)) ) ) )
+                     ((or (not (isa '+Joint Rel)) (isa '+List (meta Obj (cdr X))))
+                        (put> Obj (cdr X) (car X)) ) ) ) ) ) )
+      Obj ) )
+
+(de cloneKey (Rel Var Val Hook)
+   (cond
+      ((isa '+Number Rel)
+         (genKey Var (get Rel 'cls) Hook) )
+      ((isa '+String Rel)
+         (let S (pack "# " Val)
+            (while (fetch (tree Var (get Rel 'cls) Hook) S)
+               (setq S (pack "# " S)) )
+            S ) ) ) )
+
+(dm clone!> ()
+   (prog2
+      (dbSync)
+      (clone> This)
+      (commit 'upd) ) )
+
+# Default syncronization function
+(de upd Lst
+   (wipe Lst) )
+
+
+### Utilities ###
+# Define object variables as relations
+(de rel Lst
+   (def *Class
+      (car Lst)
+      (new (cadr Lst) (car Lst) (cddr Lst)) ) )
+
+# Find or create object
+(de request (Typ Var . @)
+   (let Dbf (or (meta Typ 'Dbf 1) 1)
+      (ifn Var
+         (new Dbf Typ)
+         (with (meta Typ Var)
+            (or
+               (pass db Var (: cls))
+               (if (: hook)
+                  (pass new Dbf Typ (: hook) (next) Var)
+                  (pass new Dbf Typ Var) ) ) ) ) ) )
+
+# Create or update object
+(de obj Lst
+   (let Obj (apply request (pop 'Lst))
+      (while Lst
+         (put> Obj (pop 'Lst) (pop 'Lst)) )
+      Obj ) )
+
+# vi:et:ts=3:sw=3
diff --git a/lib/db32-64.l b/lib/db32-64.l
@@ -0,0 +1,73 @@
+# 05feb10abu
+# (c) Software Lab. Alexander Burger
+
+## 1. On the 32-bit system, in single-user mode:
+##    : (load "lib/db32-64.l")
+##    : (export64 *Pool *Dbs *Blob)
+##
+## 2. Transfer the resulting file "db64.tgz" to the 64-bit system,
+##    and unpack it in the application's runtime directory
+##
+## 3. On the 64-bit system, in single-user mode:
+##    : (load "lib/db32-64.l")
+##    : (import32)
+
+# 64-bit DB export: (export64 "db/app/" *Dbs *Blob) -> "db64.tgz"
+(de export64 (Pool Dbs Blob)
+   (if Blob
+      (call 'tar "cfz" (tmp "db32.tgz") Pool Blob)
+      (call 'tar "cfz" (tmp "db32.tgz") Pool) )
+   (chdir (tmp)
+      (call 'tar "xfz" "db32.tgz")
+      (pool Pool Dbs)
+      (for (F . @) (or Dbs (2))
+         (for (S (seq F)  S  (seq S))
+            (touch S)
+            (at (0 . 10000) (commit T)) ) )
+      (commit T)
+      (pool)
+      (for (F . @) Dbs
+         (call 'mv
+            (pack Pool F)
+            (pack Pool (hax (dec F))) ) )
+      (ifn Blob
+         (call 'tar "cvfz" "../../db64.tgz" Pool)
+         (call 'mv Blob ".blob/")
+         (call 'mkdir "-p" Blob)
+         (use (@S @R Src)
+            (let Pat '`(conc (chop ".blob/") '(@S "." @R))
+               (in (list 'find ".blob/" "-type" "f")
+                  (while (setq Src (line))
+                     (when (match Pat Src)
+                        (let
+                           (L (split (replace @S "/") "-")
+                              Dbf
+                              (when (cdr L)
+                                 (pack
+                                    (hax (dec (fmt64 (pack (pop 'L)))))
+                                    "/" ) )
+                              Id
+                              (chop (oct (fmt64 (pack (car L)))))
+                              Dst
+                              (pack
+                                 Blob
+                                 Dbf
+                                 (car Id)
+                                 (flip
+                                    (mapcan list
+                                       (flip (cdr Id))
+                                       '(NIL NIL "/" .) ) )
+                                 "."
+                                 @R ) )
+                           (when (dirname Dst)
+                              (call 'mkdir "-p" @) )
+                           (call 'mv Src Dst) ) ) ) ) ) )
+         (call 'tar "cvfz" "../../db64.tgz" Pool Blob) ) ) )
+
+# 32-bit -> 64-bit DB import
+(de import32 ()
+   (dbMap NIL
+      '((Base Root Var Cls Hook)
+         (rebuild NIL Var Cls Hook) ) ) )
+
+# vi:et:ts=3:sw=3
diff --git a/lib/dbase.l b/lib/dbase.l
@@ -0,0 +1,59 @@
+# 10jul08abu
+# (c) Software Lab. Alexander Burger
+
+(de dbase (File)
+   (use (Cnt Hdr Siz Fld X)
+      (in File
+         (unless (= 3 (rd 1))    # Version
+            (quit "dBASE Version") )
+         (rd 3)                  # Date
+         (setq
+            Cnt (rd -4)          # Record count
+            Hdr (rd -2)          # Header size
+            Siz (rd -2) )        # Record size
+         (rd 3)                  # Reserved
+         (unless (=0 (rd 1))     # Encryption Flag
+            (quit "Encrypted") )
+         (rd 16)                 # Reserved
+         (setq Fld
+            (make
+               (until (= 13 (setq X (rd 1)))
+                  (link
+                     (cons
+                        (intern                    # Name
+                           (pack
+                              (char X)
+                              (make
+                                 (for
+                                    (L (make (do 10 (link (rd 1))))
+                                       (n0 (car L))
+                                       (cdr L) )
+                                    (link (char (car L))) ) ) ) )
+                        (cons
+                           (char (rd 1))           # Type
+                           (cons
+                              (prog (rd 4) (rd 1)) # Size
+                              (rd 1) ) ) ) )       # Prec
+                  (rd 14) ) ) ) )  # Skip
+
+      (in (list "bin/utf2" "-dd" (pack "if=" File) (pack "bs=" Hdr) "skip=1")
+         (prog1
+            (make
+               (do Cnt
+                  (setq X (make (do Siz (link (char)))))
+                  (when (<> "*" (pop 'X))
+                     (link
+                        (extract
+                           '((F)
+                              (let? S (pack (clip (cut (caddr F) 'X)))
+                                 (cons
+                                    (car F)
+                                    (case (cadr F)
+                                       ("C" S)
+                                       ("D" ($dat S))
+                                       ("L" (bool (member S `(chop "JjTt"))))
+                                       ("N" (format S (cdddr F)))
+                                       (T "?") ) ) ) )
+                           Fld ) ) ) ) )
+            (unless (= "^Z" (char))
+               (quit "Missing EOF") ) ) ) ) )
diff --git a/lib/debug.l b/lib/debug.l
@@ -0,0 +1,362 @@
+# 12mar10abu
+# (c) Software Lab. Alexander Burger
+
+# Browsing
+(de doc (Sym Browser)
+   (let (L (chop Sym)  C (car L))
+      (and
+         (member C '("*" "+"))
+         (cadr L)
+         (setq C @) )
+      (cond
+         ((>= "Z" C "A"))
+         ((>= "z" C "a") (setq C (uppc C)))
+         (T (setq C "_")) )
+      (call (or Browser (sys "BROWSER") 'w3m)
+         (pack
+            "file:"
+            (and (= `(char '/) (char (path "@"))) "//")
+            (path "@doc/ref")
+            C ".html#" Sym ) ) ) )
+
+(de more ("M" "Fun")
+   (let *Dbg NIL
+      (if (pair "M")
+         ((default "Fun" print) (pop '"M"))
+         (println (type "M"))
+         (setq
+            "Fun" (list '(X) (list 'pp 'X (lit "M")))
+            "M" (mapcar car (filter pair (val "M"))) ) )
+      (loop
+         (T (atom "M") (prinl))
+         (T (line) T)
+         ("Fun" (pop '"M")) ) ) )
+
+(de depth (Idx)  #> (max . average)
+   (let (C 0  D 0  N 0)
+      (cons
+         (recur (Idx N)
+            (ifn Idx
+               0
+               (inc 'C)
+               (inc 'D (inc 'N))
+               (inc
+                  (max
+                     (recurse (cadr Idx) N)
+                     (recurse (cddr Idx) N) ) ) ) )
+         (or (=0 C) (*/ D C)) ) ) )
+
+(de what (S)
+   (let *Dbg NIL
+      (setq S (chop S))
+      (filter
+         '(("X") (match S (chop "X")))
+         (all) ) ) )
+
+
+(de who ("X" . "*Prg")
+   (let (*Dbg NIL  "Who" '("Who" @ @@ @@@))
+      (make (mapc "who" (all))) ) )
+
+(de "who" ("Y")
+   (unless (or (ext? "Y") (memq "Y" "Who"))
+      (push '"Who" "Y")
+      (ifn (= `(char "+") (char "Y"))
+         (and (pair (val "Y")) ("nest" @) (link "Y"))
+         (for "Z" (val "Y")
+            (if (atom "Z")
+               (and ("match" "Z") (link "Y"))
+               (when ("nest" (cdr "Z"))
+                  (link (cons (car "Z") "Y")) ) ) )
+         (maps
+            '(("Z")
+               (if (atom "Z")
+                  (and ("match" "Z") (link "Y"))
+                  (when ("nest" (car "Z"))
+                     (link (cons (cdr "Z") "Y")) ) ) )
+            "Y" ) ) ) )
+
+(de "nest" ("Y")
+   ("nst1" "Y")
+   ("nst2" "Y") )
+
+(de "nst1" ("Y")
+   (let "Z" (setq "Y" (strip "Y"))
+      (loop
+         (T (atom "Y") (and (sym? "Y") ("who" "Y")))
+         (and (sym? (car "Y")) ("who" (car "Y")))
+         (and (pair (car "Y")) ("nst1" @))
+         (T (== "Z" (setq "Y" (cdr "Y")))) ) ) )
+
+(de "nst2" ("Y")
+   (let "Z" (setq "Y" (strip "Y"))
+      (loop
+         (T (atom "Y") ("match" "Y"))
+         (T (or ("match" (car "Y")) ("nst2" (car "Y")))
+            T )
+         (T (== "Z" (setq "Y" (cdr "Y")))) ) ) )
+
+(de "match" ("D")
+   (and
+      (cond
+         ((str? "X") (and (str? "D") (= "X" "D")))
+         ((sym? "X") (== "X" "D"))
+         (T (match "X" "D")) )
+      (or
+         (not "*Prg")
+         (let *Dbg (up 2 *Dbg) (run "*Prg")) ) ) )
+
+
+(de can (X)
+   (let *Dbg NIL
+      (extract
+         '(("Y")
+            (and
+               (= `(char "+") (char "Y"))
+               (asoq X (val "Y"))
+               (cons X "Y") ) )
+         (all) ) ) )
+
+
+# Class dependencies
+(de dep ("C")
+   (let *Dbg NIL
+      (dep1 0 "C")
+      (dep2 3 "C")
+      "C" ) )
+
+(de dep1 (N "C")
+   (for "X" (type "C")
+      (dep1 (+ 3 N) "X") )
+   (space N)
+   (println "C") )
+
+(de dep2 (N "C")
+   (for "X" (all)
+      (when
+         (and
+            (= `(char "+") (char "X"))
+            (memq "C" (type "X")) )
+         (space N)
+         (println "X")
+         (dep2 (+ 3 N) "X") ) ) )
+
+# Source code
+(off "*Vi")
+
+(in "@lib/tags"
+   (while (read)
+      (let Sym @
+         (if (get Sym '*Dbg)
+            (set @ (read))
+            (put Sym '*Dbg (cons (read))) ) ) ) )
+
+(de vi ("X" C)
+   (when (pair "X")
+      (setq C (cdr "X")  "X" (car "X")) )
+   (when
+      (if "X"
+         (setq "*Vi"
+            (if C
+               (get C '*Dbg -1 "X")
+               (get "X" '*Dbg 1) ) )
+         "*Vi" )
+      (call 'vim
+         (pack "+" (car "*Vi"))
+         (path (cdr "*Vi")) )
+      "X" ) )
+
+(de ld ()
+   (and "*Vi" (load (cdr "*Vi"))) )
+
+# Single-Stepping
+(de _dbg (Lst)
+   (or
+      (atom (car Lst))
+      (num? (caar Lst))
+      (flg? (caar Lst))
+      (== '! (caar Lst))
+      (set Lst (cons '! (car Lst))) ) )
+
+(de _dbg2 (Lst)
+   (map
+      '((L)
+         (if (and (pair (car L)) (flg? (caar L)))
+            (map _dbg (cdar L))
+            (_dbg L) ) )
+      Lst ) )
+
+(de dbg (Lst)
+   (when (pair Lst)
+      (case (pop 'Lst)
+         ((case state)
+            (_dbg Lst)
+            (for L (cdr Lst)
+               (map _dbg (cdr L)) ) )
+         ((cond nond)
+            (for L Lst
+               (map _dbg L) ) )
+         (quote
+            (when (fun? Lst)
+               (map _dbg (cdr Lst)) ) )
+         ((job use let let? recur)
+            (map _dbg (cdr Lst)) )
+         (loop
+            (_dbg2 Lst) )
+         ((bind do)
+            (_dbg Lst)
+            (_dbg2 (cdr Lst)) )
+         (for
+            (and (pair (car Lst)) (map _dbg (cdar Lst)))
+            (_dbg2 (cdr Lst)) )
+         (T (map _dbg Lst)) )
+      T ) )
+
+(de d () (let *Dbg NIL (dbg ^)))
+
+(de debug ("X" C)
+   (ifn (traced? "X" C)
+      (let *Dbg NIL
+         (when (pair "X")
+            (setq C (cdr "X")  "X" (car "X")) )
+         (or
+            (dbg (if C (method "X" C) (getd "X")))
+            (quit "Can't debug" "X") ) )
+      (untrace "X" C)
+      (debug "X" C)
+      (trace "X" C) ) )
+
+(de ubg (Lst)
+   (when (pair Lst)
+      (map
+         '((L)
+            (when (pair (car L))
+               (when (== '! (caar L))
+                  (set L (cdar L)) )
+               (ubg (car L)) ) )
+         Lst )
+      T ) )
+
+(de u () (let *Dbg NIL (ubg ^)))
+
+(de unbug ("X" C)
+   (let *Dbg NIL
+      (when (pair "X")
+         (setq C (cdr "X")  "X" (car "X")) )
+      (or
+         (ubg (if C (method "X" C) (getd "X")))
+         (quit "Can't unbug" "X") ) ) )
+
+# Tracing
+(de traced? ("X" C)
+   (setq "X"
+      (if C
+         (method "X" C)
+         (getd "X") ) )
+   (and
+      (pair "X")
+      (pair (cadr "X"))
+      (== '$ (caadr "X")) ) )
+
+# Convert ((X Y) A B) --> ((X Y) ($ foo (X Y) A B))
+(de trace ("X" C)
+   (let *Dbg NIL
+      (when (pair "X")
+         (setq C (cdr "X")  "X" (car "X")) )
+      (if C
+         (unless (traced? "X" C)
+            (or (method "X" C) (quit "Can't trace" "X"))
+            (con @
+               (cons
+                  (conc
+                     (list '$ (cons "X" C) (car @))
+                     (cdr @) ) ) ) )
+         (unless (traced? "X")
+            (and (sym? (getd "X")) (quit "Can't trace" "X"))
+            (and (num? (getd "X")) (expr "X"))
+            (set "X"
+               (list
+                  (car (getd "X"))
+                  (conc (list '$ "X") (getd "X")) ) ) ) )
+      "X" ) )
+
+# Convert ((X Y) ($ foo (X Y) A B)) --> ((X Y) A B)
+(de untrace ("X" C)
+   (let *Dbg NIL
+      (when (pair "X")
+         (setq C (cdr "X")  "X" (car "X")) )
+      (if C
+         (when (traced? "X" C)
+            (con
+               (method "X" C)
+               (cdddr (cadr (method "X" C))) ) )
+         (when (traced? "X")
+            (let X (set "X" (cddr (cadr (getd "X"))))
+               (and
+                  (== '@ (pop 'X))
+                  (= 1 (length X))
+                  (= 2 (length (car X)))
+                  (== 'pass (caar X))
+                  (sym? (cdadr X))
+                  (subr "X") ) ) ) )
+      "X" ) )
+
+(de *NoTrace
+   @ @@ @@@
+   pp show more led
+   what who can dep d e debug u unbug trace untrace )
+
+(de traceAll (Excl)
+   (let *Dbg NIL
+      (for "X" (all)
+         (or
+            (memq "X" Excl)
+            (memq "X" *NoTrace)
+            (= `(char "*") (char "X"))
+            (cond
+               ((= `(char "+") (char "X"))
+                  (mapc trace
+                     (extract
+                        '(("Y")
+                           (and
+                              (pair "Y")
+                              (fun? (cdr "Y"))
+                              (cons (car "Y") "X") ) )
+                        (val "X") ) ) )
+               ((pair (getd "X"))
+                  (trace "X") ) ) ) ) ) )
+
+# Process Listing
+(de proc @
+   (apply call
+      (make (while (args) (link "-C" (next))))
+      'ps "-H" "-o" "pid,ppid,start,size,pcpu,wchan,cmd" ) )
+
+# Hex Dump
+(de hd (File Cnt)
+   (in File
+      (let Pos 0
+         (while
+            (and
+               (nand Cnt (lt0 (dec 'Cnt)))
+               (make (do 16 (and (rd 1) (link @)))) )
+            (let L @
+               (prin (pad 8 (hex Pos)) "  ")
+               (inc 'Pos 16)
+               (for N L
+                  (prin (pad 2 (hex N)) " ") )
+               (space (inc (* 3 (- 16 (length L)))))
+               (for N L
+                  (prin (if (<= 32 N 127) (char N) ".")) )
+               (prinl) ) ) ) ) )
+
+# Benchmarking
+(de bench Prg
+   (let U (usec)
+      (prog1 (run Prg 1)
+         (out 2
+            (prinl
+               (format (*/ (- (usec) U) 1000) 3)
+               " sec" ) ) ) ) )
+
+# vi:et:ts=3:sw=3
diff --git a/lib/ed.l b/lib/ed.l
@@ -0,0 +1,47 @@
+# 27feb10abu
+# (c) Software Lab. Alexander Burger
+
+# Structure Editor
+(setq *Clip)
+
+(de ed ("X" "C")
+   (when (pair "X")
+      (setq  "C" (cdr "X")  "X" (car "X")) )
+   (catch NIL
+      (let (*Dbg NIL  "Done")
+         (ifn "C"
+            (set "X" (_ed (val "X")))
+            (and
+               (asoq "X" (val "C"))
+               (con @ (_ed (cdr @))) ) )
+         (pp "X" "C") ) ) )
+
+(de _ed (X)
+   (use C
+      (loop
+         (T "Done" X)
+         (pretty (car X))
+         (prinl)
+         (T (member (setq C (key)) '("^H" "^?")) X)
+         (T (= C "^I") (on "Done") X)
+         (setq X
+            (if (>= "9" C "1")
+               (cons
+                  (head (setq C (format  C)) X)
+                  (nth X (inc C)) )
+               (case (uppc C)
+                  (("^M" "^J") (cons (_ed (car X)) (cdr X)))
+                  ("^[" (throw))
+                  (" " (cons (car X) (_ed (cdr X))))
+                  ("D" (cdr X))
+                  ("I" (prin "Insert:") (cons (read) X))
+                  ("R" (prin "Replace:") (cons (read) (cdr X)))
+                  ("X" (setq *Clip (car X)) (cdr X))
+                  ("C" (setq *Clip (car X)) X)
+                  ("V" (cons *Clip X))
+                  ("0" (append (car X) (cdr X)))
+                  ("B"
+                     (if (== '! (caar X))
+                        (cons (cdar X) (cdr X))
+                        (cons (cons '! (car X)) (cdr X)) ) )
+                  (T X) ) ) ) ) ) )
diff --git a/lib/edit.l b/lib/edit.l
@@ -0,0 +1,66 @@
+# 10mar10abu
+# (c) Software Lab. Alexander Burger
+
+# "*F" "*Lst" "*X" "*K"
+
+(de edit @
+   (let *Dbg NIL
+      (setq "*F" (tmp '"edit.l"))
+      (catch NIL
+         ("edit" (rest)) ) ) )
+
+(de "edit" ("Lst")
+   (let "N" 1
+      (loop
+         (out "*F"
+            (setq "*Lst"
+               (make
+                  (for "S" "Lst"
+                     ("loc" (printsp "S"))
+                     ("loc" (val "S"))
+                     (pretty (val "S"))
+                     (prinl)
+                     (for "X" (sort (getl "S"))
+                        ("loc" "X")
+                        (space 3)
+                        (if (atom "X")
+                           (println "X" T)
+                           (printsp (cdr "X"))
+                           (pretty (setq "X" (car "X")) -3)
+                           (cond
+                              ((type "X")
+                                 (prin "  # ")
+                                 (print @) )
+                              ((>= 799999 "X" 700000)
+                                 (prin "  # " (datStr "X")) ) )
+                           (prinl) ) )
+                     (prinl)
+                     (println '(********))
+                     (prinl) ) ) ) )
+         (call 'vim
+            "+set isk=@,33-34,36-38,42-90,92,94-95,97-125"
+            "+map K yw:call setline(line(\"$\"), \"(\" . line(\".\") . \" \" . @@ . \")\")^MZZ"
+            "+map Q GC(0)^[ZZ"
+            (pack "+" "N")
+            "*F" )
+         (apply ==== "*Lst")
+         (in "*F"
+            (while (and (setq "*X" (read)) (atom "*X"))
+               (def "*X" (read))
+               (until (= '(********) (setq "*K" (read)))
+                  (def "*X" "*K" (read)) ) ) )
+         (====)
+         (NIL "*X" (throw))
+         (T (=0 (car "*X")))
+         (setq "N" (car "*X"))
+         ("edit" (conc (cdr "*X") "Lst")) ) ) )
+
+(de "loc" ("X" "Lst")
+   (cond
+      ((memq "X" "Lst"))
+      ((and (str? "X") (not (memq "X" (made))))
+         (link "X") )
+      ((pair "X")
+         (push '"Lst" "X")
+         ("loc" (car "X") "Lst")
+         ("loc" (cdr "X") "Lst") ) ) )
diff --git a/lib/el/inferior-picolisp.el b/lib/el/inferior-picolisp.el
@@ -0,0 +1,312 @@
+;;;;;; inferior-picolisp: Picolisp repl in a buffer.
+;;;;;; Version: 1.0
+
+;;; Copyright (c) 2009, Guillermo R. Palavecino
+
+;; This file is NOT part of GNU emacs.
+
+;;;; Credits:
+;; It's and adaptation of GNU emacs' cmuscheme.el
+;;
+;;;; Contact:
+;; For comments, bug reports, questions, etc, you can contact me via IRC
+;; to the user named grpala (or armadillo) on irc.freenode.net in the
+;; #picolisp channel or via email to the author's nickname at gmail.com
+;;
+;;;; License:
+;; This work is released under the GPL 2 or (at your option) any later
+;; version.
+
+(require 'picolisp)
+(require 'comint)
+
+
+(defgroup picolisp nil
+  "Run an Picolisp process in a buffer."
+  :group 'picolisp )
+
+;;; INFERIOR PICOLISP MODE STUFF
+;;;============================================================================
+
+(defcustom inferior-picolisp-mode-hook nil
+  "*Hook for customizing inferior-picolisp mode."
+  :type 'hook
+  :group 'picolisp )
+
+(defvar inferior-picolisp-mode-map
+  (let ((m (make-sparse-keymap)))
+    (define-key m "\M-\C-x" 'picolisp-send-definition) ;gnu convention
+    (define-key m "\C-x\C-e" 'picolisp-send-last-sexp)
+    (define-key m "\C-c\C-l" 'picolisp-load-file)
+    m ) )
+
+(defvar picolisp-program-name "/usr/bin/picolisp"
+  "The name of the program used to run Picolisp." )
+
+;; Install the process communication commands in the picolisp-mode keymap.
+(define-key picolisp-mode-map "\M-\C-x" 'picolisp-send-definition);gnu convention
+(define-key picolisp-mode-map "\C-x\C-e" 'picolisp-send-last-sexp);gnu convention
+(define-key picolisp-mode-map "\C-c\C-e" 'picolisp-send-definition)
+(define-key picolisp-mode-map "\C-c\M-e" 'picolisp-send-definition-and-go)
+(define-key picolisp-mode-map "\C-c\C-r" 'picolisp-send-region)
+(define-key picolisp-mode-map "\C-c\M-r" 'picolisp-send-region-and-go)
+(define-key picolisp-mode-map "\C-c\C-x" 'switch-to-picolisp)
+(define-key picolisp-mode-map "\C-c\C-l" 'picolisp-load-file)
+
+(let ((map (lookup-key picolisp-mode-map [menu-bar picolisp])))
+  (define-key map [separator-eval] '("--"))
+  (define-key map [load-file]
+    '("Load Picolisp File" . picolisp-load-file) )
+  (define-key map [switch]
+    '("Switch to Picolisp" . switch-to-picolisp) )
+  (define-key map [send-def-go]
+    '("Evaluate Last Definition & Go" . picolisp-send-definition-and-go) )
+  (define-key map [send-def]
+    '("Evaluate Last Definition" . picolisp-send-definition) )
+  (define-key map [send-region-go]
+    '("Evaluate Region & Go" . picolisp-send-region-and-go) )
+  (define-key map [send-region]
+    '("Evaluate Region" . picolisp-send-region) )
+  (define-key map [send-sexp]
+    '("Evaluate Last S-expression" . picolisp-send-last-sexp) ) )
+
+(defvar picolisp-buffer)
+
+(define-derived-mode inferior-picolisp-mode comint-mode "Inferior Picolisp"
+  "Major mode for interacting with an inferior Picolisp process.
+
+The following commands are available:
+\\{inferior-picolisp-mode-map}
+
+An Picolisp process can be fired up with M-x run-picolisp.
+
+Customization: Entry to this mode runs the hooks on comint-mode-hook and
+inferior-picolisp-mode-hook (in that order).
+
+You can send text to the inferior Picolisp process from other buffers containing
+Picolisp source.
+    switch-to-picolisp switches the current buffer to the Picolisp process buffer.
+    picolisp-send-definition sends the current definition to the Picolisp process.
+    picolisp-send-region sends the current region to the Picolisp process.
+
+    picolisp-send-definition-and-go and picolisp-send-region-and-go
+        switch to the Picolisp process buffer after sending their text.
+For information on running multiple processes in multiple buffers, see
+documentation for variable picolisp-buffer.
+
+Commands:
+Return after the end of the process' output sends the text from the
+    end of process to point.
+Return before the end of the process' output copies the sexp ending at point
+    to the end of the process' output, and sends it.
+Delete converts tabs to spaces as it moves back.
+Tab indents for Picolisp; with argument, shifts rest
+    of expression rigidly with the current line.
+C-M-q does Tab on each line starting within following expression.
+Paragraphs are separated only by blank lines.  Semicolons start comments.
+If you accidentally suspend your process, use \\[comint-continue-subjob]
+to continue it."
+  ;; Customize in inferior-picolisp-mode-hook
+  (picolisp-mode-variables)
+  (setq comint-prompt-regexp "^[^\n:?!]*[?!:]+ *")
+  (setq comint-prompt-read-only nil)
+  (setq comint-input-filter (function picolisp-input-filter))
+  (setq comint-get-old-input (function picolisp-get-old-input))
+  (setq mode-line-process '(":%s"))
+  (setq comint-input-ring-file-name "~/.pil_history") )
+
+(defcustom inferior-picolisp-filter-regexp "\\`\\s *\\S ?\\S ?\\s *\\'"
+  "*Input matching this regexp are not saved on the history list.
+Defaults to a regexp ignoring all inputs of 0, 1, or 2 letters."
+  :type 'regexp
+  :group 'picolisp )
+
+(defun picolisp-input-filter (str)
+  "Don't save anything matching `inferior-picolisp-filter-regexp'."
+  (not (string-match inferior-picolisp-filter-regexp str)) )
+
+
+(defun picolisp-get-old-input ()
+  "Snarf the sexp ending at point."
+  (save-excursion
+    (let ((end (point)))
+      (backward-sexp)
+      (buffer-substring (point) end) ) ) )
+
+;;;###autoload
+(defun run-picolisp (cmd)
+  "Run an inferior Picolisp process, input and output via buffer `*picolisp*'.
+If there is a process already running in `*picolisp*', switch to that buffer.
+With argument, allows you to edit the command line (default is value
+of `picolisp-program-name').
+Runs the hook `inferior-picolisp-mode-hook' \(after the `comint-mode-hook'
+is run).
+\(Type \\[describe-mode] in the process buffer for a list of commands.)"
+
+  (interactive (list (if current-prefix-arg
+                         (read-string "Run Picolisp: " picolisp-program-name)
+                         picolisp-program-name ) ) )
+  (when (not (comint-check-proc "*picolisp*"))
+    (let ((cmdlist (split-string cmd)))
+      (set-buffer (apply 'make-comint "picolisp" (car cmdlist)
+                         nil (cdr cmdlist) ) )
+      (inferior-picolisp-mode) ) )
+  (setq picolisp-program-name cmd)
+  (setq picolisp-buffer "*picolisp*")
+  (pop-to-buffer "*picolisp*") )
+;;;###autoload (add-hook 'same-window-buffer-names "*picolisp*")
+
+(defun picolisp-send-region (start end)
+  "Send the current region to the inferior Picolisp process."
+  (interactive "r")
+  (let ((regionsubstring (replace-regexp-in-string "^
+" "" (buffer-substring start end) ) ) )
+    (comint-send-string 
+     (picolisp-proc) 
+     (if (string= "" (car (last (split-string regionsubstring "
+" ) ) ) )
+         regionsubstring
+       (concat regionsubstring "\n") ) ) ) )
+
+(defun picolisp-send-definition ()
+  "Send the current definition to the inferior Picolisp process."
+  (interactive)
+  (save-excursion
+    (end-of-defun)
+    (let ((end (point)))
+      (beginning-of-defun)
+      (picolisp-send-region
+       (point) (progn (forward-sexp) (point)) ) ) ) )
+
+(defun picolisp-send-last-sexp ()
+  "Send the previous sexp to the inferior Picolisp process."
+  (interactive)
+  (picolisp-send-region (save-excursion (backward-sexp) (point)) (point)) )
+
+(defun switch-to-picolisp (eob-p)
+  "Switch to the picolisp process buffer.
+With argument, position cursor at end of buffer."
+  (interactive "P")
+  (if (or (and picolisp-buffer (get-buffer picolisp-buffer))
+          (picolisp-interactively-start-process) )
+      (pop-to-buffer picolisp-buffer)
+    (error "No current process buffer.  See variable `picolisp-buffer'") )
+  (when eob-p
+    (push-mark)
+    (goto-char (point-max)) ) )
+
+(defun picolisp-send-region-and-go (start end)
+  "Send the current region to the inferior Picolisp process.
+Then switch to the process buffer."
+  (interactive "r")
+  (picolisp-send-region start end)
+  (switch-to-picolisp t) )
+
+(defun picolisp-send-definition-and-go ()
+  "Send the current definition to the inferior Picolisp.
+Then switch to the process buffer."
+  (interactive)
+  (picolisp-send-definition)
+  (switch-to-picolisp t) )
+
+(defcustom picolisp-source-modes '(picolisp-mode)
+  "*Used to determine if a buffer contains Picolisp source code.
+If it's loaded into a buffer that is in one of these major modes,
+it's considered a picolisp source file by `picolisp-load-file'.  Used by
+these commands to determine defaults."
+  :type '(repeat function)
+  :group 'picolisp )
+
+(defvar picolisp-prev-load-dir/file nil
+  "Caches the last (directory . file) pair.
+Caches the last pair used in the last `picolisp-load-file' command.
+Used for determining the default in the next one." )
+
+(defun picolisp-load-file (file-name)
+  "Load a Picolisp file FILE-NAME into the inferior Picolisp process."
+  (interactive (comint-get-source "Load Picolisp file: " picolisp-prev-load-dir/file
+                                  picolisp-source-modes t ) ) ; t because `load'
+                                                       ; needs an exact name
+  (comint-check-source file-name) ; Check to see if buffer needs saved.
+  (setq picolisp-prev-l/c-dir/file (cons (file-name-directory    file-name)
+                                       (file-name-nondirectory file-name) ) )
+  (comint-send-string (picolisp-proc) (concat "(load \""
+                                            file-name
+                                            "\"\)\n" ) ) )
+
+
+(defvar picolisp-buffer nil "*The current picolisp process buffer.
+
+MULTIPLE PROCESS SUPPORT
+===========================================================================
+inferior-picolisp.el supports, in a fairly simple fashion, running multiple Picolisp
+processes.  To run multiple Picolisp processes, you start the first up with
+\\[run-picolisp].  It will be in a buffer named *picolisp*.  Rename this buffer
+with \\[rename-buffer].  You may now start up a new process with another
+\\[run-picolisp].  It will be in a new buffer, named *picolisp*.  You can
+switch between the different process buffers with \\[switch-to-buffer].
+
+Commands that send text from source buffers to Picolisp processes -- like
+`picolisp-send-definition' -- have to choose a process to send to, when you
+have more than one Picolisp process around.  This is determined by the
+global variable `picolisp-buffer'.  Suppose you have three inferior Picolisps
+running:
+    Buffer      Process
+    foo         picolisp
+    bar         picolisp<2>
+    *picolisp*  picolisp<3>
+If you do a \\[picolisp-send-definition-and-go] command on some Picolisp source
+code, what process do you send it to?
+
+- If you're in a process buffer (foo, bar, or *picolisp*),
+  you send it to that process.
+- If you're in some other buffer (e.g., a source file), you
+  send it to the process attached to buffer `picolisp-buffer'.
+This process selection is performed by function `picolisp-proc'.
+
+Whenever \\[run-picolisp] fires up a new process, it resets `picolisp-buffer'
+to be the new process's buffer.  If you only run one process, this will
+do the right thing.  If you run multiple processes, you can change
+`picolisp-buffer' to another process buffer with \\[set-variable].
+
+More sophisticated approaches are, of course, possible.  If you find yourself
+needing to switch back and forth between multiple processes frequently,
+you may wish to consider ilisp.el, a larger, more sophisticated package
+for running inferior Lisp and Picolisp processes.  The approach taken here is
+for a minimal, simple implementation.  Feel free to extend it." )
+
+(defun picolisp-proc ()
+  "Return the current Picolisp process, starting one if necessary.
+See variable `picolisp-buffer'."
+  (unless (and picolisp-buffer
+               (get-buffer picolisp-buffer)
+               (comint-check-proc picolisp-buffer) )
+    (picolisp-interactively-start-process) )
+  (or (picolisp-get-process)
+      (error "No current process.  See variable `picolisp-buffer'") ) )
+
+(defun picolisp-get-process ()
+  "Return the current Picolisp process or nil if none is running."
+  (get-buffer-process (if (eq major-mode 'inferior-picolisp-mode)
+                          (current-buffer)
+                        picolisp-buffer ) ) )
+
+(defun picolisp-interactively-start-process (&optional cmd)
+  "Start an inferior Picolisp process.  Return the process started.
+Since this command is run implicitly, always ask the user for the
+command to run."
+  (save-window-excursion
+    (run-picolisp (read-string "Run Picolisp: " picolisp-program-name)) ) )
+
+;;; Do the user's customization...
+
+(defcustom inferior-picolisp-load-hook nil
+  "This hook is run when inferior-picolisp is loaded in.
+This is a good place to put keybindings."
+  :type 'hook
+  :group 'picolisp )
+
+(run-hooks 'inferior-picolisp-load-hook)
+
+(provide 'inferior-picolisp)
+
diff --git a/lib/el/paredit.el.diff b/lib/el/paredit.el.diff
@@ -0,0 +1,89 @@
+--- /usr/share/emacs/site-lisp/paredit/paredit.el	2009-07-28 20:43:11.000000000 -0300
++++ src/el/paredit.el	2009-12-15 04:39:31.000000000 -0300
+@@ -683,7 +683,8 @@
+ (defun paredit-move-past-close (close)
+   (cond ((or (paredit-in-string-p)
+              (paredit-in-comment-p))
+-         (insert close))
++         (insert close)
++         (paredit-delete-leading-whitespace))
+         ((not (paredit-in-char-p))
+          (paredit-move-past-close-and-reindent close)
+          (paredit-blink-paren-match nil))))
+@@ -691,7 +692,8 @@
+ (defun paredit-move-past-close-and-newline (close)
+   (if (or (paredit-in-string-p)
+           (paredit-in-comment-p))
+-      (insert close)
++      (progn (insert close)
++             (paredit-delete-leading-whitespace))
+     (if (paredit-in-char-p) (forward-char))
+     (paredit-move-past-close-and-reindent close)
+     (let ((comment.point (paredit-find-comment-on-line)))
+@@ -747,6 +749,7 @@
+                             (point))))
+               (regionp (funcall forward (+ end (if spacep 2 1)))))
+         (insert close)
++        (paredit-delete-leading-whitespace)
+         (if (paredit-space-for-delimiter-p t close)
+             (insert " "))))))
+ 
+@@ -784,7 +787,8 @@
+         (if (eq close (matching-paren open))
+             (save-excursion
+               (message "Missing closing delimiter: %c" close)
+-              (insert close))
++              (insert close)
++              (paredit-delete-leading-whitespace))
+             (error "Mismatched missing closing delimiter: %c ... %c"
+                    open close))))
+   (let ((orig (point)))
+@@ -1543,6 +1547,7 @@
+                ((paredit-region-active-p) nil)
+                (t 1)))
+       (insert close)
++      (paredit-delete-leading-whitespace)
+       (backward-char)))
+   (save-excursion (backward-up-list) (indent-sexp)))
+ 
+@@ -1791,8 +1796,10 @@
+           (setq close                   ; adjusting for mixed
+                 (prog1 (char-before)    ;   delimiters as necessary,
+                   (backward-delete-char 1)
+-                  (insert close))))))
+-    (insert close)))                    ; to insert that delimiter.
++                  (insert close)
++                  (paredit-delete-leading-whitespace))))))
++    (insert close)                      ; to insert that delimiter.
++    (paredit-delete-leading-whitespace)))
+ 
+ (defun paredit-forward-slurp-into-string ()
+   (goto-char (1+ (cdr (paredit-string-start+end-points))))
+@@ -1802,7 +1809,8 @@
+   (let ((close (char-before)))
+     (backward-delete-char 1)
+     (paredit-forward-for-quote (save-excursion (forward-sexp) (point)))
+-    (insert close)))
++    (insert close)
++    (paredit-delete-leading-whitespace)))
+ 
+ (defun paredit-forward-barf-sexp ()
+   "Remove the last S-expression in the current list from that list
+@@ -1822,7 +1830,8 @@
+              (error "Barfing all subexpressions with no open-paren?"))
+             ((paredit-in-comment-p)     ; Don't put the close-paren in
+              (newline-and-indent)))     ;   a comment.
+-      (insert close))
++      (insert close)
++      (paredit-delete-leading-whitespace))
+     ;; Reindent all of the newly barfed S-expressions.
+     (paredit-forward-and-indent)))
+ 
+@@ -1919,6 +1928,7 @@
+                                         (char-before))))
+              (delete-horizontal-space)
+              (insert close)
++             (paredit-delete-leading-whitespace)
+              (save-excursion (insert ?\ )
+                              (insert open)
+                              (backward-char)
diff --git a/lib/el/picolisp.el b/lib/el/picolisp.el
@@ -0,0 +1,536 @@
+;;;;;; picolisp-mode: Major mode to edit picoLisp.
+;;;;;; Version: 1.1
+
+;;; Copyright (c) 2009, Guillermo R. Palavecino
+
+;; This file is NOT part of GNU emacs.
+
+;;;; Credits:
+;; It's based on GNU emacs' lisp-mode and scheme-mode.
+;; Some bits were taken from paredit.el
+;;
+;;;; Contact:
+;; For comments, bug reports, questions, etc, you can contact me via IRC
+;; to the user named grpala (or armadillo) on irc.freenode.net in the
+;; #picolisp channel or via email to the author's nickname at gmail.com
+;;
+;;;; License:
+;; This work is released under the GPL 2 or (at your option) any later
+;; version.
+
+(require 'lisp-mode)
+
+(defcustom picolisp-parsep t
+  "This is to toggle picolisp-mode's multi-line s-exps closing parens separation capability."
+  :type 'boolean
+  :group 'picolisp )
+
+;; I know... this shouldn't be here, but you see, people may want to keep
+;; their body-indent value unaltered and have a different one for picolisp
+;; sources, so...
+(defcustom picolisp-body-indent 3
+  "Number of columns to indent the second line of a `(de ...)' form."
+  :group 'picolisp
+  :type 'integer )
+
+(defvar picolisp-mode-syntax-table
+  (let ((st (make-syntax-table))
+        (i 0) )
+
+    ;; Default is atom-constituent.
+    (while (< i 256)
+      (modify-syntax-entry i "_   " st)
+      (setq i (1+ i)) )
+
+    ;; Word components.
+    (setq i ?0)
+    (while (<= i ?9)
+      (modify-syntax-entry i "w   " st)
+      (setq i (1+ i)) )
+    (setq i ?A)
+    (while (<= i ?Z)
+      (modify-syntax-entry i "w   " st)
+      (setq i (1+ i)) )
+    (setq i ?a)
+    (while (<= i ?z)
+      (modify-syntax-entry i "w   " st)
+      (setq i (1+ i)) )
+
+    ;; Whitespace
+    (modify-syntax-entry ?\t "    " st)
+    (modify-syntax-entry ?\n ">   " st)
+    (modify-syntax-entry ?\f "    " st)
+    (modify-syntax-entry ?\r "    " st)
+    (modify-syntax-entry ?\s "    " st)
+
+    ;; These characters are delimiters but otherwise undefined.
+    ;; Brackets and braces balance for editing convenience.
+    (modify-syntax-entry ?\[ "(]  " st)
+    (modify-syntax-entry ?\] ")[  " st)
+    (modify-syntax-entry ?{  "(}  " st)
+    (modify-syntax-entry ?}  "){  " st)
+
+    ;; Other atom delimiters
+    (modify-syntax-entry ?\( "()  " st)
+    (modify-syntax-entry ?\) ")(  " st)
+    ;; It's used for single-line comments.
+    (modify-syntax-entry ?#  "<   " st)
+    (modify-syntax-entry ?\" "\"   " st)
+    (modify-syntax-entry ?'  "'   " st)
+    (modify-syntax-entry ?`  "'   " st)
+    (modify-syntax-entry ?~  "'   " st)
+
+    ;; Special characters
+    (modify-syntax-entry ?,  "'   " st)
+    (modify-syntax-entry ?\\ "\\   " st)
+    st ) )
+
+(defvar picolisp-mode-abbrev-table nil)
+(define-abbrev-table 'picolisp-mode-abbrev-table ())
+
+(defun picolisp-mode-variables ()
+  (set-syntax-table picolisp-mode-syntax-table)
+  ;;(setq local-abbrev-table picolisp-mode-abbrev-table)
+  (make-local-variable 'paragraph-start)
+  (setq paragraph-start (concat "$\\|" page-delimiter))
+  ;;(setq comint-input-ring-file-name "~/.pil_history")
+
+  (make-local-variable 'paragraph-separate)
+  (setq paragraph-separate paragraph-start)
+
+  (make-local-variable 'paragraph-ignore-fill-prefix)
+  (setq paragraph-ignore-fill-prefix t)
+
+  (make-local-variable 'fill-paragraph-function)
+  (setq fill-paragraph-function 'lisp-fill-paragraph)
+  ;; Adaptive fill mode gets in the way of auto-fill,
+  ;; and should make no difference for explicit fill
+  ;; because lisp-fill-paragraph should do the job.
+  (make-local-variable 'adaptive-fill-mode)
+  (setq adaptive-fill-mode nil)
+
+  (make-local-variable 'normal-auto-fill-function)
+  (setq normal-auto-fill-function 'lisp-mode-auto-fill)
+
+  (make-local-variable 'indent-line-function)
+  (setq indent-line-function 'picolisp-indent-line)
+
+  (make-local-variable 'parse-sexp-ignore-comments)
+  (setq parse-sexp-ignore-comments t)
+
+  (make-local-variable 'comment-start)
+  (setq comment-start "#")
+
+  (set (make-local-variable 'comment-add) 1)
+  (make-local-variable 'comment-start-skip)
+  ;; Look within the line for a # following an even number of backslashes
+  ;; after either a non-backslash or the line beginning.
+  (setq comment-start-skip "\\(\\(^\\|[^\\\\\n]\\)\\(\\\\\\\\\\)*\\)#+[ \t]*");  ((^|[^\n])(\\\\)*)#+[ t]*
+  (set (make-local-variable 'font-lock-comment-start-skip) "#+ *")
+
+  (make-local-variable 'comment-column)
+  (setq comment-column 40)
+
+  (make-local-variable 'parse-sexp-ignore-comments)
+  (setq parse-sexp-ignore-comments t)
+
+  (make-local-variable 'lisp-indent-function)
+  (setq lisp-indent-function 'picolisp-indent-function)
+
+  ;; This is just to avoid tabsize-variations fuck-up.
+  (make-local-variable 'indent-tabs-mode)
+
+  (setq mode-line-process '("" picolisp-mode-line-process))
+  (set (make-local-variable 'font-lock-defaults)
+       '((picolisp-font-lock-keywords
+          picolisp-font-lock-keywords-1
+          picolisp-font-lock-keywords-2 )
+         nil t (("+-*/.<>=!?$%_&~^:" . "w"))
+         beginning-of-defun
+         (font-lock-mark-block-function . mark-defun)
+         (font-lock-keywords-case-fold-search . nil)
+         (parse-sexp-lookup-properties . t)
+         (font-lock-extra-managed-props syntax-table) ) )
+  (set (make-local-variable 'lisp-doc-string-elt-property)
+       'picolisp-doc-string-elt ) )
+
+(defvar picolisp-mode-line-process "")
+
+(defvar picolisp-mode-map
+  (let ((map (make-sparse-keymap "Picolisp")))
+    (set-keymap-parent map lisp-mode-shared-map)
+    (define-key map [menu-bar picolisp] (cons "Picolisp" map))
+    (define-key map [run-picolisp] '("Run Inferior Picolisp" . run-picolisp))
+    (define-key map [uncomment-region]
+      '("Uncomment Out Region" . (lambda (beg end)
+                                   (interactive "r")
+                                   (comment-region beg end '(4)) ) ) )
+    (define-key map [comment-region] '("Comment Out Region" . comment-region))
+    (define-key map [indent-region] '("Indent Region" . indent-region))
+    (define-key map [indent-line] '("Indent Line" . picolisp-indent-line))
+    (define-key map "\t" 'picolisp-indent-line)
+    (put 'comment-region 'menu-enable 'mark-active)
+    (put 'uncomment-region 'menu-enable 'mark-active)
+    (put 'indent-region 'menu-enable 'mark-active)
+    map )
+  "Keymap for Picolisp mode.
+All commands in `lisp-mode-shared-map' are inherited by this map." )
+
+
+;;;###autoload
+(defun picolisp-mode ()
+  "Major mode for editing Picolisp code.
+Editing commands are similar to those of `lisp-mode'.
+
+Commands:
+Delete converts tabs to spaces as it moves back.
+Blank lines separate paragraphs.  Semicolons start comments.
+\\{picolisp-mode-map}
+Entry to this mode calls the value of `picolisp-mode-hook'
+if that value is non-nil."
+  (interactive)
+  (remove-text-properties (point-min) (point-max) '(display ""))
+  (kill-all-local-variables)
+  (use-local-map picolisp-mode-map)
+  (setq major-mode 'picolisp-mode)
+  (setq mode-name "Picolisp")
+  (picolisp-mode-variables)
+  (run-mode-hooks 'picolisp-mode-hook)
+  (defun paredit-delete-leading-whitespace ()
+    (picolisp-delete-leading-whitespace) ) )
+
+(autoload 'run-picolisp "inferior-picolisp"
+  "Run an inferior Picolisp process, input and output via buffer `*picolisp*'.
+If there is a process already running in `*picolisp*', switch to that buffer.
+With argument, allows you to edit the command line (default is value
+of `picolisp-program-name').
+Runs the hook `inferior-picolisp-mode-hook' \(after the `comint-mode-hook'
+is run).
+\(Type \\[describe-mode] in the process buffer for a list of commands.)"
+  t )
+
+(defgroup picolisp nil
+  "Editing Picolisp code."
+  :link '(custom-group-link :tag "Font Lock Faces group" font-lock-faces)
+  :group 'lisp )
+
+(defcustom picolisp-mode-hook nil
+  "Normal hook run when entering `picolisp-mode'.
+See `run-hooks'."
+  :type 'hook
+  :group 'picolisp )
+
+(defconst picolisp-font-lock-keywords-1
+  (eval-when-compile
+    (list
+     ;;
+     ;; Declarations.
+     (list 
+      (concat "(" (regexp-opt '("be" "de" "dm" "set" "setq") t) "\\>"
+              ;; Any whitespace and declared object.
+              "[ \t]*(?"
+              "\\(\\sw+\\)?" )
+      '(1 font-lock-keyword-face)
+      '(2 (cond ((match-beginning 0) font-lock-function-name-face)
+                ((match-beginning 3) font-lock-variable-name-face)
+                (t font-lock-type-face) )
+          nil t ) )
+     (list (concat "[( \t]'?"
+                   (regexp-opt '("NIL" "T") t)  
+                   "[ )\n\t]" )
+           '(1 font-lock-constant-face) )
+     (list
+      (concat "[( ]"
+              (regexp-opt '("*OS" "*DB" "*Solo" "*PPid" "*Pid" "@" "@@" "@@@"
+                            "This" "*Dbg" "*Zap" "*Scl" "*Class" "*Dbs" "*Run"
+                            "*Hup" "*Sig1" "*Sig2" "^" "*Err" "*Msg" "*Uni" 
+                            "*Led" "*Adr" "*Allow" "*Fork" "*Bye" ) t )
+              "[ )\n\t]" )
+      '(1 font-lock-builtin-face) )
+     ;; This is so we make the point used in conses more visible
+     '("[ \t]\\(\\.\\)[ \t)]" (1 font-lock-negation-char-face))
+     '("(\\(====\\)\\>" (1 font-lock-negation-char-face)) ) )
+  "Subdued expressions to highlight in Picolisp modes." )
+
+(defconst picolisp-font-lock-keywords-2
+  (append picolisp-font-lock-keywords-1
+          (eval-when-compile
+            (list
+             ;;
+             ;; Control structures.
+             (cons
+              (concat
+               "(" (regexp-opt
+                    '( ;; Symbol Functions
+                      "new" "sym" "str" "char" "name" "sp?" "pat?" "fun?" "all" 
+                      "intern" "extern" "qsym" "loc" "box?" "str?" "ext?" 
+                      "touch" "zap" "length" "size" "format" "chop" "pack" 
+                      "glue" "pad" "align" "center" "text" "wrap" "pre?" "sub?" 
+                      "low?" "upp?" "lowc" "uppc" "fold" "val" "getd" "set" 
+                      "setq" "def" "de" "dm" "recur" "undef" "redef" "daemon" 
+                      "patch" "xchg" "on" "off" "onOff" "zero" "one" "default" 
+                      "expr" "subr" "let" "let?" "use" "accu" "push" "push1" 
+                      "pop" "cut" "del" "queue" "fifo" "idx" "lup" "cache" 
+                      "locale" "dirname"
+                      ;; Property Access
+                      "put" "get" "prop" ";" "=:" ":" "::" "putl" "getl" "wipe" 
+                      "meta"
+                      ;; Predicates
+                      "atom" "pair" "lst?" "num?" "sym?" "flg?" "sp?" "pat?" 
+                      "fun?" "box?" "str?" "ext?" "bool" "not" "==" "n==" "=" 
+                      "<>" "=0" "=T" "n0" "nT" "<" "<=" ">" ">=" "match"
+                      ;; Arithmetics
+                      "+" "-" "*" "/" "%" "*/" "**" "inc" "dec" ">>" "lt0" 
+                      "ge0" "gt0" "abs" "bit?" "&" "|" "x|" "sqrt" "seed" 
+                      "rand" "max" "min" "length" "size" "accu" "format" "pad" 
+                      "oct" "hex" "fmt64" "money"
+                      ;; List Processing
+                      "car" "cdr" "caar" "cadr" "cdar" "cddr" "caaar" "caadr" 
+                      "cadar" "caddr" "cdaar" "cdadr" "cddar" "cdddr" "cadddr" 
+                      "cddddr" "nth" "con" "cons" "conc" "circ" "rot" "list" 
+                      "need" "full" "make" "made" "chain" "link" "yoke" "copy" 
+                      "mix" "append" "delete" "delq" "replace" "insert" 
+                      "remove" "place" "strip" "split" "reverse" "flip" "trim" 
+                      "clip" "head" "tail" "stem" "fin" "last" "member" "memq" 
+                      "mmeq" "sect" "diff" "index" "offset" "assoc" "asoq" 
+                      "rank" "sort" "uniq" "group" "length" "size" "val" "set" 
+                      "xchg" "push" "push1" "pop" "cut" "queue" "fifo" "idx" 
+                      "balance" "get" "fill" "apply" "range"
+                      ;; Control Flow
+                      "load" "args" "next" "arg" "rest" "pass" "quote" "as" 
+                      "pid" "lit" "eval" "run" "macro" "curry" "def" "de" "dm" 
+                      "recur" "recurse" "undef" "box" "new" "type" "isa" 
+                      "method" "meth" "send" "try" "super" "extra" "with" 
+                      "bind" "job" "let" "let?" "use" "and" "or" "nand" "nor" 
+                      "xor" "bool" "not" "nil" "t" "prog" "prog1" "prog2" "if" 
+                      "if2" "ifn" "when" "unless" "cond" "nond" "case" "state" 
+                      "while" "until" "loop" "do" "at" "for" "catch" "throw" 
+                      "finally" "!" "e" "$" "sys" "call" "tick" "ipid" "opid" 
+                      "kill" "quit" "task" "fork" "pipe" "later" "timeout" 
+                      "abort" "bye"
+                      ;; Mapping
+                      "apply" "pass" "maps" "map" "mapc" "maplist" "mapcar" 
+                      "mapcon" "mapcan" "filter" "extract" "seek" "find" "pick" 
+                      "cnt" "sum" "maxi" "mini" "fish" "by" 
+                      ;; Input/Output
+                      "path" "in" "ipid" "out" "opid" "pipe" "ctl" "any" "sym" 
+                      "str" "load" "hear" "tell" "key" "poll" "peek" "char" 
+                      "skip" "eol" "eof" "from" "till" "line" "format" "scl" 
+                      "read" "print" "println" "printsp" "prin" "prinl" "msg" 
+                      "space" "beep" "tab" "flush" "rewind" "rd" "pr" "wr" 
+                      "rpc" "wait" "sync" "echo" "info" "file" "dir" "lines" 
+                      "open" "close" "port" "listen" "accept" "host" "connect" 
+                      "nagle" "udp" "script" "once" "rc" "pretty" "pp" "show" 
+                      "view" "here" "prEval" "mail"
+                      ;; Object Orientation
+                      "*Class" "class" "dm" "rel" "var" "var:" "new" "type" 
+                      "isa" "method" "meth" "send" "try" "object" "extend" 
+                      "super" "extra" "with" "This" 
+                      ;; Database
+                      "pool" "journal" "id" "seq" "lieu" "lock" "begin" 
+                      "commit" "rollback" "mark" "free" "dbck" "rel" "dbs" 
+                      "dbs+" "db:" "fmt64" "tree" "root" "fetch" "store" 
+                      "count" "leaf" "minKey" "maxKey" "genKey" "useKey" "init" 
+                      "step" "scan" "iter" "prune" "zapTree" "chkTree" "db" 
+                      "aux" "collect" 
+                      ;; Pilog
+                      "goal" "prove" "->" "unify" "?" 
+                      ;; Debugging
+                      "pretty" "pp" "show" "loc" "debug" "vi" "ld" "trace" 
+                      "lint" "lintAll" "fmt64"
+                      ;; System Functions
+                      "cmd" "argv" "opt" "gc" "raw" "alarm" "protect" "heap" 
+                      "env" "up" "date" "time" "usec" "stamp" "dat$" "$dat" 
+                      "datSym" "datStr" "strDat" "expDat" "day" "week" "ultimo" 
+                      "tim$" "$tim" "telStr" "expTel" "locale" "allowed" 
+                      "allow" "pwd" "cd" "chdir" "ctty" "info" "dir" "dirname" 
+                      "call" "tick" "kill" "quit" "task" "fork" "pipe" 
+                      "timeout" "mail" "test" "bye" ) t )
+               "\\>" ) 1 ) ) ) )
+  "Gaudy expressions to highlight in Picolisp modes." )
+
+(defvar picolisp-font-lock-keywords picolisp-font-lock-keywords-1
+  "Default expressions to highlight in Picolisp modes." )
+
+(defconst picolisp-sexp-comment-syntax-table
+  (let ((st (make-syntax-table picolisp-mode-syntax-table)))
+    (modify-syntax-entry ?\n " " st)
+    (modify-syntax-entry ?#  "." st)
+    st ) )
+
+(put 'lambda 'picolisp-doc-string-elt 2)
+;; Docstring's pos in a `define' depends on whether it's a var or fun def.
+(put 'define 'picolisp-doc-string-elt
+     (lambda ()
+       ;; The function is called with point right after "define".
+       (forward-comment (point-max))
+       (if (eq (char-after) ?\() 2 0) ) )
+
+
+;; Copied from lisp-indent-line,
+;; because Picolisp doesn't care about how many comment chars you use.
+(defun picolisp-indent-line (&optional whole-exp)
+  "Indent current line as Picolisp code.
+With argument, indent any additional lines of the same expression
+rigidly along with this one."
+  (interactive "P")
+  (let ((indent (calculate-lisp-indent)) shift-amt end
+        (pos (- (point-max) (point)))
+        (beg (progn (beginning-of-line) (point))) )
+    (skip-chars-forward " \t")
+    (if (or (null indent) (looking-at "\\s<\\s<\\s<"))
+        ;; Don't alter indentation of a ;;; comment line
+        ;; or a line that starts in a string.
+        (goto-char (- (point-max) pos))
+      (if (listp indent) (setq indent (car indent)))
+      (setq shift-amt (- indent (current-column)))
+      (if (zerop shift-amt)
+          nil
+        (delete-region beg (point))
+        (indent-to indent) ) )
+    ;; If initial point was within line's indentation,
+    ;; position after the indentation.  Else stay at same point in text.
+    (if (> (- (point-max) pos) (point))
+        (goto-char (- (point-max) pos)) )
+    ;; If desired, shift remaining lines of expression the same amount.
+    (and whole-exp (not (zerop shift-amt))
+         (save-excursion
+           (goto-char beg)
+           (forward-sexp 1)
+           (setq end (point))
+           (goto-char beg)
+           (forward-line 1)
+           (setq beg (point))
+           (> end beg) )
+         (indent-code-rigidly beg end shift-amt) ) ) )
+
+(defvar calculate-lisp-indent-last-sexp)
+
+;; Copied from lisp-indent-function, but with gets of
+;; picolisp-indent-{function,hook}, and minor modifications.
+(defun picolisp-indent-function (indent-point state)
+  (picolisp-parensep)
+  (let ((normal-indent (current-column)))
+    (goto-char (1+ (elt state 1)))
+    (parse-partial-sexp (point) calculate-lisp-indent-last-sexp 0 t)
+    (if (and (elt state 2)
+             (not (looking-at "\"?\\sw\\|\\s_")) )
+        ;; car of form doesn't seem to be a symbol
+        (progn
+          (if (not (> (save-excursion (forward-line 1) (point))
+                      calculate-lisp-indent-last-sexp ) )
+              (progn (goto-char calculate-lisp-indent-last-sexp)
+                     (beginning-of-line)
+                     (parse-partial-sexp (point)
+                                         calculate-lisp-indent-last-sexp 0 t ) ) )
+          ;; Indent under the list or under the first sexp on the same
+          ;; line as calculate-lisp-indent-last-sexp.  Note that first
+          ;; thing on that line has to be complete sexp since we are
+          ;; inside the innermost containing sexp.
+          (backward-prefix-chars)
+          (current-column) )
+      (let* ((function (buffer-substring (point)
+                                         (progn (forward-sexp 1) (point)) ) )
+             (method (or (get (intern-soft function) 'picolisp-indent-function)
+                         (get (intern-soft function) 'picolisp-indent-hook)
+                         ;;(and picolisp-indent-style 'picolisp-indent-defform)
+                         'picolisp-indent ) ) )
+        (if (integerp method)
+            (lisp-indent-specform method state indent-point normal-indent)
+          (funcall method state indent-point normal-indent) ) ) ) ) )
+
+
+;;; Some functions are different in picoLisp
+(defun picolisp-indent (state indent-point normal-indent)
+  (let ((lisp-body-indent picolisp-body-indent))
+    (lisp-indent-defform state indent-point) ) )
+
+
+;;; This is to space closing parens when they close a previous line.
+(defun picolisp-parensep ()
+  (save-excursion
+    (condition-case nil     ; This is to avoid fuck-ups when there are
+        (progn              ; unbalanced expressions.
+          (up-list)
+          (back-to-indentation)     
+          (while (and (re-search-forward ")" (line-end-position) t)
+                      (< (point) (line-end-position)) )
+            (if (and (not (picolisp-in-comment-p))
+                     (not (picolisp-in-string-p)) )
+                (picolisp-delete-leading-whitespace) ) )        
+          (if (and (not (picolisp-in-comment-p))
+                   (not (picolisp-in-string-p)) )
+              (picolisp-delete-leading-whitespace) ) )
+      (error nil) ) ) )
+
+(defun picolisp-delete-leading-whitespace ()
+  ;; This assumes that we're on the closing delimiter already.
+  (save-excursion
+    (backward-char)
+    (while (let ((syn (char-syntax (char-before))))
+             (and (or (eq syn ?\ ) (eq syn ?-)) ; whitespace syntax
+                  ;; The above line is a perfect example of why the
+                  ;; following test is necessary.
+                  (not (picolisp-in-char-p (1- (point)))) ) )
+      (backward-delete-char 1) ) )
+  (when (and (equal 'picolisp-mode major-mode) ; We don't want to screw-up
+                                        ; the formatting of other buffers making
+                                        ; use of paredit, do we?
+             (not (picolisp-in-string-p)) )
+    (let ((another-line? (save-excursion
+                           (backward-sexp)
+                           (line-number-at-pos) ) ) )
+      (if (< another-line? (line-number-at-pos))
+          (save-excursion
+            (backward-char)
+            (when picolisp-parsep
+              (insert " ") ) ) ) ) ) )
+  
+(defun picolisp-current-parse-state ()
+  "Return parse state of point from beginning of defun."
+  (let ((point (point)))
+    (beginning-of-defun)
+    ;; Calling PARSE-PARTIAL-SEXP will advance the point to its second
+    ;; argument (unless parsing stops due to an error, but we assume it
+    ;; won't in picolisp-mode).
+    (parse-partial-sexp (point) point) ) )  
+
+(defun picolisp-in-string-p (&optional state)
+  "True if the parse state is within a double-quote-delimited string.
+If no parse state is supplied, compute one from the beginning of the
+  defun to the point."
+  ;; 3. non-nil if inside a string (the terminator character, really)
+  (and (nth 3 (or state (picolisp-current-parse-state)))
+       t ) )  
+(defun picolisp-in-comment-p (&optional state)
+  "True if parse state STATE is within a comment.
+If no parse state is supplied, compute one from the beginning of the
+  defun to the point."
+  ;; 4. nil if outside a comment, t if inside a non-nestable comment,
+  ;;    else an integer (the current comment nesting)
+  (and (nth 4 (or state (picolisp-current-parse-state)))
+       t ) )  
+
+(defun picolisp-in-char-p (&optional argument)
+  "True if the point is immediately after a character literal.
+A preceding escape character, not preceded by another escape character,
+  is considered a character literal prefix.  (This works for elisp,
+  Common Lisp, and Scheme.)
+Assumes that `picolisp-in-string-p' is false, so that it need not handle
+  long sequences of preceding backslashes in string escapes.  (This
+  assumes some other leading character token -- ? in elisp, # in Scheme
+  and Common Lisp.)"
+  (let ((argument (or argument (point))))
+    (and (eq (char-before argument) ?\\)
+         (not (eq (char-before (1- argument)) ?\\)) ) ) ) 
+
+(add-to-list 'auto-mode-alist '("\\.l$" . picolisp-mode))
+
+(require 'tsm)
+
+(ignore-errors
+ (when tsm-lock
+   (font-lock-add-keywords 'picolisp-mode tsm-lock)
+   (font-lock-add-keywords 'inferior-picolisp-mode tsm-lock) ) ) 
+
+(provide 'picolisp)
diff --git a/lib/el/tsm.el b/lib/el/tsm.el
@@ -0,0 +1,130 @@
+;;;;;; tsm-mode: Minor mode to display transient symbols in picolisp-mode.
+;;;;;; Version: 1.0
+
+;;; Copyright (c) 2009, Guillermo R. Palavecino
+
+;; This file is NOT part of GNU emacs.
+
+;;;; Contact:
+;; For comments, bug reports, questions, etc, you can contact me via IRC
+;; to the user named grpala (or armadillo) on irc.freenode.net in the
+;; #picolisp channel or via email to the author's nickname at gmail.com
+;;
+;;;; License:
+;; This work is released under the GPL 2 or (at your option) any later
+;; version.
+
+(defvar tsm-face 'tsm-face)
+
+(defface tsm-face
+  '((((class color))
+     (:inherit font-lock-string-face :underline t) ) )
+  "Face for displaying transient symbols in picolisp-mode"
+  :group 'faces )
+
+(defun tsm-revert (beg end)
+  (remove-text-properties beg end '(display ""))
+  (remove-text-properties beg end '(face tsm-face)) )
+
+(defvar tsm-regex "\"")
+
+;;; Sorry, but the following 3 function definitions are write-only for now.
+
+(defun find-opening-dblquote ()
+  (catch 'return
+    (while (re-search-forward "\\(\"\\)" (line-end-position) t)
+      (when (save-excursion
+              (and (ignore-errors (match-beginning 1))
+                   (not (progn
+                          (goto-char (match-beginning 1))
+                          (picolisp-in-string-p) ) )
+                   (progn
+                     (forward-char)
+                     (picolisp-in-string-p) ) ) )
+        (throw 'return (point)) ) )
+    (backward-char) ) )
+
+(defun find-closing-dblquote ()
+  (catch 'return
+    (while (re-search-forward "\\(\"\\)" (line-end-position) t)
+      (when (save-excursion
+              (and (ignore-errors (match-beginning 1))
+                   (progn
+                     (goto-char (match-beginning 1))
+                     (picolisp-in-string-p) ) 
+                   (not (progn
+                          (forward-char)
+                          (picolisp-in-string-p) ) ) ) )
+        (throw 'return (point)) ) ) ) )
+
+(defun tsm-line ()
+  (while (and (find-opening-dblquote)
+              (save-excursion (find-closing-dblquote)) )
+    (let ((opening (point))
+          (closing (find-closing-dblquote)) )
+      (add-text-properties (1- opening) opening '(display ""))
+      (add-text-properties (1- closing) closing '(display ""))
+      (add-text-properties (1- opening) closing '(face tsm-face))
+      (dotimes (i (- closing opening 1))
+        (let ((i (+ i opening)))
+          (when (and (eq 92 (char-before i))
+                     (eq 34 (char-before (1+ i))) )
+            (add-text-properties (1- i) i '(display "")) ) ) ) ) ) )
+
+(defun tsm-change (beg end)
+  (save-excursion
+    (goto-char beg)
+    (while (re-search-forward "^.*\"" (save-excursion
+                                        (goto-char end)
+                                        (line-end-position) ) t )
+      (beginning-of-line)
+      (tsm-revert (line-beginning-position) (line-end-position))
+      (tsm-line) ) ) )
+
+(defvar tsm-lock
+  '(("\""
+     (0 (when tsm-mode
+          (setq global-disable-point-adjustment t) 
+          (save-excursion
+            (beginning-of-line)
+            (remove-text-properties (line-beginning-position) (line-end-position) '(display ""))
+            (tsm-line) )
+          nil ) ) ) ) )
+
+
+;;;###autoload
+(define-minor-mode tsm-mode
+  "Minor mode to display transient symbols like in the terminal repl in picolisp-mode."
+  :group 'tsm :lighter " *Tsm"
+  (save-excursion
+    (save-restriction
+      (widen)
+      ;; We erase all the properties to avoid problems.
+      (tsm-revert (point-min) (point-max))
+
+      (if tsm-mode
+          (progn 
+            (if (not (and (not font-lock-mode) (not global-font-lock-mode)))
+                (font-lock-add-keywords major-mode tsm-lock)
+              (jit-lock-register 'tsm-change)
+              (remove-hook 'after-change-functions
+                           'font-lock-after-change-function t )
+              (set (make-local-variable 'font-lock-fontified) t)
+
+              ;; Tell jit-lock how we extend the region to refontify.
+              (add-hook 'jit-lock-after-change-extend-region-functions
+                        'font-lock-extend-jit-lock-region-after-change
+                        nil t ) )
+            
+            (setq global-disable-point-adjustment t) )
+        (progn 
+          (if (and (not font-lock-mode) (not global-font-lock-mode))
+              (jit-lock-unregister 'tsm-change)
+            (font-lock-remove-keywords major-mode tsm-lock) )
+          (setq global-disable-point-adjustment nil) ) )
+
+      (if font-lock-mode (font-lock-fontify-buffer)) ) ) )
+
+;;; Announce
+
+(provide 'tsm)
diff --git a/lib/form.js b/lib/form.js
@@ -0,0 +1,352 @@
+/* 20apr10abu
+ * (c) Software Lab. Alexander Burger
+ */
+
+var FormReq = false;
+var HintReq = false;
+
+if (window.XMLHttpRequest) {
+   try {
+      FormReq = new XMLHttpRequest();
+      HintReq = new XMLHttpRequest();
+   }
+   catch (e) {}
+}
+else if (window.ActiveXObject) {  // IE
+   try {
+      FormReq = new ActiveXObject("Msxml2.XMLHTTP");
+      HintReq = new ActiveXObject("Msxml2.XMLHTTP");
+   }
+   catch (e) {
+      try {
+         FormReq = new ActiveXObject("Microsoft.XMLHTTP");
+         HintReq = new ActiveXObject("Microsoft.XMLHTTP");
+      }
+      catch (e) {}
+   }
+}
+
+var Queue = new Array();
+var Btn = new Array();
+var Key, InBtn, Auto;
+
+function inBtn(flg) {InBtn = flg;}
+
+function formKey(event) {
+   Key = event.keyCode;
+   return true;
+}
+
+function fldChg(field) {
+   if (!InBtn && Key != 13)
+      post(field.form);
+   return true;
+}
+
+function doBtn(btn) {
+   Btn.push(btn);
+   return true;
+}
+
+/*** Form submit ***/
+function doPost(form) {
+   for (var i = 0; ; ++i) {
+      if (i == Btn.length)
+         return true;
+      if (Btn[i].form == form)
+         break;
+   }
+   return post(form);
+}
+
+function post(form) {
+   var i, j, url, data;
+
+   if (!FormReq)
+      return true;
+   if (FormReq.readyState > 0 && FormReq.readyState < 4) {
+      Queue.push(form);
+      return false;
+   }
+   form.style.cursor = "wait";
+   url = form.action.split("~");
+   try {FormReq.open("POST", url[0] + "~@jsForm?" + url[1]);}
+   catch (e) {return true;}
+
+   FormReq.onreadystatechange = function() {
+      if (FormReq.readyState == 4 && FormReq.status == 200) {
+         if (FormReq.responseText == "T") {
+            Queue.length = 0;
+            form.submit();
+         }
+         else {
+            var txt = FormReq.responseText.split("&");
+
+            if (txt[0]) {
+               var r = txt[0].split(":");
+
+               if (Auto)
+                  window.clearTimeout(Auto);
+               if (r[1])
+                  Auto = window.setTimeout("document.getElementById(\"" + r[0] + "\").click()", r[1]);
+            }
+            for (i = 1; i < txt.length;) {
+               var fld = txt[i++];
+               var val = decodeURIComponent(txt[i++]);
+
+               if (!fld) {
+                  window[txt[i++]](val);
+                  continue;
+               }
+               if (!(fld = document.getElementById(fld)))
+                  continue;
+               if (fld.tagName == "SPAN") {
+                  if (i != txt.length && txt[i].charAt(0) == "=")
+                     ++i;
+                  if (i == txt.length || txt[i].charAt(0) != "+") {
+                     if (fld.firstChild.tagName != "A")
+                        fld.firstChild.data = val? val : "\u00A0";
+                     else
+                        fld.replaceChild(document.createTextNode(val? val : "\u00A0"), fld.firstChild);
+                  }
+                  else {
+                     var a = document.createElement("A");
+
+                     a.href = decodeURIComponent(txt[i++].substr(1));
+                     a.appendChild(document.createTextNode(val));
+                     fld.replaceChild(a, fld.firstChild);
+                  }
+               }
+               else if (fld.tagName == "A") {
+                  if (i != txt.length && txt[i].charAt(0) == "=")
+                     ++i;
+                  if (i == txt.length || txt[i].charAt(0) != "+") {
+                     fld.replaceChild(document.createTextNode(val? val : "\u00A0"), fld.firstChild);
+                     fld.removeAttribute("href");
+                  }
+                  else {
+                     fld.firstChild.data = val;
+                     fld.href = decodeURIComponent(txt[i++].substr(1));
+                  }
+               }
+               else {
+                  if (fld.type == "checkbox") {
+                     fld.checked = val != "";
+                     document.getElementsByName(fld.name)[0].value = "";
+                  }
+                  else if (fld.type == "select-one") {
+                     for (j = 0; j < fld.options.length; ++j) {
+                        if (fld.options[j].text == val)
+                           fld.selectedIndex = j;
+                        fld.options[j].disabled = false;
+                     }
+                  }
+                  else if (fld.type == "radio") {
+                     fld.value = val;
+                     fld.checked = txt[i++].charAt(0) != "";
+                  }
+                  else if (fld.type == "image")
+                     fld.src = val;
+                  else if (fld.value != val) {
+                     fld.value = val;
+                     fld.scrollTop = fld.scrollHeight;
+                  }
+                  fld.disabled = false;
+                  if (i == txt.length)
+                     break;
+                  if (txt[i].charAt(0) == "=") {
+                     if (fld.type == "select-one") {
+                        for (j = 0; j < fld.options.length; ++j)
+                           if (fld.options[j].text != val)
+                              fld.options[j].disabled = true;
+                     }
+                     fld.disabled = true;
+                     if (fld.type == "checkbox"  &&  fld.checked)
+                        document.getElementsByName(fld.name)[0].value = "T";
+                     ++i;
+                  }
+               }
+               while (i < txt.length && (j = "#*?".indexOf(txt[i].charAt(0))) >= 0) {
+                  switch (j) {
+
+                  case 0:  // '#'
+                     var cls;
+
+                     val = txt[i++].substr(1);
+                     if ((cls = fld.getAttribute("class")) != null  &&  (j = cls.indexOf(" ")) >= 0)
+                        val += cls.substr(j);
+                     fld.setAttribute("class", val);
+                     break;
+
+                  case 1:  // '*'
+                     var node = fld.parentNode.parentNode.lastChild;
+                     var img = document.createElement("IMG");
+
+                     if (!node.firstChild)
+                        node = fld.parentNode.parentNode.parentNode.lastChild;
+                     node.removeChild(node.firstChild);
+                     img.src = txt[i++].substr(1);
+                     if (!txt[i])
+                        node.appendChild(img);
+                     else {
+                        var a = document.createElement("A");
+
+                        a.href = decodeURIComponent(txt[i]);
+                        a.appendChild(img);
+                        node.appendChild(a);
+                     }
+                     ++i;
+                     break;
+
+                  case 2:  // '?'
+                     fld.title = decodeURIComponent(txt[i++].substr(1));
+                     break;
+                  }
+               }
+            }
+         }
+         form.style.cursor = "";
+         if (Queue.length > 0)
+            post(Queue.shift());
+      }
+   }
+
+   data = "";
+   for (i = 0; i < Btn.length;)
+      if (Btn[i].form != form)
+         ++i;
+      else {
+         data += (data? "&":"") + Btn[i].name + "=" + encodeURIComponent(Btn[i].type == "submit"? Btn[i].value : Btn[i].src);
+         Btn.splice(i,1);
+      }
+   for (i = 0; i < form.elements.length; ++i) {
+      var fld = form.elements[i];
+
+      if (fld.name  &&  fld.type != "submit") {   // "image" won't come :-(
+         var val;
+
+         if (fld.type == "checkbox")
+            val = fld.checked? "T" : "";
+         else if (fld.type == "select-one")
+            val = fld.options[fld.selectedIndex].text;
+         else if (fld.type == "radio" && !fld.checked)
+            continue;
+         else
+            val = fld.value;
+         data += "&" + fld.name + "=" + encodeURIComponent(val);
+      }
+   }
+   try {FormReq.send(data);}
+   catch (e) {
+      FormReq.abort();
+      return true;
+   }
+   return false;
+}
+
+
+/*** Hints ***/
+var Hint, Pos;
+
+function doHint(field) {
+   var i, url, data;
+
+   Hint = null;
+   if (!HintReq)
+      return true;
+   if (HintReq.readyState > 0 && HintReq.readyState < 4)
+      return false;
+   if ((i = field.id.lastIndexOf("-")) < 0)
+      return true;
+   url = field.form.action.split("~");
+   try {HintReq.open("POST", url[0] + "~@jsHint?" + field.id.substr(i+1));}
+   catch (e) {return true;}
+   HintReq.onreadystatechange = function() {
+      if (HintReq.readyState == 4 && HintReq.status == 200) {
+         Hint = HintReq.responseText.split("&");
+         for (i = 0; i < Hint.length; ++i)
+            Hint[i] = decodeURIComponent(Hint[i]);
+      }
+   }
+   for (i = 0; i < field.form.elements.length; ++i) {
+      var fld = field.form.elements[i];
+
+      if (fld.name == "*Get")
+         data = "*Get=" + fld.value;
+      else if (fld.name == "*Form")
+         data += "&*Form=" + fld.value;
+   }
+   try {HintReq.send(data);}
+   catch (e) {HintReq.abort();}
+   Pos = -1;
+   return true;
+}
+
+function hintKey(field, event, coy) {
+   var beg = field.selectionStart;
+   var end = field.selectionEnd;
+   var i;
+
+   if (Hint.length > 0) {
+      if (event.keyCode == 19) {  // Pause/Break
+         if (beg != end)
+            return true;
+         for (Pos = beg;  Pos > 0 && !field.value.charAt(Pos-1).match(/\s/);  --Pos);
+         if ((i = findHint(field.value.substring(Pos, beg))) < 0)
+            Pos = -1;
+         else
+            setHint(field, beg, end, i);
+         return false;
+      }
+      if (event.keyCode == 38 || event.keyCode == 40) {  // Up or Down
+         if (beg == end)
+            return true;
+         if ((i = findHint(field.value.substring(Pos, end))) >= 0)
+            setHint(field, beg, end, nextHint(field.value.substring(Pos, beg), i, event.keyCode==38? -1 : +1));
+         return false;
+      }
+      if (!coy) {
+         if (Pos < 0)
+            for (Pos = beg;  Pos > 0 && !field.value.charAt(Pos-1).match(/\s/);  --Pos);
+         if ((i = findHint(field.value.substring(Pos, beg) + String.fromCharCode(event.charCode || event.keyCode))) < 0)
+            Pos = -1;
+         else {
+            setHint(field, beg+1, end, i);
+            return false;
+         }
+      }
+   }
+   return true;
+}
+
+function findHint(str) {
+   str = str.toLowerCase();
+   var len = str.length;
+   for (var i = 0; i < Hint.length; ++i)
+      if (Hint[i].substr(0,len).toLowerCase() == str)
+         return i;
+   return -1;
+}
+
+function nextHint(str, i, n) {
+   str = str.toLowerCase();
+   var len = str.length;
+   do {
+      if (n < 0) {
+         if ((i += n) < 0)
+            i = Hint.length - 1;
+      }
+      else {
+         if ((i += n) >= Hint.length)
+               i = 0;
+      }
+   } while (Hint[i].substr(0,len).toLowerCase() != str);
+   return i;
+}
+
+function setHint(field, beg, end, i) {
+   field.value = field.value.substr(0,Pos) + Hint[i] + field.value.substring(end, field.value.length);
+   field.setSelectionRange(beg, Pos+Hint[i].length);
+   field.onblur = function() {fldChg(field)};
+   field.onchange = false;
+}
diff --git a/lib/form.l b/lib/form.l
@@ -0,0 +1,2069 @@
+# 21apr10abu
+# (c) Software Lab. Alexander Burger
+
+# *PRG *Top *Gui *Btn *Get *Got *Form *Evt *Lock *Spans
+# "*Cnt" "*Lst" "*App" "*Err" "*Foc" "*Post2" "*Stat" "*Ix" "*Chart" "*Cho"
+
+(allow (path "@img/") T)
+(push1 '*JS (allow (path "@lib/form.js")))
+(mapc allow '(*Gui *Get *Got *Form *Evt "@jsForm" "@jsHint"))
+
+(one "*Cnt")
+(off "*Lst" "*Post2" "*Cho")
+
+(de *Throbber
+   ("+---" "-+--" "--+-" "---+" "--+-" "-+--" .) )
+
+# Define GUI form
+(de form ("Attr" . "Prg")
+   (inc '*Form)
+   (let "App"
+      (if *PRG
+         (get "*Lst" (- "*Cnt" *Get) *Form)
+         (prog1 (setq *Top (new NIL NIL  'able T  'evt 0))
+            (conc
+               (get "*Lst" (- "*Cnt" *Get))
+               (cons *Top) ) ) )
+      (let "Lst" (get "*Lst" (- "*Cnt" *Get) 1)
+         (for ("F" . "L") "Lst"
+            (let *Form (- "F" (length "Lst"))
+               (cond
+                  ((and (== *PRG (car "L")) (memq "App" (get *PRG 'top)))
+                     (apply "form" "L") )
+                  ((or (== *PRG "App") (memq "App" (get *PRG 'top)))
+                     (if (get "L" 1 'top)
+                        (apply "form" "L")
+                        (put (car "L") 'top (cons *PRG (get *PRG 'top)))
+                        (let *PRG NIL (apply "form" "L")) ) ) ) ) ) )
+      ("form" "App" "Attr" "Prg") ) )
+
+(de "form" ("*App" "Attr" "Prg")
+   (with "*App"
+      (job (: env)
+         (<post> "Attr" (urlMT *Url *Menu *Tab *ID)
+            (<hidden> '*Get *Get)
+            (<hidden> '*Form *Form)
+            (<hidden> '*Evt (: evt))
+            (zero "*Ix")
+            (off "*Chart")
+            (if *PRG
+               (let gui
+                  '(()
+                     (with (get "*App" 'gui (inc '"*Ix"))
+                        (for E "*Err"
+                           (when (== This (car E))
+                              (<div> 'err
+                                 (if (atom (cdr E))
+                                    (ht:Prin (eval (cdr E) 1))
+                                    (eval (cdr E) 1) ) ) ) )
+                        (if (: id)
+                           (let *Gui (val "*App")
+                              (show> This (cons '*Gui @)) )
+                           (setq "*Chart" This) )
+                        This ) )
+                  (and (== *PRG "*App") (setq *Top "*App"))
+                  (htPrin "Prg") )
+               (set "*App")
+               (let gui
+                  '(@
+                     (inc '"*Ix")
+                     (with
+                        (cond
+                           ((pair (next)) (pass new @))
+                           ((not (arg)) (pass new))
+                           ((num? (arg))
+                              (ifn "*Chart"
+                                 (quit "no chart" (rest))
+                                 (with "*Chart"
+                                    (let (I (arg)  L (last (: gui)))
+                                       (when (get L I)
+                                          (inc (:: rows))
+                                          (conc (: gui)
+                                             (list (setq L (need (: cols)))) ) )
+                                       (let Fld (pass new)
+                                          (set (nth L I) Fld)
+                                          (and (get Fld 'chg) (get Fld 'able) (=: lock))
+                                          (set> Fld
+                                             (get
+                                                ((: put)
+                                                   (get (nth (: data) (: ofs)) (: rows))
+                                                   (+ (: ofs) (: rows) -1) )
+                                                I )
+                                             T )
+                                          (put Fld 'chart (list This (: rows) I))
+                                          Fld ) ) ) ) )
+                           ((get "*App" (arg)) (quit "gui conflict" (arg)))
+                           (T (put "*App" (arg) (pass new))) )
+                        (=: home gui (conc (: home gui) (cons This)))
+                        (unless (: chart) (init> This))
+                        (when (: id)
+                           (let *Gui (val "*App")
+                              (show> This (cons '*Gui (: id))) ) )
+                        This ) )
+                  (htPrin "Prg") ) ) )
+         (--)
+         (eval (: show))
+         (=: show) ) ) )
+
+# Disable form
+(de disable (Flg)
+   (and Flg (=: able)) )
+
+# Handle form actions
+(de action Prg
+   (off "*Foc")
+   (or *PRG "*Post2" (off "*Err"))
+   (catch "stop"
+      (nond
+         (*Post
+            (unless (and *PRG (= *Form (car *Got)) (= *Get (cadr *Got)))
+               (pushForm (cons)) )
+            (_doForm)
+            (off *PRG *Got) )
+         (*PRG
+            (with (postForm)
+               (ifn (= *Evt (: evt))
+                  (noContent)
+                  (postGui)
+                  (redirect
+                     (baseHRef)
+                     *SesId
+                     (urlMT *Url *Menu *Tab *ID)
+                     "&*Evt=+" (inc (:: evt))
+                     "&*Got=_+" *Form "_+" *Get ) ) ) )
+         (NIL
+            (off *PRG)
+            (pushForm (cons))
+            (_doForm) ) ) ) )
+
+(de pushForm (L)
+   (push '"*Lst" L)
+   (and (nth "*Lst" 99) (con @))
+   (setq *Get "*Cnt")
+   (inc '"*Cnt") )
+
+(de _doForm ()
+   (one *Form)
+   (run Prg 2)
+   (setq "*Stat"
+      (cons
+         (pair "*Err")
+         (copy (get "*Lst" (- "*Cnt" *Get))) ) ) )
+
+(de jsForm (Url)
+   (if (or *PRG (not *Post))
+      (noContent)
+      (setq *Url Url  Url (chop Url))
+      (let action
+         '(Prg
+            (off "*Err")
+            (with (postForm)
+               (catch "stop"
+                  (postGui)
+                  (httpHead "text/plain; charset=utf-8")
+                  (if
+                     (and
+                        (= (car "*Stat") "*Err")
+                        (= (cdr "*Stat") (get "*Lst" (- "*Cnt" *Get))) )
+                     (ht:Out *Chunked
+                        (when (: auto)
+                           (prin "i" *Form '- (: auto 1 id) ': (: auto -1))
+                           (=: auto) )
+                        (for S *Spans
+                           (prin '& (car S) '& (run (cdr S))) )
+                        (for This (: gui)
+                           (if (: id)
+                              (prin '& "i" *Form '- @ '& (js> This))
+                              (setq "*Chart" This) ) ) )
+                     (setq "*Post2" (cons *Get *Form *PRG))
+                     (ht:Out *Chunked (prin T)) ) ) )
+            (off *PRG) )
+         (use @X
+            (cond
+               ((match '("-" @X "." "h" "t" "m" "l") Url)
+                  (try 'html> (extern (ht:Pack @X))) )
+               ((disallowed)
+                  (msg *Url " not allowed")
+                  (http404) )
+               ((= '@ (car Url))
+                  ((intern (pack (cdr Url)))) )
+               ((tail '("." "l") Url)
+                  (load *Url) ) ) ) ) ) )
+
+(de postForm ()
+   (let? Lst (get "*Lst" (- "*Cnt" (setq *Get (format *Get))))
+      (setq
+         *Form (format *Form)
+         *Evt (format *Evt)
+         *PRG
+         (cond
+            ((and (= *Get (car "*Post2")) (= *Form (cadr "*Post2")))
+               (cddr "*Post2") )
+            ((off "*Post2"))
+            ((gt0 *Form) (get Lst *Form))
+            (T (get Lst 1 (+ (length (car Lst)) *Form) 1)) ) ) ) )
+
+(de postGui ()
+   (if "*Post2"
+      (off *Gui "*Post2")
+      (let *Btn NIL
+         (for G *Gui
+            (and (lt0 (car G)) (setq *Btn (cdr G)))
+            (con (assoc (car G) (val *PRG)) (cdr G)) )
+         (off *Gui)
+         (job (: env)
+            (for This (: gui)
+               (cond
+                  ((not (: id)) (setq "*Chart" This))
+                  ((chk> This) (err @))
+                  ((or (: rid) (: home able))
+                     (set> This (val> This) T) ) ) )
+            (for This (: gui)
+               (cond
+                  ((: id))
+                  ((chk> (setq "*Chart" This)) (err @))
+                  ((or (: rid) (: home able))
+                     (set> This (val> This)) ) ) )
+            (if (pair "*Err")
+               (and *Lock (with (caar "*Err") (tryLock *Lock)))
+               (finally
+                  (when *Lock
+                     (if (lock @)
+                        (=: able (off *Lock))
+                        (sync) ) )
+                  (for This (: gui)
+                     (nond
+                        ((: id) (setq "*Chart" This))
+                        ((ge0 (: id))
+                           (let? A (assoc (: id) (val *PRG))
+                              (when (cdr A)
+                                 (con A)
+                                 (act> This) ) ) ) ) ) )
+               (for This (: gui)
+                  (or (: id) (setq "*Chart" This))
+                  (upd> This) ) ) ) ) ) )
+
+(de err (Exe)
+   (cond
+      ((=T Exe) (on "*Err"))
+      ((nT "*Err") (queue '"*Err" (cons This Exe))) ) )
+
+(de url (Url . @)
+   (when Url
+      (off *PRG)
+      (redirect (baseHRef) *SesId Url '?
+         (pack
+            (make
+               (loop
+                  (and
+                     (sym? (next))
+                     (= `(char '*) (char (arg)))
+                     (link (arg) '=)
+                     (next) )
+                  (link (ht:Fmt (arg)))
+                  (NIL (args))
+                  (link '&) ) ) ) )
+      (throw "stop") ) )
+
+# Actve <span> elements
+(de span Args
+   (def (car Args)
+      (list NIL
+         (list '<span>
+            (lit (cons 'id (car Args)))
+            (cons 'ht:Prin (cdr Args)) ) ) )
+   (push '*Spans Args) )
+
+(span expires
+   (pack
+      "TimeOut"
+      " "
+      (tim$ (% (+ (time) (/ (cadr (assoc -1 *Run)) 1000)) 86400)) ) )
+
+# Return chart property
+(de chart @
+   (pass get "*Chart") )
+
+# Table highlighting
+(daemon '<table>
+   (on "rowF") )
+
+(de alternating ()
+   (onOff "rowF") )
+
+# REPL form
+(de repl (Attr)
+   (form Attr
+      (gui 'view '(+FileField) '(tmp "repl") 80 25)
+      (--)
+      (gui 'line '(+Focus +TextField) 64 ":")
+      (gui '(+JS +Button) "eval"
+         '(let Str (val> (: home line))
+            (out (pack "+" (tmp "repl"))
+               (prinl ": " Str)
+               (catch '(NIL)
+                  (let Res (in "/dev/null" (eval (any Str)))
+                     (prin "-> ")
+                     (println Res) ) )
+               (when *Msg (prinl @) (off *Msg)) )
+            (clr> (: home line)) ) )
+      (gui '(+JS +Button) "clear"
+         '(clr> (: home view)) ) ) )
+
+
+# Dialogs
+(de _dlg (Attr Env)
+   (let L (get "*Lst" (- "*Cnt" *Get))
+      (while (and (car L) (n== *PRG (caar @)))
+         (pop L) )
+      (push L
+         (list
+            (new NIL NIL  'btn This  'able T  'evt 0  'env Env)
+            Attr
+            Prg ) )
+      (pushForm L) ) )
+
+(de dialog (Env . Prg)
+   (_dlg 'dialog Env) )
+
+(de alert (Env . Prg)
+   (_dlg 'alert Env) )
+
+(de note (Str Lst)
+   (alert (env '(Str Lst))
+      (<span> 'note Str)
+      (--)
+      (for S Lst (<br> S))
+      (okButton) ) )
+
+(de ask (Str . Prg)
+   (alert (env '(Str Prg))
+      (<span> 'ask Str)
+      (--)
+      (yesButton (cons 'prog Prg))
+      (noButton) ) )
+
+(de diaform (Lst . Prg)
+   (if (and *PRG (not (: diaform)))
+      (_dlg 'dialog (env Lst))
+      (=: env (env Lst))
+      (=: diaform T)
+      (run Prg 1) ) )
+
+(de saveButton (Exe)
+   (gui '(+Button) ,"Save" Exe) )
+
+(de closeButton (Lbl Exe)
+   (when (get "*App" 'top)
+      (gui '(+Rid +Close +Button) Lbl Exe) ) )
+
+(de okButton (Exe)
+   (when (get "*App" 'top)
+      (if (=T Exe)
+         (gui '(+Force +Close +Button) T "OK")
+         (gui '(+Close +Button) "OK" Exe) ) ) )
+
+(de cancelButton ()
+   (when (get "*App" 'top)
+      (gui '(+Force +Close +Button) T ',"Cancel") ) )
+
+(de yesButton (Exe)
+   (gui '(+Close +Button) ',"Yes" Exe) )
+
+(de noButton (Exe)
+   (gui '(+Close +Button) ',"No" Exe) )
+
+(de choButton (Exe)
+   (gui '(+Rid +Tip +Button)
+      ,"Find or create an object of the same type"
+      ',"Select" Exe ) )
+
+
+(class +Force)
+# force
+
+(dm T (Exe . @)
+   (=: force Exe)
+   (pass extra) )
+
+(dm chk> ()
+   (when
+      (and
+         (cdr (assoc (: id) (val *PRG)))
+         (eval (: force)) )
+      (for A (val *PRG)
+         (and
+            (lt0 (car A))
+            (<> (: id) (car A))
+            (con A) ) )
+      T ) )
+
+
+(class +Close)
+
+(dm act> ()
+   (when (able)
+      (and
+         (get "*Lst" (- "*Cnt" *Get))
+         (pushForm
+            (cons
+               (filter
+                  '((L) (memq (car L) (: home top)))
+                  (car @) )
+               (cdr @) ) ) )
+      (extra)
+      (for This (: home top)
+         (for This (: gui)
+            (or (: id) (setq "*Chart" This))
+            (upd> This) ) ) ) )
+
+
+# Choose a value
+(class +ChoButton +Tiny +Tip +Button)
+
+(dm T (Exe)
+   (super  ,"Choose a suitable value" "+" Exe)
+   (=: chg T) )
+
+
+(class +PickButton +Tiny +Tip +Button)
+
+(dm T (Exe)
+   (super ,"Adopt this value" "@" Exe) )
+
+
+(class +DstButton +Set +Able +Close +PickButton)
+# msg obj
+
+(dm T (Dst Msg)
+   (=: msg (or Msg 'url>))
+   (super
+      '((Obj) (=: obj Obj))
+      '(: obj)
+      (when Dst
+         (or
+            (pair Dst)
+            (list 'chgDst (lit Dst) '(: obj)) ) ) ) )
+
+(de chgDst (This Val)
+   (set> This (if (: new) (@ Val) Val)) )
+
+(dm js> ()
+   (cond
+      ((: act) (super))
+      ((try (: msg) (: obj) 1)
+         (pack "@&+" (ht:Fmt (sesId (mkUrl @)))) )
+      (T "@") ) )
+
+(dm show> ("Var")
+   (if (: act)
+      (super "Var")
+      (<style> (cons 'id (pack "i" *Form '- (: id)))
+         (if (try (: msg) (: obj) 1)
+            (<tip> "-->" (<href> "@" (mkUrl @)))
+            (<span> *Style "@") ) ) ) )
+
+
+(class +Hint +ChoButton)
+# ttl hint
+
+(dm T (Ttl Exe)
+   (=: ttl Ttl)
+   (=: hint Exe)
+   (super
+      '(dialog (env 'Ttl (eval (: ttl))  'Lst (eval (: hint))  'Dst (field 1))
+         (<table> 'chart Ttl '((btn) NIL)
+            (for X Lst
+               (<row> NIL
+                  (gui '(+Close +PickButton)
+                     (list 'set> 'Dst
+                        (if (get Dst 'dy)
+                           (list 'pack '(str> Dst) (fin X))
+                           (lit (fin X)) ) ) )
+                  (ht:Prin (if (atom X) X (car X))) ) ) )
+         (cancelButton) ) ) )
+
+
+(class +Coy)
+
+(dm T @
+   (=: coy T)
+   (pass extra) )
+
+
+(class +Hint0)
+# coy
+
+(dm show> ("Var")
+   (<style>
+      (list
+         '("onfocus" . "doHint(this)")
+         (cons
+            "onkeypress"
+            (pack "return hintKey(this,event" (and (: coy) ",true") ")")) )
+      (extra "Var") ) )
+
+(de jsHint (Ix)
+   (httpHead "text/plain; charset=utf-8")
+   (ht:Out *Chunked
+      (let? Lst (get "*Lst" (- "*Cnt" (format *Get)))
+         (let? L
+            (try 'hint>
+               (get
+                  (if (gt0 (format *Form))
+                     (get Lst @)
+                     (get Lst 1 (+ (length (car Lst)) (format *Form)) 1) )
+                  'gui
+                  (format Ix) ) )
+            (prin
+               (ht:Fmt
+                  (if (atom (car L))
+                     (car L)
+                     (caar L) ) ) )
+            (for X (cdr L)
+               (prin '&
+                  (ht:Fmt (if (atom X) X (car X))) ) ) ) ) ) )
+
+
+(class +Hint1 +Hint0)
+# hint
+
+(dm T (Exe . @)
+   (=: hint Exe)
+   (pass extra) )
+
+(dm hint> ()
+   (eval (: hint)) )
+
+
+(class +Hint2 +Hint0)
+
+(dm hint> ()
+   (with (field -1)
+      (eval (: hint)) ) )
+
+
+(class +Txt)
+# txt
+
+(dm T (Fun . @)
+   (=: txt Fun)
+   (pass extra) )
+
+(dm txt> (Val)
+   ((: txt) Val) )
+
+
+(class +Set)
+# set
+
+(dm T (Fun . @)
+   (=: set Fun)
+   (pass extra) )
+
+(dm set> (Val Dn)
+   (extra ((: set) Val) Dn) )
+
+
+(class +Val)
+# val
+
+(dm T (Fun . @)
+   (=: val Fun)
+   (pass extra) )
+
+(dm val> ()
+   ((: val) (extra)) )
+
+
+(class +Fmt)
+# set val
+
+(dm T (Fun1 Fun2 . @)
+   (=: set Fun1)
+   (=: val Fun2)
+   (pass extra) )
+
+(dm set> (Val Dn)
+   (extra ((: set) Val) Dn) )
+
+(dm val> ()
+   ((: val) (extra)) )
+
+
+(class +Chg)
+# old new
+
+(dm T (Fun . @)
+   (=: new Fun)
+   (pass extra) )
+
+(dm set> (Val Dn)
+   (extra (=: old Val) Dn) )
+
+(dm val> ()
+   (let Val (extra)
+      (if (= (: old) Val)
+         Val
+         ((: new) Val) ) ) )
+
+
+(class +Upd)
+# upd
+
+(dm T (Exe . @)
+   (=: upd Exe)
+   (pass extra) )
+
+(dm upd> ()
+   (set> This (eval (: upd))) )
+
+
+(class +Init)
+# init
+
+(dm T (Val . @)
+   (=: init Val)
+   (pass extra) )
+
+(dm init> ()
+   (set> This (: init)) )
+
+
+(class +Dflt)
+# cue
+
+(dm T (Exe . @)
+   (=: cue Exe)
+   (pass extra) )
+
+(dm set> (Val Dn)
+   (extra (or Val (eval (: cue))) Dn) )
+
+(dm val> ()
+   (let Val (extra)
+      (unless (= Val (eval (: cue))) Val) ) )
+
+
+(class +Cue +Dflt)
+
+(dm T (Str . @)
+   (pass super (pack "<" Str ">")) )
+
+(dm show> ("Var")
+   (<style>
+      (let V (eval (: cue))
+         (list
+            (cons "onclick" (pack "if (this.value=='" V "') this.value=''"))
+            (cons "onblur" (pack "if (this.value=='') this.value='" V "'")) ) )
+      (extra "Var") ) )
+
+
+(class +Trim)
+
+(dm val> ()
+   (pack (trim (chop (extra)))) )
+
+
+(class +Enum)
+# enum
+
+(dm T (Lst . @)
+   (=: enum Lst)
+   (pass extra) )
+
+(dm set> (N Dn)
+   (extra (get (: enum) N) Dn) )
+
+(dm val> ()
+   (index (extra) (: enum)) )
+
+
+(class +Map)
+# map
+
+(dm T (Lst . @)
+   (=: map Lst)
+   (pass extra) )
+
+(dm set> (Val Dn)
+   (extra
+      (if
+         (find
+            '((X) (= Val (cdr X)))
+            (: map) )
+         (val (car @))
+         Val )
+      Dn ) )
+
+(dm val> ()
+   (let Val (extra)
+      (if
+         (find
+            '((X) (= Val (val (car X))))
+            (: map) )
+         (cdr @)
+         Val ) ) )
+
+
+# Case conversions
+(class +Uppc)
+
+(dm val> ()
+   (uppc (extra)) )
+
+
+(class +Lowc)
+
+(dm set> (Val Dn)
+   (extra (lowc Val) Dn) )
+
+(dm val> ()
+   (lowc (extra)) )
+
+
+# Field enable/disable
+(de able ()
+   (when (or (: rid) (: home able))
+      (eval (: able)) ) )
+
+(class +Able)
+
+(dm T (Exe . @)
+   (pass extra)
+   (when (: able)
+      (=: able
+         (cond
+            ((=T (: able)) Exe)
+            ((and (pair (: able)) (== 'and (car @)))
+               (cons 'and Exe (cdr (: able))) )
+            (T (list 'and Exe (: able))) ) ) ) )
+
+
+(class +Lock +Able)
+
+(dm T @
+   (pass super NIL) )
+
+
+(class +View +Lock +Upd)
+
+
+# Escape from form lock
+(class +Rid)
+# rid
+
+(dm T @
+   (=: rid T)
+   (pass extra) )
+
+
+(class +Align)
+
+(dm T @
+   (=: align T)
+   (pass extra) )
+
+
+(class +Limit)
+# lim
+
+(dm T (Exe . @)
+   (=: lim Exe)
+   (pass extra) )
+
+
+(class +Var)
+# var
+
+(dm T (Var . @)
+   (=: var Var)
+   (pass extra) )
+
+(dm set> (Val Dn)
+   (extra (set (: var) Val) Dn) )
+
+(dm upd> ()
+   (set> This (val (: var))) )
+
+
+(class +Chk)
+# chk
+
+(dm T (Exe . @)
+   (=: chk Exe)
+   (pass extra) )
+
+(dm chk> ()
+   (eval (: chk)) )
+
+
+(class +Tip)
+# tip
+
+(dm T (Exe . @)
+   (=: tip Exe)
+   (pass extra) )
+
+(dm show> ("Var")
+   (<tip> (eval (: tip)) (extra "Var")) )
+
+(dm js> ()
+   (pack (extra) "&?" (ht:Fmt (eval (: tip)))) )
+
+
+(class +Tiny)
+
+(dm show> ("Var")
+   (<style> 'tiny (extra "Var")) )
+
+
+(class +Click)
+# clk
+
+(dm T (Exe . @)
+   (=: clk Exe)
+   (pass extra) )
+
+(dm show> ("Var")
+   (extra "Var")
+   (and
+      (atom "*Err")
+      (eval (: clk))
+      (javascript NIL
+         "window.setTimeout(\"document.getElementById(\\\""
+         "i" *Form '- (: id)
+         "\\\").click()\","
+         @
+         ")" ) ) )
+
+
+(class +Focus)
+
+(dm show> ("Var")
+   (extra "Var")
+   (when (and (able) (not "*Foc"))
+      (on "*Foc")
+      (javascript NIL
+         "window.setTimeout(\"document.getElementById(\\\""
+         "i" *Form '- (: id)
+         "\\\").focus()\",420)" ) ) )
+
+
+### Styles ###
+(class +Style)
+# style
+
+(dm T (Exe . @)
+   (=: style Exe)
+   (pass extra) )
+
+(dm show> ("Var")
+   (<style> (eval (: style)) (extra "Var")) )
+
+(dm js> ()
+   (pack (extra) "&#" (eval (: style))) )
+
+
+# Monospace font
+(class +Mono)
+
+(dm show> ("Var")
+   (<style> "mono" (extra "Var")) )
+
+(dm js> ()
+   (pack (extra) "&#mono") )
+
+
+# Signum field
+(class +Sgn)
+
+(dm show> ("Var")
+   (<style> (and (lt0 (val> This)) "red") (extra "Var")) )
+
+(dm js> ()
+   (pack (extra) "&#" (and (lt0 (val> This)) "red")) )
+
+
+### Form field classes ###
+(de showFld "Prg"
+   (when (: lbl)
+      (ht:Prin (eval @))
+      (<nbsp>) )
+   (style (cons 'id (pack "i" *Form '- (: id))) "Prg") )
+
+
+(class +gui)
+# home id chg able chart
+
+(dm T ()
+   (push (=: home "*App") (cons (=: id "*Ix")))
+   (=: able T) )
+
+(dm txt> (Val))
+
+(dm set> (Val Dn))
+
+(dm clr> ()
+   (set> This) )
+
+(dm val> ())
+
+(dm init> ()
+   (upd> This) )
+
+(dm upd> ())
+
+(dm chk> ())
+
+
+(class +field +gui)
+
+(dm T ()
+   (super)
+   (=: chg T) )
+
+(dm txt> (Val)
+   Val )
+
+(dm js> ()
+   (let S (ht:Fmt (cdr (assoc (: id) (val *PRG))))
+      (if (able) S (pack S "&=")) ) )
+
+(dm set> (Str Dn)
+   (con (assoc (: id) (val (: home))) Str)
+   (and (not Dn) (: chart) (set> (car @) (val> (car @)))) )
+
+(dm str> ()
+   (cdr (assoc (: id) (val (: home)))) )
+
+(dm val> ()
+   (str> This) )
+
+
+# Get field
+(de field (X . @)
+   (if (sym? X)
+      (pass get (: home) X)
+      (pass get (: home gui) (+ X (abs (: id)))) ) )
+
+# Get current chart data row
+(de row (D)
+   (+ (: chart 1 ofs) (: chart 2) -1 (or D 0)) )
+
+(de curr @
+   (pass get (: chart 1 data) (row)) )
+
+(de prev @
+   (pass get (: chart 1 data) (row -1)) )
+
+
+(class +Button +gui)
+# img lbl alt act js
+
+# ([T] lbl [alt] act)
+(dm T @
+   (and (=: img (=T (next))) (next))
+   (=: lbl (arg))
+   (let X (next)
+      (ifn (args)
+         (=: act X)
+         (=: alt X)
+         (=: act (next)) ) )
+   (super)
+   (set
+      (car (val "*App"))
+      (=: id (- (: id))) ) )
+
+(dm js> ()
+   (if (able)
+      (let Str (ht:Fmt (eval (: lbl)))
+         (if (: img) (sesId Str) Str) )
+      (let Str (ht:Fmt (or (eval (: alt)) (eval (: lbl))))
+         (pack (if (: img) (sesId Str) Str) "&=") ) ) )
+
+(dm show> ("Var")
+   (<style> (cons 'id (pack "i" *Form '- (: id)))
+      (if (able)
+         (let Str (eval (: lbl))
+            ((if (: img) <image> <submit>) Str "Var" NIL (: js)) )
+         (let Str (or (eval (: alt)) (eval (: lbl)))
+            ((if (: img) <image> <submit>) Str "Var" T (: js)) ) ) ) )
+
+(dm act> ()
+   (and (able) (eval (: act))) )
+
+
+(class +JS)
+
+(dm T @
+   (=: js T)
+   (pass extra) )
+
+
+(class +Auto +JS)
+# auto
+
+(dm T (Fld Exe . @)
+   (=: auto (cons Fld Exe))
+   (pass super) )
+
+(dm act> ()
+   (when (able)
+      (=: home auto
+         (cons
+            (eval (car (: auto)))
+            (eval (cdr (: auto))) ) )
+      (extra) ) )
+
+
+(class +DnButton +Tiny +Rid +JS +Able +Button)
+
+(dm T (Exe Lbl)
+   (super
+      '(> (length (chart 'data)) (chart 'ofs))
+      (or Lbl ">")
+      (list 'scroll> (lit "*Chart") Exe) ) )
+
+
+(class +UpButton +Tiny +Rid +JS +Able +Button)
+
+(dm T (Exe Lbl)
+   (super
+      '(> (chart 'ofs) 1)
+      (or Lbl "<")
+      (list 'scroll> (lit "*Chart") (list '- Exe)) ) )
+
+(class +GoButton +Tiny +Rid +JS +Able +Button)
+
+(dm T (Exe Lbl)
+   (super
+      (list 'and
+         (list '>= '(length (chart 'data)) Exe)
+         (list '<> '(chart 'ofs) Exe) )
+      Lbl
+      (list 'goto> (lit "*Chart") Exe) ) )
+
+(de scroll (N Flg)
+   (when Flg
+      (gui '(+Tip +GoButton) ,"Go to first line" 1 "|<") )
+   (gui '(+Tip +UpButton) ,"Scroll up one page" N "<<")
+   (gui '(+Tip +UpButton) ,"Scroll up one line" 1)
+   (gui '(+Tip +DnButton) ,"Scroll down one line" 1)
+   (gui '(+Tip +DnButton) ,"Scroll down one page" N ">>")
+   (when Flg
+      (gui '(+Tip +GoButton) ,"Go to last line"
+         (list '- '(length (chart 'data)) (dec N))
+         ">|" )
+      (<nbsp>)
+      (gui '(+View +TextField)
+         '(let? Len (gt0 (length (chart 'data)))
+            (pack
+               (chart 'ofs)
+               "-"
+               (min Len (dec (+ (chart 'ofs) (chart 'rows))))
+               " / "
+               Len ) ) ) ) )
+
+
+# Delete row
+(class +DelRowButton +Tiny +JS +Able +Tip +Button)
+# del exe
+
+(dm T (Txt Exe)
+   (=: del Txt)
+   (=: exe Exe)
+   (super '(nth (: chart 1 data) (row)) ,"Delete row" "x"
+      '(if (or (: home del) (not (curr)))
+         (_delRow (: exe))
+         (ask (if (: del) (eval @) ,"Delete row?")
+            (with (: home btn)
+               (=: home del T)
+               (_delRow (: exe)) ) ) ) ) )
+
+(de _delRow (Exe)
+   (eval Exe)
+   (set> (: chart 1) (remove (row) (: chart 1 data))) )
+
+# Move row up
+(class +BubbleButton +Tiny +JS +Able +Tip +Button)
+
+(dm T ()
+   (super
+      '(> (: chart 2) 1)
+      ,"Shift row up"
+      "\^"
+      '(let L (: chart 1 data)
+         (set> (: chart 1)
+            (conc
+               (cut (row -2) 'L)
+               (cons (cadr L))
+               (cons (car L))
+               (cddr L) ) ) ) ) )
+
+
+(class +ClrButton +JS +Tip +Button)
+# clr
+
+(dm T (Lbl Lst . @)
+   (=: clr Lst)
+   (pass super ,"Clear all input fields" Lbl
+      '(for X (: clr)
+         (if (atom X)
+            (clr> (field X))
+            (set> (field (car X)) (eval (cdr X))) ) ) ) )
+
+
+(class +ShowButton +Button)
+
+(dm T (Flg Exe)
+   (super ,"Show"
+      (list '=: 'home 'show (lit Exe)) )
+   (and Flg (=: home show Exe)) )
+
+
+(class +Checkbox +field)
+# lbl
+
+# ([lbl])
+(dm T (Lbl)
+   (=: lbl Lbl)
+   (super) )
+
+(dm txt> (Val)
+   (if Val ,"Yes" ,"No") )
+
+(dm show> ("Var")
+   (showFld (<check> "Var" (not (able)))) )
+
+(dm set> (Val Dn)
+   (super (bool Val) Dn) )
+
+(dm val> ()
+   (bool (super)) )
+
+
+(class +Radio +field)  # Inited by Tomas Hlavaty <kvietaag@seznam.cz>
+# grp val lbl
+
+# (grp val [lbl])
+(dm T (Grp Val Lbl)
+   (super)
+   (=: grp (if Grp (field @) This))
+   (=: val Val)
+   (=: lbl Lbl) )
+
+(dm show> ("Var")
+   (showFld
+      (<radio>
+         (cons '*Gui (: grp id))
+         (: val)
+         (not (able)) ) ) )
+
+(dm js> ()
+   (pack
+      (ht:Fmt (: val))
+      "&" (= (: val) (str> (: grp)))
+      (unless (able) "&=") ) )
+
+(dm set> (Val Dn)
+   (when (== This (: grp))
+      (super Val Dn) ) )
+
+
+(class +TextField +field)
+# dx dy lst lbl lim align
+
+# ([dx [dy] [lbl]])
+# ([lst [lbl]])
+(dm T (X . @)
+   (nond
+      ((num? X)
+         (=: lst X)
+         (=: lbl (next)) )
+      ((num? (next))
+         (=: dx X)
+         (=: lbl (arg)) )
+      (NIL
+         (=: dx X)
+         (=: dy (arg))
+         (=: lbl (next)) ) )
+   (super)
+   (or (: dx) (: lst) (=: chg)) )
+
+(dm show> ("Var")
+   (showFld
+      (cond
+         ((: dy)
+            (<area> (: dx) (: dy) "Var" (not (able))) )
+         ((: dx)
+            (<field>
+               (if (: align) (- (: dx)) (: dx))
+               "Var"
+               (eval (: lim))
+               (not (able)) ) )
+         ((: lst)
+            (let
+               (L
+                  (mapcar
+                     '(("X")
+                        (if (atom "X")
+                           (val "X")
+                           (cons (val (car "X")) (val (cdr "X"))) ) )
+                     @ )
+                  S (str> This) )
+               (<select>
+                  (if (or (member S L) (assoc S L))
+                     L
+                     (cons S L) )
+                  "Var"
+                  (not (able)) ) ) )
+         (T
+            (<style> (cons 'id (pack "i" *Form '- (: id)))
+               (<span> *Style
+                  (if (str> This) (ht:Prin @) (<nbsp>)) ) ) ) ) ) )
+
+
+(class +LinesField +TextField)
+
+(dm set> (Val Dn)
+   (super (glue "^J" Val) Dn) )
+
+(dm val> ()
+   (split (chop (super)) "^J") )
+
+
+(class +ListTextField +TextField)
+# split
+
+(dm T (Lst . @)
+   (=: split Lst)
+   (pass super) )
+
+(dm set> (Val Dn)
+   (super (glue (car (: split)) Val) Dn) )
+
+(dm val> ()
+   (extract pack
+      (apply split (: split) (chop (super))) ) )
+
+
+# Password field
+(class +PwField +TextField)
+
+(dm show> ("Var")
+   (showFld
+      (<passwd> (: dx) "Var" (eval (: lim)) (not (able))) ) )
+
+
+# Upload field
+(class +UpField +TextField)
+
+(dm show> ("Var")
+   (showFld
+      (<upload> (: dx) "Var" (not (able))) ) )
+
+
+# Symbol fields
+(class +SymField +TextField)
+
+(dm val> ()
+   (let S (super)
+      (and (<> "-" S) (intern S)) ) )
+
+(dm set> (Val Dn)
+   (super (name Val) Dn) )
+
+
+(class +numField +Align +TextField)
+# scl
+
+(dm chk> ()
+   (and
+      (str> This)
+      (not (format @ (: scl) *Sep0 *Sep3))
+      ,"Numeric input expected" ) )
+
+
+(class +NumField +numField)
+
+(dm txt> (Val)
+   (format Val) )
+
+(dm set> (Val Dn)
+   (super (format Val) Dn) )
+
+(dm val> ()
+   (format (super) NIL *Sep0 *Sep3) )
+
+
+(class +FixField +numField)
+
+(dm T (N . @)
+   (=: scl N)
+   (pass super) )
+
+(dm txt> (Val)
+   (format Val (: scl) *Sep0 *Sep3) )
+
+(dm set> (Val Dn)
+   (super (format Val (: scl) *Sep0 *Sep3) Dn) )
+
+(dm val> ()
+   (let S (super)
+      (format
+         (if (sub? *Sep0 S) S (pack S *Sep0))
+         (: scl)
+         *Sep0
+         *Sep3 ) ) )
+
+
+(class +AtomField +Mono +TextField)
+
+(dm set> (Val Dn)
+   (super
+      (if (num? Val)
+         (align (: dx) (format Val))
+         Val )
+      Dn ) )
+
+(dm val> ()
+   (let S (super)
+      (or (format S) S) ) )
+
+
+(class +DateField +TextField)
+
+(dm txt> (Val)
+   (datStr Val) )
+
+(dm set> (Val Dn)
+   (super (datStr Val) Dn) )
+
+(dm val> ()
+   (expDat (super)) )
+
+(dm chk> ()
+   (and
+      (str> This)
+      (not (val> This))
+      ,"Bad date format" ) )
+
+
+(class +TimeField +TextField)
+
+(dm txt> (Val)
+   (tim$ Val (> (: dx) 6)) )
+
+(dm set> (Val Dn)
+   (super (tim$ Val (> (: dx) 6)) Dn) )
+
+(dm val> ()
+   ($tim (super)) )
+
+(dm chk> ()
+   (and
+      (str> This)
+      (not (val> This))
+      ,"Bad time format" ) )
+
+
+(class +Icon)
+# icon url
+
+(dm T (Exe Url . @)
+   (=: icon Exe)
+   (=: url Url)
+   (pass extra) )
+
+(dm js> ()
+   (pack (extra) "&*"
+      (ht:Fmt (sesId (eval (: icon)))) '&
+      (and (eval (: url)) (ht:Fmt (sesId @))) ) )
+
+(dm show> ("Var")
+   (prin "<table cellspacing=\"0\" cellpadding=\"0\"><td>")
+   (extra "Var")
+   (prin "</td><td>")
+   (<img> (eval (: icon)) 'icon (eval (: url)))
+   (prinl "</td></table>") )
+
+
+(class +FileField +TextField)
+# file org
+
+(dm T (Exe . @)
+   (=: file Exe)
+   (pass super) )
+
+(dm set> (Val Dn)
+   (and
+      (<> Val (: org))
+      (eval (: file))
+      (out @ (prin (=: org Val))) )
+   (super Val Dn) )
+
+(dm upd> ()
+   (set> This
+      (=: org
+         (let? F (eval (: file))
+            (and (info F) (in F (till NIL T))) ) ) ) )
+
+
+(class +Url)
+# url
+
+(dm T (Fun . @)
+   (=: url Fun)
+   (pass extra) )
+
+(dm js> ()
+   (if2 (or (: dx) (: lst)) (txt> This (val> This))
+      (pack (extra) "&*" (ht:Fmt (sesId `(path "@img/go.png"))) '& (ht:Fmt (sesId ((: url) @))))
+      (pack (extra) "&*" (ht:Fmt (sesId `(path "@img/no.png"))) '&)
+      (pack @ "&+" (ht:Fmt (sesId ((: url) @))))
+      (extra) ) )
+
+(dm show> ("Var")
+   (cond
+      ((or (: dx) (: lst))
+         (prin "<table cellspacing=\"0\" cellpadding=\"0\"><td>")
+         (extra "Var")
+         (prin "</td><td title=\"-->\">")
+         (if (val> This)
+            (<img> `(path "@img/go.png") 'url ((: url) (txt> This @)))
+            (<img> `(path "@img/no.png")) )
+         (prinl "</td></table>") )
+      ((val> This)
+         (showFld (<href> @ ((: url) (txt> This @)))) )
+      (T (extra "Var")) ) )
+
+
+(class +HttpField +Url +TextField)
+
+(dm T @
+   (pass super
+      '((S) (if (sub? "://" S) S (pack "http://" S))) ) )
+
+
+(class +MailField +Url +TextField)
+
+(dm T @
+   (pass super '((S) (pack "mailto:" S))) )
+
+
+(class +TelField +TextField)
+
+(dm txt> (Val)
+   (telStr Val) )
+
+(dm set> (Val Dn)
+   (super (telStr Val) Dn) )
+
+(dm val> ()
+   (expTel (super)) )
+
+(dm chk> ()
+   (and
+      (str> This)
+      (not (val> This))
+      ,"Bad phone number format" ) )
+
+
+(class +SexField +Map +TextField)
+
+(dm T (Lbl)
+   (super
+      '((,"male" . T) (,"female" . 0))
+      '(NIL ,"male" ,"female")
+      Lbl ) )
+
+
+(class +JsField +gui)
+# js str
+
+(dm T (Nm)
+   (super)
+   (=: js Nm) )
+
+(dm show> ("Var"))
+
+(dm js> ()
+   (pack (ht:Fmt NIL (: str) (: js))) )
+
+(dm set> (Val Dn)
+   (=: str Val) )
+
+
+### GUI charts ###
+(class +Chart)
+# home gui rows cols ofs lock put get data clip
+
+# (cols [put [get]])
+(dm T (N Put Get)
+   (setq "*Chart" This)
+   (put (=: home "*App") 'chart
+      (conc (get "*App" 'chart) (cons This)) )
+   (=: rows 1)
+   (when N
+      (=: gui (list (need (=: cols N)))) )
+   (=: ofs 1)
+   (=: lock T)
+   (=: put (or Put prog1))
+   (=: get (or Get prog1)) )
+
+(dm put> ()
+   (let I (: ofs)
+      (mapc
+         '((G D)
+            (unless (memq NIL G)
+               (mapc 'set> G ((: put) D I) '(T .)) )
+            (inc 'I) )
+         (: gui)
+         (nth (: data) I) ) ) )
+
+(dm get> ()
+   (and
+      (or (: rid) (: home able))
+      (not (: lock))
+      (let I (: ofs)
+         (map
+            '((G D)
+               (set D
+                  (trim
+                     ((: get)
+                        (mapcar 'val> (car G))
+                        (car D)
+                        (car G) ) ) )
+               (mapc 'set>
+                  (car G)
+                  ((: put) (car D) I)
+                  '(T .) )
+               (inc 'I) )
+            (: gui)
+            (nth
+               (=: data
+                  (need (- 1 I (: rows)) (: data)) )
+               I ) )
+         (=: data (trim (: data))) ) ) )
+
+(dm scroll> (N)
+   (get> This)
+   (unless (gt0 (inc (:: ofs) N))
+      (=: ofs 1) )
+   (put> This) )
+
+(dm goto> (N)
+   (get> This)
+   (=: ofs (max 1 N))
+   (put> This) )
+
+(dm find> ("Fun")
+   (get> This)
+   (let "D" (cdr (nth (: data) (: ofs)))
+      (=: ofs
+         (if (find "Fun" "D")
+            (index @ (: data))
+            1 ) ) )
+   (put> This) )
+
+(dm txt> (Flg)
+   (for (I . L) (: data)
+      (map
+         '((G D)
+            (prin (txt> (car G) (car D)))
+            (if
+               (cdr G)
+               (prin "^I")
+               (prinl (and Flg "^M")) ) )
+         (: gui 1)
+         ((: put) L I) ) ) )
+
+(dm set> (Lst)
+   (=: ofs
+      (max 1
+         (min (: ofs) (length (=: data (copy Lst)))) ) )
+   (put> This)
+   Lst )
+
+(dm log> (Lst)
+   (=: ofs (max (: ofs) (- (length (: data)) (: rows) -2)))
+   (set> This (conc (: data) (cons Lst))) )
+
+(dm clr> ()
+   (set> This) )
+
+(dm val> ()
+   (get> This)
+   (: data) )
+
+(dm init> ()
+   (upd> This) )
+
+(dm upd> ())
+
+(dm chk> ())
+
+(dm cut> (N)
+   (get> This)
+   (=: clip (get (: data) (: ofs)))
+   (set> This (remove (or N (: ofs)) (: data))) )
+
+(dm paste> (Flg N)
+   (get> This)
+   (set> This (insert (or N (: ofs)) (: data) (unless Flg (: clip)))) )
+
+
+(class +Chart1 +Chart)
+
+# (cols)
+(dm T (N)
+   (super N list car) )
+
+
+### DB GUI ###
+(de newUrl @
+   (prog1 (pass new!)
+      (lock (setq *Lock @))
+      (apply url (url> @ 1)) ) )
+
+
+# (choDlg Dst Ttl Rel [Hook] [((+XyzField) ..) Exe Able [Rel2 [Hook2]]])
+(de choDlg (Dst Ttl Rel . @)
+   (let
+      (Hook (and (meta (cdr Rel) (car Rel) 'hook) (next))
+         Fld (or (next) '((+TextField) 40))
+         Gui
+         (if (next)
+            (list '(+ObjView +TextField) @)
+            (list (list '+ObjView (last (car Fld))) (list ': (car Rel))) )
+         Able (if (args) (next) T) )
+      (nond
+         ((next)
+            (setq Ttl (list Ttl (car Rel) (last Rel) Hook)) )
+         ((=T (arg))
+            (setq Ttl (list Ttl (car (arg)) (cadr (arg)) (next))) ) )
+      (diaform '(Dst Ttl Rel Hook Fld Gui Able)
+         (apply gui
+            (cons
+               (cons '+Focus '+Var (car Fld))
+               (cdr (or (assoc Rel "*Cho") (push '"*Cho" (list Rel NIL))))
+               (cdr Fld) ) )
+         (searchButton '(init> (: home query)))
+         (gui 'query '(+QueryChart) (cho)
+            '(goal
+               (list
+                  (list 'db (car Rel) (last Rel) Hook (val> (: home gui 1)) '@@) ) )
+            2 '((Obj) (list Obj Obj)) )
+         (<table> 'chart (if (atom Ttl) Ttl (apply choTtl Ttl)) '((btn) NIL)
+            (do (cho)
+               (<row> (alternating)
+                  (gui 1 '(+DstButton) Dst)
+                  (apply gui Gui 2) ) ) )
+         (<spread>
+            (scroll (cho))
+            (if (meta (cdr Rel) (car Rel) 'hook)
+               (newButton Able Dst (cdr Rel)
+                  (meta (cdr Rel) (car Rel) 'hook)
+                  Hook
+                  (car Rel)
+                  (let? Val (val> (: home gui 1))
+                     (unless (db (car Rel) (last Rel) Hook Val)
+                        Val ) ) )
+               (newButton Able Dst (cdr Rel)
+                  (car Rel)
+                  (let? Val (val> (: home gui 1))
+                     (unless (db (car Rel) (last Rel) Val)
+                        Val ) ) ) )
+            (cancelButton) ) ) ) )
+
+(de choTtl (Ttl Var Cls Hook)
+   (with (or (get Cls Var) (meta Cls Var))
+      (if (isa '+Idx This)
+         Ttl
+         (pack (count (tree (: var) (: cls) Hook)) " " Ttl) ) ) )
+
+(de cho ()
+   (if (: diaform) 16 8) )
+
+
+# Able object
+(class +AO +Able)
+# ao
+
+(dm T (Exe . @)
+   (=: ao Exe)
+   (pass super
+      '(and
+         (: home obj)
+         (not (: home obj T))
+         (eval (: ao)) ) ) )
+
+
+# Lock/Edit button prefix
+(class +Edit +Rid +Force +Tip)
+# save
+
+(dm T (Exe)
+   (=: save Exe)
+   (super
+      '(nor (: home able) (lock (: home obj)))
+      '(if (: home able)
+         ,"Release exclusive write access for this object"
+         ,"Gain exclusive write access for this object" )
+      '(if (: home able) ,"Done" ,"Edit")
+      '(if (: home able)
+         (when (able)
+            (eval (: save))
+            (unless (pair "*Err")
+               (rollback)
+               (off *Lock) ) )
+         (tryLock (: home obj)) ) ) )
+
+(de tryLock (Obj)
+   (if (lock Obj)
+      (err (text ,"Currently edited by '@2' (@1)" @  (cdr (lup *Users @))))
+      (sync)
+      (setq *Lock Obj) ) )
+
+
+(de editButton (Able Exe)
+   (<style> (and (: able) 'edit)
+      (gui '(+AO +Focus +Edit +Button) Able Exe) ) )
+
+(de searchButton (Exe)
+   (gui '(+Rid +JS +Tip +Button) ,"Start search" ,"Search" Exe) )
+
+(de resetButton (Lst)
+   (gui '(+Force +ClrButton) T ,"Reset" Lst) )
+
+(de newButton (Able Dst . Args)
+   (gui '(+Rid +Able +Close +Tip +Button) Able ,"Create new object" ',"New"
+      (nond
+         (Dst (cons 'newUrl Args))
+         ((pair Dst)
+            (list 'set> (lit Dst) (cons 'new! Args)) )
+         (NIL
+            (list 'prog (list '=: 'obj (cons 'new! Args)) Dst) ) ) ) )
+
+# Clone object in form
+(de cloneButton (Able)
+   (gui '(+Rid +Able +Tip +Button) (or Able T)
+      ,"Create a new copy of this object"
+      ,"New/Copy"
+      '(apply url
+         (url>
+            (prog1
+               (clone!> (: home obj))
+               (lock (setq *Lock @)) )
+            1 ) ) ) )
+
+# Delete object in form
+(de delButton (Able @Txt)
+   (gui '(+Force +Rid +Able +Tip +Button) T Able
+      '(if (: home obj T)
+         ,"Mark this object as \"not deleted\""
+         ,"Mark this object as \"deleted\"" )
+      '(if (: home obj T) ,"Restore" ,"Delete")
+      (fill
+         '(nond
+            ((: home obj T)
+               (ask (text ,"Delete @1?" @Txt)
+                  (lose!> (: home top 1 obj)) ) )
+            ((keep?> (: home obj))
+               (ask (text ,"Restore @1?" @Txt)
+                  (keep!> (: home top 1 obj)) ) )
+            (NIL
+               (note ,"Restore"
+                  (mapcar
+                     '((X) (text "'@1' -- @2" (car X) (cdr X)))
+                     @ ) ) ) ) ) ) )
+
+
+# Relations
+(class +/R +Able)
+# erVar erObj
+
+(dm T (Lst . @)
+   (=: erVar (car Lst))
+   (=: erObj (cdr Lst))
+   (pass super
+      '(and (eval (: erObj)) (not (get @ T))) ) )
+
+(dm upd> ()
+   (set> This (get (eval (: erObj)) (: erVar))) )
+
+
+# Symbol/Relation
+(class +S/R +/R)
+
+(dm set> (Val Dn)
+   (and
+      (eval (: erObj))
+      (put! @ (: erVar) Val) )
+   (extra Val Dn) )
+
+
+# Entity/Relation
+(class +E/R +/R)
+
+(dm set> (Val Dn)
+   (and
+      (eval (: erObj))
+      (put!> @ (: erVar) Val) )
+   (extra Val Dn) )
+
+(dm chk> ()
+   (or
+      (extra)
+      (and
+         (eval (: erObj))
+         (mis> @ (: erVar) (val> This)) ) ) )
+
+
+(class +BlobField +/R +TextField)
+# org
+
+(dm set> (Val Dn)
+   (and
+      (<> Val (: org))
+      (let? Obj (eval (: erObj))
+         (protect
+            (when (put!> Obj (: erVar) (bool Val))
+               (and *Jnl (blob+ Obj (: erVar)))
+               (out (blob Obj (: erVar))
+                  (prin (=: org Val)) ) ) ) ) )
+   (super Val Dn) )
+
+(dm upd> ()
+   (set> This
+      (=: org
+         (let? Obj (eval (: erObj))
+            (when (get Obj (: erVar))
+               (in (blob Obj (: erVar))
+                  (till NIL T) ) ) ) ) ) )
+
+
+(class +ClassField +Map +TextField)
+# erObj
+
+(dm T (Exe Lst)
+   (=: erObj Exe)
+   (super Lst (mapcar car Lst)) )
+
+(dm upd> ()
+   (set> This (val (eval (: erObj)))) )
+
+(dm set> (Val Dn)
+   (and
+      (eval (: erObj))
+      (set!> @ Val) )
+   (super Val Dn) )
+
+
+(class +obj)
+# msg obj
+
+# ([T|msg] ..)
+(dm T ()
+   (ifn (atom (next))
+      (=: msg 'url>)
+      (=: msg (arg))
+      (next) ) )
+
+(dm js> ()
+   (if (=T (: msg))
+      (extra)
+      (if2 (or (: dx) (: lst)) (try (: msg) (: obj) 1)
+         (pack (extra) "&*" (ht:Fmt (sesId `(path "@img/go.png"))) '& (ht:Fmt (sesId (mkUrl @))))
+         (pack (extra) "&*" (ht:Fmt (sesId `(path "@img/no.png"))) '&)
+         (pack (ht:Fmt (nonblank (str> This))) "&+" (ht:Fmt (sesId (mkUrl @))))
+         (extra) ) ) )
+
+(dm show> ("Var")
+   (cond
+      ((=T (: msg)) (extra "Var"))
+      ((or (: dx) (: lst))
+         (prin "<table cellspacing=\"0\" cellpadding=\"0\"><td>")
+         (extra "Var")
+         (prin "</td><td title=\"-->\">")
+         (if (try (: msg) (: obj) 1)
+            (<img> `(path "@img/go.png") 'obj (mkUrl @))
+            (<img> `(path "@img/no.png")) )
+         (prinl "</td></table>") )
+      ((try (: msg) (: obj) 1)
+         (showFld (<href> (nonblank (str> This)) (mkUrl @))) )
+      (T (extra "Var")) ) )
+
+
+(class +Obj +obj)
+# objVar objTyp objHook
+
+# ([T|msg] (var . typ) [hook] [T] ..)
+(dm T @
+   (super)
+   (=: objVar (car (arg)))
+   (=: objTyp (cdr (arg)))
+   (when (meta (: objTyp) (: objVar) 'hook)
+      (=: objHook (next)) )
+   (pass extra
+      (if (nT (next))
+         (arg)
+         (cons NIL (hint> This)) ) ) )
+
+(dm hint> ()
+   (if (: objHook)
+      (collect (: objVar) (last (: objTyp)) (eval @) NIL T (: objVar))
+      (collect (: objVar) (last (: objTyp)) NIL T (: objVar)) ) )
+
+(dm txt> (Obj)
+   (if (ext? Obj)
+      (get Obj (: objVar))
+      Obj ) )
+
+(dm set> (Obj Dn)
+   (extra
+      (if (ext? (=: obj Obj))
+         (get Obj (: objVar))
+         Obj )
+      Dn ) )
+
+(dm val> ()
+   (let Val (extra)
+      (cond
+         ((and (: obj) (not (ext? @))) Val)
+         ((= Val (get (: obj) (: objVar)))
+            (: obj) )
+         ((: objTyp)
+            (=: obj
+               (if (: objHook)
+                  (db (: objVar) (last (: objTyp)) (eval @) Val)
+                  (db (: objVar) (last (: objTyp)) Val) ) ) )
+         (T Val) ) ) )
+
+(dm chk> ()
+   (or
+      (extra)
+      (let? S (str> This)
+         (and
+            (: objTyp)
+            (not (val> This))
+            (<> "-" S)
+            ,"Data not found" ) ) ) )
+
+
+(class +ObjView +obj)
+# disp obj
+
+# ([T|msg] exe ..)
+(dm T @
+   (super)
+   (=: disp (arg))
+   (pass extra)
+   (=: able) )
+
+(dm txt> (Obj)
+   (let Exe (: disp)
+      (if (ext? Obj)
+         (with Obj (eval Exe))
+         Obj ) ) )
+
+(dm set> (Obj Dn)
+   (let Exe (: disp)
+      (extra
+         (if (ext? (=: obj Obj))
+            (with Obj (eval Exe))
+            Obj )
+         Dn ) ) )
+
+(dm val> ()
+   (: obj) )
+
+
+# DB query chart
+(class +QueryChart +Chart)
+# iniR iniq query
+
+# (iniR iniQ cols [put [get]])
+(dm T (R Q . @)
+   (=: iniR R)
+   (=: iniQ Q)
+   (pass super) )
+
+(dm init> ()
+   (query> This (eval (: iniQ))) )
+
+(dm put> ()
+   (while
+      (and
+         (> (: ofs) (- (length (: data)) (max (: rows) (: iniR))))
+         (get (prove (: query)) '@@) )
+      (=: data (conc (: data) (cons @))) )
+   (super) )
+
+(dm txt> (Flg)
+   (for ((I . Q) (eval (: iniQ)) (prove Q))
+      (map
+         '((G D)
+            (prin (txt> (car G) (car D)))
+            (if (cdr G)
+               (prin "^I")
+               (prinl (and Flg "^M")) ) )
+         (: gui 1)
+         ((: put) (; @ @@) I) ) ) )
+
+(dm all> ()
+   (make
+      (for (Q (eval (: iniQ)) (prove Q))
+         (link (; @ @@)) ) ) )
+
+(dm query> (Q)
+   (=: query Q)
+   (set> This) )
+
+(dm sort> (Exe)
+   (set> This
+      (goal
+         (list
+            (list 'lst '@@
+               (by '((This) (eval Exe)) sort (: data)) ) ) ) ) )
+
+(dm clr> ()
+   (query> This (fail)) )
+
+
+(====)
+
+# Form object
+(de <id> "Lst"
+   (with (if *PRG (: obj) (=: obj *ID))
+      (and (: T) (prin "["))
+      (for "X" (if (=T (car "Lst")) (cdr "Lst") "Lst")
+         (ht:Prin (eval "X")) )
+      (and (: T) (prin "]")) )
+   (=: able
+      (cond
+         ((: obj T))
+         ((=T (car "Lst")) T)
+         ((== *Lock (: obj)) T)
+         (*Lock (rollback) (off *Lock)) ) ) )
+
+(de panel (Able Txt Del Dlg Var Cls Hook Msg Exe)
+   (<spread>
+      (editButton Able Exe)
+      (delButton
+         (cond
+            ((=T Able) Del)
+            ((=T Del) Able)
+            ((and Able Del) (list 'and Able Del)) )
+         (list 'text Txt (list ': 'home 'obj Var)) )
+      (choButton Dlg)
+      (stepBtn Var Cls Hook Msg) )
+   (--) )
+
+`*Dbg
+(noLint 'gui)
+(noLint 'choDlg 'gui)
+(noLint 'jsForm 'action)
+
+# vi:et:ts=3:sw=3
diff --git a/lib/gcc.l b/lib/gcc.l
@@ -0,0 +1,40 @@
+# 10oct08abu
+# (c) Software Lab. Alexander Burger
+
+(de gcc (S L . @)
+   (out (tmp S ".c")
+      (chdir '@ (prinl "#include \"" (pwd) "/src/pico.h\""))
+      (here "/**/") )
+   ~(case *OS
+      (("Linux" "FreeBSD")
+         (quote
+            (apply call L 'gcc "-m32" "-o" (tmp S)
+               "-shared" "-export-dynamic"
+               "-O" "-falign-functions" "-fomit-frame-pointer"
+               "-W" "-Wimplicit" "-Wreturn-type" "-Wunused" "-Wformat"
+               "-Wuninitialized" "-Wstrict-prototypes"
+               "-pipe" "-D_GNU_SOURCE" "-D_FILE_OFFSET_BITS=64" (tmp S ".c") ) ) )
+      ("Darwin"
+         (quote
+            (apply call L 'gcc "-o" (tmp S)
+               "-dynamiclib" "-undefined" "dynamic_lookup"
+               "-O" "-falign-functions" "-fomit-frame-pointer"
+               "-W" "-Wimplicit" "-Wreturn-type" "-Wunused" "-Wformat"
+               "-Wuninitialized" "-Wstrict-prototypes"
+               "-pipe" "-D_GNU_SOURCE" "-D_FILE_OFFSET_BITS=64" (tmp S ".c") ) ) )
+      ("Cygwin"
+         (quote
+            (call 'gcc "-c"
+               "-Os" "-falign-functions" "-fomit-frame-pointer"
+               "-W" "-Wimplicit" "-Wreturn-type" "-Wunused" "-Wformat"
+               "-Wuninitialized" "-Wstrict-prototypes"
+               "-pipe" "-D_GNU_SOURCE" "-D_FILE_OFFSET_BITS=64"
+               (pack "-I" (path "@src") )
+               "-o" (tmp S ".o") (tmp S ".c"))
+            (apply call L 'gcc "-shared" "-o" (tmp S ".dll")
+               (tmp S ".o")
+               (path "@bin/picolisp.dll") ) ) ) )
+   (while (args)
+      (def (next) (def (tmp S ': (arg)))) ) )
+
+# vi:et:ts=3:sw=3
diff --git a/lib/glyphlist.txt b/lib/glyphlist.txt
@@ -0,0 +1,4322 @@
+# ###################################################################################
+# Copyright (c) 1997,1998,2002,2007 Adobe Systems Incorporated
+# 
+# Permission is hereby granted, free of charge, to any person obtaining a
+# copy of this documentation file to use, copy, publish, distribute,
+# sublicense, and/or sell copies of the documentation, and to permit
+# others to do the same, provided that:
+# - No modification, editing or other alteration of this document is
+# allowed; and
+# - The above copyright notice and this permission notice shall be
+# included in all copies of the documentation.
+# 
+# Permission is hereby granted, free of charge, to any person obtaining a
+# copy of this documentation file, to create their own derivative works
+# from the content of this document to use, copy, publish, distribute,
+# sublicense, and/or sell the derivative works, and to permit others to do
+# the same, provided that the derived work is not represented as being a
+# copy or version of this document.
+# 
+# Adobe shall not be liable to any party for any loss of revenue or profit
+# or for indirect, incidental, special, consequential, or other similar
+# damages, whether based on tort (including without limitation negligence
+# or strict liability), contract or other legal or equitable grounds even
+# if Adobe has been advised or had reason to know of the possibility of
+# such damages.� The Adobe materials are provided on an "AS IS" basis.�
+# Adobe specifically disclaims all express, statutory, or implied
+# warranties relating to the Adobe materials, including but not limited to
+# those concerning merchantability or fitness for a particular purpose or
+# non-infringement of any third party rights regarding the Adobe
+# materials.
+# ###################################################################################
+# Name:          Adobe Glyph List
+# Table version: 2.0
+# Date:          September 20, 2002
+#
+# See http://partners.adobe.com/asn/developer/typeforum/unicodegn.html
+#
+# Format: Semicolon-delimited fields:
+#            (1) glyph name
+#            (2) Unicode scalar value
+A;0041
+AE;00C6
+AEacute;01FC
+AEmacron;01E2
+AEsmall;F7E6
+Aacute;00C1
+Aacutesmall;F7E1
+Abreve;0102
+Abreveacute;1EAE
+Abrevecyrillic;04D0
+Abrevedotbelow;1EB6
+Abrevegrave;1EB0
+Abrevehookabove;1EB2
+Abrevetilde;1EB4
+Acaron;01CD
+Acircle;24B6
+Acircumflex;00C2
+Acircumflexacute;1EA4
+Acircumflexdotbelow;1EAC
+Acircumflexgrave;1EA6
+Acircumflexhookabove;1EA8
+Acircumflexsmall;F7E2
+Acircumflextilde;1EAA
+Acute;F6C9
+Acutesmall;F7B4
+Acyrillic;0410
+Adblgrave;0200
+Adieresis;00C4
+Adieresiscyrillic;04D2
+Adieresismacron;01DE
+Adieresissmall;F7E4
+Adotbelow;1EA0
+Adotmacron;01E0
+Agrave;00C0
+Agravesmall;F7E0
+Ahookabove;1EA2
+Aiecyrillic;04D4
+Ainvertedbreve;0202
+Alpha;0391
+Alphatonos;0386
+Amacron;0100
+Amonospace;FF21
+Aogonek;0104
+Aring;00C5
+Aringacute;01FA
+Aringbelow;1E00
+Aringsmall;F7E5
+Asmall;F761
+Atilde;00C3
+Atildesmall;F7E3
+Aybarmenian;0531
+B;0042
+Bcircle;24B7
+Bdotaccent;1E02
+Bdotbelow;1E04
+Becyrillic;0411
+Benarmenian;0532
+Beta;0392
+Bhook;0181
+Blinebelow;1E06
+Bmonospace;FF22
+Brevesmall;F6F4
+Bsmall;F762
+Btopbar;0182
+C;0043
+Caarmenian;053E
+Cacute;0106
+Caron;F6CA
+Caronsmall;F6F5
+Ccaron;010C
+Ccedilla;00C7
+Ccedillaacute;1E08
+Ccedillasmall;F7E7
+Ccircle;24B8
+Ccircumflex;0108
+Cdot;010A
+Cdotaccent;010A
+Cedillasmall;F7B8
+Chaarmenian;0549
+Cheabkhasiancyrillic;04BC
+Checyrillic;0427
+Chedescenderabkhasiancyrillic;04BE
+Chedescendercyrillic;04B6
+Chedieresiscyrillic;04F4
+Cheharmenian;0543
+Chekhakassiancyrillic;04CB
+Cheverticalstrokecyrillic;04B8
+Chi;03A7
+Chook;0187
+Circumflexsmall;F6F6
+Cmonospace;FF23
+Coarmenian;0551
+Csmall;F763
+D;0044
+DZ;01F1
+DZcaron;01C4
+Daarmenian;0534
+Dafrican;0189
+Dcaron;010E
+Dcedilla;1E10
+Dcircle;24B9
+Dcircumflexbelow;1E12
+Dcroat;0110
+Ddotaccent;1E0A
+Ddotbelow;1E0C
+Decyrillic;0414
+Deicoptic;03EE
+Delta;2206
+Deltagreek;0394
+Dhook;018A
+Dieresis;F6CB
+DieresisAcute;F6CC
+DieresisGrave;F6CD
+Dieresissmall;F7A8
+Digammagreek;03DC
+Djecyrillic;0402
+Dlinebelow;1E0E
+Dmonospace;FF24
+Dotaccentsmall;F6F7
+Dslash;0110
+Dsmall;F764
+Dtopbar;018B
+Dz;01F2
+Dzcaron;01C5
+Dzeabkhasiancyrillic;04E0
+Dzecyrillic;0405
+Dzhecyrillic;040F
+E;0045
+Eacute;00C9
+Eacutesmall;F7E9
+Ebreve;0114
+Ecaron;011A
+Ecedillabreve;1E1C
+Echarmenian;0535
+Ecircle;24BA
+Ecircumflex;00CA
+Ecircumflexacute;1EBE
+Ecircumflexbelow;1E18
+Ecircumflexdotbelow;1EC6
+Ecircumflexgrave;1EC0
+Ecircumflexhookabove;1EC2
+Ecircumflexsmall;F7EA
+Ecircumflextilde;1EC4
+Ecyrillic;0404
+Edblgrave;0204
+Edieresis;00CB
+Edieresissmall;F7EB
+Edot;0116
+Edotaccent;0116
+Edotbelow;1EB8
+Efcyrillic;0424
+Egrave;00C8
+Egravesmall;F7E8
+Eharmenian;0537
+Ehookabove;1EBA
+Eightroman;2167
+Einvertedbreve;0206
+Eiotifiedcyrillic;0464
+Elcyrillic;041B
+Elevenroman;216A
+Emacron;0112
+Emacronacute;1E16
+Emacrongrave;1E14
+Emcyrillic;041C
+Emonospace;FF25
+Encyrillic;041D
+Endescendercyrillic;04A2
+Eng;014A
+Enghecyrillic;04A4
+Enhookcyrillic;04C7
+Eogonek;0118
+Eopen;0190
+Epsilon;0395
+Epsilontonos;0388
+Ercyrillic;0420
+Ereversed;018E
+Ereversedcyrillic;042D
+Escyrillic;0421
+Esdescendercyrillic;04AA
+Esh;01A9
+Esmall;F765
+Eta;0397
+Etarmenian;0538
+Etatonos;0389
+Eth;00D0
+Ethsmall;F7F0
+Etilde;1EBC
+Etildebelow;1E1A
+Euro;20AC
+Ezh;01B7
+Ezhcaron;01EE
+Ezhreversed;01B8
+F;0046
+Fcircle;24BB
+Fdotaccent;1E1E
+Feharmenian;0556
+Feicoptic;03E4
+Fhook;0191
+Fitacyrillic;0472
+Fiveroman;2164
+Fmonospace;FF26
+Fourroman;2163
+Fsmall;F766
+G;0047
+GBsquare;3387
+Gacute;01F4
+Gamma;0393
+Gammaafrican;0194
+Gangiacoptic;03EA
+Gbreve;011E
+Gcaron;01E6
+Gcedilla;0122
+Gcircle;24BC
+Gcircumflex;011C
+Gcommaaccent;0122
+Gdot;0120
+Gdotaccent;0120
+Gecyrillic;0413
+Ghadarmenian;0542
+Ghemiddlehookcyrillic;0494
+Ghestrokecyrillic;0492
+Gheupturncyrillic;0490
+Ghook;0193
+Gimarmenian;0533
+Gjecyrillic;0403
+Gmacron;1E20
+Gmonospace;FF27
+Grave;F6CE
+Gravesmall;F760
+Gsmall;F767
+Gsmallhook;029B
+Gstroke;01E4
+H;0048
+H18533;25CF
+H18543;25AA
+H18551;25AB
+H22073;25A1
+HPsquare;33CB
+Haabkhasiancyrillic;04A8
+Hadescendercyrillic;04B2
+Hardsigncyrillic;042A
+Hbar;0126
+Hbrevebelow;1E2A
+Hcedilla;1E28
+Hcircle;24BD
+Hcircumflex;0124
+Hdieresis;1E26
+Hdotaccent;1E22
+Hdotbelow;1E24
+Hmonospace;FF28
+Hoarmenian;0540
+Horicoptic;03E8
+Hsmall;F768
+Hungarumlaut;F6CF
+Hungarumlautsmall;F6F8
+Hzsquare;3390
+I;0049
+IAcyrillic;042F
+IJ;0132
+IUcyrillic;042E
+Iacute;00CD
+Iacutesmall;F7ED
+Ibreve;012C
+Icaron;01CF
+Icircle;24BE
+Icircumflex;00CE
+Icircumflexsmall;F7EE
+Icyrillic;0406
+Idblgrave;0208
+Idieresis;00CF
+Idieresisacute;1E2E
+Idieresiscyrillic;04E4
+Idieresissmall;F7EF
+Idot;0130
+Idotaccent;0130
+Idotbelow;1ECA
+Iebrevecyrillic;04D6
+Iecyrillic;0415
+Ifraktur;2111
+Igrave;00CC
+Igravesmall;F7EC
+Ihookabove;1EC8
+Iicyrillic;0418
+Iinvertedbreve;020A
+Iishortcyrillic;0419
+Imacron;012A
+Imacroncyrillic;04E2
+Imonospace;FF29
+Iniarmenian;053B
+Iocyrillic;0401
+Iogonek;012E
+Iota;0399
+Iotaafrican;0196
+Iotadieresis;03AA
+Iotatonos;038A
+Ismall;F769
+Istroke;0197
+Itilde;0128
+Itildebelow;1E2C
+Izhitsacyrillic;0474
+Izhitsadblgravecyrillic;0476
+J;004A
+Jaarmenian;0541
+Jcircle;24BF
+Jcircumflex;0134
+Jecyrillic;0408
+Jheharmenian;054B
+Jmonospace;FF2A
+Jsmall;F76A
+K;004B
+KBsquare;3385
+KKsquare;33CD
+Kabashkircyrillic;04A0
+Kacute;1E30
+Kacyrillic;041A
+Kadescendercyrillic;049A
+Kahookcyrillic;04C3
+Kappa;039A
+Kastrokecyrillic;049E
+Kaverticalstrokecyrillic;049C
+Kcaron;01E8
+Kcedilla;0136
+Kcircle;24C0
+Kcommaaccent;0136
+Kdotbelow;1E32
+Keharmenian;0554
+Kenarmenian;053F
+Khacyrillic;0425
+Kheicoptic;03E6
+Khook;0198
+Kjecyrillic;040C
+Klinebelow;1E34
+Kmonospace;FF2B
+Koppacyrillic;0480
+Koppagreek;03DE
+Ksicyrillic;046E
+Ksmall;F76B
+L;004C
+LJ;01C7
+LL;F6BF
+Lacute;0139
+Lambda;039B
+Lcaron;013D
+Lcedilla;013B
+Lcircle;24C1
+Lcircumflexbelow;1E3C
+Lcommaaccent;013B
+Ldot;013F
+Ldotaccent;013F
+Ldotbelow;1E36
+Ldotbelowmacron;1E38
+Liwnarmenian;053C
+Lj;01C8
+Ljecyrillic;0409
+Llinebelow;1E3A
+Lmonospace;FF2C
+Lslash;0141
+Lslashsmall;F6F9
+Lsmall;F76C
+M;004D
+MBsquare;3386
+Macron;F6D0
+Macronsmall;F7AF
+Macute;1E3E
+Mcircle;24C2
+Mdotaccent;1E40
+Mdotbelow;1E42
+Menarmenian;0544
+Mmonospace;FF2D
+Msmall;F76D
+Mturned;019C
+Mu;039C
+N;004E
+NJ;01CA
+Nacute;0143
+Ncaron;0147
+Ncedilla;0145
+Ncircle;24C3
+Ncircumflexbelow;1E4A
+Ncommaaccent;0145
+Ndotaccent;1E44
+Ndotbelow;1E46
+Nhookleft;019D
+Nineroman;2168
+Nj;01CB
+Njecyrillic;040A
+Nlinebelow;1E48
+Nmonospace;FF2E
+Nowarmenian;0546
+Nsmall;F76E
+Ntilde;00D1
+Ntildesmall;F7F1
+Nu;039D
+O;004F
+OE;0152
+OEsmall;F6FA
+Oacute;00D3
+Oacutesmall;F7F3
+Obarredcyrillic;04E8
+Obarreddieresiscyrillic;04EA
+Obreve;014E
+Ocaron;01D1
+Ocenteredtilde;019F
+Ocircle;24C4
+Ocircumflex;00D4
+Ocircumflexacute;1ED0
+Ocircumflexdotbelow;1ED8
+Ocircumflexgrave;1ED2
+Ocircumflexhookabove;1ED4
+Ocircumflexsmall;F7F4
+Ocircumflextilde;1ED6
+Ocyrillic;041E
+Odblacute;0150
+Odblgrave;020C
+Odieresis;00D6
+Odieresiscyrillic;04E6
+Odieresissmall;F7F6
+Odotbelow;1ECC
+Ogoneksmall;F6FB
+Ograve;00D2
+Ogravesmall;F7F2
+Oharmenian;0555
+Ohm;2126
+Ohookabove;1ECE
+Ohorn;01A0
+Ohornacute;1EDA
+Ohorndotbelow;1EE2
+Ohorngrave;1EDC
+Ohornhookabove;1EDE
+Ohorntilde;1EE0
+Ohungarumlaut;0150
+Oi;01A2
+Oinvertedbreve;020E
+Omacron;014C
+Omacronacute;1E52
+Omacrongrave;1E50
+Omega;2126
+Omegacyrillic;0460
+Omegagreek;03A9
+Omegaroundcyrillic;047A
+Omegatitlocyrillic;047C
+Omegatonos;038F
+Omicron;039F
+Omicrontonos;038C
+Omonospace;FF2F
+Oneroman;2160
+Oogonek;01EA
+Oogonekmacron;01EC
+Oopen;0186
+Oslash;00D8
+Oslashacute;01FE
+Oslashsmall;F7F8
+Osmall;F76F
+Ostrokeacute;01FE
+Otcyrillic;047E
+Otilde;00D5
+Otildeacute;1E4C
+Otildedieresis;1E4E
+Otildesmall;F7F5
+P;0050
+Pacute;1E54
+Pcircle;24C5
+Pdotaccent;1E56
+Pecyrillic;041F
+Peharmenian;054A
+Pemiddlehookcyrillic;04A6
+Phi;03A6
+Phook;01A4
+Pi;03A0
+Piwrarmenian;0553
+Pmonospace;FF30
+Psi;03A8
+Psicyrillic;0470
+Psmall;F770
+Q;0051
+Qcircle;24C6
+Qmonospace;FF31
+Qsmall;F771
+R;0052
+Raarmenian;054C
+Racute;0154
+Rcaron;0158
+Rcedilla;0156
+Rcircle;24C7
+Rcommaaccent;0156
+Rdblgrave;0210
+Rdotaccent;1E58
+Rdotbelow;1E5A
+Rdotbelowmacron;1E5C
+Reharmenian;0550
+Rfraktur;211C
+Rho;03A1
+Ringsmall;F6FC
+Rinvertedbreve;0212
+Rlinebelow;1E5E
+Rmonospace;FF32
+Rsmall;F772
+Rsmallinverted;0281
+Rsmallinvertedsuperior;02B6
+S;0053
+SF010000;250C
+SF020000;2514
+SF030000;2510
+SF040000;2518
+SF050000;253C
+SF060000;252C
+SF070000;2534
+SF080000;251C
+SF090000;2524
+SF100000;2500
+SF110000;2502
+SF190000;2561
+SF200000;2562
+SF210000;2556
+SF220000;2555
+SF230000;2563
+SF240000;2551
+SF250000;2557
+SF260000;255D
+SF270000;255C
+SF280000;255B
+SF360000;255E
+SF370000;255F
+SF380000;255A
+SF390000;2554
+SF400000;2569
+SF410000;2566
+SF420000;2560
+SF430000;2550
+SF440000;256C
+SF450000;2567
+SF460000;2568
+SF470000;2564
+SF480000;2565
+SF490000;2559
+SF500000;2558
+SF510000;2552
+SF520000;2553
+SF530000;256B
+SF540000;256A
+Sacute;015A
+Sacutedotaccent;1E64
+Sampigreek;03E0
+Scaron;0160
+Scarondotaccent;1E66
+Scaronsmall;F6FD
+Scedilla;015E
+Schwa;018F
+Schwacyrillic;04D8
+Schwadieresiscyrillic;04DA
+Scircle;24C8
+Scircumflex;015C
+Scommaaccent;0218
+Sdotaccent;1E60
+Sdotbelow;1E62
+Sdotbelowdotaccent;1E68
+Seharmenian;054D
+Sevenroman;2166
+Shaarmenian;0547
+Shacyrillic;0428
+Shchacyrillic;0429
+Sheicoptic;03E2
+Shhacyrillic;04BA
+Shimacoptic;03EC
+Sigma;03A3
+Sixroman;2165
+Smonospace;FF33
+Softsigncyrillic;042C
+Ssmall;F773
+Stigmagreek;03DA
+T;0054
+Tau;03A4
+Tbar;0166
+Tcaron;0164
+Tcedilla;0162
+Tcircle;24C9
+Tcircumflexbelow;1E70
+Tcommaaccent;0162
+Tdotaccent;1E6A
+Tdotbelow;1E6C
+Tecyrillic;0422
+Tedescendercyrillic;04AC
+Tenroman;2169
+Tetsecyrillic;04B4
+Theta;0398
+Thook;01AC
+Thorn;00DE
+Thornsmall;F7FE
+Threeroman;2162
+Tildesmall;F6FE
+Tiwnarmenian;054F
+Tlinebelow;1E6E
+Tmonospace;FF34
+Toarmenian;0539
+Tonefive;01BC
+Tonesix;0184
+Tonetwo;01A7
+Tretroflexhook;01AE
+Tsecyrillic;0426
+Tshecyrillic;040B
+Tsmall;F774
+Twelveroman;216B
+Tworoman;2161
+U;0055
+Uacute;00DA
+Uacutesmall;F7FA
+Ubreve;016C
+Ucaron;01D3
+Ucircle;24CA
+Ucircumflex;00DB
+Ucircumflexbelow;1E76
+Ucircumflexsmall;F7FB
+Ucyrillic;0423
+Udblacute;0170
+Udblgrave;0214
+Udieresis;00DC
+Udieresisacute;01D7
+Udieresisbelow;1E72
+Udieresiscaron;01D9
+Udieresiscyrillic;04F0
+Udieresisgrave;01DB
+Udieresismacron;01D5
+Udieresissmall;F7FC
+Udotbelow;1EE4
+Ugrave;00D9
+Ugravesmall;F7F9
+Uhookabove;1EE6
+Uhorn;01AF
+Uhornacute;1EE8
+Uhorndotbelow;1EF0
+Uhorngrave;1EEA
+Uhornhookabove;1EEC
+Uhorntilde;1EEE
+Uhungarumlaut;0170
+Uhungarumlautcyrillic;04F2
+Uinvertedbreve;0216
+Ukcyrillic;0478
+Umacron;016A
+Umacroncyrillic;04EE
+Umacrondieresis;1E7A
+Umonospace;FF35
+Uogonek;0172
+Upsilon;03A5
+Upsilon1;03D2
+Upsilonacutehooksymbolgreek;03D3
+Upsilonafrican;01B1
+Upsilondieresis;03AB
+Upsilondieresishooksymbolgreek;03D4
+Upsilonhooksymbol;03D2
+Upsilontonos;038E
+Uring;016E
+Ushortcyrillic;040E
+Usmall;F775
+Ustraightcyrillic;04AE
+Ustraightstrokecyrillic;04B0
+Utilde;0168
+Utildeacute;1E78
+Utildebelow;1E74
+V;0056
+Vcircle;24CB
+Vdotbelow;1E7E
+Vecyrillic;0412
+Vewarmenian;054E
+Vhook;01B2
+Vmonospace;FF36
+Voarmenian;0548
+Vsmall;F776
+Vtilde;1E7C
+W;0057
+Wacute;1E82
+Wcircle;24CC
+Wcircumflex;0174
+Wdieresis;1E84
+Wdotaccent;1E86
+Wdotbelow;1E88
+Wgrave;1E80
+Wmonospace;FF37
+Wsmall;F777
+X;0058
+Xcircle;24CD
+Xdieresis;1E8C
+Xdotaccent;1E8A
+Xeharmenian;053D
+Xi;039E
+Xmonospace;FF38
+Xsmall;F778
+Y;0059
+Yacute;00DD
+Yacutesmall;F7FD
+Yatcyrillic;0462
+Ycircle;24CE
+Ycircumflex;0176
+Ydieresis;0178
+Ydieresissmall;F7FF
+Ydotaccent;1E8E
+Ydotbelow;1EF4
+Yericyrillic;042B
+Yerudieresiscyrillic;04F8
+Ygrave;1EF2
+Yhook;01B3
+Yhookabove;1EF6
+Yiarmenian;0545
+Yicyrillic;0407
+Yiwnarmenian;0552
+Ymonospace;FF39
+Ysmall;F779
+Ytilde;1EF8
+Yusbigcyrillic;046A
+Yusbigiotifiedcyrillic;046C
+Yuslittlecyrillic;0466
+Yuslittleiotifiedcyrillic;0468
+Z;005A
+Zaarmenian;0536
+Zacute;0179
+Zcaron;017D
+Zcaronsmall;F6FF
+Zcircle;24CF
+Zcircumflex;1E90
+Zdot;017B
+Zdotaccent;017B
+Zdotbelow;1E92
+Zecyrillic;0417
+Zedescendercyrillic;0498
+Zedieresiscyrillic;04DE
+Zeta;0396
+Zhearmenian;053A
+Zhebrevecyrillic;04C1
+Zhecyrillic;0416
+Zhedescendercyrillic;0496
+Zhedieresiscyrillic;04DC
+Zlinebelow;1E94
+Zmonospace;FF3A
+Zsmall;F77A
+Zstroke;01B5
+a;0061
+aabengali;0986
+aacute;00E1
+aadeva;0906
+aagujarati;0A86
+aagurmukhi;0A06
+aamatragurmukhi;0A3E
+aarusquare;3303
+aavowelsignbengali;09BE
+aavowelsigndeva;093E
+aavowelsigngujarati;0ABE
+abbreviationmarkarmenian;055F
+abbreviationsigndeva;0970
+abengali;0985
+abopomofo;311A
+abreve;0103
+abreveacute;1EAF
+abrevecyrillic;04D1
+abrevedotbelow;1EB7
+abrevegrave;1EB1
+abrevehookabove;1EB3
+abrevetilde;1EB5
+acaron;01CE
+acircle;24D0
+acircumflex;00E2
+acircumflexacute;1EA5
+acircumflexdotbelow;1EAD
+acircumflexgrave;1EA7
+acircumflexhookabove;1EA9
+acircumflextilde;1EAB
+acute;00B4
+acutebelowcmb;0317
+acutecmb;0301
+acutecomb;0301
+acutedeva;0954
+acutelowmod;02CF
+acutetonecmb;0341
+acyrillic;0430
+adblgrave;0201
+addakgurmukhi;0A71
+adeva;0905
+adieresis;00E4
+adieresiscyrillic;04D3
+adieresismacron;01DF
+adotbelow;1EA1
+adotmacron;01E1
+ae;00E6
+aeacute;01FD
+aekorean;3150
+aemacron;01E3
+afii00208;2015
+afii08941;20A4
+afii10017;0410
+afii10018;0411
+afii10019;0412
+afii10020;0413
+afii10021;0414
+afii10022;0415
+afii10023;0401
+afii10024;0416
+afii10025;0417
+afii10026;0418
+afii10027;0419
+afii10028;041A
+afii10029;041B
+afii10030;041C
+afii10031;041D
+afii10032;041E
+afii10033;041F
+afii10034;0420
+afii10035;0421
+afii10036;0422
+afii10037;0423
+afii10038;0424
+afii10039;0425
+afii10040;0426
+afii10041;0427
+afii10042;0428
+afii10043;0429
+afii10044;042A
+afii10045;042B
+afii10046;042C
+afii10047;042D
+afii10048;042E
+afii10049;042F
+afii10050;0490
+afii10051;0402
+afii10052;0403
+afii10053;0404
+afii10054;0405
+afii10055;0406
+afii10056;0407
+afii10057;0408
+afii10058;0409
+afii10059;040A
+afii10060;040B
+afii10061;040C
+afii10062;040E
+afii10063;F6C4
+afii10064;F6C5
+afii10065;0430
+afii10066;0431
+afii10067;0432
+afii10068;0433
+afii10069;0434
+afii10070;0435
+afii10071;0451
+afii10072;0436
+afii10073;0437
+afii10074;0438
+afii10075;0439
+afii10076;043A
+afii10077;043B
+afii10078;043C
+afii10079;043D
+afii10080;043E
+afii10081;043F
+afii10082;0440
+afii10083;0441
+afii10084;0442
+afii10085;0443
+afii10086;0444
+afii10087;0445
+afii10088;0446
+afii10089;0447
+afii10090;0448
+afii10091;0449
+afii10092;044A
+afii10093;044B
+afii10094;044C
+afii10095;044D
+afii10096;044E
+afii10097;044F
+afii10098;0491
+afii10099;0452
+afii10100;0453
+afii10101;0454
+afii10102;0455
+afii10103;0456
+afii10104;0457
+afii10105;0458
+afii10106;0459
+afii10107;045A
+afii10108;045B
+afii10109;045C
+afii10110;045E
+afii10145;040F
+afii10146;0462
+afii10147;0472
+afii10148;0474
+afii10192;F6C6
+afii10193;045F
+afii10194;0463
+afii10195;0473
+afii10196;0475
+afii10831;F6C7
+afii10832;F6C8
+afii10846;04D9
+afii299;200E
+afii300;200F
+afii301;200D
+afii57381;066A
+afii57388;060C
+afii57392;0660
+afii57393;0661
+afii57394;0662
+afii57395;0663
+afii57396;0664
+afii57397;0665
+afii57398;0666
+afii57399;0667
+afii57400;0668
+afii57401;0669
+afii57403;061B
+afii57407;061F
+afii57409;0621
+afii57410;0622
+afii57411;0623
+afii57412;0624
+afii57413;0625
+afii57414;0626
+afii57415;0627
+afii57416;0628
+afii57417;0629
+afii57418;062A
+afii57419;062B
+afii57420;062C
+afii57421;062D
+afii57422;062E
+afii57423;062F
+afii57424;0630
+afii57425;0631
+afii57426;0632
+afii57427;0633
+afii57428;0634
+afii57429;0635
+afii57430;0636
+afii57431;0637
+afii57432;0638
+afii57433;0639
+afii57434;063A
+afii57440;0640
+afii57441;0641
+afii57442;0642
+afii57443;0643
+afii57444;0644
+afii57445;0645
+afii57446;0646
+afii57448;0648
+afii57449;0649
+afii57450;064A
+afii57451;064B
+afii57452;064C
+afii57453;064D
+afii57454;064E
+afii57455;064F
+afii57456;0650
+afii57457;0651
+afii57458;0652
+afii57470;0647
+afii57505;06A4
+afii57506;067E
+afii57507;0686
+afii57508;0698
+afii57509;06AF
+afii57511;0679
+afii57512;0688
+afii57513;0691
+afii57514;06BA
+afii57519;06D2
+afii57534;06D5
+afii57636;20AA
+afii57645;05BE
+afii57658;05C3
+afii57664;05D0
+afii57665;05D1
+afii57666;05D2
+afii57667;05D3
+afii57668;05D4
+afii57669;05D5
+afii57670;05D6
+afii57671;05D7
+afii57672;05D8
+afii57673;05D9
+afii57674;05DA
+afii57675;05DB
+afii57676;05DC
+afii57677;05DD
+afii57678;05DE
+afii57679;05DF
+afii57680;05E0
+afii57681;05E1
+afii57682;05E2
+afii57683;05E3
+afii57684;05E4
+afii57685;05E5
+afii57686;05E6
+afii57687;05E7
+afii57688;05E8
+afii57689;05E9
+afii57690;05EA
+afii57694;FB2A
+afii57695;FB2B
+afii57700;FB4B
+afii57705;FB1F
+afii57716;05F0
+afii57717;05F1
+afii57718;05F2
+afii57723;FB35
+afii57793;05B4
+afii57794;05B5
+afii57795;05B6
+afii57796;05BB
+afii57797;05B8
+afii57798;05B7
+afii57799;05B0
+afii57800;05B2
+afii57801;05B1
+afii57802;05B3
+afii57803;05C2
+afii57804;05C1
+afii57806;05B9
+afii57807;05BC
+afii57839;05BD
+afii57841;05BF
+afii57842;05C0
+afii57929;02BC
+afii61248;2105
+afii61289;2113
+afii61352;2116
+afii61573;202C
+afii61574;202D
+afii61575;202E
+afii61664;200C
+afii63167;066D
+afii64937;02BD
+agrave;00E0
+agujarati;0A85
+agurmukhi;0A05
+ahiragana;3042
+ahookabove;1EA3
+aibengali;0990
+aibopomofo;311E
+aideva;0910
+aiecyrillic;04D5
+aigujarati;0A90
+aigurmukhi;0A10
+aimatragurmukhi;0A48
+ainarabic;0639
+ainfinalarabic;FECA
+aininitialarabic;FECB
+ainmedialarabic;FECC
+ainvertedbreve;0203
+aivowelsignbengali;09C8
+aivowelsigndeva;0948
+aivowelsigngujarati;0AC8
+akatakana;30A2
+akatakanahalfwidth;FF71
+akorean;314F
+alef;05D0
+alefarabic;0627
+alefdageshhebrew;FB30
+aleffinalarabic;FE8E
+alefhamzaabovearabic;0623
+alefhamzaabovefinalarabic;FE84
+alefhamzabelowarabic;0625
+alefhamzabelowfinalarabic;FE88
+alefhebrew;05D0
+aleflamedhebrew;FB4F
+alefmaddaabovearabic;0622
+alefmaddaabovefinalarabic;FE82
+alefmaksuraarabic;0649
+alefmaksurafinalarabic;FEF0
+alefmaksurainitialarabic;FEF3
+alefmaksuramedialarabic;FEF4
+alefpatahhebrew;FB2E
+alefqamatshebrew;FB2F
+aleph;2135
+allequal;224C
+alpha;03B1
+alphatonos;03AC
+amacron;0101
+amonospace;FF41
+ampersand;0026
+ampersandmonospace;FF06
+ampersandsmall;F726
+amsquare;33C2
+anbopomofo;3122
+angbopomofo;3124
+angkhankhuthai;0E5A
+angle;2220
+anglebracketleft;3008
+anglebracketleftvertical;FE3F
+anglebracketright;3009
+anglebracketrightvertical;FE40
+angleleft;2329
+angleright;232A
+angstrom;212B
+anoteleia;0387
+anudattadeva;0952
+anusvarabengali;0982
+anusvaradeva;0902
+anusvaragujarati;0A82
+aogonek;0105
+apaatosquare;3300
+aparen;249C
+apostrophearmenian;055A
+apostrophemod;02BC
+apple;F8FF
+approaches;2250
+approxequal;2248
+approxequalorimage;2252
+approximatelyequal;2245
+araeaekorean;318E
+araeakorean;318D
+arc;2312
+arighthalfring;1E9A
+aring;00E5
+aringacute;01FB
+aringbelow;1E01
+arrowboth;2194
+arrowdashdown;21E3
+arrowdashleft;21E0
+arrowdashright;21E2
+arrowdashup;21E1
+arrowdblboth;21D4
+arrowdbldown;21D3
+arrowdblleft;21D0
+arrowdblright;21D2
+arrowdblup;21D1
+arrowdown;2193
+arrowdownleft;2199
+arrowdownright;2198
+arrowdownwhite;21E9
+arrowheaddownmod;02C5
+arrowheadleftmod;02C2
+arrowheadrightmod;02C3
+arrowheadupmod;02C4
+arrowhorizex;F8E7
+arrowleft;2190
+arrowleftdbl;21D0
+arrowleftdblstroke;21CD
+arrowleftoverright;21C6
+arrowleftwhite;21E6
+arrowright;2192
+arrowrightdblstroke;21CF
+arrowrightheavy;279E
+arrowrightoverleft;21C4
+arrowrightwhite;21E8
+arrowtableft;21E4
+arrowtabright;21E5
+arrowup;2191
+arrowupdn;2195
+arrowupdnbse;21A8
+arrowupdownbase;21A8
+arrowupleft;2196
+arrowupleftofdown;21C5
+arrowupright;2197
+arrowupwhite;21E7
+arrowvertex;F8E6
+asciicircum;005E
+asciicircummonospace;FF3E
+asciitilde;007E
+asciitildemonospace;FF5E
+ascript;0251
+ascriptturned;0252
+asmallhiragana;3041
+asmallkatakana;30A1
+asmallkatakanahalfwidth;FF67
+asterisk;002A
+asteriskaltonearabic;066D
+asteriskarabic;066D
+asteriskmath;2217
+asteriskmonospace;FF0A
+asterisksmall;FE61
+asterism;2042
+asuperior;F6E9
+asymptoticallyequal;2243
+at;0040
+atilde;00E3
+atmonospace;FF20
+atsmall;FE6B
+aturned;0250
+aubengali;0994
+aubopomofo;3120
+audeva;0914
+augujarati;0A94
+augurmukhi;0A14
+aulengthmarkbengali;09D7
+aumatragurmukhi;0A4C
+auvowelsignbengali;09CC
+auvowelsigndeva;094C
+auvowelsigngujarati;0ACC
+avagrahadeva;093D
+aybarmenian;0561
+ayin;05E2
+ayinaltonehebrew;FB20
+ayinhebrew;05E2
+b;0062
+babengali;09AC
+backslash;005C
+backslashmonospace;FF3C
+badeva;092C
+bagujarati;0AAC
+bagurmukhi;0A2C
+bahiragana;3070
+bahtthai;0E3F
+bakatakana;30D0
+bar;007C
+barmonospace;FF5C
+bbopomofo;3105
+bcircle;24D1
+bdotaccent;1E03
+bdotbelow;1E05
+beamedsixteenthnotes;266C
+because;2235
+becyrillic;0431
+beharabic;0628
+behfinalarabic;FE90
+behinitialarabic;FE91
+behiragana;3079
+behmedialarabic;FE92
+behmeeminitialarabic;FC9F
+behmeemisolatedarabic;FC08
+behnoonfinalarabic;FC6D
+bekatakana;30D9
+benarmenian;0562
+bet;05D1
+beta;03B2
+betasymbolgreek;03D0
+betdagesh;FB31
+betdageshhebrew;FB31
+bethebrew;05D1
+betrafehebrew;FB4C
+bhabengali;09AD
+bhadeva;092D
+bhagujarati;0AAD
+bhagurmukhi;0A2D
+bhook;0253
+bihiragana;3073
+bikatakana;30D3
+bilabialclick;0298
+bindigurmukhi;0A02
+birusquare;3331
+blackcircle;25CF
+blackdiamond;25C6
+blackdownpointingtriangle;25BC
+blackleftpointingpointer;25C4
+blackleftpointingtriangle;25C0
+blacklenticularbracketleft;3010
+blacklenticularbracketleftvertical;FE3B
+blacklenticularbracketright;3011
+blacklenticularbracketrightvertical;FE3C
+blacklowerlefttriangle;25E3
+blacklowerrighttriangle;25E2
+blackrectangle;25AC
+blackrightpointingpointer;25BA
+blackrightpointingtriangle;25B6
+blacksmallsquare;25AA
+blacksmilingface;263B
+blacksquare;25A0
+blackstar;2605
+blackupperlefttriangle;25E4
+blackupperrighttriangle;25E5
+blackuppointingsmalltriangle;25B4
+blackuppointingtriangle;25B2
+blank;2423
+blinebelow;1E07
+block;2588
+bmonospace;FF42
+bobaimaithai;0E1A
+bohiragana;307C
+bokatakana;30DC
+bparen;249D
+bqsquare;33C3
+braceex;F8F4
+braceleft;007B
+braceleftbt;F8F3
+braceleftmid;F8F2
+braceleftmonospace;FF5B
+braceleftsmall;FE5B
+bracelefttp;F8F1
+braceleftvertical;FE37
+braceright;007D
+bracerightbt;F8FE
+bracerightmid;F8FD
+bracerightmonospace;FF5D
+bracerightsmall;FE5C
+bracerighttp;F8FC
+bracerightvertical;FE38
+bracketleft;005B
+bracketleftbt;F8F0
+bracketleftex;F8EF
+bracketleftmonospace;FF3B
+bracketlefttp;F8EE
+bracketright;005D
+bracketrightbt;F8FB
+bracketrightex;F8FA
+bracketrightmonospace;FF3D
+bracketrighttp;F8F9
+breve;02D8
+brevebelowcmb;032E
+brevecmb;0306
+breveinvertedbelowcmb;032F
+breveinvertedcmb;0311
+breveinverteddoublecmb;0361
+bridgebelowcmb;032A
+bridgeinvertedbelowcmb;033A
+brokenbar;00A6
+bstroke;0180
+bsuperior;F6EA
+btopbar;0183
+buhiragana;3076
+bukatakana;30D6
+bullet;2022
+bulletinverse;25D8
+bulletoperator;2219
+bullseye;25CE
+c;0063
+caarmenian;056E
+cabengali;099A
+cacute;0107
+cadeva;091A
+cagujarati;0A9A
+cagurmukhi;0A1A
+calsquare;3388
+candrabindubengali;0981
+candrabinducmb;0310
+candrabindudeva;0901
+candrabindugujarati;0A81
+capslock;21EA
+careof;2105
+caron;02C7
+caronbelowcmb;032C
+caroncmb;030C
+carriagereturn;21B5
+cbopomofo;3118
+ccaron;010D
+ccedilla;00E7
+ccedillaacute;1E09
+ccircle;24D2
+ccircumflex;0109
+ccurl;0255
+cdot;010B
+cdotaccent;010B
+cdsquare;33C5
+cedilla;00B8
+cedillacmb;0327
+cent;00A2
+centigrade;2103
+centinferior;F6DF
+centmonospace;FFE0
+centoldstyle;F7A2
+centsuperior;F6E0
+chaarmenian;0579
+chabengali;099B
+chadeva;091B
+chagujarati;0A9B
+chagurmukhi;0A1B
+chbopomofo;3114
+cheabkhasiancyrillic;04BD
+checkmark;2713
+checyrillic;0447
+chedescenderabkhasiancyrillic;04BF
+chedescendercyrillic;04B7
+chedieresiscyrillic;04F5
+cheharmenian;0573
+chekhakassiancyrillic;04CC
+cheverticalstrokecyrillic;04B9
+chi;03C7
+chieuchacirclekorean;3277
+chieuchaparenkorean;3217
+chieuchcirclekorean;3269
+chieuchkorean;314A
+chieuchparenkorean;3209
+chochangthai;0E0A
+chochanthai;0E08
+chochingthai;0E09
+chochoethai;0E0C
+chook;0188
+cieucacirclekorean;3276
+cieucaparenkorean;3216
+cieuccirclekorean;3268
+cieuckorean;3148
+cieucparenkorean;3208
+cieucuparenkorean;321C
+circle;25CB
+circlemultiply;2297
+circleot;2299
+circleplus;2295
+circlepostalmark;3036
+circlewithlefthalfblack;25D0
+circlewithrighthalfblack;25D1
+circumflex;02C6
+circumflexbelowcmb;032D
+circumflexcmb;0302
+clear;2327
+clickalveolar;01C2
+clickdental;01C0
+clicklateral;01C1
+clickretroflex;01C3
+club;2663
+clubsuitblack;2663
+clubsuitwhite;2667
+cmcubedsquare;33A4
+cmonospace;FF43
+cmsquaredsquare;33A0
+coarmenian;0581
+colon;003A
+colonmonetary;20A1
+colonmonospace;FF1A
+colonsign;20A1
+colonsmall;FE55
+colontriangularhalfmod;02D1
+colontriangularmod;02D0
+comma;002C
+commaabovecmb;0313
+commaaboverightcmb;0315
+commaaccent;F6C3
+commaarabic;060C
+commaarmenian;055D
+commainferior;F6E1
+commamonospace;FF0C
+commareversedabovecmb;0314
+commareversedmod;02BD
+commasmall;FE50
+commasuperior;F6E2
+commaturnedabovecmb;0312
+commaturnedmod;02BB
+compass;263C
+congruent;2245
+contourintegral;222E
+control;2303
+controlACK;0006
+controlBEL;0007
+controlBS;0008
+controlCAN;0018
+controlCR;000D
+controlDC1;0011
+controlDC2;0012
+controlDC3;0013
+controlDC4;0014
+controlDEL;007F
+controlDLE;0010
+controlEM;0019
+controlENQ;0005
+controlEOT;0004
+controlESC;001B
+controlETB;0017
+controlETX;0003
+controlFF;000C
+controlFS;001C
+controlGS;001D
+controlHT;0009
+controlLF;000A
+controlNAK;0015
+controlRS;001E
+controlSI;000F
+controlSO;000E
+controlSOT;0002
+controlSTX;0001
+controlSUB;001A
+controlSYN;0016
+controlUS;001F
+controlVT;000B
+copyright;00A9
+copyrightsans;F8E9
+copyrightserif;F6D9
+cornerbracketleft;300C
+cornerbracketlefthalfwidth;FF62
+cornerbracketleftvertical;FE41
+cornerbracketright;300D
+cornerbracketrighthalfwidth;FF63
+cornerbracketrightvertical;FE42
+corporationsquare;337F
+cosquare;33C7
+coverkgsquare;33C6
+cparen;249E
+cruzeiro;20A2
+cstretched;0297
+curlyand;22CF
+curlyor;22CE
+currency;00A4
+cyrBreve;F6D1
+cyrFlex;F6D2
+cyrbreve;F6D4
+cyrflex;F6D5
+d;0064
+daarmenian;0564
+dabengali;09A6
+dadarabic;0636
+dadeva;0926
+dadfinalarabic;FEBE
+dadinitialarabic;FEBF
+dadmedialarabic;FEC0
+dagesh;05BC
+dageshhebrew;05BC
+dagger;2020
+daggerdbl;2021
+dagujarati;0AA6
+dagurmukhi;0A26
+dahiragana;3060
+dakatakana;30C0
+dalarabic;062F
+dalet;05D3
+daletdagesh;FB33
+daletdageshhebrew;FB33
+dalethatafpatah;05D3 05B2
+dalethatafpatahhebrew;05D3 05B2
+dalethatafsegol;05D3 05B1
+dalethatafsegolhebrew;05D3 05B1
+dalethebrew;05D3
+dalethiriq;05D3 05B4
+dalethiriqhebrew;05D3 05B4
+daletholam;05D3 05B9
+daletholamhebrew;05D3 05B9
+daletpatah;05D3 05B7
+daletpatahhebrew;05D3 05B7
+daletqamats;05D3 05B8
+daletqamatshebrew;05D3 05B8
+daletqubuts;05D3 05BB
+daletqubutshebrew;05D3 05BB
+daletsegol;05D3 05B6
+daletsegolhebrew;05D3 05B6
+daletsheva;05D3 05B0
+daletshevahebrew;05D3 05B0
+dalettsere;05D3 05B5
+dalettserehebrew;05D3 05B5
+dalfinalarabic;FEAA
+dammaarabic;064F
+dammalowarabic;064F
+dammatanaltonearabic;064C
+dammatanarabic;064C
+danda;0964
+dargahebrew;05A7
+dargalefthebrew;05A7
+dasiapneumatacyrilliccmb;0485
+dblGrave;F6D3
+dblanglebracketleft;300A
+dblanglebracketleftvertical;FE3D
+dblanglebracketright;300B
+dblanglebracketrightvertical;FE3E
+dblarchinvertedbelowcmb;032B
+dblarrowleft;21D4
+dblarrowright;21D2
+dbldanda;0965
+dblgrave;F6D6
+dblgravecmb;030F
+dblintegral;222C
+dbllowline;2017
+dbllowlinecmb;0333
+dbloverlinecmb;033F
+dblprimemod;02BA
+dblverticalbar;2016
+dblverticallineabovecmb;030E
+dbopomofo;3109
+dbsquare;33C8
+dcaron;010F
+dcedilla;1E11
+dcircle;24D3
+dcircumflexbelow;1E13
+dcroat;0111
+ddabengali;09A1
+ddadeva;0921
+ddagujarati;0AA1
+ddagurmukhi;0A21
+ddalarabic;0688
+ddalfinalarabic;FB89
+dddhadeva;095C
+ddhabengali;09A2
+ddhadeva;0922
+ddhagujarati;0AA2
+ddhagurmukhi;0A22
+ddotaccent;1E0B
+ddotbelow;1E0D
+decimalseparatorarabic;066B
+decimalseparatorpersian;066B
+decyrillic;0434
+degree;00B0
+dehihebrew;05AD
+dehiragana;3067
+deicoptic;03EF
+dekatakana;30C7
+deleteleft;232B
+deleteright;2326
+delta;03B4
+deltaturned;018D
+denominatorminusonenumeratorbengali;09F8
+dezh;02A4
+dhabengali;09A7
+dhadeva;0927
+dhagujarati;0AA7
+dhagurmukhi;0A27
+dhook;0257
+dialytikatonos;0385
+dialytikatonoscmb;0344
+diamond;2666
+diamondsuitwhite;2662
+dieresis;00A8
+dieresisacute;F6D7
+dieresisbelowcmb;0324
+dieresiscmb;0308
+dieresisgrave;F6D8
+dieresistonos;0385
+dihiragana;3062
+dikatakana;30C2
+dittomark;3003
+divide;00F7
+divides;2223
+divisionslash;2215
+djecyrillic;0452
+dkshade;2593
+dlinebelow;1E0F
+dlsquare;3397
+dmacron;0111
+dmonospace;FF44
+dnblock;2584
+dochadathai;0E0E
+dodekthai;0E14
+dohiragana;3069
+dokatakana;30C9
+dollar;0024
+dollarinferior;F6E3
+dollarmonospace;FF04
+dollaroldstyle;F724
+dollarsmall;FE69
+dollarsuperior;F6E4
+dong;20AB
+dorusquare;3326
+dotaccent;02D9
+dotaccentcmb;0307
+dotbelowcmb;0323
+dotbelowcomb;0323
+dotkatakana;30FB
+dotlessi;0131
+dotlessj;F6BE
+dotlessjstrokehook;0284
+dotmath;22C5
+dottedcircle;25CC
+doubleyodpatah;FB1F
+doubleyodpatahhebrew;FB1F
+downtackbelowcmb;031E
+downtackmod;02D5
+dparen;249F
+dsuperior;F6EB
+dtail;0256
+dtopbar;018C
+duhiragana;3065
+dukatakana;30C5
+dz;01F3
+dzaltone;02A3
+dzcaron;01C6
+dzcurl;02A5
+dzeabkhasiancyrillic;04E1
+dzecyrillic;0455
+dzhecyrillic;045F
+e;0065
+eacute;00E9
+earth;2641
+ebengali;098F
+ebopomofo;311C
+ebreve;0115
+ecandradeva;090D
+ecandragujarati;0A8D
+ecandravowelsigndeva;0945
+ecandravowelsigngujarati;0AC5
+ecaron;011B
+ecedillabreve;1E1D
+echarmenian;0565
+echyiwnarmenian;0587
+ecircle;24D4
+ecircumflex;00EA
+ecircumflexacute;1EBF
+ecircumflexbelow;1E19
+ecircumflexdotbelow;1EC7
+ecircumflexgrave;1EC1
+ecircumflexhookabove;1EC3
+ecircumflextilde;1EC5
+ecyrillic;0454
+edblgrave;0205
+edeva;090F
+edieresis;00EB
+edot;0117
+edotaccent;0117
+edotbelow;1EB9
+eegurmukhi;0A0F
+eematragurmukhi;0A47
+efcyrillic;0444
+egrave;00E8
+egujarati;0A8F
+eharmenian;0567
+ehbopomofo;311D
+ehiragana;3048
+ehookabove;1EBB
+eibopomofo;311F
+eight;0038
+eightarabic;0668
+eightbengali;09EE
+eightcircle;2467
+eightcircleinversesansserif;2791
+eightdeva;096E
+eighteencircle;2471
+eighteenparen;2485
+eighteenperiod;2499
+eightgujarati;0AEE
+eightgurmukhi;0A6E
+eighthackarabic;0668
+eighthangzhou;3028
+eighthnotebeamed;266B
+eightideographicparen;3227
+eightinferior;2088
+eightmonospace;FF18
+eightoldstyle;F738
+eightparen;247B
+eightperiod;248F
+eightpersian;06F8
+eightroman;2177
+eightsuperior;2078
+eightthai;0E58
+einvertedbreve;0207
+eiotifiedcyrillic;0465
+ekatakana;30A8
+ekatakanahalfwidth;FF74
+ekonkargurmukhi;0A74
+ekorean;3154
+elcyrillic;043B
+element;2208
+elevencircle;246A
+elevenparen;247E
+elevenperiod;2492
+elevenroman;217A
+ellipsis;2026
+ellipsisvertical;22EE
+emacron;0113
+emacronacute;1E17
+emacrongrave;1E15
+emcyrillic;043C
+emdash;2014
+emdashvertical;FE31
+emonospace;FF45
+emphasismarkarmenian;055B
+emptyset;2205
+enbopomofo;3123
+encyrillic;043D
+endash;2013
+endashvertical;FE32
+endescendercyrillic;04A3
+eng;014B
+engbopomofo;3125
+enghecyrillic;04A5
+enhookcyrillic;04C8
+enspace;2002
+eogonek;0119
+eokorean;3153
+eopen;025B
+eopenclosed;029A
+eopenreversed;025C
+eopenreversedclosed;025E
+eopenreversedhook;025D
+eparen;24A0
+epsilon;03B5
+epsilontonos;03AD
+equal;003D
+equalmonospace;FF1D
+equalsmall;FE66
+equalsuperior;207C
+equivalence;2261
+erbopomofo;3126
+ercyrillic;0440
+ereversed;0258
+ereversedcyrillic;044D
+escyrillic;0441
+esdescendercyrillic;04AB
+esh;0283
+eshcurl;0286
+eshortdeva;090E
+eshortvowelsigndeva;0946
+eshreversedloop;01AA
+eshsquatreversed;0285
+esmallhiragana;3047
+esmallkatakana;30A7
+esmallkatakanahalfwidth;FF6A
+estimated;212E
+esuperior;F6EC
+eta;03B7
+etarmenian;0568
+etatonos;03AE
+eth;00F0
+etilde;1EBD
+etildebelow;1E1B
+etnahtafoukhhebrew;0591
+etnahtafoukhlefthebrew;0591
+etnahtahebrew;0591
+etnahtalefthebrew;0591
+eturned;01DD
+eukorean;3161
+euro;20AC
+evowelsignbengali;09C7
+evowelsigndeva;0947
+evowelsigngujarati;0AC7
+exclam;0021
+exclamarmenian;055C
+exclamdbl;203C
+exclamdown;00A1
+exclamdownsmall;F7A1
+exclammonospace;FF01
+exclamsmall;F721
+existential;2203
+ezh;0292
+ezhcaron;01EF
+ezhcurl;0293
+ezhreversed;01B9
+ezhtail;01BA
+f;0066
+fadeva;095E
+fagurmukhi;0A5E
+fahrenheit;2109
+fathaarabic;064E
+fathalowarabic;064E
+fathatanarabic;064B
+fbopomofo;3108
+fcircle;24D5
+fdotaccent;1E1F
+feharabic;0641
+feharmenian;0586
+fehfinalarabic;FED2
+fehinitialarabic;FED3
+fehmedialarabic;FED4
+feicoptic;03E5
+female;2640
+ff;FB00
+ffi;FB03
+ffl;FB04
+fi;FB01
+fifteencircle;246E
+fifteenparen;2482
+fifteenperiod;2496
+figuredash;2012
+filledbox;25A0
+filledrect;25AC
+finalkaf;05DA
+finalkafdagesh;FB3A
+finalkafdageshhebrew;FB3A
+finalkafhebrew;05DA
+finalkafqamats;05DA 05B8
+finalkafqamatshebrew;05DA 05B8
+finalkafsheva;05DA 05B0
+finalkafshevahebrew;05DA 05B0
+finalmem;05DD
+finalmemhebrew;05DD
+finalnun;05DF
+finalnunhebrew;05DF
+finalpe;05E3
+finalpehebrew;05E3
+finaltsadi;05E5
+finaltsadihebrew;05E5
+firsttonechinese;02C9
+fisheye;25C9
+fitacyrillic;0473
+five;0035
+fivearabic;0665
+fivebengali;09EB
+fivecircle;2464
+fivecircleinversesansserif;278E
+fivedeva;096B
+fiveeighths;215D
+fivegujarati;0AEB
+fivegurmukhi;0A6B
+fivehackarabic;0665
+fivehangzhou;3025
+fiveideographicparen;3224
+fiveinferior;2085
+fivemonospace;FF15
+fiveoldstyle;F735
+fiveparen;2478
+fiveperiod;248C
+fivepersian;06F5
+fiveroman;2174
+fivesuperior;2075
+fivethai;0E55
+fl;FB02
+florin;0192
+fmonospace;FF46
+fmsquare;3399
+fofanthai;0E1F
+fofathai;0E1D
+fongmanthai;0E4F
+forall;2200
+four;0034
+fourarabic;0664
+fourbengali;09EA
+fourcircle;2463
+fourcircleinversesansserif;278D
+fourdeva;096A
+fourgujarati;0AEA
+fourgurmukhi;0A6A
+fourhackarabic;0664
+fourhangzhou;3024
+fourideographicparen;3223
+fourinferior;2084
+fourmonospace;FF14
+fournumeratorbengali;09F7
+fouroldstyle;F734
+fourparen;2477
+fourperiod;248B
+fourpersian;06F4
+fourroman;2173
+foursuperior;2074
+fourteencircle;246D
+fourteenparen;2481
+fourteenperiod;2495
+fourthai;0E54
+fourthtonechinese;02CB
+fparen;24A1
+fraction;2044
+franc;20A3
+g;0067
+gabengali;0997
+gacute;01F5
+gadeva;0917
+gafarabic;06AF
+gaffinalarabic;FB93
+gafinitialarabic;FB94
+gafmedialarabic;FB95
+gagujarati;0A97
+gagurmukhi;0A17
+gahiragana;304C
+gakatakana;30AC
+gamma;03B3
+gammalatinsmall;0263
+gammasuperior;02E0
+gangiacoptic;03EB
+gbopomofo;310D
+gbreve;011F
+gcaron;01E7
+gcedilla;0123
+gcircle;24D6
+gcircumflex;011D
+gcommaaccent;0123
+gdot;0121
+gdotaccent;0121
+gecyrillic;0433
+gehiragana;3052
+gekatakana;30B2
+geometricallyequal;2251
+gereshaccenthebrew;059C
+gereshhebrew;05F3
+gereshmuqdamhebrew;059D
+germandbls;00DF
+gershayimaccenthebrew;059E
+gershayimhebrew;05F4
+getamark;3013
+ghabengali;0998
+ghadarmenian;0572
+ghadeva;0918
+ghagujarati;0A98
+ghagurmukhi;0A18
+ghainarabic;063A
+ghainfinalarabic;FECE
+ghaininitialarabic;FECF
+ghainmedialarabic;FED0
+ghemiddlehookcyrillic;0495
+ghestrokecyrillic;0493
+gheupturncyrillic;0491
+ghhadeva;095A
+ghhagurmukhi;0A5A
+ghook;0260
+ghzsquare;3393
+gihiragana;304E
+gikatakana;30AE
+gimarmenian;0563
+gimel;05D2
+gimeldagesh;FB32
+gimeldageshhebrew;FB32
+gimelhebrew;05D2
+gjecyrillic;0453
+glottalinvertedstroke;01BE
+glottalstop;0294
+glottalstopinverted;0296
+glottalstopmod;02C0
+glottalstopreversed;0295
+glottalstopreversedmod;02C1
+glottalstopreversedsuperior;02E4
+glottalstopstroke;02A1
+glottalstopstrokereversed;02A2
+gmacron;1E21
+gmonospace;FF47
+gohiragana;3054
+gokatakana;30B4
+gparen;24A2
+gpasquare;33AC
+gradient;2207
+grave;0060
+gravebelowcmb;0316
+gravecmb;0300
+gravecomb;0300
+gravedeva;0953
+gravelowmod;02CE
+gravemonospace;FF40
+gravetonecmb;0340
+greater;003E
+greaterequal;2265
+greaterequalorless;22DB
+greatermonospace;FF1E
+greaterorequivalent;2273
+greaterorless;2277
+greateroverequal;2267
+greatersmall;FE65
+gscript;0261
+gstroke;01E5
+guhiragana;3050
+guillemotleft;00AB
+guillemotright;00BB
+guilsinglleft;2039
+guilsinglright;203A
+gukatakana;30B0
+guramusquare;3318
+gysquare;33C9
+h;0068
+haabkhasiancyrillic;04A9
+haaltonearabic;06C1
+habengali;09B9
+hadescendercyrillic;04B3
+hadeva;0939
+hagujarati;0AB9
+hagurmukhi;0A39
+haharabic;062D
+hahfinalarabic;FEA2
+hahinitialarabic;FEA3
+hahiragana;306F
+hahmedialarabic;FEA4
+haitusquare;332A
+hakatakana;30CF
+hakatakanahalfwidth;FF8A
+halantgurmukhi;0A4D
+hamzaarabic;0621
+hamzadammaarabic;0621 064F
+hamzadammatanarabic;0621 064C
+hamzafathaarabic;0621 064E
+hamzafathatanarabic;0621 064B
+hamzalowarabic;0621
+hamzalowkasraarabic;0621 0650
+hamzalowkasratanarabic;0621 064D
+hamzasukunarabic;0621 0652
+hangulfiller;3164
+hardsigncyrillic;044A
+harpoonleftbarbup;21BC
+harpoonrightbarbup;21C0
+hasquare;33CA
+hatafpatah;05B2
+hatafpatah16;05B2
+hatafpatah23;05B2
+hatafpatah2f;05B2
+hatafpatahhebrew;05B2
+hatafpatahnarrowhebrew;05B2
+hatafpatahquarterhebrew;05B2
+hatafpatahwidehebrew;05B2
+hatafqamats;05B3
+hatafqamats1b;05B3
+hatafqamats28;05B3
+hatafqamats34;05B3
+hatafqamatshebrew;05B3
+hatafqamatsnarrowhebrew;05B3
+hatafqamatsquarterhebrew;05B3
+hatafqamatswidehebrew;05B3
+hatafsegol;05B1
+hatafsegol17;05B1
+hatafsegol24;05B1
+hatafsegol30;05B1
+hatafsegolhebrew;05B1
+hatafsegolnarrowhebrew;05B1
+hatafsegolquarterhebrew;05B1
+hatafsegolwidehebrew;05B1
+hbar;0127
+hbopomofo;310F
+hbrevebelow;1E2B
+hcedilla;1E29
+hcircle;24D7
+hcircumflex;0125
+hdieresis;1E27
+hdotaccent;1E23
+hdotbelow;1E25
+he;05D4
+heart;2665
+heartsuitblack;2665
+heartsuitwhite;2661
+hedagesh;FB34
+hedageshhebrew;FB34
+hehaltonearabic;06C1
+heharabic;0647
+hehebrew;05D4
+hehfinalaltonearabic;FBA7
+hehfinalalttwoarabic;FEEA
+hehfinalarabic;FEEA
+hehhamzaabovefinalarabic;FBA5
+hehhamzaaboveisolatedarabic;FBA4
+hehinitialaltonearabic;FBA8
+hehinitialarabic;FEEB
+hehiragana;3078
+hehmedialaltonearabic;FBA9
+hehmedialarabic;FEEC
+heiseierasquare;337B
+hekatakana;30D8
+hekatakanahalfwidth;FF8D
+hekutaarusquare;3336
+henghook;0267
+herutusquare;3339
+het;05D7
+hethebrew;05D7
+hhook;0266
+hhooksuperior;02B1
+hieuhacirclekorean;327B
+hieuhaparenkorean;321B
+hieuhcirclekorean;326D
+hieuhkorean;314E
+hieuhparenkorean;320D
+hihiragana;3072
+hikatakana;30D2
+hikatakanahalfwidth;FF8B
+hiriq;05B4
+hiriq14;05B4
+hiriq21;05B4
+hiriq2d;05B4
+hiriqhebrew;05B4
+hiriqnarrowhebrew;05B4
+hiriqquarterhebrew;05B4
+hiriqwidehebrew;05B4
+hlinebelow;1E96
+hmonospace;FF48
+hoarmenian;0570
+hohipthai;0E2B
+hohiragana;307B
+hokatakana;30DB
+hokatakanahalfwidth;FF8E
+holam;05B9
+holam19;05B9
+holam26;05B9
+holam32;05B9
+holamhebrew;05B9
+holamnarrowhebrew;05B9
+holamquarterhebrew;05B9
+holamwidehebrew;05B9
+honokhukthai;0E2E
+hookabovecomb;0309
+hookcmb;0309
+hookpalatalizedbelowcmb;0321
+hookretroflexbelowcmb;0322
+hoonsquare;3342
+horicoptic;03E9
+horizontalbar;2015
+horncmb;031B
+hotsprings;2668
+house;2302
+hparen;24A3
+hsuperior;02B0
+hturned;0265
+huhiragana;3075
+huiitosquare;3333
+hukatakana;30D5
+hukatakanahalfwidth;FF8C
+hungarumlaut;02DD
+hungarumlautcmb;030B
+hv;0195
+hyphen;002D
+hypheninferior;F6E5
+hyphenmonospace;FF0D
+hyphensmall;FE63
+hyphensuperior;F6E6
+hyphentwo;2010
+i;0069
+iacute;00ED
+iacyrillic;044F
+ibengali;0987
+ibopomofo;3127
+ibreve;012D
+icaron;01D0
+icircle;24D8
+icircumflex;00EE
+icyrillic;0456
+idblgrave;0209
+ideographearthcircle;328F
+ideographfirecircle;328B
+ideographicallianceparen;323F
+ideographiccallparen;323A
+ideographiccentrecircle;32A5
+ideographicclose;3006
+ideographiccomma;3001
+ideographiccommaleft;FF64
+ideographiccongratulationparen;3237
+ideographiccorrectcircle;32A3
+ideographicearthparen;322F
+ideographicenterpriseparen;323D
+ideographicexcellentcircle;329D
+ideographicfestivalparen;3240
+ideographicfinancialcircle;3296
+ideographicfinancialparen;3236
+ideographicfireparen;322B
+ideographichaveparen;3232
+ideographichighcircle;32A4
+ideographiciterationmark;3005
+ideographiclaborcircle;3298
+ideographiclaborparen;3238
+ideographicleftcircle;32A7
+ideographiclowcircle;32A6
+ideographicmedicinecircle;32A9
+ideographicmetalparen;322E
+ideographicmoonparen;322A
+ideographicnameparen;3234
+ideographicperiod;3002
+ideographicprintcircle;329E
+ideographicreachparen;3243
+ideographicrepresentparen;3239
+ideographicresourceparen;323E
+ideographicrightcircle;32A8
+ideographicsecretcircle;3299
+ideographicselfparen;3242
+ideographicsocietyparen;3233
+ideographicspace;3000
+ideographicspecialparen;3235
+ideographicstockparen;3231
+ideographicstudyparen;323B
+ideographicsunparen;3230
+ideographicsuperviseparen;323C
+ideographicwaterparen;322C
+ideographicwoodparen;322D
+ideographiczero;3007
+ideographmetalcircle;328E
+ideographmooncircle;328A
+ideographnamecircle;3294
+ideographsuncircle;3290
+ideographwatercircle;328C
+ideographwoodcircle;328D
+ideva;0907
+idieresis;00EF
+idieresisacute;1E2F
+idieresiscyrillic;04E5
+idotbelow;1ECB
+iebrevecyrillic;04D7
+iecyrillic;0435
+ieungacirclekorean;3275
+ieungaparenkorean;3215
+ieungcirclekorean;3267
+ieungkorean;3147
+ieungparenkorean;3207
+igrave;00EC
+igujarati;0A87
+igurmukhi;0A07
+ihiragana;3044
+ihookabove;1EC9
+iibengali;0988
+iicyrillic;0438
+iideva;0908
+iigujarati;0A88
+iigurmukhi;0A08
+iimatragurmukhi;0A40
+iinvertedbreve;020B
+iishortcyrillic;0439
+iivowelsignbengali;09C0
+iivowelsigndeva;0940
+iivowelsigngujarati;0AC0
+ij;0133
+ikatakana;30A4
+ikatakanahalfwidth;FF72
+ikorean;3163
+ilde;02DC
+iluyhebrew;05AC
+imacron;012B
+imacroncyrillic;04E3
+imageorapproximatelyequal;2253
+imatragurmukhi;0A3F
+imonospace;FF49
+increment;2206
+infinity;221E
+iniarmenian;056B
+integral;222B
+integralbottom;2321
+integralbt;2321
+integralex;F8F5
+integraltop;2320
+integraltp;2320
+intersection;2229
+intisquare;3305
+invbullet;25D8
+invcircle;25D9
+invsmileface;263B
+iocyrillic;0451
+iogonek;012F
+iota;03B9
+iotadieresis;03CA
+iotadieresistonos;0390
+iotalatin;0269
+iotatonos;03AF
+iparen;24A4
+irigurmukhi;0A72
+ismallhiragana;3043
+ismallkatakana;30A3
+ismallkatakanahalfwidth;FF68
+issharbengali;09FA
+istroke;0268
+isuperior;F6ED
+iterationhiragana;309D
+iterationkatakana;30FD
+itilde;0129
+itildebelow;1E2D
+iubopomofo;3129
+iucyrillic;044E
+ivowelsignbengali;09BF
+ivowelsigndeva;093F
+ivowelsigngujarati;0ABF
+izhitsacyrillic;0475
+izhitsadblgravecyrillic;0477
+j;006A
+jaarmenian;0571
+jabengali;099C
+jadeva;091C
+jagujarati;0A9C
+jagurmukhi;0A1C
+jbopomofo;3110
+jcaron;01F0
+jcircle;24D9
+jcircumflex;0135
+jcrossedtail;029D
+jdotlessstroke;025F
+jecyrillic;0458
+jeemarabic;062C
+jeemfinalarabic;FE9E
+jeeminitialarabic;FE9F
+jeemmedialarabic;FEA0
+jeharabic;0698
+jehfinalarabic;FB8B
+jhabengali;099D
+jhadeva;091D
+jhagujarati;0A9D
+jhagurmukhi;0A1D
+jheharmenian;057B
+jis;3004
+jmonospace;FF4A
+jparen;24A5
+jsuperior;02B2
+k;006B
+kabashkircyrillic;04A1
+kabengali;0995
+kacute;1E31
+kacyrillic;043A
+kadescendercyrillic;049B
+kadeva;0915
+kaf;05DB
+kafarabic;0643
+kafdagesh;FB3B
+kafdageshhebrew;FB3B
+kaffinalarabic;FEDA
+kafhebrew;05DB
+kafinitialarabic;FEDB
+kafmedialarabic;FEDC
+kafrafehebrew;FB4D
+kagujarati;0A95
+kagurmukhi;0A15
+kahiragana;304B
+kahookcyrillic;04C4
+kakatakana;30AB
+kakatakanahalfwidth;FF76
+kappa;03BA
+kappasymbolgreek;03F0
+kapyeounmieumkorean;3171
+kapyeounphieuphkorean;3184
+kapyeounpieupkorean;3178
+kapyeounssangpieupkorean;3179
+karoriisquare;330D
+kashidaautoarabic;0640
+kashidaautonosidebearingarabic;0640
+kasmallkatakana;30F5
+kasquare;3384
+kasraarabic;0650
+kasratanarabic;064D
+kastrokecyrillic;049F
+katahiraprolongmarkhalfwidth;FF70
+kaverticalstrokecyrillic;049D
+kbopomofo;310E
+kcalsquare;3389
+kcaron;01E9
+kcedilla;0137
+kcircle;24DA
+kcommaaccent;0137
+kdotbelow;1E33
+keharmenian;0584
+kehiragana;3051
+kekatakana;30B1
+kekatakanahalfwidth;FF79
+kenarmenian;056F
+kesmallkatakana;30F6
+kgreenlandic;0138
+khabengali;0996
+khacyrillic;0445
+khadeva;0916
+khagujarati;0A96
+khagurmukhi;0A16
+khaharabic;062E
+khahfinalarabic;FEA6
+khahinitialarabic;FEA7
+khahmedialarabic;FEA8
+kheicoptic;03E7
+khhadeva;0959
+khhagurmukhi;0A59
+khieukhacirclekorean;3278
+khieukhaparenkorean;3218
+khieukhcirclekorean;326A
+khieukhkorean;314B
+khieukhparenkorean;320A
+khokhaithai;0E02
+khokhonthai;0E05
+khokhuatthai;0E03
+khokhwaithai;0E04
+khomutthai;0E5B
+khook;0199
+khorakhangthai;0E06
+khzsquare;3391
+kihiragana;304D
+kikatakana;30AD
+kikatakanahalfwidth;FF77
+kiroguramusquare;3315
+kiromeetorusquare;3316
+kirosquare;3314
+kiyeokacirclekorean;326E
+kiyeokaparenkorean;320E
+kiyeokcirclekorean;3260
+kiyeokkorean;3131
+kiyeokparenkorean;3200
+kiyeoksioskorean;3133
+kjecyrillic;045C
+klinebelow;1E35
+klsquare;3398
+kmcubedsquare;33A6
+kmonospace;FF4B
+kmsquaredsquare;33A2
+kohiragana;3053
+kohmsquare;33C0
+kokaithai;0E01
+kokatakana;30B3
+kokatakanahalfwidth;FF7A
+kooposquare;331E
+koppacyrillic;0481
+koreanstandardsymbol;327F
+koroniscmb;0343
+kparen;24A6
+kpasquare;33AA
+ksicyrillic;046F
+ktsquare;33CF
+kturned;029E
+kuhiragana;304F
+kukatakana;30AF
+kukatakanahalfwidth;FF78
+kvsquare;33B8
+kwsquare;33BE
+l;006C
+labengali;09B2
+lacute;013A
+ladeva;0932
+lagujarati;0AB2
+lagurmukhi;0A32
+lakkhangyaothai;0E45
+lamaleffinalarabic;FEFC
+lamalefhamzaabovefinalarabic;FEF8
+lamalefhamzaaboveisolatedarabic;FEF7
+lamalefhamzabelowfinalarabic;FEFA
+lamalefhamzabelowisolatedarabic;FEF9
+lamalefisolatedarabic;FEFB
+lamalefmaddaabovefinalarabic;FEF6
+lamalefmaddaaboveisolatedarabic;FEF5
+lamarabic;0644
+lambda;03BB
+lambdastroke;019B
+lamed;05DC
+lameddagesh;FB3C
+lameddageshhebrew;FB3C
+lamedhebrew;05DC
+lamedholam;05DC 05B9
+lamedholamdagesh;05DC 05B9 05BC
+lamedholamdageshhebrew;05DC 05B9 05BC
+lamedholamhebrew;05DC 05B9
+lamfinalarabic;FEDE
+lamhahinitialarabic;FCCA
+laminitialarabic;FEDF
+lamjeeminitialarabic;FCC9
+lamkhahinitialarabic;FCCB
+lamlamhehisolatedarabic;FDF2
+lammedialarabic;FEE0
+lammeemhahinitialarabic;FD88
+lammeeminitialarabic;FCCC
+lammeemjeeminitialarabic;FEDF FEE4 FEA0
+lammeemkhahinitialarabic;FEDF FEE4 FEA8
+largecircle;25EF
+lbar;019A
+lbelt;026C
+lbopomofo;310C
+lcaron;013E
+lcedilla;013C
+lcircle;24DB
+lcircumflexbelow;1E3D
+lcommaaccent;013C
+ldot;0140
+ldotaccent;0140
+ldotbelow;1E37
+ldotbelowmacron;1E39
+leftangleabovecmb;031A
+lefttackbelowcmb;0318
+less;003C
+lessequal;2264
+lessequalorgreater;22DA
+lessmonospace;FF1C
+lessorequivalent;2272
+lessorgreater;2276
+lessoverequal;2266
+lesssmall;FE64
+lezh;026E
+lfblock;258C
+lhookretroflex;026D
+lira;20A4
+liwnarmenian;056C
+lj;01C9
+ljecyrillic;0459
+ll;F6C0
+lladeva;0933
+llagujarati;0AB3
+llinebelow;1E3B
+llladeva;0934
+llvocalicbengali;09E1
+llvocalicdeva;0961
+llvocalicvowelsignbengali;09E3
+llvocalicvowelsigndeva;0963
+lmiddletilde;026B
+lmonospace;FF4C
+lmsquare;33D0
+lochulathai;0E2C
+logicaland;2227
+logicalnot;00AC
+logicalnotreversed;2310
+logicalor;2228
+lolingthai;0E25
+longs;017F
+lowlinecenterline;FE4E
+lowlinecmb;0332
+lowlinedashed;FE4D
+lozenge;25CA
+lparen;24A7
+lslash;0142
+lsquare;2113
+lsuperior;F6EE
+ltshade;2591
+luthai;0E26
+lvocalicbengali;098C
+lvocalicdeva;090C
+lvocalicvowelsignbengali;09E2
+lvocalicvowelsigndeva;0962
+lxsquare;33D3
+m;006D
+mabengali;09AE
+macron;00AF
+macronbelowcmb;0331
+macroncmb;0304
+macronlowmod;02CD
+macronmonospace;FFE3
+macute;1E3F
+madeva;092E
+magujarati;0AAE
+magurmukhi;0A2E
+mahapakhhebrew;05A4
+mahapakhlefthebrew;05A4
+mahiragana;307E
+maichattawalowleftthai;F895
+maichattawalowrightthai;F894
+maichattawathai;0E4B
+maichattawaupperleftthai;F893
+maieklowleftthai;F88C
+maieklowrightthai;F88B
+maiekthai;0E48
+maiekupperleftthai;F88A
+maihanakatleftthai;F884
+maihanakatthai;0E31
+maitaikhuleftthai;F889
+maitaikhuthai;0E47
+maitholowleftthai;F88F
+maitholowrightthai;F88E
+maithothai;0E49
+maithoupperleftthai;F88D
+maitrilowleftthai;F892
+maitrilowrightthai;F891
+maitrithai;0E4A
+maitriupperleftthai;F890
+maiyamokthai;0E46
+makatakana;30DE
+makatakanahalfwidth;FF8F
+male;2642
+mansyonsquare;3347
+maqafhebrew;05BE
+mars;2642
+masoracirclehebrew;05AF
+masquare;3383
+mbopomofo;3107
+mbsquare;33D4
+mcircle;24DC
+mcubedsquare;33A5
+mdotaccent;1E41
+mdotbelow;1E43
+meemarabic;0645
+meemfinalarabic;FEE2
+meeminitialarabic;FEE3
+meemmedialarabic;FEE4
+meemmeeminitialarabic;FCD1
+meemmeemisolatedarabic;FC48
+meetorusquare;334D
+mehiragana;3081
+meizierasquare;337E
+mekatakana;30E1
+mekatakanahalfwidth;FF92
+mem;05DE
+memdagesh;FB3E
+memdageshhebrew;FB3E
+memhebrew;05DE
+menarmenian;0574
+merkhahebrew;05A5
+merkhakefulahebrew;05A6
+merkhakefulalefthebrew;05A6
+merkhalefthebrew;05A5
+mhook;0271
+mhzsquare;3392
+middledotkatakanahalfwidth;FF65
+middot;00B7
+mieumacirclekorean;3272
+mieumaparenkorean;3212
+mieumcirclekorean;3264
+mieumkorean;3141
+mieumpansioskorean;3170
+mieumparenkorean;3204
+mieumpieupkorean;316E
+mieumsioskorean;316F
+mihiragana;307F
+mikatakana;30DF
+mikatakanahalfwidth;FF90
+minus;2212
+minusbelowcmb;0320
+minuscircle;2296
+minusmod;02D7
+minusplus;2213
+minute;2032
+miribaarusquare;334A
+mirisquare;3349
+mlonglegturned;0270
+mlsquare;3396
+mmcubedsquare;33A3
+mmonospace;FF4D
+mmsquaredsquare;339F
+mohiragana;3082
+mohmsquare;33C1
+mokatakana;30E2
+mokatakanahalfwidth;FF93
+molsquare;33D6
+momathai;0E21
+moverssquare;33A7
+moverssquaredsquare;33A8
+mparen;24A8
+mpasquare;33AB
+mssquare;33B3
+msuperior;F6EF
+mturned;026F
+mu;00B5
+mu1;00B5
+muasquare;3382
+muchgreater;226B
+muchless;226A
+mufsquare;338C
+mugreek;03BC
+mugsquare;338D
+muhiragana;3080
+mukatakana;30E0
+mukatakanahalfwidth;FF91
+mulsquare;3395
+multiply;00D7
+mumsquare;339B
+munahhebrew;05A3
+munahlefthebrew;05A3
+musicalnote;266A
+musicalnotedbl;266B
+musicflatsign;266D
+musicsharpsign;266F
+mussquare;33B2
+muvsquare;33B6
+muwsquare;33BC
+mvmegasquare;33B9
+mvsquare;33B7
+mwmegasquare;33BF
+mwsquare;33BD
+n;006E
+nabengali;09A8
+nabla;2207
+nacute;0144
+nadeva;0928
+nagujarati;0AA8
+nagurmukhi;0A28
+nahiragana;306A
+nakatakana;30CA
+nakatakanahalfwidth;FF85
+napostrophe;0149
+nasquare;3381
+nbopomofo;310B
+nbspace;00A0
+ncaron;0148
+ncedilla;0146
+ncircle;24DD
+ncircumflexbelow;1E4B
+ncommaaccent;0146
+ndotaccent;1E45
+ndotbelow;1E47
+nehiragana;306D
+nekatakana;30CD
+nekatakanahalfwidth;FF88
+newsheqelsign;20AA
+nfsquare;338B
+ngabengali;0999
+ngadeva;0919
+ngagujarati;0A99
+ngagurmukhi;0A19
+ngonguthai;0E07
+nhiragana;3093
+nhookleft;0272
+nhookretroflex;0273
+nieunacirclekorean;326F
+nieunaparenkorean;320F
+nieuncieuckorean;3135
+nieuncirclekorean;3261
+nieunhieuhkorean;3136
+nieunkorean;3134
+nieunpansioskorean;3168
+nieunparenkorean;3201
+nieunsioskorean;3167
+nieuntikeutkorean;3166
+nihiragana;306B
+nikatakana;30CB
+nikatakanahalfwidth;FF86
+nikhahitleftthai;F899
+nikhahitthai;0E4D
+nine;0039
+ninearabic;0669
+ninebengali;09EF
+ninecircle;2468
+ninecircleinversesansserif;2792
+ninedeva;096F
+ninegujarati;0AEF
+ninegurmukhi;0A6F
+ninehackarabic;0669
+ninehangzhou;3029
+nineideographicparen;3228
+nineinferior;2089
+ninemonospace;FF19
+nineoldstyle;F739
+nineparen;247C
+nineperiod;2490
+ninepersian;06F9
+nineroman;2178
+ninesuperior;2079
+nineteencircle;2472
+nineteenparen;2486
+nineteenperiod;249A
+ninethai;0E59
+nj;01CC
+njecyrillic;045A
+nkatakana;30F3
+nkatakanahalfwidth;FF9D
+nlegrightlong;019E
+nlinebelow;1E49
+nmonospace;FF4E
+nmsquare;339A
+nnabengali;09A3
+nnadeva;0923
+nnagujarati;0AA3
+nnagurmukhi;0A23
+nnnadeva;0929
+nohiragana;306E
+nokatakana;30CE
+nokatakanahalfwidth;FF89
+nonbreakingspace;00A0
+nonenthai;0E13
+nonuthai;0E19
+noonarabic;0646
+noonfinalarabic;FEE6
+noonghunnaarabic;06BA
+noonghunnafinalarabic;FB9F
+noonhehinitialarabic;FEE7 FEEC
+nooninitialarabic;FEE7
+noonjeeminitialarabic;FCD2
+noonjeemisolatedarabic;FC4B
+noonmedialarabic;FEE8
+noonmeeminitialarabic;FCD5
+noonmeemisolatedarabic;FC4E
+noonnoonfinalarabic;FC8D
+notcontains;220C
+notelement;2209
+notelementof;2209
+notequal;2260
+notgreater;226F
+notgreaternorequal;2271
+notgreaternorless;2279
+notidentical;2262
+notless;226E
+notlessnorequal;2270
+notparallel;2226
+notprecedes;2280
+notsubset;2284
+notsucceeds;2281
+notsuperset;2285
+nowarmenian;0576
+nparen;24A9
+nssquare;33B1
+nsuperior;207F
+ntilde;00F1
+nu;03BD
+nuhiragana;306C
+nukatakana;30CC
+nukatakanahalfwidth;FF87
+nuktabengali;09BC
+nuktadeva;093C
+nuktagujarati;0ABC
+nuktagurmukhi;0A3C
+numbersign;0023
+numbersignmonospace;FF03
+numbersignsmall;FE5F
+numeralsigngreek;0374
+numeralsignlowergreek;0375
+numero;2116
+nun;05E0
+nundagesh;FB40
+nundageshhebrew;FB40
+nunhebrew;05E0
+nvsquare;33B5
+nwsquare;33BB
+nyabengali;099E
+nyadeva;091E
+nyagujarati;0A9E
+nyagurmukhi;0A1E
+o;006F
+oacute;00F3
+oangthai;0E2D
+obarred;0275
+obarredcyrillic;04E9
+obarreddieresiscyrillic;04EB
+obengali;0993
+obopomofo;311B
+obreve;014F
+ocandradeva;0911
+ocandragujarati;0A91
+ocandravowelsigndeva;0949
+ocandravowelsigngujarati;0AC9
+ocaron;01D2
+ocircle;24DE
+ocircumflex;00F4
+ocircumflexacute;1ED1
+ocircumflexdotbelow;1ED9
+ocircumflexgrave;1ED3
+ocircumflexhookabove;1ED5
+ocircumflextilde;1ED7
+ocyrillic;043E
+odblacute;0151
+odblgrave;020D
+odeva;0913
+odieresis;00F6
+odieresiscyrillic;04E7
+odotbelow;1ECD
+oe;0153
+oekorean;315A
+ogonek;02DB
+ogonekcmb;0328
+ograve;00F2
+ogujarati;0A93
+oharmenian;0585
+ohiragana;304A
+ohookabove;1ECF
+ohorn;01A1
+ohornacute;1EDB
+ohorndotbelow;1EE3
+ohorngrave;1EDD
+ohornhookabove;1EDF
+ohorntilde;1EE1
+ohungarumlaut;0151
+oi;01A3
+oinvertedbreve;020F
+okatakana;30AA
+okatakanahalfwidth;FF75
+okorean;3157
+olehebrew;05AB
+omacron;014D
+omacronacute;1E53
+omacrongrave;1E51
+omdeva;0950
+omega;03C9
+omega1;03D6
+omegacyrillic;0461
+omegalatinclosed;0277
+omegaroundcyrillic;047B
+omegatitlocyrillic;047D
+omegatonos;03CE
+omgujarati;0AD0
+omicron;03BF
+omicrontonos;03CC
+omonospace;FF4F
+one;0031
+onearabic;0661
+onebengali;09E7
+onecircle;2460
+onecircleinversesansserif;278A
+onedeva;0967
+onedotenleader;2024
+oneeighth;215B
+onefitted;F6DC
+onegujarati;0AE7
+onegurmukhi;0A67
+onehackarabic;0661
+onehalf;00BD
+onehangzhou;3021
+oneideographicparen;3220
+oneinferior;2081
+onemonospace;FF11
+onenumeratorbengali;09F4
+oneoldstyle;F731
+oneparen;2474
+oneperiod;2488
+onepersian;06F1
+onequarter;00BC
+oneroman;2170
+onesuperior;00B9
+onethai;0E51
+onethird;2153
+oogonek;01EB
+oogonekmacron;01ED
+oogurmukhi;0A13
+oomatragurmukhi;0A4B
+oopen;0254
+oparen;24AA
+openbullet;25E6
+option;2325
+ordfeminine;00AA
+ordmasculine;00BA
+orthogonal;221F
+oshortdeva;0912
+oshortvowelsigndeva;094A
+oslash;00F8
+oslashacute;01FF
+osmallhiragana;3049
+osmallkatakana;30A9
+osmallkatakanahalfwidth;FF6B
+ostrokeacute;01FF
+osuperior;F6F0
+otcyrillic;047F
+otilde;00F5
+otildeacute;1E4D
+otildedieresis;1E4F
+oubopomofo;3121
+overline;203E
+overlinecenterline;FE4A
+overlinecmb;0305
+overlinedashed;FE49
+overlinedblwavy;FE4C
+overlinewavy;FE4B
+overscore;00AF
+ovowelsignbengali;09CB
+ovowelsigndeva;094B
+ovowelsigngujarati;0ACB
+p;0070
+paampssquare;3380
+paasentosquare;332B
+pabengali;09AA
+pacute;1E55
+padeva;092A
+pagedown;21DF
+pageup;21DE
+pagujarati;0AAA
+pagurmukhi;0A2A
+pahiragana;3071
+paiyannoithai;0E2F
+pakatakana;30D1
+palatalizationcyrilliccmb;0484
+palochkacyrillic;04C0
+pansioskorean;317F
+paragraph;00B6
+parallel;2225
+parenleft;0028
+parenleftaltonearabic;FD3E
+parenleftbt;F8ED
+parenleftex;F8EC
+parenleftinferior;208D
+parenleftmonospace;FF08
+parenleftsmall;FE59
+parenleftsuperior;207D
+parenlefttp;F8EB
+parenleftvertical;FE35
+parenright;0029
+parenrightaltonearabic;FD3F
+parenrightbt;F8F8
+parenrightex;F8F7
+parenrightinferior;208E
+parenrightmonospace;FF09
+parenrightsmall;FE5A
+parenrightsuperior;207E
+parenrighttp;F8F6
+parenrightvertical;FE36
+partialdiff;2202
+paseqhebrew;05C0
+pashtahebrew;0599
+pasquare;33A9
+patah;05B7
+patah11;05B7
+patah1d;05B7
+patah2a;05B7
+patahhebrew;05B7
+patahnarrowhebrew;05B7
+patahquarterhebrew;05B7
+patahwidehebrew;05B7
+pazerhebrew;05A1
+pbopomofo;3106
+pcircle;24DF
+pdotaccent;1E57
+pe;05E4
+pecyrillic;043F
+pedagesh;FB44
+pedageshhebrew;FB44
+peezisquare;333B
+pefinaldageshhebrew;FB43
+peharabic;067E
+peharmenian;057A
+pehebrew;05E4
+pehfinalarabic;FB57
+pehinitialarabic;FB58
+pehiragana;307A
+pehmedialarabic;FB59
+pekatakana;30DA
+pemiddlehookcyrillic;04A7
+perafehebrew;FB4E
+percent;0025
+percentarabic;066A
+percentmonospace;FF05
+percentsmall;FE6A
+period;002E
+periodarmenian;0589
+periodcentered;00B7
+periodhalfwidth;FF61
+periodinferior;F6E7
+periodmonospace;FF0E
+periodsmall;FE52
+periodsuperior;F6E8
+perispomenigreekcmb;0342
+perpendicular;22A5
+perthousand;2030
+peseta;20A7
+pfsquare;338A
+phabengali;09AB
+phadeva;092B
+phagujarati;0AAB
+phagurmukhi;0A2B
+phi;03C6
+phi1;03D5
+phieuphacirclekorean;327A
+phieuphaparenkorean;321A
+phieuphcirclekorean;326C
+phieuphkorean;314D
+phieuphparenkorean;320C
+philatin;0278
+phinthuthai;0E3A
+phisymbolgreek;03D5
+phook;01A5
+phophanthai;0E1E
+phophungthai;0E1C
+phosamphaothai;0E20
+pi;03C0
+pieupacirclekorean;3273
+pieupaparenkorean;3213
+pieupcieuckorean;3176
+pieupcirclekorean;3265
+pieupkiyeokkorean;3172
+pieupkorean;3142
+pieupparenkorean;3205
+pieupsioskiyeokkorean;3174
+pieupsioskorean;3144
+pieupsiostikeutkorean;3175
+pieupthieuthkorean;3177
+pieuptikeutkorean;3173
+pihiragana;3074
+pikatakana;30D4
+pisymbolgreek;03D6
+piwrarmenian;0583
+plus;002B
+plusbelowcmb;031F
+pluscircle;2295
+plusminus;00B1
+plusmod;02D6
+plusmonospace;FF0B
+plussmall;FE62
+plussuperior;207A
+pmonospace;FF50
+pmsquare;33D8
+pohiragana;307D
+pointingindexdownwhite;261F
+pointingindexleftwhite;261C
+pointingindexrightwhite;261E
+pointingindexupwhite;261D
+pokatakana;30DD
+poplathai;0E1B
+postalmark;3012
+postalmarkface;3020
+pparen;24AB
+precedes;227A
+prescription;211E
+primemod;02B9
+primereversed;2035
+product;220F
+projective;2305
+prolongedkana;30FC
+propellor;2318
+propersubset;2282
+propersuperset;2283
+proportion;2237
+proportional;221D
+psi;03C8
+psicyrillic;0471
+psilipneumatacyrilliccmb;0486
+pssquare;33B0
+puhiragana;3077
+pukatakana;30D7
+pvsquare;33B4
+pwsquare;33BA
+q;0071
+qadeva;0958
+qadmahebrew;05A8
+qafarabic;0642
+qaffinalarabic;FED6
+qafinitialarabic;FED7
+qafmedialarabic;FED8
+qamats;05B8
+qamats10;05B8
+qamats1a;05B8
+qamats1c;05B8
+qamats27;05B8
+qamats29;05B8
+qamats33;05B8
+qamatsde;05B8
+qamatshebrew;05B8
+qamatsnarrowhebrew;05B8
+qamatsqatanhebrew;05B8
+qamatsqatannarrowhebrew;05B8
+qamatsqatanquarterhebrew;05B8
+qamatsqatanwidehebrew;05B8
+qamatsquarterhebrew;05B8
+qamatswidehebrew;05B8
+qarneyparahebrew;059F
+qbopomofo;3111
+qcircle;24E0
+qhook;02A0
+qmonospace;FF51
+qof;05E7
+qofdagesh;FB47
+qofdageshhebrew;FB47
+qofhatafpatah;05E7 05B2
+qofhatafpatahhebrew;05E7 05B2
+qofhatafsegol;05E7 05B1
+qofhatafsegolhebrew;05E7 05B1
+qofhebrew;05E7
+qofhiriq;05E7 05B4
+qofhiriqhebrew;05E7 05B4
+qofholam;05E7 05B9
+qofholamhebrew;05E7 05B9
+qofpatah;05E7 05B7
+qofpatahhebrew;05E7 05B7
+qofqamats;05E7 05B8
+qofqamatshebrew;05E7 05B8
+qofqubuts;05E7 05BB
+qofqubutshebrew;05E7 05BB
+qofsegol;05E7 05B6
+qofsegolhebrew;05E7 05B6
+qofsheva;05E7 05B0
+qofshevahebrew;05E7 05B0
+qoftsere;05E7 05B5
+qoftserehebrew;05E7 05B5
+qparen;24AC
+quarternote;2669
+qubuts;05BB
+qubuts18;05BB
+qubuts25;05BB
+qubuts31;05BB
+qubutshebrew;05BB
+qubutsnarrowhebrew;05BB
+qubutsquarterhebrew;05BB
+qubutswidehebrew;05BB
+question;003F
+questionarabic;061F
+questionarmenian;055E
+questiondown;00BF
+questiondownsmall;F7BF
+questiongreek;037E
+questionmonospace;FF1F
+questionsmall;F73F
+quotedbl;0022
+quotedblbase;201E
+quotedblleft;201C
+quotedblmonospace;FF02
+quotedblprime;301E
+quotedblprimereversed;301D
+quotedblright;201D
+quoteleft;2018
+quoteleftreversed;201B
+quotereversed;201B
+quoteright;2019
+quoterightn;0149
+quotesinglbase;201A
+quotesingle;0027
+quotesinglemonospace;FF07
+r;0072
+raarmenian;057C
+rabengali;09B0
+racute;0155
+radeva;0930
+radical;221A
+radicalex;F8E5
+radoverssquare;33AE
+radoverssquaredsquare;33AF
+radsquare;33AD
+rafe;05BF
+rafehebrew;05BF
+ragujarati;0AB0
+ragurmukhi;0A30
+rahiragana;3089
+rakatakana;30E9
+rakatakanahalfwidth;FF97
+ralowerdiagonalbengali;09F1
+ramiddlediagonalbengali;09F0
+ramshorn;0264
+ratio;2236
+rbopomofo;3116
+rcaron;0159
+rcedilla;0157
+rcircle;24E1
+rcommaaccent;0157
+rdblgrave;0211
+rdotaccent;1E59
+rdotbelow;1E5B
+rdotbelowmacron;1E5D
+referencemark;203B
+reflexsubset;2286
+reflexsuperset;2287
+registered;00AE
+registersans;F8E8
+registerserif;F6DA
+reharabic;0631
+reharmenian;0580
+rehfinalarabic;FEAE
+rehiragana;308C
+rehyehaleflamarabic;0631 FEF3 FE8E 0644
+rekatakana;30EC
+rekatakanahalfwidth;FF9A
+resh;05E8
+reshdageshhebrew;FB48
+reshhatafpatah;05E8 05B2
+reshhatafpatahhebrew;05E8 05B2
+reshhatafsegol;05E8 05B1
+reshhatafsegolhebrew;05E8 05B1
+reshhebrew;05E8
+reshhiriq;05E8 05B4
+reshhiriqhebrew;05E8 05B4
+reshholam;05E8 05B9
+reshholamhebrew;05E8 05B9
+reshpatah;05E8 05B7
+reshpatahhebrew;05E8 05B7
+reshqamats;05E8 05B8
+reshqamatshebrew;05E8 05B8
+reshqubuts;05E8 05BB
+reshqubutshebrew;05E8 05BB
+reshsegol;05E8 05B6
+reshsegolhebrew;05E8 05B6
+reshsheva;05E8 05B0
+reshshevahebrew;05E8 05B0
+reshtsere;05E8 05B5
+reshtserehebrew;05E8 05B5
+reversedtilde;223D
+reviahebrew;0597
+reviamugrashhebrew;0597
+revlogicalnot;2310
+rfishhook;027E
+rfishhookreversed;027F
+rhabengali;09DD
+rhadeva;095D
+rho;03C1
+rhook;027D
+rhookturned;027B
+rhookturnedsuperior;02B5
+rhosymbolgreek;03F1
+rhotichookmod;02DE
+rieulacirclekorean;3271
+rieulaparenkorean;3211
+rieulcirclekorean;3263
+rieulhieuhkorean;3140
+rieulkiyeokkorean;313A
+rieulkiyeoksioskorean;3169
+rieulkorean;3139
+rieulmieumkorean;313B
+rieulpansioskorean;316C
+rieulparenkorean;3203
+rieulphieuphkorean;313F
+rieulpieupkorean;313C
+rieulpieupsioskorean;316B
+rieulsioskorean;313D
+rieulthieuthkorean;313E
+rieultikeutkorean;316A
+rieulyeorinhieuhkorean;316D
+rightangle;221F
+righttackbelowcmb;0319
+righttriangle;22BF
+rihiragana;308A
+rikatakana;30EA
+rikatakanahalfwidth;FF98
+ring;02DA
+ringbelowcmb;0325
+ringcmb;030A
+ringhalfleft;02BF
+ringhalfleftarmenian;0559
+ringhalfleftbelowcmb;031C
+ringhalfleftcentered;02D3
+ringhalfright;02BE
+ringhalfrightbelowcmb;0339
+ringhalfrightcentered;02D2
+rinvertedbreve;0213
+rittorusquare;3351
+rlinebelow;1E5F
+rlongleg;027C
+rlonglegturned;027A
+rmonospace;FF52
+rohiragana;308D
+rokatakana;30ED
+rokatakanahalfwidth;FF9B
+roruathai;0E23
+rparen;24AD
+rrabengali;09DC
+rradeva;0931
+rragurmukhi;0A5C
+rreharabic;0691
+rrehfinalarabic;FB8D
+rrvocalicbengali;09E0
+rrvocalicdeva;0960
+rrvocalicgujarati;0AE0
+rrvocalicvowelsignbengali;09C4
+rrvocalicvowelsigndeva;0944
+rrvocalicvowelsigngujarati;0AC4
+rsuperior;F6F1
+rtblock;2590
+rturned;0279
+rturnedsuperior;02B4
+ruhiragana;308B
+rukatakana;30EB
+rukatakanahalfwidth;FF99
+rupeemarkbengali;09F2
+rupeesignbengali;09F3
+rupiah;F6DD
+ruthai;0E24
+rvocalicbengali;098B
+rvocalicdeva;090B
+rvocalicgujarati;0A8B
+rvocalicvowelsignbengali;09C3
+rvocalicvowelsigndeva;0943
+rvocalicvowelsigngujarati;0AC3
+s;0073
+sabengali;09B8
+sacute;015B
+sacutedotaccent;1E65
+sadarabic;0635
+sadeva;0938
+sadfinalarabic;FEBA
+sadinitialarabic;FEBB
+sadmedialarabic;FEBC
+sagujarati;0AB8
+sagurmukhi;0A38
+sahiragana;3055
+sakatakana;30B5
+sakatakanahalfwidth;FF7B
+sallallahoualayhewasallamarabic;FDFA
+samekh;05E1
+samekhdagesh;FB41
+samekhdageshhebrew;FB41
+samekhhebrew;05E1
+saraaathai;0E32
+saraaethai;0E41
+saraaimaimalaithai;0E44
+saraaimaimuanthai;0E43
+saraamthai;0E33
+saraathai;0E30
+saraethai;0E40
+saraiileftthai;F886
+saraiithai;0E35
+saraileftthai;F885
+saraithai;0E34
+saraothai;0E42
+saraueeleftthai;F888
+saraueethai;0E37
+saraueleftthai;F887
+sarauethai;0E36
+sarauthai;0E38
+sarauuthai;0E39
+sbopomofo;3119
+scaron;0161
+scarondotaccent;1E67
+scedilla;015F
+schwa;0259
+schwacyrillic;04D9
+schwadieresiscyrillic;04DB
+schwahook;025A
+scircle;24E2
+scircumflex;015D
+scommaaccent;0219
+sdotaccent;1E61
+sdotbelow;1E63
+sdotbelowdotaccent;1E69
+seagullbelowcmb;033C
+second;2033
+secondtonechinese;02CA
+section;00A7
+seenarabic;0633
+seenfinalarabic;FEB2
+seeninitialarabic;FEB3
+seenmedialarabic;FEB4
+segol;05B6
+segol13;05B6
+segol1f;05B6
+segol2c;05B6
+segolhebrew;05B6
+segolnarrowhebrew;05B6
+segolquarterhebrew;05B6
+segoltahebrew;0592
+segolwidehebrew;05B6
+seharmenian;057D
+sehiragana;305B
+sekatakana;30BB
+sekatakanahalfwidth;FF7E
+semicolon;003B
+semicolonarabic;061B
+semicolonmonospace;FF1B
+semicolonsmall;FE54
+semivoicedmarkkana;309C
+semivoicedmarkkanahalfwidth;FF9F
+sentisquare;3322
+sentosquare;3323
+seven;0037
+sevenarabic;0667
+sevenbengali;09ED
+sevencircle;2466
+sevencircleinversesansserif;2790
+sevendeva;096D
+seveneighths;215E
+sevengujarati;0AED
+sevengurmukhi;0A6D
+sevenhackarabic;0667
+sevenhangzhou;3027
+sevenideographicparen;3226
+seveninferior;2087
+sevenmonospace;FF17
+sevenoldstyle;F737
+sevenparen;247A
+sevenperiod;248E
+sevenpersian;06F7
+sevenroman;2176
+sevensuperior;2077
+seventeencircle;2470
+seventeenparen;2484
+seventeenperiod;2498
+seventhai;0E57
+sfthyphen;00AD
+shaarmenian;0577
+shabengali;09B6
+shacyrillic;0448
+shaddaarabic;0651
+shaddadammaarabic;FC61
+shaddadammatanarabic;FC5E
+shaddafathaarabic;FC60
+shaddafathatanarabic;0651 064B
+shaddakasraarabic;FC62
+shaddakasratanarabic;FC5F
+shade;2592
+shadedark;2593
+shadelight;2591
+shademedium;2592
+shadeva;0936
+shagujarati;0AB6
+shagurmukhi;0A36
+shalshelethebrew;0593
+shbopomofo;3115
+shchacyrillic;0449
+sheenarabic;0634
+sheenfinalarabic;FEB6
+sheeninitialarabic;FEB7
+sheenmedialarabic;FEB8
+sheicoptic;03E3
+sheqel;20AA
+sheqelhebrew;20AA
+sheva;05B0
+sheva115;05B0
+sheva15;05B0
+sheva22;05B0
+sheva2e;05B0
+shevahebrew;05B0
+shevanarrowhebrew;05B0
+shevaquarterhebrew;05B0
+shevawidehebrew;05B0
+shhacyrillic;04BB
+shimacoptic;03ED
+shin;05E9
+shindagesh;FB49
+shindageshhebrew;FB49
+shindageshshindot;FB2C
+shindageshshindothebrew;FB2C
+shindageshsindot;FB2D
+shindageshsindothebrew;FB2D
+shindothebrew;05C1
+shinhebrew;05E9
+shinshindot;FB2A
+shinshindothebrew;FB2A
+shinsindot;FB2B
+shinsindothebrew;FB2B
+shook;0282
+sigma;03C3
+sigma1;03C2
+sigmafinal;03C2
+sigmalunatesymbolgreek;03F2
+sihiragana;3057
+sikatakana;30B7
+sikatakanahalfwidth;FF7C
+siluqhebrew;05BD
+siluqlefthebrew;05BD
+similar;223C
+sindothebrew;05C2
+siosacirclekorean;3274
+siosaparenkorean;3214
+sioscieuckorean;317E
+sioscirclekorean;3266
+sioskiyeokkorean;317A
+sioskorean;3145
+siosnieunkorean;317B
+siosparenkorean;3206
+siospieupkorean;317D
+siostikeutkorean;317C
+six;0036
+sixarabic;0666
+sixbengali;09EC
+sixcircle;2465
+sixcircleinversesansserif;278F
+sixdeva;096C
+sixgujarati;0AEC
+sixgurmukhi;0A6C
+sixhackarabic;0666
+sixhangzhou;3026
+sixideographicparen;3225
+sixinferior;2086
+sixmonospace;FF16
+sixoldstyle;F736
+sixparen;2479
+sixperiod;248D
+sixpersian;06F6
+sixroman;2175
+sixsuperior;2076
+sixteencircle;246F
+sixteencurrencydenominatorbengali;09F9
+sixteenparen;2483
+sixteenperiod;2497
+sixthai;0E56
+slash;002F
+slashmonospace;FF0F
+slong;017F
+slongdotaccent;1E9B
+smileface;263A
+smonospace;FF53
+sofpasuqhebrew;05C3
+softhyphen;00AD
+softsigncyrillic;044C
+sohiragana;305D
+sokatakana;30BD
+sokatakanahalfwidth;FF7F
+soliduslongoverlaycmb;0338
+solidusshortoverlaycmb;0337
+sorusithai;0E29
+sosalathai;0E28
+sosothai;0E0B
+sosuathai;0E2A
+space;0020
+spacehackarabic;0020
+spade;2660
+spadesuitblack;2660
+spadesuitwhite;2664
+sparen;24AE
+squarebelowcmb;033B
+squarecc;33C4
+squarecm;339D
+squarediagonalcrosshatchfill;25A9
+squarehorizontalfill;25A4
+squarekg;338F
+squarekm;339E
+squarekmcapital;33CE
+squareln;33D1
+squarelog;33D2
+squaremg;338E
+squaremil;33D5
+squaremm;339C
+squaremsquared;33A1
+squareorthogonalcrosshatchfill;25A6
+squareupperlefttolowerrightfill;25A7
+squareupperrighttolowerleftfill;25A8
+squareverticalfill;25A5
+squarewhitewithsmallblack;25A3
+srsquare;33DB
+ssabengali;09B7
+ssadeva;0937
+ssagujarati;0AB7
+ssangcieuckorean;3149
+ssanghieuhkorean;3185
+ssangieungkorean;3180
+ssangkiyeokkorean;3132
+ssangnieunkorean;3165
+ssangpieupkorean;3143
+ssangsioskorean;3146
+ssangtikeutkorean;3138
+ssuperior;F6F2
+sterling;00A3
+sterlingmonospace;FFE1
+strokelongoverlaycmb;0336
+strokeshortoverlaycmb;0335
+subset;2282
+subsetnotequal;228A
+subsetorequal;2286
+succeeds;227B
+suchthat;220B
+suhiragana;3059
+sukatakana;30B9
+sukatakanahalfwidth;FF7D
+sukunarabic;0652
+summation;2211
+sun;263C
+superset;2283
+supersetnotequal;228B
+supersetorequal;2287
+svsquare;33DC
+syouwaerasquare;337C
+t;0074
+tabengali;09A4
+tackdown;22A4
+tackleft;22A3
+tadeva;0924
+tagujarati;0AA4
+tagurmukhi;0A24
+taharabic;0637
+tahfinalarabic;FEC2
+tahinitialarabic;FEC3
+tahiragana;305F
+tahmedialarabic;FEC4
+taisyouerasquare;337D
+takatakana;30BF
+takatakanahalfwidth;FF80
+tatweelarabic;0640
+tau;03C4
+tav;05EA
+tavdages;FB4A
+tavdagesh;FB4A
+tavdageshhebrew;FB4A
+tavhebrew;05EA
+tbar;0167
+tbopomofo;310A
+tcaron;0165
+tccurl;02A8
+tcedilla;0163
+tcheharabic;0686
+tchehfinalarabic;FB7B
+tchehinitialarabic;FB7C
+tchehmedialarabic;FB7D
+tchehmeeminitialarabic;FB7C FEE4
+tcircle;24E3
+tcircumflexbelow;1E71
+tcommaaccent;0163
+tdieresis;1E97
+tdotaccent;1E6B
+tdotbelow;1E6D
+tecyrillic;0442
+tedescendercyrillic;04AD
+teharabic;062A
+tehfinalarabic;FE96
+tehhahinitialarabic;FCA2
+tehhahisolatedarabic;FC0C
+tehinitialarabic;FE97
+tehiragana;3066
+tehjeeminitialarabic;FCA1
+tehjeemisolatedarabic;FC0B
+tehmarbutaarabic;0629
+tehmarbutafinalarabic;FE94
+tehmedialarabic;FE98
+tehmeeminitialarabic;FCA4
+tehmeemisolatedarabic;FC0E
+tehnoonfinalarabic;FC73
+tekatakana;30C6
+tekatakanahalfwidth;FF83
+telephone;2121
+telephoneblack;260E
+telishagedolahebrew;05A0
+telishaqetanahebrew;05A9
+tencircle;2469
+tenideographicparen;3229
+tenparen;247D
+tenperiod;2491
+tenroman;2179
+tesh;02A7
+tet;05D8
+tetdagesh;FB38
+tetdageshhebrew;FB38
+tethebrew;05D8
+tetsecyrillic;04B5
+tevirhebrew;059B
+tevirlefthebrew;059B
+thabengali;09A5
+thadeva;0925
+thagujarati;0AA5
+thagurmukhi;0A25
+thalarabic;0630
+thalfinalarabic;FEAC
+thanthakhatlowleftthai;F898
+thanthakhatlowrightthai;F897
+thanthakhatthai;0E4C
+thanthakhatupperleftthai;F896
+theharabic;062B
+thehfinalarabic;FE9A
+thehinitialarabic;FE9B
+thehmedialarabic;FE9C
+thereexists;2203
+therefore;2234
+theta;03B8
+theta1;03D1
+thetasymbolgreek;03D1
+thieuthacirclekorean;3279
+thieuthaparenkorean;3219
+thieuthcirclekorean;326B
+thieuthkorean;314C
+thieuthparenkorean;320B
+thirteencircle;246C
+thirteenparen;2480
+thirteenperiod;2494
+thonangmonthothai;0E11
+thook;01AD
+thophuthaothai;0E12
+thorn;00FE
+thothahanthai;0E17
+thothanthai;0E10
+thothongthai;0E18
+thothungthai;0E16
+thousandcyrillic;0482
+thousandsseparatorarabic;066C
+thousandsseparatorpersian;066C
+three;0033
+threearabic;0663
+threebengali;09E9
+threecircle;2462
+threecircleinversesansserif;278C
+threedeva;0969
+threeeighths;215C
+threegujarati;0AE9
+threegurmukhi;0A69
+threehackarabic;0663
+threehangzhou;3023
+threeideographicparen;3222
+threeinferior;2083
+threemonospace;FF13
+threenumeratorbengali;09F6
+threeoldstyle;F733
+threeparen;2476
+threeperiod;248A
+threepersian;06F3
+threequarters;00BE
+threequartersemdash;F6DE
+threeroman;2172
+threesuperior;00B3
+threethai;0E53
+thzsquare;3394
+tihiragana;3061
+tikatakana;30C1
+tikatakanahalfwidth;FF81
+tikeutacirclekorean;3270
+tikeutaparenkorean;3210
+tikeutcirclekorean;3262
+tikeutkorean;3137
+tikeutparenkorean;3202
+tilde;02DC
+tildebelowcmb;0330
+tildecmb;0303
+tildecomb;0303
+tildedoublecmb;0360
+tildeoperator;223C
+tildeoverlaycmb;0334
+tildeverticalcmb;033E
+timescircle;2297
+tipehahebrew;0596
+tipehalefthebrew;0596
+tippigurmukhi;0A70
+titlocyrilliccmb;0483
+tiwnarmenian;057F
+tlinebelow;1E6F
+tmonospace;FF54
+toarmenian;0569
+tohiragana;3068
+tokatakana;30C8
+tokatakanahalfwidth;FF84
+tonebarextrahighmod;02E5
+tonebarextralowmod;02E9
+tonebarhighmod;02E6
+tonebarlowmod;02E8
+tonebarmidmod;02E7
+tonefive;01BD
+tonesix;0185
+tonetwo;01A8
+tonos;0384
+tonsquare;3327
+topatakthai;0E0F
+tortoiseshellbracketleft;3014
+tortoiseshellbracketleftsmall;FE5D
+tortoiseshellbracketleftvertical;FE39
+tortoiseshellbracketright;3015
+tortoiseshellbracketrightsmall;FE5E
+tortoiseshellbracketrightvertical;FE3A
+totaothai;0E15
+tpalatalhook;01AB
+tparen;24AF
+trademark;2122
+trademarksans;F8EA
+trademarkserif;F6DB
+tretroflexhook;0288
+triagdn;25BC
+triaglf;25C4
+triagrt;25BA
+triagup;25B2
+ts;02A6
+tsadi;05E6
+tsadidagesh;FB46
+tsadidageshhebrew;FB46
+tsadihebrew;05E6
+tsecyrillic;0446
+tsere;05B5
+tsere12;05B5
+tsere1e;05B5
+tsere2b;05B5
+tserehebrew;05B5
+tserenarrowhebrew;05B5
+tserequarterhebrew;05B5
+tserewidehebrew;05B5
+tshecyrillic;045B
+tsuperior;F6F3
+ttabengali;099F
+ttadeva;091F
+ttagujarati;0A9F
+ttagurmukhi;0A1F
+tteharabic;0679
+ttehfinalarabic;FB67
+ttehinitialarabic;FB68
+ttehmedialarabic;FB69
+tthabengali;09A0
+tthadeva;0920
+tthagujarati;0AA0
+tthagurmukhi;0A20
+tturned;0287
+tuhiragana;3064
+tukatakana;30C4
+tukatakanahalfwidth;FF82
+tusmallhiragana;3063
+tusmallkatakana;30C3
+tusmallkatakanahalfwidth;FF6F
+twelvecircle;246B
+twelveparen;247F
+twelveperiod;2493
+twelveroman;217B
+twentycircle;2473
+twentyhangzhou;5344
+twentyparen;2487
+twentyperiod;249B
+two;0032
+twoarabic;0662
+twobengali;09E8
+twocircle;2461
+twocircleinversesansserif;278B
+twodeva;0968
+twodotenleader;2025
+twodotleader;2025
+twodotleadervertical;FE30
+twogujarati;0AE8
+twogurmukhi;0A68
+twohackarabic;0662
+twohangzhou;3022
+twoideographicparen;3221
+twoinferior;2082
+twomonospace;FF12
+twonumeratorbengali;09F5
+twooldstyle;F732
+twoparen;2475
+twoperiod;2489
+twopersian;06F2
+tworoman;2171
+twostroke;01BB
+twosuperior;00B2
+twothai;0E52
+twothirds;2154
+u;0075
+uacute;00FA
+ubar;0289
+ubengali;0989
+ubopomofo;3128
+ubreve;016D
+ucaron;01D4
+ucircle;24E4
+ucircumflex;00FB
+ucircumflexbelow;1E77
+ucyrillic;0443
+udattadeva;0951
+udblacute;0171
+udblgrave;0215
+udeva;0909
+udieresis;00FC
+udieresisacute;01D8
+udieresisbelow;1E73
+udieresiscaron;01DA
+udieresiscyrillic;04F1
+udieresisgrave;01DC
+udieresismacron;01D6
+udotbelow;1EE5
+ugrave;00F9
+ugujarati;0A89
+ugurmukhi;0A09
+uhiragana;3046
+uhookabove;1EE7
+uhorn;01B0
+uhornacute;1EE9
+uhorndotbelow;1EF1
+uhorngrave;1EEB
+uhornhookabove;1EED
+uhorntilde;1EEF
+uhungarumlaut;0171
+uhungarumlautcyrillic;04F3
+uinvertedbreve;0217
+ukatakana;30A6
+ukatakanahalfwidth;FF73
+ukcyrillic;0479
+ukorean;315C
+umacron;016B
+umacroncyrillic;04EF
+umacrondieresis;1E7B
+umatragurmukhi;0A41
+umonospace;FF55
+underscore;005F
+underscoredbl;2017
+underscoremonospace;FF3F
+underscorevertical;FE33
+underscorewavy;FE4F
+union;222A
+universal;2200
+uogonek;0173
+uparen;24B0
+upblock;2580
+upperdothebrew;05C4
+upsilon;03C5
+upsilondieresis;03CB
+upsilondieresistonos;03B0
+upsilonlatin;028A
+upsilontonos;03CD
+uptackbelowcmb;031D
+uptackmod;02D4
+uragurmukhi;0A73
+uring;016F
+ushortcyrillic;045E
+usmallhiragana;3045
+usmallkatakana;30A5
+usmallkatakanahalfwidth;FF69
+ustraightcyrillic;04AF
+ustraightstrokecyrillic;04B1
+utilde;0169
+utildeacute;1E79
+utildebelow;1E75
+uubengali;098A
+uudeva;090A
+uugujarati;0A8A
+uugurmukhi;0A0A
+uumatragurmukhi;0A42
+uuvowelsignbengali;09C2
+uuvowelsigndeva;0942
+uuvowelsigngujarati;0AC2
+uvowelsignbengali;09C1
+uvowelsigndeva;0941
+uvowelsigngujarati;0AC1
+v;0076
+vadeva;0935
+vagujarati;0AB5
+vagurmukhi;0A35
+vakatakana;30F7
+vav;05D5
+vavdagesh;FB35
+vavdagesh65;FB35
+vavdageshhebrew;FB35
+vavhebrew;05D5
+vavholam;FB4B
+vavholamhebrew;FB4B
+vavvavhebrew;05F0
+vavyodhebrew;05F1
+vcircle;24E5
+vdotbelow;1E7F
+vecyrillic;0432
+veharabic;06A4
+vehfinalarabic;FB6B
+vehinitialarabic;FB6C
+vehmedialarabic;FB6D
+vekatakana;30F9
+venus;2640
+verticalbar;007C
+verticallineabovecmb;030D
+verticallinebelowcmb;0329
+verticallinelowmod;02CC
+verticallinemod;02C8
+vewarmenian;057E
+vhook;028B
+vikatakana;30F8
+viramabengali;09CD
+viramadeva;094D
+viramagujarati;0ACD
+visargabengali;0983
+visargadeva;0903
+visargagujarati;0A83
+vmonospace;FF56
+voarmenian;0578
+voicediterationhiragana;309E
+voicediterationkatakana;30FE
+voicedmarkkana;309B
+voicedmarkkanahalfwidth;FF9E
+vokatakana;30FA
+vparen;24B1
+vtilde;1E7D
+vturned;028C
+vuhiragana;3094
+vukatakana;30F4
+w;0077
+wacute;1E83
+waekorean;3159
+wahiragana;308F
+wakatakana;30EF
+wakatakanahalfwidth;FF9C
+wakorean;3158
+wasmallhiragana;308E
+wasmallkatakana;30EE
+wattosquare;3357
+wavedash;301C
+wavyunderscorevertical;FE34
+wawarabic;0648
+wawfinalarabic;FEEE
+wawhamzaabovearabic;0624
+wawhamzaabovefinalarabic;FE86
+wbsquare;33DD
+wcircle;24E6
+wcircumflex;0175
+wdieresis;1E85
+wdotaccent;1E87
+wdotbelow;1E89
+wehiragana;3091
+weierstrass;2118
+wekatakana;30F1
+wekorean;315E
+weokorean;315D
+wgrave;1E81
+whitebullet;25E6
+whitecircle;25CB
+whitecircleinverse;25D9
+whitecornerbracketleft;300E
+whitecornerbracketleftvertical;FE43
+whitecornerbracketright;300F
+whitecornerbracketrightvertical;FE44
+whitediamond;25C7
+whitediamondcontainingblacksmalldiamond;25C8
+whitedownpointingsmalltriangle;25BF
+whitedownpointingtriangle;25BD
+whiteleftpointingsmalltriangle;25C3
+whiteleftpointingtriangle;25C1
+whitelenticularbracketleft;3016
+whitelenticularbracketright;3017
+whiterightpointingsmalltriangle;25B9
+whiterightpointingtriangle;25B7
+whitesmallsquare;25AB
+whitesmilingface;263A
+whitesquare;25A1
+whitestar;2606
+whitetelephone;260F
+whitetortoiseshellbracketleft;3018
+whitetortoiseshellbracketright;3019
+whiteuppointingsmalltriangle;25B5
+whiteuppointingtriangle;25B3
+wihiragana;3090
+wikatakana;30F0
+wikorean;315F
+wmonospace;FF57
+wohiragana;3092
+wokatakana;30F2
+wokatakanahalfwidth;FF66
+won;20A9
+wonmonospace;FFE6
+wowaenthai;0E27
+wparen;24B2
+wring;1E98
+wsuperior;02B7
+wturned;028D
+wynn;01BF
+x;0078
+xabovecmb;033D
+xbopomofo;3112
+xcircle;24E7
+xdieresis;1E8D
+xdotaccent;1E8B
+xeharmenian;056D
+xi;03BE
+xmonospace;FF58
+xparen;24B3
+xsuperior;02E3
+y;0079
+yaadosquare;334E
+yabengali;09AF
+yacute;00FD
+yadeva;092F
+yaekorean;3152
+yagujarati;0AAF
+yagurmukhi;0A2F
+yahiragana;3084
+yakatakana;30E4
+yakatakanahalfwidth;FF94
+yakorean;3151
+yamakkanthai;0E4E
+yasmallhiragana;3083
+yasmallkatakana;30E3
+yasmallkatakanahalfwidth;FF6C
+yatcyrillic;0463
+ycircle;24E8
+ycircumflex;0177
+ydieresis;00FF
+ydotaccent;1E8F
+ydotbelow;1EF5
+yeharabic;064A
+yehbarreearabic;06D2
+yehbarreefinalarabic;FBAF
+yehfinalarabic;FEF2
+yehhamzaabovearabic;0626
+yehhamzaabovefinalarabic;FE8A
+yehhamzaaboveinitialarabic;FE8B
+yehhamzaabovemedialarabic;FE8C
+yehinitialarabic;FEF3
+yehmedialarabic;FEF4
+yehmeeminitialarabic;FCDD
+yehmeemisolatedarabic;FC58
+yehnoonfinalarabic;FC94
+yehthreedotsbelowarabic;06D1
+yekorean;3156
+yen;00A5
+yenmonospace;FFE5
+yeokorean;3155
+yeorinhieuhkorean;3186
+yerahbenyomohebrew;05AA
+yerahbenyomolefthebrew;05AA
+yericyrillic;044B
+yerudieresiscyrillic;04F9
+yesieungkorean;3181
+yesieungpansioskorean;3183
+yesieungsioskorean;3182
+yetivhebrew;059A
+ygrave;1EF3
+yhook;01B4
+yhookabove;1EF7
+yiarmenian;0575
+yicyrillic;0457
+yikorean;3162
+yinyang;262F
+yiwnarmenian;0582
+ymonospace;FF59
+yod;05D9
+yoddagesh;FB39
+yoddageshhebrew;FB39
+yodhebrew;05D9
+yodyodhebrew;05F2
+yodyodpatahhebrew;FB1F
+yohiragana;3088
+yoikorean;3189
+yokatakana;30E8
+yokatakanahalfwidth;FF96
+yokorean;315B
+yosmallhiragana;3087
+yosmallkatakana;30E7
+yosmallkatakanahalfwidth;FF6E
+yotgreek;03F3
+yoyaekorean;3188
+yoyakorean;3187
+yoyakthai;0E22
+yoyingthai;0E0D
+yparen;24B4
+ypogegrammeni;037A
+ypogegrammenigreekcmb;0345
+yr;01A6
+yring;1E99
+ysuperior;02B8
+ytilde;1EF9
+yturned;028E
+yuhiragana;3086
+yuikorean;318C
+yukatakana;30E6
+yukatakanahalfwidth;FF95
+yukorean;3160
+yusbigcyrillic;046B
+yusbigiotifiedcyrillic;046D
+yuslittlecyrillic;0467
+yuslittleiotifiedcyrillic;0469
+yusmallhiragana;3085
+yusmallkatakana;30E5
+yusmallkatakanahalfwidth;FF6D
+yuyekorean;318B
+yuyeokorean;318A
+yyabengali;09DF
+yyadeva;095F
+z;007A
+zaarmenian;0566
+zacute;017A
+zadeva;095B
+zagurmukhi;0A5B
+zaharabic;0638
+zahfinalarabic;FEC6
+zahinitialarabic;FEC7
+zahiragana;3056
+zahmedialarabic;FEC8
+zainarabic;0632
+zainfinalarabic;FEB0
+zakatakana;30B6
+zaqefgadolhebrew;0595
+zaqefqatanhebrew;0594
+zarqahebrew;0598
+zayin;05D6
+zayindagesh;FB36
+zayindageshhebrew;FB36
+zayinhebrew;05D6
+zbopomofo;3117
+zcaron;017E
+zcircle;24E9
+zcircumflex;1E91
+zcurl;0291
+zdot;017C
+zdotaccent;017C
+zdotbelow;1E93
+zecyrillic;0437
+zedescendercyrillic;0499
+zedieresiscyrillic;04DF
+zehiragana;305C
+zekatakana;30BC
+zero;0030
+zeroarabic;0660
+zerobengali;09E6
+zerodeva;0966
+zerogujarati;0AE6
+zerogurmukhi;0A66
+zerohackarabic;0660
+zeroinferior;2080
+zeromonospace;FF10
+zerooldstyle;F730
+zeropersian;06F0
+zerosuperior;2070
+zerothai;0E50
+zerowidthjoiner;FEFF
+zerowidthnonjoiner;200C
+zerowidthspace;200B
+zeta;03B6
+zhbopomofo;3113
+zhearmenian;056A
+zhebrevecyrillic;04C2
+zhecyrillic;0436
+zhedescendercyrillic;0497
+zhedieresiscyrillic;04DD
+zihiragana;3058
+zikatakana;30B8
+zinorhebrew;05AE
+zlinebelow;1E95
+zmonospace;FF5A
+zohiragana;305E
+zokatakana;30BE
+zparen;24B5
+zretroflexhook;0290
+zstroke;01B6
+zuhiragana;305A
+zukatakana;30BA
+#--end
diff --git a/lib/head.ps b/lib/head.ps
@@ -0,0 +1,28 @@
+%%DocumentFonts: (atend)
+/PicoEncoding
+   ISOLatin1Encoding  dup length array  copy
+def
+/isoLatin1 {
+   dup dup findfont  dup length  dict begin
+      {1 index /FID ne {def} {pop pop} ifelse} forall
+      /Encoding PicoEncoding def  currentdict
+   end  definefont
+} def
+/glyphArrayShow {
+   {
+      dup type /stringtype eq {show} {glyphshow} ifelse
+   } forall
+} def
+/glyphArrayWidth {
+   0 exch
+   {
+      dup type /stringtype eq {
+         stringwidth pop
+      } {
+         matrix currentmatrix gsave
+         newpath nulldevice setmatrix 0 0 moveto glyphshow
+         currentpoint grestore pop
+      } ifelse
+      add
+   } forall
+} def
diff --git a/lib/heartbeat.l b/lib/heartbeat.l
@@ -0,0 +1,19 @@
+# 16feb08abu
+# (c) Software Lab. Alexander Burger
+
+(ifn (info "fifo/beat")
+   (de heartbeat ())
+
+   (de heartbeat @
+      (out "fifo/beat"
+         (pr
+            (cons *Pid
+               (cons
+                  (+ (* 86400 (date T)) (time T) 300)  # Busy period 5 minutes
+                  (rest) ) ) ) ) )
+
+   (task -54321 0 (heartbeat))
+   (push1 '*Bye '(out "fifo/beat" (pr *Pid))) )
+
+(de nobeat ()
+   (task -54321) )
diff --git a/lib/http.l b/lib/http.l
@@ -0,0 +1,440 @@
+# 21apr10abu
+# (c) Software Lab. Alexander Burger
+
+# *Home *Gate *Host *Port *Port1 *Http1 *Chunked
+# *Sock *Agent *ContLen *MPartLim *MPartEnd "*HtSet"
+# *Post *Url *Timeout *SesId *ConId
+# *Referer *Cookies "*Cookies"
+
+(default
+   *HPorts 0
+   *Timeout (* 300 1000) )
+
+(zero *Http1)
+
+(de *Mimes
+   (`(chop "html") "text/html; charset=utf-8")
+   (`(chop "au") "audio/basic" 3600)
+   (`(chop "wav") "audio/x-wav" 3600)
+   (`(chop "mp3") "audio/x-mpeg" 3600)
+   (`(chop "gif") "image/gif" 3600)
+   (`(chop "tif") "image/tiff" 3600)
+   (`(chop "tiff") "image/tiff" 3600)
+   (`(chop "bmp") "image/bmp" 3600)
+   (`(chop "png") "image/png" 3600)
+   (`(chop "jpg") "image/jpeg" 3600)
+   (`(chop "txt") "text/octet-stream" 1 T)
+   (`(chop "csv") "text/csv; charset=utf-8" 1 T)
+   (`(chop "css") "text/css" 3600)
+   (`(chop "js") "application/x-javascript" 3600)
+   (`(chop "ps") "application/postscript" 1)
+   (`(chop "pdf") "application/pdf" 1)
+   (`(chop "zip") "application/zip" 1)
+   (`(chop "jar") "application/java-archive" 3600) )
+
+(de mime (S . @)
+   (let L (chop S)
+      (if (assoc L *Mimes)
+         (con @ (rest))
+         (push '*Mimes (cons L (rest))) ) ) )
+
+(de mimetype (File)
+   (in (list 'file "--brief" "--mime" File)
+      (line T) ) )
+
+
+### HTTP-Client ###
+(de client (Host Port How . Prg)
+   (let? Sock (connect Host Port)
+      (prog1
+         (out Sock
+            (if (atom How)
+               (prinl "GET /" How " HTTP/1.0^M")
+               (prinl "POST /" (car How) " HTTP/1.0^M")
+               (prinl "Content-Length: " (size (cdr How)) "^M") )
+            (prinl "User-Agent: PicoLisp^M")
+            (prinl "Host: " Host "^M")
+            (prinl "Accept-Charset: utf-8^M")
+            (prinl "^M")
+            (and (pair How) (prin (cdr @)))
+            (flush)
+            (in Sock (run Prg 1)) )
+         (close Sock) ) ) )
+
+# Local Password
+(de pw (N)
+   (if N
+      (out ".pw" (prinl (fmt64 (in "/dev/random" (rd N)))))
+      (in ".pw" (line T)) ) )
+
+# PicoLisp Shell
+(de psh (Pw Tty)
+   (off *Run)
+   (when (and (= Pw (pw)) (ctty Tty))
+      (prinl *Pid)
+      (load "@dbg.l")
+      (off *Err)
+      (quit) ) )
+
+
+### HTTP-Server ###
+(de server (P H)
+   (setq
+      *Port P
+      *Port1 P
+      *Home (cons H (chop H))
+      P (port *Port) )
+   (gc)
+   (loop
+      (setq *Sock (listen P))
+      (NIL (fork) (close P))
+      (close *Sock) )
+   (task *Sock (http @))
+   (http *Sock)
+   (or *SesId (bye))
+   (task *Sock
+      (when (accept *Sock)
+         (task @ (http @)) ) ) )
+
+(de baseHRef (Port)
+   (pack
+      (or *Gate "http") "://" *Host
+      (if *Gate "/" ":") (or Port *Port) "/" ) )
+
+(de https @
+   (pass pack "https://" *Host "/" *Port "/" *SesId) )
+
+(de ext.html (Sym)
+   (pack (ht:Fmt Sym) ".html") )
+
+(de disallowed ()
+   (and
+      *Allow
+      (not (idx *Allow *Url))
+      (or
+         (sub? ".." *Url)
+         (nor
+            (and *Tmp (pre? *Tmp *Url))
+            (find pre? (cdr *Allow) (circ *Url)) ) ) ) )
+
+# Application startup
+(de app ()
+   (unless *SesId
+      (setq
+         *SesId (pack (in "/dev/urandom" (rd 7)) "~")
+         *Sock (port *HPorts '*Port) )
+      (timeout *Timeout) ) )
+
+# Set a cookie
+(de cookie @
+   (if (assoc (next) "*Cookies")
+      (con @ (rest))
+      (push '"*Cookies" (cons (arg) (rest))) ) )
+
+# Handle HTTP-Transaction
+(de http (S)
+   (use (*Post L @U @H @X)
+      (off *Post *ContLen *Cookies "*Cookies" "*HtSet")
+      (catch "http"
+         (in S
+            (cond
+               ((not (setq L (line)))
+                  (close S)
+                  (task S)
+                  (off S)
+                  (throw "http") )
+               ((match '("G" "E" "T" " " "/" @U " " "H" "T" "T" "P" "/" "1" "." @H) L)
+                  (_htHead) )
+               ((match '("P" "O" "S" "T" " " "/" @U " " "H" "T" "T" "P" "/" "1" "." @H) L)
+                  (on *Post)
+                  (off *MPartLim *MPartEnd)
+                  (_htHead)
+                  (cond
+                     (*MPartLim (_htMultipart))
+                     ((if *ContLen (ht:Read @) (line))
+                        (for L (split @ '&)
+                           (when (cdr (setq L (split L "=")))
+                              (_htSet (car L) (ht:Pack (cadr L))) ) ) )
+                     (T (throw "http")) ) )
+               (T
+                  (out S
+                     (if
+                        (and
+                           (match '(@U " " @ " " "H" "T" "T" "P" . @) L)
+                           (member @U
+                              (quote
+                                 ("O" "P" "T" "I" "O" "N" "S")
+                                 ("H" "E" "A" "D")
+                                 ("P" "U" "T")
+                                 ("D" "E" "L" "E" "T" "E")
+                                 ("T" "R" "A" "C" "E")
+                                 ("C" "O" "N" "N" "E" "C" "T") ) ) )
+                        (httpStat 501 "Method Not Implemented" "Allow: GET, POST")
+                        (httpStat 400 "Bad Request") ) )
+                  (close S)
+                  (task S)
+                  (off S)
+                  (throw "http") ) )
+            (if (<> *ConId *SesId)
+               (if *ConId
+                  (out S (http404))
+                  (close S)
+                  (task S)
+                  (off S) )
+               (setq
+                  L (split @U "?")
+                  @U (car L)
+                  L (extract
+                     '((L)
+                        (cond
+                           ((cdr (setq L (split L "=")))
+                              (_htSet (car L) (htArg (cadr L)))
+                              NIL )
+                           ((tail '`(chop ".html") (car L))
+                              (pack (car L)) )
+                           (T (htArg (car L))) ) )
+                     (split (cadr L) "&") ) )
+               (unless (setq *Url (ht:Pack @U))
+                  (setq  *Url (car *Home)  @U (cdr *Home)) )
+               (out S
+                  (cond
+                     ((match '("-" @X "." "h" "t" "m" "l") @U)
+                        (and *SesId (timeout *Timeout))
+                        (try 'html> (extern (ht:Pack @X))) )
+                     ((= '@ (car @U))
+                        (if (disallowed)
+                           (prog (msg *Url " not allowed") (http404))
+                           (and *SesId (timeout *Timeout))
+                           (apply (val (intern (ht:Pack (cdr @U)))) L) ) )
+                     ((disallowed)
+                        (msg *Url " not allowed")
+                        (http404) )
+                     ((tail '("." "l") @U)
+                        (and *SesId (timeout *Timeout))
+                        (apply script L *Url) )
+                     ((assoc (stem @U ".") *Mimes)
+                        (apply httpEcho (cdr @) *Url) )
+                     ((=T (car (info *Url)))
+                        (if (info (setq *Url (pack *Url "default")))
+                           (apply script L *Url)
+                           (http404) ) )
+                     (T (httpEcho *Url "application/octet-stream" 1 T)) ) ) ) ) )
+      (and S (=0 *Http1) (close S) (task S)) ) )
+
+(de _htHead ()
+   (use (L @X @Y)
+      (setq *Http1 (format (car @H))  *Chunked (gt0 *Http1))
+      (if (index "~" @U)
+         (setq *ConId (pack (head @ @U))  @U (cdr (nth @U @)))
+         (off *ConId) )
+      (while (setq L (line))
+         (cond
+            ((match '(~(chop "Gate: ") @X " " . @Y) L)
+               (setq *Gate (pack @X)  *Adr (pack @Y)) )
+            ((match '(~(chop "Host: ") . @X) L)
+               (setq *Host
+                  (cond
+                     (*Gate @X)
+                     ((index ":" @X) (head (dec @) @X))
+                     (T @X) ) ) )
+            ((match '(~(chop "Referer: ") . @X) L)
+               (setq *Referer @X) )
+            ((match '(~(chop "Cookie: ") . @X) L)
+               (setq *Cookies
+                  (mapcar
+                     '((L)
+                        (setq L (split L "="))
+                        (cons (htArg (clip (car L))) (htArg (cadr L))) )
+                     (split @X ";") ) ) )
+            ((match '(~(chop "User-Agent: ") . @X) L)
+               (setq *Agent @X) )
+            ((match '(~(chop "Content-@ength: ") . @X) L)
+               (setq *ContLen (format (pack @X))) )
+            ((match '(~(chop "Content-@ype: multipart/form-data; boundary=") . @X) L)
+               (setq
+                  *MPartLim (append '(- -) @X)
+                  *MPartEnd (append *MPartLim '(- -)) ) ) ) ) ) )
+
+# rfc1867 multipart/form-data
+(de _htMultipart ()
+   (use (L @X @N @V)
+      (setq L (line))
+      (while (= *MPartLim L)
+         (unless (match '(~(chop "Content-Disposition: form-data; name=") . @X) (line))
+            (throw "http") )
+         (while (line))
+         (cond
+            ((not (member ";" @X))
+               (match '("\"" @X "\"") @X)
+               (_htSet @X
+                  (pack
+                     (make
+                        (until
+                           (or
+                              (= *MPartLim (setq L (line)))
+                              (= *MPartEnd L) )
+                           (when (eof)
+                              (throw "http") )
+                           (when (made)
+                              (link "^J") )
+                           (link (trim L)) ) ) ) ) )
+            ((match '(@N ~(chop "; filename=") . @V) @X)
+               (match '("\"" @N "\"") @N)
+               (match '("\"" @V "\"") @V)
+               (if (_htSet @N (pack (stem @V '/ "\\")))
+                  (let F (tmp @)
+                     (unless (out F (echo (pack "^M^J" *MPartLim)))
+                        (call 'rm "-f" F) ) )
+                  (out "/dev/null" (echo (pack "^M^J" *MPartLim))) )
+               (setq L (if (= "-" (car (line))) *MPartEnd *MPartLim)) ) ) ) ) )
+
+(de _htSet ("Var" Val)
+   (let (@N NIL  @Z NIL  @V)
+      (setq "Var"
+         (intern
+            (ht:Pack
+               (ifn (match '(@V ":" @N ":" @Z) "Var")
+                  "Var"
+                  (setq @N (format (pack @N)))
+                  @V ) ) ) )
+      (when @Z
+         (setq Val
+            (cond
+               ((= @Z '("." "x")) (cons (format Val)))
+               ((= @Z '("." "y")) (cons NIL (format Val)))
+               (T (msg @Z " bad suffix") (throw "http")) ) ) )
+      (cond
+         ((and *Allow (not (idx *Allow "Var")))
+            (msg "Var" ': " not allowed")
+            (throw "http") )
+         ((not @N)
+            (nond
+               ((= `(char '*) (char "Var")) (put "Var" 'http Val))
+               ((and @Z (val "Var")) (set "Var" Val))
+               ((car Val) (con (val "Var") (cdr Val)))
+               (NIL (set (val "Var") (car Val))) ) )
+         ((not (memq "Var" "*HtSet"))
+            (push '"*HtSet" "Var")
+            (set "Var" (cons (cons @N Val)))
+            Val )
+         ((assoc @N (val "Var"))
+            (let X @
+               (cond
+                  ((nand @Z (cdr X)) (con X Val))
+                  ((car Val) (set (cdr X) @))
+                  (T (con (cdr X) (cdr Val))) ) ) )
+         (T
+            (queue "Var" (cons @N Val))
+            Val ) ) ) )
+
+(de htArg (Lst)
+   (case (car Lst)
+      ("$" (intern (ht:Pack (cdr Lst))))
+      ("+" (format (pack (cdr Lst))))
+      ("-" (extern (ht:Pack (cdr Lst))))
+      ("_" (mapcar htArg (split (cdr Lst) "_")))
+      (T (ht:Pack Lst)) ) )
+
+# Http Transfer Header
+(de http1 (Typ Upd File Att)
+   (prinl "HTTP/1." *Http1 " 200 OK^M")
+   (prinl "Server: PicoLisp^M")
+   (prin "Date: ")
+   (httpDate (date T) (time T))
+   (when Upd
+      (prinl "Cache-Control: max-age=" Upd "^M")
+      (when (=0 Upd)
+         (prinl "Cache-Control: private, no-store, no-cache^M") ) )
+   (prinl "Content-Type: " (or Typ "text/html; charset=utf-8") "^M")
+   (when File
+      (prinl
+         "Content-Disposition: "
+         (if Att "attachment" "inline")
+         "; filename=\"" File "\"^M" ) ) )
+
+(de httpCookies ()
+   (mapc
+      '((L)
+         (prin "Set-Cookie: "
+            (ht:Fmt (pop 'L)) "=" (ht:Fmt (pop 'L))
+            "; path=" (or (pop 'L) "/") )
+         (and (pop 'L) (prin "; expires=" @))
+         (and (pop 'L) (prin "; domain=" @))
+         (and (pop 'L) (prin "; secure"))
+         (and (pop 'L) (prin "; HttpOnly"))
+         (prinl) )
+      "*Cookies" ) )
+
+(de httpHead (Typ Upd File Att)
+   (http1 Typ Upd File Att)
+   (and *Chunked (prinl "Transfer-Encoding: chunked^M"))
+   (httpCookies)
+   (prinl "^M") )
+
+(de httpDate (Dat Tim)
+   (let D (date Dat)
+      (prinl
+         (day Dat *Day) ", "
+         (pad 2 (caddr D)) " "
+         (get *Mon (cadr D)) " "
+         (car D) " "
+         (tim$ Tim T) " GMT^M" ) ) )
+
+# Http Echo
+(de httpEcho (File Typ Upd Att)
+   (and *Tmp (pre? *Tmp File) (one Upd))
+   (ifn (info File)
+      (http404)
+      (http1 (or Typ (mimetype File)) Upd (stem (chop File) "/") Att)
+      (prinl "Content-Length: " (car @) "^M")
+      (prin "Last-Modified: ")
+      (httpDate (cadr @) (cddr @))
+      (prinl "^M")
+      (in File (echo)) ) )
+
+(de srcUrl (Url)
+   (if (or (pre? "http:" Url) (pre? "https:" Url))
+      Url
+      (pack (baseHRef *Port1) Url) ) )
+
+(de sesId (Url)
+   (if
+      (or
+         (pre? "http:" Url)
+         (pre? "https:" Url)
+         (pre? "mailto:" Url)
+         (pre? "javascript:" Url) )
+      Url
+      (pack *SesId Url) ) )
+
+(de httpStat (N Str . @)
+   (prinl "HTTP/1." *Http1 " " N " " Str "^M")
+   (prinl "Server: PicoLisp^M")
+   (while (args)
+      (prinl (next) "^M") )
+   (prinl "Content-Type: text/html^M")
+   (httpCookies)
+   (prinl "Content-Length: " (+ 68 (length N) (* 2 (length Str))) "^M")
+   (prinl "^M")
+   (prinl "<HTML>")
+   (prinl "<HEAD><TITLE>" N " " Str "</TITLE></HEAD>")
+   (prinl "<BODY><H1>" Str "</H1></BODY>")
+   (prinl "</HTML>") )
+
+(de noContent ()
+   (httpStat 204 "No Content") )
+
+(de redirect @
+   (httpStat 303 "See Other" (pass pack "Location: ")) )
+
+(de forbidden ()
+   (httpStat 403 "No Permission")
+   (throw "http") )
+
+(de http404 ()
+   (httpStat 404 "Not Found") )
+
+`*Dbg
+(noLint 'http '"O")
+
+# vi:et:ts=3:sw=3
diff --git a/lib/import.l b/lib/import.l
@@ -0,0 +1,30 @@
+# 15jul05abu
+# (c) Software Lab. Alexander Burger
+
+### Import Parsing ###
+(de getStr (N Lst)
+   (pack (clip (get Lst N))) )
+
+(de getSym (N Lst)
+   (intern
+      (pack (replace (clip (get Lst N)) " " '_)) ) )
+
+(de getStrLst (N Lst)
+   (mapcar pack (split (clip (get Lst N)) " ")) )
+
+(de getSymLst (N Lst)
+   (mapcar
+      '((L) (intern (pack L)))
+      (split (clip (get Lst N)) " ") ) )
+
+(de getNum (N Lst)
+   (format (getStr N Lst)) )
+
+(de getFlt (P N Lst)
+   (format (getStr N Lst) P *Sep0 *Sep3) )
+
+(de getDat (L Lst)
+   (date
+      (mapcar
+         '((N) (getNum N Lst))
+         L ) ) )
diff --git a/lib/led.l b/lib/led.l
@@ -0,0 +1,431 @@
+# 19apr10abu
+# (c) Software Lab. Alexander Burger
+
+# Line editor
+# vi-mode, just a subset:
+#  - Only single-key commands
+#  - No repeat count
+
+(setq
+   "Line"      NIL      # Holds current input line
+   "LPos"      1        # Position in line (1 .. length)
+   "HPos"      1        # Position in history
+   "UndoLine"  NIL      # Undo
+   "UndoPos"   0
+   "Line1"     NIL      # Initial line
+   "Insert"    T        # Insert mode flag
+   "FKey"      NIL      # Function key bindings
+   "Clip"      NIL      # Cut/Copy/Paste buffer
+   "Item"      NIL      # Item to find
+   "Found"     NIL      # Find stack
+   "Complete"  NIL      # Input completion
+
+   "HistMax"   1000     # History limit
+
+   "History"            # History of input lines
+   (in "+@.picoHistory"
+      (ctl NIL
+         (make (until (eof) (link (line T)))) ) )
+   "Hist0"     "History" )
+
+
+# Basic editing routine
+(de chgLine (L N)
+   (let (D (length "Line")  Tsm)
+      (for (P (dec "LPos") (>= P 1) (dec P))  # To start of old line
+         (unless
+            (and
+               *Tsm
+               (= "\"" (get "Line" P))
+               ("skipQ" "LPos" P "Line") )
+            (prin "^H") ) )
+      (for (P . C) (setq "Line" L)  # Output new line
+         (cond
+            ((> " " C)
+               (dec 'D)
+               (prin "_") )
+            ((or (not *Tsm) (<> "\"" C) ("escQ" P L))
+               (dec 'D)
+               (prin C) )
+            (T
+               (prin
+                  (and Tsm (cdr *Tsm))
+                  (unless ("skipQ" N P L)
+                     (dec 'D)
+                     C )
+                  (and (onOff Tsm) (car *Tsm)) ) ) ) )
+      (and Tsm (prin (cdr *Tsm)))
+      (space D)  # Clear rest of old line
+      (do D (prin "^H"))
+      (setq "LPos" (inc (length L)))
+      (until (= N "LPos")  # To new position
+         (unless
+            (and
+               *Tsm
+               (= "\"" (get "Line" "LPos"))
+               ("skipQ" N "LPos" "Line") )
+            (prin "^H") )
+         (dec '"LPos") ) )
+   (flush) )
+
+# Skipped double quote
+(de "skipQ" (N P L)
+   (nor
+      (>= (inc N) P (dec N))
+      (= "\""  (get L (dec P)))
+      (= "\"" (get L (inc P)))
+      ("escQ" P L) ) )
+
+# Escaped double quote
+(de "escQ" ()
+   (let Esc NIL
+      (for I (dec P)
+         ((if (= "\\" (get L I)) onOff off) Esc) ) ) )
+
+# Check for delimiter
+(de delim? (C)
+   (member C '`(chop '" ^I^J^M\"'()[]`~")) )
+
+# Move left
+(de lMove ()
+   (chgLine "Line" (max 1 (dec "LPos"))) )
+
+# Move to beginning
+(de bMove ()
+   (chgLine "Line" 1) )
+
+# Move right
+(de rMove ()
+   (chgLine "Line"
+      (if (>= "LPos" (length "Line"))
+         "LPos"
+         (inc "LPos") ) ) )
+
+# Move to end of line
+(de eMove ()
+   (chgLine "Line" (length "Line")) )
+
+# Move beyond end of line
+(de xMove ()
+   (chgLine "Line" (inc (length "Line"))) )
+
+# Move word left
+(de lWord ()
+   (use (N L)
+      (chgLine "Line"
+         (if (>= 1 (setq N "LPos"))
+            1
+            (loop
+               (T (= 1 (dec 'N)) 1)
+               (setq L (nth "Line" (dec N)))
+               (T (and (delim? (car L)) (not (delim? (cadr L))))
+                  N ) ) ) ) ) )
+
+# Move word right
+(de rWord ()
+   (use (M N L)
+      (setq M (length "Line"))
+      (chgLine "Line"
+         (if (<= M (setq N "LPos"))
+            M
+            (loop
+               (T (= M (inc 'N)) M)
+               (setq L (nth "Line" (dec N)))
+               (T (and (delim? (car L)) (not (delim? (cadr L))))
+                  N ) ) ) ) ) )
+
+# Match left parenthesis
+(de lPar ()
+   (let (N 1  I (dec "LPos"))
+      (loop
+         (T (=0 I))
+         (case (get "Line" I)
+            (")" (inc 'N))
+            ("(" (dec 'N)) )
+         (T (=0 N) (chgLine "Line" I))
+         (dec 'I) ) ) )
+
+# Match right parenthesis
+(de rPar ()
+   (let (N 1  I (inc "LPos"))
+      (loop
+         (T (> I (length "Line")))
+         (case (get "Line" I)
+            ("(" (inc 'N))
+            (")" (dec 'N)) )
+         (T (=0 N) (chgLine "Line" I))
+         (inc 'I) ) ) )
+
+# Clear to end of line
+(de clrEol ()
+   (let N (dec "LPos")
+      (if (=0 N)
+         (chgLine NIL 1)
+         (chgLine (head N "Line") N) ) ) )
+
+# Insert a char
+(de insChar (C)
+   (chgLine (insert "LPos" "Line" C) (inc "LPos")) )
+
+(de del1 (L)
+   (ifn (nth L "LPos")
+      L
+      (setq "Clip" (append "Clip" (list (get L "LPos"))))
+      (remove "LPos" L) ) )
+
+# Delete a char
+(de delChar ()
+   (use L
+      (off "Clip")
+      (chgLine
+         (setq L (del1 "Line"))
+         (max 1 (min "LPos" (length L))) ) ) )
+
+# Delete a word (F: with trailing blank)
+(de delWord (F)
+   (let L "Line"
+      (off "Clip")
+      (ifn (= "(" (get L "LPos"))
+         (while (and (nth L "LPos") (not (delim? (get L "LPos"))))
+            (setq L (del1 L)) )
+         (for (N 1 (and (setq L (del1 L)) (< 0 N)))
+            (case (get L "LPos")
+               ("(" (inc 'N))
+               (")" (dec 'N)) ) ) )
+      (and
+         F
+         (sp? (get L "LPos"))
+         (setq L (del1 L)) )
+      (chgLine L (max 1 (min "LPos" (length L)))) ) )
+
+# Replace char
+(de rplChar (C)
+   (chgLine
+      (insert "LPos" (remove "LPos" "Line") C)
+      "LPos" ) )
+
+# Undo mechanism
+(de doUndo ()
+   (setq  "UndoLine" "Line"  "UndoPos"  "LPos") )
+
+# Paste clip
+(de doPaste ()
+   (if (= 1 "LPos")
+      (chgLine (append "Clip" "Line") 1)
+      (chgLine
+         (append
+            (head (dec "LPos") "Line")
+            "Clip"
+            (nth "Line" "LPos") )
+         (+ "LPos" (length "Clip") -1) ) ) )
+
+# Set history line
+(de setHist (N)
+   (chgLine
+      (if (=0 (setq "HPos" N))
+         "Line1"
+         (chop (get "History" "HPos")) )
+      1 ) )
+
+# Searching
+(de ledSearch (L)
+   (let (H (nth "History" (inc "HPos"))  S (find '((X) (match "Item" (chop X))) H))
+      (chgLine
+         (ifn S
+            (prog (beep) L)
+            (push '"Found" "HPos")
+            (inc '"HPos" (index S H))
+            (chop S) )
+         1 ) ) )
+
+# TAB expansion
+(de expandTab ()
+   (let ("L" (head (dec "LPos") "Line")  "S" "L")
+      (while (find "skipFun" "S")
+         (pop '"S") )
+      (ifn "S"
+         (prog
+            (off "Complete")
+            (do 3 (insChar " ")) )
+         (ifn
+            (default "Complete"
+               (let "N" (inc (length "S"))
+                  (mapcar
+                     '((X)
+                        (setq X
+                           (nth
+                              (mapcar
+                                 '((C)
+                                    (if (delim? C) (pack "\\" C) C) )
+                                 (chop X) )
+                              "N" ) )
+                        (cons
+                           (+ "LPos" (length X))
+                           (append "L" X (nth "Line" "LPos")) ) )
+                     ("tabFun" (pack "S")) ) ) )
+            (beep)
+            (chgLine (cdar "Complete") (caar "Complete"))
+            (rot "Complete") ) ) ) )
+
+# Insert mode
+(de insMode ("C")
+   (if (= "C" "^I")
+      (expandTab)
+      (off "Complete")
+      (case "C"
+         (("^H" "^?")
+            (when (> "LPos" 1)
+               (chgLine (remove (dec "LPos") "Line") (dec "LPos")) ) )
+         ("^V" (insChar (key)))
+         ("^["
+            (loop
+               (NIL
+                  (make
+                     (while (and (setq "C" (key 50)) (<> "C" "^["))
+                        (link "C") ) )
+                  (off "Insert")
+                  (lMove) )
+               (and
+                  (assoc (pack "^[" @) "FKey")
+                  (let *Dbg "*Dbg"
+                     (run (cdr @)) ) )
+               (NIL "C") ) )
+         (T
+            (when (= "C" ")")
+               (chgLine "Line" (prog1 "LPos" (lPar) (wait 200))) )
+            (insChar "C") ) ) ) )
+
+# Command mode
+(de cmdMode ("C")
+   (case "C"
+      ("g" (prinl) (println "Clip"))
+      ("$" (eMove))
+      ("%"
+         (case (get "Line" "LPos")
+            (")" (lPar))
+            ("(" (rPar))
+            (T (beep)) ) )
+      ("/"
+         (let "L" "Line"
+            (_getLine '("/") '((C) (= C "/")))
+            (unless (=T "Line")
+               (setq "Item" (append '(@) (cdr "Line") '(@)))
+               (ledSearch "L")
+               (off "Insert") ) ) )
+      ("0" (bMove))
+      ("A" (doUndo) (xMove) (on "Insert"))
+      ("a" (doUndo) ((if (= "LPos" (length "Line")) xMove rMove)) (on "Insert"))
+      ("b" (lWord))
+      ("c" (doUndo) (delWord NIL) (on "Insert"))
+      ("C" (doUndo) (clrEol) (xMove) (on "Insert"))
+      ("d" (doUndo) (delWord T))
+      ("D" (doUndo) (clrEol))
+      ("f"
+         (ifn (setq "C" (index (key) (nth "Line" (inc "LPos"))))
+            (beep)
+            (chgLine "Line" (+ "C" "LPos")) ) )
+      ("h" (lMove))
+      ("i" (doUndo) (on "Insert"))
+      ("I" (doUndo) (bMove) (on "Insert"))
+      ("j" (unless (=0 "HPos") (setHist (dec "HPos"))))
+      ("k" (when (< "HPos" (length "History")) (setHist (inc "HPos"))))
+      ("l" (rMove))
+      ("n" (ledSearch "Line"))
+      ("N" (if "Found" (setHist (pop '"Found")) (beep)))
+      ("p" (doUndo) ((if (= "LPos" (length "Line")) xMove rMove)) (doPaste))
+      ("P" (doUndo) (doPaste))
+      ("r" (ifn "Line" (beep) (doUndo) (rplChar (key))))
+      ("s" (doUndo) (delChar) (on "Insert"))
+      ("S" (doUndo) (chgLine NIL 1) (on "Insert"))
+      ("U" (setHist "HPos"))
+      ("u"
+         (let ("L" "Line"  "P" "LPos")
+            (chgLine "UndoLine" "UndoPos")
+            (setq  "UndoLine" "L"  "UndoPos" "P") ) )
+      ("w" (rWord))
+      ("x" (doUndo) (delChar))
+      ("X" (lMove) (doUndo) (delChar))
+      ("~"
+         (doUndo)
+         (rplChar
+            ((if (low? (setq "C" (get "Line" "LPos"))) uppc lowc) "C") )
+         (rMove) )
+      (T (beep)) ) )
+
+# Get a line from console
+(de _getLine ("L" "skipFun")
+   (use "C"
+      (chgLine "L" (inc (length "L")))
+      (on "Insert")
+      (until
+         (member
+            (setq "C" (let *Dbg "*Dbg" (key)))
+            '("^J" "^M") )
+         (case "C"
+            (NIL (bye))
+            ("^D" (prinl) (tell 'bye) (bye))
+            ("^X" (prin (cdr *Tsm)) (prinl) (quit)) )
+         ((if "Insert" insMode cmdMode) "C") ) ) )
+
+# Function keys
+(de fkey (Key . Prg)
+   (setq "FKey"
+      (cond
+         ((not Key) "FKey")
+         ((not Prg) (delete (assoc Key "FKey") "FKey"))
+         ((assoc Key "FKey")
+            (cons (cons Key Prg) (delete @ "FKey")) )
+         (T (cons (cons Key Prg) "FKey")) ) ) )
+
+# Main editing functions
+(de _led ("Line1" "tabFun" "skipFun")
+   (default "tabFun"
+      '((S)
+         (conc
+            (filter '((X) (pre? S X)) (all))
+            (let P (rot (split (chop S) "/"))
+               (setq
+                  S (pack (car P))
+                  P (and (cdr P) (pack (glue "/" @) "/")) )
+               (extract
+                  '((X)
+                     (and (pre? S X) (pack P X)) )
+                  (dir P) ) ) ) ) )
+   (setq "LPos" 1  "HPos" 0)
+   (_getLine "Line1" (or "skipFun" delim?))
+   (prinl (cdr *Tsm)) )
+
+(de revise ("X" "tabFun" "skipFun")
+   (let ("*Dbg" *Dbg  *Dbg NIL)
+      (_led (chop "X") "tabFun" "skipFun")
+      (pack "Line") ) )
+
+(de saveHistory ()
+   (in "+@.picoHistory"
+      (ctl T
+         (let (Old (make (until (eof) (link (line T))))  New "History"  N "HistMax")
+            (out "@.picoHistory"
+               (while (and New (n== New "Hist0"))
+                  (prinl (pop 'New))
+                  (dec 'N) )
+               (setq "Hist0" "History")
+               (do N
+                  (NIL Old)
+                  (prinl (pop 'Old)) ) ) ) ) ) )
+
+# Enable line editing
+(de *Led
+   (let ("*Dbg" *Dbg  *Dbg NIL)
+      (push1 '*Bye '(saveHistory))
+      (push1 '*Fork '(del '(saveHistory) '*Bye))
+      (_led)
+      (let L (pack "Line")
+         (or
+            (>= 3 (length "Line"))
+            (sp? (car "Line"))
+            (= L (car "History"))
+            (push '"History" L) )
+         (and (nth "History" "HistMax") (con @))
+         L ) ) )
+
+# vi:et:ts=3:sw=3
diff --git a/lib/led.min.l b/lib/led.min.l
@@ -0,0 +1,23 @@
+# 05feb05abu
+# (c) Software Lab. Alexander Burger
+
+# *Line
+
+# Line input editing
+(de mkChar (C)
+   (prin C)
+   (queue '*Line C) )
+
+# Enable line editing
+(de *Led
+   (use C
+      (until (member (setq C (key)) '("^J" "^M"))
+         (case C
+            (("^H" "^?")
+               (when *Line
+                  (prin "^H ^H")
+                  (setq *Line (cdr (rot *Line))) ) )
+            ("^I" (do 3 (mkChar " ")))
+            (T (mkChar C)) ) ) )
+   (prinl)
+   (prog1 (pack *Line) (off *Line)) )
diff --git a/lib/lint.l b/lib/lint.l
@@ -0,0 +1,257 @@
+# 31mar10abu
+# (c) Software Lab. Alexander Burger
+
+# *NoLint
+
+(de noLint (X V)
+   (if V
+      (push1 '*NoLint (cons X V))
+      (or (memq X *NoLint) (push '*NoLint X)) ) )
+
+(de global? (S)
+   (or
+      (memq S '(NIL ^ @ @@ @@@ This T))
+      (member (char S) '(`(char '*) `(char '+))) ) )
+
+(de local? (S)
+   (or
+      (str? S)
+      (member (char S) '(`(char '*) `(char '_))) ) )
+
+(de dlsym? (S)
+   (and
+      (car (setq S (split (chop S) ':)))
+      (cadr S)
+      (low? (caar S)) ) )
+
+(de lint1 ("X")
+   (cond
+      ((atom "X")
+         (when (sym? "X")
+            (cond
+               ((memq "X" "*L") (setq "*Use" (delq "X" "*Use")))
+               ((local? "X") (lint2 (val "X")))
+               (T
+                  (or
+                     (getd "X")
+                     (global? "X")
+                     (member (cons "*X" "X") *NoLint)
+                     (memq "X" "*Bnd")
+                     (push '"*Bnd" "X") ) ) ) ) )
+      ((num? (car "X")))
+      (T
+         (case (car "X")
+            ((: ::))
+            (; (lint1 (cadr "X")))
+            (quote
+               (if (and (pair (fun? (cdr "X"))) (not (cdr (tail 1 @))))
+                  (use "*L" (lintFun (cdr "X")))
+                  (lint2 (cdr "X")) ) )
+            ((de dm)
+               (let "*X" (cadr "X")
+                  (lintFun (cddr "X")) ) )
+            (recur
+               (let recurse (cdr "X")
+                  (lintFun recurse) ) )
+            (task
+               (lint1 (cadr "X"))
+               (let "Y" (cddr "X")
+                  (use "*L"
+                     (while (num? (car "Y"))
+                        (pop '"Y") )
+                     (while (and (car "Y") (sym? @))
+                        (lintVar (pop '"Y"))
+                        (pop '"Y") )
+                     (mapc lint1 "Y") ) ) )
+            (let?
+               (use "*L"
+                  (lintVar (cadr "X"))
+                  (mapc lint1 (cddr "X")) ) )
+            (let
+               (use "*L"
+                  (if (atom (cadr "X"))
+                     (lintVar (cadr "X"))
+                     (for (L (cadr "X") L (cddr L))
+                        (lintDup (car L)
+                           (extract '((X F) (and F X))
+                              (cddr L)
+                              '(T NIL .) ) )
+                        (lintVar (car L))
+                        (lint1 (cadr L)) ) )
+                  (mapc lint1 (cddr "X")) ) )
+            (use
+               (use "*L"
+                  (if (atom (cadr "X"))
+                     (lintVar (cadr "X"))
+                     (mapc lintVar (cadr "X")) )
+                  (mapc lint1 (cddr "X")) ) )
+            (for
+               (use "*L"
+                  (let "Y" (cadr "X")
+                     (cond
+                        ((atom "Y")          # (for X (1 2 ..) ..)
+                           (lint1 (caddr "X"))
+                           (lintVar "Y")
+                           (lintLoop (cdddr "X")) )
+                        ((atom (cdr "Y"))    # (for (I . X) (1 2 ..) ..)
+                           (lintVar (car "Y"))
+                           (lint1 (caddr "X"))
+                           (lintVar (cdr "Y"))
+                           (lintLoop (cdddr "X")) )
+                        ((atom (car "Y"))    # (for (X (1 2 ..) ..) ..)
+                           (lint1 (cadr "Y"))
+                           (lintVar (car "Y"))
+                           (mapc lint1 (cddr "Y"))
+                           (lintLoop (cddr "X")) )
+                        (T                   # (for ((I . L) (1 2 ..) ..) ..)
+                           (lintVar (caar "Y"))
+                           (lint1 (cadr "Y"))
+                           (lintVar (cdar "Y"))
+                           (mapc lint1 (cddr "Y"))
+                           (lintLoop (cddr "X")) ) ) ) ) )
+            ((case state)
+               (lint1 (cadr "X"))
+               (for "X" (cddr "X")
+                  (mapc lint1 (cdr "X")) ) )
+            ((cond nond)
+               (for "X" (cdr "X")
+                  (mapc lint1 "X") ) )
+            (loop
+               (lintLoop (cdr "X")) )
+            (do
+               (lint1 (cadr "X"))
+               (lintLoop (cddr "X")) )
+            (=:
+               (lint1 (last (cddr "X"))) )
+            ((dec inc pop push push1 queue fifo val idx accu)
+               (_lintq '(T)) )
+            ((cut port)
+               (_lintq '(NIL T)) )
+            (set
+               (_lintq '(T NIL .)) )
+            (xchg
+               (_lintq '(T T .)) )
+            (T
+               (cond
+                  ((pair (car "X"))
+                     (lint1 @)
+                     (mapc lint2 (cdr "X")) )
+                  ((memq (car "X") "*L")
+                     (setq "*Use" (delq (car "X") "*Use"))
+                     (mapc lint2 (cdr "X")) )
+                  ((fun? (val (car "X")))
+                     (if (num? @)
+                        (mapc lint1 (cdr "X"))
+                        (when (local? (car "X"))
+                           (lint2 (val (car "X"))) )
+                        (let "Y" (car (getd (pop '"X")))
+                           (while (and (pair "X") (pair "Y"))
+                              (lint1 (pop '"X"))
+                              (pop '"Y") )
+                           (if (or (== '@ "Y") (= "Prg" "Y") (= "*Prg" "Y"))
+                              (mapc lint1 "X")
+                              (lint2 "X") ) ) ) )
+                  (T
+                     (or
+                        (str? (car "X"))
+                        (dlsym? (car "X"))
+                        (== '@ (car "X"))
+                        (memq (car "X") *NoLint)
+                        (memq (car "X") "*Def")
+                        (push '"*Def" (car "X")) )
+                     (mapc lint1 (cdr "X")) ) ) ) ) ) ) )
+
+(de lint2 (X Mark)
+   (cond
+      ((memq X Mark))
+      ((atom X)
+         (and (memq X "*L") (setq "*Use" (delq X "*Use"))) )
+      (T (lint2 (car X))
+         (lint2 (cdr X) (cons X Mark)) ) ) )
+
+(de lintVar (X Flg)
+   (cond
+      ((or (not (sym? X)) (memq X '(NIL *DB *Solo ^ meth quote T)))
+         (push '"*Var" X) )
+      ((not (global? X))
+         (or
+            Flg
+            (member (cons "*X" X) *NoLint)
+            (memq X "*Use")
+            (push '"*Use" X) )
+         (push '"*L" X) ) ) )
+
+(de lintDup (X Lst)
+   (and
+      (memq X Lst)
+      (not (member (cons "*X" X) *NoLint))
+      (push '"*Dup" X) ) )
+
+(de lintLoop ("Lst")
+   (for "Y" "Lst"
+      (if (and (pair "Y") (or (=T (car "Y")) (not (car "Y"))))
+         (mapc lint1 (cdr "Y"))
+         (lint1 "Y") ) ) )
+
+(de _lintq (Lst)
+   (mapc
+      '((X Flg)
+         (lint1 (if Flg (strip X) X)) )
+      (cdr "X")
+      Lst ) )
+
+(de lintFun ("Lst")
+   (let "A" (and (pair "Lst") (car "Lst"))
+      (while (pair "A")
+         (lintDup (car "A") (cdr "A"))
+         (lintVar (pop '"A") T) )
+      (when "A"
+         (lintVar "A") )
+      (mapc lint1 (cdr "Lst")) ) )
+
+(de lint ("X" "C")
+   (let ("*L" NIL  "*Var" NIL  "*Dup" NIL  "*Def" NIL  "*Bnd" NIL  "*Use" NIL)
+      (when (pair "X")
+         (setq  "C" (cdr "X")  "X" (car "X")) )
+      (cond
+         ("C"  # Method
+            (let "*X" (cons "X" "C")
+               (lintFun (method "X" "C")) ) )
+         ((pair (val "X"))  # Function
+            (let "*X" "X"
+               (lintFun (val "X")) ) )
+         ((info "X")  # File name
+            (let "*X" "X"
+               (in "X" (while (read) (lint1 @))) ) )
+         (T (quit "Can't lint" "X")) )
+      (when (or "*Var" "*Dup" "*Def" "*Bnd" "*Use")
+         (make
+            # Bad variables
+            (and "*Var" (link (cons 'var "*Var")))
+            # Duplicate parameters
+            (and "*Dup" (link (cons 'dup "*Dup")))
+            # Undefined functions
+            (and "*Def" (link (cons 'def "*Def")))
+            # Unbound variables
+            (and "*Bnd" (<> `(char '_) (char "X")) (link (cons 'bnd "*Bnd")))
+            # Unused variables
+            (and "*Use" (link (cons 'use "*Use"))) ) ) ) )
+
+(de lintAll @
+   (let *Dbg NIL
+      (make
+         (for "X" (all)
+            (cond
+               ((= `(char "+") (char "X"))
+                  (for "Y" (val "X")
+                     (and
+                        (pair "Y")
+                        (fun? (cdr "Y"))
+                        (lint (car "Y") "X")
+                        (link (cons (cons (car "Y") "X") @)) ) ) )
+               ((and (not (global? "X")) (pair (getd "X")) (lint "X"))
+                  (link (cons "X" @)) ) ) )
+         (while (args)
+            (and (lint (next)) (link (cons (arg) @))) ) ) ) )
+
+# vi:et:ts=3:sw=3
diff --git a/lib/math.l b/lib/math.l
@@ -0,0 +1,11 @@
+# 18mar10abu
+# (c) Software Lab. Alexander Burger
+
+(and (=0 *Scl) (scl 6))                # Default scale 6
+(setq                                  # Global constants
+   pi    3.1415926535897931
+   pi/2  1.5707963267948966 )
+
+(load (if (== 64 64) "@lib/math64.l" "@lib/math32.l"))
+
+# vi:et:ts=3:sw=3
diff --git a/lib/math32.l b/lib/math32.l
@@ -0,0 +1,22 @@
+# 21feb10abu
+# (c) Software Lab. Alexander Burger
+
+(de exp (X)
+   (ext:Exp X 1.0) )
+
+(de log (X)
+   (and (gt0 X) (ext:Log X 1.0)) )
+
+(de sin (A)
+   (ext:Sin A 1.0) )
+
+(de cos (A)
+   (ext:Cos A 1.0) )
+
+(de tan (A)
+   (ext:Tan A 1.0) )
+
+(de atan (X Y)
+   (ext:Atan X Y 1.0) )
+
+# vi:et:ts=3:sw=3
diff --git a/lib/math64.l b/lib/math64.l
@@ -0,0 +1,44 @@
+# 22feb10abu
+# (c) Software Lab. Alexander Burger
+
+(load "lib/native.l")
+
+(de log (X)
+   (and (gt0 X) ("log" X 1.0)) )
+
+(gcc "math" NIL
+   (exp (X) "Exp" 'N X 1.0)
+   ("log" (X) "Log" 'N X 1.0)
+   (sin (A) "Sin" 'N A 1.0)
+   (cos (A) "Cos" 'N A 1.0)
+   (tan (A) "Tan" 'N A 1.0)
+   (atan (X Y) "Atan" 'N X Y 1.0) )
+
+#include <math.h>
+
+long Exp(long x, int scl) {
+   return round((double)scl * exp((double)x / (double)scl));
+}
+
+long Log(long x, int scl) {
+   return round((double)scl * log((double)x / (double)scl));
+}
+
+long Sin(long a, int scl) {
+   return round((double)scl * sin((double)a / (double)scl));
+}
+
+long Cos(long a, int scl) {
+   return round((double)scl * cos((double)a / (double)scl));
+}
+
+long Tan(long a, int scl) {
+   return round((double)scl * tan((double)a / (double)scl));
+}
+
+long Atan(long x, long y, int scl) {
+   return round((double)scl * atan2((double)x / (double)scl, (double)y / (double)scl));
+}
+/**/
+
+# vi:et:ts=3:sw=3
diff --git a/lib/misc.l b/lib/misc.l
@@ -0,0 +1,480 @@
+# 27feb10abu
+# (c) Software Lab. Alexander Burger
+
+# *Allow *Tmp
+
+(de *Day . (Mon Tue Wed Thu Fri Sat Sun .))
+(de *Mon . (Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec .))
+(de *mon . (jan feb mar apr may jun jul aug sep oct nov dec .))
+
+### Locale ###
+(de *Ctry)
+(de *Lang)
+(de *Sep0 . ".")
+(de *Sep3 . ",")
+(de *CtryCode)
+(de *DateFmt @Y "-" @M "-" @D)
+(de *DayFmt "Monday" "Tuesday" "Wednesday" "Thursday" "Friday" "Saturday" "Sunday")
+(de *MonFmt "January" "February" "March" "April" "May" "June" "July" "August" "September" "October" "November" "December")
+
+(de locale (Ctry Lang App)  # "DE" "de" ["app/loc/"]
+   (load (if (setq *Ctry Ctry) (pack "@loc/" @ ".l") "@loc/NIL.l"))
+   (ifn (setq *Lang Lang)
+      (for S (idx '*Uni)
+         (set S S) )
+      (let L
+         (sort
+            (make
+               ("loc" (pack "@loc/" Lang))
+               (and App ("loc" (pack App Lang))) ) )
+         (balance '*Uni L T)
+         (for S L
+            (set (car (idx '*Uni S)) (val S)) ) ) ) )
+
+(de "loc" (F)
+   (in F
+      (use X
+         (while (setq X (read))
+            (if (=T X)
+               ("loc" (read))
+               (set (link @) (name (read))) ) ) ) ) )
+
+### Math ###
+(de sqrt (N)
+   (cond
+      ((lt0 N) (quit "Bad argument" N))
+      (N
+         (let (A 1  B 0)
+            (while (>= N A)
+               (setq A (>> -2 A)) )
+            (loop
+               (if (> (inc 'B A) N)
+                  (dec 'B A)
+                  (dec 'N B)
+                  (inc 'B A) )
+               (setq B (>> 1 B)  A (>> 2 A))
+               (T (=0 A)) )
+            B ) ) ) )
+
+# (Knuth Vol.2, p.442)
+(de ** (X N)  # N th power of X
+   (let Y 1
+      (loop
+         (when (bit? 1 N)
+            (setq Y (* Y X)) )
+         (T (=0 (setq N (>> 1 N)))
+            Y )
+         (setq X (* X X)) ) ) )
+
+(de accu (Var Key Val)
+   (when Val
+      (if (assoc Key (val Var))
+         (con @ (+ Val (cdr @)))
+         (push Var (cons Key Val)) ) ) )
+
+### String ###
+(de align (X . @)
+   (pack
+      (if (pair X)
+         (mapcar
+            '((X) (need X (chop (next)) " "))
+            X )
+         (need X (chop (next)) " ") ) ) )
+
+(de center (X . @)
+   (pack
+      (if (pair X)
+         (let R 0
+            (mapcar
+               '((X)
+                  (let (S (chop (next))  N (>> 1 (+ X (length S))))
+                     (prog1
+                        (need (+ N R) S " ")
+                        (setq R (- X N)) ) ) )
+               X ) )
+         (let S (chop (next))
+            (need (>> 1 (+ X (length S))) S " ") ) ) ) )
+
+(de wrap (Max Lst)
+   (setq Lst (split Lst " " "^J"))
+   (pack
+      (make
+         (while Lst
+            (if (>= (length (car Lst)) Max)
+               (link (pop 'Lst) "^J")
+               (chain
+                  (make
+                     (link (pop 'Lst))
+                     (loop
+                        (NIL Lst)
+                        (T (>= (+ (length (car Lst)) (sum length (made))) Max)
+                           (link "^J") )
+                        (link " " (pop 'Lst)) ) ) ) ) ) ) ) )
+
+### Number ###
+(de pad (N Val)
+   (pack (need N (chop Val) "0")) )
+
+(de money (N Cur)
+   (if Cur
+      (pack (format N 2 *Sep0 *Sep3) " " Cur)
+      (format N 2 *Sep0 *Sep3) ) )
+
+# Octal notation
+(de oct (X)
+   (cond
+      ((num? X)
+         (let (S (and (lt0 X) '-)  L (oct1 X))
+            (until (=0 (setq X (>> 3 X)))
+               (push 'L (oct1 X)) )
+            (pack S L) ) )
+      ((setq X (chop X))
+         (let (S (and (= '- (car X)) (pop 'X))  N 0)
+            (for C X
+               (setq N (+ (format C) (>> -3 N))) )
+            (if S (- N) N) ) ) ) )
+
+(de oct1 (N)
+   (char (+ (& N 7) `(char "0"))) )
+
+# Hexadecimal notation
+(de hex (X)
+   (cond
+      ((num? X)
+         (let (S (and (lt0 X) '-)  L (hex1 X))
+            (until (=0 (setq X (>> 4 X)))
+               (push 'L (hex1 X)) )
+            (pack S L) ) )
+      ((setq X (chop X))
+         (let (S (and (= '- (car X)) (pop 'X))  N 0)
+            (for C X
+               (setq C (- (char C) `(char "0")))
+               (and (> C 9) (dec 'C 7))
+               (and (> C 22) (dec 'C 32))
+               (setq N (+ C (>> -4 N))) )
+            (if S (- N) N) ) ) ) )
+
+(de hex1 (N)
+   (let C (& 15 N)
+      (and (> C 9) (inc 'C 7))
+      (char (+ C `(char "0"))) ) )
+
+# Hexadecimal/Alpha notation
+(de hax (X)
+   (if (num? X)
+      (pack
+         (mapcar
+            '((C)
+               (when (> (setq C (- (char C) `(char "0"))) 9)
+                  (dec 'C 7) )
+               (char (+ `(char "@") C)) )
+            (chop (hex X)) ) )
+      (hex
+         (mapcar
+            '((C)
+               (when (> (setq C (- (char C) `(char "@"))) 9)
+                  (inc 'C 7) )
+               (char (+ `(char "0") C)) )
+            (chop X) ) ) ) )
+
+# Base 64 notation
+(de fmt64 (X)
+   (if (num? X)
+      (let L (_fmt64 X)
+         (until (=0 (setq X (>> 6 X)))
+            (push 'L (_fmt64 X)) )
+         (pack L) )
+      (let N 0
+         (for C (chop X)
+            (setq C (- (char C) `(char "0")))
+            (and (> C 42) (dec 'C 6))
+            (and (> C 11) (dec 'C 5))
+            (setq N (+ C (>> -6 N))) )
+         N ) ) )
+
+(de _fmt64 (N)
+   (let C (& 63 N)
+      (and (> C 11) (inc 'C 5))
+      (and (> C 42) (inc 'C 6))
+      (char (+ C `(char "0"))) ) )
+
+### Tree ###
+(de balance ("Var" "Lst" "Flg")
+   (unless "Flg" (set "Var"))
+   (let "Len" (length "Lst")
+      (recur ("Lst" "Len")
+         (unless (=0 "Len")
+            (let ("N" (>> 1 (inc "Len"))  "L" (nth "Lst" "N"))
+               (idx "Var" (car "L") T)
+               (recurse "Lst" (dec "N"))
+               (recurse (cdr "L") (- "Len" "N")) ) ) ) ) )
+
+### Allow ###
+(de allowed Lst
+   (setq *Allow (cons NIL (car Lst)))
+   (balance *Allow (sort (cdr Lst))) )
+
+(de allow (X Flg)
+   (nond
+      (*Allow)
+      (Flg (idx *Allow X T))
+      ((member X (cdr *Allow))
+         (conc *Allow (cons X)) ) )
+   X )
+
+### Telephone ###
+(de telStr (S)
+   (cond
+      ((not S))
+      ((and *CtryCode (pre? (pack *CtryCode " ") S))
+         (pack 0 (cdddr (chop S))) )
+      (T (pack "+" S)) ) )
+
+(de expTel (S)
+   (setq S
+      (make
+         (for (L (chop S) L)
+            (ifn (sub? (car L) " -")
+               (link (pop 'L))
+               (let F NIL
+                  (loop
+                     (and (= '- (pop 'L)) (on F))
+                     (NIL L)
+                     (NIL (sub? (car L) " -")
+                        (link (if F '- " ")) ) ) ) ) ) ) )
+   (cond
+      ((= "+" (car S)) (pack (cdr S)))
+      ((head '("0" "0") S)
+         (pack (cddr S)) )
+      ((and *CtryCode (= "0" (car S)))
+         (pack *CtryCode " " (cdr S)) ) ) )
+
+### Date ###
+# ISO date
+(de dat$ (Dat C)
+   (when (date Dat)
+      (pack (car @) C (pad 2 (cadr @)) C (pad 2 (caddr @))) ) )
+
+(de $dat (S C)
+   (if C
+      (and
+         (= 3
+            (length (setq S (split (chop S) C))) )
+         (date
+            (format (pack (car S)))                # Year
+            (or (format (pack (cadr S))) 0)        # Month
+            (or (format (pack (caddr S))) 0) ) )   # Day
+      (and
+         (format S)
+         (date
+            (/ @ 10000)       # Year
+            (% (/ @ 100) 100) # Month
+            (% @ 100) ) ) ) )
+
+(de datSym (Dat)
+   (when (date Dat)
+      (pack
+         (pad 2 (caddr @))
+         (get *mon (cadr @))
+         (pad 2 (% (car @) 100)) ) ) )
+
+# Localized
+(de datStr (D F)
+   (when (setq D (date D))
+      (let
+         (@Y (if F (pad 2 (% (car D) 100)) (pad 4 (car D)))
+            @M (pad 2 (cadr D))
+            @D (pad 2 (caddr D)) )
+         (pack (fill *DateFmt)) ) ) )
+
+(de strDat (S)
+   (use (@Y @M @D)
+      (and
+         (match *DateFmt (chop S))
+         (date
+            (format (pack @Y))
+            (or (format (pack @M)) 0)
+            (or (format (pack @D)) 0) ) ) ) )
+
+(de expDat (S)
+   (use (@Y @M @D X)
+      (unless (match *DateFmt (setq S (chop S)))
+         (if
+            (or
+               (cdr (setq S (split S ".")))
+               (>= 2 (length (car S))) )
+            (setq
+               @D (car S)
+               @M (cadr S)
+               @Y (caddr S) )
+            (setq
+               @D (head 2 (car S))
+               @M (head 2 (nth (car S) 3))
+               @Y (nth (car S) 5) ) ) )
+      (and
+         (setq @D (format (pack @D)))
+         (date
+            (nond
+               (@Y (car (date (date))))
+               ((setq X (format (pack @Y))))
+               ((>= X 100)
+                  (+ X
+                     (* 100 (/ (car (date (date))) 100)) ) )
+               (NIL X) )
+            (nond
+               (@M (cadr (date (date))))
+               ((setq X (format (pack @M))) 0)
+               ((n0 X) (cadr (date (date))))
+               (NIL X) )
+            @D ) ) ) )
+
+# Day of the week
+(de day (Dat Lst)
+   (get
+      (or Lst *DayFmt)
+      (inc (% (inc Dat) 7)) ) )
+
+# Week of the year
+(de week (Dat)
+   (let W
+      (-
+         (_week Dat)
+         (_week (date (car (date Dat)) 1 4))
+         -1 )
+      (if (=0 W) 53 W) ) )
+
+(de _week (Dat)
+   (/ (- Dat (% (inc Dat) 7)) 7) )
+
+# Last day of month
+(de ultimo (Y M)
+   (dec
+      (if (= 12 M)
+         (date (inc Y) 1 1)
+         (date Y (inc M) 1) ) ) )
+
+### Time ###
+(de tim$ (Tim F)
+   (when Tim
+      (setq Tim (time Tim))
+      (pack (pad 2 (car Tim)) ":" (pad 2 (cadr Tim))
+         (and F ":")
+         (and F (pad 2 (caddr Tim))) ) ) )
+
+(de $tim (S)
+   (setq S (split (chop S) ":"))
+   (unless (or (cdr S) (>= 2 (length (car S))))
+      (setq S
+         (list
+            (head 2 (car S))
+            (head 2 (nth (car S) 3))
+            (nth (car S) 5) ) ) )
+   (when (format (pack (car S)))
+      (time @
+         (or (format (pack (cadr S))) 0)
+         (or (format (pack (caddr S))) 0) ) ) )
+
+(de stamp (Dat Tim)
+   (default  Dat (date)  Tim (time T))
+   (pack (dat$ Dat "-") " " (tim$ Tim T)) )
+
+### I/O ###
+(de chdir ("Dir" . "Prg")
+   (let? "Old" (cd "Dir")
+      (finally (cd "Old")
+         (run "Prg") ) ) )
+
+(de dirname (F)
+   (pack (flip (member '/ (flip (chop F))))) )
+
+# Temporary Files
+(de tmp @
+   (unless *Tmp
+      (push '*Bye '(call 'rm "-r" *Tmp))
+      (push '*Fork '(off *Tmp) '(del '(call 'rm "-r" *Tmp) '*Bye))
+      (call 'mkdir "-p" (setq *Tmp (pack "tmp/" *Pid "/"))) )
+   (pass pack *Tmp) )
+
+
+# Print or eval
+(de prEval (Prg Ofs)
+   (default Ofs 1)
+   (for X Prg
+      (if (atom X)
+         (prinl (eval X Ofs))
+         (eval X Ofs) ) ) )
+
+# Echo here-documents
+(de here (S)
+   (line)
+   (echo S) )
+
+# Send mail
+(de mail (Host Port From To Sub Att . Prg)
+   (let? S (connect Host Port)
+      (let B (pack "==" (date) "-" (time T) "==")
+         (prog1
+            (and
+               (pre? "220 " (in S (line T)))
+               (out S (prinl "HELO " (cdr (member "@" (chop From))) "^M"))
+               (pre? "250 " (in S (line T)))
+               (out S (prinl "MAIL FROM:" From "^M"))
+               (pre? "250 " (in S (line T)))
+               (if (atom To)
+                  (_rcpt To)
+                  (find bool (mapcar _rcpt To)) )
+               (out S (prinl "DATA^M"))
+               (pre? "354 " (in S (line T)))
+               (out S
+                  (prinl "From: " From "^M")
+                  (prinl "To: " (or (fin To) (glue "," To)) "^M")
+                  (prinl "Subject: " Sub "^M")
+                  (prinl "User-Agent: PicoLisp^M")
+                  (prinl "MIME-Version: 1.0^M")
+                  (when Att
+                     (prinl "Content-Type: multipart/mixed; boundary=\"" B "\"^M")
+                     (prinl "^M")
+                     (prinl "--" B "^M") )
+                  (prinl "Content-Type: text/plain; charset=utf-8^M")
+                  (prinl "Content-Transfer-Encoding: 8bit^M")
+                  (prinl "^M")
+                  (prEval Prg 2)
+                  (prinl "^M")
+                  (when Att
+                     (loop
+                        (prinl "--" B "^M")
+                        (prinl
+                           "Content-Type: "
+                           (or (caddr Att) "application/octet-stream")
+                           "; name=\""
+                           (cadr Att)
+                           "\"^M" )
+                        (prinl "Content-Transfer-Encoding: base64^M")
+                        (prinl "^M")
+                        (in (car Att)
+                           (while
+                              (do 15
+                                 (NIL (ext:Base64 (rd 1) (rd 1) (rd 1)))
+                                 T )
+                              (prinl) ) )
+                        (prinl)
+                        (prinl "^M")
+                        (NIL (setq Att (cdddr Att))) )
+                     (prinl "--" B "--^M") )
+                  (prinl ".^M")
+                  (prinl "QUIT^M") )
+               T )
+            (close S) ) ) ) )
+
+(de _rcpt (To)
+   (out S (prinl "RCPT TO:" To "^M"))
+   (pre? "250 " (in S (line T))) )
+
+### Testing ###
+(de test (Pat . Prg)
+   (bind (fish pat? Pat)
+      (unless (match Pat (run Prg 1))
+         (msg Prg)
+         (quit 'fail Pat) ) ) )
+
+# vi:et:ts=3:sw=3
diff --git a/lib/native.l b/lib/native.l
@@ -0,0 +1,23 @@
+# 19feb10abu
+# (c) Software Lab. Alexander Burger
+
+(de gcc (Nm L . Lst)
+   (out (tmp Nm ".c") (here "/**/"))
+   ~(case *OS
+      (("Linux" "FreeBSD")
+         (quote
+            (apply call L 'gcc "-o" (tmp Nm)
+               "-fPIC" "-shared" "-export-dynamic"
+               "-O" "-falign-functions" "-fomit-frame-pointer"
+               "-W" "-Wimplicit" "-Wreturn-type" "-Wunused" "-Wformat"
+               "-Wuninitialized" "-Wstrict-prototypes"
+               "-pipe" "-D_GNU_SOURCE" (tmp Nm ".c") ) ) ) )
+   (for L Lst
+      (def (car L)
+         (list
+            (cadr L)
+            (cons 'native (tmp Nm) (name (caddr L)) (cdddr L)) ) )
+      (when (== '@ (fin (cadr L)))
+         (push (cdaar L) 'pass) ) ) )
+
+# vi:et:ts=3:sw=3
diff --git a/lib/pilog.l b/lib/pilog.l
@@ -0,0 +1,550 @@
+# 28jan10abu
+# (c) Software Lab. Alexander Burger
+
+# *Rule
+
+(de be CL
+   (with (car CL)
+      (if (== *Rule This)
+         (=: T (conc (: T) (cons (cdr CL))))
+         (=: T (cons (cdr CL)))
+         (setq *Rule This) )
+      This ) )
+
+(de repeat ()
+   (conc (get *Rule T) (get *Rule T)) )
+
+(de asserta (CL)
+   (with (car CL)
+      (=: T (cons (cdr CL) (: T))) ) )
+
+(de assertz (CL)
+   (with (car CL)
+      (=: T (conc (: T) (cons (cdr CL)))) ) )
+
+(de retract (X)
+   (if (sym? X)
+      (put X T)
+      (put (car X) T
+         (delete (cdr X) (get (car X) T)) ) ) )
+
+(de rules @
+   (while (args)
+      (let S (next)
+         (for ((N . L) (get S T) L)
+            (prin N " (be ")
+            (print S)
+            (for X (pop 'L)
+               (space)
+               (print X) )
+            (prinl ")")
+            (T (== L (get S T))
+               (println '(repeat)) ) )
+         S ) ) )
+
+### Pilog Interpreter ###
+(de goal ("CL" . @)
+   (let "Env" '(T)
+      (while (args)
+         (push '"Env"
+            (cons (cons 0 (next)) 1 (next)) ) )
+      (while (and "CL" (pat? (car "CL")))
+         (push '"Env"
+            (cons
+               (cons 0 (pop '"CL"))
+               (cons 1 (eval (pop '"CL"))) ) ) )
+      (cons
+         (cons
+            (conc (list 1 (0) NIL "CL" NIL) "Env") ) ) ) )
+
+(de fail ()
+   (goal '((NIL))) )
+
+(de pilog ("CL" . "Prg")
+   (for ("Q" (goal "CL") (prove "Q"))
+      (bind @ (run "Prg")) ) )
+
+(de solve ("CL" . "Prg")
+   (make
+      (if "Prg"
+         (for ("Q" (goal "CL") (prove "Q"))
+            (link (bind @ (run "Prg"))) )
+         (for ("Q" (goal "CL") (prove "Q"))
+            (link @) ) ) ) )
+
+(de query ("Q" "Dbg")
+   (use "R"
+      (loop
+         (NIL (prove "Q" "Dbg"))
+         (T (=T (setq "R" @)) T)
+         (for X "R"
+            (space)
+            (print (car X))
+            (print '=)
+            (print (cdr X))
+            (flush) )
+         (T (line)) ) ) )
+
+(de ? "CL"
+   (let "L"
+      (make
+         (while (nor (pat? (car "CL")) (lst? (car "CL")))
+            (link (pop '"CL")) ) )
+      (query (goal "CL") "L") ) )
+
+### Basic Rules ###
+(be repeat)
+(repeat)
+
+(be true)
+
+(be not @P (1 -> @P) T (fail))
+(be not @P)
+
+(be call @P
+   (2 cons (-> @P)) )
+
+(be or @L (@C box (-> @L)) (_or @C))
+
+(be _or (@C) (3 pop (-> @C)))
+(be _or (@C) (@ not (val (-> @C))) T (fail))
+(repeat)
+
+(be nil (@X) (@ not (-> @X)))
+
+(be equal (@X @X))
+
+(be different (@X @X) T (fail))
+(be different (@ @))
+
+(be append (NIL @X @X))
+(be append ((@A . @X) @Y (@A . @Z)) (append @X @Y @Z))
+
+(be member (@X (@X . @)))
+(be member (@X (@ . @Y)) (member @X @Y))
+
+(be delete (@A (@A . @Z) @Z))
+(be delete (@A (@X . @Y) (@X . @Z))
+   (delete @A @Y @Z) )
+
+(be permute ((@X) (@X)))
+(be permute (@L (@X . @Y))
+   (delete @X @L @D)
+   (permute @D @Y) )
+
+(be uniq (@B @X)
+   (@ not (idx (-> @B) (-> @X) T)) )
+
+(be asserta (@C) (@ asserta (-> @C)))
+
+(be assertz (@C) (@ assertz (-> @C)))
+
+(be retract (@C)
+   (2 cons (-> @C))
+   (@ retract (list (car (-> @C)) (cdr (-> @C)))) )
+
+(be clause ("@H" "@B")
+   ("@A" get (-> "@H") T)
+   (member "@B" "@A") )
+
+(be show (@X) (@ show (-> @X)))
+
+### DB ###
+(de initQuery (Var Cls Hook Val)
+   (let (Tree (tree Var Cls Hook)  Rel (get Cls Var))
+      (when (find '((B) (isa '+index B)) (get Rel 'bag))
+         (setq Rel @) )
+      (cond
+         ((pair Val)
+            (cond
+               ((pair (cdr Val))
+                  (cond
+                     ((not (; Rel aux)) (quit "No Aux"))
+                     ((atom (car Val))
+                        (init Tree Val (append Val T)) )
+                     ((>= (cdr Val) (car Val))
+                        (init Tree (car Val) (append (cdr Val) T)) )
+                     (T (init Tree (append (car Val) T) (cdr Val))) ) )
+               ((isa '+Key Rel)
+                  (init Tree (car Val) (cdr Val)) )
+               ((>= (cdr Val) (car Val))
+                  (init Tree
+                     (cons (car Val))
+                     (cons (cdr Val) T) ) )
+               (T
+                  (init Tree
+                     (cons (car Val) T)
+                     (cons (cdr Val)) ) ) ) )
+         ((or (num? Val) (ext? Val))
+            (if (isa '+Key Rel)
+               (init Tree Val Val)
+               (init Tree (cons Val) (cons Val T)) ) )
+         ((=T Val) (init Tree))
+         ((isa '+Key Rel)
+            (init Tree Val (pack Val `(char T))) )
+         ((isa '+Idx Rel)
+            (let Q (init Tree (cons Val) (cons (pack Val `(char T)) T))
+               (if (cdr Q)
+                  Q
+                  (setq Val (pack (car (split (chop Val) " "))))
+                  (init Tree (cons Val) (cons (pack Val `(char T)) T)) ) ) )
+         (T (init Tree (cons Val) (cons (pack Val `(char T)) T))) ) ) )
+
+# (db var cls obj)
+(be db (@Var @Cls @Obj)
+   (@Q box
+      (with (or (get (-> @Cls) (-> @Var)) (meta (-> @Cls) (-> @Var)))
+         (initQuery (: var) (: cls) NIL '(NIL . T)) ) )
+   (_db @Obj) )
+
+# (db var cls hook|val obj)
+(be db (@Var @Cls @X @Obj)
+   (@Q box
+      (with (or (get (-> @Cls) (-> @Var)) (meta (-> @Cls) (-> @Var)))
+         (cond
+            ((: hook)
+               (initQuery (: var) (: cls) (-> @X) '(NIL . T)) )
+            ((isa '+Fold This)
+               (initQuery (: var) (: cls) NIL (fold (-> @X))) )
+            (T
+               (initQuery (: var) (: cls) NIL (-> @X)) ) ) ) )
+   (_db @Obj) )
+
+# (db var cls hook val obj)
+(be db (@Var @Cls @Hook @Val @Obj)
+   (@Q box
+      (with (or (get (-> @Cls) (-> @Var)) (meta (-> @Cls) (-> @Var)))
+         (initQuery (: var) (: cls) (-> @Hook)
+            (if (isa '+Fold This)
+               (fold (-> @Val))
+               (-> @Val) ) ) ) )
+   (_db @Obj) )
+
+(be _db (@Obj)
+   (@ let (Q (val (-> @Q 2))  Cls (-> @Cls 2))
+      (loop
+         (NIL (step Q (= '(NIL) (caaar Q))) T)
+         (T (isa Cls (setq "R" @))) ) )
+   T
+   (fail) )
+
+(be _db (@Obj) (@Obj . "R"))
+
+(repeat)
+
+
+(be val (@V . @L)
+   (@V apply get (-> @L))
+   T )
+
+(be lst (@V . @L)
+   (@Lst box (apply get (-> @L)))
+   (_lst @V @Lst) )
+
+(be _lst (@Val @Lst) (@ not (val (-> @Lst))) T (fail))
+(be _lst (@Val @Lst) (@Val pop (-> @Lst)))
+(repeat)
+
+(be map (@V . @L)
+   (@Lst box (apply get (-> @L)))
+   (_map @V @Lst) )
+
+(be _map (@Val @Lst) (@ not (val (-> @Lst))) T (fail))
+(be _map (@Val @Lst) (@Val prog1 (val (-> @Lst)) (pop (-> @Lst))))
+(repeat)
+
+
+(be isa (@Typ . @L)
+   (@ or
+      (not (-> @Typ))
+      (isa (-> @Typ) (apply get (-> @L))) ) )
+
+(be same (@V . @L)
+   (@ let V (-> @V)
+      (or
+         (not V)
+         (let L (-> @L)
+            ("same" (car L) (cdr L)) ) ) ) )
+
+(de "same" (X L)
+   (cond
+      ((not L)
+         (if (atom X)
+            (= V X)
+            (member V X) ) )
+      ((atom X)
+         ("same" (get X (car L)) (cdr L)) )
+      ((atom (car L))
+         (pick
+            '((Y) ("same" (get Y (car L)) (cdr L)))
+            X ) )
+      (T ("same" (apply get (car L) X) (cdr L))) ) )
+
+(be bool (@F . @L)
+   (@ or
+      (not (-> @F))
+      (apply get (-> @L)) ) )
+
+(be range (@N . @L)
+   (@ let N (-> @N)
+      (or
+         (not N)
+         (let L (-> @L)
+            ("range" (car L) (cdr L)) ) ) ) )
+
+(de "range" (X L)
+   (cond
+      ((not L)
+         (if (atom X)
+            (or
+               (<= (car N) X (cdr N))
+               (>= (car N) X (cdr N)) )
+            (find
+               '((Y)
+                  (or
+                     (<= (car N) Y (cdr N))
+                     (>= (car N) Y (cdr N)) ) )
+               X ) ) )
+      ((atom X)
+         ("range" (get X (car L)) (cdr L)) )
+      ((atom (car L))
+         (pick
+            '((Y) ("range" (get Y (car L)) (cdr L)))
+            X ) )
+      (T ("range" (apply get (car L) X) (cdr L))) ) )
+
+(be head (@S . @L)
+   (@ let S (-> @S)
+      (or
+         (not S)
+         (let L (-> @L)
+            ("head" (car L) (cdr L)) ) ) ) )
+
+(de "head" (X L)
+   (cond
+      ((not L)
+         (if (atom X)
+            (pre? S X)
+            (find '((Y) (pre? S Y)) X) ) )
+      ((atom X)
+         ("head" (get X (car L)) (cdr L)) )
+      ((atom (car L))
+         (pick
+            '((Y) ("head" (get Y (car L)) (cdr L)))
+            X ) )
+      (T ("head" (apply get (car L) X) (cdr L))) ) )
+
+(be fold (@S . @L)
+   (@ let S (-> @S)
+      (or
+         (not S)
+         (let L (-> @L)
+            ("fold" (car L) (cdr L)) ) ) ) )
+
+(de "fold" (X L)
+   (cond
+      ((not L)
+         (let P (fold S)
+            (if (atom X)
+               (pre? P (fold X))
+               (find '((Y) (pre? P (fold Y))) X) ) ) )
+      ((atom X)
+         ("fold" (get X (car L)) (cdr L)) )
+      ((atom (car L))
+         (pick
+            '((Y) ("fold" (get Y (car L)) (cdr L)))
+            X ) )
+      (T ("fold" (apply get (car L) X) (cdr L))) ) )
+
+(be part (@S . @L)
+   (@ let S (-> @S)
+      (or
+         (not S)
+         (let L (-> @L)
+            ("part" (car L) (cdr L)) ) ) ) )
+
+(de "part" (X L)
+   (cond
+      ((not L)
+         (let P (fold S)
+            (if (atom X)
+               (sub? P (fold X))
+               (find '((Y) (sub? P (fold Y))) X) ) ) )
+      ((atom X)
+         ("part" (get X (car L)) (cdr L)) )
+      ((atom (car L))
+         (pick
+            '((Y) ("part" (get Y (car L)) (cdr L)))
+            X ) )
+      (T ("part" (apply get (car L) X) (cdr L))) ) )
+
+(be tolr (@S . @L)
+   (@ let S (-> @S)
+      (or
+         (not S)
+         (let L (-> @L)
+            ("tolr" (car L) (cdr L)) ) ) ) )
+
+(de "tolr" (X L)
+   (cond
+      ((not L)
+         (if (atom X)
+            (or (sub? S X) (pre? (ext:Snx S) (ext:Snx X)))
+            (let P (ext:Snx S)
+               (find
+                  '((Y)
+                     (or (sub? S Y) (pre? P (ext:Snx Y))) )
+                  X ) ) ) )
+      ((atom X)
+         ("tolr" (get X (car L)) (cdr L)) )
+      ((atom (car L))
+         (pick
+            '((Y) ("tolr" (get Y (car L)) (cdr L)))
+            X ) )
+      (T ("tolr" (apply get (car L) X) (cdr L))) ) )
+
+
+(de "select" (Lst Flg)
+   (let? X
+      (nond
+         ((atom (car Lst))
+            (make
+               (for (L (pop 'Lst) L)
+                  (let
+                     (Var (pop 'L)
+                        Cls (pop 'L)
+                        Hook (and (get Cls Var 'hook) (pop 'L))
+                        Val (pop 'L) )
+                     (and (or Val Flg) (chain ("initSel"))) ) ) ) )
+         ((pat? (car Lst))
+            (let
+               (Var (pop 'Lst)
+                  Cls (pop 'Lst)
+                  Hook (and (get Cls Var 'hook) (pop 'Lst))
+                  Val (pop 'Lst) )
+               (and (or Val Flg) ("initSel")) ) )
+         (NIL
+            (let (Var (pop 'Lst) Val (pop 'Lst))
+               (and
+                  (or Flg (apply or Val))
+                  (cons Var (goal (pop 'Lst))) ) ) ) )
+      (cons
+         (cons
+            (for (L NIL Lst)
+               (push 'L (pop 'Lst) NIL)
+                L )
+            X ) ) ) )
+
+(de "initSel" ()
+   (with (treeRel Var Cls)
+      (cond
+         ((isa '+Fold This)
+            (initQuery Var (: cls) Hook (fold Val)) )
+         ((isa '+Sn This)
+            (conc
+               (initQuery Var (: cls) Hook Val)
+               (initQuery Var (: cls) Hook (ext:Snx Val)) ) )
+         (T (initQuery Var (: cls) Hook Val)) ) ) )
+
+(de _gen (Lst Q)
+   (cond
+      (Lst
+         (use X
+            (loop
+               (T
+                  (cond
+                     ((atom (car Lst))
+                        (prog1 (car Lst) (set Lst)) )
+                     ((atom (caar Lst)) (pop Lst))
+                     (T
+                        (prog1
+                           (step (car Lst) (= '(NIL) (caar (caar Lst))))
+                           (or (cdaar Lst) (set Lst)) ) ) )
+                  @ )
+               (NIL (setq X (_gen (cddr Lst) Q)))
+               (set Lst
+                  (let Y (cadr Lst)
+                     (cond
+                        ((atom Y) (get X Y))
+                        ((=T (caddr Y))
+                           (initQuery (car Y) (cadr Y) X (cadddr Y)) )  # X = Hook
+                        (T
+                           (initQuery
+                              (car Y)
+                              (cadr Y)
+                              (caddr Y)
+                              (if (cadddr Y)
+                                 (cons
+                                    (cons X (car @))
+                                    (cons X (cdr @)) )
+                                 X ) ) ) ) ) ) ) ) )
+      ((pat? (car Q)) (get (prove (cdr Q)) @))
+      (T (step Q (= '(NIL) (caaar Q)))) ) )
+
+(be select (("@Obj" . "@X") . "@Lst")
+   (@ unify (-> "@X"))
+   ("@P" box (cdr (-> "@Lst")))
+   ("@C" box  # ((obj ..) curr . lst)
+      (let L (car (-> "@Lst"))
+         (setq L
+            (or
+               (mapcan "select" L)
+               ("select" (car L) T) ) )
+         (cons NIL L L) ) )
+   (_gen "@Obj")
+   (_sel) )
+
+(be _gen (@Obj)
+   (@ let C (caadr (val (-> "@C" 2)))
+      (not (setq "*R" (_gen (car C) (cdr C)))) )
+   T
+   (fail) )
+
+(be _gen (@Obj) (@Obj . "*R"))
+
+(repeat)
+
+(be _sel ()
+   (2 val (-> "@P" 2))
+   (@ let C (val (-> "@C" 2))
+      (unless (idx C "*R" T)
+         (rot (cddr C) (offset (cadr C) (cddr C)))
+         (set (cdr C) (cddr C)) ) )
+   T )
+
+(be _sel ()
+   (@ let C (cdr (val (-> "@C" 2)))
+      (set C (or (cdar C) (cdr C))) )
+   (fail) )
+
+### Remote queries ###
+(de rqry Args
+   (for (Q (goal (cdr Args)) (prove Q))
+      (pr (get @ (car Args)))
+      (NIL (flush)) )
+   (bye) )
+
+(be remote ("@Lst" . "@CL")
+   (@Sockets box
+      (prog1 (cdr (-> "@Lst"))
+         (for X @  # (out . in)
+            ((car X)
+               (cons 'rqry (car (-> "@Lst")) (-> "@CL")) ) ) ) )
+   (@ unify (car (-> "@Lst")))
+   (_remote "@Lst") )
+
+(be _remote ((@Obj . @))
+   (@ not (val (-> @Sockets 2)))
+   T
+   (fail) )
+
+(be _remote ((@Obj . @))
+   (@Obj let (Box (-> @Sockets 2)  Lst (val Box))
+      (rot Lst)
+      (loop
+         (T ((cdar Lst)) @)
+         (NIL (set Box (setq Lst (cdr Lst)))) ) ) )
+
+(repeat)
+
+# vi:et:ts=3:sw=3
diff --git a/lib/prof.l b/lib/prof.l
@@ -0,0 +1,51 @@
+# 15may07abu
+# (c) Software Lab. Alexander Burger
+
+# *Profile
+
+(de _prf? (Lst)
+   (and (pair Lst) (== 'tick (caadr Lst))) )
+
+(de _prf (Lst)
+   (when (pair Lst)
+      (if (_prf? Lst)
+         (prog1
+            (cadr (cadr Lst))
+            (set (cdadr Lst) (cons (+ 0) (+ 0))) )
+         (con
+            Lst
+            (list (cons 'tick (cons (+ 0) (+ 0)) (cdr Lst))) )
+         T ) ) )
+
+(de "uprf" (Lst)
+   (when (_prf? Lst)
+      (con Lst (cddr (cadr Lst)))
+      T ) )
+
+(de prof ("X" "C")
+   (when (pair "X")
+      (setq  "C" (cdr "X")  "X" (car "X")) )
+   (and (not "C") (num? (getd "X")) (expr "X"))
+   (unless
+      (and
+         (_prf (if "C" (method "X" "C") (getd "X")))
+         (push1 '*Profile (cons "X" "C")) )
+      (quit "Can't profile" "X") ) )
+
+(de unprof ("X" "C")
+   (del (cons "X" "C") '*Profile)
+   ("uprf" (if "C" (method "X" "C") (getd "X"))) )
+
+(de profile ()
+   (mapc println
+      (flip
+         (by '((X) (+ (car X) (cadr X))) sort
+            (mapcar
+               '(("X")
+                  (let P
+                     (_prf
+                        (if (cdr "X")
+                           (method (car "X") (cdr "X"))
+                           (getd (car "X")) ) )
+                     (cons (car P) (cdr P) "X") ) )
+               *Profile ) ) ) ) )
diff --git a/lib/ps.l b/lib/ps.l
@@ -0,0 +1,318 @@
+# 12nov09abu
+# (c) Software Lab. Alexander Burger
+
+# "*Glyph" "*PgX" "*PgY"
+# "*DX" "*DY" "*Pos" "*Fonts" "*Size" "*Font" "*Pag" "*Lim" "*FF" "*UL"
+
+(once
+   (balance '"*Glyph"
+      (sort
+         (make
+            (in "@lib/glyphlist.txt"
+               (use (L C)
+                  (while (setq L (line))
+                     (unless (or (= "#" (car L)) (member " " L))
+                        (setq
+                           L (split L ";")
+                           C (char (hex (pack (cadr L)))) )
+                        (set (link C) (pack (car L))) ) ) ) ) ) ) ) )
+
+(de glyph (C)
+   (val (car (idx '"*Glyph" C))) )
+
+(de pdf (Nm . Prg)
+   (let (Ps (tmp Nm ".ps")  Pdf (tmp Nm ".pdf"))
+      (out Ps (run Prg 1))
+      (_pdf)
+      Pdf ) )
+
+(de psOut (How Nm . Prg)
+   (ifn Nm
+      (out (list "lpr" (pack "-P" How)) (run Prg 1))
+      (let (Ps (tmp Nm ".ps")  Pdf (tmp Nm ".pdf"))
+         (out Ps (run Prg 1))
+         (cond
+            ((not How) (_pdf) (url Pdf "PDF"))
+            ((=0 How) (_pdf) (url Pdf))
+            ((=T How) (_pdf) (httpEcho Pdf "application/pdf" 1))
+            ((fun? How) (How Ps) (_pdf))
+            (T (call 'lpr (pack "-P" How) Ps) (_pdf)) )
+         Pdf ) ) )
+
+(de _pdf ()
+   (if (= *OS "Darwin")
+      (call 'pstopdf Ps)
+      (call 'ps2pdf
+         (pack "-dDEVICEWIDTHPOINTS=" "*PgX")
+         (pack "-dDEVICEHEIGHTPOINTS=" "*PgY")
+         Ps Pdf ) ) )
+
+(de psHead (DX DY)
+   (prinl "%!PS-Adobe-1.0")
+   (prinl "%%Creator: PicoLisp")
+   (prinl "%%BoundingBox: 0 0 "
+      (setq "*DX" DX "*PgX" DX) " "
+      (setq "*DY" DY "*PgY" DY) )
+   (in "@lib/head.ps" (echo))
+   (zero "*Pos")
+   (off "*Fonts" "*Lim" "*UL")
+   (setq "*Size" 12) )
+
+(de a4 ()
+   (psHead 595 842) )
+
+(de a4L ()
+   (psHead 842 595) )
+
+(de a5 ()
+   (psHead 420 595) )
+
+(de a5L ()
+   (psHead 595 420) )
+
+(de _font ()
+   (prinl "/" "*Font" " findfont  " "*Size" " scalefont  setfont") )
+
+(de font ("F" . "Prg")
+   (use "N"
+      (cond
+         ((pair "F")
+            (setq "N" (pop '"F")) )
+         ((num? "F")
+            (setq "N" "F"  "F" "*Font") )
+         (T (setq "N" "*Size")) )
+      (unless (member "F" "*Fonts")
+         (push '"*Fonts" "F")
+         (prinl "/" "F" " isoLatin1 def") )
+      (ifn "Prg"
+         (setq "*Size" "N"  "*Font" "F")
+         (let ("*Size" "N" "*Font" "F")
+            (_font)
+            (psEval "Prg") ) ) )
+   (_font) )
+
+(de bold "Prg"
+   (let "*Font" (pack "*Font" "-Bold")
+      (_font)
+      (psEval "Prg") )
+   (_font) )
+
+(de width ("N" . "Prg")
+   (and "Prg" (prinl "currentlinewidth"))
+   (prinl "N" " setlinewidth")
+   (when "Prg"
+      (psEval "Prg")
+      (prinl "setlinewidth") ) )
+
+(de gray ("N" . "Prg")
+   (and "Prg" (prinl "currentgray"))
+   (prinl (- 100 "N") " 100 div setgray")
+   (when "Prg"
+      (psEval "Prg")
+      (prinl "setgray") ) )
+
+(de color ("R" "G" "B" . "Prg")
+   (and "Prg" (prinl "currentrgbcolor"))
+   (prinl "R" " 100 div " "G" " 100 div " "B" " 100 div setrgbcolor")
+   (when "Prg"
+      (psEval "Prg")
+      (prinl "setrgbcolor") ) )
+
+(de poly (F X Y . @)
+   (prin "newpath " X " " (- "*PgY" Y) " moveto  ")
+   (while (args)
+      (if (pair (next))
+         (for P (arg)
+            (prin (car P) " " (- "*PgY" (cdr P)) " lineto  ") )
+         (prin (arg) " " (- "*PgY" (next)) " lineto  ") ) )
+   (prinl (if F "fill" "stroke")) )
+
+(de rect (X1 Y1 X2 Y2 F)
+   (poly F X1 Y1  X2 Y1  X2 Y2  X1 Y2  X1 Y1) )
+
+(de arc (X Y R F A B)
+   (prinl
+      "newpath "
+      X " " (- "*PgY" Y) " " R " "
+      (or A 0) " "
+      (or B 360) " arc "
+      (if F "fill" "stroke") ) )
+
+(de ellipse (X Y DX DY F A B)
+   (prinl "matrix currentmatrix")
+   (prinl
+      "newpath "
+      X " " (- "*PgY" Y) " translate "
+      DX " " DY " scale 0 0 1 "
+      (or A 0) " "
+      (or B 360) " arc" )
+   (prinl "setmatrix " (if F "fill" "stroke")) )
+
+
+(de indent (X DX)
+   (prinl X " 0 translate")
+   (dec '"*DX" X)
+   (and DX (dec '"*DX" DX)) )
+
+(de window ("*X" "*Y" "*DX" "*DY" . "Prg")
+   ("?ff")
+   (prinl "gsave")
+   (prinl "*X" " " (- "*Y") " translate")
+   (let "*Pos" 0
+      (psEval "Prg") )
+   (prinl "grestore") )
+
+(de ?ps ("X" "H" "V")
+   (and "X" (ps "X" "H" "V")) )
+
+(de ps ("X" "H" "V")
+   (cond
+      ((not "X") (inc '"*Pos" "*Size"))
+      ((num? "X") (_ps (chop "X")))
+      ((pair "X") (_ps "X"))
+      (T (mapc _ps (split (chop "X") "^J"))) ) )
+
+(de ps+ ("X")
+   (fmtPs (chop "X"))
+   (?ul1)
+   (prinl " glyphArrayShow")
+   (?ul2) )
+
+(de _ps ("L")
+   ("?ff")
+   (fmtPs "L")
+   (ifn "H"
+      (prin " 0")
+      (prin " dup glyphArrayWidth " "*DX" " exch sub")
+      (and (=0 "H") (prin " 2 div")) )
+   (prin
+      " "
+      (-
+         "*PgY"
+         (cond
+            ((not "V")
+               (inc '"*Pos" "*Size") )
+            ((=0 "V")
+               (setq "*Pos" (+ (/ "*Size" 4) (/ "*DY" 2))) )
+            (T (setq "*Pos" "*DY")) ) ) )
+   (prin " moveto")
+   (?ul1)
+   (prinl " glyphArrayShow")
+   (?ul2) )
+
+(de escPs (C)
+   (and (sub? C "\\()") (prin "\\"))
+   (prin C) )
+
+(de fmtPs (Lst)
+   (prin "[")
+   (while Lst
+      (if (>= (car Lst) `(char 128))
+         (prin "/" (or (glyph (pop 'Lst)) ".notdef"))
+         (prin "(")
+         (escPs (pop 'Lst))
+         (while (and Lst (>= `(char 127) (car Lst)))
+            (escPs (pop 'Lst)) )
+         (prin ")") )
+      (and Lst (space)) )
+   (prin "]") )
+
+(de ?ul1 ()
+   (and "*UL" (prin " currentpoint " "*UL" " sub 3 -1 roll")) )
+
+(de ?ul2 ()
+   (when "*UL"
+      (prinl "currentpoint " "*UL" " sub")
+      (prinl "gsave  newpath 4 -2 roll moveto lineto stroke grestore") ) )
+
+(de pos (N)
+   (if N (+ N "*Pos") "*Pos") )
+
+(de down (N)
+   (inc '"*Pos" (or N "*Size")) )
+
+(de table ("Lst" . "Prg")  #> Y
+   ("?ff")
+   (let ("PosX" 0  "Max" "*Size")
+      (mapc
+         '(("N" "X")
+            (window "PosX" "*Pos" "N" "Max"
+               (if (atom "X") (ps (eval "X")) (eval "X"))
+               (inc '"PosX" "N")
+               (setq "Max" (max "*Pos" "Max")) ) )
+         "Lst"
+         "Prg" )
+      (inc '"*Pos" "Max") ) )
+
+(de underline ("*UL" . "Prg")
+   (psEval "Prg") )
+
+(de hline (Y X2 X1)
+   (inc 'Y "*Pos")
+   (poly NIL (or X2 "*DX") Y (or X1 0) Y) )
+
+(de vline (X Y2 Y1)
+   (poly NIL X (or Y2 "*DY") X (or Y1 0)) )
+
+(de border (Y)
+   (rect 0 (or Y 0) "*DX" "*Pos") )
+
+(de psEval ("Prg")
+   (while "Prg"
+      (if (atom (car "Prg"))
+         (ps (eval (pop '"Prg")))
+         (eval (pop '"Prg")) ) ) )
+
+(de page (Flg)
+   (when (=T Flg)
+      (prinl "gsave") )
+   (prinl "showpage")
+   (zero "*Pos")
+   (cond
+      ((=T Flg)
+         (prinl "grestore") )
+      ((=0 Flg)
+         (setq "*DX" "*PgX"  "*DY" "*PgY"  "*Lim") )
+      (T (prin "%%DocumentFonts:")
+         (while "*Fonts"
+            (prin " " (pop '"*Fonts")) )
+         (prinl)
+         (prinl "%%EOF") ) ) )
+
+(de pages (Lst . Prg)
+   (setq "*Pag" Lst  "*Lim" (pop '"*Pag")  "*FF" Prg) )
+
+(de "?ff" ()
+   (when (and "*Lim" (>= "*Pos" "*Lim"))
+      (off "*Lim")
+      (run "*FF")
+      (setq "*Lim" (pop '"*Pag")) ) )
+
+(de noff "Prg"
+   (let "*Lim" NIL
+      (psEval "Prg") ) )
+
+(de eps (Eps X Y DX DY)
+   (prinl "gsave " (or X 0) " " (- "*PgY" (or Y 0)) " translate")
+   (when DX
+      (prinl DX " 100. div " (or DY DX) " 100. div scale") )
+   (in Eps (echo))
+   (prinl "grestore") )
+
+(====)
+
+(de brief ("F" "Fnt" "Abs" . "Prg")
+   (when "F"
+      (poly NIL 10 265  19 265)           # Faltmarken
+      (poly NIL 10 421  19 421) )
+   (poly NIL 50 106  50 103  53 103)      # Fenstermarken
+   (poly NIL 50 222  50 225  53 225)
+   (poly NIL 288 103  291 103  291 106)
+   (poly NIL 288 225  291 225  291 222)
+   (poly NIL 50 114  291 114)             # Absender
+   (window 60 102 220 10
+      (font "Fnt" (ps "Abs" 0)) )
+   (window 65 125 210 90
+      (psEval "Prg") ) )
+
+# vi:et:ts=3:sw=3
diff --git a/lib/readline.l b/lib/readline.l
@@ -0,0 +1,28 @@
+# 05dec08abu
+# (c) Software Lab. Alexander Burger
+
+(load "@lib/gcc.l")
+
+(gcc "readline" '("-lreadline") '_led)
+
+#include <readline/readline.h>
+#include <readline/history.h>
+
+any _led(any ex __attribute__((unused))) {
+   char *p;
+   any x;
+
+   rl_already_prompted = YES;
+   if ((p = readline(": ")) && *p)
+      add_history(p);
+   x = mkStr(p);
+   free(p);
+   return x;
+}
+
+/**/
+
+# Enable line editing
+(de *Led (_led))
+
+# vi:et:ts=3:sw=3
diff --git a/lib/rsa.l b/lib/rsa.l
@@ -0,0 +1,109 @@
+# 10nov04abu
+# (c) Software Lab. Alexander Burger
+
+# *InND
+
+# Generate long random number
+(de longRand (N)
+   (use (R D)
+      (while (=0 (setq R (abs (rand)))))
+      (until (> R N)
+         (unless (=0 (setq D (abs (rand))))
+            (setq R (* R D)) ) )
+      (% R N) ) )
+
+# X power Y modulus N
+(de **Mod (X Y N)
+   (let M 1
+      (loop
+         (when (bit? 1 Y)
+            (setq M (% (* M X) N)) )
+         (T (=0 (setq Y (>> 1 Y)))
+            M )
+         (setq X (% (* X X) N)) ) ) )
+
+# Probabilistic prime check
+(de prime? (N)
+   (and
+      (> N 1)
+      (bit? 1 N)
+      (let (Q (dec N)  K 0)
+         (until (bit? 1 Q)
+            (setq
+               Q  (>> 1 Q)
+               K  (inc K) ) )
+         (do 50
+            (NIL (_prim? N Q K))
+            T ) ) ) )
+
+# (Knuth Vol.2, p.379)
+(de _prim? (N Q K)
+   (use (X J Y)
+      (while (> 2 (setq X (longRand N))))
+      (setq
+         J 0
+         Y (**Mod X Q N) )
+      (loop
+         (T
+            (or
+               (and (=0 J) (= 1 Y))
+               (= Y (dec N)) )
+            T )
+         (T
+            (or
+               (and (> J 0) (= 1 Y))
+               (<= K (inc 'J)) )
+            NIL )
+         (setq Y (% (* Y Y) N)) ) ) )
+
+# Find a prime number with `Len' digits
+(de prime (Len)
+   (let P (longRand (** 10 (*/ Len 2 3)))
+      (unless (bit? 1 P)
+         (inc 'P) )
+      (until (prime? P)  # P: Prime number of size 2/3 Len
+         (inc 'P 2) )
+      # R: Random number of size 1/3 Len
+      (let (R (longRand (** 10 (/ Len 3)))  K (+ R (% (- P R) 3)))
+         (when (bit? 1 K)
+            (inc 'K 3) )
+         (until (prime? (setq R (inc (* K P))))
+            (inc 'K 6) )
+         R ) ) )
+
+# Generate RSA key
+(de rsaKey (N)  #> (Encrypt . Decrypt)
+   (let (P (prime (*/ N 5 10))  Q (prime (*/ N 6 10)))
+      (cons
+         (* P Q)
+         (/
+            (inc (* 2 (dec P) (dec Q)))
+            3 ) ) ) )
+
+# Encrypt a list of characters
+(de encrypt (Key Lst)
+   (let Siz (>> 1 (size Key))
+      (make
+         (while Lst
+            (let N (char (pop 'Lst))
+               (while (> Siz (size N))
+                  (setq N (>> -16 N))
+                  (inc 'N (char (pop 'Lst))) )
+               (link (**Mod N 3 Key)) ) ) ) ) )
+
+# Decrypt a list of numbers
+(de decrypt (Keys Lst)
+   (mapcan
+      '((N)
+         (let Res NIL
+            (setq N (**Mod N (cdr Keys) (car Keys)))
+            (until (=0 N)
+               (push 'Res (char (& `(dec (** 2 16)) N)))
+               (setq N (>> 16 N)) )
+            Res ) )
+      Lst ) )
+
+# Init crypt
+(de rsa (N)
+   (seed (in "/dev/urandom" (rd 20)))
+   (setq *InND (rsaKey N)) )
diff --git a/lib/scrape.l b/lib/scrape.l
@@ -0,0 +1,160 @@
+# 08apr09abu
+# (c) Software Lab. Alexander Burger
+
+# *ScrHost *ScrPort *Title *Expect *Found
+# *Links *Forms *Buttons *Fields *Errors
+
+# Scrape HTML form(s)
+(de scrape (Host Port How)
+   (client (setq *ScrHost Host) (setq *ScrPort Port) How
+      (off *Links *Forms *Buttons *Fields *Errors)
+      (while
+         (from
+            "<title>"
+            "<base href=\"http://"
+            "<a href=\""
+            " action=\""
+            "<input type=\"submit\" name=\""
+            "<input type=\"hidden\" name=\""
+            "<input type=\"text\" name=\""
+            "<input type=\"password\" name=\""
+            "<select name=\""
+            "<option selected=\"selected\">"
+            "<textarea name=\""
+            "<span id=\""
+            "<div class=\"err\">"
+            *Expect )
+         (case @
+            ("<title>"
+               (setq *Title (ht:Pack (till "<"))) )
+            ("<base href=\"http://"
+               (setq
+                  *ScrHost (rot (cdr (rot (split (till "\"") '/ ':))))
+                  *ScrPort (format (pack (pop '*ScrHost)))
+                  *ScrHost (pack *ScrHost) ) )
+            ("<a href=\""
+               (let Url (till "\"" T)
+                  (from ">")
+                  (cond
+                     ((till "<")
+                        (queue '*Links (cons (ht:Pack @) Url)) )
+                     ((= "<img" (till " " T))
+                        (from "alt=\"")
+                        (queue '*Links (cons (ht:Pack (till "\"")) Url)) ) ) ) )
+            (" action=\""
+               (queue '*Forms (list (till "\"" T))) )  # (action . fields)
+            ("<input type=\"submit\" name=\""
+               (let Nm (till "\"" T)
+                  (from "value=\"")
+                  (queue '*Buttons  # (label field . form)
+                     (cons
+                        (ht:Pack (till "\""))
+                        (cons Nm T)
+                        (last *Forms) ) ) ) )
+            ("<input type=\"hidden\" name=\""
+               (conc (last *Forms)
+                  (cons
+                     (cons (till "\"" T)
+                        (prog (from "value=\"") (ht:Pack (till "\"")))) ) ) )
+            (("<input type=\"text\" name=\"" "<input type=\"password\" name=\"")
+               (conc (last *Forms)
+                  (cons
+                     (queue '*Fields
+                        (cons (till "\"" T)
+                           (prog (from "value=\"") (ht:Pack (till "\"")))) ) ) ) )
+            ("<select name=\""
+               (conc (last *Forms)
+                  (cons
+                     (queue '*Fields (cons (till "\"" T))) ) ) )
+            ("<option selected=\"selected\">"
+               (con (last *Fields) (ht:Pack (till "<"))) )
+            ("<textarea name=\""
+               (conc (last *Forms)
+                  (cons
+                     (queue '*Fields
+                        (cons (till "\"" T)
+                           (prog (from ">") (ht:Pack (till "<"))) ) ) ) ) )
+            ("<span id=\""
+               (from ">")
+               (queue '*Fields (ht:Pack (till "<"))) )
+            ("<div class=\"err\">"
+               (queue '*Errors (ht:Pack (till "<"))) )
+            (T  (on *Found)) ) )
+      (or *Errors *Title) ) )
+
+# Expect content
+(de expect (*Expect . "Prg")
+   (let *Found NIL
+      (run "Prg")
+      (unless *Found
+         (quit "Content not found" *Expect) ) ) )
+
+# Click on a link
+(de click (Lbl Cnt)
+   (let L (cdr (target *Links Lbl Cnt))
+      (when (pre? "http://" L)
+         (setq
+            L (split (nth (chop L) 8) '/ ':)
+            *ScrHost (pack (pop 'L))
+            *ScrPort (ifn (format (pack (car L))) 80 (pop 'L) @)
+            L (glue '/ L) ) )
+      (scrape *ScrHost *ScrPort L) ) )
+
+# Press a button
+(de press (Lbl Cnt)
+   (let B (target *Buttons Lbl Cnt)
+      (scrape *ScrHost *ScrPort
+         (cons
+            (caddr B)
+            (glue "&"
+               (mapcar
+                  '((X)
+                     (list (car X) '= (ht:Fmt (cdr X))) )
+                  (cons (cadr B) (cdddr B)) ) ) ) ) ) )
+
+# Retrieve a field's value
+(de value (Fld Cnt)
+   (fin (field Fld Cnt)) )
+
+# Set a field's value
+(de enter (Fld Str Cnt)
+   (con (field Fld Cnt) Str) )
+
+### Utilities ###
+(de display ()
+   (prinl "###############")
+   (apply println (mapcar car *Links) 'click)
+   (prinl)
+   (apply println (mapcar car *Buttons) 'press)
+   (prinl)
+   (apply println (trim (mapcar fin *Fields)) 'value)
+   (prinl)
+   *Title )
+
+(de target (Lst Lbl Cnt)
+   (cond
+      ((num? Lbl)
+         (get Lst Lbl) )
+      ((pair Lbl) Lbl)
+      (T
+         (default Cnt 1)
+         (or
+            (find
+               '((L)
+                  (and
+                     (pre? Lbl (car L))
+                     (=0 (dec 'Cnt)) ) )
+               Lst )
+            (quit "Target not found" Lbl) ) ) ) )
+
+(de field (Fld Cnt)
+   (or
+      (cond
+         ((gt0 Fld)
+            (get *Fields Fld) )
+         ((lt0 Fld)
+            (get *Fields (+ (length *Fields) Fld 1)) )
+         (T (assoc Fld (cdr (get *Forms (or Cnt 1))))) )
+      (quit "Field not found" Fld) ) )
+
+# vi:et:ts=3:sw=3
diff --git a/lib/simul.l b/lib/simul.l
@@ -0,0 +1,154 @@
+# 22mar10abu
+# (c) Software Lab. Alexander Burger
+
+(de permute (Lst)
+   (ifn (cdr Lst)
+      (cons Lst)
+      (mapcan
+         '((X)
+            (mapcar
+               '((Y) (cons X Y))
+               (permute (delete X Lst)) ) )
+         Lst ) ) )
+
+(de shuffle (Lst)
+   (make
+      (for (N (length Lst) (gt0 N))
+         (setq Lst
+            (conc
+               (cut (rand 0 (dec 'N)) 'Lst)
+               (prog (link (car Lst)) (cdr Lst)) ) ) ) ) )
+
+(de samples (Cnt Lst)
+   (make
+      (until (=0 Cnt)
+         (when (>= Cnt (rand 1 (length Lst)))
+            (link (car Lst))
+            (dec 'Cnt) )
+         (pop 'Lst) ) ) )
+
+
+# Genetic Algorithm
+(de gen ("Pop" "Cond" "Re" "Mu" "Se")
+   (until ("Cond" "Pop")
+      (for ("P" "Pop" "P" (cdr "P"))
+         (set "P"
+            (maxi "Se"  # Selection
+               (make
+                  (for ("P" "Pop" "P")
+                     (rot "P" (rand 1 (length "P")))
+                     (link  # Recombination + Mutation
+                        ("Mu" ("Re" (pop '"P") (pop '"P"))) ) ) ) ) ) ) )
+   (maxi "Se" "Pop") )
+
+
+# Alpha-Beta tree search
+(de game ("Flg" "Cnt" "Moves" "Move" "Cost")
+   (let ("Alpha" '(1000000)  "Beta" -1000000)
+      (recur ("Flg" "Cnt" "Alpha" "Beta")
+         (if (=0 (dec '"Cnt"))
+            (let? "Lst" ("Moves" "Flg")
+               (loop
+                  ("Move" (caar "Lst"))
+                  (setq "*Val" (list ("Cost" "Flg") (car "Lst")))
+                  ("Move" (cdar "Lst"))
+                  (T (>= "Beta" (car "*Val"))
+                     (cons "Beta" (car "Lst") (cdr "Alpha")) )
+                  (when (> (car "Alpha") (car "*Val"))
+                     (setq "Alpha" "*Val") )
+                  (NIL (setq "Lst" (cdr "Lst")) "Alpha") ) )
+            (let? "Lst"
+               (sort
+                  (mapcar
+                     '(("Mov")
+                        (prog2
+                           ("Move" (car "Mov"))
+                           (cons ("Cost" "Flg") "Mov")
+                           ("Move" (cdr "Mov")) ) )
+                     ("Moves" "Flg") ) )
+               (loop
+                  ("Move" (cadar "Lst"))
+                  (setq "*Val"
+                     (if (recurse (not "Flg") "Cnt" (cons (- "Beta")) (- (car "Alpha")))
+                        (cons (- (car @)) (cdar "Lst") (cdr @))
+                        (list (caar "Lst") (cdar "Lst")) ) )
+                  ("Move" (cddar "Lst"))
+                  (T (>= "Beta" (car "*Val"))
+                     (cons "Beta" (cdar "Lst") (cdr "Alpha")) )
+                  (when (> (car "Alpha") (car "*Val"))
+                     (setq "Alpha" "*Val") )
+                  (NIL (setq "Lst" (cdr "Lst")) "Alpha") ) ) ) ) ) )
+
+
+### Grids ###
+(de grid (DX DY)
+   (prog1
+      (make
+         (for X DX
+            (link
+               (make
+                  (for Y DY
+                     (link
+                        (def
+                           (if (> DX 26)
+                              (box)
+                              (intern (pack (char (+ X 96)) Y)) )
+                           (cons (cons) (cons)) ) ) ) ) ) ) )
+      (let (Lst @  West)
+         (while Lst
+            (let (East (cadr Lst)  South)
+               (for (L (car Lst) (pop 'L))
+                  (with @
+                     (and (pop 'West) (set (: 0 1) @))  # west
+                     (and (pop 'East) (con (: 0 1) @))  # east
+                     (and South (set (: 0 -1) @))       # south
+                     (and (car L) (con (: 0 -1) @))     # north
+                     (setq South This) ) ) )
+            (setq West (pop 'Lst)) ) ) ) )
+
+(de west (This)
+   (: 0 1 1) )
+
+(de east (This)
+   (: 0 1 -1) )
+
+(de south (This)
+   (: 0 -1 1) )
+
+(de north (This)
+   (: 0 -1 -1) )
+
+(de disp ("Grid" "How" "Fun" "X" "Y" "DX" "DY")
+   (setq "Grid"
+      (if "X"
+         (mapcar
+            '((L) (flip (head "DY" (nth L "Y"))))
+            (head "DX" (nth "Grid" "X")) )
+         (mapcar reverse "Grid") ) )
+   (let (N (+ (length (cdar "Grid")) (or "Y" 1))  Sp (length N))
+      ("border" north)
+      (while (caar "Grid")
+         (prin " " (align Sp N) " "
+            (and "How" (if (and (nT "How") (west (caar "Grid"))) " " '|)) )
+         (for L "Grid"
+            (prin
+               ("Fun" (car L))
+               (and "How" (if (and (nT "How") (east (car L))) " " '|)) ) )
+         (prinl)
+         ("border" south)
+         (map pop "Grid")
+         (dec 'N) )
+      (unless (> (default "X" 1) 26)
+         (space (inc Sp))
+         (for @ "Grid"
+            (prin " " (and "How" "  ") (char (+ 96 "X")))
+            (T (> (inc '"X") 26)) )
+         (prinl) ) ) )
+
+(de "border" (Dir)
+   (when "How"
+      (space Sp)
+      (prin "  +")
+      (for L "Grid"
+         (prin (if (and (nT "How") (Dir (car L))) "   +" "---+")) )
+      (prinl) ) )
diff --git a/lib/sq.l b/lib/sq.l
@@ -0,0 +1,131 @@
+# 24dec09abu
+# (c) Software Lab. Alexander Burger
+
+# (select [var ..] cls [hook|T] [var val ..])
+(de select Lst
+   (let
+      (Vars
+         (make
+            (until
+               (or
+                  (atom Lst)
+                  (and
+                     (sym? (car Lst))
+                     (= `(char "+") (char (car Lst))) ) )
+               (link (pop 'Lst)) ) )
+         Cls (pop 'Lst)
+         Hook (cond
+            ((ext? (car Lst)) (pop 'Lst))
+            ((=T (car Lst)) (pop 'Lst) *DB) ) )
+      (default Lst
+         (cons
+            (or
+               (car Vars)
+               (and
+                  (find
+                     '((X) (isa '(+Need +index) (car X)))
+                     (getl Cls) )
+                  (get (car @) 'var) )
+               (cdr
+                  (maxi caar
+                     (getl (get (or Hook *DB) Cls)) ) ) ) ) )
+      (let Q
+         (goal
+            (cons
+               (make
+                  (link
+                     'select
+                     '(@@)
+                     (make
+                        (for (L Lst L)
+                           (link
+                              (make
+                                 (link (pop 'L) Cls)
+                                 (and Hook (link Hook))
+                                 (link (if L (pop 'L) '(NIL . T))) ) ) ) ) )
+                  (while Lst
+                     (let (Var (pop 'Lst)  Val (if Lst (pop 'Lst) '(NIL . T)))
+                        (link
+                           (list
+                              (cond
+                                 ((pair Val) 'range)
+                                 ((or (num? Val) (ext? Val)) 'same)
+                                 ((=T Val) 'bool)
+                                 ((isa '+Fold (get Cls Var)) 'fold)
+                                 ((isa '+Sn (get Cls Var)) 'tolr)
+                                 (T 'head) )
+                              Val '@@ Var ) ) ) ) ) ) )
+         (use Obj
+            (loop
+               (NIL (setq Obj (cdr (asoq '@@ (prove Q)))))
+               (ifn Vars
+                  (show Obj)
+                  (for Var Vars
+                     (cond
+                        ((pair Var)
+                           (print (apply get Var Obj)) )
+                        ((meta Obj Var)
+                           (print> @ (get Obj Var)) )
+                        (T (print (get Obj Var))) )
+                     (space) )
+                  (print Obj) )
+               (T (line) Obj) ) ) ) ) )
+
+(dm (print> . +relation) (Val)
+   (print Val) )
+
+(dm (print> . +Number) (Val)
+   (prin (format Val (: scl))) )
+
+(dm (print> . +Date) (Val)
+   (print (datStr Val)) )
+
+
+# (update 'obj ['var])
+(de update (Obj Var)
+   (let *Dbg NIL
+      (printsp Obj)
+      (if Var
+         (_update (get Obj Var) Var)
+         (set!> Obj
+            (any (revise (sym (val Obj)))) )
+         (for X (getl Obj)
+            (_update (or (atom X) (pop 'X)) X) ) )
+      Obj ) )
+
+(de _update (Val Var)
+   (printsp Var)
+   (let New
+      (if (meta Obj Var)
+         (revise> @ Val)
+         (any (revise (sym Val))) )
+      (unless (= New Val)
+         (if (mis> Obj Var New)
+            (quit "mismatch" @)
+            (put!> Obj Var New) ) ) ) )
+
+
+(dm (revise> . +relation) (Val)
+   (any (revise (sym Val))) )
+
+(dm (revise> . +Bag) (Lst)
+   (mapcar
+      '((V B) (space 6) (revise> B V))
+      (any (revise (sym Lst)))
+      (: bag) ) )
+
+(dm (revise> . +Number) (Val)
+   (format
+      (revise (format Val (: scl)))
+      (: scl) ) )
+
+(dm (revise> . +Date) (Val)
+   (expDat
+      (revise
+         (datStr Val)
+         '((S) (list (datStr (expDat S)))) ) ) )
+
+(dm (revise> . +List) (Val)
+   (mapcar
+      '((X) (space 3) (extra X))
+      (any (revise (sym Val))) ) )
diff --git a/lib/tags b/lib/tags
@@ -0,0 +1,346 @@
+! (2560 . "@src64/flow.l")
+$ (2662 . "@src64/flow.l")
+% (2238 . "@src64/big.l")
+& (2459 . "@src64/big.l")
+* (2057 . "@src64/big.l")
+*/ (2114 . "@src64/big.l")
++ (1839 . "@src64/big.l")
+- (1877 . "@src64/big.l")
+-> (3788 . "@src64/subr.l")
+/ (2179 . "@src64/big.l")
+: (2896 . "@src64/sym.l")
+:: (2920 . "@src64/sym.l")
+; (2822 . "@src64/sym.l")
+< (2192 . "@src64/subr.l")
+<= (2222 . "@src64/subr.l")
+<> (2129 . "@src64/subr.l")
+= (2100 . "@src64/subr.l")
+=0 (2158 . "@src64/subr.l")
+=: (2851 . "@src64/sym.l")
+== (2044 . "@src64/subr.l")
+==== (967 . "@src64/sym.l")
+=T (2166 . "@src64/subr.l")
+> (2252 . "@src64/subr.l")
+>= (2282 . "@src64/subr.l")
+>> (2293 . "@src64/big.l")
+abs (2383 . "@src64/big.l")
+accept (140 . "@src64/net.l")
+alarm (455 . "@src64/main.l")
+all (772 . "@src64/sym.l")
+and (1637 . "@src64/flow.l")
+any (3750 . "@src64/io.l")
+append (1329 . "@src64/subr.l")
+apply (581 . "@src64/apply.l")
+arg (1858 . "@src64/main.l")
+args (1834 . "@src64/main.l")
+argv (2467 . "@src64/main.l")
+as (146 . "@src64/flow.l")
+asoq (2938 . "@src64/subr.l")
+assoc (2903 . "@src64/subr.l")
+at (2122 . "@src64/flow.l")
+atom (2370 . "@src64/subr.l")
+bind (1375 . "@src64/flow.l")
+bit? (2400 . "@src64/big.l")
+bool (1737 . "@src64/flow.l")
+box (839 . "@src64/flow.l")
+box? (999 . "@src64/sym.l")
+by (1535 . "@src64/apply.l")
+bye (3137 . "@src64/flow.l")
+caaaar (271 . "@src64/subr.l")
+caaadr (288 . "@src64/subr.l")
+caaar (99 . "@src64/subr.l")
+caadar (311 . "@src64/subr.l")
+caaddr (334 . "@src64/subr.l")
+caadr (116 . "@src64/subr.l")
+caar (31 . "@src64/subr.l")
+cadaar (360 . "@src64/subr.l")
+cadadr (383 . "@src64/subr.l")
+cadar (136 . "@src64/subr.l")
+caddar (409 . "@src64/subr.l")
+cadddr (435 . "@src64/subr.l")
+caddr (156 . "@src64/subr.l")
+cadr (45 . "@src64/subr.l")
+call (2793 . "@src64/flow.l")
+car (5 . "@src64/subr.l")
+case (1978 . "@src64/flow.l")
+catch (2478 . "@src64/flow.l")
+cd (2234 . "@src64/main.l")
+cdaaar (464 . "@src64/subr.l")
+cdaadr (487 . "@src64/subr.l")
+cdaar (179 . "@src64/subr.l")
+cdadar (513 . "@src64/subr.l")
+cdaddr (539 . "@src64/subr.l")
+cdadr (199 . "@src64/subr.l")
+cdar (62 . "@src64/subr.l")
+cddaar (568 . "@src64/subr.l")
+cddadr (594 . "@src64/subr.l")
+cddar (222 . "@src64/subr.l")
+cdddar (623 . "@src64/subr.l")
+cddddr (652 . "@src64/subr.l")
+cdddr (245 . "@src64/subr.l")
+cddr (79 . "@src64/subr.l")
+cdr (17 . "@src64/subr.l")
+chain (1132 . "@src64/subr.l")
+char (3231 . "@src64/io.l")
+chop (1093 . "@src64/sym.l")
+circ (816 . "@src64/subr.l")
+clip (1784 . "@src64/subr.l")
+close (4137 . "@src64/io.l")
+cmd (2449 . "@src64/main.l")
+cnt (1279 . "@src64/apply.l")
+commit (1503 . "@src64/db.l")
+con (725 . "@src64/subr.l")
+conc (781 . "@src64/subr.l")
+cond (1932 . "@src64/flow.l")
+connect (202 . "@src64/net.l")
+cons (747 . "@src64/subr.l")
+copy (1216 . "@src64/subr.l")
+ctl (4077 . "@src64/io.l")
+ctty (2259 . "@src64/main.l")
+cut (1795 . "@src64/sym.l")
+date (1973 . "@src64/main.l")
+dbck (2092 . "@src64/db.l")
+de (551 . "@src64/flow.l")
+dec (1991 . "@src64/big.l")
+def (475 . "@src64/flow.l")
+default (1659 . "@src64/sym.l")
+del (1850 . "@src64/sym.l")
+delete (1392 . "@src64/subr.l")
+delq (1443 . "@src64/subr.l")
+diff (2561 . "@src64/subr.l")
+dir (2392 . "@src64/main.l")
+dm (563 . "@src64/flow.l")
+do (2152 . "@src64/flow.l")
+e (2623 . "@src64/flow.l")
+echo (4157 . "@src64/io.l")
+env (510 . "@src64/main.l")
+eof (3308 . "@src64/io.l")
+eol (3299 . "@src64/io.l")
+errno (1193 . "@src64/main.l")
+eval (208 . "@src64/flow.l")
+ext (4852 . "@src64/io.l")
+ext? (1034 . "@src64/sym.l")
+extern (900 . "@src64/sym.l")
+extra (1280 . "@src64/flow.l")
+extract (1084 . "@src64/apply.l")
+fifo (1961 . "@src64/sym.l")
+file (2339 . "@src64/main.l")
+fill (3165 . "@src64/subr.l")
+filter (1027 . "@src64/apply.l")
+fin (2018 . "@src64/subr.l")
+finally (2536 . "@src64/flow.l")
+find (1188 . "@src64/apply.l")
+fish (1479 . "@src64/apply.l")
+flg? (2417 . "@src64/subr.l")
+flip (1686 . "@src64/subr.l")
+flush (4827 . "@src64/io.l")
+fold (3341 . "@src64/sym.l")
+for (2241 . "@src64/flow.l")
+fork (2960 . "@src64/flow.l")
+format (1769 . "@src64/big.l")
+free (2034 . "@src64/db.l")
+from (3327 . "@src64/io.l")
+full (1066 . "@src64/subr.l")
+fun? (734 . "@src64/sym.l")
+gc (378 . "@src64/gc.l")
+ge0 (2359 . "@src64/big.l")
+get (2748 . "@src64/sym.l")
+getd (742 . "@src64/sym.l")
+getl (3030 . "@src64/sym.l")
+glue (1232 . "@src64/sym.l")
+gt0 (2370 . "@src64/big.l")
+head (1805 . "@src64/subr.l")
+heap (481 . "@src64/main.l")
+hear (3049 . "@src64/io.l")
+host (185 . "@src64/net.l")
+id (1034 . "@src64/db.l")
+idx (2035 . "@src64/sym.l")
+if (1818 . "@src64/flow.l")
+if2 (1837 . "@src64/flow.l")
+ifn (1878 . "@src64/flow.l")
+in (3974 . "@src64/io.l")
+inc (1924 . "@src64/big.l")
+index (2609 . "@src64/subr.l")
+info (2296 . "@src64/main.l")
+intern (875 . "@src64/sym.l")
+ipid (2905 . "@src64/flow.l")
+isa (976 . "@src64/flow.l")
+job (1442 . "@src64/flow.l")
+journal (977 . "@src64/db.l")
+key (3158 . "@src64/io.l")
+kill (2937 . "@src64/flow.l")
+last (2029 . "@src64/subr.l")
+length (2685 . "@src64/subr.l")
+let (1492 . "@src64/flow.l")
+let? (1553 . "@src64/flow.l")
+lieu (1163 . "@src64/db.l")
+line (3483 . "@src64/io.l")
+lines (3636 . "@src64/io.l")
+link (1163 . "@src64/subr.l")
+list (887 . "@src64/subr.l")
+listen (152 . "@src64/net.l")
+lit (183 . "@src64/flow.l")
+load (3951 . "@src64/io.l")
+lock (1191 . "@src64/db.l")
+loop (2184 . "@src64/flow.l")
+low? (3213 . "@src64/sym.l")
+lowc (3243 . "@src64/sym.l")
+lst? (2387 . "@src64/subr.l")
+lt0 (2348 . "@src64/big.l")
+lup (2224 . "@src64/sym.l")
+made (1098 . "@src64/subr.l")
+make (1079 . "@src64/subr.l")
+map (715 . "@src64/apply.l")
+mapc (757 . "@src64/apply.l")
+mapcan (967 . "@src64/apply.l")
+mapcar (853 . "@src64/apply.l")
+mapcon (907 . "@src64/apply.l")
+maplist (799 . "@src64/apply.l")
+maps (656 . "@src64/apply.l")
+mark (1952 . "@src64/db.l")
+match (3058 . "@src64/subr.l")
+max (2312 . "@src64/subr.l")
+maxi (1377 . "@src64/apply.l")
+member (2427 . "@src64/subr.l")
+memq (2449 . "@src64/subr.l")
+meta (3135 . "@src64/sym.l")
+meth (1102 . "@src64/flow.l")
+method (1066 . "@src64/flow.l")
+min (2341 . "@src64/subr.l")
+mini (1428 . "@src64/apply.l")
+mix (1251 . "@src64/subr.l")
+mmeq (2477 . "@src64/subr.l")
+n0 (2174 . "@src64/subr.l")
+n== (2072 . "@src64/subr.l")
+nT (2183 . "@src64/subr.l")
+name (499 . "@src64/sym.l")
+nand (1672 . "@src64/flow.l")
+native (1201 . "@src64/main.l")
+need (918 . "@src64/subr.l")
+new (850 . "@src64/flow.l")
+next (1841 . "@src64/main.l")
+nil (1755 . "@src64/flow.l")
+nond (1955 . "@src64/flow.l")
+nor (1693 . "@src64/flow.l")
+not (1745 . "@src64/flow.l")
+nth (685 . "@src64/subr.l")
+num? (2398 . "@src64/subr.l")
+off (1596 . "@src64/sym.l")
+offset (2649 . "@src64/subr.l")
+on (1581 . "@src64/sym.l")
+onOff (1611 . "@src64/sym.l")
+one (1644 . "@src64/sym.l")
+open (4099 . "@src64/io.l")
+opid (2921 . "@src64/flow.l")
+opt (2570 . "@src64/main.l")
+or (1653 . "@src64/flow.l")
+out (3994 . "@src64/io.l")
+pack (1144 . "@src64/sym.l")
+pair (2379 . "@src64/subr.l")
+pass (620 . "@src64/apply.l")
+pat? (720 . "@src64/sym.l")
+path (1168 . "@src64/io.l")
+peek (3215 . "@src64/io.l")
+pick (1235 . "@src64/apply.l")
+pid (157 . "@src64/flow.l")
+pipe (4015 . "@src64/io.l")
+poll (3111 . "@src64/io.l")
+pool (657 . "@src64/db.l")
+pop (1771 . "@src64/sym.l")
+port (5 . "@src64/net.l")
+pr (4941 . "@src64/io.l")
+pre? (1409 . "@src64/sym.l")
+prin (4751 . "@src64/io.l")
+prinl (4765 . "@src64/io.l")
+print (4791 . "@src64/io.l")
+println (4822 . "@src64/io.l")
+printsp (4807 . "@src64/io.l")
+prog (1773 . "@src64/flow.l")
+prog1 (1781 . "@src64/flow.l")
+prog2 (1798 . "@src64/flow.l")
+prop (2779 . "@src64/sym.l")
+protect (471 . "@src64/main.l")
+prove (3412 . "@src64/subr.l")
+push (1686 . "@src64/sym.l")
+push1 (1722 . "@src64/sym.l")
+put (2696 . "@src64/sym.l")
+putl (2948 . "@src64/sym.l")
+pwd (2223 . "@src64/main.l")
+queue (1918 . "@src64/sym.l")
+quit (914 . "@src64/main.l")
+quote (141 . "@src64/flow.l")
+rand (2627 . "@src64/big.l")
+range (988 . "@src64/subr.l")
+rank (2966 . "@src64/subr.l")
+raw (433 . "@src64/main.l")
+rd (4869 . "@src64/io.l")
+read (2489 . "@src64/io.l")
+replace (1490 . "@src64/subr.l")
+rest (1887 . "@src64/main.l")
+reverse (1665 . "@src64/subr.l")
+rewind (4835 . "@src64/io.l")
+rollback (1885 . "@src64/db.l")
+rot (848 . "@src64/subr.l")
+rpc (4974 . "@src64/io.l")
+run (332 . "@src64/flow.l")
+sect (2513 . "@src64/subr.l")
+seed (2612 . "@src64/big.l")
+seek (1141 . "@src64/apply.l")
+send (1146 . "@src64/flow.l")
+seq (1090 . "@src64/db.l")
+set (1480 . "@src64/sym.l")
+setq (1513 . "@src64/sym.l")
+size (2750 . "@src64/subr.l")
+skip (3285 . "@src64/io.l")
+sort (3837 . "@src64/subr.l")
+sp? (711 . "@src64/sym.l")
+space (4769 . "@src64/io.l")
+split (1579 . "@src64/subr.l")
+state (2022 . "@src64/flow.l")
+stem (1974 . "@src64/subr.l")
+str (3804 . "@src64/io.l")
+str? (1013 . "@src64/sym.l")
+strip (1563 . "@src64/subr.l")
+sub? (1442 . "@src64/sym.l")
+sum (1326 . "@src64/apply.l")
+super (1233 . "@src64/flow.l")
+sym (3790 . "@src64/io.l")
+sym? (2406 . "@src64/subr.l")
+sync (3011 . "@src64/io.l")
+sys (2764 . "@src64/flow.l")
+t (1764 . "@src64/flow.l")
+tail (1896 . "@src64/subr.l")
+tell (3081 . "@src64/io.l")
+text (1270 . "@src64/sym.l")
+throw (2504 . "@src64/flow.l")
+tick (2873 . "@src64/flow.l")
+till (3394 . "@src64/io.l")
+time (2106 . "@src64/main.l")
+touch (1049 . "@src64/sym.l")
+trim (1746 . "@src64/subr.l")
+try (1187 . "@src64/flow.l")
+type (929 . "@src64/flow.l")
+udp (269 . "@src64/net.l")
+unify (3810 . "@src64/subr.l")
+unless (1914 . "@src64/flow.l")
+until (2098 . "@src64/flow.l")
+up (597 . "@src64/main.l")
+upp? (3228 . "@src64/sym.l")
+uppc (3292 . "@src64/sym.l")
+use (1586 . "@src64/flow.l")
+usec (2211 . "@src64/main.l")
+val (1461 . "@src64/sym.l")
+version (2584 . "@src64/main.l")
+wait (2973 . "@src64/io.l")
+when (1897 . "@src64/flow.l")
+while (2074 . "@src64/flow.l")
+wipe (3088 . "@src64/sym.l")
+with (1343 . "@src64/flow.l")
+wr (4958 . "@src64/io.l")
+xchg (1536 . "@src64/sym.l")
+xor (1714 . "@src64/flow.l")
+x| (2539 . "@src64/big.l")
+yoke (1187 . "@src64/subr.l")
+zap (1063 . "@src64/sym.l")
+zero (1629 . "@src64/sym.l")
+| (2499 . "@src64/big.l")
diff --git a/lib/term.l b/lib/term.l
@@ -0,0 +1,47 @@
+# 16mar10abu
+# (c) Software Lab. Alexander Burger
+
+### Key codes ###
+(setq
+   *XtF1    (in '("tput" "kf1") (line T))
+   *XtF2    (in '("tput" "kf2") (line T))
+   *XtF3    (in '("tput" "kf3") (line T))
+   *XtF4    (in '("tput" "kf4") (line T))
+   *XtF5    (in '("tput" "kf5") (line T))
+   *XtF6    (in '("tput" "kf6") (line T))
+   *XtF7    (in '("tput" "kf7") (line T))
+   *XtF8    (in '("tput" "kf8") (line T))
+   *XtF9    (in '("tput" "kf9") (line T))
+   *XtF10   (in '("tput" "kf10") (line T))
+   *XtF11   (in '("tput" "kf11") (line T))
+   *XtF12   (in '("tput" "kf12") (line T))
+
+   *XtMenu  "^[[29~"                            #?
+
+   *XtIns   (in '("tput" "kich1") (line T))
+   *XtDel   (in '("tput" "kdch1") (line T))
+
+   *XtPgUp  (in '("tput" "kpp") (line T))
+   *XtPgDn  (in '("tput" "knp") (line T))
+   *XtUp    (in '("tput" "cuu1") (line T))
+   *XtDown  "^[[B"                              #?
+   *XtRight (in '("tput" "cuf1") (line T))
+   *XtLeft  "^[[D"                              #?
+   *XtEnd   "^[[F"                              #?
+   *XtHome  (in '("tput" "home") (line T)) )
+
+
+### Cursor movements ###
+(de xtUp (N)
+   (do N (prin *XtUp)) )
+
+(de xtDown (N)
+   (do N (prin *XtDown)) )
+
+(de xtRight (N)
+   (do N (prin *XtRight)) )
+
+(de xtLeft (N)
+   (do N (prin *XtLeft)) )
+
+# vi:et:ts=3:sw=3
diff --git a/lib/test.l b/lib/test.l
@@ -0,0 +1,31 @@
+# 09sep09abu
+# (c) Software Lab. Alexander Burger
+
+### Unit Tests ###
+# $(/bin/pwd)/p lib/test.l -bye
+
+(load "dbg.l")
+
+(test T (pool (tmp "db")))
+
+(load
+   "test/src/main.l"
+   "test/src/apply.l"
+   "test/src/flow.l"
+   "test/src/sym.l"
+   "test/src/subr.l"
+   "test/src/big.l"
+   "test/src/io.l"
+   "test/src/db.l"
+   "test/src/net.l"
+   "test/src/ext.l"
+   "test/src/ht.l" )
+
+(load "test/lib.l")
+(load "test/lib/misc.l")
+
+(load "test/lib/lint.l")
+
+(msg 'OK)
+
+# vi:et:ts=3:sw=3
diff --git a/lib/tex.l b/lib/tex.l
@@ -0,0 +1,164 @@
+# 03jun07abu
+# (c) Software Lab. Alexander Burger
+
+# Convert to PDF document
+(de dviPdf (Doc)
+   (prog1
+      (tmp Doc ".pdf")
+      (call "/usr/bin/dvips" "-q" (pack Doc ".dvi"))
+      (call "ps2pdf" (pack Doc ".ps") @)
+      (call 'rm "-f"
+         (pack Doc ".tex")
+         (pack Doc ".dvi")
+         (pack Doc ".ps") ) ) )
+
+# Tex Formatter
+(de texFmt (S)
+   (_tex S)
+   (prinl) )
+
+(de tex (S  . @)
+   (prin "\\" S "{")
+   (_tex (next))
+   (while (args)
+      (when (next)
+         (prin "\\\\")
+         (_tex (arg)) ) )
+   (prinl "}") )
+
+(de texl (S Lst)
+   (prin "\\" S "{")
+   (_tex (pop 'Lst))
+   (while Lst
+      (when (pop 'Lst)
+         (prin "\\\\")
+         (_tex @) ) )
+   (prinl "}") )
+
+(de _tex (X)
+   (when X
+      (ifn (sym? X)
+         (prin X)
+         (let N 0
+            (for (L (chop X) L (cdr L))
+               (cond
+                  ((and (= "!" (car L)) (= "{" (cadr L)))
+                     (prin "\\textbf{")
+                     (inc 'N)
+                     (pop 'L) )
+                  ((and (= "/" (car L)) (= "{" (cadr L)))
+                     (prin "\\textit{")
+                     (inc 'N)
+                     (pop 'L) )
+                  ((and (= "_" (car L)) (= "{" (cadr L)))
+                     (prin "\\underline{")
+                     (inc 'N)
+                     (pop 'L) )
+                  ((and (= "\^" (car L)) (= "{" (cadr L)))
+                     (prin "\^{")
+                     (inc 'N)
+                     (pop 'L) )
+                  ((= `(char 8364) (car L))
+                     (prin "\\EUR") )
+                  ((sub? (car L) "#$%&_{")
+                     (prin "\\" (car L)) )
+                  ((sub? (car L) "<²>")
+                     (prin "$" (car L) "$") )
+                  (T
+                     (prin
+                        (case (car L)
+                           ("\"" "\\char34")
+                           ("\\" "$\\backslash$")
+                           ("\^" "\\char94")
+                           ("}" (if (=0 N) "\\}" (dec 'N) "}"))
+                           ("~" "\\char126")
+                           (T (car L)) ) ) ) ) )
+            (do N (prin "}")) ) ) ) )
+
+
+### TeX Document ###
+(de document (Doc Cls Typ Use . Prg)
+   (out (list "bin/lat1" (pack Doc ".tex"))
+      (prinl "\\documentclass[" Cls "]{" Typ "}")
+      (while Use
+         (if (atom (car Use))
+            (prinl "\\usepackage{" (pop 'Use) "}")
+            (prinl "\\usepackage[" (caar Use) "]{" (cdr (pop 'Use)) "}") ) )
+      (prinl "\\begin{document}")
+      (prEval Prg 2)
+      (prinl "\\end{document}") )
+   (call 'sh "-c"
+      (pack "latex -interaction=batchmode " Doc ".tex >/dev/null") )
+   (call 'rm (pack Doc ".aux") (pack Doc ".log")) )
+
+(de \block (S . Prg)
+   (prinl "\\begin{" S "}")
+   (prEval Prg 2)
+   (prinl "\\end{" S "}") )
+
+
+### Tabular environment ###
+(de \table (Fmt . Prg)
+   (prinl "\\begin{tabular}[c]{" Fmt "}")
+   (prEval Prg 2)
+   (prinl "\\end{tabular}") )
+
+(de \carry ()
+   (prinl "\\end{tabular}")
+   (prinl)
+   (prinl "\\begin{tabular}[c]{" "Fmt" "}") )
+
+(de \head @
+   (prin "\\textbf{" (next) "}")
+   (while (args)
+      (prin " & \\textbf{")
+      (_tex (next))
+      (prin "}") )
+   (prinl "\\\\") )
+
+(de \row @
+   (when (=0 (next))
+      (next)
+      (prin "\\raggedleft ") )
+   (ifn (=T (arg))
+      (_tex (arg))
+      (prin "\\textbf{")
+      (_tex (next))
+      (prin "}") )
+   (while (args)
+      (prin " & ")
+      (when (=0 (next))
+         (next)
+         (prin "\\raggedleft ") )
+      (ifn (=T (arg))
+         (_tex (arg))
+         (prin "\\textbf{")
+         (_tex (next))
+         (prin "}") ) )
+   (prinl "\\\\") )
+
+(de \hline ()
+   (prinl "\\hline") )
+
+(de \cline (C1 C2)
+   (prinl "\\cline{" C1 "-" C2 "}") )
+
+
+### Letter Document Class ###
+(de \letter (Lst . Prg)
+   (prin "\\begin{letter}{" (pop 'Lst))
+   (while Lst
+      (when (pop 'Lst)
+         (prin "\\\\" @) ) )
+   (prinl "}")
+   (prEval Prg 2)
+   (prinl "\\end{letter}") )
+
+(de \signature (S)
+   (tex "signature" S) )
+
+(de \opening (S)
+   (tex "opening" S) )
+
+(de \closing (S)
+   (tex "closing" S) )
diff --git a/lib/too.l b/lib/too.l
@@ -0,0 +1,487 @@
+# 16apr10abu
+# (c) Software Lab. Alexander Burger
+
+### DB Garbage Collection ###
+(de dbgc ()
+   (markExt *DB)
+   (let Cnt 0
+      (finally (mark 0)
+         (for (F . @) (or *Dbs (2))
+            (for (S (seq F)  S  (seq S))
+               (unless (mark S)
+                  (inc 'Cnt)
+                  (and (isa '+Entity S) (zap> S))
+                  (zap S) ) ) ) )
+      (commit)
+      (when *Blob
+         (use (@S @R F S)
+            (let Pat (conc (chop *Blob) '(@S "." @R))
+               (in (list 'find *Blob "-type" "f")
+                  (while (setq F (line))
+                     (when (match Pat F)
+                        (unless
+                           (and
+                              (setq S (extern (pack (replace @S '/))))
+                              (get S (intern (pack @R))) )
+                           (inc 'Cnt)
+                           (call 'rm (pack F)) )
+                        (wipe S) ) ) ) ) ) )
+      (gt0 Cnt) ) )
+
+(de markExt (S)
+   (unless (mark S T)
+      (markData (val S))
+      (maps markData S)
+      (wipe S) ) )
+
+(de markData (X)
+   (while (pair X)
+      (markData (pop 'X)) )
+   (and (ext? X) (markExt X)) )
+
+
+### DB Mapping ###
+(de dbMap ("ObjFun" "TreeFun")
+   (default "ObjFun" quote "TreeFun" quote)
+   (finally (mark 0)
+      (_dbMap *DB)
+      (dbMapT *DB) ) )
+
+(de _dbMap ("Hook")
+   (unless (mark "Hook" T)
+      ("ObjFun" "Hook")
+      (for "X" (getl "Hook")
+         (when (pair "X")
+            (if
+               (and
+                  (ext? (car "X"))
+                  (not (isa '+Entity (car "X")))
+                  (sym? (cdr "X"))
+                  (find
+                     '(("X") (isa '+relation (car "X")))
+                     (getl (cdr "X")) ) )
+               (let ("Base" (car "X")  "Cls" (cdr "X"))
+                  (dbMapT "Base")
+                  (for "X" (getl "Base")
+                     (when
+                        (and
+                           (pair "X")
+                           (sym? (cdr "X"))
+                           (pair (car "X"))
+                           (num? (caar "X"))
+                           (ext? (cdar "X")) )
+                        ("TreeFun" "Base" (car "X") (cdr "X") "Cls" "Hook")
+                        (iter (tree (cdr "X") "Cls" "Hook") _dbMap) ) )
+                  (wipe "Base") )
+               (dbMapV (car "X")) ) ) )
+      (wipe "Hook") ) )
+
+(de dbMapT ("Base")
+   (let "X" (val "Base")
+      (when
+         (and
+            (pair "X")
+            (num? (car "X"))
+            (ext? (cdr "X")) )
+         ("TreeFun" "Base" "X")
+         (iter "Base" dbMapV) ) ) )
+
+(de dbMapV ("X")
+   (while (pair "X")
+      (dbMapV (pop '"X")) )
+   (and (ext? "X") (_dbMap "X")) )
+
+
+### DB Check ###
+(de dbCheck ()
+   (and (lock) (quit 'lock @))  # Lock whole database
+   (for (F . N) (or *Dbs (2))  # Low-level integrity check
+      (unless (pair (println F N (dbck F T)))
+         (quit 'dbck @) ) )
+   (dbMap  # Check tree structures
+      NIL
+      '((Base Root Var Cls Hook)
+         (println Base Root Var Cls Hook)
+         (unless (= (car Root) (chkTree (cdr Root)))
+            (quit "Tree size mismatch") )
+         (when Var
+            (scan (tree Var Cls Hook)
+               '((K V)
+                  (or
+                     (isa Cls V)
+                     (isa '+Alt (meta V Var))
+                     (quit "Bad Type" V) )
+                  (unless (has> V Var (if (pair K) (car K) K))
+                     (quit "Bad Value" K) ) )
+               NIL T T ) ) ) )
+   (and *Dbs (dbfCheck))  # Check DB file assignments
+   (and (dangling) (println 'dangling @))  # Show dangling index references
+   T )
+
+(de dangling ()
+   (make
+      (dbMap
+         '((This)
+            (and
+               (not (: T))
+               (dangle This)
+               (link @) ) ) ) ) )
+
+# Check Index References
+(de dangle (Obj)
+   (and
+      (make
+         (for X (getl Obj)
+            (let V (or (atom X) (pop 'X))
+               (with (meta Obj X)
+                  (cond
+                     ((isa '+Joint This)
+                        (if (isa '+List This)
+                           (when
+                              (find
+                                 '((Y)
+                                    (if (atom (setq Y (get Y (: slot))))
+                                       (n== Obj Y)
+                                       (not (memq Obj Y)) ) )
+                                 V )
+                              (link X) )
+                           (let Y (get V (: slot))
+                              (if (atom Y)
+                                 (unless (== Obj Y) (link X))
+                                 (unless (memq Obj Y) (link X)) ) ) ) )
+                     ((isa '+Key This)
+                        (and
+                           (<> Obj
+                              (fetch
+                                 (tree X (: cls) (get Obj (: hook)))
+                                 V ) )
+                           (link X) ) )
+                     ((isa '+Ref This)
+                        (let
+                           (Tree (tree X (: cls) (get Obj (: hook)))
+                              Aux (conc (mapcar '((S) (get Obj S)) (: aux)) Obj) )
+                           (if (isa '+List This)
+                              (when
+                                 (find
+                                    '((Y)
+                                       (and
+                                          (or
+                                             (not (isa '+Fold This))
+                                             (setq V (fold V)) )
+                                          (<> Obj (fetch Tree (cons Y Aux))) ) )
+                                    V )
+                                 (link X) )
+                              (and
+                                 (or
+                                    (not (isa '+Fold This))
+                                    (setq V (fold V)) )
+                                 (<> Obj (fetch Tree (cons V Aux)))
+                                 (link X) ) ) ) )
+                     (T
+                        (for B (: bag)
+                           (cond
+                              ((isa '+Key B)
+                                 (let N (index B (: bag))
+                                    (with B
+                                       (when
+                                          (find
+                                             '((L)
+                                                (and
+                                                   (get L N)
+                                                   (<> Obj
+                                                      (fetch
+                                                         (tree (: var) (: cls)
+                                                            (get
+                                                               (if (sym? (: hook)) Obj L)
+                                                               (: hook) ) )
+                                                         (get L N) ) ) ) )
+                                                V )
+                                             (link X) ) ) ) )
+                              ((isa '+Ref B)
+                                 (let N (index B (: bag))
+                                    (with B
+                                       (when
+                                          (find
+                                             '((L)
+                                                (and
+                                                   (get L N)
+                                                   (<> Obj
+                                                      (fetch
+                                                         (tree (: var) (: cls)
+                                                            (get
+                                                               (if (sym? (: hook)) Obj L)
+                                                               (: hook) ) )
+                                                         (cons (get L N) Obj) ) ) ) )
+                                                V )
+                                             (link X) ) ) ) ) ) ) ) ) ) ) ) )
+      (cons Obj @) ) )
+
+
+### Rebuild tree ###
+(de rebuild (X Var Cls Hook)
+   (let Lst NIL
+      (let? Base (get (or Hook *DB) Cls)
+         (unless X
+            (setq Lst
+               (if (; (treeRel Var Cls) hook)
+                  (collect Var Cls Hook)
+                  (collect Var Cls) ) ) )
+         (zapTree (get Base Var -1))
+         (put Base Var NIL)
+         (commit) )
+      (nond
+         (X
+            (let Len (length Lst)
+               (recur (Lst Len)
+                  (unless (=0 Len)
+                     (let (N (>> 1 (inc Len))  L (nth Lst N))
+                        (re-index (car L) Var)
+                        (recurse Lst (dec N))
+                        (recurse (cdr L) (- Len N)) ) ) ) ) )
+         ((atom X)
+            (for Obj X
+               (re-index Obj Var) ) )
+         (NIL
+            (for (Obj X Obj (seq Obj))
+               (and (isa Cls Obj) (re-index Obj Var)) ) ) )
+      (commit) ) )
+
+(de re-index (Obj Var)
+   (unless (get Obj T)
+      (when (get Obj Var)
+         (rel> (meta Obj Var) Obj NIL
+            (put> (meta Obj Var) Obj NIL @) )
+         (at (0 . 10000) (commit)) ) ) )
+
+
+### Database file management ###
+(de dbfCheck ()
+   (for "Cls" (all)
+      (when (and (= `(char "+") (char "Cls")) (isa '+Entity "Cls"))
+         (or
+            (get "Cls" 'Dbf)
+            (meta "Cls" 'Dbf)
+            (println 'dbfCheck "Cls") )
+         (for Rel (getl "Cls")
+            (and
+               (pair Rel)
+               (or
+                  (isa '+index (car Rel))
+                  (find '((B) (isa '+index B)) (; Rel 1 bag)) )
+               (unless (; Rel 1 dbf)
+                  (println 'dbfCheck (cdr Rel) "Cls") ) ) ) ) ) )
+
+(de dbfMigrate (Pool Dbs)
+   (let
+      (scan
+         '(("Tree" "Fun")
+            (let "Node" (cdr (root "Tree"))
+               (if (ext? (fin (val "Node")))
+                  (recur ("Node")
+                     (let? "X" (val "Node")
+                        (recurse (cadr "X"))
+                        ("Fun" (car "X") (cdddr "X"))
+                        (recurse (caddr "X"))
+                        (wipe "Node") ) )
+                  (recur ("Node")
+                     (let? "X" (val "Node")
+                        (recurse (car "X"))
+                        (for "Y" (cdr "X")
+                           ("Fun" (car "Y") (or (cddr "Y") (fin (car "Y"))))
+                           (recurse (cadr "Y")) )
+                        (wipe "Node") ) ) ) ) )
+         iter
+         '(("Tree" "Bar")
+            (scan "Tree" '(("K" "V") ("Bar" "V"))) )
+         zapTree
+         '((Node)
+            (let? X (val Node)
+               (zapTree (cadr X))
+               (zapTree (caddr X))
+               (zap Node) ) ) )
+      (dbfUpdate) )
+   (let Lst
+      (make
+         (for (S *DB S (seq S))
+            (link (cons S (val S) (getl S))) ) )
+      (pool)
+      (call 'rm (pack Pool 1))
+      (pool Pool Dbs)
+      (set *DB (cadar Lst))
+      (putl *DB (cddr (pop 'Lst)))
+      (for L Lst
+         (let New (new T)
+            (set New (cadr L))
+            (putl New (cddr L))
+            (con L New) ) )
+      (set *DB (dbfReloc0 (val *DB) Lst))
+      (for X Lst
+         (set (cdr X) (dbfReloc0 (val (cdr X)) Lst))
+         (putl (cdr X) (dbfReloc0 (getl (cdr X)) Lst)) )
+      (commit)
+      (dbMap  # Relocate base symbols
+         '((Obj)
+            (putl Obj (dbfReloc0 (getl Obj) Lst))
+            (commit) )
+         '((Base Root Var Cls Hook)
+            (when (asoq (cdr Root) Lst)
+               (con Root (cdr @))
+               (touch Base)
+               (commit) ) ) ) ) )
+
+(de dbfUpdate ()
+   (dbMap  # Move
+      '((Obj)
+         (let N (or (meta Obj 'Dbf 1) 1)
+            (unless (= N (car (id Obj T)))
+               (let New (new N)
+                  (set New (val Obj))
+                  (putl New (getl Obj))
+                  (set Obj (cons T New)) )
+               (commit) ) ) ) )
+   (when *Blob
+      (for X
+         (make
+            (use (@S @R F S)
+               (let Pat (conc (chop *Blob) '(@S "." @R))
+                  (in (list 'find *Blob "-type" "f")
+                     (while (setq F (line))
+                        (and
+                           (match Pat F)
+                           (setq S (extern (pack (replace @S '/))))
+                           (=T (car (pair (val S))))
+                           (link
+                              (cons (pack F) (blob (cdr (val S)) @R)) ) ) ) ) ) ) )
+         (and (dirname (cdr X)) (call 'mkdir "-p" @))
+         (call 'mv (car X) (cdr X)) ) )
+   (dbMap  # Relocate
+      '((Obj)
+         (when (=T (car (pair (val Obj))))
+            (setq Obj (cdr (val Obj))) )
+         (when (isa '+Entity Obj)
+            (putl Obj (dbfReloc (getl Obj)))
+            (commit) ) )
+      '((Base Root Var Cls Hook)
+         (if Var
+            (dbfRelocTree Base Root (tree Var Cls Hook) (get Cls Var 'dbf))
+            (dbfRelocTree Base Root Base) ) ) )
+   (dbgc) )
+
+(de dbfReloc (X)
+   (cond
+      ((pair X)
+         (cons (dbfReloc (car X)) (dbfReloc (cdr X))) )
+      ((and (ext? X) (=T (car (pair (val X)))))
+         (cdr (val X)) )
+      (T X) ) )
+
+(de dbfReloc0 (X Lst)
+   (cond
+      ((pair X)
+         (cons (dbfReloc0 (car X) Lst) (dbfReloc0 (cdr X) Lst)) )
+      ((asoq X Lst) (cdr @))
+      (T X) ) )
+
+(de dbfRelocTree (Base Root Tree Dbf)
+   (let? Lst (make (scan Tree '((K V) (link (cons K V)))))
+      (zapTree (cdr Root))
+      (touch Base)
+      (set Root 0)
+      (con Root)
+      (commit)
+      (for X
+         (make
+            (for
+               (Lst (cons Lst) Lst
+                  (mapcan
+                     '((L)
+                        (let (N (/ (inc (length L)) 2)  X (nth L N))
+                           (link (car X))
+                           (make
+                              (and (>= N 2) (link (head (dec N) L)))
+                              (and (cdr X) (link @)) ) ) )
+                     Lst ) ) ) )
+         (store Tree
+            (dbfReloc (car X))
+            (dbfReloc (cdr X))
+            Dbf ) )
+      (commit) ) )
+
+
+### Dump Objects ###
+(de dump CL
+   (let B 0
+      (for ("Q" (goal CL) (asoq '@@ (prove "Q")))
+         (let (Obj (cdr @)  Lst)
+            (prin "(obj ")
+            (_dmp Obj)
+            (maps
+               '((X)
+                  (unless (member X Lst)
+                     (prinl)
+                     (space 3)
+                     (cond
+                        ((pair X)
+                           (printsp (cdr X))
+                           (_dmp (car X) T) )
+                        ((isa '+Blob (meta Obj X))
+                           (prin X " `(tmp " (inc 'B) ")")
+                           (out (tmp B)
+                              (in (blob Obj X) (echo)) ) )
+                        (T (print X T)) ) ) )
+                  Obj )
+            (prinl " )")
+            Obj ) ) ) )
+
+(de _dmp (Obj Flg)
+   (cond
+      ((pair Obj)
+         (prin "(")
+         (_dmp (pop 'Obj) T)
+         (while (pair Obj)
+            (space)
+            (_dmp (pop 'Obj) T) )
+         (when Obj
+            (prin " . ")
+            (_dmp Obj T) )
+         (prin ")") )
+      ((ext? Obj)
+         (when Flg
+            (prin "`(obj ") )
+         (prin "(")
+         (catch NIL
+            (maps
+               '((X)
+                  (with (and (pair X) (meta Obj (cdr X)))
+                     (when (isa '+Key This)
+                        (or Flg (push 'Lst X))
+                        (printsp (type Obj) (: var))
+                        (when (: hook)
+                           (_dmp (: hook) T)
+                           (space) )
+                        (_dmp (car X) T)
+                        (throw) ) ) )
+               Obj )
+            (print (type Obj))
+            (maps
+               '((X)
+                  (with (and (pair X) (meta Obj (cdr X)))
+                     (when (isa '+Ref This)
+                        (space)
+                        (or Flg (push 'Lst X))
+                        (print (: var))
+                        (when (: hook)
+                           (space)
+                           (_dmp (: hook) T) )
+                        (space)
+                        (_dmp (car X) T) ) ) )
+               Obj ) )
+         (when Flg
+            (prin ")") )
+         (prin ")") )
+      (T (print Obj)) ) )
+
+`*Dbg
+(noLint 'dbfMigrate 'iter)
+
+# vi:et:ts=3:sw=3
diff --git a/lib/xhtml.l b/lib/xhtml.l
@@ -0,0 +1,669 @@
+# 20apr10abu
+# (c) Software Lab. Alexander Burger
+
+# *JS *Style *Menu *Tab *ID
+
+(mapc allow '(*Menu *Tab *ID))
+(setq *Menu 0  *Tab 1)
+
+(de htPrin (Prg Ofs)
+   (default Ofs 1)
+   (for X Prg
+      (if (atom X)
+         (ht:Prin (eval X Ofs))
+         (eval X Ofs) ) ) )
+
+(de htStyle (Attr)
+   (cond
+      ((atom Attr)
+         (prin " class=\"")
+         (ht:Prin Attr)
+         (prin "\"") )
+      ((and (atom (car Attr)) (atom (cdr Attr)))
+         (prin " " (car Attr) "=\"")
+         (ht:Prin (cdr Attr))
+         (prin "\"") )
+      (T (mapc htStyle Attr)) ) )
+
+(de dfltCss (Cls)
+   (htStyle
+      (cond
+         ((not *Style) Cls)
+         ((atom *Style) (pack *Style " " Cls))
+         ((and (atom (car *Style)) (atom (cdr *Style)))
+            (list Cls *Style) )
+         ((find atom *Style)
+            (replace *Style @ (pack @ " " Cls)) )
+         (T (cons Cls *Style)) ) ) )
+
+(de tag (Nm Attr Ofs Prg)
+   (prin '< Nm)
+   (and Attr (htStyle @))
+   (prin '>)
+   (if (atom Prg)
+      (ht:Prin (eval Prg Ofs))
+      (for X Prg
+         (if (atom X)
+            (ht:Prin (eval X Ofs))
+            (eval X Ofs) ) ) )
+   (prin "</" Nm '>) )
+
+(de <tag> (Nm Attr . Prg)
+   (tag Nm Attr 2 Prg) )
+
+(de style (X Prg)
+   (let *Style
+      (nond
+         (X *Style)
+         (*Style X)
+         ((pair X)
+            (cond
+               ((atom *Style) (pack *Style " " X))
+               ((and (atom (car *Style)) (atom (cdr *Style)))
+                  (list X *Style) )
+               ((find atom *Style)
+                  (replace *Style @ (pack @ " " X)) )
+               (T (cons X *Style)) ) )
+         ((or (pair (car X)) (pair (cdr X)))
+            (cond
+               ((atom *Style) (list *Style X))
+               ((and (atom (car *Style)) (atom (cdr *Style)))
+                  (if (= (car X) (car *Style))
+                     X
+                     (list *Style X) ) )
+               (T
+                  (cons X (delete (assoc (car X) *Style) *Style)) ) ) )
+         (NIL X) )
+      (run Prg 2 '(*Style)) ) )
+
+(de <style> ("X" . "Prg")
+   (style "X" "Prg") )
+
+(de nonblank (Str)
+   (or Str `(pack (char 160) (char 160))) )
+
+
+### XHTML output ###
+(de html (Upd Ttl Css Attr . Prg)
+   (httpHead NIL Upd)
+   (ht:Out *Chunked
+      ## (xml? T)
+      (prinl "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\" \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">")
+      (prinl
+         "<html xmlns=\"http://www.w3.org/1999/xhtml\" xml:lang=\""
+         (or *Lang "en")
+         "\" lang=\""
+         (or *Lang "en")
+         "\">" )
+      (prinl "<head>")
+      (and Ttl (<tag> 'title NIL Ttl) (prinl))
+      (and *Host *Port (prinl "<base href=\"" (baseHRef) "\"/>"))
+      (when Css
+         (if (atom Css) ("css" Css) (mapc "css" Css)) )
+      (mapc javascript *JS)
+      (prinl "</head>")
+      (tag 'body Attr 2 Prg)
+      (prinl "</html>") ) )
+
+(de "css" (Css)
+   (prinl "<link rel=\"stylesheet\" type=\"text/css\" href=\"" (srcUrl Css) "\"/>") )
+
+(de javascript (JS . @)
+   (when *JS
+      (when JS
+         (prinl "<script type=\"text/javascript\" src=\"" (srcUrl JS) "\"></script>") )
+      (when (rest)
+         (prinl "<script type=\"text/javascript\">" @ "</script>") ) ) )
+
+(de <div> (Attr . Prg)
+   (tag 'div Attr 2 Prg)
+   (prinl) )
+
+(de <span> (Attr . Prg)
+   (tag 'span Attr 2 Prg) )
+
+(de <br> Prg
+   (htPrin Prg 2)
+   (prinl "<br/>") )
+
+(de -- ()
+   (prinl "<br/>") )
+
+(de ---- ()
+   (prinl "<br/><br/>") )
+
+(de <hr> ()
+   (prinl "<hr/>") )
+
+(de <nbsp> (N)
+   (do (or N 1) (prin "&nbsp;")) )
+
+(de <small> Prg
+   (tag 'small NIL 2 Prg) )
+
+(de <big> Prg
+   (tag 'big NIL 2 Prg) )
+
+(de <em> Prg
+   (tag 'em NIL 2 Prg) )
+
+(de <strong> Prg
+   (tag 'strong NIL 2 Prg) )
+
+(de <h1> (Attr . Prg)
+   (tag 'h1 Attr 2 Prg)
+   (prinl) )
+
+(de <h2> (Attr . Prg)
+   (tag 'h2 Attr 2 Prg)
+   (prinl) )
+
+(de <h3> (Attr . Prg)
+   (tag 'h3 Attr 2 Prg)
+   (prinl) )
+
+(de <h4> (Attr . Prg)
+   (tag 'h4 Attr 2 Prg)
+   (prinl) )
+
+(de <h5> (Attr . Prg)
+   (tag 'h5 Attr 2 Prg)
+   (prinl) )
+
+(de <h6> (Attr . Prg)
+   (tag 'h6 Attr 2 Prg)
+   (prinl) )
+
+(de <p> (Attr . Prg)
+   (tag 'p Attr 2 Prg)
+   (prinl) )
+
+(de <pre> (Attr . Prg)
+   (tag 'pre Attr 2 Prg)
+   (prinl) )
+
+(de <ol> (Attr . Prg)
+   (tag 'ol Attr 2 Prg)
+   (prinl) )
+
+(de <ul> (Attr . Prg)
+   (tag 'ul Attr 2 Prg)
+   (prinl) )
+
+(de <li> (Attr . Prg)
+   (tag 'li Attr 2 Prg)
+   (prinl) )
+
+(de <href> (Str Url)
+   (prin "<a href=\"" (sesId Url) "\"")
+   (and *Style (htStyle @))
+   (prin '>)
+   (ht:Prin Str)
+   (prin "</a>") )
+
+(de <img> (Src Alt Url DX DY)
+   (and Url (prin "<a href=\"" (sesId Url) "\">"))
+   (prin "<img src=\"" (sesId Src) "\"")
+   (when Alt
+      (prin " alt=\"")
+      (ht:Prin Alt)
+      (prin "\"") )
+   (and DX (prin " width=\"" DX "\""))
+   (and DY (prin " height=\"" DY "\""))
+   (and *Style (htStyle @))
+   (prin "/>")
+   (and Url (prin "</a>")) )
+
+(de <this> (Var Val . Prg)
+   (prin "<a href=\"" (sesId *Url) '? Var '= (ht:Fmt Val) "\"")
+   (and *Style (htStyle @))
+   (prin '>)
+   (htPrin Prg 2)
+   (prin "</a>") )
+
+(de <table> (Attr Ttl "Head" . Prg)
+   (tag 'table Attr 1
+      (quote
+         (and Ttl (tag 'caption NIL 1 Ttl))
+         (when (find cdr "Head")
+            (tag 'tr NIL 1
+               (quote
+                  (for X "Head"
+                     (tag 'th (car X) 2 (cdr X)) ) ) ) )
+         (htPrin Prg 2) ) )
+   (prinl) )
+
+(de <row> (Cls . Prg)
+   (tag 'tr NIL 1
+      (quote
+         (let (L Prg  H (up "Head"))
+            (while L
+               (let (X (pop 'L)  C (pack Cls (and Cls (caar H) " ") (caar H))  N 1)
+                  (while (== '- (car L))
+                     (inc 'N)
+                     (pop 'L)
+                     (pop 'H) )
+                  (setq C
+                     (if2 C (> N 1)
+                        (list C (cons 'colspan N))
+                        C
+                        (cons 'colspan N) ) )
+                  (tag 'td
+                     (if (== 'align (car (pop 'H)))
+                        (list '(align . right) C)
+                        C )
+                     1
+                     (quote
+                        (if (atom X)
+                           (ht:Prin (eval X 1))
+                           (eval X 1) ) ) ) ) ) ) ) ) )
+
+(de <th> (Attr . Prg)
+   (tag 'th Attr 2 Prg) )
+
+(de <tr> (Attr . Prg)
+   (tag 'tr Attr 2 Prg) )
+
+(de <td> (Attr . Prg)
+   (tag 'td Attr 2 Prg) )
+
+(de <grid> (X . Lst)
+   (tag 'table 'grid 1
+      (quote
+         (while Lst
+            (tag 'tr NIL 1
+               (quote
+                  (use X
+                     (let L (and (sym? X) (chop X))
+                        (do (or (num? X) (length X))
+                           (tag 'td
+                              (cond
+                                 ((pair X) (pop 'X))
+                                 ((= "." (pop 'L)) 'align) )
+                              1
+                              (quote
+                                 (if (atom (car Lst))
+                                    (ht:Prin (eval (pop 'Lst) 1))
+                                    (eval (pop 'Lst) 1) ) ) ) ) ) ) ) ) ) ) )
+   (prinl) )
+
+(de <spread> Lst
+   (<table> '(width . "100%") NIL '((norm) (align))
+      (<row> NIL
+         (eval (car Lst) 1)
+         (run (cdr Lst) 1) ) ) )
+
+(de tip ("Str" "Txt")
+   (<span> (cons 'title "Str") "Txt") )
+
+(de <tip> ("Str" . "Prg")
+   (style (cons 'title "Str") "Prg") )
+
+
+# Menus
+(de urlMT (Url Menu Tab Id Str)
+   (pack Url '?  "*Menu=+" Menu  "&*Tab=+" Tab  "&*ID=" (ht:Fmt Id) Str) )
+
+(de <menu> Lst
+   (let (M 1  N 1  E 2  U)
+      (recur (Lst N E)
+         (<ul> NIL
+            (for L Lst
+               (nond
+                  ((car L) (<li> NIL (htPrin (cdr L) 2)))
+                  ((=T (car L))
+                     (if (setq U (eval (cadr L) E))
+                        (<li> (pack (if (= U *Url) 'act 'cmd) N)
+                           (<tip> "-->"
+                              (<href> (eval (car L) E)
+                                 (urlMT U *Menu (if (= U *Url) *Tab 1)
+                                    (eval (caddr L))
+                                    (eval (cadddr L)) ) ) ) )
+                        (<li> (pack 'cmd N)
+                           (ht:Prin (eval (car L) E)) ) ) )
+                  ((bit? M *Menu)
+                     (<li> (pack 'sub N)
+                        (<tip> ,"Open submenu"
+                           (<href>
+                              (eval (cadr L) E)
+                              (urlMT *Url (| M *Menu) *Tab *ID) ) ) )
+                     (setq M (>> -1 M))
+                     (recur (L)
+                        (for X (cddr L)
+                           (when (=T (car X))
+                              (recurse X)
+                              (setq M (>> -1 M)) ) ) ) )
+                  (NIL
+                     (<li> (pack 'top N)
+                        (<tip> ,"Close submenu"
+                           (<href>
+                              (eval (cadr L) E)
+                              (urlMT *Url (x| M *Menu) *Tab *ID) ) )
+                        (setq M (>> -1 M))
+                        (recurse (cddr L) (inc N) (inc E)) ) ) ) ) ) ) ) )
+
+# Update link
+(de updLink ()
+   (<tip> ,"Update"
+      (<span> 'step (<href> "@" (urlMT *Url *Menu *Tab *ID))) ) )
+
+# Tabs
+(de <tab> Lst
+   (<table> 'tab NIL NIL
+      (for (N . L) Lst
+         (if (= N *Tab)
+            (<td> 'top (ht:Prin (eval (car L) 1)))
+            (<td> 'sub
+               (<href> (eval (car L) 1) (urlMT *Url *Menu N *ID)) ) ) ) )
+   (htPrin (get Lst *Tab -1) 2) )
+
+
+### DB Linkage ###
+(de mkUrl (Lst)
+   (pack (pop 'Lst) '?
+      (make
+         (while Lst
+            (and
+               (sym? (car Lst))
+               (= `(char '*) (char (car Lst)))
+               (link (pop 'Lst) '=) )
+            (link (ht:Fmt (pop 'Lst)))
+            (and Lst (link '&)) ) ) ) )
+
+(de <$> (Str Obj Msg Tab)
+   (cond
+      ((not Obj) (ht:Prin Str))
+      ((=T Obj) (<href> Str (pack Msg Str)))
+      ((send (or Msg 'url>) Obj (or Tab 1))
+         (<href> Str (mkUrl @)) )
+      (T (ht:Prin Str)) ) )
+
+# Links to previous and next object
+(de stepBtn (Var Cls Hook Msg)
+   (default Msg 'url>)
+   (<span> 'step
+      (use (Rel S1 S2)
+         (if (isa '+Joint (setq Rel (meta *ID Var)))
+            (let Lst (get *ID Var (; Rel slot))
+               (setq
+                  S2 (lit (cadr (memq *ID Lst)))
+                  S1 (lit (car (seek '((L) (== *ID (cadr L))) Lst))) ) )
+            (let
+               (K
+                  (cond
+                     ((isa '+Key Rel)
+                        (get *ID Var) )
+                     ((isa '+Fold Rel)
+                        (cons (fold (get *ID Var)) *ID) )
+                     (T
+                        (cons
+                           (get *ID Var)
+                           (conc
+                              (mapcar '((S) (get *ID S)) (; Rel aux))
+                              *ID ) ) ) )
+                  Q1 (init (tree Var Cls Hook) K NIL)
+                  Q2 (init (tree Var Cls Hook) K T) )
+               (unless (get *ID T)
+                  (step Q1 T)
+                  (step Q2 T) )
+               (setq
+                  S1 (list 'step (lit Q1) T)
+                  S2 (list 'step (lit Q2) T) ) ) )
+         (if (and (eval S1) (send Msg @ *Tab))
+            (<tip> ,"Next object of the same type"
+               (<href> "<<<" (mkUrl @)) )
+            (prin "&lt;&lt;&lt;") )
+         (prin "&nbsp;--&nbsp;")
+         (if (and (eval S2) (send Msg @ *Tab))
+            (<tip> ,"Next object of the same type"
+               (<href> ">>>" (mkUrl @)) )
+            (prin "&gt;&gt;&gt;") ) ) ) )
+
+# Character Separated Values
+(off "*CSV")
+
+(de csv ("Nm" . "Prg")
+   (call 'rm "-f" (tmp "Nm" ".csv"))
+   (let "*CSV" (pack "+" (tmp "Nm" ".csv"))
+      (run "Prg") )
+   (<href> "CSV" (tmp "Nm" ".csv")) )
+
+(de <0> @
+   (when "*CSV"
+      (out @
+         (prin (next))
+         (while (args)
+            (prin "^I" (next)) )
+         (prinl "^M") ) ) )
+
+(de <%> @
+   (prog1 (pass pack)
+      (ht:Prin @)
+      (prinl "<br/>")
+      (<0> @) ) )
+
+(de <!> ("Lst")
+   (when "*CSV"
+      (out @
+         (prin (eval (cadar "Lst")))
+         (for "S" (cdr "Lst")
+            (prin "^I" (eval (cadr "S"))) )
+         (prinl "^M") ) )
+   "Lst" )
+
+(de <+> (Str Obj Msg Tab)
+   (<$> Str Obj Msg Tab)
+   (and "*CSV" (out @ (prin Str "^I"))) )
+
+(de <-> (Str Obj Msg Tab)
+   (<$> Str Obj Msg Tab)
+   (<0> Str) )
+
+
+# Interactive tree
+(de <tree> ("Url" "Path" "Tree" "Able?" "Excl?" "Expand" "Print")
+   (default "Print" 'ht:Prin)
+   (let ("Pos" "Tree"  "F" (pop '"Path")  "A" 0)
+      (when "Path"
+         (loop
+            (and "F"
+               (not (cdr "Path"))
+               (map
+                  '((L)
+                     (when (pair (car L)) (set L (caar L))) )
+                  "Pos" ) )
+            (T (atom (car (setq "Pos" (nth "Pos" (abs (pop '"Path")))))))
+            (NIL "Path")
+            (setq "Pos" (cdar "Pos")) )
+         (set "Pos"
+            (if (atom (car "Pos"))
+               (cons (car "Pos") ("Expand" (car "Pos")))
+               (caar "Pos") ) ) )
+      (setq "Pos" (car "Pos"))
+      ("tree" "Tree")
+      "Tree" ) )
+
+(de "tree" ("Tree" "Lst")
+   (prinl "<ul>")
+   (for ("N" . "X") "Tree"
+      (prin "<li><a id=\"T" (inc '"A") "\"></a>")
+      (cond
+         ((pair "X")
+            (let "L" (append "Lst" (cons "N"))
+               (<href> (if (== "X" "Pos") "<+>" "[+]")
+                  (pack "Url"
+                     '? (ht:Fmt (cons NIL "L"))
+                     "#T" (max 1 (- "A" 12)) ) )
+               (space)
+               ("Print" (car "X"))
+               (and (cdr "X") ("tree" @ "L")) ) )
+         (("Able?" "X")
+            (let "L" (append "Lst" (cons (- "N")))
+               (<href> (if (== "X" "Pos") "< >" "[ ]")
+                  (pack "Url"
+                     "?" (ht:Fmt (cons ("Excl?" "X") "L"))
+                     "#T" (max 1 (- "A" 12)) ) )
+               (space)
+               ("Print" "X") ) )
+         (T ("Print" "X")) )
+      (prin "</li>") )
+   (prinl "</ul>") )
+
+
+### HTML form ###
+(de <post> (Attr Url . Prg)
+   (prin
+      "<form enctype=\"multipart/form-data\" action=\""
+      (sesId Url)
+      (and *JS "\" onkeypress=\"formKey(event)\" onsubmit=\"return doPost(this)")
+      "\" method=\"post\">" )
+   (tag 'fieldset Attr 2 Prg)
+   (prinl "</form>") )
+
+(de htmlVar ("Var")
+   (prin "name=\"")
+   (if (pair "Var")
+      (prin (car "Var") ":" (cdr "Var") ":")
+      (prin "Var") )
+   (prin "\"") )
+
+(de htmlVal ("Var")
+   (if (pair "Var")
+      (cdr (assoc (cdr "Var") (val (car "Var"))))
+      (val "Var") ) )
+
+(de <label> (Attr . Prg)
+   (tag 'label Attr 2 Prg) )
+
+(de <field> (N "Var" Max Flg)
+   (prin "<input type=\"text\" ")
+   (htmlVar "Var")
+   (prin " value=\"")
+   (ht:Prin (htmlVal "Var"))
+   (prin "\" size=\"")
+   (if (lt0 N)
+      (prin (- N) "\" style=\"text-align: right;\"")
+      (prin N "\"") )
+   (and Max (prin " maxlength=\"" Max "\""))
+   (and *JS (prin " onchange=\"return fldChg(this)\""))
+   (dfltCss "field")
+   (and Flg (prin " disabled=\"disabled\""))
+   (prinl "/>") )
+
+(de <hidden> ("Var" Val)
+   (prin "<input type=\"hidden\" ")
+   (htmlVar "Var")
+   (prin " value=\"")
+   (ht:Prin Val)
+   (prinl "\"/>") )
+
+(de <passwd> (N "Var" Max Flg)
+   (prin "<input type=\"password\" ")
+   (htmlVar "Var")
+   (prin " value=\"")
+   (ht:Prin (htmlVal "Var"))
+   (prin "\" size=\"" N "\"")
+   (and Max (prin " maxlength=\"" Max "\""))
+   (and *JS (prin " onchange=\"return fldChg(this)\""))
+   (dfltCss "passwd")
+   (and Flg (prin " disabled=\"disabled\""))
+   (prinl "/>") )
+
+(de <upload> (N "Var" Flg)
+   (prin "<input type=\"file\" ")
+   (htmlVar "Var")
+   (prin " value=\"")
+   (ht:Prin (htmlVal "Var"))
+   (prin "\" size=\"" N "\"")
+   (and *JS (prin " onchange=\"return fldChg(this)\""))
+   (dfltCss "upload")
+   (and Flg (prin " disabled=\"disabled\""))
+   (prinl "/>") )
+
+(de <area> (Cols Rows "Var" Flg)
+   (prin "<textarea ")
+   (htmlVar "Var")
+   (prin " cols=\"" Cols "\" rows=\"" Rows "\" wrap=\"off\"")
+   (and *JS (prin " onchange=\"return fldChg(this)\""))
+   (dfltCss "area")
+   (and Flg (prin " disabled=\"disabled\""))
+   (prin '>)
+   (ht:Prin (htmlVal "Var"))
+   (prinl "</textarea>") )
+
+(de <select> (Lst "Var" Flg)
+   (prin "<select ")
+   (htmlVar "Var")
+   (and *JS (prin " onchange=\"return fldChg(this)\""))
+   (dfltCss "select")
+   (prin '>)
+   (for "X" Lst
+      (let "V" (if (atom "X") "X" (car "X"))
+         (prin
+            "<option"
+            (and (pair "X") (pack " title=\"" (cdr "X") "\""))
+            (cond
+               ((= "V" (htmlVal "Var")) " selected=\"selected\"")
+               (Flg " disabled=\"disabled\"") )
+            '> )
+         (ht:Prin "V") )
+      (prin "</option>") )
+   (prinl "</select>") )
+
+(de <check> ("Var" Flg)
+   (let Val (htmlVal "Var")
+      (prin "<input type=\"hidden\" ")
+      (htmlVar "Var")
+      (prin " value=\"" (and Flg Val T) "\">")
+      (prin "<input type=\"checkbox\" ")
+      (htmlVar "Var")
+      (prin " value=\"T\"" (and Val " checked=\"checked\""))
+      (and *JS (prin " onchange=\"return fldChg(this)\""))
+      (dfltCss "check")
+      (and Flg (prin " disabled=\"disabled\""))
+      (prinl "/>") ) )
+
+(de <radio> ("Var" Val Flg)
+   (prin "<input type=\"radio\" ")
+   (htmlVar "Var")
+   (prin " value=\"")
+   (ht:Prin Val)
+   (prin "\"" (and (= Val (htmlVal "Var")) " checked=\"checked\""))
+   (and *JS (prin " onchange=\"return fldChg(this)\""))
+   (dfltCss "radio")
+   (and Flg (prin " disabled=\"disabled\""))
+   (prinl "/>") )
+
+(de <submit> (S "Var" Flg JS)
+   (prin "<input type=\"submit\"")
+   (and "Var" (space) (htmlVar "Var"))
+   (prin " value=\"")
+   (ht:Prin S)
+   (prin "\"")
+   (when *JS
+      (prin " onmousedown=\"inBtn(1)\" onblur=\"inBtn(0)\"")
+      (and JS (prin " onclick=\"return doBtn(this)\"")) )
+   (dfltCss "submit")
+   (and Flg (prin " disabled=\"disabled\""))
+   (prinl "/>") )
+
+(de <image> (Src "Var" Flg JS)
+   (prin "<input type=\"image\"")
+   (and "Var" (space) (htmlVar "Var"))
+   (prin " src=\"" (sesId Src) "\"")
+   (when *JS
+      (prin " onmousedown=\"inBtn(1)\" onblur=\"inBtn(0)\"")
+      (and JS (prin " onclick=\"return doBtn(this)\"")) )
+   (dfltCss "image")
+   (and Flg (prin " disabled=\"disabled\""))
+   (prinl "/>") )
+
+(de <reset> (S Flg)
+   (prin "<input type=\"reset\" value=\"")
+   (ht:Prin S)
+   (prin "\"")
+   (dfltCss "reset")
+   (and Flg (prin " disabled=\"disabled\""))
+   (prinl "/>") )
+
+# vi:et:ts=3:sw=3
diff --git a/lib/xm.l b/lib/xm.l
@@ -0,0 +1,115 @@
+# 02jan09abu
+# (c) Software Lab. Alexander Burger
+
+# Check or write header
+(de xml? (Flg)
+   (if Flg
+      (prinl "<?xml version=\"1.0\" encoding=\"utf-8\"?>")
+      (skip)
+      (prog1
+         (head '("<" "?" "x" "m" "l") (till ">"))
+         (char) ) ) )
+
+# Generate/Parse XML data
+(de xml (Lst N)
+   (if Lst
+      (let Tag (pop 'Lst)
+         (space (default N 0))
+         (prin "<" Tag)
+         (for X (pop 'Lst)
+            (prin " " (car X) "=\"")
+            (escXml (cdr X))
+            (prin "\"") )
+         (nond
+            (Lst (prinl "/>"))
+            ((or (cdr Lst) (pair (car Lst)))
+               (prin ">")
+               (escXml (car Lst))
+               (prinl "</" Tag ">") )
+            (NIL
+               (prinl ">")
+               (for X Lst
+                  (if (pair X)
+                     (xml X (+ 3 N))
+                     (space (+ 3 N))
+                     (escXml X)
+                     (prinl) ) )
+               (space N)
+               (prinl "</" Tag ">") ) ) )
+      (skip)
+      (unless (= "<" (char))
+         (quit "Bad XML") )
+      (_xml (till " /<>" T)) ) )
+
+(de _xml (Tok)
+   (use X
+      (make
+         (link (intern Tok))
+         (let L
+            (make
+               (loop
+                  (NIL (skip) (quit "XML parse error"))
+                  (T (member @ '`(chop "/>")))
+                  (NIL (setq X (intern (till "=" T))))
+                  (char)
+                  (unless (= "\"" (char))
+                     (quit "XML parse error" X) )
+                  (link (cons X (pack (xmlEsc (till "\"")))))
+                  (char) ) )
+            (if (= "/" (char))
+               (prog (char) (and L (link L)))
+               (link L)
+               (loop
+                  (NIL (skip) (quit "XML parse error" Tok))
+                  (T (and (= "<" (setq X (char))) (= "/" (peek)))
+                     (char)
+                     (unless (= Tok (till " /<>" T))
+                        (quit "Unbalanced XML" Tok) )
+                     (char) )
+                  (if (= "<" X)
+                     (and (_xml (till " /<>" T)) (link @))
+                     (link
+                        (pack (xmlEsc (trim (cons X (till "^J<"))))) ) ) ) ) ) ) ) )
+
+(de xmlEsc (L)
+   (use (@A @X @Z)
+      (make
+         (while L
+            (ifn (match '("&" @X ";" @Z) L)
+               (link (pop 'L))
+               (link
+                  (cond
+                     ((= @X '`(chop "quot")) "\"")
+                     ((= @X '`(chop "amp")) "&")
+                     ((= @X '`(chop "lt")) "<")
+                     ((= @X '`(chop "gt")) ">")
+                     ((= @X '`(chop "apos")) "'")
+                     ((= "#" (car @X))
+                        (char
+                           (if (= "x" (cadr @X))
+                              (hex (cddr @X))
+                              (format (pack (cdr @X))) ) ) )
+                     (T @X) ) )
+               (setq L @Z) ) ) ) ) )
+
+(de escXml (X)
+   (for C (chop X)
+      (if (member C '`(chop "\"&<"))
+         (prin "&#" (char C) ";")
+         (prin C) ) ) )
+
+
+# Access functions
+(de body (Lst . @)
+   (while (and (setq Lst (cddr Lst)) (args))
+      (setq Lst (assoc (next) Lst)) )
+   Lst )
+
+(de attr (Lst Key . @)
+   (while (args)
+      (setq
+         Lst (assoc Key (cddr Lst))
+         Key (next) ) )
+   (cdr (assoc Key (cadr Lst))) )
+
+# vi:et:ts=3:sw=3
diff --git a/lib/xml.l b/lib/xml.l
@@ -0,0 +1,286 @@
+# 03jan09abu
+# 21jan09 Tomas Hlavaty <kvietaag@seznam.cz>
+
+# Check or write header
+(de xml? (Flg)
+   (if Flg
+      (prinl "<?xml version=\"1.0\" encoding=\"utf-8\"?>")
+      (skip)
+      (prog1
+         (head '("<" "?" "x" "m" "l") (till ">"))
+         (char) ) ) )
+
+# Generate/Parse XML data
+# expects well formed XML
+# encoding by picolisp (utf8 "only", no utf16 etc.)
+# trim whitespace except in cdata
+# ignore <? <!-- <!DOCTYPE
+# non-builtin entities as normal text: &ent; => ent
+(de xml (Lst N)
+   (if Lst
+      (let (Nn NIL Nl NIL Pre NIL)
+         (when N
+            (do (abs N)
+               (push 'Nn (if (lt0 N) "^I" " ")) ) )
+         (_xml_ Lst) )
+      (_xml) ) )
+
+(de _xml_ (Lst)
+   (let Tag (pop 'Lst)
+      (when Nl
+         (prinl)
+         (when Pre
+            (prin Pre) ) )
+      (prin "<" Tag)
+      (for X (pop 'Lst)
+         (prin " " (car X) "=\"")
+         (escXml (cdr X))
+         (prin "\"") )
+      (ifn Lst
+         (prin "/>")
+         (prin ">")
+         (use Nlx
+            (let (Nl N
+                  Pre (cons Pre Nn) )
+               (for X Lst
+                  (if (pair X)
+                     (_xml_ X)
+                     (off Nl)
+                     (escXml X) ) )
+               (setq Nlx Nl) )
+            (when Nlx
+               (prinl)
+               (when Pre
+                  (prin Pre) ) ) )
+         (prin "</" Tag ">") ) ) )
+
+(de _xml (In Char)
+   (unless Char
+      (skip)
+      (unless (= "<" (char))
+         (quit "Bad XML") ) )
+   (case (peek)
+      ("?"
+         (from "?>")
+         (unless In (_xml In)) )
+      ("!"
+         (char)
+         (case (peek)
+            ("-"
+               (ifn (= "-" (char) (char))
+                  (quit "XML comment expected")
+                  (from "-->")
+                  (unless In (_xml In)) ) )
+            ("D"
+               (if (find '((C) (<> C (char))) '`(chop "DOCTYPE"))
+                  (quit "XML DOCTYPE expected")
+                  (when (= "[" (from "[" ">"))
+                     (use X
+                        (loop
+                           (T (= "]" (setq X (from "]" "\"" "'" "<!--"))))
+                           (case X
+                              ("\"" (from "\""))
+                              ("'" (from "'"))
+                              ("<!--" (from "-->"))
+                              (NIL (quit "Unbalanced XML DOCTYPE")) ) ) )
+                     (from ">") )
+                  (unless In (_xml In)) ) )
+            ("["
+               (if (find '((C) (<> C (char))) '`(chop "[CDATA["))
+                  (quit "XML CDATA expected")
+                  (pack
+                     (head -3
+                        (make
+                           (loop
+                              (NIL (link (char)) (quit "Unbalanced XML CDATA"))
+                              (T (= '`(chop "]]>") (tail 3 (made)))) ) ) ) ) ) )
+            (T (quit "Unhandled XML tag")) ) )
+      (T
+         (let Tok (till " ^I^M^J/>" T)
+            (use X
+               (make
+                  (link (intern (pack Tok)))
+                  (let L
+                     (make
+                        (loop
+                           (NIL (skip) (quit "Unexpected end of XML" Tok))
+                           (T (member @ '("/" ">")))
+                           (NIL (setq X (intern (pack (trim (till "="))))))
+                           (char)
+                           (skip)
+                           (let C (char)
+                              (unless (member C '("\"" "'"))
+                                 (quit "XML attribute quote expected" X) )
+                              (link (cons X (pack (xmlEsc (till C))))) )
+                           (char) ) )
+                     (if (= "/" (char))
+                        (prog (char) (and L (link L)))
+                        (link L)
+                        (loop
+                           (NIL (skip) (quit "Unexpected end of XML" Tok))
+                           (T (and (= "<" (setq X (char))) (= "/" (peek)))
+                              (char)
+                              (unless (= Tok (till " ^I^M^J/>" T))
+                                 (quit "Unbalanced XML" Tok) )
+                              (skip)
+                              (char) )
+                           (if (= "<" X)
+                              (when (_xml T "<")
+                                 (link @) )
+                              (link
+                                 (pack (xmlEsc (trim (cons X (till "^M^J<"))))) ) ) ) ) ) ) ) ) ) ) )
+
+(de xmlEsc (L)
+   (use (@X @Z)
+      (make
+         (while L
+            (ifn (match '("&" @X ";" @Z) L)
+               (link (pop 'L))
+               (link
+                  (cond
+                     ((= @X '`(chop "quot")) "\"")
+                     ((= @X '`(chop "amp")) "&")
+                     ((= @X '`(chop "lt")) "<")
+                     ((= @X '`(chop "gt")) ">")
+                     ((= @X '`(chop "apos")) "'")
+                     ((= "#" (car @X))
+                        (char
+                           (if (= "x" (cadr @X))
+                              (hex (cddr @X))
+                              (format (pack (cdr @X))) ) ) )
+                     (T @X) ) )
+               (setq L @Z) ) ) ) ) )
+
+(de escXml (X)
+   (for C (chop X)
+      (prin (case C
+               ("\"" "&quot;")
+               ("&" "&amp;")
+               ("<" "&lt;")
+               (">" "&gt;")
+               (T C) ) ) ) )
+
+
+# Simple XML string
+(de xml$ (Lst)
+   (pack
+      (make
+         (recur (Lst)
+            (let Tag (pop 'Lst)
+               (link "<" Tag)
+               (for X (pop 'Lst)
+                  (link " " (car X) "=\"" (cdr X) "\"") )
+               (ifn Lst
+                  (link "/>")
+                  (link ">")
+                  (for X Lst
+                     (if (pair X)
+                        (recurse X (+ 3 N))
+                        (link X) ) )
+                  (link "</" Tag ">") ) ) ) ) ) )
+
+
+# Access functions
+(de body (Lst . @)
+   (while (and (setq Lst (cddr Lst)) (args))
+      (setq Lst (assoc (next) Lst)) )
+   Lst )
+
+(de attr (Lst Key . @)
+   (while (args)
+      (setq
+         Lst (assoc Key (cddr Lst))
+         Key (next) ) )
+   (cdr (assoc Key (cadr Lst))) )
+
+# <xml> output
+(de "xmlL" Lst
+   (push '"Xml"
+      (make
+         (link (pop 'Lst))
+         (let Att (make
+                     (while (and Lst (car Lst) (atom (car Lst)))
+                        (let K (pop 'Lst)
+                           (if (=T K)
+                              (for X (eval (pop 'Lst) 1)
+                                 (if (=T (car X))
+                                    (link (cons (cdr X) NIL))
+                                    (when (cdr X)
+                                       (link X) ) ) )
+                              (when (eval (pop 'Lst) 1)
+                                 (link (cons K @)) ) ) ) ) )
+            (let "Xml" NIL
+               (xrun Lst)
+               (ifn "Xml"
+                  (when Att
+                     (link Att) )
+                  (link Att)
+                  (chain (flip "Xml")) ) ) ) ) ) )
+
+(de "xmlO" Lst
+   (let Tag (pop 'Lst)
+      (when "Nl"
+         (prinl)
+         (when "Pre"
+            (prin "Pre") ) )
+      (prin "<" Tag)
+      (while (and Lst (car Lst) (atom (car Lst)))
+         (let K (pop 'Lst)
+            (if (=T K)
+               (for X (eval (pop 'Lst) 1)
+                  (if (=T (car X))
+                     (prin " " (cdr X) "=\"\"")
+                     (when (cdr X)
+                        (prin " " (car X) "=\"")
+                        (escXml (cdr X))
+                        (prin "\"") ) ) )
+               (when (eval (pop 'Lst) 1)
+                  (prin " " K "=\"")
+                  (escXml @)
+                  (prin "\"") ) ) ) )
+      (ifn Lst
+         (prin "/>")
+         (prin ">")
+         (use Nl
+            (let ("Nl" "N"
+                  "Pre" (cons "Pre" "Nn") )
+               (xrun Lst)
+               (setq Nl "Nl") )
+            (when Nl
+               (prinl)
+               (when "Pre"
+                  (prin "Pre") ) ) )
+         (prin "</" Tag ">") ) ) )
+
+(de <xml> ("N" . Lst)
+   (if (=T "N")
+      (let (<xml> "xmlL"
+            xprin '(@ (push '"Xml" (pass pack)))
+            xrun '((Lst Ofs)
+                   (default Ofs 2)
+                   (for X Lst
+                      (if (pair X)
+                         (eval X Ofs '("Xml"))
+                         (when (eval X Ofs '("Xml"))
+                            (xprin @) ) ) ) )
+            "Xml" NIL )
+         (run Lst 1 '(<xml> xprin xrun "Xml"))
+         (car (flip "Xml")) )
+      (let (<xml> "xmlO"
+            xprin '(@ (off "Nl") (mapc escXml (rest)))
+            xrun '((Lst Ofs)
+                   (default Ofs 2)
+                   (for X Lst
+                      (if (pair X)
+                         (eval X Ofs '("Nl" "Pre"))
+                         (when (eval X Ofs '("Nl" "Pre"))
+                            (xprin @) ) ) ) )
+            "Nn" NIL
+            "Nl" NIL
+            "Pre" NIL )
+         (when "N"
+            (do (abs "N")
+               (push '"Nn" (if (lt0 "N") "^I" " ")) ) )
+         (run Lst 1 '(<xml> xprin xrun "N" "Nn" "Nl" "Pre")) ) ) )
+
+# vi:et:ts=3:sw=3
diff --git a/lib/xmlrpc.l b/lib/xmlrpc.l
@@ -0,0 +1,63 @@
+# 02jan09abu
+# (c) Software Lab. Alexander Burger
+
+# (xmlrpc "localhost" 8080 "foo.bar" 'int 41 'string "abc" ..)
+(de xmlrpc (Host Port Meth . @)
+   (let? Sock (connect Host Port)
+      (let Xml (tmp 'xmlrpc)
+         (out Xml
+            (xml? T)
+            (xml
+               (list 'methodCall NIL
+                  (list 'methodName NIL Meth)
+                  (make
+                     (link 'params NIL)
+                     (while (args)
+                        (link
+                           (list 'param NIL
+                              (list 'value NIL (list (next) NIL (next))) ) ) ) ) ) ) )
+         (prog1
+            (out Sock
+               (prinl "POST /RPC2 HTTP/1.0^M")
+               (prinl "Host: " Host "^M")
+               (prinl "User-Agent: PicoLisp^M")
+               (prinl "Content-Type: text/xml^M")
+               (prinl "Accept-Charset: utf-8^M")
+               (prinl "Content-Length: " (car (info Xml)) "^M")
+               (prinl "^M")
+               (in Xml (echo))
+               (flush)
+               (in Sock
+                  (while (line))
+                  (let? L (and (xml?) (xml))
+                     (when (== 'methodResponse (car L))
+                        (xmlrpcValue
+                           (car (body L 'params 'param 'value)) ) ) ) ) )
+            (close Sock) ) ) ) )
+
+(de xmlrpcKey (Str)
+   (or (format Str) (intern Str)) )
+
+(de xmlrpcValue (Lst)
+   (let X (caddr Lst)
+      (case (car Lst)
+         (string X)
+         ((i4 int) (format X))
+         (boolean (= "1" X))
+         (double (format X *Scl))
+         (array
+            (when (== 'data (car X))
+               (mapcar
+                  '((L)
+                     (and (== 'value (car L)) (xmlrpcValue (caddr L))) )
+                  (cddr X) ) ) )
+         (struct
+            (extract
+               '((L)
+                  (when (== 'member (car L))
+                     (cons
+                        (xmlrpcKey (caddr (assoc 'name L)))
+                        (xmlrpcValue (caddr (assoc 'value L))) ) ) )
+               (cddr Lst) ) ) ) ) )
+
+# vi:et:ts=3:sw=3
diff --git a/loc/AR.l b/loc/AR.l
@@ -0,0 +1,7 @@
+(setq
+   *Sep0 ","
+   *Sep3 "."
+   *CtryCode 54
+   *DateFmt '(@D "-" @M "-" @Y)
+   *DayFmt '("Lunes" "Martes" "Miércoles" "Jueves" "Viernes" "Sábado" "Domingo")
+   *MonFmt '("Enero" "Febrero" "Marzo" "Abril" "Mayo" "Junio" "Julio" "Agosto" "Septiembre" "Octubre" "Noviembre" "Diciembre") )
diff --git a/loc/CH.l b/loc/CH.l
@@ -0,0 +1,7 @@
+(setq
+   *Sep0 "."
+   *Sep3 "'"
+   *CtryCode 41
+   *DateFmt '(@D "." @M "." @Y)
+   *DayFmt '("Montag" "Dienstag" "Mittwoch" "Donnerstag" "Freitag" "Samstag" "Sonntag")
+   *MonFmt '("Januar" "Februar" "März" "April" "Mai" "Juni" "Juli" "August" "September" "Oktober" "November" "Dezember") )
diff --git a/loc/DE.l b/loc/DE.l
@@ -0,0 +1,7 @@
+(setq
+   *Sep0 ","
+   *Sep3 "."
+   *CtryCode 49
+   *DateFmt '(@D "." @M "." @Y)
+   *DayFmt '("Montag" "Dienstag" "Mittwoch" "Donnerstag" "Freitag" "Samstag" "Sonntag")
+   *MonFmt '("Januar" "Februar" "März" "April" "Mai" "Juni" "Juli" "August" "September" "Oktober" "November" "Dezember") )
diff --git a/loc/ES.l b/loc/ES.l
@@ -0,0 +1,7 @@
+(setq
+   *Sep0 ","
+   *Sep3 "."
+   *CtryCode 34
+   *DateFmt '(@D "/" @M "/" @Y)
+   *DayFmt '("Lunes" "Martes" "Miércoles" "Jueves" "Viernes" "Sábado" "Domingo")
+   *MonFmt '("Enero" "Febrero" "Marzo" "Abril" "Mayo" "Junio" "Julio" "Agosto" "Setiembre" "Octubre" "Noviembre" "Diciembre") )
diff --git a/loc/JP.l b/loc/JP.l
@@ -0,0 +1,7 @@
+(setq
+   *Sep0 "."
+   *Sep3 ","
+   *CtryCode 81
+   *DateFmt '(@Y "/" @M "/" @D)
+   *DayFmt '("月曜日" "火曜日" "水曜日" "木曜日" "金曜日" "土曜日" "日曜日")
+   *MonFmt '("一月" "二月" "三月" "四月" "五月" "六月" "七月" "八月" "九月" "十月" "十一月" "十二月") )
diff --git a/loc/NIL.l b/loc/NIL.l
@@ -0,0 +1,7 @@
+(setq  # Default locale
+   *Sep0 "."
+   *Sep3 ","
+   *CtryCode NIL
+   *DateFmt '(@Y "-" @M "-" @D)
+   *DayFmt '("Monday" "Tuesday" "Wednesday" "Thursday" "Friday" "Saturday" "Sunday")
+   *MonFmt '("January" "February" "March" "April" "May" "June" "July" "August" "September" "October" "November" "December") )
diff --git a/loc/NO.l b/loc/NO.l
@@ -0,0 +1,7 @@
+(setq
+   *Sep0 ","
+   *Sep3 "."
+   *CtryCode 47
+   *DateFmt '(@D "." @M "." @Y)
+   *DayFmt '("mandag" "tirsdag" "onsdag" "torsdag" "fredag" "lørdag" "søndag")
+   *MonFmt '("januar" "februar" "mars" "april" "mai" "juni" "juli" "august" "september" "oktober" "november" "desember") )
diff --git a/loc/RU.l b/loc/RU.l
@@ -0,0 +1,7 @@
+(setq
+   *Sep0 ","
+   *Sep3 " "
+   *CtryCode 7
+   *DateFmt '(@D "." @M "." @Y)
+   *DayFmt '("Понедельник" "Вторник" "Среда" "Четверг" "Пятница" "Суббота" "Воскресенье")
+   *MonFmt '("Январь" "Февраль" "Март" "Апрель" "Май" "Июнь" "Июль" "Август" "Сентябрь" "Октябрь" "Ноябрь" "Декабрь") )
diff --git a/loc/UK.l b/loc/UK.l
@@ -0,0 +1,7 @@
+(setq
+   *Sep0 "."
+   *Sep3 ","
+   *CtryCode 44
+   *DateFmt '(@D "/" @M "/" @Y)
+   *DayFmt '("Monday" "Tuesday" "Wednesday" "Thursday" "Friday" "Saturday" "Sunday")
+   *MonFmt '("January" "February" "March" "April" "May" "June" "July" "August" "September" "October" "November" "December") )
diff --git a/loc/US.l b/loc/US.l
@@ -0,0 +1,7 @@
+(setq
+   *Sep0 "."
+   *Sep3 ","
+   *CtryCode 1
+   *DateFmt '(@M "/" @D "/" @Y)
+   *DayFmt '("Monday" "Tuesday" "Wednesday" "Thursday" "Friday" "Saturday" "Sunday")
+   *MonFmt '("January" "February" "March" "April" "May" "June" "July" "August" "September" "October" "November" "December") )
diff --git a/loc/ar b/loc/ar
@@ -0,0 +1 @@
+T "@loc/es"
diff --git a/loc/ch b/loc/ch
@@ -0,0 +1,4 @@
+# 10may08abu
+# (c) Software Lab. Alexander Burger
+
+T "@loc/de"
diff --git a/loc/de b/loc/de
@@ -0,0 +1,77 @@
+# 22dec08abu
+# (c) Software Lab. Alexander Burger
+
+"Language" "Sprache"
+
+# lib/db.l
+"Boolean input expected" "Boolean-Type erwartet"
+"Numeric input expected" "Zahleneingabe erforderlich"
+"Symbolic type expected" "Symbol-Type erwartet"
+"String type expected" "String-Type erwartet"
+"Type error" "Typ-Fehler"
+"Not unique" "Nicht eindeutig"
+"Input required" "Eingabe erforderlich"
+
+# lib/form.l
+"Cancel" "Abbruch"
+"Yes" "Ja"
+"No" "Nein"
+"Select" "Auswahl"
+"Delete row?" "Zeile löschen?"
+"Show" "Anzeigen"
+"Bad date format" "Falsches Datums-Format"
+"Bad time format" "Falsches Uhrzeit-Format"
+"Bad phone number format" "Falsches Telefonnummern-Format"
+"male" "männlich"
+"female" "weiblich"
+"New" "Neu"
+"Edit" "Bearbeiten"
+"Save" "Speichern"
+"Done" "Fertig"
+"Currently edited by '@2' (@1)" "Zur Zeit von '@2' (@1) bearbeitet"
+"Search" "Suchen"
+"Reset" "Zurücksetzen"
+"New/Copy" "Neu/Muster"
+"Restore" "Wiederherstellen"
+"Restore @1?" "@1 wiederherstellen?"
+"Delete" "Löschen"
+"Delete @1?" "@1 löschen?"
+"Data not found" "Datensatz nicht gefunden"
+
+# General
+"login" "anmelden"
+"logout" "abmelden"
+"' logged in" "' ist angemeldet"
+"Name" "Name"
+"Password" "Passwort"
+"Permission denied" "Keine Berechtigung"
+"Permissions" "Berechtigungen"
+"Role" "Rolle"
+"Roles" "Rollen"
+"User" "Benutzer"
+"Users" "Benutzer"
+
+# Tooltips
+"Open submenu" "Untermenü öffnen"
+"Close submenu" "Untermenü schließen"
+"Next object of the same type" "Nächstes Objekt vom gleichen Typ"
+"Find or create an object of the same type" "Ein Objekt vom gleichen Typ suchen oder neu anlegen"
+"Choose a suitable value" "Einen passenden Wert auswählen"
+"Adopt this value" "Diesen Wert übernehmen"
+"Go to first line" "Zur ersten Zeile gehen"
+"Scroll up one page" "Eine Seite nach oben scrollen"
+"Scroll up one line" "Eine Zeile nach oben scrollen"
+"Scroll down one line" "Eine Zeile nach unten scrollen"
+"Scroll down one page" "Eine Seite nach unten scrollen"
+"Go to last line" "Zur letzten Zeile gehen"
+"Delete row" "Zeile löschen"
+"Shift row up" "Zeile nach oben schieben"
+"Clear all input fields" "Alle Eingabefelder löschen"
+"Release exclusive write access for this object" "Exklusiven Schreibzugriff auf dieses Objekt freigeben"
+"Gain exclusive write access for this object" "Exklusiven Schreibzugriff auf dieses Objekt erhalten"
+"Start search" "Suche starten"
+"Create new object" "Neues Objekt anlegen"
+"Create a new copy of this object" "Eine neue Kopie dieses Objektes anlegen"
+"Mark this object as \"not deleted\"" "Dieses Objekt als \"nicht gelöscht\" markieren"
+"Mark this object as \"deleted\"" "Dieses Objekt als \"gelöscht\" markieren"
+"Update" "Aktualisieren"
diff --git a/loc/es b/loc/es
@@ -0,0 +1,52 @@
+# 26aug09art
+# Armadillo <tc.rucho@gmail.com>
+
+"Language" "Idioma"
+
+# lib/db.l
+"Boolean input expected" "Se espera el ingreso de datos tipo buliano"
+"Numeric input expected" "Se espera el ingreso de datos tipo numérico"
+"Symbolic type expected" "Se esperan datos del tipo simbólico"
+"String type expected" "Se esperan datos del tipo String"
+"Type error" "Error de tipado"
+"Not unique" "No único"
+"Input required" "Se require ingreso de datos"
+
+# lib/form.l
+"Cancel" "Cancelar"
+"Yes" "Sí"
+"No" "No"
+"Select" "Seleccionar"
+"Delete row?" "¿Borrar fila?"
+"Show" "Mostrar"
+"Bad date format" "El formato de la fecha no es válido"
+"Bad time format" "El formato de la hora no es válido"
+"Bad phone number format" "El formato del número telefónico no es válido"
+"male" "hombre"
+"female" "mujer"
+"New" "Nuevo"
+"Edit" "Editar"
+"Save" "Guardar"
+"Done" "Terminar"
+"Currently edited by '@2' (@1)" "Actualmente editado por '@2' (@1)"
+"Search" "Buscar"
+"Reset" "Vaciar/Limpiar"
+"New/Copy" "Nuevo/Copiar"
+"Restore" "Restaurar"
+"Restore @1?" "¿Restaurar @1?"
+"Delete" "Borrar"
+"Delete @1?" "¿Borrar @1?"
+"Data not found" "No se encontraron datos"
+
+# General
+"login" "Ingresar al Sistema"
+"logout" "Salir del Sistema"
+"' logged in" "' ingresó al sistema"
+"Name" "Nombre"
+"Password" "Contraseña"
+"Permission denied" "Permiso denegado"
+"Permissions" "Permisos"
+"Role" "Rol"
+"Roles" "Roles"
+"User" "Usuario"
+"Users" "Usuarios"
diff --git a/loc/jp b/loc/jp
@@ -0,0 +1,77 @@
+# 22dec08abu
+# (c) Software Lab. Alexander Burger
+
+"Language" "言語"
+
+# lib/db.l
+"Boolean input expected" "Booleanタイプが必要"
+"Numeric input expected" "数値入力が必要"
+"Symbolic type expected" "Symbolicタイプが必要"
+"String type expected" "Stringタイプが必要"
+"Type error" "タイプエラー"
+"Not unique" "重複"
+"Input required" "入力が必要"
+
+# lib/form.l
+"Cancel" "キャンセル"
+"Yes" "はい"
+"No" "いいえ"
+"Select" "選択"
+"Delete row?" "行を消しますか？"
+"Show" "表示"
+"Bad date format" "日付が違います"
+"Bad time format" "時刻が違います"
+"Bad phone number format" "電話番号が違います"
+"male" "男性"
+"female" "女性"
+"New" "作成"
+"Edit" "編集"
+"Save" "保存"
+"Done" "終了"
+"Currently edited by '@2' (@1)" "現在'@2'(@1)が編集中です"
+"Search" "検索"
+"Reset" "リセット"
+"New/Copy" "作成/コピー"
+"Restore" "もとへ戻す"
+"Restore @1?" "@1もとへ戻しますか？"
+"Delete" "消去"
+"Delete @1?" "@1を消しますか？"
+"Data not found" "データが見つかりません"
+
+# General
+"login" "ログイン"
+"logout" "ログアウト"
+"' logged in" "' ログインしました"
+"Name" "名前"
+"Password" "パスワード"
+"Permission denied" "認証できません"
+"Permissions" "許可"
+"Role" "役割"
+"Roles" "役割"
+"User" "ユーザー"
+"Users" "ユーザー"
+
+# Tooltips
+"Open submenu" "サブメニューを開く"
+"Close submenu" "サブメニューを閉じる"
+"Next object of the same type" "次の同じタイプへ"
+"Find or create an object of the same type" "同じタイプを探す/新規"
+"Choose a suitable value" "適したバリューを選ぶ"
+"Adopt this value" "このバリューを採用する"
+"Go to first line" "最初の列にいく"
+"Scroll up one page" "一ページ上へスクロール"
+"Scroll up one line" "一行上へスクロール"
+"Scroll down one line" "一行下へスクロール"
+"Scroll down one page" "一ページ下へスクロール"
+"Go to last line" "最後の列にいく"
+"Delete row" "行を消す"
+"Shift row up" "行を上へ移す"
+"Clear all input fields" "全ての入力フィールドを消す"
+"Release exclusive write access for this object" "Release exclusive write access for this object"
+"Gain exclusive write access for this object" "Gain exclusive write access for this object"
+"Start search" "検索スタート"
+"Create new object" "オブジェクトを新規"
+"Create a new copy of this object" "このオブジェクトを新しくコピーする"
+"Mark this object as \"not deleted\"" "このオブジェクトを消さない状態にする"
+"Mark this object as \"deleted\"" "このオブジェクトを消された状態にする"
+"Update" "更新"
diff --git a/loc/no b/loc/no
@@ -0,0 +1,77 @@
+# 13jan10jk
+# Jon Kleiser, jon.kleiser@usit.uio.no
+
+"Language" "Språk"
+
+# lib/db.l
+"Boolean input expected" "Boolsk verdi forventet"
+"Numeric input expected" "Numerisk verdi forventet"
+"Symbolic type expected" "Symbol-type forventet"
+"String type expected" "Tekststreng forventet"
+"Type error" "Type-feil"
+"Not unique" "Ikke unik"
+"Input required" "Input-data påkrevet"
+
+# lib/form.l
+"Cancel" "Avbryt"
+"Yes" "Ja"
+"No" "Nei"
+"Select" "Velg"
+"Delete row?" "Slett rad?"
+"Show" "Vis"
+"Bad date format" "Ugyldig datoformat"
+"Bad time format" "Ugyldig tidsformat"
+"Bad phone number format" "Ugyldig telefonnummer-format"
+"male" "mannlig"
+"female" "kvinnelig"
+"New" "Ny"
+"Edit" "Rediger"
+"Save" "Lagre"
+"Done" "Ferdig"
+"Currently edited by '@2' (@1)" "Redigeres nå av '@2' (@1)"
+"Search" "Søk"
+"Reset" "Tilbakestill"
+"New/Copy" "Ny/Kopi"
+"Restore" "Gjenopprett"
+"Restore @1?" "Gjenopprette @1?"
+"Delete" "Slett"
+"Delete @1?" "Slett @1?"
+"Data not found" "Data ble ikke funnet"
+
+# General
+"login" "logg inn"
+"logout" "logg ut"
+"' logged in" "' er innlogget"
+"Name" "Navn"
+"Password" "Passord"
+"Permission denied" "Ingen adgangsrett"
+"Permissions" "Adgangsrettigheter"
+"Role" "Rolle"
+"Roles" "Roller"
+"User" "Bruker"
+"Users" "Brukere"
+
+# Tooltips
+"Open submenu" "Åpne undermeny"
+"Close submenu" "Lukk undermeny"
+"Next object of the same type" "Neste objekt av samme type"
+"Find or create an object of the same type" "Finn eller opprett et objekt av samme type"
+"Choose a suitable value" "Velg en passende verdi"
+"Adopt this value" "Overta denne verdien"
+"Go to first line" "Gå til første linje"
+"Scroll up one page" "Scroll opp en side"
+"Scroll up one line" "Scroll opp en linje"
+"Scroll down one line" "Scroll ned en linje"
+"Scroll down one page" "Scroll ned en side"
+"Go to last line" "Gå til siste linje"
+"Delete row" "Slett rad"
+"Shift row up" "Forskyv en rad opp"
+"Clear all input fields" "Slett alle input-felter"
+"Release exclusive write access for this object" "Frigi eksklusiv skrivetilgang til dette objektet"
+"Gain exclusive write access for this object" "Innhent eksklusiv skrivetilgang til dette objektet"
+"Start search" "Start søk"
+"Create new object" "Opprett nytt objekt"
+"Create a new copy of this object" "Opprett ny kopi av dette objektet"
+"Mark this object as \"not deleted\"" "Merk dette objektet som \"ikke slettet\""
+"Mark this object as \"deleted\"" "Merk dette objektet som \"slettet\""
+"Update" "Oppdater"
diff --git a/loc/ru b/loc/ru
@@ -0,0 +1,77 @@
+# 11aug08
+# Mansur Mamkin <mmamkin@mail.ru>
+
+"Language" "Язык"
+
+# lib/db.l
+"Boolean input expected" "Ожидается тип Boolean"
+"Numeric input expected" "Ожидается числовой тип"
+"Symbolic type expected" "Ожидается тип Symbol"
+"String type expected" "Ожидается тип String"
+"Type error" "Ошибка типа"
+"Not unique" "Не уникальный"
+"Input required" "Требуется ввод"
+
+# lib/form.l
+"Cancel" "Отмена"
+"Yes" "Да"
+"No" "Нет"
+"Select" "Выбрать"
+"Delete row?" "Удалить строку?"
+"Show" "Показать"
+"Bad date format" "Неверный формат даты"
+"Bad time format" "Неверный формат времени"
+"Bad phone number format" "Неверный формат телефонного номера"
+"male" "муж."
+"female" "жен."
+"New" "Новый"
+"Edit" "Редактировать"
+"Save" "Сохранить"
+"Done" "Готово"
+"Currently edited by '@2' (@1)" "Редактируется '@2' (@1)"
+"Search" "Искать"
+"Reset" "Сброс"
+"New/Copy" "Новый/Копировать"
+"Restore" "Восстановить"
+"Restore @1?" "Восстановить @1?"
+"Delete" "Удалить"
+"Delete @1?" "Удалить @1?"
+"Data not found" "Данные не найдены"
+
+# General
+"login" "Войти"
+"logout" "Выйти"
+"' logged in" "' вошел"
+"Name" "Имя"
+"Password" "Пароль"
+"Permission denied" "Доступ запрещен"
+"Permissions" "Разрешения"
+"Role" "Роль"
+"Roles" "Роли"
+"User" "Пользователь"
+"Users" "Пользователи"
+
+# Tooltips
+"Open submenu" "Открыть подменю"
+"Close submenu" "Закрыть подменю"
+"Next object of the same type" "Следующий объект такого же типа"
+"Find or create an object of the same type" "Найти или создать объект такого же типа"
+"Choose a suitable value" "Выберите подходящее значение"
+"Adopt this value" "Принять это значение"
+"Go to first line" "Перейти к первой строке"
+"Scroll up one page" "Прокрутить вверх на одну страницу"
+"Scroll up one line" "Прокрутить вверх на одну строку"
+"Scroll down one line" "Прокрутить вниз на одну строку"
+"Scroll down one page" "Прокрутить вниз на одну страницу"
+"Go to last line" "Перейти к последней строке"
+"Delete row" "Удалить строку"
+"Shift row up" "Переместить строку вверх"
+"Clear all input fields" "Очистить все поля ввода"
+"Release exclusive write access for this object" "Закрыть эксклюзивный доступ для записи этого объекта"
+"Gain exclusive write access for this object" "Получить эксклюзивный доступ для записи этого объекта"
+"Start search" "Начать поиск"
+"Create new object" "Создать новый объект"
+"Create a new copy of this object" "Создать новую копию этого объекта"
+"Mark this object as \"not deleted\"" "Отметить этот объект как \"не удалённый\""
+"Mark this object as \"deleted\"" "Отметить этот объект как \"удалённый\""
+"Update" "Обновить"
diff --git a/misc/bigtest b/misc/bigtest
@@ -0,0 +1,103 @@
+#!bin/picolisp lib.l
+# 23jan10abu
+# misc/bigtest <seed>
+
+(load "lib/misc.l")
+
+(seed (car (argv)))
+
+#  Random patterns:
+#  cnt
+#     xxx0000000000000000000000000xxxx0000000000000000000000000xxx
+#        (| 7 (>> -28 15) (>> -57 7))
+#
+#     xxx1111111111111111111111111xxxx1111111111111111111111111xxx
+#        1FFFFFF0FFFFFF8
+#
+#
+#  dig
+#     xxx000000000000000000000000000xxxx000000000000000000000000000xxx
+#        (| 7 (>> -30 15) (>> -61 7))
+#
+#     xxx111111111111111111111111111xxxx111111111111111111111111111xxx
+#        1FFFFFFC3FFFFFF8
+
+(de rnd ()
+   (let (Big (| (rand 0 7) (>> -28 (rand 0 15)) (>> -57 (rand 0 7)))  N -60)
+      (when (rand T)
+         (setq Big (| Big `(hex "1FFFFFF0FFFFFF8"))) )
+      (do (rand 0 2)
+         (let Dig (| (rand 0 7) (>> -30 (rand 0 15)) (>> -61 (rand 0 7)))
+            (when (rand T)
+               (setq Dig (| Dig `(hex "1FFFFFFC3FFFFFF8"))) )
+            (setq Big (| Big (>> N Dig)))
+            (dec 'N 64) ) )
+      (if (rand T) Big (- Big)) ) )
+
+
+(de test1 (S N1)
+   (let (N (read)  X (eval (list S N1)))
+      (unless (= N X)
+         (prinl "^J" N ": (" S " " N1 ") -> " X)
+         (bye) ) ) )
+
+(de test2 (S N1 N2)
+   (let (N (read)  X (eval (list S N1 N2)))
+      (unless (= N X)
+         (prinl "^J" N ": (" S " " N1 " " N2 ") -> " X)
+         (bye) ) ) )
+
+(de cmp2 (S N1 N2)
+   (let (N (n0 (read))  X (eval (list S N1 N2)))
+      (unless (== N X)
+         (prinl "^J" N ": (" S " " N1 " " N2 ") -> " X)
+         (bye) ) ) )
+
+
+(sys "BC_LINE_LENGTH" "200")
+
+(pipe
+   (out '("/usr/bin/bc")
+      (do 10000000
+         (setq N1 (rnd))
+         (while (=0 (setq N2 (rnd))))
+         (prinl N1)
+         (prinl N2)
+         (prinl N1 " + " N2)
+         (prinl N1 " + 1")
+         (prinl N1 " + 1")
+         (prinl N1 " - " N2)
+         (prinl N1 " - 1")
+         (prinl N1 " - 1")
+         (prinl N1 " * " N2)
+         (prinl N1 " * 2")
+         (prinl N1 " % " N2)
+         (prinl N1 " / " N2)
+         (prinl N1 " / 2")
+         (prinl N1 " >= " N2)
+         (prinl N1 " > " N2)
+         (prinl "sqrt(" (abs N1) ")") ) )
+   (do 100
+      (do 100000
+         (setq
+            N1 (read)
+            N2 (read) )
+         (test2 '+ N1 N2)
+         (test2 '+ N1 1)
+         (test1 'inc N1)
+         (test2 '- N1 N2)
+         (test2 '- N1 1)
+         (test1 'dec N1)
+         (test2 '* N1 N2)
+         (test2 '* N1 2)
+         (test2 '% N1 N2)
+         (test2 '/ N1 N2)
+         (test2 '/ N1 2)
+         (cmp2 '>= N1 N2)
+         (cmp2 '> N1 N2)
+         (test1 'sqrt (abs N1)) )
+      (prin ".")
+      (flush) )
+   (prinl) )
+
+(bye)
diff --git a/misc/calc b/misc/calc
@@ -0,0 +1,12 @@
+#!bin/picolisp lib.l
+# 21jan07abu
+# (c) Software Lab. Alexander Burger
+
+(load "@lib/misc.l" "@misc/calc.l")
+
+# Initialize
+(main)
+
+# Start server
+(go)
+(wait)
diff --git a/misc/calc.l b/misc/calc.l
@@ -0,0 +1,73 @@
+# 17apr08abu
+# (c) Software Lab. Alexander Burger
+
+# *Init *Accu *Stack
+
+(allowed NIL "@calculator" "favicon.ico" "lib.css")
+(load "lib/http.l" "lib/xhtml.l" "lib/form.l")
+
+# Calculator logic
+(de digit (N)
+   (when *Init (zero *Accu) (off *Init))
+   (setq *Accu (+ N (* 10 *Accu))) )
+
+(de calc ()
+   (let (Fun (caar *Stack)  Val (cddr (pop '*Stack)))
+      (setq *Accu
+         (if (and (== '/ Fun) (=0 *Accu))
+            (alert "Div / 0")
+            (Fun Val *Accu) ) ) ) )
+
+(de operand (Fun Prio)
+   (when (>= (cadar *Stack) Prio) (calc))
+   (push '*Stack (cons Fun Prio *Accu))
+   (on *Init) )
+
+(de finish ()
+   (while *Stack (calc))
+   (on *Init) )
+
+# Calculator GUI
+(de calculator ()
+   (app)
+   (action
+      (html 0 "Bignum Calculator" "lib.css" NIL
+         (<h2> NIL "Bignum Calculator")
+         (form NIL
+            (<br> (gui '(+Var +NumField) '*Accu 60))
+            (<grid> 4
+               (gui '(+JS +Button) "±" '(setq *Accu (- *Accu)))
+               (gui '(+Able +JS +Button) '(ge0 *Accu) (char 8730)
+                  '(setq *Accu (sqrt *Accu)) )
+               (gui '(+JS +Button) "\^" '(operand '** 3))
+               (gui '(+JS +Button) "/" '(operand '/ 2))
+
+               (gui '(+JS +Button) "7" '(digit 7))
+               (gui '(+JS +Button) "8" '(digit 8))
+               (gui '(+JS +Button) "9" '(digit 9))
+               (gui '(+JS +Button) "*" '(operand '* 2))
+
+               (gui '(+JS +Button) "4" '(digit 4))
+               (gui '(+JS +Button) "5" '(digit 5))
+               (gui '(+JS +Button) "6" '(digit 6))
+               (gui '(+JS +Button) "-" '(operand '- 1))
+
+               (gui '(+JS +Button) "1" '(digit 1))
+               (gui '(+JS +Button) "2" '(digit 2))
+               (gui '(+JS +Button) "3" '(digit 3))
+               (gui '(+JS +Button) "+" '(operand '+ 1))
+
+               (gui '(+JS +Button) "0" '(digit 0))
+               (gui '(+JS +Button) "C" '(zero *Accu))
+               (gui '(+JS +Button) "A" '(main))
+               (gui '(+JS +Button) "=" '(finish)) ) ) ) ) )
+
+# Initialize
+(de main ()
+   (on *Init)
+   (zero *Accu)
+   (off *Stack) )
+
+# Start server
+(de go ()
+   (server 8080 "@calculator") )
diff --git a/misc/chat b/misc/chat
@@ -0,0 +1,32 @@
+#!bin/picolisp lib.l
+# 21dec05abu
+
+# *Port *Sock *Name
+
+(de chat Lst
+   (out *Sock
+      (mapc prin Lst)
+      (prinl) ) )
+
+
+(setq *Port (port 4004))
+
+(loop
+   (setq *Sock (listen *Port))
+   (NIL (fork) (close *Port))
+   (close *Sock) )
+
+(out *Sock
+   (prin "Please enter your name: ")
+   (flush) )
+(in *Sock (setq *Name (line T)))
+
+(tell 'chat "+++ " *Name " arrived +++")
+
+(task *Sock
+   (in @
+      (ifn (eof)
+         (tell 'chat *Name "> " (line T))
+         (tell 'chat "--- " *Name " left ---")
+         (bye) ) ) )
+(wait)
diff --git a/misc/crc.l b/misc/crc.l
@@ -0,0 +1,23 @@
+# 04sep06abu
+# (c) Software Lab. Alexander Burger
+
+(load "lib/gcc.l")
+
+(gcc "crc" NIL 'crc)
+
+any crc(any ex) {
+   any x = EVAL(cadr(ex));
+   int c, crc, i;
+
+   NeedLst(ex,x);
+   for (crc = 0; isCell(x); 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;
+      }
+   }
+   return boxCnt(crc);
+}
+/**/
diff --git a/misc/dining.l b/misc/dining.l
@@ -0,0 +1,42 @@
+# 18mar10abu
+# (c) Software Lab. Alexander Burger
+# Dining Philosophers
+
+(de dining (Name State)
+   (loop
+      (prinl Name ": " State)
+      (state 'State                       # Dispatch according to state
+         (thinking 'hungry)               # If thinking, get hungry
+         (hungry                          # If hungry, grab random fork
+            (if (rand T)
+               (and (acquire leftFork) 'leftFork)
+               (and (acquire rightFork) 'rightFork) ) )
+         (hungry 'hungry                  # Failed, stay hungry for a while
+            (wait (rand 1000 3000)) )
+         (leftFork                        # If holding left fork, try right one
+            (and (acquire rightFork) 'eating)
+            (wait 2000) )                 # then eat for 2 seconds
+         (rightFork                       # If holding right fork, try left one
+            (and (acquire leftFork) 'eating)
+            (wait 2000) )                 # then eat for 2 seconds
+         ((leftFork rightFork) 'hungry    # Otherwise, go back to hungry,
+            (release (val State))         # release left or right fork
+            (wait (rand 1000 3000)) )     # and stay hungry
+         (eating 'thinking             # After eating, resume thinking
+            (release leftFork)
+            (release rightFork)
+            (wait 6000) ) ) ) )           # for 6 seconds
+
+(setq *Philosophers
+   (maplist
+      '((Phils Forks)
+         (let (leftFork (tmp (car Forks))  rightFork (tmp (cadr Forks)))
+            (or
+               (fork)  # Parent: Collect child process IDs
+               (dining (car Phils) 'hungry) ) ) )  # Initially hungry
+      '("Aristotle" "Kant" "Spinoza" "Marx" "Russell")
+      '("ForkA" "ForkB" "ForkC" "ForkD" "ForkE" .) ) )
+
+(push '*Bye '(mapc kill *Philosophers))  # Terminate all upon exit
+
+# vi:et:ts=3:sw=3
diff --git a/misc/dirTree.l b/misc/dirTree.l
@@ -0,0 +1,19 @@
+# 10jul08abu
+# (c) Software Lab. Alexander Burger
+
+(load "lib/http.l" "lib/xhtml.l")
+
+(de subDirs (Dir)
+   (cache '*DirCache (or (pack (flip (chop Dir))) ".")
+      (extract
+         '((F)
+            (when (=T (car (info (setq F (pack Dir F)))))
+               (pack F '/) ) )
+         (dir Dir) ) ) )
+
+(de dir.html (Path)
+   (and (app) (setq *DirTree (subDirs)))
+   (html NIL "Test" NIL NIL
+      (<tree> "@dir.html" Path *DirTree subDirs nil subDirs) ) )
+
+(server 8080 "@dir.html")
diff --git a/misc/fannkuch.l b/misc/fannkuch.l
@@ -0,0 +1,38 @@
+# 07nov09abu
+# (c) Software Lab. Alexander Burger
+# Fannkuch benchmark (http://shootout.alioth.debian.org)
+
+(de fannkuch (N)
+   (let (Lst (range 1 N)  L Lst  Max)
+      (recur (L)  # Permute
+         (if (cdr L)
+            (do (length L)
+               (recurse (cdr L))
+               (rot L) )
+            (zero N)  # For each permutation
+            (for (P (copy Lst)  (> (car P) 1)  (flip P (car P)))
+               (inc 'N) )
+            (setq Max (max N Max)) ) )
+      Max ) )
+
+# Parallelized version
+(de fannkuch+ (N)
+   (let (Res (need N)  Lst (range 1 N)  L Lst  Max)
+      (for (R Res R (cdr R))
+         (later R
+            (let L (cdr Lst)
+               (recur (L)  # Permute
+                  (if (cdr L)
+                     (do (length L)
+                        (recurse (cdr L))
+                        (rot L) )
+                     (zero N)  # For each permutation
+                     (for (P (copy Lst)  (> (car P) 1)  (flip P (car P)))
+                        (inc 'N) )
+                     (setq Max (max N Max)) ) )
+               Max ) )
+         (rot Lst) )
+      (wait NIL (full Res))
+      (apply max Res) ) )
+
+# vi:et:ts=3:sw=3
diff --git a/misc/fibo.l b/misc/fibo.l
@@ -0,0 +1,50 @@
+# 08mar10abu
+# (c) Software Lab. Alexander Burger
+
+# Standard version
+(de fibo (N)
+   (if (> 2 N)
+      1
+      (+ (fibo (dec N)) (fibo (- N 2))) ) )
+
+
+# Parallelized version
+(de fibo+ (D N)  # Uses 2**D processes
+   (cond
+      ((> 1 (dec 'N)) 1)
+      ((ge0 (dec 'D))
+         (let (A NIL B NIL)
+            (later 'A (fibo+ D N))
+            (later 'B (fibo+ D (dec N)))
+            (wait NIL (and A B))
+            (+ A B) ) )
+      (T
+         (+
+            (fibo+ D N)
+            (fibo+ D (dec N)) ) ) ) )
+
+
+# Using a cache (fastest)
+(de cachedFibo (N)
+   (cache '*Fibo (format (seed N))
+      (if (> 2 N)
+         1
+         (+ (cachedFibo (dec N)) (cachedFibo (- N 2))) ) ) )
+
+
+# Coded in 'C'
+`(== 64 64)  # Only in the 64-bit version
+
+(load "lib/native.l")
+
+(gcc "fibo" NIL
+   (cFibo (N) "Fibo" 'I N) )
+
+int Fibo(int n) {
+   if (n < 2)
+      return 1;
+   return Fibo(n-1) + Fibo(n-2);
+}
+/**/
+
+# vi:et:ts=3:sw=3
diff --git a/misc/hanoi.l b/misc/hanoi.l
@@ -0,0 +1,24 @@
+# 10nov04abu
+# (c) Software Lab. Alexander Burger
+
+# Lisp
+(de hanoi (N)
+   (move N 'left 'center 'right) )
+
+(de move (N A B C)
+   (unless (=0 N)
+      (move (dec N) A C B)
+      (println 'Move 'disk 'from 'the A 'to 'the B 'pole)
+      (move (dec N) C B A) ) )
+
+# Pilog
+(be hanoi (@N)
+   (move @N left center right) )
+
+(be move (0 @ @ @) T)
+
+(be move (@N @A @B @C)
+   (@M - (-> @N) 1)
+   (move @M @A @C @B)
+   (@ println 'Move 'disk 'from 'the (-> @A) 'to 'the (-> @B) 'pole)
+   (move @M @C @B @A) )
diff --git a/misc/life.l b/misc/life.l
@@ -0,0 +1,54 @@
+# 15mar10abu
+# (c) Software Lab. Alexander Burger
+
+(load "@lib/simul.l")
+
+(de life (DX DY . Init)
+   (let Grid (grid DX DY)
+      (for This Init
+         (=: life T) )
+      (loop
+         (disp Grid NIL
+            '((This) (if (: life) "X " "  ")) )
+         (wait 1000)
+         (for Col Grid
+            (for This Col
+               (let N  # Count neighbors
+                  (cnt
+                     '((Dir) (get (Dir This) 'life))
+                     (quote
+                        west east south north
+                        ((X) (south (west X)))
+                        ((X) (north (west X)))
+                        ((X) (south (east X)))
+                        ((X) (north (east X))) ) )
+                  (=: next  # Next generation
+                     (if (: life)
+                        (>= 3 N 2)
+                        (= N 3) ) ) ) ) )
+         (for Col Grid  # Update
+            (for This Col
+               (=: life (: next)) ) ) ) ) )
+
+# Blinker (period 2)
+'(life 5 5  b3 c3 d3)
+
+# Glider
+'(life 9 9  a7 b7 b9 c7 c8)
+
+# Pulsar (period 3)
+(life 17 17
+   b6 b12
+   c6 c12
+   d6 d7 d11 d12 
+   f2 f3 f4 f7 f8 f10 f11 f14 f15 f16
+   g4 g6 g8 g10 g12 g14
+   h6 h7 h11 h12
+   j6 j7 j11 j12
+   k4 k6 k8 k10 k12 k14
+   l2 l3 l4 l7 l8 l10 l11 l14 l15 l16
+   n6 n7 n11 n12 
+   o6 o12
+   p6 p12 )
+
+# vi:et:ts=3:sw=3
diff --git a/misc/mailing b/misc/mailing
@@ -0,0 +1,93 @@
+#!bin/picolisp lib.l
+# 05sep08abu
+# (c) Software Lab. Alexander Burger
+
+# Configuration
+(setq
+   *MailingList "picolisp@software-lab.de"
+   *SpoolFile "/var/mail/picolisp"
+   *MailingDomain "software-lab.de"
+   *Mailings (make (in "Mailings" (while (line T) (link @))))
+   *SmtpHost "localhost"
+   *SmtpPort 25 )
+
+# Process mails
+(loop
+   (when (gt0 (car (info *SpoolFile)))
+      (protect
+         (in *SpoolFile
+            (unless (= "From" (till " " T))
+               (quit "Bad mbox file") )
+            (char)
+            (while (setq *From (lowc (till " " T)))
+               (off
+                  *Name *Subject *Date *MessageID *InReplyTo *MimeVersion
+                  *ContentType *ContentDisposition *UserAgent )
+               (while (split (line) " ")
+                  (setq *Line (glue " " (cdr @)))
+                  (case (pack (car @))
+                     ("From:" (setq *Name *Line))
+                     ("Subject:" (setq *Subject *Line))
+                     ("Date:" (setq *Date *Line))
+                     ("Message-ID:" (setq *MessageID *Line))
+                     ("In-Reply-To:" (setq *InReplyTo *Line))
+                     ("MIME-Version:" (setq *MimeVersion *Line))
+                     ("Content-Type:" (setq *ContentType *Line))
+                     ("Content-Disposition:" (setq *ContentDisposition *Line))
+                     ("User-Agent:" (setq *UserAgent *Line)) ) )
+               (if (nor (member *From *Mailings) (= "subscribe" (lowc *Subject)))
+                  (out "/dev/null" (echo "^JFrom ") (msg *From " discarded"))
+                  (unless (setq *Sock (connect *SmtpHost *SmtpPort))
+                     (quit "Can't connect to SMTP server") )
+                  (unless
+                     (and
+                        (pre? "220 " (in *Sock (line T)))
+                        (out *Sock (prinl "HELO " *MailingDomain "^M"))
+                        (pre? "250 " (in *Sock (line T)))
+                        (out *Sock (prinl "MAIL FROM:" *MailingList "^M"))
+                        (pre? "250 " (in *Sock (line T))) )
+                     (quit "Can't HELO") )
+                  (when (= "subscribe" (lowc *Subject))
+                     (push1 '*Mailings *From)
+                     (out "Mailings" (mapc prinl *Mailings)) )
+                  (for To *Mailings
+                     (out *Sock (prinl "RCPT TO:" To "^M"))
+                     (unless (pre? "250 " (in *Sock (line T)))
+                        (msg T " can't mail") ) )
+                  (when (and (out *Sock (prinl "DATA^M")) (pre? "354 " (in *Sock (line T))))
+                     (out *Sock
+                        (prinl "From: " (or *Name *From) "^M")
+                        (prinl "Sender: " *MailingList "^M")
+                        (prinl "Reply-To: " *MailingList "^M")
+                        (prinl "To: " *MailingList "^M")
+                        (prinl "Subject: " *Subject "^M")
+                        (and *Date (prinl "Date: " @ "^M"))
+                        (and *MessageID (prinl "Message-ID: " @ "^M"))
+                        (and *InReplyTo (prinl "In-Reply-To: " @ "^M"))
+                        (and *MimeVersion (prinl "MIME-Version: " @ "^M"))
+                        (and *ContentType (prinl "Content-Type: " @ "^M"))
+                        (and *ContentDisposition (prinl "Content-Disposition: " @ "^M"))
+                        (and *UserAgent (prinl "User-Agent: " @ "^M"))
+                        (prinl "^M")
+                        (cond
+                           ((= "subscribe" (lowc *Subject))
+                              (prinl "Hello " (or *Name *From) " :-)^M")
+                              (prinl "You are now subscribed^M")
+                              (prinl "****^M^J^M") )
+                           ((= "unsubscribe" (lowc *Subject))
+                              (out "Mailings"
+                                 (mapc prinl (del *From '*Mailings)) )
+                              (prinl "Good bye " (or *Name *From) " :-(^M")
+                              (prinl "You are now unsubscribed^M")
+                              (prinl "****^M^J^M") ) )
+                        (echo "^JFrom ")
+                        (prinl "-- ^M")
+                        (prinl "UNSUBSCRIBE: mailto:" *MailingList "?subject=Unsubscribe^M")
+                        (prinl ".^M")
+                        (prinl "QUIT^M") ) )
+                  (close *Sock) ) ) )
+         (out *SpoolFile (rewind)) ) )
+   (call "fetchmail" "-as")
+   (wait `(* 5 60 1000)) )
+
+# vi:et:ts=3:sw=3
diff --git a/misc/maze.l b/misc/maze.l
@@ -0,0 +1,33 @@
+# 31jan10abu
+# (c) Software Lab. Alexander Burger
+
+# ./dbg misc/maze.l -"setq M (maze 16 10)" -"display M"
+
+(load "lib/simul.l")
+
+(de maze (DX DY)
+   (let Maze (grid DX DY)
+      (let Fld (get Maze (rand 1 DX) (rand 1 DY))
+         (recur (Fld)
+            (for Dir (shuffle '((west . east) (east . west) (south . north) (north . south)))
+               (with ((car Dir) Fld)
+                  (unless (or (: west) (: east) (: south) (: north))
+                     (put Fld (car Dir) This)
+                     (put This (cdr Dir) Fld)
+                     (recurse This) ) ) ) ) )
+      (for Col Maze
+         (for This Col
+            (set This
+               (cons
+                  (cons (: west) (: east))
+                  (cons (: south) (: north)) ) )
+            (=: west)
+            (=: east)
+            (=: south)
+            (=: north) ) )
+      Maze ) )
+
+(de display (Maze)
+   (disp Maze 0 '((This) "   ")) )
+
+# vi:et:ts=3:sw=3
diff --git a/misc/pi.l b/misc/pi.l
@@ -0,0 +1,23 @@
+# 14aug05abu
+# (c) Software Lab. Alexander Burger
+
+##############################
+# Iterative calculation of PI:
+#  S = 0
+#  P = 2
+#  Loop
+#     S = sqrt(S+2)
+#     P = 2*P/S
+##############################
+
+(de pi (N Eps)
+   (default Eps 100)
+   (let (Scl (** 10 N)  S 0  N2 (* 2 Scl)  P N2  P2 0)
+      (while (> (- P P2) Eps)
+         (setq
+            P2 P
+            S (sqrt (* Scl (+ S N2)))
+            P (*/ N2 P S) ) ) ) )
+
+(test 3141592653589793238462643383279502884197169399375105820975043
+   (pi 60) )
diff --git a/misc/pilog.l b/misc/pilog.l
@@ -0,0 +1,125 @@
+# 25dec09abu
+# (c) Software Lab. Alexander Burger
+
+(be sister (@X @Y) (parents @X @M @F) (parents @Y @M @F) (different @X @Y))
+
+(be parents (@C @M @F) (mother @C @M) (father @C @F))
+
+(be mother (Mia Masako))
+(be mother (Laila Masako))
+(be mother (Mona Masako))
+
+(be father (Mia Alex))
+(be father (Laila Alex))
+(be father (Mona Alex))
+
+(be factorial (0 1) T)
+(be factorial (@N @X)
+   (@A - (-> @N) 1)
+   (factorial @A @B)
+   (@X * (-> @N) (-> @B)) )
+
+(be fibo (0 1) T)
+(be fibo (1 1) T)
+(be fibo (@N @X)
+   (@Y - (-> @N) 1)
+   (@Z - (-> @N) 2)
+   (fibo @Y @A)
+   (fibo @Z @B)
+   (@X + (-> @A) (-> @B))
+   (asserta (fibo (@N @X) T)) )
+
+
+(be int (@N)
+   (@ zero *N)
+   (repeat)
+   (@N inc '*N) )
+
+(be prnum ()
+   (@ zero *N)
+   (repeat)
+   (@ println (inc '*N))
+   (@ >= *N 4) )
+
+(be gennum (@N)
+   (@C box 0)
+   (_gennum @N @C) )
+
+(be _gennum (@N @C) (@ >= (val (-> @C)) 4) T (fail))
+(be _gennum (@N @C) (@N inc (-> @C)))
+(repeat)
+
+(be genlst (@X)
+   (@C box (1 2 3 4))
+   (_genlst @X @C) )
+
+(be _genlst (@X @C) (@ not (val (-> @C))) T (fail))
+(be _genlst (@X @C) (@X pop (-> @C)))
+(repeat)
+
+(be tree (@K (@K @V @L @R) @V)
+   T )
+
+(be tree (@K (@K1 @V1 @L @R) @V)
+   (@ < (-> @K) (-> @K1))
+   (tree @K @L @V) )
+
+(be tree (@K (@K1 @V1 @L @R) @V)
+   (@ >= (-> @K) (-> @K1))
+   (tree @K @R @V) )
+
+
+(be change (you I))
+(be change (are (am not)))
+(be change (french german))
+(be change (@X @X))
+
+
+### Test ###
+(test NIL (solve '((equal A B))))
+(test '(T) (solve '((equal A A))))
+
+(test NIL (solve '((not (equal A A)))))
+(test '(T) (solve '((not (equal A B)))))
+
+(test NIL (solve '((different A A))))
+(test '(T) (solve '((different A B))))
+
+(test
+   '(((@X . 3)) ((@X . 4)))
+   (solve '((or ((equal 3 @X)) ((equal 4 @X))))) )
+
+(test '(T) (solve '((append (a b) (c d) (a b c d)))))
+(test
+   '(((@X) (@Y a b c)) ((@X a) (@Y b c)) ((@X a b) (@Y c)) ((@X a b c) (@Y)))
+   (solve '((append @X @Y (a b c)))) )
+
+(test '(T) (solve '((member b (a b c)))))
+(test
+   '(((@X . a)) ((@X . b)) ((@X . c)))
+   (solve '((member @X (a b c)))) )
+
+(test '(T) (solve '((clause append ((NIL @X @X))))))
+
+(test
+   '(a b c d)
+   (solve '((@B box) (lst @X (a b c b c d)) (uniq @B @X)) @X) )
+
+
+(test
+   '(((@B . Mia)) ((@B . Mona)))
+   (solve '((sister Laila @B))) )
+
+(test
+   '(((@X . 1)) ((@X . 2)) ((@X . 3)) ((@X . 4)))
+   (solve '((gennum @X))) )
+
+(test
+   '(((@X . 1)) ((@X . 2)) ((@X . 3)) ((@X . 4)))
+   (solve '((genlst @X))) )
+
+(test
+   '(((@Z I (am not) a computer)))
+   (solve '((mapcar change (you are a computer) @Z) T)) )
+
+# vi:et:ts=3:sw=3
diff --git a/misc/reverse.l b/misc/reverse.l
@@ -0,0 +1,16 @@
+# 19dec05abu
+# (c) Software Lab. Alexander Burger
+
+(setq *Port (port 6789))
+
+(loop
+   (setq *Sock (listen *Port))
+   (NIL (fork) (close *Port))
+   (close *Sock) )
+
+(in *Sock
+   (until (eof)
+      (out *Sock
+         (prinl (flip (line))) ) ) )
+
+(bye)
diff --git a/misc/setf.l b/misc/setf.l
@@ -0,0 +1,49 @@
+# 31jan08abu
+# (c) Software Lab. Alexander Burger
+
+# 'setf' is the most perverse concept ever introduced into Lisp
+(de setf "Args"
+   (let "P" (car "Args")
+      (set
+         (if (atom "P")
+            "P"
+            (let (: ::  get prop  car prog  cadr cdr  caddr cadr  cadddr caddr)
+               (eval "P") ) )
+         (eval (cadr "Args")) ) ) )
+
+### Test ###
+(test 7
+   (use A
+      (setf A 7)
+      A ) )
+
+(test (7 2 3)
+   (let L (1 2 3)
+      (setf (car L) 7)
+      L ) )
+
+(test (1 7 3)
+   (let L (1 2 3)
+      (setf (cadr L) 7)
+      L ) )
+
+(test 7
+   (put 'A 'a 1)
+   (setf (get 'A 'a) 7)
+   (get 'A 'a) )
+
+(test 7
+   (put 'A 'a 1)
+   (with 'A
+      (setf (: a) 7)
+      (: a) ) )
+
+# But also:
+(undef 'foo)
+(de foo (X)
+   (cadr X) )
+
+(test (1 7 3)
+   (let L (1 2 3) (setf (foo L) 7) L) )
+
+# vi:et:ts=3:sw=3
diff --git a/misc/sieve.l b/misc/sieve.l
@@ -0,0 +1,14 @@
+# 25feb10abu
+# (c) Software Lab. Alexander Burger
+
+# Sieve of Eratosthenes
+(de sieve (N)
+   (let Sieve (range 1 N)
+      (set Sieve)
+      (for I (cdr Sieve)
+         (when I
+            (for (S (nth Sieve (* I I)) S (nth (cdr S) I))
+               (set S) ) ) )
+      (filter bool Sieve) ) )
+
+# vi:et:ts=3:sw=3
diff --git a/misc/stress.l b/misc/stress.l
@@ -0,0 +1,68 @@
+# 22mar10abu
+# (c) Software Lab. Alexander Burger
+# Use: nice ./p misc/stress.l -main -go -bye; rm db/test jnl db/test2
+
+(load "lib/too.l")
+
+(class +A +Entity)
+(rel key (+Key +Number))               # Key  1 .. 999
+(rel dat (+Ref +Number))               # Data 1 .. 999
+
+(de rnd ()
+   (rand 1 999) )
+
+(de modify (N)
+   (do N
+      (do (rand 10 40)
+         (let K (rnd)
+            (with (db 'key '+A K)
+               (unless (= K (: key))
+                  (print '!)
+                  (flush) ) ) ) )
+      (dbSync)
+      (let (D (rnd)  X (db 'key '+A (rnd)))
+         (inc *DB (- D (get X 'dat)))
+         (put> X 'dat D) )
+      (commit 'upd) ) )
+
+(de verify ()
+   (dbCheck)
+   (let N 0
+      (scan (tree 'dat '+A)
+         '((K V)
+            (unless (= (car K) (get V 'dat))
+               (quit "dat mismatch" K) )
+            (inc 'N (car K)) ) )
+      (or
+         (= N (val *DB))
+         (quit "val mismatch" (- N (val *DB))) ) ) )
+
+(de main ()
+   (seed (in "/dev/urandom" (rd 8)))
+   (call 'mkdir "-p" "db")
+   (call 'rm "-f" "db/test" "jnl" "db/test2")
+   (pool "db/test" NIL "jnl")
+   (set *DB 0)
+   (for K 999
+      (let D (rnd)
+         (new T '(+A)  'key K  'dat D)
+         (inc *DB D) ) )
+   (commit) )
+
+(de go ()
+   (do 10
+      (let Pids
+         (make
+            (do 40
+               (rand)
+               (if (fork)
+                  (link @)
+                  (modify 999)
+                  (bye) ) ) )
+         (while (find '((P) (kill P 0)) Pids)
+            (wait 1000) )
+         (rollback) ) )
+   (verify)
+   (pool "db/test2")
+   (journal "jnl")
+   (call 'cmp "db/test" "db/test2") )
diff --git a/misc/travel.l b/misc/travel.l
@@ -0,0 +1,51 @@
+# 22oct03abu
+# (c) Software Lab. Alexander Burger
+
+(de travel (A B)
+   (mini car
+      (solve
+         (quote
+            @A A
+            @B B
+            (path @A @B @P @N) )
+         (cons @N @P) ) ) )
+
+
+(be path (@A @B @P @N) (path1 @A @B (@A) @P @N))
+
+(be path1 (@A @A @L (@A) 0))
+(be path1 (@A @B @L (@A . @P) @N)
+   (edge @A @Z @X)
+   (not (member @Z @L))
+   (path1 @Z @B (@Z . @L) @P @Y)
+   (@N + (-> @X) (-> @Y)) )
+
+(be edge (@A @B @N) (vect @A @B @N))
+(be edge (@A @B @N) (vect @B @A @N))
+
+(be vect (Rheine Muenster 39))
+(be vect (Rheine Osnabrueck 42))
+(be vect (Muenster Osnabrueck 51))
+(be vect (Warendorf Muenster 28))
+(be vect (Warendorf Osnabrueck 43))
+(be vect (Warendorf Rheda 24))
+(be vect (Warendorf Guetersloh 27))
+(be vect (Osnabrueck Bielefeld 48))
+(be vect (Rheda Guetersloh 10))
+(be vect (Bielefeld Guetersloh 16))
+(be vect (Bielefeld Paderborn 39))
+(be vect (Paderborn Guetersloh 31))
+(be vect (Paderborn Rheda 32))
+(be vect (Paderborn Soest 41))
+(be vect (Soest Rheda 38))
+(be vect (Soest Beckum 26))
+(be vect (Beckum Rheda 24))
+(be vect (Beckum Warendorf 27))
+(be vect (Ahlen Warendorf 27))
+(be vect (Ahlen Muenster 46))
+(be vect (Ahlen Beckum 11))
+(be vect (Ahlen Soest 27))
+
+(test
+   '(123 Rheine Muenster Warendorf Rheda Paderborn)
+   (travel 'Rheine 'Paderborn) )
diff --git a/misc/trip.l b/misc/trip.l
@@ -0,0 +1,84 @@
+# 11mar10abu
+# (c) Software Lab. Alexander Burger
+
+(load "lib/simul.l")
+
+# Set up distance properties
+# See "misc/travel.l" and "doc/travel"
+(mapc
+   '((L)
+      (put (car L) (cadr L) (caddr L))
+      (put (cadr L) (car L) (caddr L)) )
+   (quote
+      (Rheine Muenster 39)
+      (Rheine Osnabrueck 42)
+      (Muenster Osnabrueck 51)
+      (Warendorf Muenster 28)
+      (Warendorf Osnabrueck 43)
+      (Warendorf Rheda 24)
+      (Warendorf Guetersloh 27)
+      (Osnabrueck Bielefeld 48)
+      (Rheda Guetersloh 10)
+      (Bielefeld Guetersloh 16)
+      (Bielefeld Paderborn 39)
+      (Paderborn Guetersloh 31)
+      (Paderborn Rheda 32)
+      (Paderborn Soest 41)
+      (Soest Rheda 38)
+      (Soest Beckum 26)
+      (Beckum Rheda 24)
+      (Beckum Warendorf 27)
+      (Ahlen Warendorf 27)
+      (Ahlen Muenster 46)
+      (Ahlen Beckum 11)
+      (Ahlen Soest 27) ) )
+
+# Find a route from 'A' to 'B'
+(de route (A B Lst)
+   (if (get A B)
+      (list A B)
+      (and
+         (pick
+            '((X)
+               (and
+                  (not (memq X Lst))
+                  (route X B (cons A Lst)) ) )
+            (shuffle (mapcar cdr (getl A))) )
+         (cons A @) ) ) )
+
+# Minimize trip from 'A' to 'B'
+(de trip (Pop Gen A B)
+   (gen
+      (make (do Pop (link (route A B))))  # Population
+      '((Pop) (lt0 (dec 'Gen)))  # Condition
+      '((X Y)  # Recombination
+         (make
+            (while (prog (link (pop 'X)) X)
+               (when (member (car X) (cdr Y))
+                  (setq Y @)
+                  (xchg 'X 'Y) ) ) ) )
+      '((L)  # Mutation
+         (let (N (length L)  H (>> 1 N)  N1 (rand 1 H)  N2 (rand (inc H) N))
+            (if (route (get L N1) (get L N2))
+               (append
+                  (head (dec N1) L)
+                  @
+                  (nth L (inc N2)) )
+               L ) ) )
+      '((L)  # Selection
+         (let A (pop 'L)
+            (-
+               (sum
+                  '((X) (get A (setq A X)))
+                  L ) ) ) ) ) )
+
+# Optimum hit percentage, e.g. (tst 12 8)
+(de tst (Pop Gen)
+   (let OK 0
+      (do 100
+         (when
+            (=
+               (trip Pop Gen 'Rheine 'Paderborn)
+               '(Rheine Muenster Warendorf Rheda Paderborn) )
+            (inc 'OK) ) )
+      OK ) )
diff --git a/opt/pilog.l b/opt/pilog.l
@@ -0,0 +1,15 @@
+# 25dec09abu
+# (c) Software Lab. Alexander Burger
+
+(be mapcar (@ NIL NIL))
+(be mapcar (@P (@X . @L) (@Y . @M))
+   (call @P @X @Y)
+   (mapcar @P @L @M) )
+
+# Contributed by Clemens Hinze <cle-picolisp@qiao.in-berlin.de>
+(be findall (@Pat @P @Res)
+   (@Res solve
+      (-> @P)
+      (or @Pat (fill (-> @Pat))) ) )
+
+# vi:et:ts=3:sw=3
diff --git a/p b/p
@@ -0,0 +1,2 @@
+#!/bin/sh
+exec ${0%/*}/bin/picolisp ${0%/*}/lib.l @ext.l "$@"
diff --git a/plmod b/plmod
@@ -0,0 +1,2 @@
+#!/bin/sh
+exec ${0%/*}/bin/picolisp -"on *Dbg" ${0%/*}/lib.l @ext.l @plmod.l "$@"
diff --git a/plmod.l b/plmod.l
@@ -0,0 +1,10 @@
+# 16feb10abu
+# (c) Software Lab. Alexander Burger
+
+(on *Dbg)
+(off *Tsm)
+(load "@lib/debug.l" "@lib/edit.l" "@lib/lint.l" "@lib/sq.l")
+
+(noLint 'later (loc "@Prg" later))
+
+# vi:et:ts=3:sw=3
diff --git a/rcsim/README b/rcsim/README
@@ -0,0 +1,125 @@
+12nov09abu
+(c) Software Lab. Alexander Burger
+
+
+         RC Flight Simulator
+         ===================
+
+The PicoLisp RC Flight Simulator is a very simple toy simulator, allowing you to
+fly an airplane in a way similar to a radio controlled model plane.
+
+It is all implemented within the PicoLisp system, so that no additional
+libraries like OpenGL or GL4Java are needed. It may be regarded as a proof of
+concept, because a flight simulator is one of the least typical things to do in
+Lisp.
+
+The plane is similar to the German WW-I aircraft Fokker "D-VII" (and a bit to
+the British Sopwith Camel ;-). Though the user's position is that of a model
+plane's pilot (i.e. viewing the plane from a fixed position), all parameters
+like dimensions, mass, engine power and flight data are intended to be as close
+as possible to a "real" Fokker D-VII. Unfortunately, some of these parameters
+are not known exactly, but it is a fun project anyway, and I hope it comes
+close.
+
+
+The simulator supports two different kinds of user interface. The version in the
+standard release uses a plain Xlib frontend. To use it, you'll have to build it
+once:
+
+   $ (cd src; make x11)
+
+Then start the PicoLisp server with
+
+   $ ./dbg rcsim/main.l -main -go
+
+and then the Z3d-Client from another X-terminal
+
+   $ bin/z3dClient localhost 8080
+
+Then make sure that your keyboard focus is on the first X-terminal (where you
+started the simulator from, _not_ the Z3d-Client window).
+
+Hitting ENTER at the PicoLisp prompt (the colon ':') will terminate the
+simulation process and close the Z3d-Client window. As always, you can stop the
+PicoLisp servers with 'killall picolisp'.
+
+
+   The second version runs in an Applet in any Java-enabled browser.To run it
+   locally, please download and unpack the "picoJavaGUI.tgz" tarball. It
+   contains the Java applet GUI which is no longer part of the standard PicoLisp
+   release.
+
+   You can start the PicoLisp server with
+
+      $ ./p rcsim/applet.main.l -main -go -wait
+
+   or (to get an interactive PicoLisp command line) with
+
+      $ ./dbg rcsim/main.l -main -go
+
+   and then point your browser to "http://localhost:8080".
+
+   If you don't have PicoLisp installed, you might want to try the online
+   version at:
+
+      http://rcsim.7fach.de
+
+   (please take care not to use a proxy for that address)
+
+   In both cases, click onto the image to set the keyboard focus.
+
+
+The simulator runs in the background, so if it is started interactively (see
+above), the Lisp interpreter is fully available and lets you inspect or modify
+the environment. For example
+
+: (show *Model)
+
+shows the current state of the model.
+
+In the Z3d-Version, terminal output is interlaced with the simulator's output.
+If you see no ':' prompt, it is helpful to type a single dot '.' and ENTER, to
+avoid terminating the interpreter:
+
+...
+0 %  0 km/h  0 m/s  1 m
+.
+-> NIL
+:
+
+
+The simulator is controlled by the following 10 keys:
+
+- The cursor (arrow) keys UP and DOWN control the elevator
+- The LEFT and RIGHT cursor keys control the combined rudder/ailerons
+- The HOME key sets full throttle (F8)
+- PAGE UP/DOWN increase/decrease the throttle (F7/F6)
+- The END key turns the engine off (F5)
+- INS/DEL zoom in/out (or F4/F3)
+
+For a first flight, just hit the HOME key as the plane sits waiting on the
+runway, and watch it accelerate. After some time, when it starts to jump a bit
+nervously, give a little up-elevator (the DOWN arrow key) to gain height. Then
+hit the PAGE DOWN key once or twice to decrease the throttle, and cautiously
+experiment with with the arrow keys.
+
+
+There is some rudimentary sound implemented. It is not intended to be realistic
+(the graphic isn't either ;-) but to give some audible feedback to the user. It
+produces a simple square wave sound, depending on the engine's thrust, the
+airspeed, the distance, and the Doppler effect.
+
+If you are using the Java/Applet version, you might simply click on the "Sound"
+checkbox. Be warned, however, that this induces additional load on the client
+side, and doesn't sound very smooth. BTW, does anybody know of a better way to
+produce continuous sound with variable frequency in a Java applet?
+
+In the Z3d-Client version, a console speaker interface is used, which gives
+better results. As the speaker can be accessed in Linux only from a virtual
+console (not from an X-terminal), log into a virtual console (typically tty1 ..
+tty6) _before_ you start the simulator, change to the installation directory,
+and run the simple tone server:
+
+   $ rcsim/tone
+
+When done, you can stop it with 'killall tone'.
diff --git a/rcsim/env.l b/rcsim/env.l
@@ -0,0 +1,103 @@
+# 21jan07abu
+# (c) Software Lab. Alexander Burger
+
+(model This
+   '(runway1  -120.0  -200.0  -0.02
+      (`DarkGrey NIL
+        +20.0   -20.0      0
+        +20.0   +20.0      0
+        -20.0   +20.0      0
+        -20.0   -20.0      0 )
+      (`White NIL
+        +10.0    -1.0      0
+        +10.0    +1.0      0
+        -10.0    +1.0      0
+        -10.0    -1.0      0 ) ) )
+
+(model This
+   '(runway2  -80.0  -200.0  -0.02
+      (`DarkGrey NIL
+        +20.0   -20.0      0
+        +20.0   +20.0      0
+        -20.0   +20.0      0
+        -20.0   -20.0      0 )
+      (`White NIL
+        +10.0    -1.0      0
+        +10.0    +1.0      0
+        -10.0    +1.0      0
+        -10.0    -1.0      0 ) ) )
+
+(model This
+   '(runway3  -40.0  -200.0  -0.02
+      (`DarkGrey NIL
+        +20.0   -20.0      0
+        +20.0   +20.0      0
+        -20.0   +20.0      0
+        -20.0   -20.0      0 )
+      (`White NIL
+        +10.0    -1.0      0
+        +10.0    +1.0      0
+        -10.0    +1.0      0
+        -10.0    -1.0      0 ) ) )
+
+(model This
+   '(runway4  0.0  -200.0  -0.02
+      (`DarkGrey NIL
+        +20.0   -20.0      0
+        +20.0   +20.0      0
+        -20.0   +20.0      0
+        -20.0   -20.0      0 )
+      (`White NIL
+        +10.0    -1.0      0
+        +10.0    +1.0      0
+        -10.0    +1.0      0
+        -10.0    -1.0      0 ) ) )
+
+(model This
+   '(runway5  +40.0  -200.0  -0.02
+      (`DarkGrey NIL
+        +20.0   -20.0      0
+        +20.0   +20.0      0
+        -20.0   +20.0      0
+        -20.0   -20.0      0 )
+      (`White NIL
+        +10.0    -1.0      0
+        +10.0    +1.0      0
+        -10.0    +1.0      0
+        -10.0    -1.0      0 ) ) )
+
+(model This
+   '(runway6  +80.0  -200.0  -0.02
+      (`DarkGrey NIL
+        +20.0   -20.0      0
+        +20.0   +20.0      0
+        -20.0   +20.0      0
+        -20.0   -20.0      0 )
+      (`White NIL
+        +10.0    -1.0      0
+        +10.0    +1.0      0
+        -10.0    +1.0      0
+        -10.0    -1.0      0 ) ) )
+
+(model This
+   '(runway7  +120.0  -200.0  -0.02
+      (`DarkGrey NIL
+        +20.0   -20.0      0
+        +20.0   +20.0      0
+        -20.0   +20.0      0
+        -20.0   -20.0      0 )
+      (`White NIL
+        +10.0    -1.0      0
+        +10.0    +1.0      0
+        -10.0    +1.0      0
+        -10.0    -1.0      0 ) ) )
+
+(=: env
+   (list
+      (: runway1)
+      (: runway2)
+      (: runway3)
+      (: runway4)
+      (: runway5)
+      (: runway6)
+      (: runway7) ) )
diff --git a/rcsim/fokker.l b/rcsim/fokker.l
@@ -0,0 +1,456 @@
+# 01feb05abu
+# (c) Software Lab. Alexander Burger
+
+(=: mass 910.0)               # kg
+(=: power 3924.0)             # N
+(=: rc -1.4)                  # kg/m
+(=: lc -250.0)                # kg/m
+(=: trim 30)                  # Trimmung
+(=: lim1 0.8)                 # tan(a)
+(=: lim2 0.24)
+(=: tx 1.2)                   # Touchdown
+(=: tz -1.9)
+(=: pitch 0.26)
+(=: torq -10000.0)            # Drehmoment
+(=: stab (0.01 0.01 0.02))    # Stabilitaet
+
+(model This
+   '(body  0.0  0.0  1.50
+      # Flaeche oben
+      (`Blue `Blue
+         -0.15  +0.30  +1.05
+         +1.20   0.00  +1.05
+         +1.20  +3.90  +1.05
+         +0.90  +4.20  +1.05
+         -0.20  +3.90  +1.05
+         -0.60  +2.20  +1.05
+         -0.60  +0.60  +1.05 )
+      (`Blue `Blue
+         -0.60  -0.60  +1.05
+         -0.60  -2.20  +1.05
+         -0.20  -3.90  +1.05
+         +0.90  -4.20  +1.05
+         +1.20  -3.90  +1.05
+         +1.20   0.00  +1.05
+         -0.15  -0.30  +1.05 )
+      (`Blue `Blue
+         +1.20   0.00  +1.05
+         -0.15  -0.30  +1.05
+         -0.15  +0.30  +1.05 )
+
+      # Querruder
+      (rightAileron  -0.60  +2.20  +1.05
+         (`Red `Red
+            +0.40  +1.70   0.00
+            +0.72  +1.78   0.00
+            +0.72  +1.90   0.00
+            +0.40  +2.10   0.00
+             0.00  +1.80   0.00
+             0.00  +1.70   0.00 )
+         (`Red `Red
+            +0.40  +1.70   0.00
+             0.00  +1.70   0.00
+             0.00   0.00   0.00 ) )
+      (leftAileron  -0.60  -2.20  +1.05
+         (`Red `Red
+            +0.40  -1.70   0.00
+            +0.72  -1.78   0.00
+            +0.72  -1.90   0.00
+            +0.40  -2.10   0.00
+             0.00  -1.80   0.00
+             0.00  -1.70   0.00 )
+         (`Red `Red
+            +0.40  -1.70   0.00
+             0.00  -1.70   0.00
+             0.00   0.00   0.00 ) )
+
+      # Flaeche rechts unten
+      (`Blue `Blue
+         +0.90  +0.20  -0.60
+         +0.90  +3.90  -0.30
+         +0.60  +4.20  -0.30
+         -0.90  +3.90  -0.30
+         -0.90  +0.20  -0.60 )
+
+      # Flaeche links unten
+      (`Blue `Blue
+         -0.90  -0.20  -0.60
+         -0.90  -3.90  -0.30
+         +0.60  -4.20  -0.30
+         +0.90  -3.90  -0.30
+         +0.90  -0.20  -0.60 )
+
+      # Streben links
+      (`Brown `Brown
+         -0.20  -2.55  +1.05
+         -0.50  -2.55  -0.37
+         -0.60  -2.55  -0.37
+         -0.30  -2.55  +1.05 )
+
+      (`Brown `Brown
+         -0.50  -2.55  -0.37
+         -0.50  -2.55  -0.37
+         +0.80  -2.55  +0.90
+         +0.80  -2.55  +1.05 )
+
+      (`Brown `Brown
+         +0.90  -2.55  +1.05
+         +0.60  -2.55  -0.37
+         +0.50  -2.55  -0.37
+         +0.80  -2.55  +1.05 )
+
+      # Streben rechts
+      (`Brown `Brown
+         -0.20  +2.55  +1.05
+         -0.50  +2.55  -0.37
+         -0.60  +2.55  -0.37
+         -0.30  +2.55  +1.05 )
+
+      (`Brown `Brown
+         -0.50  +2.55  -0.37
+         -0.50  +2.55  -0.37
+         +0.80  +2.55  +0.90
+         +0.80  +2.55  +1.05 )
+
+      (`Brown `Brown
+         +0.90  +2.55  +1.05
+         +0.60  +2.55  -0.37
+         +0.50  +2.55  -0.37
+         +0.80  +2.55  +1.05 )
+
+      # Motorlager
+      (`Grey NIL
+         +1.80  +0.30  +0.30
+         +1.80  -0.30  +0.30
+         +1.80  -0.30  -0.30
+         +1.80  +0.30  -0.30 )
+
+      # Rumpfnase
+      (`Blue NIL
+         +1.20   0.00  +0.60
+         +1.80  -0.30  +0.30
+         +1.80  +0.30  +0.30 )
+      (`Blue NIL
+         +1.20   0.00  +0.60
+         +1.20  -0.45  +0.30
+         +1.80  -0.30  +0.30 )
+      (`Blue NIL
+         +1.80  +0.30  +0.30
+         +1.20  +0.45  +0.30
+         +1.20   0.00  +0.60 )
+      (`Blue NIL
+         +1.20  -0.45  +0.30
+         +1.20  -0.45  -0.30
+         +1.80  -0.30  -0.30
+         +1.80  -0.30  +0.30 )
+      (`Blue NIL
+         +1.80  +0.30  +0.30
+         +1.80  +0.30  -0.30
+         +1.20  +0.45  -0.30
+         +1.20  +0.45  +0.30 )
+      (`Blue NIL
+         +1.20  -0.45  -0.30
+         +1.20  -0.30  -0.60
+         +1.80  -0.30  -0.30 )
+      (`Blue NIL
+         +1.80  +0.30  -0.30
+         +1.20  +0.30  -0.60
+         +1.20  +0.45  -0.30 )
+      (`Blue NIL
+         +1.20  -0.30  -0.60
+         +1.20  +0.30  -0.60
+         +1.80  +0.30  -0.30
+         +1.80  -0.30  -0.30 )
+
+      # Rumpfseite rechts
+      (`Red NIL
+         +1.20  +0.45  +0.30
+         +1.20  +0.45  -0.30
+         -1.50  +0.45  -0.30
+         -1.50  +0.45  +0.30
+         -1.20  +0.45  +0.45
+         -0.90  +0.45  +0.45 )
+      (`Red NIL
+         -1.50  +0.45  +0.30
+         -1.50  +0.45  -0.30
+         -4.80   0.00  -0.30
+         -4.80   0.00   0.00 )
+
+      # Rumpfseite links
+      (`Red NIL
+         -0.90  -0.45  +0.45
+         -1.20  -0.45  +0.45
+         -1.50  -0.45  +0.30
+         -1.50  -0.45  -0.30
+         +1.20  -0.45  -0.30
+         +1.20  -0.45  +0.30 )
+      (`Red NIL
+         -4.80   0.00   0.00
+         -4.80   0.00  -0.30
+         -1.50  -0.45  -0.30
+         -1.50  -0.45  +0.30 )
+
+      # Rumpfoberteil vorne
+      (`Red NIL
+         +1.20   0.00  +0.60
+         +1.20  +0.45  +0.30
+         -0.90  +0.45  +0.45
+         -0.60   0.00  +0.60 )
+      (`Red NIL
+         -0.60   0.00  +0.60
+         -0.90  -0.45  +0.45
+         +1.20  -0.45  +0.30
+         +1.20   0.00  +0.60 )
+
+      # Cockpit
+      (`Brown NIL
+         -0.60   0.00  +0.60
+         -0.90  +0.45  +0.45
+         -0.90  -0.45  +0.45 )
+      (`Black NIL
+         -0.90  +0.45  +0.45
+         -1.20  +0.45  +0.45
+         -1.20  -0.45  +0.45
+         -0.90  -0.45  +0.45 )
+      (`Black NIL
+         -1.20  +0.45  +0.45
+         -1.35   0.00  +0.54
+         -1.20  -0.45  +0.45 )
+
+      # Rumpfoberteil hinten
+      (`Red NIL
+         -1.35   0.00  +0.54
+         -1.20  +0.45  +0.45
+         -4.80   0.00   0.00 )
+      (`Red NIL
+         -1.20  +0.45  +0.45
+         -1.50  +0.45  +0.30
+         -4.80   0.00   0.00 )
+      (`Red NIL
+         -4.80   0.00   0.00
+         -1.20  -0.45  +0.45
+         -1.35   0.00  +0.54 )
+      (`Red NIL
+         -4.80   0.00   0.00
+         -1.50  -0.45  +0.30
+         -1.20  -0.45  +0.45 )
+
+      # Rumpfboden
+      (`Red NIL
+         +1.20  +0.45  -0.30
+         +1.20  +0.30  -0.60
+         -1.50  +0.30  -0.60
+         -1.50  +0.45  -0.30 )
+      (`Red NIL
+         +1.20  +0.30  -0.60
+         +1.20  -0.30  -0.60
+         -1.50  -0.30  -0.60
+         -1.50  +0.30  -0.60 )
+      (`Red NIL
+         -1.50  -0.45  -0.30
+         -1.50  -0.30  -0.60
+         +1.20  -0.30  -0.60
+         +1.20  -0.45  -0.30 )
+      (`Red NIL
+         -4.80   0.00  -0.30
+         -1.50  -0.30  -0.60
+         -1.50  -0.45  -0.30 )
+      (`Red NIL
+         -4.80   0.00  -0.30
+         -1.50  +0.30  -0.60
+         -1.50  -0.30  -0.60 )
+      (`Red NIL
+         -1.50  +0.45  -0.30
+         -1.50  +0.30  -0.60
+         -4.80   0.00  -0.30 )
+
+      # Hoehenleitwerk
+      (`Red `Red
+         -3.60  +0.15   0.00
+         -4.20  +1.80   0.00
+         -4.50  +1.80   0.00
+         -4.50  +0.06   0.00 )
+      (`Red `Red
+         -4.50  -0.06   0.00
+         -4.50  -1.80   0.00
+         -4.20  -1.80   0.00
+         -3.60  -0.15   0.00 )
+
+      # Hoehenruder
+      (elevator  -4.50  0.00  0.00
+         (`Blue `Blue
+             0.00  +1.80   0.00
+            -0.60  +1.50   0.00
+            -0.60  +0.60   0.00
+             0.00  +0.06   0.00 )
+         (`Blue `Blue
+             0.00  -0.06   0.00
+            -0.60  -0.60   0.00
+            -0.60  -1.50   0.00
+             0.00  -1.80   0.00 ) )
+
+      # Seitenleitwerk
+      (`Red `Red
+         -4.80   0.00   0.00
+         -3.60   0.00  +0.15
+         -4.20   0.00  +0.90
+         -4.80   0.00  +1.05 )
+
+      # Seitenruder
+      (rudder  -4.80  0.00  0.00
+         (`Blue `Blue
+             0.00   0.00  +1.05
+             0.00   0.00  -0.30
+            -0.45   0.00  +0.30
+            -0.45   0.00  +0.90 ) )
+
+      # Schatten Nase
+      (NIL T
+         +0.90  -0.30  -0.20
+         +1.70   0.00  -0.20
+         +0.90  +0.30  -0.20 )
+
+      # Schatten Flaechen
+      (NIL T
+         +0.90  -3.00  -0.20
+         +0.90  +3.00  -0.20
+         -0.90  +3.00  -0.20
+         -0.90  -3.00  -0.20 )
+
+      # Schatten Rumpf
+      (NIL T
+         -0.90  -0.40  -0.20
+         -0.90  +0.40  -0.20
+         -4.70   0.00  -0.20 )
+
+      # Schatten Leitwerk
+      (NIL T
+         -3.60   0.00  -0.20
+         -4.20  +1.80  -0.20
+         -4.50  +1.80  -0.20
+         -4.50  -1.80  -0.20
+         -4.20  -1.80  -0.20 )
+
+      # Spinner
+      (`Blue NIL
+         +1.80  +0.15  -0.15
+         +1.80  +0.15  +0.15
+         +2.10   0.00   0.00 )
+      (`Blue NIL
+         +1.80  -0.15  -0.15
+         +1.80  +0.15  -0.15
+         +2.10   0.00   0.00 )
+      (`Blue NIL
+         +1.80  -0.15  +0.15
+         +1.80  -0.15  -0.15
+         +2.10   0.00   0.00 )
+      (`Blue NIL
+         +1.80  +0.15  +0.15
+         +1.80  -0.15  +0.15
+         +2.10   0.00   0.00 )
+
+      # Fahrwerk
+      (`Grey `Grey
+         +1.20  +0.30  -0.60
+         +1.20  +0.90  -1.47
+         +1.20  +1.00  -1.47
+         +1.20  +0.40  -0.60 )
+      (`Grey `Grey
+         +1.20  -0.30  -0.60
+         +1.20  -0.90  -1.47
+         +1.20  -1.00  -1.47
+         +1.20  -0.40  -0.60 )
+      (`Grey `Grey
+         +1.20  -1.20  -1.47
+         +1.20  -1.20  -1.53
+         +1.20  +1.20  -1.53
+         +1.20  +1.20  -1.47 )
+      (`Grey `Grey
+         +1.20  +0.90  -1.53
+         +1.20  +0.90  -1.47
+         +0.30  +0.30  -0.60
+         +0.18  +0.30  -0.60 )
+      (`Grey `Grey
+         +1.20  -0.90  -1.53
+         +1.20  -0.90  -1.47
+         +0.30  -0.30  -0.60
+         +0.18  -0.30  -0.60 )
+
+      # Rad rechts
+      (`Yellow `Yellow
+         +1.20  +1.20  -1.20
+         +1.38  +1.20  -1.25
+         +1.50  +1.20  -1.37
+         +1.55  +1.20  -1.55
+         +1.50  +1.20  -1.73
+         +1.38  +1.20  -1.85
+         +1.20  +1.20  -1.90
+         +1.02  +1.20  -1.85
+         +0.90  +1.20  -1.72
+         +0.85  +1.20  -1.55
+         +0.90  +1.20  -1.37
+         +1.02  +1.20  -1.25 )
+
+      # Schatten Rad rechts
+      (NIL T
+         +1.60  +1.00  -1.55
+         +1.60  +1.40  -1.55
+         +0.80  +1.40  -1.55
+         +0.80  +1.00  -1.55 )
+
+      # Rad links
+      (`Yellow `Yellow
+         +1.20  -1.20  -1.20
+         +1.38  -1.20  -1.25
+         +1.50  -1.20  -1.37
+         +1.55  -1.20  -1.55
+         +1.50  -1.20  -1.73
+         +1.38  -1.20  -1.85
+         +1.20  -1.20  -1.90
+         +1.02  -1.20  -1.85
+         +0.90  -1.20  -1.72
+         +0.85  -1.20  -1.55
+         +0.90  -1.20  -1.37
+         +1.02  -1.20  -1.25 )
+
+      # Schatten Rad links
+      (NIL T
+         +1.60  -1.00  -1.55
+         +1.60  -1.40  -1.55
+         +0.80  -1.40  -1.55
+         +0.80  -1.00  -1.55 )
+
+      # Latte
+      (propeller  +1.95  0.00  0.00) ) )
+
+(model This
+   '(blade  +1.95  0.00  0.00
+      (`Black `Black
+         -0.05   0.00   0.00
+         +0.05   0.00   0.00
+         +0.02  +0.40  -0.50
+         +0.00  +0.90  -0.90
+         -0.02  +0.50  -0.40
+         -0.05   0.00   0.00
+         -0.02  -0.50  +0.40
+         +0.00  -0.90  +0.90
+         +0.02  -0.40  +0.50
+         +0.05   0.00   0.00 ) ) )
+
+(model This
+   '(disk  +1.95  0.00  0.00
+      (NIL NIL
+         +0.00  -0.30  +1.20
+         +0.00  -0.90  +0.90
+         +0.00  -1.20  +0.30
+         +0.00  -1.20  -0.30
+         +0.00  -0.90  -0.90
+         +0.00  -0.30  -1.20
+         +0.00  +0.30  -1.20
+         +0.00  +0.90  -0.90
+         +0.00  +1.20  -0.30
+         +0.00  +1.20  +0.30
+         +0.00  +0.90  +0.90
+         +0.00  +0.30  +1.20 ) ) )
+
+(z3d:Yrot 0.26 (: body))
diff --git a/rcsim/lib.l b/rcsim/lib.l
@@ -0,0 +1,255 @@
+# 26aug09abu
+# (c) Software Lab. Alexander Burger
+
+# *Pilot *Scene *Model
+# *DT *Thr *Speed *Climb *Alt
+
+(load "simul/lib.l")
+
+(de *DT . 0.020)
+(de *Tower . 12.0)
+
+(de start ()
+   (task -20 0 (simulate))
+   (setq "Time" (time)) )
+
+(de stop ()
+   (task -20) )
+
+(de draw ()
+   (at (0 . 100)
+      (let N (time)
+         (rate> *Pilot (- N "Time"))
+         (setq "Time" N) ) )
+   (draw> *Scene) )
+
+(de simulate ()
+   (sim> *Scene)
+   (sim> *Model) )
+
+(de MUL Args
+   (let D 1.0
+      (make
+         (link '*/ (pop 'Args) (pop 'Args))
+         (while Args
+            (setq D (* D 1.0))
+            (link (pop 'Args)) )
+         (link D) ) ) )
+
+(de dist (X Y)
+   (sqrt (+ (* X X) (* Y Y))) )
+
+(de damp ("Var" Val)
+   (set "Var" (>> 1 (+ Val (val "Var")))) )
+
+(de doppler (F X Y VX VY)
+   (let N (dist X Y)
+      (if (=0 N)
+         F
+         (- F
+            (*/ F
+               (+ `(MUL X VX) `(MUL Y VY))
+               (* N 150) ) ) ) ) )
+
+
+(class +Model)
+# mass power rc lc limit tx tz pitch torq stab
+# body leftAileron rightAileron rudder elevator propeller blade disk
+# ele ail rud thr thrust vx vy vz fx fy fz dx dy dz
+
+(dm T ()
+   (load "rcsim/fokker.l")
+   (=: ele (=: ail (=: rud (=: thr (=: thrust 0)))))
+   (=: vx (=: vy (=: vz 0)))
+   (=: fx (=: fy (=: fz 0)))
+   (=: dx (=: dy (=: dz 0)))
+   (z3d:dx -100.0 (: body))
+   (z3d:dy -200.0 (: body))
+   (blade> This) )
+
+(dm dir> ()
+   (let B (val (: body))
+      (z3d:Spot
+         (+ (car B) (>> 3 (: vx)) (>> 2 (: vz)))
+         (+ (cadr B) (>> 3 (: vy)) (>> 2 (: vz)))
+         (+ (caddr B) (>> 3 (: vz)) (>> 2 (: vz)))
+         0 0 *Tower ) ) )
+
+(dm blade> ()
+   (set (: propeller) (val (: blade))) )
+
+(dm disk> ()
+   (set (: propeller) (val (: disk))) )
+
+
+(dm down> ()
+   (when (> (: ele) -100)
+      (dec (:: ele) 20)
+      (z3d:Arot +0.2 (: elevator)) ) )
+
+(dm up> ()
+   (when (> 100 (: ele))
+      (inc (:: ele) 20)
+      (z3d:Arot -0.2 (: elevator)) ) )
+
+(dm left> ()
+   (when (> (: ail) -100)
+      (dec (:: ail) 20)
+      (dec (:: rud) 20)
+      (z3d:Arot +0.2 (: leftAileron))
+      (z3d:Arot +0.2 (: rightAileron))
+      (z3d:Arot +0.2 (: rudder)) ) )
+
+(dm right> ()
+   (when (> 100 (: ail))
+      (inc (:: ail) 20)
+      (inc (:: rud) 20)
+      (z3d:Arot -0.2 (: leftAileron))
+      (z3d:Arot -0.2 (: rightAileron))
+      (z3d:Arot -0.2 (: rudder)) ) )
+
+(dm throt> (X)
+   (=: thr
+      (cond
+         ((not X) 0)
+         ((=T X) 100)
+         ((lt0 X) (max 10 (- (: thr) 25)))
+         ((=0 (: thr)) 10)
+         ((= 10 (: thr)) 25)
+         (T (min 100 (+ 25 (: thr)))) ) ) )
+
+(dm sim> ()
+   (cond
+      ((gt0 (: ele))
+         (dec (:: ele))
+         (z3d:Arot +0.01 (: elevator)) )
+      ((lt0 (: ele))
+         (inc (:: ele))
+         (z3d:Arot -0.01 (: elevator)) ) )
+   (cond
+      ((gt0 (: ail))
+         (dec (:: ail))
+         (dec (:: rud))
+         (z3d:Arot +0.01 (: leftAileron))
+         (z3d:Arot +0.01 (: rightAileron))
+         (z3d:Arot +0.01 (: rudder)) )
+      ((lt0 (: ail))
+         (inc (:: ail))
+         (inc (:: rud))
+         (z3d:Arot -0.01 (: leftAileron))
+         (z3d:Arot -0.01 (: rightAileron))
+         (z3d:Arot -0.01 (: rudder)) ) )
+   (cond
+      ((> (: thr) (: thrust))
+         (inc (:: thrust)) )
+      ((> (: thrust) (: thr))
+         (dec (:: thrust)) ) )
+   (if (> 20 (: thrust))
+      (blade> This)
+      (disk> This) )
+   (unless (=0 (: thrust))
+      (z3d:Xrot 0.2 (: propeller)) )
+   (use (Touch VX VY VZ Body Taxi Stick A FX FY FZ DX DY DZ)
+      (z3d:Rotate (: tx) 0 (: tz) (: body) NIL NIL 'Touch)
+      (z3d:Rotate (: vx) (: vy) (: vz) (: body) 'VX 'VY 'VZ T)
+      (setq
+         Body (val (: body))
+         Taxi (> 0.1 (+ (caddr Body) Touch))
+         Stick (>= 1.0 (+ VX VY))
+         FX (+ (*/ (: thrust) (: power) 100) `(MUL (: rc) VX (abs VX)))
+         FZ (+
+            (cond
+               ((> 0.1 VX) 0)
+               ((> (abs (setq A (*/ 1.0 VZ VX))) (: lim2))
+                  0 )
+               ((>= (: lim1) A)
+                  `(MUL VX VX (: lc) A) )
+               (T `(MUL VX VX (: lc) (- (: lim2) A))) )
+            `(MUL 8.0 (: rc) VZ (abs VZ)) ) )
+
+      (ifn Taxi
+         (setq FY `(MUL 4.0 (: rc) VY (abs VY)))
+         (let F (>> 2 (: mass))
+            (cond
+               ((> 0.1 (abs VX))
+                  (and (>= F FX) (zero FX)) )
+               ((gt0 VX)
+                  (dec 'FX F) )
+               (T (inc 'FX F)) )
+            (setq FY (if (lt0 VY) (* 12 F) (* -12 F))) )
+         (z3d:Yrot
+            (>> 3 (- (: pitch) (get Body 6)))  # rot.a.z
+            (: body) ) )
+      (unless Stick
+         (z3d:Yrot
+            (+
+               (*/ VX (+ (: ele) (: trim)) 80000)
+               `(MUL VZ (: stab 2)) )
+            (: body) )
+         (if Taxi
+            (prog
+               (z3d:Zrot (*/ VX (: rud) 80000) (: body))
+               (z3d:Xrot (get Body 9) (: body)) )  # rot.b.z
+            (z3d:Xrot  # roll
+               (+
+                  (- (*/ VX (: ail) 80000) (/ VY 400))
+                  (*/ (: thrust) (: torq) (: mass))
+                  `(MUL (get Body 9) (: stab 1)) )  # rot.b.z
+               (: body) )
+            (z3d:Zrot
+               (+
+                  (*/ VX (: rud) 80000)
+                  `(MUL VY (: stab 3)) )
+               (: body) ) ) )
+
+      # World system
+      (z3d:Rotate FX FY FZ (: body) 'FX 'FY 'FZ)
+      (dec 'FZ `(MUL (: mass) 9.81))
+
+      # Accelerate
+      (setq
+         A (*/ 1.0 *DT (: mass))
+         DX `(MUL A (damp (:: fx) FX))
+         DY `(MUL A (damp (:: fy) FY))
+         DZ `(MUL A (damp (:: fz) FZ)) )
+      (if (and Stick (> 0.001 (+ `(MUL DX DX) `(MUL DY DY))))
+         (=: vx (=: vy (=: dx (=: dy 0))))
+         (inc (:: vx) (damp (:: dx) DX))
+         (inc (:: vy) (damp (:: dy) DY)) )
+      (inc (:: vz) (damp (:: dz) DZ))
+      (when (and Taxi (lt0 (: vz)))
+         (when (> -6.0 (: vz))
+            (=: thr (=: thrust 0))
+            (=: vx (=: vy 0))
+            (blade> This) )
+         (set (cddr Body) (- Touch))
+         (=: vz 0) )
+
+      # Translate
+      (inc Body `(MUL (: vx) *DT))
+      (inc (cdr Body) `(MUL (: vy) *DT))
+      (inc (cddr Body) `(MUL (: vz) *DT))
+
+      # Sound/Display
+      (tone> *Scene
+         (max 0
+            (- 100
+               (/ (dist (car Body) (cadr Body)) 40.0) ) )
+         (cond
+            ((=0 (: thrust)) 0)
+            ((> 22 (: thrust)) 11)
+            (T
+               (doppler
+                  (>> 1 (+ (: thrust) (/ VX 0.5)))
+                  (car Body)
+                  (cadr Body)
+                  (: vx)
+                  (: vy) ) ) ) )
+      (unless (= *Thr (: thr))
+         (thr> *Pilot (setq *Thr (: thr))) )
+      (unless (= *Speed (setq A (*/ VX 3.6 `(* 1.0 1.0))))
+         (speed> *Pilot (setq *Speed A)) )
+      (unless (= *Climb (setq A (/ (: vz) 1.0)))
+         (climb> *Pilot (setq *Climb A)) )
+      (unless (= *Alt (setq A (/ (caddr Body) 1.0)))
+         (alt> *Pilot (setq *Alt A)) ) ) )
diff --git a/rcsim/main.l b/rcsim/main.l
@@ -0,0 +1,124 @@
+# 24jul07abu
+# (c) Software Lab. Alexander Burger
+
+# *Sock *Panel *FocLen
+
+(load "lib/term.l")
+(load "rcsim/lib.l")
+
+
+(de main ()
+   (setq
+      *FocLen 8000.0
+      *Pilot (new '(+Pilot))
+      *Scene (new '(+Scene))
+      *Model (new '(+Model))
+      *Panel (list
+         0 " %  "
+         0 " km/h  "
+         0 " m/s  "
+         0 " m  "
+         NIL ) )
+   (push1 '*Bye '(tone> *Scene 0 0)) )
+
+(de setPanel (N X)
+   (set (nth *Panel N) X)
+   (prinl *Panel) )
+
+(de go ()
+   (out (setq *Sock (listen (port 8080) 120000))
+      (pr 800 600) )
+   (start)
+   (draw)
+   (task *Sock
+      (in *Sock
+         (case (rd)
+            (`(char "o")  # ok
+               (draw) )
+            (`(char "c")  # clk
+               (rd) (rd) ) ) ) ) )
+
+# Key Controls
+(fkey *XtIns
+   (when (> 32000.0 *FocLen)
+      (setq *FocLen (>> -1 *FocLen)) ) )
+
+(fkey *XtDel
+   (when (> *FocLen 2000.0)
+      (setq *FocLen (>> 1 *FocLen)) ) )
+
+(fkey *XtUp
+   (down> *Model) )
+
+(fkey *XtDown
+   (up> *Model) )
+
+(fkey *XtLeft
+   (left> *Model) )
+
+(fkey *XtRight
+   (right> *Model) )
+
+(fkey *XtHome
+   (throt> *Model T) )
+
+(fkey *XtPgDn
+   (throt> *Model -1) )
+
+(fkey *XtPgUp
+   (throt> *Model +1) )
+
+(fkey *XtEnd
+   (throt> *Model) )
+
+(fkey *XtF3 ~(get (fkey) *XtDel))
+(fkey *XtF4 ~(get (fkey) *XtIns))
+(fkey *XtF5 ~(get (fkey) *XtEnd))
+(fkey *XtF6 ~(get (fkey) *XtPgDn))
+(fkey *XtF7 ~(get (fkey) *XtPgUp))
+(fkey *XtF8 ~(get (fkey) *XtHome))
+
+
+# Pilot
+(class +Pilot)
+
+(dm thr> (N)
+   (setPanel 1 N) )
+
+(dm speed> (N)
+   (setPanel 3 N) )
+
+(dm climb> (N)
+   (setPanel 5 N) )
+
+(dm alt> (N)
+   (setPanel 7 N) )
+
+(dm rate> (N)
+   (setPanel 9 (pack (format N 2) " s")) )
+
+
+# Scene
+(class +Scene)
+# env tone
+
+(dm T ()
+   (load "rcsim/env.l")
+   (when (call 'test "-p" "fifo/tone")
+      (=: tone (open "fifo/tone")) ) )
+
+(dm sim> ())
+
+(dm draw> ()
+   (out *Sock
+      (let Dir (dir> *Model)
+         (z3d:Draw *FocLen (car Dir) (cdr Dir)  0 0 *Tower  LightBlue DarkGreen)
+         (z3d:Draw (get *Model 'body))
+         (mapc z3d:Draw (: env))
+         (z3d:Draw) ) ) )
+
+(dm tone> (A F)
+   (when (: tone)
+      (out @ (pr A (*/ F 22 10))) ) )
+
+# vi:et:ts=3:sw=3
diff --git a/rcsim/tone b/rcsim/tone
@@ -0,0 +1,41 @@
+#!bin/picolisp lib.l
+# 13oct06abu
+# (c) Software Lab. Alexander Burger
+
+# Must be run on a virtual console
+
+(load "lib/misc.l" "lib/gcc.l")
+
+### 'ioctl' glue function
+(gcc "tst" NIL 'tone)
+
+#include <sys/ioctl.h>
+#include <linux/kd.h> // KIOCSOUND
+
+// (tone 'freq) -> flg
+any tone(any ex) {
+   long amp = evCnt(ex,cdr(ex));
+   long freq = evCnt(ex,cddr(ex));
+
+   return ioctl(0, KIOCSOUND, amp==0 || freq==0? 0 : 1193180L/freq) < 0? Nil : T;
+}
+
+/**/
+
+### Create named pipe
+(unless (call 'test "-p" "fifo/tone")
+   (call 'mkdir "-p" "fifo")
+   (call 'mkfifo "fifo/tone") )
+
+(push1 '*Bye '(call 'rm "fifo/tone"))
+
+
+### Serve calls like:
+#  (setq *Tone (open "fifo/tone"))
+#  (out *Tone (pr 100 440))  # 440 Hz
+#  (out *Tone (pr 0 0))    # Off
+#  (close *Tone)
+(loop
+   (in "fifo/tone"
+      (while (rd)
+         (tone @ (rd)) ) ) )
diff --git a/simul/lib.l b/simul/lib.l
@@ -0,0 +1,90 @@
+# 18mar10abu
+# (c) Software Lab. Alexander Burger
+
+(scl 6)  # Keep in sync with `SCL' in "src/z3d.c"
+
+(load "lib/simul.l")
+(load "simul/rgb.l")
+
+# Unity Matrix
+(setq
+   *UMat (1.0 0.0 0.0  0.0 1.0 0.0  0.0 0.0 1.0)
+   PI    3.1415927
+   PI/2  1.5707963 )
+
+# Mirror in y-direction
+(de y-mirror (Lst)
+   (make
+      (while (sym? (car Lst))
+         (link (pop 'Lst)) )
+      (link
+         (pop 'Lst)     # pos-x
+         (- (pop 'Lst)) # pos-y
+         (pop 'Lst) )   # pos-z
+      (for L Lst
+         (link
+            (if (sym? (car L))
+               (y-mirror L)
+               (make
+                  (link (cadr L) (car L))
+                  (when (sym? (car (setq L (cddr L))))
+                     (link (pop 'L)) )
+                  (while L
+                     (link (pop 'L) (- (pop 'L)) (pop 'L)) ) ) ) ) ) ) )
+
+# Create model
+(de model (Obj Lst)
+   (let X Obj
+      (while (sym? (cadr Lst))
+         (setq X (get X (pop 'Lst))) )
+      (unless X
+         (quit "Can't attach (sub)model" (car Lst)) )
+      (prog1
+         (put X (pop 'Lst) (new (ext? Obj)))
+         (set @
+            (make
+               (link (pop 'Lst) (pop 'Lst) (pop 'Lst))
+               (mapc link *UMat)
+               (for M Lst
+                  (link
+                     (if (and (car M) (sym? (car M)))
+                        (model Obj M)
+                        M ) ) ) ) ) ) ) )
+
+# Duplicate position and orientation
+(de placement (Sym)
+   (prog1
+      (new (ext? Sym))
+      (set @
+         (conc
+            (head 12 (val Sym))
+            (mapcan
+               '((X)
+                  (and
+                     (sym? X)
+                     (list (placement X)) ) )
+               (nth (val Sym) 13) ) ) ) ) )
+
+# Reset orientation
+(de straight (M)
+   (touch M)
+   (map
+      '((V L) (set L (car V)))
+      *UMat
+      (cdddr (val M)) ) )
+
+# Movements
+(de z3d:dx (X M)
+   (touch M)
+   (set (val M)
+      (+ X (car (val M))) ) )
+
+(de z3d:dy (Y M)
+   (touch M)
+   (set (cdr (val M))
+      (+ Y (cadr (val M))) ) )
+
+(de z3d:dz (Z M)
+   (touch M)
+   (set (cddr (val M))
+      (+ Z (caddr (val M))) ) )
diff --git a/simul/rgb.l b/simul/rgb.l
@@ -0,0 +1,29 @@
+# 02sep99abu
+# (c) Software Lab. Alexander Burger
+
+(de rgb (R G B . S)
+   (def S (+ B (* G 256) (* R 65536))) )
+
+# Color Constant Definitions from "/usr/lib/X11/rgb.txt"
+(rgb 0     0   0 . Black)
+(rgb 0     0 255 . Blue)
+(rgb 165  42  42 . Brown)
+(rgb 0   100   0 . DarkGreen)
+(rgb 169 169 169 . DarkGrey)
+(rgb 190 190 190 . Grey)
+(rgb 173 216 230 . LightBlue)
+(rgb 211 211 211 . LightGrey)
+(rgb 255   0   0 . Red)
+(rgb 46  139  87 . SeaGreen)
+(rgb 255 255   0 . Yellow)
+
+(rgb 255 193 193 . RosyBrown1)
+(rgb 238 180 180 . RosyBrown2)
+(rgb 205 155 155 . RosyBrown3)
+(rgb 139 105 105 . RosyBrown4)
+
+(rgb 221 160 221 . Plum)
+(rgb 135 206 250 . LightSkyBlue)
+(rgb 245 222 179 . Wheat)
+(rgb 255 255 255 . White)
+(rgb 139   0   0 . DarkRed)
diff --git a/src/Makefile b/src/Makefile
@@ -0,0 +1,145 @@
+# 09dec09abu
+# 27feb08rdo
+# (c) Software Lab. Alexander Burger
+
+bin = ../bin
+lib = ../lib
+
+picoFiles = main.c gc.c apply.c flow.c sym.c subr.c big.c io.c net.c tab.c
+
+CFLAGS := -c -O2 -m32 -pipe \
+	-falign-functions -fomit-frame-pointer -fno-strict-aliasing \
+	-W -Wimplicit -Wreturn-type -Wunused -Wformat \
+	-Wuninitialized -Wstrict-prototypes \
+	-D_GNU_SOURCE  -D_FILE_OFFSET_BITS=64
+
+
+ifeq ($(shell uname), Linux)
+	OS = Linux
+	PICOLISP-FLAGS = -m32 -rdynamic
+	LIB-FLAGS = -lc -lm -ldl
+	DYNAMIC-LIB-FLAGS = -m32 -shared -export-dynamic
+	STRIP = strip
+else
+ifeq ($(shell uname), OpenBSD)
+	OS = OpenBSD
+	PICOLISP-FLAGS = -m32 -rdynamic
+	LIB-FLAGS = -lc -lm
+	DYNAMIC-LIB-FLAGS = -m32 -shared -export-dynamic
+	STRIP = strip
+else
+ifeq ($(shell uname), FreeBSD)
+	OS = FreeBSD
+	PICOLISP-FLAGS = -m32 -rdynamic
+	LIB-FLAGS = -lc -lm
+	DYNAMIC-LIB-FLAGS = -m32 -shared -export-dynamic
+	STRIP = strip
+else
+ifeq ($(shell uname), NetBSD)
+	OS = NetBSD
+	PICOLISP-FLAGS = -m32 -rdynamic
+	LIB-FLAGS = -lc -lm
+	DYNAMIC-LIB-FLAGS = -m32 -shared -export-dynamic
+	STRIP = strip
+else
+ifeq ($(shell uname), Darwin)
+	OS = Darwin
+	PICOLISP-FLAGS = -m32
+	LIB-FLAGS = -lc -lm -ldl
+	DYNAMIC-LIB-FLAGS = -m32 -dynamiclib -undefined dynamic_lookup
+	STRIP = :
+else
+ifeq ($(shell uname -o), Cygwin)
+	OS = Cygwin
+	DYNAMIC-LIB-FLAGS = -shared
+	PICOLISP-FLAGS =
+	DLL-DEFS = $(bin)/picolisp.dll
+	STRIP = strip
+	exe = .exe
+	dll = .dll
+endif
+endif
+endif
+endif
+endif
+endif
+
+
+picolisp: $(bin)/picolisp $(lib)/ext$(dll) $(lib)/ht$(dll) $(lib)/z3d$(dll)
+tools: $(bin)/lat1 $(bin)/utf2 $(bin)/balance
+gate: $(bin)/ssl $(bin)/httpGate
+x11: $(bin)/z3dClient
+
+all: picolisp tools gate x11
+
+.c.o:
+	gcc $(CFLAGS) -D_OS='"$(OS)"' $*.c
+
+
+$(picoFiles:.c=.o) ext.o ht.o z3d.o: pico.h
+
+
+ifeq ($(OS), Cygwin)
+
+$(bin)/picolisp$(dll): $(picoFiles:.c=.o)
+	gcc -o $(bin)/picolisp$(dll) $(DYNAMIC-LIB-FLAGS) $(picoFiles:.c=.o)
+	$(STRIP) $(bin)/picolisp$(dll)
+
+$(bin)/picolisp: $(picoFiles:.c=.o) $(bin)/picolisp$(dll) start.o
+	mkdir -p $(bin) $(lib)
+	gcc -o $(bin)/picolisp$(exe) $(PICOLISP-FLAGS) start.o -L$(bin) -l$(bin)/picolisp
+	$(STRIP) $(bin)/picolisp$(exe)
+
+else
+
+$(bin)/picolisp: $(picoFiles:.c=.o)
+	mkdir -p $(bin) $(lib)
+	gcc -o $(bin)/picolisp$(exe) $(PICOLISP-FLAGS) $(picoFiles:.c=.o) $(LIB-FLAGS)
+	$(STRIP) $(bin)/picolisp$(exe)
+
+endif
+
+
+$(lib)/ext$(dll): ext.o
+	gcc -o $(lib)/ext$(dll) $(DYNAMIC-LIB-FLAGS) ext.o $(DLL-DEFS)
+	$(STRIP) $(lib)/ext$(dll)
+
+$(lib)/ht$(dll): ht.o
+	gcc -o $(lib)/ht$(dll) $(DYNAMIC-LIB-FLAGS) ht.o $(DLL-DEFS)
+	$(STRIP) $(lib)/ht$(dll)
+
+$(lib)/z3d$(dll): z3d.o
+	gcc -o $(lib)/z3d$(dll)  $(DYNAMIC-LIB-FLAGS) z3d.o $(DLL-DEFS)
+	$(STRIP) $(lib)/z3d$(dll)
+
+
+$(bin)/lat1: lat1.o
+	gcc -m32 -o $(bin)/lat1$(exe) lat1.o
+	$(STRIP) $(bin)/lat1$(exe)
+
+$(bin)/utf2: utf2.o
+	gcc -m32 -o $(bin)/utf2$(exe) utf2.o
+	$(STRIP) $(bin)/utf2$(exe)
+
+$(bin)/balance: balance.o
+	gcc -m32 -o $(bin)/balance$(exe) balance.o
+	$(STRIP) $(bin)/balance$(exe)
+
+$(bin)/ssl: ssl.o
+	gcc -m32 -o $(bin)/ssl$(exe) ssl.o -lssl -lcrypto
+	$(STRIP) $(bin)/ssl$(exe)
+
+$(bin)/httpGate: httpGate.o
+	gcc -m32 -o $(bin)/httpGate$(exe) httpGate.o -lssl -lcrypto
+	$(STRIP) $(bin)/httpGate$(exe)
+
+$(bin)/z3dClient: z3dClient.o
+	gcc -m32 -o $(bin)/z3dClient$(exe) z3dClient.o  -L/usr/X11R6/lib -lXext -lX11
+	$(STRIP) $(bin)/z3dClient$(exe)
+
+
+# Clean up
+clean:
+	rm -f *.o
+
+# vi:noet:ts=4:sw=4
diff --git a/src/apply.c b/src/apply.c
@@ -0,0 +1,676 @@
+/* 06jun09abu
+ * (c) Software Lab. Alexander Burger
+ */
+
+#include "pico.h"
+
+any apply(any ex, any foo, bool cf, int n, cell *p) {
+   while (!isNum(foo)) {
+      if (isCell(foo)) {
+         int i;
+         any x = car(foo);
+         struct {  // bindFrame
+            struct bindFrame *link;
+            int i, cnt;
+            struct {any sym; any val;} bnd[length(x)+2];
+         } f;
+
+         f.link = Env.bind,  Env.bind = (bindFrame*)&f;
+         f.i = 0;
+         f.cnt = 1,  f.bnd[0].sym = At,  f.bnd[0].val = val(At);
+         while (isCell(x)) {
+            f.bnd[f.cnt].val = val(f.bnd[f.cnt].sym = car(x));
+            val(f.bnd[f.cnt].sym) = --n<0? Nil : cf? car(data(p[f.cnt-1])) : data(p[f.cnt-1]);
+            ++f.cnt, x = cdr(x);
+         }
+         if (isNil(x))
+            x = prog(cdr(foo));
+         else if (x != At) {
+            f.bnd[f.cnt].sym = x,  f.bnd[f.cnt++].val = val(x),  val(x) = Nil;
+            x = prog(cdr(foo));
+         }
+         else {
+            int cnt = n;
+            int next = Env.next;
+            cell *arg = Env.arg;
+            cell c[Env.next = n];
+
+            Env.arg = c;
+            for (i = f.cnt-1;  --n >= 0;  ++i)
+               Push(c[n], cf? car(data(p[i])) : data(p[i]));
+            x = prog(cdr(foo));
+            if (cnt)
+               drop(c[cnt-1]);
+            Env.arg = arg,  Env.next = next;
+         }
+         while (--f.cnt >= 0)
+            val(f.bnd[f.cnt].sym) = f.bnd[f.cnt].val;
+         Env.bind = f.link;
+         return x;
+      }
+      if (val(foo) == val(Meth)) {
+         any expr, o, x;
+
+         o = cf? car(data(p[0])) : data(p[0]);
+         NeedSym(ex,o);
+         Fetch(ex,o);
+         TheKey = foo,  TheCls = Nil;
+         if (expr = method(o)) {
+            int i;
+            methFrame m;
+            struct {  // bindFrame
+               struct bindFrame *link;
+               int i, cnt;
+               struct {any sym; any val;} bnd[length(x = car(expr))+3];
+            } f;
+
+            m.link = Env.meth;
+            m.key = TheKey;
+            m.cls = TheCls;
+            f.link = Env.bind,  Env.bind = (bindFrame*)&f;
+            f.i = 0;
+            f.cnt = 1,  f.bnd[0].sym = At,  f.bnd[0].val = val(At);
+            --n, ++p;
+            while (isCell(x)) {
+               f.bnd[f.cnt].val = val(f.bnd[f.cnt].sym = car(x));
+               val(f.bnd[f.cnt].sym) = --n<0? Nil : cf? car(data(p[f.cnt-1])) : data(p[f.cnt-1]);
+               ++f.cnt, x = cdr(x);
+            }
+            if (isNil(x)) {
+               f.bnd[f.cnt].sym = This;
+               f.bnd[f.cnt++].val = val(This);
+               val(This) = o;
+               Env.meth = &m;
+               x = prog(cdr(expr));
+            }
+            else if (x != At) {
+               f.bnd[f.cnt].sym = x,  f.bnd[f.cnt++].val = val(x),  val(x) = Nil;
+               f.bnd[f.cnt].sym = This;
+               f.bnd[f.cnt++].val = val(This);
+               val(This) = o;
+               Env.meth = &m;
+               x = prog(cdr(expr));
+            }
+            else {
+               int cnt = n;
+               int next = Env.next;
+               cell *arg = Env.arg;
+               cell c[Env.next = n];
+
+               Env.arg = c;
+               for (i = f.cnt-1;  --n >= 0;  ++i)
+                  Push(c[n], cf? car(data(p[i])) : data(p[i]));
+               f.bnd[f.cnt].sym = This;
+               f.bnd[f.cnt++].val = val(This);
+               val(This) = o;
+               Env.meth = &m;
+               x = prog(cdr(expr));
+               if (cnt)
+                  drop(c[cnt-1]);
+               Env.arg = arg,  Env.next = next;
+            }
+            while (--f.cnt >= 0)
+               val(f.bnd[f.cnt].sym) = f.bnd[f.cnt].val;
+            Env.bind = f.link;
+            Env.meth = Env.meth->link;
+            return x;
+         }
+         err(ex, o, "Bad object");
+      }
+      if (isNil(val(foo)) || foo == val(foo))
+         undefined(foo,ex);
+      foo = val(foo);
+   }
+   if (--n < 0)
+      cdr(ApplyBody) = Nil;
+   else {
+      any x = ApplyArgs;
+      val(caar(x)) = cf? car(data(p[n])) : data(p[n]);
+      while (--n >= 0) {
+         if (!isCell(cdr(x)))
+            cdr(x) = cons(cons(consSym(Nil,Nil), car(x)), Nil);
+         x = cdr(x);
+         val(caar(x)) = cf? car(data(p[n])) : data(p[n]);
+      }
+      cdr(ApplyBody) = car(x);
+   }
+   return evSubr(foo, ApplyBody);
+}
+
+// (apply 'fun 'lst ['any ..]) -> any
+any doApply(any ex) {
+   any x, y;
+   int i, n;
+   cell foo;
+
+   x = cdr(ex),  Push(foo, EVAL(car(x)));
+   x = cdr(x),  y = EVAL(car(x));
+   {
+      cell c[(n = length(cdr(x))) + length(y)];
+
+      while (isCell(y))
+         Push(c[n], car(y)),  y = cdr(y),  ++n;
+      for (i = 0; isCell(x = cdr(x)); ++i)
+         Push(c[i], EVAL(car(x)));
+      x = apply(ex, data(foo), NO, n, c);
+   }
+   drop(foo);
+   return x;
+}
+
+// (pass 'fun ['any ..]) -> any
+any doPass(any ex) {
+   any x;
+   int n, i;
+   cell foo, c[length(cdr(x = cdr(ex))) + (Env.next>0? Env.next : 0)];
+
+   Push(foo, EVAL(car(x)));
+   for (n = 0; isCell(x = cdr(x)); ++n)
+      Push(c[n], EVAL(car(x)));
+   for (i = Env.next;  --i >= 0;  ++n)
+      Push(c[n], data(Env.arg[i]));
+   x = apply(ex, data(foo), NO, n, c);
+   drop(foo);
+   return x;
+}
+
+// (maps 'fun 'sym ['lst ..]) -> any
+any doMaps(any ex) {
+   any x;
+   int i, n;
+   cell foo, c[length(cdr(x = cdr(ex)))];
+
+   Push(foo, EVAL(car(x)));
+   x = cdr(x),  Push(c[0], EVAL(car(x)));
+   NeedSym(ex, data(c[0]));
+   for (n = 1; isCell(x = cdr(x)); ++n)
+      Push(c[n], EVAL(car(x)));
+   Fetch(ex, data(c[0]));
+   data(c[0]) = tail1(data(c[0]));
+   while (isCell(data(c[0]))) {
+      x = apply(ex, data(foo), YES, n, c);
+      for (i = 0; i < n; ++i)
+         data(c[i]) = cdr(data(c[i]));
+   }
+   drop(foo);
+   return x;
+}
+
+// (map 'fun 'lst ..) -> lst
+any doMap(any ex) {
+   any x = cdr(ex);
+   cell foo;
+
+   Push(foo, EVAL(car(x)));
+   if (isCell(x = cdr(x))) {
+      int i, n = 0;
+      cell c[length(x)];
+
+      do
+         Push(c[n], EVAL(car(x))), ++n;
+      while (isCell(x = cdr(x)));
+      while (isCell(data(c[0]))) {
+         x = apply(ex, data(foo), NO, n, c);
+         for (i = 0; i < n; ++i)
+            data(c[i]) = cdr(data(c[i]));
+      }
+   }
+   drop(foo);
+   return x;
+}
+
+// (mapc 'fun 'lst ..) -> any
+any doMapc(any ex) {
+   any x = cdr(ex);
+   cell foo;
+
+   Push(foo, EVAL(car(x)));
+   if (isCell(x = cdr(x))) {
+      int i, n = 0;
+      cell c[length(x)];
+
+      do
+         Push(c[n], EVAL(car(x))), ++n;
+      while (isCell(x = cdr(x)));
+      while (isCell(data(c[0]))) {
+         x = apply(ex, data(foo), YES, n, c);
+         for (i = 0; i < n; ++i)
+            data(c[i]) = cdr(data(c[i]));
+      }
+   }
+   drop(foo);
+   return x;
+}
+
+// (maplist 'fun 'lst ..) -> lst
+any doMaplist(any ex) {
+   any x = cdr(ex);
+   cell res, foo;
+
+   Push(res, Nil);
+   Push(foo, EVAL(car(x)));
+   if (isCell(x = cdr(x))) {
+      int i, n = 0;
+      cell c[length(x)];
+
+      do
+         Push(c[n], EVAL(car(x))), ++n;
+      while (isCell(x = cdr(x)));
+      if (!isCell(data(c[0])))
+         return Pop(res);
+      data(res) = x = cons(apply(ex, data(foo), NO, n, c), Nil);
+      while (isCell(data(c[0]) = cdr(data(c[0])))) {
+         for (i = 1; i < n; ++i)
+            data(c[i]) = cdr(data(c[i]));
+         cdr(x) = cons(apply(ex, data(foo), NO, n, c), Nil);
+         x = cdr(x);
+      }
+   }
+   return Pop(res);
+}
+
+// (mapcar 'fun 'lst ..) -> lst
+any doMapcar(any ex) {
+   any x = cdr(ex);
+   cell res, foo;
+
+   Push(res, Nil);
+   Push(foo, EVAL(car(x)));
+   if (isCell(x = cdr(x))) {
+      int i, n = 0;
+      cell c[length(x)];
+
+      do
+         Push(c[n], EVAL(car(x))), ++n;
+      while (isCell(x = cdr(x)));
+      if (!isCell(data(c[0])))
+         return Pop(res);
+      data(res) = x = cons(apply(ex, data(foo), YES, n, c), Nil);
+      while (isCell(data(c[0]) = cdr(data(c[0])))) {
+         for (i = 1; i < n; ++i)
+            data(c[i]) = cdr(data(c[i]));
+         cdr(x) = cons(apply(ex, data(foo), YES, n, c), Nil);
+         x = cdr(x);
+      }
+   }
+   return Pop(res);
+}
+
+// (mapcon 'fun 'lst ..) -> lst
+any doMapcon(any ex) {
+   any x = cdr(ex);
+   cell res, foo;
+
+   Push(res, Nil);
+   Push(foo, EVAL(car(x)));
+   if (isCell(x = cdr(x))) {
+      int i, n = 0;
+      cell c[length(x)];
+
+      do
+         Push(c[n], EVAL(car(x))), ++n;
+      while (isCell(x = cdr(x)));
+      if (!isCell(data(c[0])))
+         return Pop(res);
+      while (!isCell(x = apply(ex, data(foo), NO, n, c))) {
+         if (!isCell(data(c[0]) = cdr(data(c[0]))))
+            return Pop(res);
+         for (i = 1; i < n; ++i)
+            data(c[i]) = cdr(data(c[i]));
+      }
+      data(res) = x;
+      while (isCell(data(c[0]) = cdr(data(c[0])))) {
+         for (i = 1; i < n; ++i)
+            data(c[i]) = cdr(data(c[i]));
+         while (isCell(cdr(x)))
+            x = cdr(x);
+         cdr(x) = apply(ex, data(foo), NO, n, c);
+      }
+   }
+   return Pop(res);
+}
+
+// (mapcan 'fun 'lst ..) -> lst
+any doMapcan(any ex) {
+   any x = cdr(ex);
+   cell res, foo;
+
+   Push(res, Nil);
+   Push(foo, EVAL(car(x)));
+   if (isCell(x = cdr(x))) {
+      int i, n = 0;
+      cell c[length(x)];
+
+      do
+         Push(c[n], EVAL(car(x))), ++n;
+      while (isCell(x = cdr(x)));
+      if (!isCell(data(c[0])))
+         return Pop(res);
+      while (!isCell(x = apply(ex, data(foo), YES, n, c))) {
+         if (!isCell(data(c[0]) = cdr(data(c[0]))))
+            return Pop(res);
+         for (i = 1; i < n; ++i)
+            data(c[i]) = cdr(data(c[i]));
+      }
+      data(res) = x;
+      while (isCell(data(c[0]) = cdr(data(c[0])))) {
+         for (i = 1; i < n; ++i)
+            data(c[i]) = cdr(data(c[i]));
+         while (isCell(cdr(x)))
+            x = cdr(x);
+         cdr(x) = apply(ex, data(foo), YES, n, c);
+      }
+   }
+   return Pop(res);
+}
+
+// (filter 'fun 'lst ..) -> lst
+any doFilter(any ex) {
+   any x = cdr(ex);
+   cell res, foo;
+
+   Push(res, Nil);
+   Push(foo, EVAL(car(x)));
+   if (isCell(x = cdr(x))) {
+      int i, n = 0;
+      cell c[length(x)];
+
+      do
+         Push(c[n], EVAL(car(x))), ++n;
+      while (isCell(x = cdr(x)));
+      if (!isCell(data(c[0])))
+         return Pop(res);
+      while (isNil(apply(ex, data(foo), YES, n, c))) {
+         if (!isCell(data(c[0]) = cdr(data(c[0]))))
+            return Pop(res);
+         for (i = 1; i < n; ++i)
+            data(c[i]) = cdr(data(c[i]));
+      }
+      data(res) = x = cons(car(data(c[0])), Nil);
+      while (isCell(data(c[0]) = cdr(data(c[0])))) {
+         for (i = 1; i < n; ++i)
+            data(c[i]) = cdr(data(c[i]));
+         if (!isNil(apply(ex, data(foo), YES, n, c)))
+            x = cdr(x) = cons(car(data(c[0])), Nil);
+      }
+   }
+   return Pop(res);
+}
+
+// (extract 'fun 'lst ..) -> lst
+any doExtract(any ex) {
+   any x = cdr(ex);
+   any y;
+   cell res, foo;
+
+   Push(res, Nil);
+   Push(foo, EVAL(car(x)));
+   if (isCell(x = cdr(x))) {
+      int i, n = 0;
+      cell c[length(x)];
+
+      do
+         Push(c[n], EVAL(car(x))), ++n;
+      while (isCell(x = cdr(x)));
+      if (!isCell(data(c[0])))
+         return Pop(res);
+      while (isNil(y = apply(ex, data(foo), YES, n, c))) {
+         if (!isCell(data(c[0]) = cdr(data(c[0]))))
+            return Pop(res);
+         for (i = 1; i < n; ++i)
+            data(c[i]) = cdr(data(c[i]));
+      }
+      data(res) = x = cons(y, Nil);
+      while (isCell(data(c[0]) = cdr(data(c[0])))) {
+         for (i = 1; i < n; ++i)
+            data(c[i]) = cdr(data(c[i]));
+         if (!isNil(y = apply(ex, data(foo), YES, n, c)))
+            x = cdr(x) = cons(y, Nil);
+      }
+   }
+   return Pop(res);
+}
+
+// (seek 'fun 'lst ..) -> lst
+any doSeek(any ex) {
+   any x = cdr(ex);
+   cell foo;
+
+   Push(foo, EVAL(car(x)));
+   if (isCell(x = cdr(x))) {
+      int i, n = 0;
+      cell c[length(x)];
+
+      do
+         Push(c[n], EVAL(car(x))), ++n;
+      while (isCell(x = cdr(x)));
+      while (isCell(data(c[0]))) {
+         if (!isNil(apply(ex, data(foo), NO, n, c))) {
+            drop(foo);
+            return data(c[0]);
+         }
+         for (i = 0; i < n; ++i)
+            data(c[i]) = cdr(data(c[i]));
+      }
+   }
+   drop(foo);
+   return Nil;
+}
+
+// (find 'fun 'lst ..) -> any
+any doFind(any ex) {
+   any x = cdr(ex);
+   cell foo;
+
+   Push(foo, EVAL(car(x)));
+   if (isCell(x = cdr(x))) {
+      int i, n = 0;
+      cell c[length(x)];
+
+      do
+         Push(c[n], EVAL(car(x))), ++n;
+      while (isCell(x = cdr(x)));
+      while (isCell(data(c[0]))) {
+         if (!isNil(apply(ex, data(foo), YES, n, c))) {
+            drop(foo);
+            return car(data(c[0]));
+         }
+         for (i = 0; i < n; ++i)
+            data(c[i]) = cdr(data(c[i]));
+      }
+   }
+   drop(foo);
+   return Nil;
+}
+
+// (pick 'fun 'lst ..) -> any
+any doPick(any ex) {
+   any x = cdr(ex);
+   cell foo;
+
+   Push(foo, EVAL(car(x)));
+   if (isCell(x = cdr(x))) {
+      int i, n = 0;
+      cell c[length(x)];
+
+      do
+         Push(c[n], EVAL(car(x))), ++n;
+      while (isCell(x = cdr(x)));
+      while (isCell(data(c[0]))) {
+         if (!isNil(x = apply(ex, data(foo), YES, n, c))) {
+            drop(foo);
+            return x;
+         }
+         for (i = 0; i < n; ++i)
+            data(c[i]) = cdr(data(c[i]));
+      }
+   }
+   drop(foo);
+   return Nil;
+}
+
+// (cnt 'fun 'lst ..) -> cnt
+any doCnt(any ex) {
+   any x = cdr(ex);
+   int res;
+   cell foo;
+
+   res = 0;
+   Push(foo, EVAL(car(x)));
+   if (isCell(x = cdr(x))) {
+      int i, n = 0;
+      cell c[length(x)];
+
+      do
+         Push(c[n], EVAL(car(x))), ++n;
+      while (isCell(x = cdr(x)));
+      while (isCell(data(c[0]))) {
+         if (!isNil(apply(ex, data(foo), YES, n, c)))
+            res += 2;
+         for (i = 0; i < n; ++i)
+            data(c[i]) = cdr(data(c[i]));
+      }
+   }
+   drop(foo);
+   return box(res);
+}
+
+// (sum 'fun 'lst ..) -> num
+any doSum(any ex) {
+   any x = cdr(ex);
+   cell res, foo, c1;
+
+   Push(res, box(0));
+   Push(foo, EVAL(car(x)));
+   if (isCell(x = cdr(x))) {
+      int i, n = 0;
+      cell c[length(x)];
+
+      do
+         Push(c[n], EVAL(car(x))), ++n;
+      while (isCell(x = cdr(x)));
+      while (isCell(data(c[0]))) {
+         if (isNum(data(c1) = apply(ex, data(foo), YES, n, c))) {
+            Save(c1);
+            if (isNeg(data(res))) {
+               if (isNeg(data(c1)))
+                  bigAdd(data(res),data(c1));
+               else
+                  bigSub(data(res),data(c1));
+               if (!IsZero(data(res)))
+                  neg(data(res));
+            }
+            else if (isNeg(data(c1)))
+               bigSub(data(res),data(c1));
+            else
+               bigAdd(data(res),data(c1));
+            drop(c1);
+         }
+         for (i = 0; i < n; ++i)
+            data(c[i]) = cdr(data(c[i]));
+      }
+   }
+   return Pop(res);
+}
+
+// (maxi 'fun 'lst ..) -> any
+any doMaxi(any ex) {
+   any x = cdr(ex);
+   cell res, val, foo;
+
+   Push(res, Nil);
+   Push(val, Nil);
+   Push(foo, EVAL(car(x)));
+   if (isCell(x = cdr(x))) {
+      int i, n = 0;
+      cell c[length(x)];
+
+      do
+         Push(c[n], EVAL(car(x))), ++n;
+      while (isCell(x = cdr(x)));
+      while (isCell(data(c[0]))) {
+         if (compare(x = apply(ex, data(foo), YES, n, c), data(val)) > 0)
+            data(res) = car(data(c[0])),  data(val) = x;
+         for (i = 0; i < n; ++i)
+            data(c[i]) = cdr(data(c[i]));
+      }
+   }
+   return Pop(res);
+}
+
+// (mini 'fun 'lst ..) -> any
+any doMini(any ex) {
+   any x = cdr(ex);
+   cell res, val, foo;
+
+   Push(res, Nil);
+   Push(val, T);
+   Push(foo, EVAL(car(x)));
+   if (isCell(x = cdr(x))) {
+      int i, n = 0;
+      cell c[length(x)];
+
+      do
+         Push(c[n], EVAL(car(x))), ++n;
+      while (isCell(x = cdr(x)));
+      while (isCell(data(c[0]))) {
+         if (compare(x = apply(ex, data(foo), YES, n, c), data(val)) < 0)
+            data(res) = car(data(c[0])),  data(val) = x;
+         for (i = 0; i < n; ++i)
+            data(c[i]) = cdr(data(c[i]));
+      }
+   }
+   return Pop(res);
+}
+
+static void fish(any ex, any foo, any x, cell *r) {
+   if (!isNil(apply(ex, foo, NO, 1, (cell*)&x)))
+      data(*r) = cons(x, data(*r));
+   else if (isCell(x)) {
+      if (!isNil(cdr(x)))
+         fish(ex, foo, cdr(x), r);
+      fish(ex, foo, car(x), r);
+   }
+}
+
+// (fish 'fun 'any) -> lst
+any doFish(any ex) {
+   any x = cdr(ex);
+   cell res, foo, c1;
+
+   Push(res, Nil);
+   Push(foo, EVAL(car(x)));
+   x = cdr(x),  Push(c1, EVAL(car(x)));
+   fish(ex, data(foo), data(c1), &res);
+   return Pop(res);
+}
+
+// (by 'fun1 'fun2 'lst ..) -> lst
+any doBy(any ex) {
+   any x = cdr(ex);
+   cell res, foo1, foo2;
+
+   Push(res, Nil);
+   Push(foo1, EVAL(car(x))),  x = cdr(x),  Push(foo2, EVAL(car(x)));
+   if (isCell(x = cdr(x))) {
+      int i, n = 0;
+      cell c[length(x)];
+
+      do
+         Push(c[n], EVAL(car(x))), ++n;
+      while (isCell(x = cdr(x)));
+      if (!isCell(data(c[0])))
+         return Pop(res);
+      data(res) = x = cons(cons(apply(ex, data(foo1), YES, n, c), car(data(c[0]))), Nil);
+      while (isCell(data(c[0]) = cdr(data(c[0])))) {
+         for (i = 1; i < n; ++i)
+            data(c[i]) = cdr(data(c[i]));
+         cdr(x) = cons(cons(apply(ex, data(foo1), YES, n, c), car(data(c[0]))), Nil);
+         x = cdr(x);
+      }
+      data(res) = apply(ex, data(foo2), NO, 1, &res);
+      for (x = data(res); isCell(x); x = cdr(x))
+         car(x) = cdar(x);
+   }
+   return Pop(res);
+}
diff --git a/src/balance.c b/src/balance.c
@@ -0,0 +1,94 @@
+/* balance.c
+ * 06jul05abu
+ */
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <unistd.h>
+#include <string.h>
+#include <errno.h>
+#include <signal.h>
+#include <sys/wait.h>
+
+int Len, Siz;
+char *Line, **Data;
+
+static void giveup(char *msg) {
+   fprintf(stderr, "balance: %s\n", msg);
+   exit(1);
+}
+
+static char *getLine(FILE *fp) {
+	int i, c;
+   char *s;
+
+   i = 0;
+   while ((c = getc_unlocked(fp)) != '\n') {
+      if (c == EOF)
+         return NULL;
+      Line[i] = c;
+      if (++i == Len  &&  !(Line = realloc(Line, Len *= 2)))
+         giveup("No memory");
+   }
+   Line[i] = '\0';
+   if (!(s = strdup(Line)))
+      giveup("No memory");
+   return s;
+}
+
+static void balance(char **data, int len) {
+   if (len) {
+      int n = (len + 1) / 2;
+      char **p = data + n - 1;
+
+      printf("%s\n", *p);
+      balance(data, n - 1);
+      balance(p + 1, len - n);
+   }
+}
+
+// balance [-<cmd> [<arg> ..]]
+// balance [<file>]
+int main(int ac, char *av[]) {
+   int cnt;
+   char *s;
+   pid_t pid = 0;
+   FILE *fp = stdin;
+
+   if (ac > 1) {
+      if (*av[1] == '-') {
+         int pfd[2];
+
+         if (pipe(pfd) < 0)
+            giveup("Pipe error\n");
+         if ((pid = fork()) == 0) {
+            close(pfd[0]);
+            if (pfd[1] != STDOUT_FILENO)
+               dup2(pfd[1], STDOUT_FILENO),  close(pfd[1]);
+            execvp(av[1]+1, av+1);
+         }
+         if (pid < 0)
+            giveup("Fork error\n");
+         close(pfd[1]);
+         if (!(fp = fdopen(pfd[0], "r")))
+            giveup("Pipe open error\n");
+      }
+      else if (!(fp = fopen(av[1], "r")))
+         giveup("File open error\n");
+   }
+   Line = malloc(Len = 4096);
+   Data = malloc((Siz = 4096) * sizeof(char*));
+   for (cnt = 0;  s = getLine(fp);  ++cnt) {
+      if (cnt == Siz  &&  !(Data = realloc(Data, (Siz *= 2) * sizeof(char*))))
+         giveup("No memory");
+      Data[cnt] = s;
+   }
+   if (pid) {
+      fclose(fp);
+      while (waitpid(pid, NULL, 0) < 0)
+         if (errno != EINTR)
+            giveup("Pipe close error\n");
+   }
+   balance(Data, cnt);
+   return 0;
+}
diff --git a/src/big.c b/src/big.c
@@ -0,0 +1,1137 @@
+/* 01mar10abu
+ * (c) Software Lab. Alexander Burger
+ */
+
+#include "pico.h"
+
+#define MAX    MASK           // Max digit size    0xFFFF....
+#define OVFL   ((1<<BITS-1))  // Carry/Overflow    0x8000....
+
+
+static void divErr(any ex) {err(ex,NULL,"Div/0");}
+
+/* Box double word */
+any boxWord2(word2 t) {
+   cell c1;
+
+   Push(c1, hi(t)? consNum(num(t), box(hi(t))) : box(num(t)));
+   digMul2(data(c1));
+   return Pop(c1);
+}
+
+word2 unBoxWord2(any x) {
+   word2 n = unDig(x);
+
+   if (isNum(x = cdr(numCell(x))))
+      n = n << BITS + unDig(x);
+   return n / 2;
+}
+
+/* Bignum copy */
+any bigCopy(any x) {
+   any y;
+   cell c1, c2;
+
+   Push(c1, x);
+   Push(c2, y = box(unDig(x)));
+   while (isNum(x = cdr(numCell(x))))
+      y = cdr(numCell(y)) = box(unDig(x));
+   drop(c1);
+   return data(c2);
+}
+
+/* Remove leading zero words */
+void zapZero(any x) {
+   any r = x;
+
+   while (isNum(x = cdr(numCell(x))))
+      if (unDig(x))
+         r = x;
+   cdr(numCell(r)) = x;
+}
+
+/* Multiply a (positive) bignum by 2 */
+void digMul2(any x) {
+   any y;
+   word n, carry;
+
+   n = unDig(x),  setDig(x, n + n),  carry = n & OVFL;
+   while (isNum(x = cdr(numCell(y = x)))) {
+      n = unDig(x);
+      setDig(x, n + n + (carry? 1 : 0));
+      carry = n & OVFL;
+   }
+   if (carry)
+      cdr(numCell(y)) = box(1);
+}
+
+/* Shift right by one bit */
+void digDiv2(any x) {
+   any r, y;
+
+   r = NULL;
+   setDig(x, unDig(x) / 2);
+   while (isNum(x = cdr(numCell(y = x)))) {
+      if (unDig(x) & 1)
+         setDig(y, unDig(y) | OVFL);
+      setDig(x, unDig(x) / 2);
+      r = y;
+   }
+   if (r  &&  unDig(y) == 0)
+      cdr(numCell(r)) = x;
+}
+
+/* Add two (positive) bignums */
+void bigAdd(any dst, any src) {
+   any x;
+   word n, carry;
+
+   carry = (unDig(src) & ~1) > num(setDig(dst, (unDig(src) & ~1) + (unDig(dst) & ~1)));
+   src = cdr(numCell(src));
+   dst = cdr(numCell(x = dst));
+   for (;;) {
+      if (!isNum(src)) {
+         while (isNum(dst)) {
+            if (!carry)
+               return;
+            carry = 0 == num(setDig(dst, 1 + unDig(dst)));
+            dst = cdr(numCell(x = dst));
+         }
+         break;
+      }
+      if (!isNum(dst)) {
+         do {
+            carry = unDig(src) > (n = carry + unDig(src));
+            x = cdr(numCell(x)) = box(n);
+         } while (isNum(src = cdr(numCell(src))));
+         break;
+      }
+      if ((n = carry + unDig(src)) >= carry)
+         carry = unDig(dst) > (n += unDig(dst));
+      else
+         n = unDig(dst);
+      setDig(dst,n);
+      src = cdr(numCell(src));
+      dst = cdr(numCell(x = dst));
+   }
+   if (carry)
+      cdr(numCell(x)) = box(1);
+}
+
+/* Add digit to a (positive) bignum */
+void digAdd(any x, word n) {
+   any y;
+   word carry;
+
+   carry = n > num(setDig(x, n + unDig(x)));
+   while (carry) {
+      if (isNum(x = cdr(numCell(y = x))))
+         carry = 0 == num(setDig(x, 1 + unDig(x)));
+      else {
+         cdr(numCell(y)) = box(1);
+         break;
+      }
+   }
+}
+
+/* Subtract two (positive) bignums */
+void bigSub(any dst, any src) {
+   any x, y;
+   word n, borrow;
+
+   borrow = MAX - (unDig(src) & ~1) < num(setDig(dst, (unDig(dst) & ~1) - (unDig(src) & ~1)));
+   y = dst;
+   for (;;) {
+      src = cdr(numCell(src));
+      dst = cdr(numCell(x = dst));
+      if (!isNum(src)) {
+         while (isNum(dst)) {
+            if (!borrow)
+               return;
+            borrow = MAX == num(setDig(dst, unDig(dst) - 1));
+            dst = cdr(numCell(x = dst));
+         }
+         break;
+      }
+      if (!isNum(dst)) {
+         do {
+            if (borrow)
+               n = MAX - unDig(src);
+            else
+               borrow = 0 != (n = -unDig(src));
+            x = cdr(numCell(x)) = box(n);
+         } while (isNum(src = cdr(numCell(src))));
+         break;
+      }
+      if ((n = unDig(dst) - borrow) > MAX - borrow)
+         setDig(dst, MAX - unDig(src));
+      else
+         borrow = num(setDig(dst, n - unDig(src))) > MAX - unDig(src);
+   }
+   if (borrow) {
+      dst = y;
+      borrow = 0 != (n = -unDig(dst));
+      setDig(dst, n | 1);  /* Negate */
+      while (dst != x) {
+         dst = cdr(numCell(dst));
+         if (borrow)
+            setDig(dst, MAX - unDig(dst));
+         else
+            borrow = 0 != num(setDig(dst, -unDig(dst)));
+      }
+   }
+   if (unDig(x) == 0)
+      zapZero(y);
+}
+
+/* Subtract 1 from a (positive) bignum */
+void digSub1(any x) {
+   any r, y;
+   word borrow;
+
+   r = NULL;
+   borrow = MAX-1 == num(setDig(x, unDig(x) - 2));
+   while (isNum(x = cdr(numCell(y = x)))) {
+      if (!borrow)
+         return;
+      borrow = MAX == num(setDig(x, unDig(x) - 1));
+      r = y;
+   }
+   if (r  &&  unDig(y) == 0)
+      cdr(numCell(r)) = x;
+}
+
+/* Multiply two (positive) bignums */
+static any bigMul(any x1, any x2) {
+   any x, y, z;
+   word n, carry;
+   word2 t;
+   cell c1;
+
+   Push(c1, x = y = box(0));
+   for (;;) {
+      n = unDig(x2) / 2;
+      if (isNum(x2 = cdr(numCell(x2)))  &&  unDig(x2) & 1)
+         n |= OVFL;
+      t = (word2)n * unDig(z = x1);  // x += n * x1
+      carry = (lo(t) > num(setDig(y, unDig(y) + lo(t)))) + hi(t);
+      while (isNum(z = cdr(numCell(z)))) {
+         if (!isNum(cdr(numCell(y))))
+            cdr(numCell(y)) = box(0);
+         y = cdr(numCell(y));
+         t = (word2)n * unDig(z);
+         carry = carry > num(setDig(y, carry + unDig(y)));
+         if (lo(t) > num(setDig(y, unDig(y) + lo(t))))
+            ++carry;
+         carry += hi(t);
+      }
+      if (carry)
+         cdr(numCell(y)) = box(carry);
+      if (!isNum(x2))
+         break;
+      if (!isNum(y = cdr(numCell(x))))
+         y = cdr(numCell(x)) = box(0);
+      x = y;
+   } while (isNum(x2));
+   zapZero(data(c1));
+   return Pop(c1);
+}
+
+/* Multiply digit with a (positive) bignum */
+static void digMul(any x, word n) {
+   word2 t;
+   any y;
+
+   t = (word2)n * unDig(x);
+   for (;;) {
+      setDig(x, num(t));
+      t = hi(t);
+      if (!isNum(x = cdr(numCell(y = x))))
+         break;
+      t += (word2)n * unDig(x);
+   }
+   if (t)
+      cdr(numCell(y)) = box(num(t));
+}
+
+/* (Positive) Bignum comparison */
+static int bigCmp(any x, any y) {
+   int res;
+   any x1, y1, x2, y2;
+
+   x1 = y1 = Nil;
+   for (;;) {
+      if ((x2 = cdr(numCell(x))) == (y2 = cdr(numCell(y)))) {
+         for (;;) {
+            if (unDig(x) < unDig(y)) {
+               res = -1;
+               break;
+            }
+            if (unDig(x) > unDig(y)) {
+               res = +1;
+               break;
+            }
+            if (!isNum(x1))
+               return 0;
+            x2 = cdr(numCell(x1)),  cdr(numCell(x1)) = x,  x = x1,  x1 = x2;
+            y2 = cdr(numCell(y1)),  cdr(numCell(y1)) = y,  y = y1,  y1 = y2;
+         }
+         break;
+      }
+      if (!isNum(x2)) {
+         res = -1;
+         break;
+      }
+      if (!isNum(y2)) {
+         res = +1;
+         break;
+      }
+      cdr(numCell(x)) = x1,  x1 = x,  x = x2;
+      cdr(numCell(y)) = y1,  y1 = y,  y = y2;
+   }
+   while (isNum(x1)) {
+      x2 = cdr(numCell(x1)),  cdr(numCell(x1)) = x,  x = x1,  x1 = x2;
+      y2 = cdr(numCell(y1)),  cdr(numCell(y1)) = y,  y = y1,  y1 = y2;
+   }
+   return res;
+}
+
+/* Divide two (positive) bignums (Knuth Vol.2, p.257) */
+static any bigDiv(any u, any v, bool rem) {
+   int m, n, d, i;
+   word q, v1, v2, u1, u2, u3, borrow;
+   word2 t, r;
+   any x, y, z;
+   cell c1;
+
+   digDiv2(u),  digDiv2(v);                                 // Normalize
+   for (m = 0, z = u;  isNum(y = cdr(numCell(z)));  ++m, z = y);
+   x = v,  y = NULL,  n = 1;
+   while (isNum(cdr(numCell(x))))
+      y = x,  x = cdr(numCell(x)),  ++n,  --m;
+   if (m < 0) {
+      if (rem)
+         digMul2(u);
+      return box(0);
+   }
+   cdr(numCell(z)) = box(0);
+   for (d = 0;  (unDig(x) & OVFL) == 0;  ++d)
+      digMul2(u),  digMul2(v);
+   v1 = unDig(x);
+   v2 = y? unDig(y) : 0;
+   Push(c1, Nil);
+   do {
+      for (i = m, x = u;  --i >= 0;  x = cdr(numCell(x)));  // Index x -> u
+      i = n;
+      y = x;
+      u1 = u2 = 0;
+      do
+         u3 = u2,  u2 = u1,  u1 = unDig(y),  y = cdr(numCell(y));
+      while (--i >= 0);
+
+      t = ((word2)u1 << BITS) + u2;                         // Calculate q
+      q = u1 == v1? MAX : t / v1;
+      r = t - (word2)q*v1;
+      while (r <= MAX  &&  (word2)q*v2 > (r << BITS) + u3)
+         --q,  r += v1;
+
+      z = x;                                                // x -= q*v
+      t = (word2)q * unDig(y = v);
+      borrow = (MAX - lo(t) < num(setDig(z, unDig(z) - lo(t)))) + hi(t);
+      while (isNum(y = cdr(numCell(y)))) {
+         z = cdr(numCell(z));
+         t = (word2)q * unDig(y);
+         borrow = MAX - borrow < num(setDig(z, unDig(z) - borrow));
+         if (MAX - lo(t) < num(setDig(z, unDig(z) - lo(t))))
+            ++borrow;
+         borrow += hi(t);
+      }
+      if (borrow) {
+         z = cdr(numCell(z));
+         if (MAX - borrow < num(setDig(z, unDig(z) - borrow))) {
+            word n, carry;                                  // x += v
+
+            --q;
+            if (m || rem) {
+               y = v;
+               carry = unDig(y) > num(setDig(x, unDig(y) + unDig(x)));
+               while (x = cdr(numCell(x)),  isNum(y = cdr(numCell(y)))) {
+                  if ((n = carry + unDig(y)) >= carry)
+                     carry = unDig(x) > (n += unDig(x));
+                  else
+                     n = unDig(x);
+                  setDig(x,n);
+               }
+               setDig(x, carry + unDig(x));
+            }
+         }
+      }
+      data(c1) = consNum(q, data(c1));                      // Store result
+   } while (--m >= 0);
+   if (!rem)
+      zapZero(data(c1)),  digMul2(data(c1));
+   else {
+      zapZero(u);
+      if (!d)
+         digMul2(u);
+      else
+         while (--d)
+            digDiv2(u);
+   }
+   return Pop(c1);
+}
+
+/* Compare two numbers */
+int bigCompare(any x, any y) {
+   if (isNeg(x)) {
+      if (!isNeg(y))
+         return -1;
+      return bigCmp(y,x);
+   }
+   if (isNeg(y))
+      return +1;
+   return bigCmp(x,y);
+}
+
+/* Make number from symbol */
+any symToNum(any s, int scl, int sep, int ign) {
+   unsigned c;
+   bool sign, frac;
+   cell c1, c2;
+
+   if (!(c = symByte(s)))
+      return NULL;
+   while (c <= ' ')  /* Skip white space */
+      if (!(c = symByte(NULL)))
+         return NULL;
+   sign = NO;
+   if (c == '+'  ||  c == '-' && (sign = YES))
+      if (!(c = symByte(NULL)))
+         return NULL;
+   if ((c -= '0') > 9)
+      return NULL;
+   frac = NO;
+   Push(c1, s);
+   Push(c2, box(c+c));
+   while ((c = symChar(NULL))  &&  (!frac || scl)) {
+      if ((int)c == sep) {
+         if (frac) {
+            drop(c1);
+            return NULL;
+         }
+         frac = YES;
+      }
+      else if ((int)c != ign) {
+         if ((c -= '0') > 9) {
+            drop(c1);
+            return NULL;
+         }
+         digMul(data(c2), 10);
+         digAdd(data(c2), c+c);
+         if (frac)
+            --scl;
+      }
+   }
+   if (c) {
+      if ((c -= '0') > 9) {
+         drop(c1);
+         return NULL;
+      }
+      if (c >= 5)
+         digAdd(data(c2), 1+1);
+      while (c = symByte(NULL)) {
+         if ((c -= '0') > 9) {
+            drop(c1);
+            return NULL;
+         }
+      }
+   }
+   if (frac)
+      while (--scl >= 0)
+         digMul(data(c2), 10);
+   if (sign && !IsZero(data(c2)))
+      neg(data(c2));
+   drop(c1);
+   return data(c2);
+}
+
+/* Buffer size calculation */
+static inline int numlen(any x) {
+   int n = 10;
+   while (isNum(x = cdr(numCell(x))))
+      n += 10;
+   return (n + 8) / 9;
+}
+
+/* Make symbol from number */
+any numToSym(any x, int scl, int sep, int ign) {
+   int i;
+   bool sign;
+   cell c1;
+   word n = numlen(x);
+   word c, *p, *q, *ta, *ti, acc[n], inc[n];
+   char *b, buf[10];
+
+   sign = isNeg(x);
+   *(ta = acc) = 0;
+   *(ti = inc) = 1;
+   n = 2;
+   for (;;) {
+      do {
+         if (unDig(x) & n) {
+            c = 0,  p = acc,  q = inc;
+            do {
+               if (ta < p)
+                  *++ta = 0;
+               if (c = (*p += *q + c) > 999999999)
+                  *p -= 1000000000;
+            } while (++p, ++q <= ti);
+            if (c)
+               *p = 1,  ++ta;
+         }
+         c = 0,  q = inc;
+         do
+            if (c = (*q += *q + c) > 999999999)
+               *q -= 1000000000;
+         while (++q <= ti);
+         if (c)
+            *q = 1,  ++ti;
+      } while (n <<= 1);
+      if (!isNum(x = cdr(numCell(x))))
+         break;
+      n = 1;
+   }
+   n = (ta - acc) * 9 + sprintf(b = buf, "%ld", *ta--);
+   if (sep < 0)
+      return boxCnt(n + sign);
+   i = -8,  Push(c1, x = box(0));
+   if (sign)
+      byteSym('-', &i, &x);
+   if ((scl = n - scl - 1) < 0) {
+      byteSym('0', &i, &x);
+      charSym(sep, &i, &x);
+      while (scl < -1)
+         byteSym('0', &i, &x),  ++scl;
+   }
+   for (;;) {
+      byteSym(*b++, &i, &x);
+      if (!*b) {
+         if (ta < acc)
+            return consStr(Pop(c1));
+         sprintf(b = buf, "%09ld", *ta--);
+      }
+      if (scl == 0)
+         charSym(sep, &i, &x);
+      else if (ign  &&  scl > 0  &&  scl % 3 == 0)
+         charSym(ign, &i, &x);
+      --scl;
+   }
+}
+
+#define DMAX ((double)((word2)MASK+1))
+
+/* Make number from double */
+any doubleToNum(double d) {
+   bool sign;
+   any x;
+   cell c1;
+
+   sign = NO;
+   if (d < 0.0)
+      sign = YES,  d = -d;
+   d += 0.5;
+   Push(c1, x = box((word)fmod(d,DMAX)));
+   while (d > DMAX)
+      x = cdr(numCell(x)) = box((word)fmod(d /= DMAX, DMAX));
+   digMul2(data(c1));
+   if (sign && !IsZero(data(c1)))
+      neg(data(c1));
+   return Pop(c1);
+}
+
+/* Make double from number */
+double numToDouble(any x) {
+   double d, m;
+   bool sign;
+
+   sign = isNeg(x);
+   d = (double)(unDig(x) / 2),  m = DMAX/2.0;
+   while (isNum(x = cdr(numCell(x))))
+      d += m * (double)unDig(x),  m *= DMAX;
+   return sign? -d : d;
+}
+
+// (format 'num ['cnt ['sym1 ['sym2]]]) -> sym
+// (format 'sym ['cnt ['sym1 ['sym2]]]) -> num
+any doFormat(any ex) {
+   int scl, sep, ign;
+   any x, y;
+   cell c1;
+
+   x = cdr(ex),  Push(c1, EVAL(car(x)));
+   NeedAtom(ex,data(c1));
+   x = cdr(x),  y = EVAL(car(x));
+   scl = isNil(y)? 0 : xCnt(ex, y);
+   sep = '.';
+   ign = 0;
+   if (isCell(x = cdr(x))) {
+      y = EVAL(car(x));
+      NeedSym(ex,y);
+      sep = symChar(name(y));
+      if (isCell(x = cdr(x))) {
+         y = EVAL(car(x));
+         NeedSym(ex,y);
+         ign = symChar(name(y));
+      }
+   }
+   data(c1) = isNum(data(c1))?
+      numToSym(data(c1), scl, sep, ign) :
+      symToNum(name(data(c1)), scl, sep, ign) ?: Nil;
+   return Pop(c1);
+}
+
+// (+ 'num ..) -> num
+any doAdd(any ex) {
+   any x;
+   cell c1, c2;
+
+   x = cdr(ex);
+   if (isNil(data(c1) = EVAL(car(x))))
+      return Nil;
+   NeedNum(ex,data(c1));
+   Push(c1, bigCopy(data(c1)));
+   while (isCell(x = cdr(x))) {
+      Push(c2, EVAL(car(x)));
+      if (isNil(data(c2))) {
+         drop(c1);
+         return Nil;
+      }
+      NeedNum(ex,data(c2));
+      if (isNeg(data(c1))) {
+         if (isNeg(data(c2)))
+            bigAdd(data(c1),data(c2));
+         else
+            bigSub(data(c1),data(c2));
+         if (!IsZero(data(c1)))
+            neg(data(c1));
+      }
+      else if (isNeg(data(c2)))
+         bigSub(data(c1),data(c2));
+      else
+         bigAdd(data(c1),data(c2));
+      drop(c2);
+   }
+   return Pop(c1);
+}
+
+// (- 'num ..) -> num
+any doSub(any ex) {
+   any x;
+   cell c1, c2;
+
+   x = cdr(ex);
+   if (isNil(data(c1) = EVAL(car(x))))
+      return Nil;
+   NeedNum(ex,data(c1));
+   if (!isCell(x = cdr(x)))
+      return IsZero(data(c1))?
+            data(c1) : consNum(unDig(data(c1)) ^ 1, cdr(numCell(data(c1))));
+   Push(c1, bigCopy(data(c1)));
+   do {
+      Push(c2, EVAL(car(x)));
+      if (isNil(data(c2))) {
+         drop(c1);
+         return Nil;
+      }
+      NeedNum(ex,data(c2));
+      if (isNeg(data(c1))) {
+         if (isNeg(data(c2)))
+            bigSub(data(c1),data(c2));
+         else
+            bigAdd(data(c1),data(c2));
+         if (!IsZero(data(c1)))
+            neg(data(c1));
+      }
+      else if (isNeg(data(c2)))
+         bigAdd(data(c1),data(c2));
+      else
+         bigSub(data(c1),data(c2));
+      drop(c2);
+   } while (isCell(x = cdr(x)));
+   return Pop(c1);
+}
+
+// (inc 'num) -> num
+// (inc 'var ['num]) -> num
+any doInc(any ex) {
+   any x;
+   cell c1, c2;
+
+   x = cdr(ex);
+   if (isNil(data(c1) = EVAL(car(x))))
+      return Nil;
+   if (isNum(data(c1))) {
+      Push(c1, bigCopy(data(c1)));
+      if (!isNeg(data(c1)))
+         digAdd(data(c1), 2);
+      else {
+         pos(data(c1)), digSub1(data(c1)), neg(data(c1));
+         if (unDig(data(c1)) == 1  &&  !isNum(cdr(numCell(data(c1)))))
+            setDig(data(c1), 0);
+      }
+      return Pop(c1);
+   }
+   CheckVar(ex,data(c1));
+   if (isSym(data(c1)))
+      Touch(ex,data(c1));
+   if (!isCell(x = cdr(x))) {
+      if (isNil(val(data(c1))))
+         return Nil;
+      NeedNum(ex,val(data(c1)));
+      Save(c1);
+      val(data(c1)) = bigCopy(val(data(c1)));
+      if (!isNeg(val(data(c1))))
+         digAdd(val(data(c1)), 2);
+      else {
+         pos(val(data(c1))), digSub1(val(data(c1))), neg(val(data(c1)));
+         if (unDig(val(data(c1))) == 1  &&  !isNum(cdr(numCell(val(data(c1))))))
+            setDig(val(data(c1)), 0);
+      }
+   }
+   else {
+      Save(c1);
+      Push(c2, EVAL(car(x)));
+      if (isNil(val(data(c1))) || isNil(data(c2))) {
+         drop(c1);
+         return Nil;
+      }
+      NeedNum(ex,val(data(c1)));
+      val(data(c1)) = bigCopy(val(data(c1)));
+      NeedNum(ex,data(c2));
+      if (isNeg(val(data(c1)))) {
+         if (isNeg(data(c2)))
+            bigAdd(val(data(c1)),data(c2));
+         else
+            bigSub(val(data(c1)),data(c2));
+         if (!IsZero(val(data(c1))))
+            neg(val(data(c1)));
+      }
+      else if (isNeg(data(c2)))
+         bigSub(val(data(c1)),data(c2));
+      else
+         bigAdd(val(data(c1)),data(c2));
+   }
+   return val(Pop(c1));
+}
+
+// (dec 'num) -> num
+// (dec 'var ['num]) -> num
+any doDec(any ex) {
+   any x;
+   cell c1, c2;
+
+   x = cdr(ex);
+   if (isNil(data(c1) = EVAL(car(x))))
+      return Nil;
+   if (isNum(data(c1))) {
+      Push(c1, bigCopy(data(c1)));
+      if (isNeg(data(c1)))
+         digAdd(data(c1), 2);
+      else if (IsZero(data(c1)))
+         setDig(data(c1), 3);
+      else
+         digSub1(data(c1));
+      return Pop(c1);
+   }
+   CheckVar(ex,data(c1));
+   if (isSym(data(c1)))
+      Touch(ex,data(c1));
+   if (!isCell(x = cdr(x))) {
+      if (isNil(val(data(c1))))
+         return Nil;
+      NeedNum(ex,val(data(c1)));
+      Save(c1);
+      val(data(c1)) = bigCopy(val(data(c1)));
+      if (isNeg(val(data(c1))))
+         digAdd(val(data(c1)), 2);
+      else if (IsZero(val(data(c1))))
+         setDig(val(data(c1)), 3);
+      else
+         digSub1(val(data(c1)));
+   }
+   else {
+      Save(c1);
+      Push(c2, EVAL(car(x)));
+      if (isNil(val(data(c1))) || isNil(data(c2))) {
+         drop(c1);
+         return Nil;
+      }
+      NeedNum(ex,val(data(c1)));
+      val(data(c1)) = bigCopy(val(data(c1)));
+      NeedNum(ex,data(c2));
+      if (isNeg(val(data(c1)))) {
+         if (isNeg(data(c2)))
+            bigSub(val(data(c1)),data(c2));
+         else
+            bigAdd(val(data(c1)),data(c2));
+         if (!IsZero(val(data(c1))))
+            neg(val(data(c1)));
+      }
+      else if (isNeg(data(c2)))
+         bigAdd(val(data(c1)),data(c2));
+      else
+         bigSub(val(data(c1)),data(c2));
+   }
+   return val(Pop(c1));
+}
+
+// (* 'num ..) -> num
+any doMul(any ex) {
+   any x;
+   bool sign;
+   cell c1, c2;
+
+   x = cdr(ex);
+   if (isNil(data(c1) = EVAL(car(x))))
+      return Nil;
+   NeedNum(ex,data(c1));
+   Push(c1, bigCopy(data(c1)));
+   sign = isNeg(data(c1)),  pos(data(c1));
+   while (isCell(x = cdr(x))) {
+      Push(c2, EVAL(car(x)));
+      if (isNil(data(c2))) {
+         drop(c1);
+         return Nil;
+      }
+      NeedNum(ex,data(c2));
+      sign ^= isNeg(data(c2));
+      data(c1) = bigMul(data(c1),data(c2));
+      drop(c2);
+   }
+   if (sign && !IsZero(data(c1)))
+      neg(data(c1));
+   return Pop(c1);
+}
+
+// (*/ 'num1 ['num2 ..] 'num3) -> num
+any doMulDiv(any ex) {
+   any x;
+   bool sign;
+   cell c1, c2, c3;
+
+   x = cdr(ex);
+   if (isNil(data(c1) = EVAL(car(x))))
+      return Nil;
+   NeedNum(ex,data(c1));
+   Push(c1, bigCopy(data(c1)));
+   sign = isNeg(data(c1)),  pos(data(c1));
+   Push(c2, Nil);
+   for (;;) {
+      x = cdr(x),  data(c2) = EVAL(car(x));
+      if (isNil(data(c2))) {
+         drop(c1);
+         return Nil;
+      }
+      NeedNum(ex,data(c2));
+      sign ^= isNeg(data(c2));
+      if (!isCell(cdr(x)))
+         break;
+      data(c1) = bigMul(data(c1),data(c2));
+   }
+   if (IsZero(data(c2)))
+      divErr(ex);
+   Push(c3, bigCopy(data(c2)));
+   digDiv2(data(c3));
+   bigAdd(data(c1),data(c3));
+   data(c2) = bigCopy(data(c2));
+   data(c1) = bigDiv(data(c1),data(c2),NO);
+   if (sign && !IsZero(data(c1)))
+      neg(data(c1));
+   return Pop(c1);
+}
+
+// (/ 'num ..) -> num
+any doDiv(any ex) {
+   any x;
+   bool sign;
+   cell c1, c2;
+
+   x = cdr(ex);
+   if (isNil(data(c1) = EVAL(car(x))))
+      return Nil;
+   NeedNum(ex,data(c1));
+   Push(c1, bigCopy(data(c1)));
+   sign = isNeg(data(c1)),  pos(data(c1));
+   while (isCell(x = cdr(x))) {
+      Push(c2, EVAL(car(x)));
+      if (isNil(data(c2))) {
+         drop(c1);
+         return Nil;
+      }
+      NeedNum(ex,data(c2));
+      sign ^= isNeg(data(c2));
+      if (IsZero(data(c2)))
+         divErr(ex);
+      data(c2) = bigCopy(data(c2));
+      data(c1) = bigDiv(data(c1),data(c2),NO);
+      drop(c2);
+   }
+   if (sign && !IsZero(data(c1)))
+      neg(data(c1));
+   return Pop(c1);
+}
+
+// (% 'num ..) -> num
+any doRem(any ex) {
+   any x;
+   bool sign;
+   cell c1, c2;
+
+   x = cdr(ex);
+   if (isNil(data(c1) = EVAL(car(x))))
+      return Nil;
+   NeedNum(ex,data(c1));
+   Push(c1, bigCopy(data(c1)));
+   sign = isNeg(data(c1)),  pos(data(c1));
+   while (isCell(x = cdr(x))) {
+      Push(c2, EVAL(car(x)));
+      if (isNil(data(c2))) {
+         drop(c1);
+         return Nil;
+      }
+      NeedNum(ex,data(c2));
+      if (IsZero(data(c2)))
+         divErr(ex);
+      data(c2) = bigCopy(data(c2));
+      bigDiv(data(c1),data(c2),YES);
+      drop(c2);
+   }
+   if (sign && !IsZero(data(c1)))
+      neg(data(c1));
+   return Pop(c1);
+}
+
+// (>> 'cnt 'num) -> num
+any doShift(any ex) {
+   any x;
+   long n;
+   bool sign;
+   cell c1;
+
+   x = cdr(ex),  n = evCnt(ex,x);
+   x = cdr(x);
+   if (isNil(data(c1) = EVAL(car(x))))
+      return Nil;
+   NeedNum(ex,data(c1));
+   Push(c1, bigCopy(data(c1)));
+   sign = isNeg(data(c1));
+   if (n > 0) {
+      do
+         digDiv2(data(c1));
+      while (--n);
+      pos(data(c1));
+   }
+   else if (n < 0) {
+      pos(data(c1));
+      do
+         digMul2(data(c1));
+      while (++n);
+   }
+   if (sign && !IsZero(data(c1)))
+      neg(data(c1));
+   return Pop(c1);
+}
+
+// (lt0 'any) -> num | NIL
+any doLt0(any x) {
+   x = cdr(x);
+   return isNum(x = EVAL(car(x))) && isNeg(x)? x : Nil;
+}
+
+// (ge0 'any) -> num | NIL
+any doGe0(any x) {
+   x = cdr(x);
+   return isNum(x = EVAL(car(x))) && !isNeg(x)? x : Nil;
+}
+
+// (gt0 'any) -> num | NIL
+any doGt0(any x) {
+   x = cdr(x);
+   return isNum(x = EVAL(car(x))) && !isNeg(x) && !IsZero(x)? x : Nil;
+}
+
+// (abs 'num) -> num
+any doAbs(any ex) {
+   any x;
+
+   x = cdr(ex);
+   if (isNil(x = EVAL(car(x))))
+      return Nil;
+   NeedNum(ex,x);
+   if (!isNeg(x))
+      return x;
+   return consNum(unDig(x) & ~1, cdr(numCell(x)));
+}
+
+// (bit? 'num ..) -> num | NIL
+any doBitQ(any ex) {
+   any x, y, z;
+   cell c1;
+
+   x = cdr(ex),  Push(c1, EVAL(car(x)));
+   NeedNum(ex,data(c1));
+   while (isCell(x = cdr(x))) {
+      if (isNil(z = EVAL(car(x)))) {
+         drop(c1);
+         return Nil;
+      }
+      NeedNum(ex,z);
+      y = data(c1);
+      for (;;) {
+         if ((unDig(y) & unDig(z)) != unDig(y)) {
+            drop(c1);
+            return Nil;
+         }
+         if (!isNum(y = cdr(numCell(y))))
+            break;
+         if (!isNum(z = cdr(numCell(z)))) {
+            drop(c1);
+            return Nil;
+         }
+      }
+   }
+   return Pop(c1);
+}
+
+// (& 'num ..) -> num
+any doBitAnd(any ex) {
+   any x, y, z;
+   cell c1;
+
+   x = cdr(ex);
+   if (isNil(data(c1) = EVAL(car(x))))
+      return Nil;
+   NeedNum(ex,data(c1));
+   Push(c1, bigCopy(data(c1)));
+   while (isCell(x = cdr(x))) {
+      if (isNil(z = EVAL(car(x)))) {
+         drop(c1);
+         return Nil;
+      }
+      NeedNum(ex,z);
+      y = data(c1);
+      for (;;) {
+         setDig(y, unDig(y) & unDig(z));
+         if (!isNum(z = cdr(numCell(z)))) {
+            cdr(numCell(y)) = Nil;
+            break;
+         }
+         if (!isNum(y = cdr(numCell(y))))
+            break;
+      }
+   }
+   zapZero(data(c1));
+   return Pop(c1);
+}
+
+// (| 'num ..) -> num
+any doBitOr(any ex) {
+   any x, y;
+   cell c1, c2;
+
+   x = cdr(ex);
+   if (isNil(data(c1) = EVAL(car(x))))
+      return Nil;
+   NeedNum(ex,data(c1));
+   Push(c1, bigCopy(data(c1)));
+   while (isCell(x = cdr(x))) {
+      if (isNil(data(c2) = EVAL(car(x)))) {
+         drop(c1);
+         return Nil;
+      }
+      NeedNum(ex,data(c2));
+      y = data(c1);
+      Save(c2);
+      for (;;) {
+         setDig(y, unDig(y) | unDig(data(c2)));
+         if (!isNum(data(c2) = cdr(numCell(data(c2)))))
+            break;
+         if (!isNum(cdr(numCell(y))))
+            cdr(numCell(y)) = box(0);
+         y = cdr(numCell(y));
+      }
+      drop(c2);
+   }
+   return Pop(c1);
+}
+
+// (x| 'num ..) -> num
+any doBitXor(any ex) {
+   any x, y;
+   cell c1, c2;
+
+   x = cdr(ex);
+   if (isNil(data(c1) = EVAL(car(x))))
+      return Nil;
+   NeedNum(ex,data(c1));
+   Push(c1, bigCopy(data(c1)));
+   while (isCell(x = cdr(x))) {
+      if (isNil(data(c2) = EVAL(car(x)))) {
+         drop(c1);
+         return Nil;
+      }
+      NeedNum(ex,data(c2));
+      y = data(c1);
+      Save(c2);
+      for (;;) {
+         setDig(y, unDig(y) ^ unDig(data(c2)));
+         if (!isNum(data(c2) = cdr(numCell(data(c2)))))
+            break;
+         if (!isNum(cdr(numCell(y))))
+            cdr(numCell(y)) = box(0);
+         y = cdr(numCell(y));
+      }
+      drop(c2);
+   }
+   zapZero(data(c1));
+   return Pop(c1);
+}
+
+/* Random numbers */
+static u_int64_t Seed;
+
+static u_int64_t initSeed(any x) {
+   u_int64_t n;
+
+   for (n = 0; isCell(x); x = cdr(x))
+      n += initSeed(car(x));
+   if (!isNil(x)) {
+      if (isSym(x))
+         x = name(x);
+      do
+         n += unDig(x);
+      while (isNum(x = cdr(numCell(x))));
+   }
+   return n;
+}
+
+// (seed 'any) -> cnt
+any doSeed(any ex) {
+   return boxCnt(
+         hi(Seed = initSeed(EVAL(cadr(ex))) * 6364136223846793005LL + 1) );
+}
+
+// (rand ['cnt1 'cnt2] | ['T]) -> cnt | flg
+any doRand(any ex) {
+   any x;
+   long n;
+
+   x = cdr(ex);
+   Seed = Seed * 6364136223846793005LL + 1;
+   if (isNil(x = EVAL(car(x))))
+      return boxCnt(hi(Seed));
+   if (x == T)
+      return hi(Seed) & 1 ? T : Nil;
+   n = xCnt(ex,x);
+   return boxCnt(n + hi(Seed) % (evCnt(ex, cddr(ex)) + 1 - n));
+}
diff --git a/src/ext.c b/src/ext.c
@@ -0,0 +1,182 @@
+/* 21feb10abu
+ * (c) Software Lab. Alexander Burger
+ */
+
+#include "pico.h"
+
+/*** Soundex Algorithm ***/
+static int SnxTab[] = {
+   '0', '1', '2', '3', '4', '5', '6', '7',  // 48
+   '8', '9',   0,   0,   0,   0,   0,   0,
+     0,   0, 'F', 'S', 'T',   0, 'F', 'S',  // 64
+     0,   0, 'S', 'S', 'L', 'N', 'N',   0,
+   'F', 'S', 'R', 'S', 'T',   0, 'F', 'F',
+   'S',   0, 'S',   0,   0,   0,   0,   0,
+     0,   0, 'F', 'S', 'T',   0, 'F', 'S',  // 96
+     0,   0, 'S', 'S', 'L', 'N', 'N',   0,
+   'F', 'S', 'R', 'S', 'T',   0, 'F', 'F',
+   'S',   0, 'S',   0,   0,   0,   0,   0,
+     0,   0,   0,   0,   0,   0,   0,   0,  // 128
+     0,   0,   0,   0,   0,   0,   0,   0,
+     0,   0,   0,   0,   0,   0,   0,   0,
+     0,   0,   0,   0,   0,   0,   0,   0,
+     0,   0,   0,   0,   0,   0,   0,   0,  // 160
+     0,   0,   0,   0,   0,   0,   0,   0,
+     0,   0,   0,   0,   0,   0,   0,   0,
+     0,   0,   0,   0,   0,   0,   0,   0,
+     0,   0,   0,   0,   0,   0,   0, 'S',  // 192
+     0,   0,   0,   0,   0,   0,   0,   0,
+   'T', 'N',   0,   0,   0,   0,   0, 'S',
+     0,   0,   0,   0,   0,   0,   0, 'S',
+     0,   0,   0,   0,   0,   0,   0, 'S',  // 224
+     0,   0,   0,   0,   0,   0,   0,   0,
+     0, 'N'
+   // ...
+};
+
+#define SNXBASE   48
+#define SNXSIZE   ((int)(sizeof(SnxTab) / sizeof(int)))
+
+
+// (ext:Snx 'any ['cnt]) -> sym
+any Snx(any ex) {
+   int n, c, i, last;
+   any x, nm;
+   cell c1, c2;
+
+   x = cdr(ex);
+   if (!isSym(x = EVAL(car(x))) || !(c = symChar(name(x))))
+      return Nil;
+   while (c < SNXBASE)
+      if (!(c = symChar(NULL)))
+         return Nil;
+   Push(c1, x);
+   n = isCell(x = cddr(ex))? evCnt(ex,x) : 24;
+   if (c >= 'a' && c <= 'z' || c == 128 || c >= 224 && c < 255)
+      c &= ~0x20;
+   Push(c2, boxChar(last = c, &i, &nm));
+   while (c = symChar(NULL))
+      if (c > ' ') {
+         if ((c -= SNXBASE) < 0 || c >= SNXSIZE || !(c = SnxTab[c]))
+            last = 0;
+         else if (c != last) {
+            if (!--n)
+               break;
+            charSym(last = c, &i, &nm);
+         }
+      }
+   drop(c1);
+   return consStr(data(c2));
+}
+
+
+/*** Math ***/
+// (ext:Exp 'x 'scale) -> num
+any Exp(any ex) {
+   double x, n;
+
+   x = evDouble(ex, cdr(ex));
+   n = evDouble(ex, cddr(ex));
+   return doubleToNum(n * exp(x / n));
+}
+
+// (ext:Log 'x 'scale) -> num
+any Log(any ex) {
+   double x, n;
+
+   x = evDouble(ex, cdr(ex));
+   n = evDouble(ex, cddr(ex));
+   return doubleToNum(n * log(x / n));
+}
+
+// (ext:Sin 'angle 'scale) -> num
+any Sin(any ex) {
+   any x;
+   double a, n;
+
+   a = evDouble(ex, x = cdr(ex));
+   n = evDouble(ex, cdr(x));
+   return doubleToNum(n * sin(a / n));
+}
+
+// (ext:Cos 'angle 'scale) -> num
+any Cos(any ex) {
+   any x;
+   double a, n;
+
+   a = evDouble(ex, x = cdr(ex));
+   n = evDouble(ex, cdr(x));
+   return doubleToNum(n * cos(a / n));
+}
+
+// (ext:Tan 'angle 'scale) -> num
+any Tan(any ex) {
+   any x;
+   double a, n;
+
+   a = evDouble(ex, x = cdr(ex));
+   n = evDouble(ex, cdr(x));
+   return doubleToNum(n * tan(a / n));
+}
+
+// (ext:Atan 'x 'y 'scale) -> num
+any Atan(any ex) {
+   double x, y, n;
+
+   x = evDouble(ex, cdr(ex));
+   y = evDouble(ex, cddr(ex));
+   n = evDouble(ex, cdddr(ex));
+   return doubleToNum(n * atan2(x / n, y / n));
+}
+
+
+/*** U-Law Encoding ***/
+#define BIAS   132
+#define CLIP   (32767-BIAS)
+
+// (ext:Ulaw 'cnt) -> cnt  # SEEEMMMM
+any Ulaw(any ex) {
+   int val, sign, tmp, exp;
+
+   val = (int)evCnt(ex,cdr(ex));
+   sign = 0;
+   if (val < 0)
+      val = -val,  sign = 0x80;
+   if (val > CLIP)
+      val = CLIP;
+   tmp = (val += BIAS) << 1;
+   for (exp = 7;  exp > 0  &&  !(tmp & 0x8000);  --exp, tmp <<= 1);
+   return boxCnt(~(sign  |  exp<<4  |  val >> exp+3 & 0x000F) & 0xFF);
+}
+
+
+/*** Base64 Encoding ***/
+static unsigned char Chr64[] =
+   "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/";
+
+// (ext:Base64 'num1|NIL ['num2|NIL ['num3|NIL]]) -> flg
+any Base64(any x) {
+   int c, d;
+   any y;
+
+   x = cdr(x);
+   if (isNil(y = EVAL(car(x))))
+      return Nil;
+   c = unDig(y) / 2;
+   Env.put(Chr64[c >> 2]);
+   x = cdr(x);
+   if (isNil(y = EVAL(car(x)))) {
+      Env.put(Chr64[(c & 3) << 4]),  Env.put('='),  Env.put('=');
+      return Nil;
+   }
+   d = unDig(y) / 2;
+   Env.put(Chr64[(c & 3) << 4 | d >> 4]);
+   x = cdr(x);
+   if (isNil(y = EVAL(car(x)))) {
+      Env.put(Chr64[(d & 15) << 2]),  Env.put('=');
+      return Nil;
+   }
+   c = unDig(y) / 2;
+   Env.put(Chr64[(d & 15) << 2 | c >> 6]),  Env.put(Chr64[c & 63]);
+   return T;
+}
diff --git a/src/flow.c b/src/flow.c
@@ -0,0 +1,1688 @@
+/* 19apr10abu
+ * (c) Software Lab. Alexander Burger
+ */
+
+#include "pico.h"
+
+static void redefMsg(any x, any y) {
+   outFile *oSave = OutFile;
+   void (*putSave)(int) = Env.put;
+
+   OutFile = OutFiles[STDERR_FILENO],  Env.put = putStdout;
+   outString("# ");
+   print(x);
+   if (y)
+      space(), print(y);
+   outString(" redefined\n");
+   Env.put = putSave,  OutFile = oSave;
+}
+
+static void putSrc(any s, any k) {
+   if (!isNil(val(Dbg)) && !isExt(s) && InFile && InFile->name) {
+      any x, y;
+      cell c1;
+
+      Push(c1, boxCnt(InFile->src));
+      data(c1) = cons(data(c1), mkStr(InFile->name));
+      x = get(s, Dbg);
+      if (!k) {
+         if (isNil(x))
+            put(s, Dbg, cons(data(c1), Nil));
+         else
+            car(x) = data(c1);
+      }
+      else if (isNil(x))
+         put(s, Dbg, cons(Nil, cons(data(c1), Nil)));
+      else {
+         for (y = cdr(x); isCell(y); y = cdr(y))
+            if (caar(y) == k) {
+               cdar(y) = data(c1);
+               drop(c1);
+               return;
+            }
+         cdr(x) = cons(cons(k, data(c1)), cdr(x));
+      }
+      drop(c1);
+   }
+}
+
+static void redefine(any ex, any s, any x) {
+   NeedSym(ex,s);
+   CheckVar(ex,s);
+   if (!isNil(val(s))  &&  s != val(s)  &&  !equal(x,val(s)))
+      redefMsg(s, NULL);
+   val(s) = x;
+   putSrc(s, NULL);
+}
+
+// (quote . any) -> any
+any doQuote(any x) {return cdr(x);}
+
+// (as 'any1 . any2) -> any2 | NIL
+any doAs(any x) {
+   x = cdr(x);
+   if (isNil(EVAL(car(x))))
+      return Nil;
+   return cdr(x);
+}
+
+// (pid 'pid|lst . exe) -> any
+any doPid(any x) {
+   any y;
+
+   x = cdr(x);
+   if (!isCell(y = EVAL(car(x))))
+      return equal(y, val(Pid))? EVAL(cdr(x)) : Nil;
+   do
+      if (equal(car(y), val(Pid)))
+         return EVAL(cdr(x));
+   while (isCell(y = cdr(y)));
+   return Nil;
+}
+
+// (lit 'any) -> any
+any doLit(any x) {
+   x = cadr(x);
+   if (isNum(x = EVAL(x)) || isNil(x) || x == T || isCell(x) && isNum(car(x)))
+      return x;
+   return cons(Quote, x);
+}
+
+// (eval 'any ['cnt ['lst]]) -> any
+any doEval(any x) {
+   any y;
+   cell c1;
+   bindFrame *p;
+
+   x = cdr(x),  Push(c1, EVAL(car(x))),  x = cdr(x);
+   if (!isNum(y = EVAL(car(x))) || !(p = Env.bind))
+      data(c1) = EVAL(data(c1));
+   else {
+      int cnt, n, i, j;
+      struct {  // bindFrame
+         struct bindFrame *link;
+         int i, cnt;
+         struct {any sym; any val;} bnd[length(x)];
+      } f;
+
+      x = cdr(x),  x = EVAL(car(x));
+      j = cnt = (int)unBox(y);
+      n = f.i = f.cnt = 0;
+      do {
+         ++n;
+         if ((i = p->i) <= 0  &&  (p->i -= cnt, i == 0)) {
+            for (i = 0;  i < p->cnt;  ++i) {
+               y = val(p->bnd[i].sym);
+               val(p->bnd[i].sym) = p->bnd[i].val;
+               p->bnd[i].val = y;
+            }
+            if (p->cnt  &&  p->bnd[0].sym == At  &&  !--j)
+               break;
+         }
+      } while (p = p->link);
+      while (isCell(x)) {
+         for (p = Env.bind, j = n; ; p = p->link) {
+            if (p->i < 0)
+               for (i = 0;  i < p->cnt;  ++i) {
+                  if (p->bnd[i].sym == car(x)) {
+                     f.bnd[f.cnt].val = val(f.bnd[f.cnt].sym = car(x));
+                     val(car(x)) = p->bnd[i].val;
+                     ++f.cnt;
+                     goto next;
+                  }
+               }
+            if (!--j)
+               break;
+         }
+next:    x = cdr(x);
+      }
+      f.link = Env.bind,  Env.bind = (bindFrame*)&f;
+      data(c1) = EVAL(data(c1));
+      while (--f.cnt >= 0)
+         val(f.bnd[f.cnt].sym) = f.bnd[f.cnt].val;
+      Env.bind = f.link;
+      do {
+         for (p = Env.bind, i = n;  --i;  p = p->link);
+         if (p->i < 0  &&  (p->i += cnt) == 0)
+            for (i = p->cnt;  --i >= 0;) {
+               y = val(p->bnd[i].sym);
+               val(p->bnd[i].sym) = p->bnd[i].val;
+               p->bnd[i].val = y;
+            }
+      } while (--n);
+   }
+   return Pop(c1);
+}
+
+// (run 'any ['cnt ['lst]]) -> any
+any doRun(any x) {
+   any y;
+   cell c1;
+   bindFrame *p;
+
+   x = cdr(x),  data(c1) = EVAL(car(x)),  x = cdr(x);
+   if (!isNum(data(c1))) {
+      Save(c1);
+      if (!isNum(y = EVAL(car(x))) || !(p = Env.bind))
+         data(c1) = isSym(data(c1))? val(data(c1)) : run(data(c1));
+      else {
+         int cnt, n, i, j;
+         struct {  // bindFrame
+            struct bindFrame *link;
+            int i, cnt;
+            struct {any sym; any val;} bnd[length(x)];
+         } f;
+
+         x = cdr(x),  x = EVAL(car(x));
+         j = cnt = (int)unBox(y);
+         n = f.i = f.cnt = 0;
+         do {
+            ++n;
+            if ((i = p->i) <= 0  &&  (p->i -= cnt, i == 0)) {
+               for (i = 0;  i < p->cnt;  ++i) {
+                  y = val(p->bnd[i].sym);
+                  val(p->bnd[i].sym) = p->bnd[i].val;
+                  p->bnd[i].val = y;
+               }
+               if (p->cnt  &&  p->bnd[0].sym == At  &&  !--j)
+                  break;
+            }
+         } while (p = p->link);
+         while (isCell(x)) {
+            for (p = Env.bind, j = n; ; p = p->link) {
+               if (p->i < 0)
+                  for (i = 0;  i < p->cnt;  ++i) {
+                     if (p->bnd[i].sym == car(x)) {
+                        f.bnd[f.cnt].val = val(f.bnd[f.cnt].sym = car(x));
+                        val(car(x)) = p->bnd[i].val;
+                        ++f.cnt;
+                        goto next;
+                     }
+                  }
+               if (!--j)
+                  break;
+            }
+next:       x = cdr(x);
+         }
+         f.link = Env.bind,  Env.bind = (bindFrame*)&f;
+         data(c1) = isSym(data(c1))? val(data(c1)) : prog(data(c1));
+         while (--f.cnt >= 0)
+            val(f.bnd[f.cnt].sym) = f.bnd[f.cnt].val;
+         Env.bind = f.link;
+         do {
+            for (p = Env.bind, i = n;  --i;  p = p->link);
+            if (p->i < 0  &&  (p->i += cnt) == 0)
+               for (i = p->cnt;  --i >= 0;) {
+                  y = val(p->bnd[i].sym);
+                  val(p->bnd[i].sym) = p->bnd[i].val;
+                  p->bnd[i].val = y;
+               }
+         } while (--n);
+      }
+      drop(c1);
+   }
+   return data(c1);
+}
+
+// (def 'sym 'any) -> sym
+// (def 'sym 'sym 'any) -> sym
+any doDef(any ex) {
+   any x, y;
+   cell c1, c2, c3;
+
+   x = cdr(ex),  Push(c1, EVAL(car(x)));
+   NeedSym(ex,data(c1));
+   CheckVar(ex,data(c1));
+   Touch(ex,data(c1));
+   x = cdr(x),  Push(c2, EVAL(car(x)));
+   if (!isCell(cdr(x))) {
+      if (!isNil(y = val(data(c1)))  &&  y != data(c1)  &&  !equal(data(c2), y))
+         redefMsg(data(c1), NULL);
+      val(data(c1)) = data(c2);
+      putSrc(data(c1), NULL);
+   }
+   else {
+      x = cdr(x),  Push(c3, EVAL(car(x)));
+      if (!isNil(y = get(data(c1), data(c2)))  &&  !equal(data(c3), y))
+         redefMsg(data(c1), data(c2));
+      put(data(c1), data(c2), data(c3));
+      putSrc(data(c1), data(c2));
+   }
+   return Pop(c1);
+}
+
+// (de sym . any) -> sym
+any doDe(any ex) {
+   redefine(ex, cadr(ex), cddr(ex));
+   return cadr(ex);
+}
+
+// (dm sym . fun|cls2) -> sym
+// (dm (sym . cls) . fun|cls2) -> sym
+// (dm (sym sym2 [. cls]) . fun|cls2) -> sym
+any doDm(any ex) {
+   any x, y, msg, cls;
+
+   x = cdr(ex);
+   if (!isCell(car(x)))
+      msg = car(x),  cls = val(Class);
+   else {
+      msg = caar(x);
+      cls = !isCell(cdar(x))? cdar(x) :
+         get(isNil(cddar(x))? val(Class) : cddar(x), cadar(x));
+   }
+   if (msg != T)
+      redefine(ex, msg, val(Meth));
+   if (isSym(cdr(x))) {
+      y = val(cdr(x));
+      for (;;) {
+         if (!isCell(y) || !isCell(car(y)))
+            err(ex, msg, "Bad message");
+         if (caar(y) == msg) {
+            x = car(y);
+            break;
+         }
+         y = cdr(y);
+      }
+   }
+   for (y = val(cls);  isCell(y) && isCell(car(y));  y = cdr(y))
+      if (caar(y) == msg) {
+         if (!equal(cdr(x), cdar(y)))
+            redefMsg(msg, cls);
+         cdar(y) = cdr(x);
+         putSrc(cls, msg);
+         return msg;
+      }
+   if (!isCell(car(x)))
+      val(cls) = cons(x, val(cls));
+   else
+      val(cls) = cons(cons(msg, cdr(x)), val(cls));
+   putSrc(cls, msg);
+   return msg;
+}
+
+/* Evaluate method invocation */
+static any evMethod(any o, any expr, any x) {
+   any y = car(expr);
+   methFrame m;
+   struct {  // bindFrame
+      struct bindFrame *link;
+      int i, cnt;
+      struct {any sym; any val;} bnd[length(y)+3];
+   } f;
+
+   m.link = Env.meth;
+   m.key = TheKey;
+   m.cls = TheCls;
+   f.link = Env.bind,  Env.bind = (bindFrame*)&f;
+   f.i = sizeof(f.bnd) / (2*sizeof(any)) - 2;
+   f.cnt = 1,  f.bnd[0].sym = At,  f.bnd[0].val = val(At);
+   while (isCell(y)) {
+      f.bnd[f.cnt].sym = car(y);
+      f.bnd[f.cnt].val = EVAL(car(x));
+      ++f.cnt, x = cdr(x), y = cdr(y);
+   }
+   if (isNil(y)) {
+      while (--f.i > 0) {
+         x = val(f.bnd[f.i].sym);
+         val(f.bnd[f.i].sym) = f.bnd[f.i].val;
+         f.bnd[f.i].val = x;
+      }
+      f.bnd[f.cnt].sym = This,  f.bnd[f.cnt++].val = val(This),  val(This) = o;
+      Env.meth = &m;
+      x = prog(cdr(expr));
+   }
+   else if (y != At) {
+      f.bnd[f.cnt].sym = y,  f.bnd[f.cnt++].val = val(y),  val(y) = x;
+      while (--f.i > 0) {
+         x = val(f.bnd[f.i].sym);
+         val(f.bnd[f.i].sym) = f.bnd[f.i].val;
+         f.bnd[f.i].val = x;
+      }
+      f.bnd[f.cnt].sym = This,  f.bnd[f.cnt++].val = val(This),  val(This) = o;
+      Env.meth = &m;
+      x = prog(cdr(expr));
+   }
+   else {
+      int n, cnt;
+      cell *arg;
+      cell c[n = cnt = length(x)];
+
+      while (--n >= 0)
+         Push(c[n], EVAL(car(x))),  x = cdr(x);
+      while (--f.i > 0) {
+         x = val(f.bnd[f.i].sym);
+         val(f.bnd[f.i].sym) = f.bnd[f.i].val;
+         f.bnd[f.i].val = x;
+      }
+      n = Env.next,  Env.next = cnt;
+      arg = Env.arg,  Env.arg = c;
+      f.bnd[f.cnt].sym = This,  f.bnd[f.cnt++].val = val(This),  val(This) = o;
+      Env.meth = &m;
+      x = prog(cdr(expr));
+      if (cnt)
+         drop(c[cnt-1]);
+      Env.arg = arg,  Env.next = n;
+   }
+   while (--f.cnt >= 0)
+      val(f.bnd[f.cnt].sym) = f.bnd[f.cnt].val;
+   Env.bind = f.link;
+   Env.meth = Env.meth->link;
+   return x;
+}
+
+any method(any x) {
+   any y, z;
+
+   if (isCell(y = val(x))) {
+      while (isCell(z = car(y))) {
+         if (car(z) == TheKey)
+            return cdr(z);
+         if (!isCell(y = cdr(y)))
+            return NULL;
+      }
+      do
+         if (x = method(car(TheCls = y)))
+            return x;
+      while (isCell(y = cdr(y)));
+   }
+   return NULL;
+}
+
+// (box 'any) -> sym
+any doBox(any x) {
+   x = cdr(x);
+   return consSym(EVAL(car(x)), Nil);
+}
+
+// (new ['flg|num] ['typ ['any ..]]) -> obj
+any doNew(any ex) {
+   any x, y, *h;
+   cell c1, c2;
+
+   x = cdr(ex);
+   if (isCell(y = EVAL(car(x))))
+      Push(c1, consSym(Nil,Nil));
+   else {
+      if (isNil(y))
+         data(c1) = consSym(Nil,Nil);
+      else {
+         y = newId(ex, isNum(y)? (int)unDig(y)/2 : 1);
+         if (data(c1) = findHash(y, h = Extern + ehash(y)))
+            tail(data(c1)) = y;
+         else
+            *h = cons(data(c1) = consSym(Nil,y), *h);
+         mkExt(data(c1));
+      }
+      Save(c1);
+      x = cdr(x),  y = EVAL(car(x));
+   }
+   val(data(c1)) = y;
+   TheKey = T,  TheCls = Nil;
+   if (y = method(data(c1)))
+      evMethod(data(c1), y, cdr(x));
+   else {
+      Push(c2, Nil);
+      while (isCell(x = cdr(x))) {
+         data(c2) = EVAL(car(x)),  x = cdr(x);
+         put(data(c1), data(c2), EVAL(car(x)));
+      }
+   }
+   return Pop(c1);
+}
+
+// (type 'any) -> lst
+any doType(any ex) {
+   any x, y, z;
+
+   x = cdr(ex),  x = EVAL(car(x));
+   if (isSym(x)) {
+      Fetch(ex,x);
+      z = x = val(x);
+      while (isCell(x)) {
+         if (!isCell(car(x))) {
+            y = x;
+            while (isSym(car(x))) {
+               if (!isCell(x = cdr(x)))
+                  return isNil(x)? y : Nil;
+               if (z == x)
+                  return Nil;
+            }
+            return Nil;
+         }
+         if (z == (x = cdr(x)))
+            return Nil;
+      }
+   }
+   return Nil;
+}
+
+static bool isa(any cls, any x) {
+   any z;
+
+   z = x = val(x);
+   while (isCell(x)) {
+      if (!isCell(car(x))) {
+         while (isSym(car(x))) {
+            if (isExt(car(x)))
+               return NO;
+            if (cls == car(x) || isa(cls, car(x)))
+               return YES;
+            if (!isCell(x = cdr(x)) || z == x)
+               return NO;
+         }
+         return NO;
+      }
+      if (z == (x = cdr(x)))
+         return NO;
+   }
+   return NO;
+}
+
+// (isa 'cls|typ 'any) -> obj | NIL
+any doIsa(any ex) {
+   any x;
+   cell c1;
+
+   x = cdr(ex),  Push(c1, EVAL(car(x)));
+   x = cdr(x),  x = EVAL(car(x));
+   if (isSym(x)) {
+      Fetch(ex,x);
+      drop(c1);
+      if (isSym(data(c1)))
+         return isa(data(c1), x)? x : Nil;
+      while (isCell(data(c1))) {
+         if (!isa(car(data(c1)), x))
+            return Nil;
+         data(c1) = cdr(data(c1));
+      }
+      return x;
+   }
+   drop(c1);
+   return Nil;
+}
+
+// (method 'msg 'obj) -> fun
+any doMethod(any ex) {
+   any x;
+   cell c1;
+
+   x = cdr(ex),  Push(c1,  EVAL(car(x)));
+   NeedSym(ex,data(c1));
+   x = cdr(x),  x = EVAL(car(x));
+   NeedSym(ex,x);
+   Fetch(ex,x);
+   TheKey = Pop(c1);
+   return method(x)? : Nil;
+}
+
+// (meth 'obj ..) -> any
+any doMeth(any ex) {
+   any x, y;
+   cell c1;
+
+   x = cdr(ex),  Push(c1, EVAL(car(x)));
+   NeedSym(ex,data(c1));
+   Fetch(ex,data(c1));
+   for (TheKey = car(ex); ; TheKey = val(TheKey)) {
+      if (!isSym(TheKey))
+         err(ex, TheKey, "Bad message");
+      if (isNum(val(TheKey))) {
+         TheCls = Nil;
+         if (y = method(data(c1))) {
+            x = evMethod(data(c1), y, cdr(x));
+            drop(c1);
+            return x;
+         }
+         err(ex, TheKey, "Bad message");
+      }
+   }
+}
+
+// (send 'msg 'obj ['any ..]) -> any
+any doSend(any ex) {
+   any x, y;
+   cell c1, c2;
+
+   x = cdr(ex),  Push(c1,  EVAL(car(x)));
+   NeedSym(ex,data(c1));
+   x = cdr(x),  Push(c2,  EVAL(car(x)));
+   NeedSym(ex,data(c2));
+   Fetch(ex,data(c2));
+   TheKey = data(c1),  TheCls = Nil;
+   if (y = method(data(c2))) {
+      x = evMethod(data(c2), y, cdr(x));
+      drop(c1);
+      return x;
+   }
+   err(ex, TheKey, "Bad message");
+}
+
+// (try 'msg 'obj ['any ..]) -> any
+any doTry(any ex) {
+   any x, y;
+   cell c1, c2;
+
+   x = cdr(ex),  Push(c1,  EVAL(car(x)));
+   NeedSym(ex,data(c1));
+   x = cdr(x),  Push(c2,  EVAL(car(x)));
+   if (isSym(data(c2))) {
+      if (isExt(data(c2))) {
+         if (!isLife(data(c2)))
+            return Nil;
+         db(ex,data(c2),1);
+      }
+      TheKey = data(c1),  TheCls = Nil;
+      if (y = method(data(c2))) {
+         x = evMethod(data(c2), y, cdr(x));
+         drop(c1);
+         return x;
+      }
+   }
+   drop(c1);
+   return Nil;
+}
+
+// (super ['any ..]) -> any
+any doSuper(any ex) {
+   any x, y;
+   methFrame m;
+
+   m.key = TheKey = Env.meth->key;
+   x = val(isNil(Env.meth->cls)? val(This) : car(Env.meth->cls));
+   while (isCell(car(x)))
+      x = cdr(x);
+   while (isCell(x)) {
+      if (y = method(car(TheCls = x))) {
+         m.cls = TheCls;
+         m.link = Env.meth,  Env.meth = &m;
+         x = evExpr(y, cdr(ex));
+         Env.meth = Env.meth->link;
+         return x;
+      }
+      x = cdr(x);
+   }
+   err(ex, TheKey, "Bad super");
+}
+
+static any extra(any x) {
+   any y;
+
+   for (x = val(x); isCell(car(x)); x = cdr(x));
+   while (isCell(x)) {
+      if (x == Env.meth->cls  ||  !(y = extra(car(x)))) {
+         while (isCell(x = cdr(x)))
+            if (y = method(car(TheCls = x)))
+               return y;
+         return NULL;
+      }
+      if (y  &&  num(y) != 1)
+         return y;
+      x = cdr(x);
+   }
+   return (any)1;
+}
+
+// (extra ['any ..]) -> any
+any doExtra(any ex) {
+   any x, y;
+   methFrame m;
+
+   m.key = TheKey = Env.meth->key;
+   if ((y = extra(val(This)))  &&  num(y) != 1) {
+      m.cls = TheCls;
+      m.link = Env.meth,  Env.meth = &m;
+      x = evExpr(y, cdr(ex));
+      Env.meth = Env.meth->link;
+      return x;
+   }
+   err(ex, TheKey, "Bad extra");
+}
+
+// (with 'sym . prg) -> any
+any doWith(any ex) {
+   any x;
+   bindFrame f;
+
+   x = cdr(ex);
+   if (isNil(x = EVAL(car(x))))
+      return Nil;
+   NeedSym(ex,x);
+   Bind(This,f),  val(This) = x;
+   x = prog(cddr(ex));
+   Unbind(f);
+   return x;
+}
+
+// (bind 'sym|lst . prg) -> any
+any doBind(any ex) {
+   any x, y;
+
+   x = cdr(ex);
+   if (isNum(y = EVAL(car(x))))
+      argError(ex, y);
+   if (isNil(y))
+      return prog(cdr(x));
+   if (isSym(y)) {
+      bindFrame f;
+
+      Bind(y,f);
+      x = prog(cdr(x));
+      Unbind(f);
+      return x;
+   }
+   {
+      struct {  // bindFrame
+         struct bindFrame *link;
+         int i, cnt;
+         struct {any sym; any val;} bnd[length(y)];
+      } f;
+
+      f.link = Env.bind,  Env.bind = (bindFrame*)&f;
+      f.i = f.cnt = 0;
+      do {
+         if (isNum(car(y)))
+            argError(ex, car(y));
+         if (isSym(car(y))) {
+            f.bnd[f.cnt].sym = car(y);
+            f.bnd[f.cnt].val = val(car(y));
+         }
+         else {
+            f.bnd[f.cnt].sym = caar(y);
+            f.bnd[f.cnt].val = val(caar(y));
+            val(caar(y)) = cdar(y);
+         }
+         ++f.cnt;
+      } while (isCell(y = cdr(y)));
+      x = prog(cdr(x));
+      while (--f.cnt >= 0)
+         val(f.bnd[f.cnt].sym) = f.bnd[f.cnt].val;
+      Env.bind = f.link;
+      return x;
+   }
+}
+
+// (job 'lst . prg) -> any
+any doJob(any ex) {
+   any x = cdr(ex);
+   any y = EVAL(car(x));
+   any z;
+   cell c1;
+   struct {  // bindFrame
+      struct bindFrame *link;
+      int i, cnt;
+      struct {any sym; any val;} bnd[length(y)];
+   } f;
+
+   Push(c1,y);
+   f.link = Env.bind,  Env.bind = (bindFrame*)&f;
+   f.i = f.cnt = 0;
+   while (isCell(y)) {
+      f.bnd[f.cnt].sym = caar(y);
+      f.bnd[f.cnt].val = val(caar(y));
+      val(caar(y)) = cdar(y);
+      ++f.cnt,  y = cdr(y);
+   }
+   z = prog(cdr(x));
+   for (f.cnt = 0, y = Pop(c1);  isCell(y);  ++f.cnt, y = cdr(y)) {
+      cdar(y) = val(caar(y));
+      val(caar(y)) = f.bnd[f.cnt].val;
+   }
+   Env.bind = f.link;
+   return z;
+}
+
+// (let sym 'any . prg) -> any
+// (let (sym 'any ..) . prg) -> any
+any doLet(any x) {
+   any y;
+
+   x = cdr(x);
+   if (isSym(y = car(x))) {
+      bindFrame f;
+
+      x = cdr(x),  Bind(y,f),  val(y) = EVAL(car(x));
+      x = prog(cdr(x));
+      Unbind(f);
+   }
+   else {
+      struct {  // bindFrame
+         struct bindFrame *link;
+         int i, cnt;
+         struct {any sym; any val;} bnd[(length(y)+1)/2];
+      } f;
+
+      f.link = Env.bind,  Env.bind = (bindFrame*)&f;
+      f.i = f.cnt = 0;
+      do {
+         f.bnd[f.cnt].sym = car(y);
+         f.bnd[f.cnt].val = val(car(y));
+         ++f.cnt;
+         val(car(y)) = EVAL(cadr(y));
+      } while (isCell(y = cddr(y)));
+      x = prog(cdr(x));
+      while (--f.cnt >= 0)
+         val(f.bnd[f.cnt].sym) = f.bnd[f.cnt].val;
+      Env.bind = f.link;
+   }
+   return x;
+}
+
+// (let? sym 'any . prg) -> any
+any doLetQ(any x) {
+   any y, z;
+   bindFrame f;
+
+   x = cdr(x),  y = car(x),  x = cdr(x);
+   if (isNil(z = EVAL(car(x))))
+      return Nil;
+   Bind(y,f),  val(y) = z;
+   x = prog(cdr(x));
+   Unbind(f);
+   return x;
+}
+
+// (use sym . prg) -> any
+// (use (sym ..) . prg) -> any
+any doUse(any x) {
+   any y;
+
+   x = cdr(x);
+   if (isSym(y = car(x))) {
+      bindFrame f;
+
+      Bind(y,f);
+      x = prog(cdr(x));
+      Unbind(f);
+   }
+   else {
+      struct {  // bindFrame
+         struct bindFrame *link;
+         int i, cnt;
+         struct {any sym; any val;} bnd[length(y)];
+      } f;
+
+      f.link = Env.bind,  Env.bind = (bindFrame*)&f;
+      f.i = f.cnt = 0;
+      do {
+         f.bnd[f.cnt].sym = car(y);
+         f.bnd[f.cnt].val = val(car(y));
+         ++f.cnt;
+      } while (isCell(y = cdr(y)));
+      x = prog(cdr(x));
+      while (--f.cnt >= 0)
+         val(f.bnd[f.cnt].sym) = f.bnd[f.cnt].val;
+      Env.bind = f.link;
+   }
+   return x;
+}
+
+// (and 'any ..) -> any
+any doAnd(any x) {
+   any a;
+
+   x = cdr(x);
+   do {
+      if (isNil(a = EVAL(car(x))))
+         return Nil;
+      val(At) = a;
+   }
+   while (isCell(x = cdr(x)));
+   return a;
+}
+
+// (or 'any ..) -> any
+any doOr(any x) {
+   any a;
+
+   x = cdr(x);
+   do
+      if (!isNil(a = EVAL(car(x))))
+         return val(At) = a;
+   while (isCell(x = cdr(x)));
+   return Nil;
+}
+
+// (nand 'any ..) -> flg
+any doNand(any x) {
+   any a;
+
+   x = cdr(x);
+   do {
+      if (isNil(a = EVAL(car(x))))
+         return T;
+      val(At) = a;
+   }
+   while (isCell(x = cdr(x)));
+   return Nil;
+}
+
+// (nor 'any ..) -> flg
+any doNor(any x) {
+   any a;
+
+   x = cdr(x);
+   do {
+      if (!isNil(a = EVAL(car(x)))) {
+         val(At) = a;
+         return Nil;
+      }
+   } while (isCell(x = cdr(x)));
+   return T;
+}
+
+// (xor 'any 'any) -> flg
+any doXor(any x) {
+   bool f;
+
+   x = cdr(x),  f = isNil(EVAL(car(x))),  x = cdr(x);
+   return  f ^ isNil(EVAL(car(x)))?  T : Nil;
+}
+
+// (bool 'any) -> flg
+any doBool(any x) {return isNil(EVAL(cadr(x)))? Nil : T;}
+
+// (not 'any) -> flg
+any doNot(any x) {
+   any a;
+
+   if (isNil(a = EVAL(cadr(x))))
+      return T;
+   val(At) = a;
+   return Nil;
+}
+
+// (nil . prg) -> NIL
+any doNil(any x) {
+   while (isCell(x = cdr(x)))
+      if (isCell(car(x)))
+         evList(car(x));
+   return Nil;
+}
+
+// (t . prg) -> T
+any doT(any x) {
+   while (isCell(x = cdr(x)))
+      if (isCell(car(x)))
+         evList(car(x));
+   return T;
+}
+
+// (prog . prg) -> any
+any doProg(any x) {return prog(cdr(x));}
+
+// (prog1 'any1 . prg) -> any1
+any doProg1(any x) {
+   cell c1;
+
+   x = cdr(x),  Push(c1, val(At) = EVAL(car(x)));
+   while (isCell(x = cdr(x)))
+      if (isCell(car(x)))
+         evList(car(x));
+   return Pop(c1);
+}
+
+// (prog2 'any1 'any2 . prg) -> any2
+any doProg2(any x) {
+   cell c1;
+
+   x = cdr(x),  EVAL(car(x));
+   x = cdr(x),  Push(c1, val(At) = EVAL(car(x)));
+   while (isCell(x = cdr(x)))
+      if (isCell(car(x)))
+         evList(car(x));
+   return Pop(c1);
+}
+
+// (if 'any1 'any2 . prg) -> any
+any doIf(any x) {
+   any a;
+
+   x = cdr(x);
+   if (isNil(a = EVAL(car(x))))
+      return prog(cddr(x));
+   val(At) = a;
+   x = cdr(x);
+   return EVAL(car(x));
+}
+
+// (if2 'any1 'any2 'any3 'any4 'any5 . prg) -> any
+any doIf2(any x) {
+   any a;
+
+   x = cdr(x);
+   if (isNil(a = EVAL(car(x)))) {
+      x = cdr(x);
+      if (isNil(a = EVAL(car(x))))
+         return prog(cddddr(x));
+      val(At) = a;
+      x = cdddr(x);
+      return EVAL(car(x));
+   }
+   val(At) = a;
+   x = cdr(x);
+   if (isNil(a = EVAL(car(x)))) {
+      x = cddr(x);
+      return EVAL(car(x));
+   }
+   val(At) = a;
+   x = cdr(x);
+   return EVAL(car(x));
+}
+
+// (ifn 'any1 'any2 . prg) -> any
+any doIfn(any x) {
+   any a;
+
+   x = cdr(x);
+   if (!isNil(a = EVAL(car(x)))) {
+      val(At) = a;
+      return prog(cddr(x));
+   }
+   x = cdr(x);
+   return EVAL(car(x));
+}
+
+// (when 'any . prg) -> any
+any doWhen(any x) {
+   any a;
+
+   x = cdr(x);
+   if (isNil(a = EVAL(car(x))))
+      return Nil;
+   val(At) = a;
+   return prog(cdr(x));
+}
+
+// (unless 'any . prg) -> any
+any doUnless(any x) {
+   any a;
+
+   x = cdr(x);
+   if (!isNil(a = EVAL(car(x)))) {
+      val(At) = a;
+      return Nil;
+   }
+   return prog(cdr(x));
+}
+
+// (cond ('any1 . prg1) ('any2 . prg2) ..) -> any
+any doCond(any x) {
+   any a;
+
+   while (isCell(x = cdr(x))) {
+      if (!isNil(a = EVAL(caar(x)))) {
+         val(At) = a;
+         return prog(cdar(x));
+      }
+   }
+   return Nil;
+}
+
+// (nond ('any1 . prg1) ('any2 . prg2) ..) -> any
+any doNond(any x) {
+   any a;
+
+   while (isCell(x = cdr(x))) {
+      if (isNil(a = EVAL(caar(x))))
+         return prog(cdar(x));
+      val(At) = a;
+   }
+   return Nil;
+}
+
+// (case 'any (any1 . prg1) (any2 . prg2) ..) -> any
+any doCase(any x) {
+   any y, z;
+
+   x = cdr(x),  val(At) = EVAL(car(x));
+   while (isCell(x = cdr(x))) {
+      y = car(x),  z = car(y);
+      if (z == T  ||  equal(val(At), z))
+         return prog(cdr(y));
+      if (isCell(z)) {
+         do
+            if (equal(val(At), car(z)))
+               return prog(cdr(y));
+         while (isCell(z = cdr(z)));
+      }
+   }
+   return Nil;
+}
+
+// (state 'var (sym|lst exe [. prg]) ..) -> any
+any doState(any ex) {
+   any x, y, a;
+   cell c1;
+
+   x = cdr(ex);
+   Push(c1, EVAL(car(x)));
+   NeedVar(ex,data(c1));
+   CheckVar(ex,data(c1));
+   while (isCell(x = cdr(x))) {
+      y = car(x);
+      if (car(y) == T || memq(val(data(c1)), car(y))) {
+         y = cdr(y);
+         if (!isNil(a = EVAL(car(y)))) {
+            val(At) = val(data(c1)) = a;
+            drop(c1);
+            return prog(cdr(y));
+         }
+      }
+   }
+   drop(c1);
+   return Nil;
+}
+
+// (while 'any . prg) -> any
+any doWhile(any x) {
+   any cond, a;
+   cell c1;
+
+   cond = car(x = cdr(x)),  x = cdr(x);
+   Push(c1, Nil);
+   while (!isNil(a = EVAL(cond))) {
+      val(At) = a;
+      data(c1) = prog(x);
+   }
+   return Pop(c1);
+}
+
+// (until 'any . prg) -> any
+any doUntil(any x) {
+   any cond, a;
+   cell c1;
+
+   cond = car(x = cdr(x)),  x = cdr(x);
+   Push(c1, Nil);
+   while (isNil(a = EVAL(cond)))
+      data(c1) = prog(x);
+   val(At) = a;
+   return Pop(c1);
+}
+
+// (loop ['any | (NIL 'any . prg) | (T 'any . prg) ..]) -> any
+any doLoop(any ex) {
+   any x, y, a;
+
+   for (;;) {
+      x = cdr(ex);
+      do {
+         if (isCell(y = car(x))) {
+            if (isNil(car(y))) {
+               y = cdr(y);
+               if (isNil(a = EVAL(car(y))))
+                  return prog(cdr(y));
+               val(At) = a;
+            }
+            else if (car(y) == T) {
+               y = cdr(y);
+               if (!isNil(a = EVAL(car(y)))) {
+                  val(At) = a;
+                  return prog(cdr(y));
+               }
+            }
+            else
+               evList(y);
+         }
+      } while (isCell(x = cdr(x)));
+   }
+}
+
+// (do 'flg|num ['any | (NIL 'any . prg) | (T 'any . prg) ..]) -> any
+any doDo(any x) {
+   any y, z, a;
+   cell c1;
+
+   x = cdr(x);
+   if (isNil(data(c1) = EVAL(car(x))))
+      return Nil;
+   Save(c1);
+   if (isNum(data(c1))) {
+      if (isNeg(data(c1))) {
+         drop(c1);
+         return Nil;
+      }
+      data(c1) = bigCopy(data(c1));
+   }
+   x = cdr(x),  z = Nil;
+   for (;;) {
+      if (isNum(data(c1))) {
+         if (IsZero(data(c1))) {
+            drop(c1);
+            return z;
+         }
+         digSub1(data(c1));
+      }
+      y = x;
+      do {
+         if (!isNum(z = car(y))) {
+            if (isSym(z))
+               z = val(z);
+            else if (isNil(car(z))) {
+               z = cdr(z);
+               if (isNil(a = EVAL(car(z)))) {
+                  drop(c1);
+                  return prog(cdr(z));
+               }
+               val(At) = a;
+               z = Nil;
+            }
+            else if (car(z) == T) {
+               z = cdr(z);
+               if (!isNil(a = EVAL(car(z)))) {
+                  val(At) = a;
+                  drop(c1);
+                  return prog(cdr(z));
+               }
+               z = Nil;
+            }
+            else
+               z = evList(z);
+         }
+      } while (isCell(y = cdr(y)));
+   }
+}
+
+// (at '(cnt1 . cnt2) . prg) -> any
+any doAt(any ex) {
+   any x;
+
+   x = cdr(ex),  x = EVAL(car(x));
+   NeedCell(ex,x);
+   NeedCnt(ex,car(x));
+   NeedCnt(ex,cdr(x));
+   if (num(setDig(car(x), unDig(car(x))+2)) < unDig(cdr(x)))
+      return Nil;
+   setDig(car(x), 0);
+   return prog(cddr(ex));
+}
+
+// (for sym 'num ['any | (NIL 'any . prg) | (T 'any . prg) ..]) -> any
+// (for sym|(sym2 . sym) 'lst ['any | (NIL 'any . prg) | (T 'any . prg) ..]) -> any
+// (for (sym|(sym2 . sym) 'any1 'any2 [. prg]) ['any | (NIL 'any . prg) | (T 'any . prg) ..]) -> any
+any doFor(any x) {
+   any y, body, cond, a;
+   cell c1;
+   struct {  // bindFrame
+      struct bindFrame *link;
+      int i, cnt;
+      struct {any sym; any val;} bnd[2];
+   } f;
+
+   f.link = Env.bind,  Env.bind = (bindFrame*)&f;
+   f.i = 0;
+   if (!isCell(y = car(x = cdr(x))) || !isCell(cdr(y))) {
+      if (!isCell(y)) {
+         f.cnt = 1;
+         f.bnd[0].sym = y;
+         f.bnd[0].val = val(y);
+      }
+      else {
+         f.cnt = 2;
+         f.bnd[0].sym = cdr(y);
+         f.bnd[0].val = val(cdr(y));
+         f.bnd[1].sym = car(y);
+         f.bnd[1].val = val(car(y));
+         val(f.bnd[1].sym) = Zero;
+      }
+      y = Nil;
+      x = cdr(x),  Push(c1, EVAL(car(x)));
+      if (isNum(data(c1)))
+         val(f.bnd[0].sym) = Zero;
+      body = x = cdr(x);
+      for (;;) {
+         if (isNum(data(c1))) {
+            val(f.bnd[0].sym) = bigCopy(val(f.bnd[0].sym));
+            digAdd(val(f.bnd[0].sym), 2);
+            if (bigCompare(val(f.bnd[0].sym), data(c1)) > 0)
+               break;
+         }
+         else {
+            if (!isCell(data(c1)))
+               break;
+            val(f.bnd[0].sym) = car(data(c1));
+            if (!isCell(data(c1) = cdr(data(c1))))
+               data(c1) = Nil;
+         }
+         if (f.cnt == 2) {
+            val(f.bnd[1].sym) = bigCopy(val(f.bnd[1].sym));
+            digAdd(val(f.bnd[1].sym), 2);
+         }
+         do {
+            if (!isNum(y = car(x))) {
+               if (isSym(y))
+                  y = val(y);
+               else if (isNil(car(y))) {
+                  y = cdr(y);
+                  if (isNil(a = EVAL(car(y)))) {
+                     y = prog(cdr(y));
+                     goto for1;
+                  }
+                  val(At) = a;
+                  y = Nil;
+               }
+               else if (car(y) == T) {
+                  y = cdr(y);
+                  if (!isNil(a = EVAL(car(y)))) {
+                     val(At) = a;
+                     y = prog(cdr(y));
+                     goto for1;
+                  }
+                  y = Nil;
+               }
+               else
+                  y = evList(y);
+            }
+         } while (isCell(x = cdr(x)));
+         x = body;
+      }
+   for1:
+      drop(c1);
+      if (f.cnt == 2)
+         val(f.bnd[1].sym) = f.bnd[1].val;
+      val(f.bnd[0].sym) = f.bnd[0].val;
+      Env.bind = f.link;
+      return y;
+   }
+   if (!isCell(car(y))) {
+      f.cnt = 1;
+      f.bnd[0].sym = car(y);
+      f.bnd[0].val = val(car(y));
+   }
+   else {
+      f.cnt = 2;
+      f.bnd[0].sym = cdar(y);
+      f.bnd[0].val = val(cdar(y));
+      f.bnd[1].sym = caar(y);
+      f.bnd[1].val = val(caar(y));
+      val(f.bnd[1].sym) = Zero;
+   }
+   y = cdr(y);
+   val(f.bnd[0].sym) = EVAL(car(y));
+   y = cdr(y),  cond = car(y),  y = cdr(y);
+   Push(c1,Nil);
+   body = x = cdr(x);
+   while (!isNil(a = EVAL(cond))) {
+      val(At) = a;
+      if (f.cnt == 2) {
+         val(f.bnd[1].sym) = bigCopy(val(f.bnd[1].sym));
+         digAdd(val(f.bnd[1].sym), 2);
+      }
+      do {
+         if (!isNum(data(c1) = car(x))) {
+            if (isSym(data(c1)))
+               data(c1) = val(data(c1));
+            else if (isNil(car(data(c1)))) {
+               data(c1) = cdr(data(c1));
+               if (isNil(a = EVAL(car(data(c1))))) {
+                  data(c1) = prog(cdr(data(c1)));
+                  goto for2;
+               }
+               val(At) = a;
+               data(c1) = Nil;
+            }
+            else if (car(data(c1)) == T) {
+               data(c1) = cdr(data(c1));
+               if (!isNil(a = EVAL(car(data(c1))))) {
+                  val(At) = a;
+                  data(c1) = prog(cdr(data(c1)));
+                  goto for2;
+               }
+               data(c1) = Nil;
+            }
+            else
+               data(c1) = evList(data(c1));
+         }
+      } while (isCell(x = cdr(x)));
+      if (isCell(y))
+         val(f.bnd[0].sym) = prog(y);
+      x = body;
+   }
+for2:
+   if (f.cnt == 2)
+      val(f.bnd[1].sym) = f.bnd[1].val;
+   val(f.bnd[0].sym) = f.bnd[0].val;
+   Env.bind = f.link;
+   return Pop(c1);
+}
+
+// (catch 'any . prg) -> any
+any doCatch(any x) {
+   any y;
+   catchFrame f;
+
+   x = cdr(x),  f.tag = EVAL(car(x)),  f.fin = Zero;
+   f.link = CatchPtr,  CatchPtr = &f;
+   f.env = Env;
+   y = setjmp(f.rst)? Thrown : prog(cdr(x));
+   CatchPtr = f.link;
+   return y;
+}
+
+// (throw 'sym 'any)
+any doThrow(any ex) {
+   any x, tag;
+   catchFrame *p;
+
+   x = cdr(ex),  tag = EVAL(car(x));
+   x = cdr(x),  Thrown = EVAL(car(x));
+   for (p = CatchPtr;  p;  p = p->link)
+      if (p->tag == T  ||  tag == p->tag) {
+         unwind(p);
+         longjmp(p->rst, 1);
+      }
+   err(ex, tag, "Tag not found");
+}
+
+// (finally exe . prg) -> any
+any doFinally(any x) {
+   catchFrame f;
+   cell c1;
+
+   x = cdr(x),  f.tag = NULL,  f.fin = car(x);
+   f.link = CatchPtr,  CatchPtr = &f;
+   f.env = Env;
+   Push(c1, prog(cdr(x)));
+   EVAL(f.fin);
+   CatchPtr = f.link;
+   return Pop(c1);
+}
+
+static outFrame Out;
+static struct {  // bindFrame
+   struct bindFrame *link;
+   int i, cnt;
+   struct {any sym; any val;} bnd[3];  // for 'Up', 'Run' and 'At'
+} Brk;
+
+any brkLoad(any x) {
+   if (!Env.brk && isatty(STDIN_FILENO) && isatty(STDOUT_FILENO)) {
+      Env.brk = YES;
+      Brk.cnt = 3;
+      Brk.bnd[0].sym = Up,  Brk.bnd[0].val = val(Up),  val(Up) = x;
+      Brk.bnd[1].sym = Run,  Brk.bnd[1].val = val(Run),  val(Run) = Nil;
+      Brk.bnd[2].sym = At,  Brk.bnd[2].val = val(At);
+      Brk.link = Env.bind,  Env.bind = (bindFrame*)&Brk;
+      Out.pid = 0,  Out.fd = STDOUT_FILENO,  pushOutFiles(&Out);
+      print(x), newline();
+      load(NULL, '!', Nil);
+      popOutFiles();
+      val(At) = Brk.bnd[2].val;
+      val(Run) = Brk.bnd[1].val;
+      x = val(Up),  val(Up) = Brk.bnd[0].val;
+      Env.bind = Brk.link;
+      Env.brk = NO;
+   }
+   return x;
+}
+
+// (! . exe) -> any
+any doBreak(any x) {
+   x = cdr(x);
+   if (!isNil(val(Dbg)))
+      x = brkLoad(x);
+   return EVAL(x);
+}
+
+// (e . prg) -> any
+any doE(any ex) {
+   any x;
+   inFrame *in;
+   cell c1, at, key;
+
+   if (!Env.brk)
+      err(ex, NULL, "No Break");
+   Push(c1,val(Dbg)),  val(Dbg) = Nil;
+   Push(at, val(At)),  val(At) = Brk.bnd[2].val;
+   Push(key, val(Run)),  val(Run) = Brk.bnd[1].val;
+   in =  Env.inFrames,  popInFiles();
+   popOutFiles();
+   x = isCell(cdr(ex))? prog(cdr(ex)) : EVAL(val(Up));
+   pushOutFiles(&Out);
+   pushInFiles(in);
+   val(Run) = data(key);
+   val(At) = data(at);
+   val(Dbg) = Pop(c1);
+   return x;
+}
+
+static void traceIndent(int i, any x, char *s) {
+   if (i > 64)
+      i = 64;
+   while (--i >= 0)
+      Env.put(' ');
+   if (isSym(x))
+      print(x);
+   else
+      print(car(x)), space(), print(cdr(x)), space(), print(val(This));
+   outString(s);
+}
+
+// ($ sym|lst lst . prg) -> any
+any doTrace(any x) {
+   any foo, body;
+   outFile *oSave;
+   void (*putSave)(int);
+   cell c1;
+
+   x = cdr(x);
+   if (isNil(val(Dbg)))
+      return prog(cddr(x));
+   oSave = OutFile,  putSave = Env.put;
+   OutFile = OutFiles[STDERR_FILENO],  Env.put = putStdout;
+   foo = car(x);
+   x = cdr(x),  body = cdr(x);
+   traceIndent(++Env.trace, foo, " :");
+   for (x = car(x);  isCell(x);  x = cdr(x))
+      space(), print(val(car(x)));
+   if (!isNil(x)) {
+      if (x != At)
+         space(), print(val(x));
+      else {
+         int i = Env.next;
+
+         while (--i >= 0)
+            space(), print(data(Env.arg[i]));
+      }
+   }
+   newline();
+   Env.put = putSave,  OutFile = oSave;
+   Push(c1, prog(body));
+   OutFile = OutFiles[STDERR_FILENO],  Env.put = putStdout;
+   traceIndent(Env.trace--, foo, " = "),  print(data(c1));
+   newline();
+   Env.put = putSave,  OutFile = oSave;
+   return Pop(c1);
+}
+
+// (sys 'any ['any]) -> sym
+any doSys(any x) {
+   any y;
+
+   y = evSym(x = cdr(x));
+   {
+      char nm[bufSize(y)];
+
+      bufString(y,nm);
+      if (!isCell(x = cdr(x)))
+         return mkStr(getenv(nm));
+      y = evSym(x);
+      {
+         char val[bufSize(y)];
+
+         bufString(y,val);
+         return setenv(nm,val,1)? Nil : y;
+      }
+   }
+}
+
+// (call 'any ..) -> flg
+any doCall(any ex) {
+   pid_t pid;
+   any x, y;
+   int res, i, ac = length(x = cdr(ex));
+   char *av[ac+1];
+
+   if (ac == 0)
+      return Nil;
+   av[0] = alloc(NULL, pathSize(y = evSym(x))),  pathString(y, av[0]);
+   for (i = 1; isCell(x = cdr(x)); ++i)
+      av[i] = alloc(NULL, bufSize(y = evSym(x))),  bufString(y, av[i]);
+   av[ac] = NULL;
+   flushAll();
+   if ((pid = fork()) == 0) {
+      setpgid(0,0);
+      tcsetpgrp(0,getpgrp());
+      execvp(av[0], av);
+      execError(av[0]);
+   }
+   i = 0;  do
+      free(av[i]);
+   while (++i < ac);
+   if (pid < 0)
+      err(ex, NULL, "fork");
+   setpgid(pid,0);
+   tcsetpgrp(0,pid);
+   for (;;) {
+      while (waitpid(pid, &res, WUNTRACED) < 0) {
+         if (errno != EINTR)
+            err(ex, NULL, "wait pid");
+         if (Signal)
+            sighandler(ex);
+      }
+      tcsetpgrp(0,getpgrp());
+      if (!WIFSTOPPED(res))
+         return res == 0? T : Nil;
+      load(NULL, '+', Nil);
+      tcsetpgrp(0,pid);
+      kill(pid, SIGCONT);
+   }
+}
+
+// (tick (cnt1 . cnt2) . prg) -> any
+any doTick(any ex) {
+   any x;
+   clock_t n1, n2, save1, save2;
+   struct tms tim;
+   static clock_t ticks1, ticks2;
+
+   save1 = ticks1,  save2 = ticks2;
+   times(&tim),  n1 = tim.tms_utime,  n2 = tim.tms_stime;
+   x = prog(cddr(ex));
+   times(&tim);
+   n1 = (tim.tms_utime - n1) - (ticks1 - save1);
+   n2 = (tim.tms_stime - n2) - (ticks2 - save2);
+   setDig(caadr(ex), unDig(caadr(ex)) + 2*n1);
+   setDig(cdadr(ex), unDig(cdadr(ex)) + 2*n2);
+   ticks1 += n1,  ticks2 += n2;
+   return x;
+}
+
+// (ipid) -> pid | NIL
+any doIpid(any ex __attribute__((unused))) {
+   if (Env.inFrames  &&  Env.inFrames->pid > 1)
+      return boxCnt((long)Env.inFrames->pid);
+   return Nil;
+}
+
+// (opid) -> pid | NIL
+any doOpid(any ex __attribute__((unused))) {
+   if (Env.outFrames  &&  Env.outFrames->pid > 1)
+      return boxCnt((long)Env.outFrames->pid);
+   return Nil;
+}
+
+// (kill 'pid ['cnt]) -> flg
+any doKill(any ex) {
+   pid_t pid;
+
+   pid = (pid_t)evCnt(ex,cdr(ex));
+   return kill(pid, isCell(cddr(ex))? (int)evCnt(ex,cddr(ex)) : SIGTERM)? Nil : T;
+}
+
+static void allocChildren(void) {
+   int i;
+
+   Child = alloc(Child, (Children + 8) * sizeof(child));
+   for (i = 0; i < 8; ++i)
+      Child[Children++].pid = 0;
+}
+
+pid_t forkLisp(any ex) {
+   pid_t n;
+   int i, hear[2], tell[2];
+   static int mic[2];
+
+   flushAll();
+   if (!Spkr) {
+      if (pipe(mic) < 0)
+         pipeError(ex, "open");
+      closeOnExec(ex, mic[0]), closeOnExec(ex, mic[1]);
+      Spkr = mic[0];
+   }
+   if (pipe(hear) < 0  ||  pipe(tell) < 0)
+      pipeError(ex, "open");
+   closeOnExec(ex, hear[0]), closeOnExec(ex, hear[1]);
+   closeOnExec(ex, tell[0]), closeOnExec(ex, tell[1]);
+   for (i = 0; i < Children; ++i)
+      if (!Child[i].pid)
+         break;
+   if ((n = fork()) < 0)
+      err(ex, NULL, "fork");
+   if (n == 0) {
+      void *p;
+
+      Slot = i;
+      Spkr = 0;
+      Mic = mic[1];
+      close(hear[1]), close(tell[0]), close(mic[0]);
+      if (Hear)
+         close(Hear),  closeInFile(Hear),  closeOutFile(Hear);
+      initInFile(Hear = hear[0], NULL);
+      if (Tell)
+         close(Tell);
+      Tell = tell[1];
+      for (i = 0; i < Children; ++i)
+         if (Child[i].pid)
+            close(Child[i].hear), close(Child[i].tell),  free(Child[i].buf);
+      Children = 0,  free(Child),  Child = NULL;
+      for (p = Env.inFrames; p; p = ((inFrame*)p)->link)
+         ((inFrame*)p)->pid = 0;
+      for (p = Env.outFrames; p; p = ((outFrame*)p)->link)
+         ((outFrame*)p)->pid = 0;
+      for (p = CatchPtr; p; p = ((catchFrame*)p)->link)
+         ((catchFrame*)p)->fin = Zero;
+      free(Termio),  Termio = NULL;
+      if (Repl)
+         ++Repl;
+      val(PPid) = val(Pid);
+      val(Pid) = boxCnt(getpid());
+      run(val(Fork));
+      val(Fork) = Nil;
+      return 0;
+   }
+   if (i == Children)
+      allocChildren();
+   close(hear[0]), close(tell[1]);
+   Child[i].pid = n;
+   Child[i].hear = tell[0];
+   nonblocking(Child[i].tell = hear[1]);
+   Child[i].ofs = Child[i].cnt = 0;
+   Child[i].buf = NULL;
+   return n;
+}
+
+// (fork) -> pid | NIL
+any doFork(any ex) {
+   int n;
+
+   return (n = forkLisp(ex))? boxCnt(n) : Nil;
+}
+
+// (bye 'cnt|NIL)
+any doBye(any ex) {
+   any x = EVAL(cadr(ex));
+
+   bye(isNil(x)? 0 : xCnt(ex,x));
+}
diff --git a/src/gc.c b/src/gc.c
@@ -0,0 +1,185 @@
+/* 04may09abu
+ * (c) Software Lab. Alexander Burger
+ */
+
+#include "pico.h"
+
+/* Mark data */
+static void mark(any x) {
+   cell *p;
+
+   while (num((p = cellPtr(x))->cdr) & 1) {
+      *(word*)&cdr(p) &= ~1;
+      if (!isNum(x))
+         mark(p->car);
+      x = p->cdr;
+   }
+}
+
+/* Garbage collector */
+static void gc(long c) {
+   any p, *pp, x;
+   heap *h;
+   int i;
+
+   val(DB) = Nil;
+   h = Heaps;
+   do {
+      p = h->cells + CELLS-1;
+      do
+         *(word*)&cdr(p) |= 1;
+      while (--p >= h->cells);
+   } while (h = h->next);
+   /* Mark */
+   mark(Nil+1);
+   mark(Alarm),  mark(Line),  mark(Zero),  mark(One);
+   for (i = 0; i < IHASH; ++i)
+      mark(Intern[i]),  mark(Transient[i]);
+   mark(ApplyArgs),  mark(ApplyBody);
+   for (p = Env.stack; p; p = cdr(p))
+      mark(car(p));
+   for (p = (any)Env.bind;  p;  p = (any)((bindFrame*)p)->link)
+      for (i = ((bindFrame*)p)->cnt;  --i >= 0;) {
+         mark(((bindFrame*)p)->bnd[i].sym);
+         mark(((bindFrame*)p)->bnd[i].val);
+      }
+   for (p = (any)CatchPtr; p; p = (any)((catchFrame*)p)->link) {
+      if (((catchFrame*)p)->tag)
+         mark(((catchFrame*)p)->tag);
+      mark(((catchFrame*)p)->fin);
+   }
+   for (p = (any)Env.meth;  p;  p = (any)((methFrame*)p)->link)
+      mark(((methFrame*)p)->key),  mark(((methFrame*)p)->cls);
+   for (i = 0; i < EHASH; ++i)
+      for (p = Extern[i];  isCell(p);  p = (any)(num(p->cdr) & ~1))
+         if (num(val(p->car)) & 1) {
+            for (x = tail1(p->car); !isSym(x); x = cdr(cellPtr(x)));
+            if ((x = (any)(num(x) & ~1)) == At2  ||  x == At3)
+               mark(p->car);  // Keep if dirty or deleted
+         }
+   if (num(val(val(DB) = DbVal)) & 1) {
+      val(DbVal) = cdr(numCell(DbTail)) = Nil;
+      tail(DbVal) = ext(DbTail);
+   }
+   for (i = 0; i < EHASH; ++i)
+      for (pp = Extern + i;  isCell(p = *pp);)
+         if (num(val(p->car)) & 1)
+            *pp = (cell*)(num(p->cdr) & ~1);
+         else
+            *(word*)(pp = &cdr(p)) &= ~1;
+   /* Sweep */
+   Avail = NULL;
+   h = Heaps;
+   if (c) {
+      do {
+         p = h->cells + CELLS-1;
+         do
+            if (num(p->cdr) & 1)
+               Free(p),  --c;
+         while (--p >= h->cells);
+      } while (h = h->next);
+      while (c >= 0)
+         heapAlloc(),  c -= CELLS;
+   }
+   else {
+      heap **hp = &Heaps;
+      cell *av;
+
+      do {
+         c = CELLS;
+         av = Avail;
+         p = h->cells + CELLS-1;
+         do
+            if (num(p->cdr) & 1)
+               Free(p),  --c;
+         while (--p >= h->cells);
+         if (c)
+            hp = &h->next,  h = h->next;
+         else
+            Avail = av,  h = h->next,  free(*hp),  *hp = h;
+      } while (h);
+   }
+}
+
+// (gc ['cnt]) -> cnt | NIL
+any doGc(any x) {
+   x = cdr(x);
+   gc(isNum(x = EVAL(car(x)))? CELLS*unBox(x) : CELLS);
+   return x;
+}
+
+/* Construct a cell */
+any cons(any x, any y) {
+   cell *p;
+
+   if (!(p = Avail)) {
+      cell c1, c2;
+
+      Push(c1,x);
+      Push(c2,y);
+      gc(CELLS);
+      drop(c1);
+      p = Avail;
+   }
+   Avail = p->car;
+   p->car = x;
+   p->cdr = y;
+   return p;
+}
+
+/* Construct a symbol */
+any consSym(any v, any x) {
+   cell *p;
+
+   if (!(p = Avail)) {
+      cell c1, c2;
+
+      Push(c1,v);
+      Push(c2,x);
+      gc(CELLS);
+      drop(c1);
+      p = Avail;
+   }
+   Avail = p->car;
+   p = symPtr(p);
+   tail(p) = x;
+   val(p) = v;
+   return p;
+}
+
+/* Construct a string */
+any consStr(any x) {
+   cell *p;
+
+   if (!(p = Avail)) {
+      cell c1;
+
+      Push(c1,x);
+      gc(CELLS);
+      drop(c1);
+      p = Avail;
+   }
+   Avail = p->car;
+   p = symPtr(p);
+   tail(p) = x;
+   val(p) = p;
+   return p;
+}
+
+/* Construct a number cell */
+any consNum(word n, any x) {
+   cell *p;
+
+   if (!(p = Avail)) {
+      cell c1;
+
+      Push(c1,x);
+      gc(CELLS);
+      drop(c1);
+      p = Avail;
+   }
+   Avail = p->car;
+   p->car = (any)n;
+   p->cdr = x;
+   return numPtr(p);
+}
diff --git a/src/ht.c b/src/ht.c
@@ -0,0 +1,368 @@
+/* 01apr10abu
+ * (c) Software Lab. Alexander Burger
+ */
+
+#include "pico.h"
+
+static char *HtOK[] = {
+   "<b>",      "</b>",
+   "<i>",      "</i>",
+   "<u>",      "</u>",
+   "<p>",      "</p>",
+   "<pre>",    "</pre>",
+   "<div ",    "</div>",
+   "<br>", "<hr>", NULL
+};
+
+static bool findHtOK(char *s) {
+   char **p, *q, *t;
+
+   for (p = HtOK; *p; ++p)
+      for (q = *p,  t = s;;) {
+         if (*q != *t)
+            break;
+         if (*++q == '\0')
+            return YES;
+         if (*++t == '\0')
+            break;
+      }
+   return NO;
+}
+
+// (ht:Prin 'sym ..) -> sym
+any Prin(any x) {
+   any y = Nil;
+
+   while (isCell(x = cdr(x))) {
+      if (isNum(y = EVAL(car(x))) || isCell(y) || isExt(y))
+         prin(y);
+      else {
+         int c;
+         char *p, *q, nm[bufSize(y)];
+
+         bufString(y, nm);
+         for (p = nm; *p;) {
+            if (findHtOK(p) && (q = strchr(p,'>')))
+               do
+                  Env.put(*p++);
+               while (p <= q);
+            else {
+               switch (*(byte*)p) {
+               case '<':
+                  outString("&lt;");
+                  break;
+               case '>':
+                  outString("&gt;");
+                  break;
+               case '&':
+                  outString("&amp;");
+                  break;
+               case '"':
+                  outString("&quot;");
+                  break;
+               case 0xFF:
+                  Env.put(0xEF);
+                  Env.put(0xBF);
+                  Env.put(0xBF);
+                  break;
+               default:
+                  Env.put(c = *p);
+                  if ((c & 0x80) != 0) {
+                     Env.put(*++p);
+                     if ((c & 0x20) != 0)
+                        Env.put(*++p);
+                  }
+               }
+               ++p;
+            }
+         }
+      }
+   }
+   return y;
+}
+
+static void putHex(int c) {
+   int n;
+
+   Env.put('%');
+   if ((n = c >> 4 & 0xF) > 9)
+      n += 7;
+   Env.put(n + '0');
+   if ((n = c & 0xF) > 9)
+      n += 7;
+   Env.put(n + '0');
+}
+
+static void htEncode(char *p) {
+	int c;
+
+   while (c = *p++) {
+      if (strchr(" \"#%&:;<=>?_", c))
+         putHex(c);
+      else {
+         Env.put(c);
+         if ((c & 0x80) != 0) {
+            Env.put(*p++);
+            if ((c & 0x20) != 0)
+               Env.put(*p++);
+         }
+      }
+   }
+}
+
+static void htFmt(any x) {
+   any y;
+
+   if (isNum(x))
+      Env.put('+'),  prin(x);
+   else if (isCell(x))
+      do
+         Env.put('_'),  htFmt(car(x));
+      while (isCell(x = cdr(x)));
+   else if (isNum(y = name(x))) {
+      char nm[bufSize(x)];
+
+      bufString(x, nm);
+      if (isExt(x))
+         Env.put('-'),  htEncode(nm);
+      else if (hashed(x, ihash(y), Intern))
+         Env.put('$'),  htEncode(nm);
+      else if (strchr("$+-", *nm)) {
+         putHex(*nm);
+         htEncode(nm+1);
+      }
+      else
+         htEncode(nm);
+   }
+}
+
+// (ht:Fmt 'any ..) -> sym
+any Fmt(any x) {
+   int n, i;
+   cell c[length(x = cdr(x))];
+
+   for (n = 0;  isCell(x);  ++n, x = cdr(x))
+      Push(c[n], EVAL(car(x)));
+   begString();
+   for (i = 0; i < n;) {
+      htFmt(data(c[i]));
+      if (++i != n)
+         Env.put('&');
+   }
+   x = endString();
+   if (n)
+      drop(c[0]);
+   return x;
+}
+
+static int getHex(any *p) {
+   int n, m;
+
+   n = firstByte(car(*p)),  *p = cdr(*p);
+   if ((n -= '0') > 9)
+      n = (n & 0xDF) - 7;
+   m = firstByte(car(*p)),  *p = cdr(*p);
+   if ((m -= '0') > 9)
+      m = (m & 0xDF) - 7;
+   return n << 4 | m;
+}
+
+static bool head(char *s, any x) {
+   while (*s) {
+      if (*s++ != firstByte(car(x)))
+         return NO;
+      x = cdr(x);
+   }
+   return YES;
+}
+
+static int getUnicode(any *p) {
+   int c, n = 0;
+   any x = cdr(*p);
+
+   while ((c = firstByte(car(x))) >= '0' && c <= '9') {
+      n = n * 10 + c - '0';
+      x = cdr(x);
+   }
+   if (n  &&  c == ';') {
+      *p = cdr(x);
+      return n;
+   }
+   return 0;
+}
+
+// (ht:Pack 'lst) -> sym
+any Pack(any x) {
+   int c;
+   cell c1;
+
+   x = EVAL(cadr(x));
+   begString();
+   Push(c1,x);
+   while (isCell(x)) {
+      if ((c = firstByte(car(x))) == '%')
+         x = cdr(x),  Env.put(getHex(&x));
+      else if (c != '&')
+         outName(car(x)), x = cdr(x);
+      else if (head("lt;", x = cdr(x)))
+         Env.put('<'), x = cdddr(x);
+      else if (head("gt;", x))
+         Env.put('>'), x = cdddr(x);
+      else if (head("amp;", x))
+         Env.put('&'), x = cddddr(x);
+      else if (head("quot;", x))
+         Env.put('"'), x = cddr(cdddr(x));
+      else if (head("nbsp;", x))
+         Env.put(' '), x = cddr(cdddr(x));
+      else if (firstByte(car(x)) == '#' && (c = getUnicode(&x)))
+         outName(mkChar(c));
+      else
+         Env.put('&');
+   }
+   return endString();
+}
+
+/*** Read content length bytes */
+// (ht:Read 'cnt) -> lst
+any Read(any ex) {
+   any x;
+   int n, c;
+   cell c1;
+
+   if ((n = evCnt(ex, cdr(ex))) <= 0)
+      return Nil;
+   if (!Chr)
+      Env.get();
+   if (Chr < 0)
+      return Nil;
+   if ((c = getChar()) >= 128) {
+      --n;
+      if (c >= 2048)
+         --n;
+   }
+   if (--n < 0)
+      return Nil;
+   Push(c1, x = cons(mkChar(c), Nil));
+   while (n) {
+      Env.get();
+      if (Chr < 0) {
+         data(c1) = Nil;
+         break;
+      }
+      if ((c = getChar()) >= 128) {
+         --n;
+         if (c >= 2048)
+            --n;
+      }
+      if (--n < 0) {
+         data(c1) = Nil;
+         break;
+      }
+      x = cdr(x) = cons(mkChar(c), Nil);
+   }
+   Chr = 0;
+   return Pop(c1);
+}
+
+
+/*** Chunked Encoding ***/
+#define CHUNK 4000
+static int Cnt;
+static void (*Get)(void);
+static void (*Put)(int);
+static char Chunk[CHUNK];
+
+static int chrHex(void) {
+   if (Chr >= '0' && Chr <= '9')
+      return Chr - 48;
+   else if (Chr >= 'A' && Chr <= 'F')
+      return Chr - 55;
+   else if (Chr >= 'a' && Chr <= 'f')
+      return Chr - 87;
+   else
+      return -1;
+}
+
+static void chunkSize(void) {
+   int n;
+
+   if (!Chr)
+      Get();
+   if ((Cnt = chrHex()) >= 0) {
+      while (Get(), (n = chrHex()) >= 0)
+         Cnt = Cnt << 4 | n;
+      while (Chr != '\n') {
+         if (Chr < 0)
+            return;
+         Get();
+      }
+      Get();
+      if (Cnt == 0) {
+         Get();  // Skip '\r' of empty line
+         Chr = 0;  // Discard '\n'
+      }
+   }
+}
+
+static void getChunked(void) {
+   if (Cnt <= 0)
+      Chr = -1;
+   else {
+      Get();
+      if (--Cnt == 0) {
+         Get(), Get();  // Skip '\n', '\r'
+         chunkSize();
+      }
+   }
+}
+
+// (ht:In 'flg . prg) -> any
+any In(any x) {
+   x = cdr(x);
+   if (isNil(EVAL(car(x))))
+      return prog(cdr(x));
+   Get = Env.get,  Env.get = getChunked;
+   chunkSize();
+   x = prog(cdr(x));
+   Env.get = Get;
+   Chr = 0;
+   return x;
+}
+
+static void wrChunk(void) {
+   int i;
+   char buf[BITS/2];
+
+   sprintf(buf, "%x\r\n", Cnt);
+   i = 0;
+   do
+      Put(buf[i]);
+   while (buf[++i]);
+   for (i = 0; i < Cnt; ++i)
+      Put(Chunk[i]);
+   Put('\r'), Put('\n');
+}
+
+static void putChunked(int c) {
+   Chunk[Cnt++] = c;
+   if (Cnt == CHUNK)
+      wrChunk(),  Cnt = 0;
+}
+
+// (ht:Out 'flg . prg) -> any
+any Out(any x) {
+   x = cdr(x);
+   if (isNil(EVAL(car(x))))
+      x = prog(cdr(x));
+   else {
+      Cnt = 0;
+      Put = Env.put,  Env.put = putChunked;
+      x = prog(cdr(x));
+      if (Cnt)
+         wrChunk();
+      Env.put = Put;
+      outString("0\r\n\r\n");
+   }
+   flush(OutFile);
+   return x;
+}
diff --git a/src/httpGate.c b/src/httpGate.c
@@ -0,0 +1,309 @@
+/* 20jul09abu
+ * (c) Software Lab. Alexander Burger
+ */
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <unistd.h>
+#include <fcntl.h>
+#include <errno.h>
+#include <ctype.h>
+#include <string.h>
+#include <signal.h>
+#include <netdb.h>
+#include <time.h>
+#include <sys/time.h>
+#include <sys/stat.h>
+#include <sys/socket.h>
+#include <arpa/inet.h>
+#include <netinet/tcp.h>
+#include <netinet/in.h>
+
+#include <openssl/pem.h>
+#include <openssl/ssl.h>
+#include <openssl/err.h>
+
+typedef enum {NO,YES} bool;
+
+static int Http1;
+
+static char Head_410[] =
+   "HTTP/1.0 410 Gone\r\n"
+   "Server: PicoLisp\r\n"
+   "Content-Type: text/html; charset=utf-8\r\n"
+   "\r\n";
+
+static void giveup(char *msg) {
+   fprintf(stderr, "httpGate: %s\n", msg);
+   exit(2);
+}
+
+static inline bool pre(char *p, char *s) {
+   while (*s)
+      if (*p++ != *s++)
+         return NO;
+   return YES;
+}
+
+static char *ses(char *buf, int port, int *len) {
+   int np;
+   char *p, *q;
+
+   if (Http1 == 0)
+      return buf;
+   if (pre(buf, "GET /")) {
+      np = (int)strtol(buf+5, &q, 10);
+      if (q == buf+5 || *q != '/' || np < 1024 || np > 65535)
+         return buf;
+      p = q++ - 4;
+      do
+         if (*q < '0' || *q > '9')
+            return buf;
+      while (*++q != '~');
+      if (np == port) {
+         p[0] = 'G',  p[1] = 'E',  p[2] = 'T',  p[3] = ' ';
+         *len -= p - buf;
+         return p;
+      }
+      return NULL;
+   }
+   if (pre(buf, "POST /")) {
+      np = (int)strtol(buf+6, &q, 10);
+      if (q == buf+6 || *q != '/' || np < 1024 || np > 65535)
+         return buf;
+      p = q++ - 5;
+      do
+         if (*q < '0' || *q > '9')
+            return buf;
+      while (*++q != '~');
+      if (np == port) {
+         p[0] = 'P',  p[1] = 'O',  p[2] = 'S',  p[3] = 'T',  p[4] = ' ';
+         *len -= p - buf;
+         return p;
+      }
+      return NULL;
+   }
+   return buf;
+}
+
+static int slow(SSL *ssl, int fd, char *p, int cnt) {
+   int n;
+
+   while ((n = ssl? SSL_read(ssl, p, cnt) : read(fd, p, cnt)) < 0)
+      if (errno != EINTR)
+         return 0;
+   return n;
+}
+
+static void wrBytes(int fd, char *p, int cnt) {
+   int n;
+
+   do
+      if ((n = write(fd, p, cnt)) >= 0)
+         p += n, cnt -= n;
+      else if (errno != EINTR)
+         exit(1);
+   while (cnt);
+}
+
+static void sslWrite(SSL *ssl, void *p, int cnt) {
+   if (SSL_write(ssl, p, cnt) <= 0)
+      exit(1);
+}
+
+static int gateSocket(void) {
+   int sd;
+
+   if ((sd = socket(AF_INET, SOCK_STREAM, 0)) < 0)
+      exit(1);
+   return sd;
+}
+
+static int gatePort(int port) {
+   int n, sd;
+   struct sockaddr_in addr;
+
+   memset(&addr, 0, sizeof(addr));
+   addr.sin_family = AF_INET;
+   addr.sin_addr.s_addr = htonl(INADDR_ANY);
+   addr.sin_port = htons((unsigned short)port);
+   n = 1,  setsockopt(sd = gateSocket(), SOL_SOCKET, SO_REUSEADDR, &n, sizeof(n));
+   if (bind(sd, (struct sockaddr*)&addr, sizeof(addr)) < 0)
+      exit(1);
+   if (listen(sd,5) < 0)
+      exit(1);
+   return sd;
+}
+
+static int gateConnect(unsigned short port) {
+   int sd;
+   struct sockaddr_in addr;
+
+   memset(&addr, 0, sizeof(addr));
+   addr.sin_addr.s_addr = inet_addr("127.0.0.1");
+   sd = gateSocket();
+   addr.sin_family = AF_INET;
+   addr.sin_port = htons(port);
+   return connect(sd, (struct sockaddr*)&addr, sizeof(addr)) < 0? -1 : sd;
+}
+
+
+static pid_t Buddy;
+
+static void doSigAlarm(int n __attribute__((unused))) {
+   kill(Buddy, SIGTERM);
+   exit(0);
+}
+
+static void doSigUsr1(int n __attribute__((unused))) {
+   alarm(420);
+}
+
+int main(int ac, char *av[]) {
+   int cnt = ac>4? ac-3 : 1, ports[cnt], n, sd, cli, srv;
+   struct sockaddr_in addr;
+   char *gate;
+   SSL_CTX *ctx;
+   SSL *ssl;
+
+   if (ac < 3)
+      giveup("port dflt [pem [alt ..]]");
+
+   sd = gatePort(atoi(av[1]));  // e.g. 80 or 443
+   ports[0] = atoi(av[2]);  // e.g. 8080
+   if (ac == 3 || *av[3] == '\0')
+      ssl = NULL,  gate = "Gate: http %s\r\n";
+   else {
+      SSL_library_init();
+      SSL_load_error_strings();
+      if (!(ctx = SSL_CTX_new(SSLv23_server_method())) ||
+            !SSL_CTX_use_certificate_file(ctx, av[3], SSL_FILETYPE_PEM) ||
+               !SSL_CTX_use_PrivateKey_file(ctx, av[3], SSL_FILETYPE_PEM) ||
+                                          !SSL_CTX_check_private_key(ctx) ) {
+         ERR_print_errors_fp(stderr);
+         giveup("SSL init");
+      }
+      ssl = SSL_new(ctx),  gate = "Gate: https %s\r\n";
+   }
+   for (n = 1; n < cnt; ++n)
+      ports[n] = atoi(av[n+3]);
+
+   signal(SIGCHLD,SIG_IGN);  /* Prevent zombies */
+   if ((n = fork()) < 0)
+      giveup("detach");
+   if (n)
+      return 0;
+   setsid();
+
+   for (;;) {
+      socklen_t len = sizeof(addr);
+      if ((cli = accept(sd, (struct sockaddr*)&addr, &len)) >= 0 && (n = fork()) >= 0) {
+         if (!n) {
+            int fd, port;
+            char *p, *q, buf[4096], buf2[64];
+
+            close(sd);
+
+            alarm(420);
+            if (ssl) {
+               SSL_set_fd(ssl, cli);
+               if (SSL_accept(ssl) < 0)
+                  return 1;
+               n = SSL_read(ssl, buf, sizeof(buf));
+            }
+            else
+               n = read(cli, buf, sizeof(buf));
+            alarm(0);
+            if (n < 6)
+               return 1;
+
+            /* "GET /url HTTP/1.x"
+             * "GET /8080/url HTTP/1.x"
+             * "POST /url HTTP/1.x"
+             * "POST /8080/url HTTP/1.x"
+             */
+            if (pre(buf, "GET /"))
+               p = buf + 5;
+            else if (pre(buf, "POST /"))
+               p = buf + 6;
+            else
+               return 1;
+
+            port = (int)strtol(p, &q, 10);
+            if (q == p  ||  *q != ' ' && *q != '/')
+               port = ports[0],  q = p;
+            else if (port < cnt)
+               port = ports[port];
+            else if (port < 1024)
+               return 1;
+
+            if ((srv = gateConnect((unsigned short)port)) < 0) {
+               if (!memchr(q,'~', buf + n - q))
+                  return 1;
+               if ((fd = open("void", O_RDONLY)) < 0)
+                  return 1;
+               alarm(420);
+               if (ssl)
+                  sslWrite(ssl, Head_410, strlen(Head_410));
+               else
+                  wrBytes(cli, Head_410, strlen(Head_410));
+               alarm(0);
+               while ((n = read(fd, buf, sizeof(buf))) > 0) {
+                  alarm(420);
+                  if (ssl)
+                     sslWrite(ssl, buf, n);
+                  else
+                     wrBytes(cli, buf, n);
+                  alarm(0);
+               }
+               return 0;
+            }
+
+            Http1 = 0;
+            wrBytes(srv, buf, p - buf);
+            if (*q == '/')
+               ++q;
+            p = q;
+            while (*p++ != '\n')
+               if (p >= buf + n)
+                  return 1;
+            wrBytes(srv, q, p - q);
+            if (pre(p-10, "HTTP/1."))
+               Http1 = *(p-3) - '0';
+            wrBytes(srv, buf2, sprintf(buf2, gate, inet_ntoa(addr.sin_addr)));
+            wrBytes(srv, p, buf + n - p);
+
+            signal(SIGALRM, doSigAlarm);
+            signal(SIGUSR1, doSigUsr1);
+            if (Buddy = fork()) {
+               for (;;) {
+                  alarm(420);
+                  n = slow(ssl, cli, buf, sizeof(buf));
+                  alarm(0);
+                  if (!n || !(p = ses(buf, port, &n)))
+                     break;
+                  wrBytes(srv, p, n);
+               }
+               shutdown(cli, SHUT_RD);
+               shutdown(srv, SHUT_WR);
+            }
+            else {
+               Buddy = getppid();
+               while ((n = read(srv, buf, sizeof(buf))) > 0) {
+                  kill(Buddy, SIGUSR1);
+                  alarm(420);
+                  if (ssl)
+                     sslWrite(ssl, buf, n);
+                  else
+                     wrBytes(cli, buf, n);
+                  alarm(0);
+               }
+               shutdown(srv, SHUT_RD);
+               shutdown(cli, SHUT_WR);
+            }
+            return 0;
+         }
+         close(cli);
+      }
+   }
+}
diff --git a/src/io.c b/src/io.c
@@ -0,0 +1,3543 @@
+/* 14apr10abu
+ * (c) Software Lab. Alexander Burger
+ */
+
+#include "pico.h"
+
+#ifdef __CYGWIN__
+#include <sys/file.h>
+#define fcntl(fd,cmd,fl) 0
+#endif
+
+static any read0(bool);
+
+// I/O Tokens
+enum {NIX, BEG, DOT, END};
+enum {NUMBER, INTERN, TRANSIENT, EXTERN};
+
+static char Delim[] = " \t\n\r\"'(),[]`~{}";
+static int StrI;
+static cell StrCell, *StrP;
+static bool Sync;
+static byte *PipeBuf, *PipePtr;
+static void (*PutSave)(int);
+static byte TBuf[] = {INTERN+4, 'T'};
+
+static void openErr(any ex, char *s) {err(ex, NULL, "%s open: %s", s, strerror(errno));}
+static void closeErr(void) {err(NULL, NULL, "Close error: %s", strerror(errno));}
+static void eofErr(void) {err(NULL, NULL, "EOF Overrun");}
+static void badFd(any ex, any x) {err(ex, x, "Bad FD");}
+static void lockErr(void) {err(NULL, NULL, "File lock: %s", strerror(errno));}
+static void writeErr(char *s) {err(NULL, NULL, "%s write: %s", s, strerror(errno));}
+static void selectErr(any ex) {err(ex, NULL, "Select error: %s", strerror(errno));}
+
+static void lockFile(int fd, int cmd, int typ) {
+   struct flock fl;
+
+   fl.l_type = typ;
+   fl.l_whence = SEEK_SET;
+   fl.l_start = 0;
+   fl.l_len = 0;
+   while (fcntl(fd, cmd, &fl) < 0  &&  typ != F_UNLCK)
+      if (errno != EINTR)
+         lockErr();
+}
+
+void closeOnExec(any ex, int fd) {
+   if (fcntl(fd, F_SETFD, FD_CLOEXEC) < 0)
+      err(ex, NULL, "SETFD %s", strerror(errno));
+}
+
+int nonblocking(int fd) {
+   int flg = fcntl(fd, F_GETFL, 0);
+
+   fcntl(fd, F_SETFL, flg | O_NONBLOCK);
+   return flg;
+}
+
+inFile *initInFile(int fd, char *nm) {
+   inFile *p;
+
+   if (fd >= InFDs) {
+      int i = InFDs;
+
+      InFiles = alloc(InFiles, (InFDs = fd + 1) * sizeof(inFile*));
+      do
+         InFiles[i] = NULL;
+      while (++i < InFDs);
+   }
+   p = InFiles[fd] = alloc(InFiles[fd], sizeof(inFile));
+   p->fd = fd;
+   p->ix = p->cnt = p->next = 0;
+   p->line = p->src = 1;
+   p->name = nm;
+   return p;
+}
+
+outFile *initOutFile(int fd) {
+   outFile *p;
+
+   if (fd >= OutFDs) {
+      int i = OutFDs;
+
+      OutFiles = alloc(OutFiles, (OutFDs = fd + 1) * sizeof(outFile*));
+      do
+         OutFiles[i] = NULL;
+      while (++i < OutFDs);
+   }
+   p = OutFiles[fd] = alloc(OutFiles[fd], sizeof(outFile));
+   p->tty = isatty(p->fd = fd);
+   p->ix = 0;
+   return p;
+}
+
+void closeInFile(int fd) {
+   inFile *p;
+
+   if (fd < InFDs && (p = InFiles[fd])) {
+      if (p == InFile)
+         InFile = NULL;
+      free(p->name),  free(p),  InFiles[fd] = NULL;
+   }
+}
+
+void closeOutFile(int fd) {
+   outFile *p;
+
+   if (fd < OutFDs && (p = OutFiles[fd])) {
+      if (p == OutFile)
+         OutFile = NULL;
+      free(p),  OutFiles[fd] = NULL;
+   }
+}
+
+int slow(inFile *p, bool nb) {
+   int n, f;
+
+   p->ix = p->cnt = 0;
+   for (;;) {
+      if (nb)
+         f = nonblocking(p->fd);
+      n = read(p->fd, p->buf, BUFSIZ);
+      if (nb)
+         fcntl(p->fd, F_SETFL, f);
+      if (n >= 0)
+         return p->cnt = n;
+      if (errno == EAGAIN)
+         return -1;
+      if (errno != EINTR)
+         return 0;
+      if (Signal)
+         sighandler(NULL);
+   }
+}
+
+int rdBytes(int fd, byte *p, int cnt, bool nb) {
+   int n, f;
+
+   for (;;) {
+      if (nb)
+         f = nonblocking(fd);
+      n = read(fd, p, cnt);
+      if (nb)
+         fcntl(fd, F_SETFL, f);
+      if (n > 0) {
+         for (;;) {
+            p += n;
+            if ((cnt -= n) == 0)
+               return 1;
+            while ((n = read(fd, p, cnt)) <= 0) {
+               if (!n || errno != EINTR)
+                  return 0;
+               if (Signal)
+                  sighandler(NULL);
+            }
+         }
+      }
+      if (n == 0)
+         return 0;
+      if (errno == EAGAIN)
+         return -1;
+      if (errno != EINTR)
+         return 0;
+      if (Signal)
+         sighandler(NULL);
+   }
+}
+
+bool wrBytes(int fd, byte *p, int cnt) {
+   int n;
+
+   do {
+      if ((n = write(fd, p, cnt)) >= 0)
+         p += n, cnt -= n;
+      else if (errno == EBADF || errno == EPIPE || errno == ECONNRESET)
+         return NO;
+      else if (errno != EINTR)
+         writeErr("bytes");
+      if (Signal)
+         sighandler(NULL);
+   } while (cnt);
+   return YES;
+}
+
+static void wrChild(int i, byte *p, int cnt) {
+   int n;
+
+   if (Child[i].cnt == 0) {
+      for (;;) {
+         if ((n = write(Child[i].tell, p, cnt)) >= 0) {
+            if ((cnt -= n) == 0)
+               return;
+            p += n;
+         }
+         else if (errno == EAGAIN)
+            break;
+         else if (errno == EPIPE || errno == ECONNRESET) {
+            Child[i].pid = 0;
+            close(Child[i].hear),  close(Child[i].tell);
+            free(Child[i].buf);
+            return;
+         }
+         else if (errno != EINTR)
+            writeErr("child");
+      }
+   }
+   n = Child[i].cnt;
+   Child[i].buf = alloc(Child[i].buf, n + sizeof(int) + cnt);
+   *(int*)(Child[i].buf + n) = cnt;
+   memcpy(Child[i].buf + n + sizeof(int), p, cnt);
+   Child[i].cnt += sizeof(int) + cnt;
+}
+
+bool flush(outFile *p) {
+   int n;
+
+   if (p && (n = p->ix)) {
+      p->ix = 0;
+      return wrBytes(p->fd, p->buf, n);
+   }
+   return YES;
+}
+
+void flushAll(void) {
+   int i;
+
+   for (i = 0; i < OutFDs; ++i)
+      flush(OutFiles[i]);
+}
+
+/*** Low level I/O ***/
+static int stdinByte(void) {
+   inFile *p;
+
+   if (!(p = InFiles[STDIN_FILENO])  ||  p->ix == p->cnt  &&  !slow(p,NO))
+      return -1;
+   return p->buf[p->ix++];
+}
+
+static int getBinary(void) {
+   if (!InFile  ||  InFile->ix == InFile->cnt  &&  !slow(InFile,NO))
+      return -1;
+   return InFile->buf[InFile->ix++];
+}
+
+static any rdNum(int cnt) {
+   int n, i;
+   any x;
+   cell c1;
+
+   if ((n = getBin()) < 0)
+      return NULL;
+   i = 0,  Push(c1, x = box(n));
+   if (--cnt == 62) {
+      do {
+         do {
+            if ((n = getBin()) < 0)
+               return NULL;
+            byteSym(n, &i, &x);
+         } while (--cnt);
+         if ((cnt = getBin()) < 0)
+            return NULL;
+      } while (cnt == 255);
+   }
+   while (--cnt >= 0) {
+      if ((n = getBin()) < 0)
+         return NULL;
+      byteSym(n, &i, &x);
+   }
+   return Pop(c1);
+}
+
+any binRead(int extn) {
+   int c;
+   any x, y, *h;
+   cell c1;
+
+   if ((c = getBin()) < 0)
+      return NULL;
+   if ((c & ~3) == 0) {
+      if (c == NIX)
+         return Nil;
+      if (c == BEG) {
+         if ((x = binRead(extn)) == NULL)
+            return NULL;
+         Push(c1, x = cons(x,Nil));
+         while ((y = binRead(extn)) != (any)END) {
+            if (y == NULL) {
+               drop(c1);
+               return NULL;
+            }
+            if (y == (any)DOT) {
+               if ((y = binRead(extn)) == NULL) {
+                  drop(c1);
+                  return NULL;
+               }
+               cdr(x) = y == (any)END? data(c1) : y;
+               break;
+            }
+            x = cdr(x) = cons(y,Nil);
+         }
+         return Pop(c1);
+      }
+      return (any)(long)c;  // DOT or END
+   }
+   if ((y = rdNum(c / 4)) == NULL)
+      return NULL;
+   if ((c &= 3) == NUMBER)
+      return y;
+   if (c == TRANSIENT)
+      return consStr(y);
+   if (c == EXTERN) {
+      if (extn)
+         y = extOffs(extn, y);
+      if (x = findHash(y, h = Extern + ehash(y)))
+         return x;
+      mkExt(x = consSym(Nil,y));
+      *h = cons(x,*h);
+      return x;
+   }
+   if (x = findHash(y, h = Intern + ihash(y)))
+      return x;
+   x = consSym(Nil,y);
+   *h = cons(x,*h);
+   return x;
+}
+
+static void prDig(int t, word n) {
+   int i = 1;
+   word m = MASK;
+
+   while (n & (m <<= 8))
+      ++i;
+   putBin(i*4+t);
+   while (putBin(n), --i)
+      n >>= 8;
+}
+
+static int numByte(any s) {
+   static int i;
+   static any x;
+   static word n;
+
+   if (s)
+      i = 0,  n = unDig(x = s);
+   else if (n >>= 8,  (++i & sizeof(word)-1) == 0)
+      n = unDig(x = cdr(numCell(x)));
+   return n & 0xFF;
+}
+
+static void prNum(int t, any x) {
+   int cnt, i;
+
+   if (!isNum(cdr(numCell(x))))
+      prDig(t, unDig(x));
+   else if ((cnt = numBytes(x)) < 63) {
+      putBin(cnt*4+t);
+      putBin(numByte(x));
+      while (--cnt)
+         putBin(numByte(NULL));
+   }
+   else {
+      putBin(63*4+t);
+      putBin(numByte(x));
+      for (i = 1; i < 63; ++i)
+         putBin(numByte(NULL));
+      cnt -= 63;
+      while (cnt >= 255) {
+         putBin(255);
+         for (i = 0; i < 255; ++i)
+            putBin(numByte(NULL));
+         cnt -= 255;
+      }
+      putBin(cnt);
+      while (--cnt >= 0)
+         putBin(numByte(NULL));
+   }
+}
+
+void binPrint(int extn, any x) {
+   any y;
+
+   if (isNum(x))
+      prNum(NUMBER, x);
+   else if (isNil(x))
+      putBin(NIX);
+   else if (isSym(x)) {
+      if (!isNum(y = name(x)))
+         binPrint(extn, y);
+      else if (!isExt(x))
+         prNum(hashed(x, ihash(y), Intern)? INTERN : TRANSIENT, y);
+      else
+         prNum(EXTERN, extn? extOffs(-extn, y) : y);
+   }
+   else {
+      y = x;
+      putBin(BEG);
+      while (binPrint(extn, car(x)), !isNil(x = cdr(x))) {
+         if (x == y) {
+            putBin(DOT);
+            break;
+         }
+         if (!isCell(x)) {
+            putBin(DOT);
+            binPrint(extn, x);
+            return;
+         }
+      }
+      putBin(END);
+   }
+}
+
+void pr(int extn, any x) {putBin = putStdout,  binPrint(extn, x);}
+
+void prn(long n) {
+   putBin = putStdout;
+   prDig(NUMBER, n >= 0? n * 2 : -n * 2 + 1);
+}
+
+/* Family IPC */
+static void putTell(int c) {
+   *PipePtr++ = c;
+   if (PipePtr == PipeBuf + PIPE_BUF - 1)  // END
+      err(NULL, NULL, "Tell PIPE_BUF");
+}
+
+static void tellBeg(ptr *pb, ptr *pp, ptr buf) {
+   *pb = PipeBuf,  *pp = PipePtr;
+   PipePtr = (PipeBuf = buf) + sizeof(int);
+   *PipePtr++ = BEG;
+}
+
+static void prTell(any x) {putBin = putTell,  binPrint(0, x);}
+
+static void tellEnd(ptr *pb, ptr *pp) {
+   int i, n;
+
+   *PipePtr++ = END;
+   *(int*)PipeBuf = n = PipePtr - PipeBuf - sizeof(int);
+   if (Tell && !wrBytes(Tell, PipeBuf, n+sizeof(int)))
+      close(Tell),  Tell = 0;
+   for (i = 0; i < Children; ++i)
+      if (Child[i].pid)
+         wrChild(i, PipeBuf+sizeof(int), n);
+   PipePtr = *pp,  PipeBuf = *pb;
+}
+
+static any rdHear(void) {
+   any x;
+   inFile *iSave = InFile;
+
+   InFile = InFiles[Hear];
+   getBin = getBinary;
+   x = binRead(0);
+   InFile = iSave;
+   return x;
+}
+
+/* Return next byte from symbol name */
+int symByte(any s) {
+   static any x;
+   static word n;
+
+   if (s) {
+      if (!isNum(x = s))
+         return 0;
+      n = unDig(x);
+   }
+   else if ((n >>= 8) == 0) {
+      if (!isNum(cdr(numCell(x))))
+         return 0;
+      n = unDig(x = cdr(numCell(x)));
+   }
+   return n & 0xFF;
+}
+
+/* Return next char from symbol name */
+int symChar(any s) {
+   int c = symByte(s);
+
+   if (c == 0xFF)
+      return TOP;
+   if (c & 0x80) {
+      if ((c & 0x20) == 0)
+         c &= 0x1F;
+      else
+         c = (c & 0xF) << 6 | symByte(NULL) & 0x3F;
+      c = c << 6 | symByte(NULL) & 0x3F;
+   }
+   return c;
+}
+
+int numBytes(any x) {
+   int cnt;
+   word n, m = MASK;
+
+   for (cnt = 1;  isNum(cdr(numCell(x)));  cnt += WORD)
+      x = cdr(numCell(x));
+   for (n = unDig(x); n & (m <<= 8); ++cnt);
+   return cnt;
+}
+
+/* Buffer size */
+int bufSize(any x) {return isNum(x = name(x))? numBytes(x)+1 : 1;}
+
+int pathSize(any x) {
+   int c = firstByte(x);
+
+   if (c != '@'  &&  (c != '+' || secondByte(x) != '@'))
+      return bufSize(x);
+   if (!Home)
+      return numBytes(name(x));
+   return strlen(Home) + numBytes(name(x));
+}
+
+void bufString(any x, char *p) {
+   int c = symByte(name(x));
+
+   while (*p++ = c)
+      c = symByte(NULL);
+}
+
+void pathString(any x, char *p) {
+   int c;
+   char *h;
+
+   if ((c = symByte(name(x))) == '+')
+      *p++ = c,  c = symByte(NULL);
+   if (c != '@')
+      while (*p++ = c)
+         c = symByte(NULL);
+   else {
+      if (h = Home)
+         do
+            *p++ = *h++;
+         while (*h);
+      while (*p++ = symByte(NULL));
+   }
+}
+
+// (path 'any) -> sym
+any doPath(any x) {
+   x = evSym(cdr(x));
+   {
+      char nm[pathSize(x)];
+
+      pathString(x,nm);
+      return mkStr(nm);
+   }
+}
+
+/* Add next byte to symbol name */
+void byteSym(int c, int *i, any *p) {
+   if ((*i += 8) < BITS)
+      setDig(*p, unDig(*p) | (c & 0xFF) << *i);
+   else
+      *i = 0,  *p = cdr(numCell(*p)) = box(c & 0xFF);
+}
+
+/* Box first char of symbol name */
+any boxChar(int c, int *i, any *p) {
+   *i = 0;
+   if (c < 0x80)
+      *p = box(c);
+   else if (c < 0x800) {
+      *p = box(0xC0 | c>>6 & 0x1F);
+      byteSym(0x80 | c & 0x3F, i, p);
+   }
+   else if (c == TOP)
+      *p = box(0xFF);
+   else {
+      *p = box(0xE0 | c>>12 & 0x0F);
+      byteSym(0x80 | c>>6 & 0x3F, i, p);
+      byteSym(0x80 | c & 0x3F, i, p);
+   }
+   return *p;
+}
+
+/* Add next char to symbol name */
+void charSym(int c, int *i, any *p) {
+   if (c < 0x80)
+      byteSym(c, i, p);
+   else if (c < 0x800) {
+      byteSym(0xC0 | c>>6 & 0x1F, i, p);
+      byteSym(0x80 | c & 0x3F, i, p);
+   }
+   else if (c == TOP)
+      byteSym(0xFF, i, p);
+   else {
+      byteSym(0xE0 | c>>12 & 0x0F, i, p);
+      byteSym(0x80 | c>>6 & 0x3F, i, p);
+      byteSym(0x80 | c & 0x3F, i, p);
+   }
+}
+
+static int currFd(any ex, char *p) {
+   if (!Env.inFrames && !Env.outFrames)
+      err(ex, NULL, "No current fd");
+   if (!Env.inFrames)
+      return OutFile->fd;
+   if (!Env.outFrames)
+      return InFile->fd;
+   return labs((char*)Env.outFrames - p) > labs((char*)Env.inFrames - p)?
+      InFile->fd : OutFile->fd;
+}
+
+void rdOpen(any ex, any x, inFrame *f) {
+   if (isNil(x))
+      f->pid = 0,  f->fd = STDIN_FILENO;
+   else if (isNum(x)) {
+      int n = (int)unBox(x);
+
+      if (n < 0) {
+         inFrame *g = Env.inFrames;
+
+         for (;;) {
+            if (!(g = g->link))
+               badFd(ex,x);
+            if (!++n) {
+               n = g->fd;
+               break;
+            }
+         }
+      }
+      f->pid = 0,  f->fd = n;
+      if (n >= InFDs || !InFiles[n])
+         badFd(ex,x);
+   }
+   else if (isSym(x)) {
+      char nm[pathSize(x)];
+
+      f->pid = 1;
+      pathString(x,nm);
+      if (nm[0] == '+') {
+         while ((f->fd = open(nm+1, O_APPEND|O_CREAT|O_RDWR, 0666)) < 0) {
+            if (errno != EINTR)
+               openErr(ex, nm);
+            if (Signal)
+               sighandler(ex);
+         }
+         initInFile(f->fd, strdup(nm+1));
+      }
+      else {
+         while ((f->fd = open(nm, O_RDONLY)) < 0) {
+            if (errno != EINTR)
+               openErr(ex, nm);
+            if (Signal)
+               sighandler(ex);
+         }
+         initInFile(f->fd, strdup(nm));
+      }
+      closeOnExec(ex, f->fd);
+   }
+   else {
+      any y;
+      int i, pfd[2], ac = length(x);
+      char *av[ac+1];
+
+      if (pipe(pfd) < 0)
+         pipeError(ex, "read open");
+      closeOnExec(ex, pfd[0]), closeOnExec(ex, pfd[1]);
+      av[0] = alloc(NULL, pathSize(y = xSym(car(x)))),  pathString(y, av[0]);
+      for (i = 1; isCell(x = cdr(x)); ++i)
+         av[i] = alloc(NULL, bufSize(y = xSym(car(x)))),  bufString(y, av[i]);
+      av[ac] = NULL;
+      if ((f->pid = fork()) == 0) {
+         setpgid(0,0);
+         close(pfd[0]);
+         if (pfd[1] != STDOUT_FILENO)
+            dup2(pfd[1], STDOUT_FILENO),  close(pfd[1]);
+         execvp(av[0], av);
+         execError(av[0]);
+      }
+      i = 0;  do
+         free(av[i]);
+      while (++i < ac);
+      if (f->pid < 0)
+         err(ex, NULL, "fork");
+      setpgid(f->pid,0);
+      close(pfd[1]);
+      initInFile(f->fd = pfd[0], NULL);
+   }
+}
+
+void wrOpen(any ex, any x, outFrame *f) {
+   if (isNil(x))
+      f->pid = 0,  f->fd = STDOUT_FILENO;
+   else if (isNum(x)) {
+      int n = (int)unBox(x);
+
+      if (n < 0) {
+         outFrame *g = Env.outFrames;
+
+         for (;;) {
+            if (!(g = g->link))
+               badFd(ex,x);
+            if (!++n) {
+               n = g->fd;
+               break;
+            }
+         }
+      }
+      f->pid = 0,  f->fd = n;
+      if (n >= OutFDs || !OutFiles[n])
+         badFd(ex,x);
+   }
+   else if (isSym(x)) {
+      char nm[pathSize(x)];
+
+      f->pid = 1;
+      pathString(x,nm);
+      if (nm[0] == '+') {
+         while ((f->fd = open(nm+1, O_APPEND|O_CREAT|O_WRONLY, 0666)) < 0) {
+            if (errno != EINTR)
+               openErr(ex, nm);
+            if (Signal)
+               sighandler(ex);
+         }
+      }
+      else {
+         while ((f->fd = open(nm, O_CREAT|O_TRUNC|O_WRONLY, 0666)) < 0) {
+            if (errno != EINTR)
+               openErr(ex, nm);
+            if (Signal)
+               sighandler(ex);
+         }
+      }
+      closeOnExec(ex, f->fd);
+      initOutFile(f->fd);
+   }
+   else {
+      any y;
+      int i, pfd[2], ac = length(x);
+      char *av[ac+1];
+
+      if (pipe(pfd) < 0)
+         pipeError(ex, "write open");
+      closeOnExec(ex, pfd[0]), closeOnExec(ex, pfd[1]);
+      av[0] = alloc(NULL, pathSize(y = xSym(car(x)))),  pathString(y, av[0]);
+      for (i = 1; isCell(x = cdr(x)); ++i)
+         av[i] = alloc(NULL, bufSize(y = xSym(car(x)))),  bufString(y, av[i]);
+      av[ac] = NULL;
+      if ((f->pid = fork()) == 0) {
+         setpgid(0,0);
+         close(pfd[1]);
+         if (pfd[0] != STDIN_FILENO)
+            dup2(pfd[0], STDIN_FILENO),  close(pfd[0]);
+         execvp(av[0], av);
+         execError(av[0]);
+      }
+      i = 0;  do
+         free(av[i]);
+      while (++i < ac);
+      if (f->pid < 0)
+         err(ex, NULL, "fork");
+      setpgid(f->pid,0);
+      close(pfd[0]);
+      initOutFile(f->fd = pfd[1]);
+   }
+}
+
+void ctOpen(any ex, any x, ctlFrame *f) {
+   NeedSym(ex,x);
+   if (isNil(x)) {
+      f->fd = -1;
+      lockFile(currFd(ex, (char*)f), F_SETLKW, F_RDLCK);
+   }
+   else if (x == T) {
+      f->fd = -1;
+      lockFile(currFd(ex, (char*)f), F_SETLKW, F_WRLCK);
+   }
+   else {
+      char nm[pathSize(x)];
+
+      pathString(x,nm);
+      if (nm[0] == '+') {
+         while ((f->fd = open(nm+1, O_CREAT|O_RDWR, 0666)) < 0) {
+            if (errno != EINTR)
+               openErr(ex, nm);
+            if (Signal)
+               sighandler(ex);
+         }
+         lockFile(f->fd, F_SETLKW, F_RDLCK);
+      }
+      else {
+         while ((f->fd = open(nm, O_CREAT|O_RDWR, 0666)) < 0) {
+            if (errno != EINTR)
+               openErr(ex, nm);
+            if (Signal)
+               sighandler(ex);
+         }
+         lockFile(f->fd, F_SETLKW, F_WRLCK);
+      }
+      closeOnExec(ex, f->fd);
+   }
+}
+
+/*** Reading ***/
+void getStdin(void) {
+   if (!InFile)
+      Chr = -1;
+   else if (InFile != InFiles[STDIN_FILENO]) {
+      if (InFile->ix == InFile->cnt  &&  !slow(InFile,NO)) {
+         Chr = -1;
+         return;
+      }
+      if ((Chr = InFile->buf[InFile->ix++]) == '\n')
+         ++InFile->line;
+   }
+   else if (!isCell(val(Led))) {
+      waitFd(NULL, STDIN_FILENO, -1);
+      Chr = stdinByte();
+   }
+   else {
+      static word dig;
+
+      if (!isNum(Line))
+         dig = isNum(Line = name(run(val(Led))))? unDig(Line) : '\n';
+      else if ((dig >>= 8) == 0)
+         dig = isNum(Line = cdr(numCell(Line)))? unDig(Line) : '\n';
+      Chr = dig & 0xFF;
+   }
+}
+
+static void getParse(void) {
+   if ((Chr = Env.parser->dig & 0xFF) == 0xFF)
+      Chr = -1;
+   else if ((Env.parser->dig >>= 8) == 0) {
+      Env.parser->dig =
+         isNum(Env.parser->name = cdr(numCell(Env.parser->name))) ?
+            unDig(Env.parser->name) : Env.parser->eof;
+   }
+}
+
+void pushInFiles(inFrame *f) {
+   if (InFile)
+      InFile->next = Chr;
+   Chr = (InFile = InFiles[f->fd])? InFile->next : -1;
+   f->get = Env.get,  Env.get = getStdin;
+   f->link = Env.inFrames,  Env.inFrames = f;
+}
+
+void pushOutFiles(outFrame *f) {
+   OutFile = OutFiles[f->fd];
+   f->put = Env.put,  Env.put = putStdout;
+   f->link = Env.outFrames,  Env.outFrames = f;
+}
+
+void pushCtlFiles(ctlFrame *f) {
+   f->link = Env.ctlFrames,  Env.ctlFrames = f;
+}
+
+void popInFiles(void) {
+   if (Env.inFrames->pid) {
+      close(Env.inFrames->fd),  closeInFile(Env.inFrames->fd);
+      if (Env.inFrames->pid > 1)
+         while (waitpid(Env.inFrames->pid, NULL, 0) < 0) {
+            if (errno != EINTR)
+               closeErr();
+            if (Signal)
+               sighandler(NULL);
+         }
+   }
+   Env.get = Env.inFrames->get;
+   Chr =
+      (InFile = InFiles[(Env.inFrames = Env.inFrames->link)? Env.inFrames->fd : STDIN_FILENO])?
+         InFile->next : -1;
+}
+
+void popOutFiles(void) {
+   flush(OutFile);
+   if (Env.outFrames->pid) {
+      close(Env.outFrames->fd),  closeOutFile(Env.outFrames->fd);
+      if (Env.outFrames->pid > 1)
+         while (waitpid(Env.outFrames->pid, NULL, 0) < 0) {
+            if (errno != EINTR)
+               closeErr();
+            if (Signal)
+               sighandler(NULL);
+         }
+   }
+   Env.put = Env.outFrames->put;
+   OutFile = OutFiles[(Env.outFrames = Env.outFrames->link)? Env.outFrames->fd : STDOUT_FILENO];
+}
+
+void popCtlFiles(void) {
+   if (Env.ctlFrames->fd >= 0)
+      close(Env.ctlFrames->fd);
+   else
+      lockFile(currFd(NULL, (char*)Env.ctlFrames), F_SETLK, F_UNLCK);
+   Env.ctlFrames = Env.ctlFrames->link;
+}
+
+/* Get full char from input channel */
+int getChar(void) {
+   int c;
+
+   if ((c = Chr) == 0xFF)
+      return TOP;
+   if (c & 0x80) {
+      Env.get();
+      if ((c & 0x20) == 0)
+         c &= 0x1F;
+      else
+         c = (c & 0xF) << 6 | Chr & 0x3F,  Env.get();
+      if (Chr < 0)
+         eofErr();
+      c = c << 6 | Chr & 0x3F;
+   }
+   return c;
+}
+
+/* Skip White Space and Comments */
+static int skip(int c) {
+   for (;;) {
+      if (Chr < 0)
+         return Chr;
+      while (Chr <= ' ') {
+         Env.get();
+         if (Chr < 0)
+            return Chr;
+      }
+      if (Chr != c)
+         return Chr;
+      Env.get();
+      if (c != '#' || Chr != '{') {
+         while (Chr != '\n') {
+            if (Chr < 0)
+               return Chr;
+            Env.get();
+         }
+      }
+      else {
+         for (;;) {  // #{block-comment}# from Kriangkrai Soatthiyanont
+            Env.get();
+            if (Chr < 0)
+               return Chr;
+            if (Chr == '}' && (Env.get(), Chr == '#'))
+               break;
+         }
+      }
+      Env.get();
+   }
+}
+
+/* Test for escaped characters */
+static bool testEsc(void) {
+   for (;;) {
+      if (Chr < 0)
+         return NO;
+      if (Chr == '^') {
+         Env.get();
+         if (Chr == '?')
+            Chr = 127;
+         else
+            Chr &= 0x1F;
+         return YES;
+      }
+      if (Chr != '\\')
+         return YES;
+      if (Env.get(), Chr != '\n')
+         return YES;
+      do
+         Env.get();
+      while (Chr == ' '  ||  Chr == '\t');
+   }
+}
+
+/* Try for anonymous symbol */
+static any anonymous(any s) {
+   unsigned c;
+   unsigned long n;
+   heap *h;
+
+   if ((c = symByte(s)) != '$')
+      return NULL;
+   n = 0;
+   while (c = symByte(NULL)) {
+      if (c < '0' || c > '9')
+         return NULL;
+      n = n * 10 + c - '0';
+   }
+   n *= sizeof(cell);
+   h = Heaps;
+   do
+      if ((any)n >= h->cells  &&  (any)n < h->cells + CELLS)
+         return symPtr((any)n);
+   while (h = h->next);
+   return NULL;
+}
+
+/* Read an atom */
+static any rdAtom(int c) {
+   int i;
+   any x, y, *h;
+   cell c1;
+
+   i = 0,  Push(c1, y = box(c));
+   while (Chr > 0 && !strchr(Delim, Chr)) {
+      if (Chr == '\\')
+         Env.get();
+      byteSym(Chr, &i, &y);
+      Env.get();
+   }
+   y = Pop(c1);
+   if (unDig(y) == ('L'<<16 | 'I'<<8 | 'N'))
+      return Nil;
+   if (x = symToNum(y, (int)unDig(val(Scl)) / 2, '.', 0))
+      return x;
+   if (x = anonymous(y))
+      return x;
+   if (x = findHash(y, h = Intern + ihash(y)))
+      return x;
+   x = consSym(Nil,y);
+   *h = cons(x,*h);
+   return x;
+}
+
+/* Read a list */
+static any rdList(void) {
+   any x;
+   cell c1;
+
+   Env.get();
+   for (;;) {
+      if (skip('#') == ')') {
+         Env.get();
+         return Nil;
+      }
+      if (Chr == ']')
+         return Nil;
+      if (Chr != '~') {
+         Push(c1, x = cons(read0(NO),Nil));
+         break;
+      }
+      Env.get();
+      Push(c1, read0(NO));
+      if (isCell(x = data(c1) = EVAL(data(c1)))) {
+         while (isCell(cdr(x)))
+            x = cdr(x);
+         break;
+      }
+      drop(c1);
+   }
+   for (;;) {
+      if (skip('#') == ')') {
+         Env.get();
+         break;
+      }
+      if (Chr == ']')
+         break;
+      if (Chr == '.') {
+         Env.get();
+         if (strchr(Delim, Chr)) {
+            cdr(x) = skip('#')==')' || Chr==']'? data(c1) : read0(NO);
+            if (skip('#') == ')')
+               Env.get();
+            else if (Chr != ']')
+               err(NULL, x, "Bad dotted pair");
+            break;
+         }
+         x = cdr(x) = cons(rdAtom('.'), Nil);
+      }
+      else if (Chr != '~')
+         x = cdr(x) = cons(read0(NO), Nil);
+      else {
+         Env.get();
+         cdr(x) = read0(NO);
+         cdr(x) = EVAL(cdr(x));
+         while (isCell(cdr(x)))
+            x = cdr(x);
+      }
+   }
+   return Pop(c1);
+}
+
+/* Read one expression */
+static any read0(bool top) {
+   int i;
+   any x, y, *h;
+   cell c1;
+
+   if (skip('#') < 0) {
+      if (top)
+         return Nil;
+      eofErr();
+   }
+   if (top && InFile)
+      InFile->src = InFile->line;
+   if (Chr == '(') {
+      x = rdList();
+      if (top  &&  Chr == ']')
+         Env.get();
+      return x;
+   }
+   if (Chr == '[') {
+      x = rdList();
+      if (Chr != ']')
+         err(NULL, x, "Super parentheses mismatch");
+      Env.get();
+      return x;
+   }
+   if (Chr == '\'') {
+      Env.get();
+      return cons(Quote, read0(NO));
+   }
+   if (Chr == ',') {
+      Env.get();
+      Push(c1, x = read0(NO));
+      if (isCell(y = idx(Uni, data(c1), 1)))
+         x = car(y);
+      drop(c1);
+      return x;
+   }
+   if (Chr == '`') {
+      Env.get();
+      Push(c1, read0(NO));
+      x = EVAL(data(c1));
+      drop(c1);
+      return x;
+   }
+   if (Chr == '"') {
+      Env.get();
+      if (Chr == '"') {
+         Env.get();
+         return Nil;
+      }
+      if (!testEsc())
+         eofErr();
+      i = 0,  Push(c1, y = box(Chr));
+      while (Env.get(), Chr != '"') {
+         if (!testEsc())
+            eofErr();
+         byteSym(Chr, &i, &y);
+      }
+      y = Pop(c1),  Env.get();
+      if (x = findHash(y, h = Transient + ihash(y)))
+         return x;
+      x = consStr(y);
+      if (Env.get == getStdin)
+         *h = cons(x,*h);
+      return x;
+   }
+   if (Chr == '{') {
+      Env.get();
+      if (Chr == '}') {
+         Env.get();
+         return consSym(Nil,Nil);
+      }
+      i = 0,  Push(c1, y = box(Chr));
+      while (Env.get(), Chr != '}') {
+         if (Chr < 0)
+            eofErr();
+         byteSym(Chr, &i, &y);
+      }
+      y = Pop(c1),  Env.get();
+      if (x = findHash(y, h = Extern + ehash(y)))
+         return x;
+      mkExt(x = consSym(Nil,y));
+      *h = cons(x,*h);
+      return x;
+   }
+   if (Chr == ')' || Chr == ']' || Chr == '~')
+      err(NULL, NULL, "Bad input '%c' (%d)", isprint(Chr)? Chr:'?', Chr);
+   if (Chr == '\\')
+      Env.get();
+   i = Chr;
+   Env.get();
+   return rdAtom(i);
+}
+
+any read1(int end) {
+   any x;
+
+   if (!Chr)
+      Env.get();
+   if (Chr == end)
+      return Nil;
+   x = read0(YES);
+   while (Chr > 0  &&  strchr(" \t)]", Chr))
+      Env.get();
+   return x;
+}
+
+/* Read one token */
+any token(any x, int c) {
+   int i;
+   any y, *h;
+   cell c1;
+
+   if (!Chr)
+      Env.get();
+   if (skip(c) < 0)
+      return NULL;
+   if (Chr == '"') {
+      Env.get();
+      if (Chr == '"') {
+         Env.get();
+         return Nil;
+      }
+      if (!testEsc())
+         return Nil;
+      i = 0,  Push(c1, y = box(Chr));
+      while (Env.get(), Chr != '"' && testEsc())
+         byteSym(Chr, &i, &y);
+      Env.get();
+      return consStr(y = Pop(c1));
+   }
+   if (Chr >= '0' && Chr <= '9') {
+      i = 0,  Push(c1, y = box(Chr));
+      while (Env.get(), Chr >= '0' && Chr <= '9' || Chr == '.')
+         byteSym(Chr, &i, &y);
+      return symToNum(Pop(c1), (int)unDig(val(Scl)) / 2, '.', 0);
+   }
+   {
+      char nm[bufSize(x)];
+
+      bufString(x, nm);
+      if (Chr >= 'A' && Chr <= 'Z' || Chr == '\\' || Chr >= 'a' && Chr <= 'z' || strchr(nm,Chr)) {
+         if (Chr == '\\')
+            Env.get();
+         i = 0,  Push(c1, y = box(Chr));
+         while (Env.get(),
+               Chr >= '0' && Chr <= '9' || Chr >= 'A' && Chr <= 'Z' ||
+               Chr == '\\' || Chr >= 'a' && Chr <= 'z' || strchr(nm,Chr) ) {
+            if (Chr == '\\')
+               Env.get();
+            byteSym(Chr, &i, &y);
+         }
+         y = Pop(c1);
+         if (x = findHash(y, h = Intern + ihash(y)))
+            return x;
+         x = consSym(Nil,y);
+         *h = cons(x,*h);
+         return x;
+      }
+   }
+   c = getChar();
+   Env.get();
+   return mkChar(c);
+}
+
+// (read ['sym1 ['sym2]]) -> any
+any doRead(any ex) {
+   any x;
+
+   if (!isCell(x = cdr(ex)))
+      x = read1(0);
+   else {
+      cell c1;
+
+      Push(c1, EVAL(car(x)));
+      NeedSym(ex, data(c1));
+      x = cdr(x),  x = EVAL(car(x));
+      NeedSym(ex,x);
+      x = token(data(c1), symChar(name(x))) ?: Nil;
+      drop(c1);
+   }
+   if (InFile == InFiles[STDIN_FILENO]  &&  Chr == '\n')
+      Chr = 0;
+   return x;
+}
+
+static inline bool inReady(inFile *p) {
+   return p->ix < p->cnt;
+}
+
+static bool isSet(int fd, fd_set *fds) {
+   inFile *p;
+
+   if (fd >= InFDs || !(p = InFiles[fd]))
+      return FD_ISSET(fd, fds);
+   if (inReady(p))
+      return YES;
+   return FD_ISSET(fd, fds) && slow(p,YES) >= 0;
+}
+
+long waitFd(any ex, int fd, long ms) {
+   any x, taskSave;
+   cell c1, c2, c3;
+   int i, j, m, n;
+   long t;
+   bool flg;
+   fd_set rdSet, wrSet;
+   struct timeval *tp, tv;
+#ifndef __linux__
+   struct timeval tt;
+#endif
+
+   taskSave = Env.task;
+   Push(c1, val(At));
+   Save(c2);
+   do {
+      if (ms >= 0)
+         t = ms,  tp = &tv;
+      else
+         t = LONG_MAX,  tp = NULL;
+      FD_ZERO(&rdSet);
+      FD_ZERO(&wrSet);
+      m = 0;
+      if (fd >= 0) {
+         if (fd < InFDs  &&  InFiles[fd]  &&  inReady(InFiles[fd]))
+            tp = &tv,  t = 0;
+         else
+            FD_SET(m = fd, &rdSet);
+      }
+      for (x = data(c2) = Env.task = val(Run); isCell(x); x = cdr(x)) {
+         if (!memq(car(x), taskSave)) {
+            if (isNeg(caar(x))) {
+               if ((n = (int)unDig(cadar(x)) / 2) < t)
+                  tp = &tv,  t = n;
+            }
+            else if ((n = (int)unDig(caar(x)) / 2) != fd) {
+               if (n < InFDs  &&  InFiles[n]  &&  inReady(InFiles[n]))
+                  tp = &tv,  t = 0;
+               else {
+                  FD_SET(n, &rdSet);
+                  if (n > m)
+                     m = n;
+               }
+            }
+         }
+      }
+      if (Hear  &&  Hear != fd  &&  InFiles[Hear]) {
+         if (inReady(InFiles[Hear]))
+            tp = &tv,  t = 0;
+         else {
+            FD_SET(Hear, &rdSet);
+            if (Hear > m)
+               m = Hear;
+         }
+      }
+      if (Spkr) {
+         FD_SET(Spkr, &rdSet);
+         if (Spkr > m)
+            m = Spkr;
+      }
+      for (i = 0; i < Children; ++i) {
+         if (Child[i].pid) {
+            FD_SET(Child[i].hear, &rdSet);
+            if (Child[i].hear > m)
+               m = Child[i].hear;
+            if (Child[i].cnt) {
+               FD_SET(Child[i].tell, &wrSet);
+               if (Child[i].tell > m)
+                  m = Child[i].tell;
+            }
+         }
+      }
+      if (tp) {
+         tv.tv_sec = t / 1000;
+         tv.tv_usec = t % 1000 * 1000;
+#ifndef __linux__
+         gettimeofday(&tt,NULL);
+         t = tt.tv_sec*1000 + tt.tv_usec/1000;
+#endif
+      }
+      while (select(m+1, &rdSet, &wrSet, NULL, tp) < 0) {
+         if (errno != EINTR) {
+            val(Run) = Nil;
+            selectErr(ex);
+         }
+         if (Signal)
+            sighandler(ex);
+      }
+      if (tp) {
+#ifdef __linux__
+         t -= tv.tv_sec*1000 + tv.tv_usec/1000;
+#else
+         gettimeofday(&tt,NULL);
+         t = tt.tv_sec*1000 + tt.tv_usec/1000 - t;
+#endif
+         if (ms > 0  &&  (ms -= t) < 0)
+            ms = 0;
+      }
+      for (flg = NO, i = 0; i < Children; ++i) {
+         if (Child[i].pid) {
+            if (FD_ISSET(Child[i].hear, &rdSet)) {
+               if ((m = rdBytes(Child[i].hear, (byte*)&n, sizeof(int), YES)) >= 0) {
+                  byte buf[PIPE_BUF - sizeof(int)];
+
+                  if (m  &&  rdBytes(Child[i].hear, buf, n, NO)) {
+                     for (flg = YES, j = 0; j < Children; ++j)
+                        if (j != i  &&  Child[j].pid)
+                           wrChild(j, buf, n);
+                  }
+                  else {
+                     Child[i].pid = 0;
+                     close(Child[i].hear),  close(Child[i].tell);
+                     free(Child[i].buf);
+                     continue;
+                  }
+               }
+            }
+            if (FD_ISSET(Child[i].tell, &wrSet)) {
+               n = *(int*)(Child[i].buf + Child[i].ofs);
+               if (wrBytes(Child[i].tell, Child[i].buf + Child[i].ofs + sizeof(int), n)) {
+                  Child[i].ofs += sizeof(int) + n;
+                  if (2 * Child[i].ofs >= Child[i].cnt) {
+                     if (Child[i].cnt -= Child[i].ofs) {
+                        memcpy(Child[i].buf, Child[i].buf + Child[i].ofs, Child[i].cnt);
+                        Child[i].buf = alloc(Child[i].buf, Child[i].cnt);
+                     }
+                     Child[i].ofs = 0;
+                  }
+               }
+               else {
+                  Child[i].pid = 0;
+                  close(Child[i].hear),  close(Child[i].tell);
+                  free(Child[i].buf);
+               }
+            }
+         }
+      }
+      if (!flg  &&  Spkr  &&  FD_ISSET(Spkr,&rdSet)  &&
+            rdBytes(Spkr, (byte*)&m, sizeof(int), YES) > 0  &&  Child[m].pid )
+         wrChild(m, TBuf, sizeof(TBuf));
+      if (Hear && Hear != fd && isSet(Hear, &rdSet)) {
+         if ((data(c3) = rdHear()) == NULL)
+            close(Hear),  closeInFile(Hear),  closeOutFile(Hear),  Hear = 0;
+         else if (data(c3) == T)
+            Sync = YES;
+         else {
+            Save(c3);
+            evList(data(c3));
+            drop(c3);
+         }
+      }
+      for (x = data(c2); isCell(x); x = cdr(x)) {
+         if (!memq(car(x), taskSave)) {
+            if (isNeg(caar(x))) {
+               if ((n = (int)(unDig(cadar(x)) / 2 - t)) > 0)
+                  setDig(cadar(x), (long)2*n);
+               else {
+                  setDig(cadar(x), unDig(caar(x)));
+                  val(At) = caar(x);
+                  prog(cddar(x));
+               }
+            }
+            else if ((n = (int)unDig(caar(x)) / 2) != fd) {
+               if (isSet(n, &rdSet)) {
+                  val(At) = caar(x);
+                  prog(cdar(x));
+               }
+            }
+         }
+      }
+      if (Signal)
+         sighandler(ex);
+   } while (ms  &&  fd >= 0 && !isSet(fd, &rdSet));
+   Env.task = taskSave;
+   val(At) = Pop(c1);
+   return ms;
+}
+
+// (wait ['cnt] . prg) -> any
+any doWait(any ex) {
+   any x, y;
+   long ms;
+
+   x = cdr(ex);
+   ms = isNil(y = EVAL(car(x)))? -1 : xCnt(ex,y);
+   x = cdr(x);
+   while (isNil(y = prog(x)))
+      if (!(ms = waitFd(ex, -1, ms)))
+         return prog(x);
+   return y;
+}
+
+// (sync) -> flg
+any doSync(any ex) {
+   byte *p;
+   int n, cnt;
+
+   if (!Mic || !Hear)
+      return Nil;
+   p = (byte*)&Slot;
+   cnt = sizeof(int);
+   do {
+      if ((n = write(Mic, p, cnt)) >= 0)
+         p += n, cnt -= n;
+      else if (errno != EINTR)
+         writeErr("sync");
+      if (Signal)
+         sighandler(ex);
+   } while (cnt);
+   Sync = NO;
+   do
+      waitFd(ex, -1, -1);
+   while (!Sync);
+   return T;
+}
+
+// (hear 'cnt) -> cnt
+any doHear(any ex) {
+   any x;
+   int fd;
+
+   x = cdr(ex),  x = EVAL(car(x));
+   if ((fd = (int)xCnt(ex,x)) < 0 || fd >= InFDs || !InFiles[fd])
+      badFd(ex,x);
+   if (Hear)
+      close(Hear),  closeInFile(Hear),  closeOutFile(Hear);
+   Hear = fd;
+   return x;
+}
+
+// (tell 'sym ['any ..]) -> any
+any doTell(any x) {
+   any y;
+   ptr pbSave, ppSave;
+   byte buf[PIPE_BUF];
+
+   if (!Tell && !Children)
+      return Nil;
+   tellBeg(&pbSave, &ppSave, buf);
+   do
+      x = cdr(x),  prTell(y = EVAL(car(x)));
+   while (isCell(cdr(x)));
+   tellEnd(&pbSave, &ppSave);
+   return y;
+}
+
+// (poll 'cnt) -> cnt | NIL
+any doPoll(any ex) {
+   any x;
+   int fd;
+   inFile *p;
+   fd_set fdSet;
+   struct timeval tv;
+
+   x = cdr(ex),  x = EVAL(car(x));
+   if ((fd = (int)xCnt(ex,x)) < 0  ||  fd >= InFDs)
+      badFd(ex,x);
+   if (!(p = InFiles[fd]))
+      return Nil;
+   do {
+      if (inReady(p))
+         return x;
+      FD_ZERO(&fdSet);
+      FD_SET(fd, &fdSet);
+      tv.tv_sec = tv.tv_usec = 0;
+      while (select(fd+1, &fdSet, NULL, NULL, &tv) < 0)
+         if (errno != EINTR)
+            selectErr(ex);
+      if (!FD_ISSET(fd, &fdSet))
+         return Nil;
+   } while (slow(p,YES) < 0);
+   return x;
+}
+
+// (key ['cnt]) -> sym
+any doKey(any ex) {
+   any x;
+   int c, d, e;
+
+   flushAll();
+   setRaw();
+   x = cdr(ex);
+   if (!waitFd(ex, STDIN_FILENO, isNil(x = EVAL(car(x)))? -1 : xCnt(ex,x)))
+      return Nil;
+   if ((c = stdinByte()) < 0)
+      return Nil;
+   if (c == 0xFF)
+      c = TOP;
+   else if (c & 0x80) {
+      if ((d = stdinByte()) < 0)
+         return Nil;
+      if ((c & 0x20) == 0)
+         c = (c & 0x1F) << 6 | d & 0x3F;
+      else {
+         if ((e = stdinByte()) < 0)
+            return Nil;
+         c = ((c & 0xF) << 6 | d & 0x3F) << 6 | e & 0x3F;
+      }
+   }
+   return mkChar(c);
+}
+
+// (peek) -> sym
+any doPeek(any ex __attribute__((unused))) {
+   if (!Chr)
+      Env.get();
+   return Chr<0? Nil : mkChar(Chr);
+}
+
+// (char) -> sym
+// (char 'cnt) -> sym
+// (char T) -> sym
+// (char 'sym) -> cnt
+any doChar(any ex) {
+   any x = cdr(ex);
+   if (!isCell(x)) {
+      if (!Chr)
+         Env.get();
+      x = Chr<0? Nil : mkChar(getChar());
+      Env.get();
+      return x;
+   }
+   if (isNum(x = EVAL(car(x))))
+      return IsZero(x)? Nil : mkChar(unDig(x) / 2);
+   if (isSym(x))
+      return x == T? mkChar(TOP) : boxCnt(symChar(name(x)));
+   atomError(ex,x);
+}
+
+// (skip ['any]) -> sym
+any doSkip(any x) {
+   x = evSym(cdr(x));
+   return skip(symChar(name(x)))<0? Nil : mkChar(Chr);
+}
+
+// (eol) -> flg
+any doEol(any ex __attribute__((unused))) {
+   return Chr=='\n' || Chr<=0? T : Nil;
+}
+
+// (eof ['flg]) -> flg
+any doEof(any x) {
+   x = cdr(x);
+   if (!isNil(EVAL(car(x)))) {
+      Chr = -1;
+      return T;
+   }
+   if (!Chr)
+      Env.get();
+   return Chr < 0? T : Nil;
+}
+
+// (from 'any ..) -> sym
+any doFrom(any x) {
+   int i, j, ac = length(x = cdr(x)), p[ac];
+   cell c[ac];
+   char *av[ac];
+
+   if (ac == 0)
+      return Nil;
+   for (i = 0;;) {
+      Push(c[i], evSym(x));
+      av[i] = alloc(NULL, bufSize(data(c[i]))),  bufString(data(c[i]), av[i]);
+      p[i] = 0;
+      if (++i == ac)
+         break;
+      x = cdr(x);
+   }
+   if (!Chr)
+      Env.get();
+   while (Chr >= 0) {
+      for (i = 0; i < ac; ++i) {
+         for (;;) {
+            if (av[i][p[i]] == (byte)Chr) {
+               if (av[i][++p[i]])
+                  break;
+               Env.get();
+               x = data(c[i]);
+               goto done;
+            }
+            if (!p[i])
+               break;
+            for (j = 1; --p[i]; ++j)
+               if (memcmp(av[i], av[i]+j, p[i]) == 0)
+                  break;
+         }
+      }
+      Env.get();
+   }
+   x = Nil;
+done:
+   i = 0;  do
+      free(av[i]);
+   while (++i < ac);
+   drop(c[0]);
+   return x;
+}
+
+// (till 'any ['flg]) -> lst|sym
+any doTill(any ex) {
+   any x;
+   int i;
+   cell c1;
+
+   x = evSym(cdr(ex));
+   {
+      char buf[bufSize(x)];
+
+      bufString(x, buf);
+      if (!Chr)
+         Env.get();
+      if (Chr < 0 || strchr(buf,Chr))
+         return Nil;
+      x = cddr(ex);
+      if (isNil(EVAL(car(x)))) {
+         Push(c1, x = cons(mkChar(getChar()), Nil));
+         while (Env.get(), Chr > 0 && !strchr(buf,Chr))
+            x = cdr(x) = cons(mkChar(getChar()), Nil);
+         return Pop(c1);
+      }
+      Push(c1, boxChar(getChar(), &i, &x));
+      while (Env.get(), Chr > 0 && !strchr(buf,Chr))
+         charSym(getChar(), &i, &x);
+      return consStr(Pop(c1));
+   }
+}
+
+bool eol(void) {
+   if (Chr < 0)
+      return YES;
+   if (Chr == '\n') {
+      Chr = 0;
+      return YES;
+   }
+   if (Chr == '\r') {
+      Env.get();
+      if (Chr == '\n')
+         Chr = 0;
+      return YES;
+   }
+   return NO;
+}
+
+// (line 'flg ['cnt ..]) -> lst|sym
+any doLine(any ex) {
+   any x, y, z;
+   bool pack;
+   int i, n;
+   cell c1;
+
+   if (!Chr)
+      Env.get();
+   if (eol())
+      return Nil;
+   x = cdr(ex);
+   if (pack = !isNil(EVAL(car(x))))
+      Push(c1, boxChar(getChar(), &i, &z));
+   else
+      Push(c1, cons(mkChar(getChar()), Nil));
+   if (!isCell(x = cdr(x)))
+      y = data(c1);
+   else {
+      if (!pack)
+         z = data(c1);
+      data(c1) = y = cons(data(c1), Nil);
+      for (;;) {
+         n = (int)evCnt(ex,x);
+         while (--n) {
+            if (Env.get(), eol()) {
+               if (pack)
+                  car(y) = consStr(car(y));
+               return Pop(c1);
+            }
+            if (pack)
+               charSym(getChar(), &i, &z);
+            else
+               z = cdr(z) = cons(mkChar(getChar()), Nil);
+         }
+         if (pack)
+            car(y) = consStr(car(y));
+         if (!isCell(x = cdr(x))) {
+            pack = NO;
+            break;
+         }
+         if (Env.get(), eol())
+            return Pop(c1);
+         y = cdr(y) = cons(
+            pack? boxChar(getChar(), &i, &z) : (z = cons(mkChar(getChar()), Nil)),
+            Nil );
+      }
+   }
+   for (;;) {
+      if (Env.get(), eol())
+         return pack? consStr(Pop(c1)) : Pop(c1);
+      if (pack)
+         charSym(getChar(), &i, &z);
+      else
+         y = cdr(y) = cons(mkChar(getChar()), Nil);
+   }
+}
+
+// (lines 'any ..) -> cnt
+any doLines(any x) {
+   any y;
+   int c, cnt = 0;
+   bool flg = NO;
+   FILE *fp;
+
+   for (x = cdr(x); isCell(x); x = cdr(x)) {
+      y = evSym(x);
+      {
+         char nm[pathSize(y)];
+
+         pathString(y, nm);
+         if (fp = fopen(nm, "r")) {
+            flg = YES;
+            while ((c = getc_unlocked(fp)) >= 0)
+               if (c == '\n')
+                  ++cnt;
+            fclose(fp);
+         }
+      }
+   }
+   return flg? boxCnt(cnt) : Nil;
+}
+
+static any parse(any x, bool skp, any s) {
+   int c;
+   parseFrame *save, parser;
+   void (*getSave)(void);
+   cell c1;
+
+   save = Env.parser;
+   Env.parser = &parser;
+   parser.dig = unDig(parser.name = name(x));
+   parser.eof = s? 0xFF : 0xFF5D0A;
+   getSave = Env.get,  Env.get = getParse,  c = Chr,  Chr = 0;
+   Push(c1, Env.parser->name);
+   if (skp)
+      getParse();
+   if (!s)
+      x = rdList();
+   else {
+      any y;
+      cell c2;
+
+      if (!(x = token(s,0)))
+         return Nil;
+      Push(c2, y = cons(x,Nil));
+      while (x = token(s,0))
+         y = cdr(y) = cons(x,Nil);
+      x = Pop(c2);
+   }
+   drop(c1);
+   Chr = c,  Env.get = getSave,  Env.parser = save;
+   return x;
+}
+
+static void putString(int c) {
+   if (StrP)
+      byteSym(c, &StrI, &StrP);
+   else
+      StrI = 0,  data(StrCell) = StrP = box(c & 0xFF);
+}
+
+void begString(void) {
+   StrP = NULL;
+   Push(StrCell,Nil);
+   PutSave = Env.put,  Env.put = putString;
+}
+
+any endString(void) {
+   Env.put = PutSave;
+   drop(StrCell);
+   return StrP? consStr(data(StrCell)) : Nil;
+}
+
+// (any 'sym) -> any
+any doAny(any ex) {
+   any x;
+
+   x = cdr(ex),  x = EVAL(car(x));
+   NeedSym(ex,x);
+   if (!isNil(x)) {
+      int c;
+      parseFrame *save, parser;
+      void (*getSave)(void);
+      cell c1;
+
+      save = Env.parser;
+      Env.parser = &parser;
+      parser.dig = unDig(parser.name = name(x));
+      parser.eof = 0xFF20;
+      getSave = Env.get,  Env.get = getParse,  c = Chr,  Chr = 0;
+      Push(c1, Env.parser->name);
+      getParse();
+      x = read0(YES);
+      drop(c1);
+      Chr = c,  Env.get = getSave,  Env.parser = save;
+   }
+   return x;
+}
+
+// (sym 'any) -> sym
+any doSym(any x) {
+   x = EVAL(cadr(x));
+   begString();
+   print(x);
+   return endString();
+}
+
+// (str 'sym ['sym1]) -> lst
+// (str 'lst) -> sym
+any doStr(any ex) {
+   any x;
+   cell c1, c2;
+
+   x = cdr(ex);
+   if (isNil(x = EVAL(car(x))))
+      return Nil;
+   if (isNum(x))
+      argError(ex,x);
+   if (isSym(x)) {
+      if (!isCell(cddr(ex)))
+         return parse(x, NO, NULL);
+      Push(c1, x);
+      Push(c2, evSym(cddr(ex)));
+      x = parse(x, NO, data(c2));
+      drop(c1);
+      return x;
+   }
+   begString();
+   while (print(car(x)), isCell(x = cdr(x)))
+      space();
+   return endString();
+}
+
+any load(any ex, int pr, any x) {
+   cell c1, c2;
+   inFrame f;
+
+   if (isSym(x) && firstByte(x) == '-') {
+      Push(c1, parse(x, YES, NULL));
+      x = evList(data(c1));
+      drop(c1);
+      return x;
+   }
+   rdOpen(ex, x, &f);
+   doHide(Nil);
+   pushInFiles(&f);
+   x = Nil;
+   for (;;) {
+      if (InFile != InFiles[STDIN_FILENO])
+         data(c1) = read1(0);
+      else {
+         if (pr && !Chr)
+            Env.put(pr), space(), flushAll();
+         data(c1) = read1(isatty(STDIN_FILENO)? '\n' : 0);
+         if (Chr == '\n')
+            Chr = 0;
+      }
+      if (isNil(data(c1)))
+         break;
+      Save(c1);
+      if (InFile != InFiles[STDIN_FILENO] || Chr || !pr)
+         x = EVAL(data(c1));
+      else {
+         flushAll();
+         Push(c2, val(At));
+         x = val(At) = EVAL(data(c1));
+         val(At3) = val(At2),  val(At2) = data(c2);
+         outString("-> "),  flushAll(),  print1(x),  newline();
+      }
+      drop(c1);
+   }
+   popInFiles();
+   doHide(Nil);
+   return x;
+}
+
+// (load 'any ..) -> any
+any doLoad(any ex) {
+   any x, y;
+
+   x = cdr(ex);
+   do {
+      if ((y = EVAL(car(x))) != T)
+         y = load(ex, '>', y);
+      else
+         y = loadAll(ex);
+   } while (isCell(x = cdr(x)));
+   return y;
+}
+
+// (in 'any . prg) -> any
+any doIn(any ex) {
+   any x;
+   inFrame f;
+
+   x = cdr(ex),  x = EVAL(car(x));
+   rdOpen(ex, x, &f);
+   pushInFiles(&f);
+   x = prog(cddr(ex));
+   popInFiles();
+   return x;
+}
+
+// (out 'any . prg) -> any
+any doOut(any ex) {
+   any x;
+   outFrame f;
+
+   x = cdr(ex),  x = EVAL(car(x));
+   wrOpen(ex, x, &f);
+   pushOutFiles(&f);
+   x = prog(cddr(ex));
+   popOutFiles();
+   return x;
+}
+
+// (pipe exe) -> cnt
+// (pipe exe . prg) -> any
+any doPipe(any ex) {
+   any x;
+   union {
+      inFrame in;
+      outFrame out;
+   } f;
+   int pfd[2];
+
+   if (pipe(pfd) < 0)
+      err(ex, NULL, "Can't pipe");
+   closeOnExec(ex, pfd[0]), closeOnExec(ex, pfd[1]);
+   if ((f.in.pid = forkLisp(ex)) == 0) {
+      if (isCell(cddr(ex)))
+         setpgid(0,0);
+      close(pfd[0]);
+      if (pfd[1] != STDOUT_FILENO)
+         dup2(pfd[1], STDOUT_FILENO),  close(pfd[1]);
+      wrOpen(ex, Nil, &f.out);
+      pushOutFiles(&f.out);
+      val(Run) = Nil;
+      EVAL(cadr(ex));
+      bye(0);
+   }
+   close(pfd[1]);
+   initInFile(f.in.fd = pfd[0], NULL);
+   if (!isCell(cddr(ex)))
+      return boxCnt(pfd[0]);
+   setpgid(f.in.pid,0);
+   pushInFiles(&f.in);
+   x = prog(cddr(ex));
+   popInFiles();
+   return x;
+}
+
+// (ctl 'sym . prg) -> any
+any doCtl(any ex) {
+   any x;
+   ctlFrame f;
+
+   x = cdr(ex),  x = EVAL(car(x));
+   ctOpen(ex,x,&f);
+   pushCtlFiles(&f);
+   x = prog(cddr(ex));
+   popCtlFiles();
+   return x;
+}
+
+// (open 'any) -> cnt | NIL
+any doOpen(any ex) {
+   any x = evSym(cdr(ex));
+   char nm[pathSize(x)];
+   int fd;
+
+   pathString(x, nm);
+   while ((fd = open(nm, O_CREAT|O_RDWR, 0666)) < 0) {
+      if (errno != EINTR)
+         return Nil;
+      if (Signal)
+         sighandler(ex);
+   }
+   closeOnExec(ex, fd);
+   initInFile(fd, strdup(nm)), initOutFile(fd);
+   return boxCnt(fd);
+}
+
+// (close 'cnt) -> cnt | NIL
+any doClose(any ex) {
+   any x;
+   int fd;
+
+   x = cdr(ex),  x = EVAL(car(x));
+   if (close(fd = (int)xCnt(ex,x)))
+      return Nil;
+   closeInFile(fd),  closeOutFile(fd);
+   return x;
+}
+
+// (echo ['cnt ['cnt]] | ['sym ..]) -> sym
+any doEcho(any ex) {
+   any x, y;
+   long cnt;
+
+   x = cdr(ex),  y = EVAL(car(x));
+   if (!Chr)
+      Env.get();
+   if (isNil(y) && !isCell(cdr(x))) {
+      while (Chr >= 0)
+         Env.put(Chr),  Env.get();
+      return T;
+   }
+   if (isSym(y)) {
+      int m, n, i, j, ac = length(x), p[ac], om, op;
+      cell c[ac];
+      char *av[ac];
+
+      for (i = 0;;) {
+         Push(c[i], y);
+         av[i] = alloc(NULL, bufSize(y)),  bufString(y, av[i]);
+         p[i] = 0;
+         if (++i == ac)
+            break;
+         y = evSym(x = cdr(x));
+      }
+      m = -1;
+      while (Chr >= 0) {
+         if ((om = m) >= 0)
+            op = p[m];
+         for (i = 0; i < ac; ++i) {
+            for (;;) {
+               if (av[i][p[i]] == (byte)Chr) {
+                  if (av[i][++p[i]]) {
+                     if (m < 0  ||  p[i] > p[m])
+                        m = i;
+                     break;
+                  }
+                  if (om >= 0)
+                     for (j = 0, n = op-p[i]; j <= n; ++j)
+                        Env.put(av[om][j]);
+                  Env.get();
+                  x = data(c[i]);
+                  goto done;
+               }
+               if (!p[i])
+                  break;
+               for (j = 1; --p[i]; ++j)
+                  if (memcmp(av[i], av[i]+j, p[i]) == 0)
+                     break;
+               if (m == i)
+                  for (m = -1, j = 0; j < ac; ++j)
+                     if (p[j] && (m < 0 || p[j] > p[m]))
+                        m = j;
+            }
+         }
+         if (m < 0) {
+            if (om >= 0)
+               for (i = 0; i < op; ++i)
+                  Env.put(av[om][i]);
+            Env.put(Chr);
+         }
+         else if (om >= 0)
+            for (i = 0, n = op-p[m]; i <= n; ++i)
+               Env.put(av[om][i]);
+         Env.get();
+      }
+      x = Nil;
+   done:
+      i = 0;  do
+         free(av[i]);
+      while (++i < ac);
+      drop(c[0]);
+      return x;
+   }
+   if (isCell(x = cdr(x))) {
+      for (cnt = xCnt(ex,y), y = EVAL(car(x)); --cnt >= 0; Env.get())
+         if (Chr < 0)
+            return Nil;
+   }
+   for (cnt = xCnt(ex,y); --cnt >= 0; Env.get()) {
+      if (Chr < 0)
+         return Nil;
+      Env.put(Chr);
+   }
+   return T;
+}
+
+/*** Printing ***/
+void putStdout(int c) {
+   if (OutFile) {
+      if (OutFile->ix == BUFSIZ) {
+         OutFile->ix = 0;
+         wrBytes(OutFile->fd, OutFile->buf, BUFSIZ);
+      }
+      if ((OutFile->buf[OutFile->ix++] = c) == '\n' && OutFile->tty) {
+         int n = OutFile->ix;
+
+         OutFile->ix = 0;
+         wrBytes(OutFile->fd, OutFile->buf, n);
+      }
+   }
+}
+
+void newline(void) {Env.put('\n');}
+void space(void) {Env.put(' ');}
+
+void outWord(word n) {
+   if (n > 9)
+      outWord(n / 10);
+   Env.put('0' + n % 10);
+}
+
+void outString(char *s) {
+   while (*s)
+      Env.put(*s++);
+}
+
+static void outSym(int c) {
+   do
+      Env.put(c);
+   while (c = symByte(NULL));
+}
+
+void outName(any s) {outSym(symByte(name(s)));}
+
+void outNum(any x) {
+   if (isNum(cdr(numCell(x))))
+      outName(numToSym(x, 0, 0, 0));
+   else {
+      char *p, buf[BITS/2];
+
+      sprintf(p = buf, "%ld", unBox(x));
+      do
+         Env.put(*p++);
+      while (*p);
+   }
+}
+
+/* Print one expression */
+void print(any x) {
+   cell c1;
+
+   Push(c1,x);
+   print1(x);
+   drop(c1);
+}
+
+void print1(any x) {
+   if (Signal)
+      sighandler(NULL);
+   if (isNum(x))
+      outNum(x);
+   else if (isNil(x))
+      outString("NIL");
+   else if (isSym(x)) {
+      int c, d;
+
+      if (!(c = symByte(name(x))))
+         Env.put('$'),  outWord(num(x)/sizeof(cell));
+      else if (isExt(x))
+         Env.put('{'),  outSym(c),  Env.put('}');
+      else if (hashed(x, ihash(name(x)), Intern)) {
+         do {
+            d = symByte(NULL);
+            if (strchr(Delim, c)  ||  c == '.' && !d)
+               Env.put('\\');
+            Env.put(c);
+         } while (c = d);
+      }
+      else {
+         bool tsm = isCell(val(Tsm)) && Env.put == putStdout && OutFile->tty;
+
+         if (!tsm)
+            Env.put('"');
+         else {
+            outName(car(val(Tsm)));
+            c = symByte(name(x));
+         }
+         do {
+            if (c == '\\'  ||  c == '^'  ||  !tsm && c == '"')
+               Env.put('\\');
+            else if (c == 127)
+               Env.put('^'),  c = '?';
+            else if (c < ' ')
+               Env.put('^'),  c |= 0x40;
+            Env.put(c);
+         } while (c = symByte(NULL));
+         if (!tsm)
+            Env.put('"');
+         else
+            outName(cdr(val(Tsm)));
+      }
+   }
+   else if (car(x) == Quote  &&  x != cdr(x))
+      Env.put('\''),  print1(cdr(x));
+   else {
+      any y = x;
+      Env.put('(');
+      while (print1(car(x)), !isNil(x = cdr(x))) {
+         if (x == y) {
+            outString(" .");
+            break;
+         }
+         if (!isCell(x)) {
+            outString(" . ");
+            print1(x);
+            break;
+         }
+         space();
+      }
+      Env.put(')');
+   }
+}
+
+void prin(any x) {
+   cell c1;
+
+   Push(c1,x);
+   prin1(x);
+   drop(c1);
+}
+
+void prin1(any x) {
+   if (Signal)
+      sighandler(NULL);
+   if (!isNil(x)) {
+      if (isNum(x))
+         outNum(x);
+      else if (isSym(x)) {
+         if (isExt(x))
+            Env.put('{');
+         outName(x);
+         if (isExt(x))
+            Env.put('}');
+      }
+      else {
+         while (prin1(car(x)), !isNil(x = cdr(x))) {
+            if (!isCell(x)) {
+               prin1(x);
+               break;
+            }
+         }
+      }
+   }
+}
+
+// (prin 'any ..) -> any
+any doPrin(any x) {
+   any y = Nil;
+
+   while (isCell(x = cdr(x)))
+      prin(y = EVAL(car(x)));
+   return y;
+}
+
+// (prinl 'any ..) -> any
+any doPrinl(any x) {
+   any y = Nil;
+
+   while (isCell(x = cdr(x)))
+      prin(y = EVAL(car(x)));
+   newline();
+   return y;
+}
+
+// (space ['cnt]) -> cnt
+any doSpace(any ex) {
+   any x;
+   int n;
+
+   if (isNil(x = EVAL(cadr(ex)))) {
+      Env.put(' ');
+      return One;
+   }
+   for (n = xCnt(ex,x); n > 0; --n)
+      Env.put(' ');
+   return x;
+}
+
+// (print 'any ..) -> any
+any doPrint(any x) {
+   any y;
+
+   x = cdr(x),  print(y = EVAL(car(x)));
+   while (isCell(x = cdr(x)))
+      space(),  print(y = EVAL(car(x)));
+   return y;
+}
+
+// (printsp 'any ..) -> any
+any doPrintsp(any x) {
+   any y;
+
+   x = cdr(x);
+   do
+      print(y = EVAL(car(x))),  space();
+   while (isCell(x = cdr(x)));
+   return y;
+}
+
+// (println 'any ..) -> any
+any doPrintln(any x) {
+   any y;
+
+   x = cdr(x),  print(y = EVAL(car(x)));
+   while (isCell(x = cdr(x)))
+      space(),  print(y = EVAL(car(x)));
+   newline();
+   return y;
+}
+
+// (flush) -> flg
+any doFlush(any ex __attribute__((unused))) {
+   return flush(OutFile)? T : Nil;
+}
+
+// (rewind) -> flg
+any doRewind(any ex __attribute__((unused))) {
+   if (!OutFile)
+      return Nil;
+   OutFile->ix = 0;
+   return lseek(OutFile->fd, 0L, SEEK_SET) || ftruncate(OutFile->fd, 0)? Nil : T;
+}
+
+// (ext 'cnt . prg) -> any
+any doExt(any ex) {
+   int extn;
+   any x;
+
+   x = cdr(ex);
+   extn = ExtN,  ExtN = (int)evCnt(ex,x);
+   x = prog(cddr(ex));
+   ExtN = extn;
+   return x;
+}
+
+// (rd ['sym]) -> any
+// (rd 'cnt) -> num | NIL
+any doRd(any x) {
+   int i, j;
+   long cnt;
+   word n;
+   cell c1;
+
+   x = cdr(x),  x = EVAL(car(x));
+   if (!isNum(x)) {
+      Push(c1,x);
+      getBin = getBinary;
+      x = binRead(ExtN) ?: data(c1);
+      drop(c1);
+      return x;
+   }
+   if (!InFile)
+      return Nil;
+   if ((cnt = unBox(x)) < 0) {
+      byte buf[cnt = -cnt];
+
+      if (!rdBytes(InFile->fd, buf, cnt, NO))  // Little Endian
+         return Nil;
+      if (cnt % sizeof(word) == 0)
+         Push(c1, Nil);
+      else {
+         n = buf[--cnt];
+
+         while (cnt % sizeof(word))
+            n = n << 8 | buf[--cnt];
+         Push(c1, box(n));
+      }
+      while ((cnt -= WORD) >= 0) {
+         n = buf[cnt + WORD-1];
+         i = WORD-2;
+         do
+            n = n << 8 | buf[cnt + i];
+         while (--i >= 0);
+         data(c1) = consNum(n, data(c1));
+      }
+   }
+   else {
+      byte buf[cnt];
+
+      if (!rdBytes(InFile->fd, buf, cnt, NO))
+         return Nil;
+      if (cnt % sizeof(word) == 0) {
+         i = 0;
+         Push(c1, Nil);
+      }
+      else {
+         n = buf[0];
+
+         for (i = 1;  i < (int)(cnt % sizeof(word));  ++i)
+            n = n << 8 | buf[i];
+         Push(c1, box(n));
+      }
+      while (i < cnt) {
+         n = buf[i++];
+         j = 1;
+         do
+            n = n << 8 | buf[i++];
+         while (++j < WORD);
+         data(c1) = consNum(n, data(c1));
+      }
+   }
+   zapZero(data(c1));
+   digMul2(data(c1));
+   return Pop(c1);
+}
+
+// (pr 'any ..) -> any
+any doPr(any x) {
+   any y;
+
+   x = cdr(x);
+   do
+      pr(ExtN, y = EVAL(car(x)));
+   while (isCell(x = cdr(x)));
+   return y;
+}
+
+// (wr 'cnt ..) -> cnt
+any doWr(any x) {
+   any y;
+
+   x = cdr(x);
+   do
+      putStdout(unDig(y = EVAL(car(x))) / 2);
+   while (isCell(x = cdr(x)));
+   return y;
+}
+
+static void putChar(int c) {putchar_unlocked(c);}
+
+// (rpc 'sym ['any ..]) -> flg
+any doRpc(any x) {
+   any y;
+
+   x = cdr(x);
+   putChar(BEG);
+   do
+      y = EVAL(car(x)),  putBin = putChar,  binPrint(ExtN, y);
+   while (isCell(x = cdr(x)));
+   putChar(END);
+   return fflush(stdout)? Nil : T;
+}
+
+/*** DB-I/O ***/
+#define BLKSIZE 64  // DB block unit size
+#define BLK 6
+#define TAGMASK (BLKSIZE-1)
+#define BLKMASK (~TAGMASK)
+#define EXTERN64 65536
+
+static int F, Files, *BlkShift, *BlkFile, *BlkSize, *Fluse, MaxBlkSize;
+static FILE *Jnl, *Log;
+static adr BlkIndex, BlkLink;
+static adr *Marks;
+static byte *Locks, *Ptr, **Mark;
+static byte *Block, *IniBlk;  // 01 00 00 00 00 00 NIL 0
+
+static adr getAdr(byte *p) {
+   return (adr)p[0] | (adr)p[1]<<8 | (adr)p[2]<<16 |
+                           (adr)p[3]<<24 | (adr)p[4]<<32 | (adr)p[5]<<40;
+}
+
+static void setAdr(adr n, byte *p) {
+   p[0] = (byte)n,  p[1] = (byte)(n >> 8),  p[2] = (byte)(n >> 16);
+   p[3] = (byte)(n >> 24),  p[4] = (byte)(n >> 32),  p[5] = (byte)(n >> 40);
+}
+
+static void dbfErr(any ex) {err(ex, NULL, "Bad DB file");}
+static void dbErr(char *s) {err(NULL, NULL, "DB %s: %s", s, strerror(errno));}
+static void jnlErr(any ex) {err(ex, NULL, "Bad Journal");}
+static void fsyncErr(any ex, char *s) {err(ex, NULL, "%s fsync error: %s", s, strerror(errno));}
+static void truncErr(any ex) {err(ex, NULL, "Log truncate error: %s", strerror(errno));}
+static void ignLog(void) {fprintf(stderr, "Discarding incomplete transaction.\n");}
+
+any new64(adr n, any x) {
+   int c, i;
+   adr w = 0;
+
+   do {
+      if ((c = n & 0x3F) > 11)
+         c += 5;
+      if (c > 42)
+         c += 6;
+      w = w << 8 | c + '0';
+   } while (n >>= 6);
+   if (i = F) {
+      ++i;
+      w = w << 8 | '-';
+      do {
+         if ((c = i & 0x3F) > 11)
+            c += 5;
+         if (c > 42)
+            c += 6;
+         w = w << 8 | c + '0';
+      } while (i >>= 6);
+   }
+   return hi(w)? consNum(num(w), consNum(hi(w), x)) : consNum(num(w), x);
+}
+
+adr blk64(any x) {
+   int c;
+   adr n, w;
+
+   F = 0;
+   n = 0;
+   if (isNum(x)) {
+      w = unDig(x);
+      if (isNum(x = cdr(numCell(x))))
+         w |= (adr)unDig(x) << BITS;
+      do {
+         if ((c = w & 0xFF) == '-')
+            F = n-1,  n = 0;
+         else {
+            if ((c -= '0') > 42)
+               c -= 6;
+            if (c > 11)
+               c -= 5;
+            n = n << 6 | c;
+         }
+      } while (w >>= 8);
+   }
+   return n;
+}
+
+any extOffs(int offs, any x) {
+   int f = F;
+   adr n = blk64(x);
+
+   if (offs != -EXTERN64) {
+      if ((F += offs) < 0)
+         err(NULL, NULL, "%d: Bad DB offset", F);
+      x = new64(n, Nil);
+   }
+   else {  // Undocumented 64-bit DB export
+      adr w = n & 0xFFFFF | (F & 0xFF) << 20;
+
+      w |= ((n >>= 20) & 0xFFF) << 28;
+      w |= (adr)(F >> 8) << 40 | (n >> 12) << 48;
+      x = hi(w)? consNum(num(w), consNum(hi(w), Nil)) : consNum(num(w), Nil);
+   }
+   F = f;
+   return x;
+}
+
+/* DB Record Locking */
+static void dbLock(int cmd, int typ, int f, off_t len) {
+   struct flock fl;
+
+   fl.l_type = typ;
+   fl.l_whence = SEEK_SET;
+   fl.l_start = 0;
+   fl.l_len = len;
+   while (fcntl(BlkFile[f], cmd, &fl) < 0  &&  typ != F_UNLCK)
+      if (errno != EINTR)
+         lockErr();
+}
+
+static inline void rdLock(void) {
+   if (val(Solo) != T)
+      dbLock(F_SETLKW, F_RDLCK, 0, 1);
+}
+
+static inline void wrLock(void) {
+   if (val(Solo) != T)
+      dbLock(F_SETLKW, F_WRLCK, 0, 1);
+}
+
+static inline void rwUnlock(off_t len) {
+   if (val(Solo) != T) {
+      if (len == 0) {
+         int f;
+
+         for (f = 1; f < Files; ++f)
+            if (Locks[f])
+               dbLock(F_SETLK, F_UNLCK, f, 0),  Locks[f] = 0;
+         val(Solo) = Zero;
+      }
+      dbLock(F_SETLK, F_UNLCK, 0, len);
+   }
+}
+
+static pid_t tryLock(off_t n, off_t len) {
+   struct flock fl;
+
+   for (;;) {
+      fl.l_type = F_WRLCK;
+      fl.l_whence = SEEK_SET;
+      fl.l_start = n;
+      fl.l_len = len;
+      if (fcntl(BlkFile[F], F_SETLK, &fl) >= 0) {
+         Locks[F] = 1;
+         if (!n)
+            val(Solo) = T;
+         else if (val(Solo) != T)
+            val(Solo) = Nil;
+         return 0;
+      }
+      if (errno != EINTR  &&  errno != EACCES  &&  errno != EAGAIN)
+         lockErr();
+      fl.l_type = F_WRLCK;  //??
+      fl.l_whence = SEEK_SET;
+      fl.l_start = n;
+      fl.l_len = len;
+      while (fcntl(BlkFile[F], F_GETLK, &fl) < 0)
+         if (errno != EINTR)
+            lockErr();
+      if (fl.l_type != F_UNLCK)
+         return fl.l_pid;
+   }
+}
+
+static void blkPeek(off_t pos, void *buf, int siz) {
+   if (pread(BlkFile[F], buf, siz, pos) != (ssize_t)siz)
+      dbErr("read");
+}
+
+static void blkPoke(off_t pos, void *buf, int siz) {
+   if (pwrite(BlkFile[F], buf, siz, pos) != (ssize_t)siz)
+      dbErr("write");
+   if (Jnl) {
+      byte a[BLK+2];
+
+      putc_unlocked(siz == BlkSize[F]? BLKSIZE : siz, Jnl);
+      a[0] = (byte)F,  a[1] = (byte)(F >> 8),  setAdr(pos >> BlkShift[F], a+2);
+      if (fwrite(a, BLK+2, 1, Jnl) != 1 || fwrite(buf, siz, 1, Jnl) != 1)
+         writeErr("Journal");
+   }
+}
+
+static void rdBlock(adr n) {
+   blkPeek((BlkIndex = n) << BlkShift[F], Block, BlkSize[F]);
+   BlkLink = getAdr(Block) & BLKMASK;
+   Ptr = Block + BLK;
+}
+
+static void logBlock(void) {
+   byte a[BLK+2];
+
+   a[0] = (byte)F,  a[1] = (byte)(F >> 8),  setAdr(BlkIndex, a+2);
+   if (fwrite(a, BLK+2, 1, Log) != 1 || fwrite(Block, BlkSize[F], 1, Log) != 1)
+      writeErr("Log");
+}
+
+static void wrBlock(void) {blkPoke(BlkIndex << BlkShift[F], Block, BlkSize[F]);}
+
+static adr newBlock(void) {
+   adr n;
+   byte buf[2*BLK];
+
+   blkPeek(0, buf, 2*BLK);  // Get Free, Next
+   if ((n = getAdr(buf)) && Fluse[F]) {
+      blkPeek(n << BlkShift[F], buf, BLK);  // Get free link
+      --Fluse[F];
+   }
+   else if ((n = getAdr(buf+BLK)) != 281474976710592LL)
+      setAdr(n + BLKSIZE, buf+BLK);  // Increment next
+   else
+      err(NULL, NULL, "DB Oversize");
+   blkPoke(0, buf, 2*BLK);
+   setAdr(0, IniBlk),  blkPoke(n << BlkShift[F], IniBlk, BlkSize[F]);
+   return n;
+}
+
+any newId(any ex, int i) {
+   adr n;
+
+   if ((F = i-1) >= Files)
+      dbfErr(ex);
+   if (!Log)
+      ++Env.protect;
+   wrLock();
+   if (Jnl)
+      lockFile(fileno(Jnl), F_SETLKW, F_WRLCK);
+   n = newBlock();
+   if (Jnl)
+      fflush(Jnl),  lockFile(fileno(Jnl), F_SETLK, F_UNLCK);
+   rwUnlock(1);
+   if (!Log)
+      --Env.protect;
+   return new64(n/BLKSIZE, At2);  // dirty
+}
+
+bool isLife(any x) {
+   adr n;
+   byte buf[2*BLK];
+
+   if (n = blk64(name(x))*BLKSIZE) {
+      if (F < Files) {
+         for (x = tail1(x); !isSym(x); x = cdr(cellPtr(x)));
+         if (x == At || x == At2)
+            return YES;
+         if (x != At3) {
+            blkPeek(0, buf, 2*BLK);  // Get Next
+            if (n < getAdr(buf+BLK)) {
+               blkPeek(n << BlkShift[F], buf, BLK);
+               if ((buf[0] & TAGMASK) == 1)
+                  return YES;
+            }
+         }
+      }
+      else if (!isNil(val(Ext)))
+         return YES;
+   }
+   return NO;
+}
+
+static void cleanUp(adr n) {
+   adr p, fr;
+   byte buf[BLK];
+
+   blkPeek(0, buf, BLK),  fr = getAdr(buf);  // Get Free
+   setAdr(n, buf),  blkPoke(0, buf, BLK);    // Set new
+   for (;;) {
+      p = n << BlkShift[F];
+      blkPeek(p, buf, BLK);  // Get block link
+      buf[0] &= BLKMASK;  // Clear Tag
+      if ((n = getAdr(buf)) == 0)
+         break;
+      blkPoke(p, buf, BLK);
+   }
+   setAdr(fr, buf),  blkPoke(p, buf, BLK);  // Append old free list
+}
+
+static int getBlock(void) {
+   if (Ptr == Block+BlkSize[F]) {
+      if (!BlkLink)
+         return 0;
+      rdBlock(BlkLink);
+   }
+   return *Ptr++;
+}
+
+static void putBlock(int c) {
+   if (Ptr == Block+BlkSize[F]) {
+      if (BlkLink)
+         wrBlock(),  rdBlock(BlkLink);
+      else {
+         adr n = newBlock();
+         int cnt = Block[0];  // Link must be 0
+
+         setAdr(n | cnt, Block);
+         wrBlock();
+         BlkIndex = n;
+         if (cnt < TAGMASK)
+            ++cnt;
+         setAdr(cnt, Block);
+         Ptr = Block + BLK;
+      }
+   }
+   *Ptr++ = (byte)c;
+}
+
+// Test for existing transaction
+static bool transaction(void) {
+   byte a[BLK];
+
+   fseek(Log, 0L, SEEK_SET);
+   if (fread(a, 2, 1, Log) == 0) {
+      if (!feof(Log))
+         ignLog();
+      return NO;
+   }
+   for (;;) {
+      if (a[0] == 0xFF && a[1] == 0xFF)
+         return YES;
+      if ((F = a[0] | a[1]<<8) >= Files  ||
+            fread(a, BLK, 1, Log) != 1  ||
+            fseek(Log, BlkSize[F], SEEK_CUR) != 0  ||
+            fread(a, 2, 1, Log) != 1 ) {
+         ignLog();
+         return NO;
+      }
+   }
+}
+
+static void restore(any ex) {
+   byte dirty[Files], a[BLK], buf[MaxBlkSize];
+
+   fprintf(stderr, "Last transaction not completed: Rollback\n");
+   fseek(Log, 0L, SEEK_SET);
+   for (F = 0; F < Files; ++F)
+      dirty[F] = 0;
+   for (;;) {
+      if (fread(a, 2, 1, Log) == 0)
+         jnlErr(ex);
+      if (a[0] == 0xFF && a[1] == 0xFF)
+         break;
+      if ((F = a[0] | a[1]<<8) >= Files  ||
+            fread(a, BLK, 1, Log) != 1  ||
+            fread(buf, BlkSize[F], 1, Log) != 1 )
+         jnlErr(ex);
+      if (pwrite(BlkFile[F], buf, BlkSize[F], getAdr(a) << BlkShift[F]) != (ssize_t)BlkSize[F])
+         dbErr("write");
+      dirty[F] = 1;
+   }
+   for (F = 0; F < Files; ++F)
+      if (dirty[F] && fsync(BlkFile[F]) < 0)
+         fsyncErr(ex, "DB");
+}
+
+// (pool ['sym1 ['lst] ['sym2] ['sym3]]) -> T
+any doPool(any ex) {
+   any x;
+   byte buf[2*BLK+1];
+   cell c1, c2, c3, c4;
+
+   x = cdr(ex),  Push(c1, evSym(x));  // db
+   x = cdr(x),  Push(c2, EVAL(car(x)));  // lst
+   NeedLst(ex,data(c2));
+   x = cdr(x),  Push(c3, evSym(x));  // sym2
+   Push(c4, evSym(cdr(x)));  // sym3
+   val(Solo) = Zero;
+   if (Files) {
+      doRollback(Nil);
+      for (F = 0; F < Files; ++F) {
+         if (Marks)
+            free(Mark[F]);
+         if (close(BlkFile[F]) < 0)
+            closeErr();
+      }
+      free(Mark), Mark = NULL, free(Marks), Marks = NULL;
+      Files = 0;
+      if (Jnl)
+         fclose(Jnl),  Jnl = NULL;
+      if (Log)
+         fclose(Log),  Log = NULL;
+   }
+   if (!isNil(data(c1))) {
+      x = data(c2);
+      Files = length(x) ?: 1;
+      BlkShift = alloc(BlkShift, Files * sizeof(int));
+      BlkFile = alloc(BlkFile, Files * sizeof(int));
+      BlkSize = alloc(BlkSize, Files * sizeof(int));
+      Fluse = alloc(Fluse, Files * sizeof(int));
+      Locks = alloc(Locks, Files),  memset(Locks, 0, Files);
+      MaxBlkSize = 0;
+      for (F = 0; F < Files; ++F) {
+         char nm[pathSize(data(c1)) + 8];
+
+         pathString(data(c1), nm);
+         if (isCell(x))
+            sprintf(nm + strlen(nm), "%d", F+1);
+         BlkShift[F] = isNum(car(x))? (int)unDig(car(x))/2 : 2;
+         if ((BlkFile[F] = open(nm, O_RDWR)) >= 0) {
+            blkPeek(0, buf, 2*BLK+1);  // Get block shift
+            BlkSize[F] = BLKSIZE << (BlkShift[F] = (int)buf[2*BLK]);
+         }
+         else {
+            if (errno != ENOENT  ||
+                     (BlkFile[F] = open(nm, O_CREAT|O_EXCL|O_RDWR, 0666)) < 0) {
+               Files = F;
+               openErr(ex, nm);
+            }
+            BlkSize[F] = BLKSIZE << BlkShift[F];
+            setAdr(0, buf);  // Free
+            if (F)
+               setAdr(BLKSIZE, buf+BLK);  // Next
+            else {
+               byte blk[BlkSize[0]];
+
+               setAdr(2*BLKSIZE, buf+BLK);  // Next
+               memset(blk, 0, BlkSize[0]);
+               setAdr(1, blk),  blkPoke(BlkSize[0], blk, BlkSize[0]);
+            }
+            buf[2*BLK] = (byte)BlkShift[F];
+            blkPoke(0, buf, 2*BLK+1);
+         }
+         closeOnExec(ex, BlkFile[F]);
+         if (BlkSize[F] > MaxBlkSize)
+            MaxBlkSize = BlkSize[F];
+         Fluse[F] = -1;
+         x = cdr(x);
+      }
+      Block = alloc(Block, MaxBlkSize);
+      IniBlk = alloc(IniBlk, MaxBlkSize);
+      memset(IniBlk, 0, MaxBlkSize);
+      if (!isNil(data(c3))) {
+         char nm[pathSize(data(c3))];
+
+         pathString(data(c3), nm);
+         if (!(Jnl = fopen(nm, "a")))
+            openErr(ex, nm);
+         closeOnExec(ex, fileno(Jnl));
+      }
+      if (!isNil(data(c4))) {
+         char nm[pathSize(data(c4))];
+
+         pathString(data(c4), nm);
+         if (!(Log = fopen(nm, "a+")))
+            openErr(ex, nm);
+         closeOnExec(ex, fileno(Log));
+         if (transaction())
+            restore(ex);
+         fseek(Log, 0L, SEEK_SET);
+         if (ftruncate(fileno(Log), 0))
+            truncErr(ex);
+      }
+   }
+   drop(c1);
+   return T;
+}
+
+// (journal 'any ..) -> T
+any doJournal(any ex) {
+   any x, y;
+   int siz;
+   FILE *fp;
+   byte a[BLK], buf[MaxBlkSize];
+
+   for (x = cdr(ex); isCell(x); x = cdr(x)) {
+      y = evSym(x);
+      {
+         char nm[pathSize(y)];
+
+         pathString(y, nm);
+         if (!(fp = fopen(nm, "r")))
+            openErr(ex, nm);
+         while ((siz = getc_unlocked(fp)) >= 0) {
+            if (fread(a, 2, 1, fp) != 1)
+               jnlErr(ex);
+            if ((F = a[0] | a[1]<<8) >= Files)
+               dbfErr(ex);
+            if (siz == BLKSIZE)
+               siz = BlkSize[F];
+            if (fread(a, BLK, 1, fp) != 1 || fread(buf, siz, 1, fp) != 1)
+               jnlErr(ex);
+            blkPoke(getAdr(a) << BlkShift[F], buf, siz);
+         }
+         fclose(fp);
+      }
+   }
+   return T;
+}
+
+static any mkId(adr n) {
+   any x, y, *h;
+
+   x = new64(n, Nil);
+   if (y = findHash(x, h = Extern + ehash(x)))
+      return y;
+   mkExt(y = consSym(Nil,x));
+   *h = cons(y,*h);
+   return y;
+}
+
+// (id 'num ['num]) -> sym
+// (id 'sym [NIL]) -> num
+// (id 'sym T) -> (num . num)
+any doId(any ex) {
+   any x, y;
+   adr n;
+   cell c1;
+
+   x = cdr(ex);
+   if (isNum(y = EVAL(car(x)))) {
+      x = cdr(x);
+      if (isNil(x = EVAL(car(x)))) {
+         F = 0;
+         return mkId(unBoxWord2(y));
+      }
+      F = (int)unDig(y)/2 - 1;
+      NeedNum(ex,x);
+      return mkId(unBoxWord2(x));
+   }
+   NeedExt(ex,y);
+   n = blk64(name(y));
+   x = cdr(x);
+   if (isNil(EVAL(car(x))))
+      return boxWord2(n);
+   Push(c1, boxWord2(n));
+   data(c1) = cons(box((F + 1) * 2), data(c1));
+   return Pop(c1);
+}
+
+// (seq 'cnt|sym1) -> sym | NIL
+any doSeq(any ex) {
+   any x;
+   adr n, next;
+   byte buf[2*BLK];
+
+   x = cdr(ex);
+   if (isNum(x = EVAL(car(x)))) {
+      F = (int)unDig(x)/2 - 1;
+      n = 0;
+   }
+   else {
+      NeedExt(ex,x);
+      n = blk64(name(x))*BLKSIZE;
+   }
+   if (F >= Files)
+      dbfErr(ex);
+   rdLock();
+   blkPeek(0, buf, 2*BLK),  next = getAdr(buf+BLK);  // Get Next
+   while ((n += BLKSIZE) < next) {
+      blkPeek(n << BlkShift[F], buf, BLK);
+      if ((buf[0] & TAGMASK) == 1) {
+         rwUnlock(1);
+         return mkId(n/BLKSIZE);
+      }
+   }
+   rwUnlock(1);
+   return Nil;
+}
+
+// (lieu 'any) -> sym | NIL
+any doLieu(any x) {
+   any y;
+
+   x = cdr(x);
+   if (!isSym(x = EVAL(car(x))) || !isExt(x))
+      return Nil;
+   for (y = tail1(x); !isSym(y); y = cdr(cellPtr(y)));
+   return y == At || y == At2? x : Nil;
+}
+
+// (lock ['sym]) -> cnt | NIL
+any doLock(any ex) {
+   any x;
+   pid_t n;
+   off_t blk;
+
+   x = cdr(ex);
+   if (isNil(x = EVAL(car(x))))
+      F = 0,  n = tryLock(0,0);
+   else {
+      NeedExt(ex,x);
+      blk = blk64(name(x));
+      if (F >= Files)
+         dbfErr(ex);
+      n = tryLock(blk * BlkSize[F], 1);
+   }
+   return n? boxCnt(n) : Nil;
+}
+
+static int binSize(any x) {
+   if (isNum(x)) {
+      int n = numBytes(x);
+
+      if (n < 63)
+         return n + 1;
+      return n + 2 + (n - 63) / 255;
+   }
+   else if (isNil(x))
+      return 1;
+   else if (isSym(x))
+      return binSize(name(x));
+   else {
+      any y = x;
+      int n = 2;
+
+      while (n += binSize(car(x)), !isNil(x = cdr(x))) {
+         if (x == y)
+            return n + 1;
+         if (!isCell(x))
+            return n + binSize(x);
+      }
+      return n;
+   }
+}
+
+int dbSize(any ex, any x) {
+   int n;
+
+   db(ex,x,1);
+   n = BLK + 1 + binSize(val(x));
+   for (x = tail1(x);  isCell(x);  x = cdr(x)) {
+      if (isSym(car(x)))
+         n += binSize(car(x)) + 2;
+      else
+         n += binSize(cdar(x)) + binSize(caar(x));
+   }
+   return n;
+}
+
+
+void db(any ex, any s, int a) {
+   any x, y, *p;
+
+   if (!isNum(x = tail1(s))) {
+      if (a == 1)
+         return;
+      while (!isNum(x = cdr(x)));
+   }
+   p = &cdr(numCell(x));
+   while (isNum(*p))
+      p = &cdr(numCell(*p));
+   if (!isSym(*p))
+      p = &car(*p);
+   if (*p != At3) {  // not deleted
+      if (*p == At2) {  // dirty
+         if (a == 3) {
+            *p = At3;  // deleted
+            val(s) = Nil;
+            tail(s) = ext(x);
+         }
+      }
+      else if (isNil(*p) || a > 1) {
+         if (a == 3) {
+            *p = At3;  // deleted
+            val(s) = Nil;
+            tail(s) = ext(x);
+         }
+         else if (*p == At)
+            *p =  At2;  // loaded -> dirty
+         else {  // NIL & 1 | 2
+            adr n;
+            cell c[1];
+
+            Push(c[0],s);
+            n = blk64(x);
+            if (F < Files) {
+               rdLock();
+               rdBlock(n*BLKSIZE);
+               if ((Block[0] & TAGMASK) != 1)
+                  err(ex, s, "Bad ID");
+               *p  =  a == 1? At : At2;  // loaded : dirty
+               getBin = getBlock;
+               val(s) = binRead(0);
+               if (!isNil(y = binRead(0))) {
+                  tail(s) = ext(x = cons(y,x));
+                  if ((y = binRead(0)) != T)
+                     car(x) = cons(y,car(x));
+                  while (!isNil(y = binRead(0))) {
+                     cdr(x) = cons(y,cdr(x));
+                     if ((y = binRead(0)) != T)
+                        cadr(x) = cons(y,cadr(x));
+                     x = cdr(x);
+                  }
+               }
+               rwUnlock(1);
+            }
+            else {
+               if (!isCell(y = val(Ext)) || F < unBox(caar(y)))
+                  dbfErr(ex);
+               while (isCell(cdr(y)) && F >= unBox(caadr(y)))
+                  y = cdr(y);
+               y = apply(ex, cdar(y), NO, 1, c);  // ((Obj) ..)
+               *p = At;  // loaded
+               val(s) = car(y);
+               if (!isCell(y = cdr(y)))
+                  tail(s) = ext(x);
+               else {
+                  tail(s) = ext(y);
+                  while (isCell(cdr(y)))
+                     y = cdr(y);
+                  cdr(y) = x;
+               }
+            }
+            drop(c[0]);
+         }
+      }
+   }
+}
+
+// (commit ['any] [exe1] [exe2]) -> flg
+any doCommit(any ex) {
+   bool note;
+   int i, extn;
+   adr n;
+   cell c1;
+   any x, y, z;
+   ptr pbSave, ppSave;
+   byte dirty[Files], buf[PIPE_BUF];
+
+   x = cdr(ex),  Push(c1, EVAL(car(x)));
+   if (!Log)
+      ++Env.protect;
+   wrLock();
+   if (Jnl)
+      lockFile(fileno(Jnl), F_SETLKW, F_WRLCK);
+   if (Log) {
+      for (F = 0; F < Files; ++F)
+         dirty[F] = 0,  Fluse[F] = 0;
+      for (i = 0; i < EHASH; ++i) {  // Save objects
+         for (x = Extern[i];  isCell(x);  x = cdr(x)) {
+            for (y = tail1(car(x)); isCell(y); y = cdr(y));
+            z = numCell(y);
+            while (isNum(cdr(z)))
+               z = numCell(cdr(z));
+            if (cdr(z) == At2 || cdr(z) == At3) {  // dirty or deleted
+               n = blk64(y);
+               if (F < Files) {
+                  rdBlock(n*BLKSIZE);
+                  while (logBlock(), BlkLink)
+                     rdBlock(BlkLink);
+                  dirty[F] = 1;
+                  if (cdr(z) != At3)
+                     ++Fluse[F];
+               }
+            }
+         }
+      }
+      for (F = 0; F < Files; ++F) {
+         if (i = Fluse[F]) {
+            rdBlock(0);                               // Save Block 0
+            while (logBlock(),  BlkLink && --i >= 0)  // and free list
+               rdBlock(BlkLink);
+         }
+      }
+      putc_unlocked(0xFF, Log),  putc_unlocked(0xFF, Log);
+      fflush(Log);
+      if (fsync(fileno(Log)) < 0)
+         fsyncErr(ex, "Transaction");
+   }
+   x = cddr(ex),  EVAL(car(x));
+   if (data(c1) == T)
+      note = NO,  extn = EXTERN64;  // Undocumented 64-bit DB export
+   else {
+      extn = 0;
+      if (note = !isNil(data(c1)) && (Tell || Children))
+         tellBeg(&pbSave, &ppSave, buf),  prTell(data(c1));
+   }
+   for (i = 0; i < EHASH; ++i) {
+      for (x = Extern[i];  isCell(x);  x = cdr(x)) {
+         for (y = tail1(car(x)); isCell(y); y = cdr(y));
+         z = numCell(y);
+         while (isNum(cdr(z)))
+            z = numCell(cdr(z));
+         if (cdr(z) == At2) {  // dirty
+            n = blk64(y);
+            if (F < Files) {
+               rdBlock(n*BLKSIZE);
+               Block[0] |= 1;  // Might be new
+               putBin = putBlock;
+               binPrint(extn, val(y = car(x)));
+               for (y = tail1(y);  isCell(y);  y = cdr(y)) {
+                  if (isCell(car(y)))
+                     binPrint(extn, cdar(y)), binPrint(extn, caar(y));
+                  else
+                     binPrint(extn, car(y)), binPrint(extn, T);
+               }
+               putBlock(NIX);
+               setAdr(Block[0] & TAGMASK, Block);  // Clear Link
+               wrBlock();
+               if (BlkLink)
+                  cleanUp(BlkLink);
+               cdr(z) = At;  // loaded
+               if (note) {
+                  if (PipePtr >= PipeBuf + PIPE_BUF - 12) {  // EXTERN <2+1+7> END
+                     tellEnd(&pbSave, &ppSave);
+                     tellBeg(&pbSave, &ppSave, buf),  prTell(data(c1));
+                  }
+                  prTell(car(x));
+               }
+            }
+         }
+         else if (cdr(z) == At3) {  // deleted
+            n = blk64(y);
+            if (F < Files) {
+               cleanUp(n*BLKSIZE);
+               if (note) {
+                  if (PipePtr >= PipeBuf + PIPE_BUF - 12) {  // EXTERN <2+1+7> END
+                     tellEnd(&pbSave, &ppSave);
+                     tellBeg(&pbSave, &ppSave, buf),  prTell(data(c1));
+                  }
+                  prTell(car(x));
+               }
+            }
+            cdr(z) = Nil;
+         }
+      }
+   }
+   if (note)
+      tellEnd(&pbSave, &ppSave);
+   x = cdddr(ex),  EVAL(car(x));
+   if (Jnl)
+      fflush(Jnl),  lockFile(fileno(Jnl), F_SETLK, F_UNLCK);
+   if (isCell(x = val(Zap))) {
+      outFile f, *oSave;
+      char nm[pathSize(y = cdr(x))];
+
+      pathString(y, nm);
+      if ((f.fd = open(nm, O_APPEND|O_CREAT|O_WRONLY, 0666)) < 0)
+         openErr(ex, nm);
+      f.ix = 0;
+      f.tty = NO;
+      putBin = putStdout;
+      oSave = OutFile,  OutFile = &f;
+      for (y = car(x); isCell(y); y = cdr(y))
+         binPrint(0, car(y));
+      flush(&f);
+      close(f.fd);
+      car(x) = Nil;
+      OutFile = oSave;
+   }
+   if (Log) {
+      for (F = 0; F < Files; ++F)
+         if (dirty[F] && fsync(BlkFile[F]) < 0)
+            fsyncErr(ex, "DB");
+      fseek(Log, 0L, SEEK_SET);
+      if (ftruncate(fileno(Log), 0))
+         truncErr(ex);
+   }
+   rwUnlock(0);  // Unlock all
+   if (!Log)
+      --Env.protect;
+   for (F = 0; F < Files; ++F)
+      Fluse[F] = -1;
+   drop(c1);
+   return T;
+}
+
+// (rollback) -> T
+any doRollback(any x) {
+   int i;
+   any y, z;
+
+   for (i = 0; i < EHASH; ++i) {
+      for (x = Extern[i];  isCell(x);  x = cdr(x)) {
+         val(y = car(x)) = Nil;
+         for (z = tail1(y); isCell(z); z = cdr(z));
+         tail(y) = ext(z);
+         z = numCell(z);
+         while (isNum(cdr(z)))
+            z = numCell(cdr(z));
+         cdr(z) = Nil;
+      }
+   }
+   if (isCell(x = val(Zap)))
+      car(x) = Nil;
+   rwUnlock(0);  // Unlock all
+   return T;
+}
+
+// (mark 'sym|0 ['NIL | 'T | '0]) -> flg
+any doMark(any ex) {
+   any x, y;
+   adr n, m;
+   int b;
+   byte *p;
+
+   x = cdr(ex);
+   if (isNum(y = EVAL(car(x)))) {
+      if (Marks) {
+         for (F = 0; F < Files; ++F)
+            free(Mark[F]);
+         free(Mark), Mark = NULL, free(Marks), Marks = NULL;
+      }
+      return Nil;
+   }
+   NeedExt(ex,y);
+   n = blk64(name(y));
+   if (F >= Files)
+      dbfErr(ex);
+   if (!Marks) {
+      Marks = alloc(Marks, Files * sizeof(adr));
+      memset(Marks, 0, Files * sizeof(adr));
+      Mark = alloc(Mark, Files * sizeof(byte*));
+      memset(Mark, 0, Files * sizeof(byte*));
+   }
+   b = 1 << (n & 7);
+   if ((n >>= 3) >= Marks[F]) {
+      m = Marks[F],  Marks[F] = n + 1;
+      Mark[F] = alloc(Mark[F], Marks[F]);
+      memset(Mark[F] + m, 0, Marks[F] - m);
+   }
+   p = Mark[F] + n;
+   x = cdr(x);
+   y = *p & b? T : Nil;  // Old value
+   if (!isNil(x = EVAL(car(x)))) {
+      if (isNum(x))
+         *p &= ~b;  // Clear mark
+      else
+         *p |= b;  // Set mark
+   }
+   return y;
+}
+
+// (free 'cnt) -> (sym . lst)
+any doFree(any x) {
+   byte buf[2*BLK];
+   cell c1;
+
+   if ((F = (int)evCnt(x, cdr(x)) - 1) >= Files)
+      dbfErr(x);
+   rdLock();
+   blkPeek(0, buf, 2*BLK);  // Get Free, Next
+   Push(c1, x = cons(mkId(getAdr(buf+BLK)/BLKSIZE), Nil));  // Next
+   BlkLink = getAdr(buf);  // Free
+   while (BlkLink) {
+      x = cdr(x) = cons(mkId(BlkLink/BLKSIZE), Nil);
+      rdBlock(BlkLink);
+   }
+   rwUnlock(1);
+   return Pop(c1);
+}
+
+// (dbck ['cnt] 'flg) -> any
+any doDbck(any ex) {
+   any x, y;
+   bool flg;
+   int i;
+   adr next, p, cnt;
+   word2 blks, syms;
+   byte buf[2*BLK];
+   cell c1;
+
+   F = 0;
+   x = cdr(ex);
+   if (isNum(y = EVAL(car(x)))) {
+      if ((F = (int)unDig(y)/2 - 1) >= Files)
+         dbfErr(ex);
+      x = cdr(x),  y = EVAL(car(x));
+   }
+   flg = !isNil(y);
+   cnt = BLKSIZE;
+   blks = syms = 0;
+   ++Env.protect;
+   wrLock();
+   if (Jnl)
+      lockFile(fileno(Jnl), F_SETLKW, F_WRLCK);
+   blkPeek(0, buf, 2*BLK);  // Get Free, Next
+   BlkLink = getAdr(buf);
+   next = getAdr(buf+BLK);
+   while (BlkLink) {  // Check free list
+      rdBlock(BlkLink);
+      if ((cnt += BLKSIZE) > next) {
+         x = mkStr("Circular free list");
+         goto done;
+      }
+      Block[0] |= TAGMASK,  wrBlock();  // Mark free list
+   }
+   for (p = BLKSIZE;  p != next;  p += BLKSIZE) {  // Check all chains
+      if (rdBlock(p), (Block[0] & TAGMASK) == 0) {
+         cnt += BLKSIZE;
+         memcpy(Block, buf, BLK);  // Insert into free list
+         wrBlock();
+         setAdr(p, buf),  blkPoke(0, buf, BLK);
+      }
+      else if ((Block[0] & TAGMASK) == 1) {
+         ++blks, ++syms;
+         cnt += BLKSIZE;
+         for (i = 2;  BlkLink;  cnt += BLKSIZE) {
+            ++blks;
+            rdBlock(BlkLink);
+            if ((Block[0] & TAGMASK) != i) {
+               x = mkStr("Bad chain");
+               goto done;
+            }
+            if (i < TAGMASK)
+               ++i;
+         }
+      }
+   }
+   BlkLink = getAdr(buf);  // Unmark free list
+   while (BlkLink) {
+      rdBlock(BlkLink);
+      if (Block[0] & TAGMASK)
+         Block[0] &= BLKMASK,  wrBlock();
+   }
+   if (cnt != next)
+      x = mkStr("Bad count");
+   else if (!flg)
+      x = Nil;
+   else {
+      Push(c1, boxWord2(syms));
+      data(c1) = cons(boxWord2(blks), data(c1));
+      x = Pop(c1);
+   }
+done:
+   if (Jnl)
+      fflush(Jnl),  lockFile(fileno(Jnl), F_SETLK, F_UNLCK);
+   rwUnlock(1);
+   --Env.protect;
+   return x;
+}
diff --git a/src/lat1.c b/src/lat1.c
@@ -0,0 +1,75 @@
+/* lat1.c
+ * 31mar05abu
+ * Convert stdin (UTF-8, 2-Byte) to process or file (ISO-8859-15)
+ */
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <unistd.h>
+#include <errno.h>
+#include <signal.h>
+#include <sys/wait.h>
+
+// lat1 [-<cmd> [<arg> ..]]
+// lat1 [[+]<Outfile/ISO-8859-15>]
+int main(int ac, char *av[]) {
+	int c;
+   pid_t pid = 0;
+   FILE *fp = stdout;
+
+   if (ac > 1) {
+      char *mode = "w";
+
+      if (*av[1] == '-') {
+         int pfd[2];
+
+         if (pipe(pfd) < 0) {
+            fprintf(stderr, "lat1: Pipe error\n");
+            return 1;
+         }
+         if ((pid = fork()) == 0) {
+            close(pfd[1]);
+            if (pfd[0] != STDIN_FILENO)
+               dup2(pfd[0], STDIN_FILENO),  close(pfd[0]);
+            execvp(av[1]+1, av+1);
+         }
+         if (pid < 0) {
+            fprintf(stderr, "lat1: Fork error\n");
+            return 1;
+         }
+         close(pfd[0]);
+         if (!(fp = fdopen(pfd[1], mode))) {
+            fprintf(stderr, "lat1: Pipe open error\n");
+            return 1;
+         }
+      }
+      else {
+         if (*av[1] == '+')
+            mode = "a",  ++av[1];
+         if (!(fp = fopen(av[1], mode))) {
+            fprintf(stderr, "lat1: '%s' open error\n", av[1]);
+            return 1;
+         }
+      }
+   }
+	while ((c = getchar_unlocked()) != EOF) {
+      if ((c & 0x80) == 0)
+         putc_unlocked(c,fp);
+      else if ((c & 0x20) == 0)
+         putc_unlocked((c & 0x1F) << 6 | getchar_unlocked() & 0x3F, fp);
+      else {
+         getchar_unlocked(); // 0x82
+         getchar_unlocked(); // 0xAC
+         putc_unlocked(0xA4, fp);
+      }
+	}
+   if (pid) {
+      fclose(fp);
+      while (waitpid(pid, NULL, 0) < 0)
+         if (errno != EINTR) {
+            fprintf(stderr, "lat1: Pipe close error\n");
+            return 1;
+         }
+   }
+   return 0;
+}
diff --git a/src/main.c b/src/main.c
@@ -0,0 +1,1140 @@
+/* 22apr10abu
+ * (c) Software Lab. Alexander Burger
+ */
+
+#include "pico.h"
+
+/* Globals */
+int Signal, Repl, Chr, Slot, Spkr, Mic, Hear, Tell, Children, ExtN;
+char **AV, *AV0, *Home;
+child *Child;
+heap *Heaps;
+cell *Avail;
+stkEnv Env;
+catchFrame *CatchPtr;
+struct termios OrgTermio, *Termio;
+int InFDs, OutFDs;
+inFile *InFile, **InFiles;
+outFile *OutFile, **OutFiles;
+int (*getBin)(void);
+void (*putBin)(int);
+any TheKey, TheCls, Thrown;
+any Alarm, Line, Zero, One, Intern[IHASH], Transient[IHASH], Extern[EHASH];
+any ApplyArgs, ApplyBody, DbVal, DbTail;
+any Nil, DB, Meth, Quote, T;
+any Solo, PPid, Pid, At, At2, At3, This, Dbg, Zap, Ext, Scl, Class;
+any Run, Hup, Sig1, Sig2, Up, Err, Msg, Uni, Led, Tsm, Adr, Fork, Bye;
+
+static int TtyPid;
+static word2 USec;
+static struct timeval Tv;
+static bool Tio, Jam;
+static jmp_buf ErrRst;
+static void finish(int) __attribute__ ((noreturn));
+static struct rlimit ULim = {RLIM_INFINITY, RLIM_INFINITY};
+
+
+/*** System ***/
+static void finish(int n) {
+   setCooked();
+   exit(n);
+}
+
+void giveup(char *msg) {
+   fprintf(stderr, "%d %s\n", (int)getpid(), msg);
+   finish(1);
+}
+
+void bye(int n) {
+   static bool flg;
+
+   if (!flg) {
+      flg = YES;
+      unwind(NULL);
+      prog(val(Bye));
+   }
+   flushAll();
+   finish(n);
+}
+
+void execError(char *s) {
+   fprintf(stderr, "%s: can't exec\n", s);
+   exit(127);
+}
+
+/* Install interrupting signal */
+static void iSignal(int n, void (*foo)(int)) {
+   struct sigaction act, old;
+
+   act.sa_handler = foo;
+   sigemptyset(&act.sa_mask);
+   act.sa_flags = 0;
+   sigaction(n, &act, &old);
+}
+
+/* Signal handler */
+void sighandler(any ex) {
+   int i;
+   bool flg;
+
+   if (!Env.protect) {
+      Env.protect = 1;
+      switch (Signal) {
+      case SIGHUP:
+         Signal = 0,  run(val(Hup));
+         break;
+      case SIGINT:
+         Signal = 0;
+         if (Repl < 2)
+            brkLoad(ex ?: Nil);
+         break;
+      case SIGUSR1:
+         Signal = 0,  run(val(Sig1));
+         break;
+      case SIGUSR2:
+         Signal = 0,  run(val(Sig2));
+         break;
+      case SIGALRM:
+         Signal = 0,  run(Alarm);
+         break;
+      case SIGTERM:
+         for (flg = NO, i = 0; i < Children; ++i)
+            if (Child[i].pid  &&  kill(Child[i].pid, SIGTERM) == 0)
+               flg = YES;
+         if (!flg)
+            Signal = 0,  bye(0);
+         break;
+      }
+      Env.protect = 0;
+   }
+}
+
+static void sig(int n) {
+   if (TtyPid)
+      kill(TtyPid, n);
+   else
+      Signal = n;
+}
+
+static void sigTerm(int n) {
+   if (TtyPid)
+      kill(TtyPid, n);
+   else
+      Signal = SIGTERM;
+}
+
+static void sigChld(int n __attribute__((unused))) {
+   int e, stat;
+   pid_t pid;
+
+   e = errno;
+   while ((pid = waitpid(0, &stat, WNOHANG)) > 0)
+      if (WIFSIGNALED(stat))
+         fprintf(stderr, "%d SIG-%d\n", (int)pid, WTERMSIG(stat));
+   errno = e;
+}
+
+static void tcSet(struct termios *p) {
+   if (Termio)
+      while (tcsetattr(STDIN_FILENO, TCSADRAIN, p)  &&  errno == EINTR);
+}
+
+static void sigTermStop(int n __attribute__((unused))) {
+   sigset_t mask;
+
+   tcSet(&OrgTermio);
+   sigemptyset(&mask);
+   sigaddset(&mask, SIGTSTP);
+   sigprocmask(SIG_UNBLOCK, &mask, NULL);
+   signal(SIGTSTP, SIG_DFL),  raise(SIGTSTP),  signal(SIGTSTP, sigTermStop);
+   tcSet(Termio);
+}
+
+void setRaw(void) {
+   if (Tio && !Termio) {
+      *(Termio = malloc(sizeof(struct termios))) = OrgTermio;
+      Termio->c_iflag = 0;
+      Termio->c_lflag = ISIG;
+      Termio->c_cc[VMIN] = 1;
+      Termio->c_cc[VTIME] = 0;
+      tcSet(Termio);
+      if (signal(SIGTSTP,SIG_IGN) == SIG_DFL)
+         signal(SIGTSTP, sigTermStop);
+   }
+}
+
+void setCooked(void) {
+   tcSet(&OrgTermio);
+   free(Termio),  Termio = NULL;
+}
+
+// (raw ['flg]) -> flg
+any doRaw(any x) {
+   if (!isCell(x = cdr(x)))
+      return Termio? T : Nil;
+   if (isNil(EVAL(car(x)))) {
+      setCooked();
+      return Nil;
+   }
+   setRaw();
+   return T;
+}
+
+// (alarm 'cnt . prg) -> cnt
+any doAlarm(any x) {
+   int n = alarm((int)evCnt(x,cdr(x)));
+   Alarm = cddr(x);
+   return boxCnt(n);
+}
+
+// (protect . prg) -> any
+any doProtect(any x) {
+   ++Env.protect;
+   x = prog(cdr(x));
+   --Env.protect;
+   return x;
+}
+
+/* Allocate memory */
+void *alloc(void *p, size_t siz) {
+   if (!(p = realloc(p,siz)))
+      giveup("No memory");
+   return p;
+}
+
+/* Allocate cell heap */
+void heapAlloc(void) {
+   heap *h;
+   cell *p;
+
+   h = (heap*)alloc(NULL, sizeof(heap));
+   h->next = Heaps,  Heaps = h;
+   p = h->cells + CELLS-1;
+   do
+      Free(p);
+   while (--p >= h->cells);
+}
+
+// (heap 'flg) -> cnt
+any doHeap(any x) {
+   long n = 0;
+
+   x = cdr(x);
+   if (isNil(EVAL(car(x)))) {
+      heap *h = Heaps;
+      do
+         ++n;
+      while (h = h->next);
+      return boxCnt(n);
+   }
+   for (x = Avail;  x;  x = car(x))
+      ++n;
+   return boxCnt(n / CELLS);
+}
+
+// (env ['lst] | ['sym 'val] ..) -> lst
+any doEnv(any x) {
+   int i;
+   bindFrame *p;
+   cell c1, c2;
+
+   Push(c1, Nil);
+   if (!isCell(x = cdr(x))) {
+      for (p = Env.bind;  p;  p = p->link) {
+         if (p->i == 0) {
+            for (i = p->cnt;  --i >= 0;) {
+               for (x = data(c1); ; x = cdr(x)) {
+                  if (!isCell(x)) {
+                     data(c1) = cons(cons(p->bnd[i].sym, val(p->bnd[i].sym)), data(c1));
+                     break;
+                  }
+                  if (caar(x) == p->bnd[i].sym)
+                     break;
+               }
+            }
+         }
+      }
+   }
+   else {
+      do {
+         Push(c2, EVAL(car(x)));
+         if (isCell(data(c2))) {
+            do
+               data(c1) = cons(cons(car(data(c2)), val(car(data(c2)))), data(c1));
+            while (isCell(data(c2) = cdr(data(c2))));
+         }
+         else if (!isNil(data(c2))) {
+            x = cdr(x);
+            data(c1) = cons(cons(data(c2), EVAL(car(x))), data(c1));
+         }
+         drop(c2);
+      }
+      while (isCell(x = cdr(x)));
+   }
+   return Pop(c1);
+}
+
+// (up [cnt] sym ['val]) -> any
+any doUp(any x) {
+   any y, *val;
+   int cnt, i;
+   bindFrame *p;
+
+   x = cdr(x);
+   if (!isNum(y = car(x)))
+      cnt = 1;
+   else
+      cnt = (int)unBox(y),  x = cdr(x),  y = car(x);
+   for (p = Env.bind, val = &val(y);  p;  p = p->link) {
+      if (p->i <= 0) {
+         for (i = 0;  i < p->cnt;  ++i)
+            if (p->bnd[i].sym == y) {
+               if (!--cnt) {
+                  if (isCell(x = cdr(x)))
+                     return p->bnd[i].val = EVAL(car(x));
+                  return p->bnd[i].val;
+               }
+               val = &p->bnd[i].val;
+            }
+      }
+   }
+   if (isCell(x = cdr(x)))
+      return *val = EVAL(car(x));
+   return *val;
+}
+
+/*** Primitives ***/
+/* Comparisons */
+bool equal(any x, any y) {
+   for (;;) {
+      if (x == y)
+         return YES;
+      if (isNum(x)) {
+         if (!isNum(y)  ||  unDig(x) != unDig(y))
+            return NO;
+         x = cdr(numCell(x)),  y = cdr(numCell(y));
+      }
+      else if (isSym(x)) {
+         if (!isSym(y)  || !isNum(x = name(x))  ||  !isNum(y = name(y)))
+            return NO;
+      }
+      else {
+         any a, b;
+
+         if (!isCell(y))
+            return NO;
+         while (car(x) == Quote) {
+            if (car(y) != Quote)
+               return NO;
+            if (x == cdr(x))
+               return y == cdr(y);
+            if (y == cdr(y))
+               return NO;
+            if (!isCell(x = cdr(x)))
+               return equal(x, cdr(y));
+            if (!isCell(y = cdr(y)))
+               return NO;
+         }
+         a = x, b = y;
+         for (;;) {
+            if (!equal(car(x), car(y)))
+               return NO;
+            if (!isCell(x = cdr(x)))
+               return equal(x, cdr(y));
+            if (!isCell(y = cdr(y)))
+               return NO;
+            if (x == a && y == b)
+               return YES;
+         }
+      }
+   }
+}
+
+int compare(any x, any y) {
+   any a, b;
+
+   if (x == y)
+      return 0;
+   if (isNil(x))
+      return -1;
+   if (x == T)
+      return +1;
+   if (isNum(x)) {
+      if (!isNum(y))
+         return isNil(y)? +1 : -1;
+      return bigCompare(x,y);
+   }
+   if (isSym(x)) {
+      int b1, b2;
+      word n1, n2;
+
+      if (isNum(y) || isNil(y))
+         return +1;
+      if (isCell(y) || y == T)
+         return -1;
+      if (!isNum(a = name(x)))
+         return !isNum(name(y))? 1664525*(int32_t)(long)x - 1664525*(int32_t)(long)y : -1;
+      if (!isNum(b = name(y)))
+         return +1;
+      n1 = unDig(a), n2 = unDig(b);
+      for (;;) {
+         if ((b1 = n1 & 0xFF) != (b2 = n2 & 0xFF))
+            return b1 - b2;
+         if ((n1 >>= 8) == 0) {
+            if ((n2 >>= 8) != 0)
+               return -1;
+            if (!isNum(a = cdr(numCell(a))))
+               return !isNum(b = cdr(numCell(b)))? 0 : -1;
+            if (!isNum(b = cdr(numCell(b))))
+               return +1;
+            n1 = unDig(a), n2 = unDig(b);
+         }
+         else if ((n2 >>= 8) == 0)
+            return +1;
+      }
+   }
+   if (!isCell(y))
+      return y == T? -1 : +1;
+   a = x, b = y;
+   for (;;) {
+      int n;
+
+      if (n = compare(car(x),car(y)))
+         return n;
+      if (!isCell(x = cdr(x)))
+         return compare(x, cdr(y));
+      if (!isCell(y = cdr(y)))
+         return y == T? -1 : +1;
+      if (x == a && y == b)
+         return 0;
+   }
+}
+
+/*** Error handling ***/
+void err(any ex, any x, char *fmt, ...) {
+   va_list ap;
+   char msg[240];
+   outFrame f;
+
+   va_start(ap,fmt);
+   vsnprintf(msg, sizeof(msg), fmt, ap);
+   va_end(ap);
+   val(Up) = ex ?: Nil;
+   if (msg[0]) {
+      any y;
+      catchFrame *p;
+
+      val(Msg) = mkStr(msg);
+      for (p = CatchPtr;  p;  p = p->link)
+         if (y = p->tag)
+            while (isCell(y)) {
+               if (subStr(car(y), val(Msg))) {
+                  Thrown = isNil(car(y))? val(Msg) : car(y);
+                  unwind(p);
+                  longjmp(p->rst, 1);
+               }
+               y = cdr(y);
+            }
+   }
+   Chr = ExtN = 0;
+   Env.brk = NO;
+   Alarm = Line = Nil;
+   f.pid = 0,  f.fd = STDERR_FILENO,  pushOutFiles(&f);
+   if (InFile && InFile->name) {
+      Env.put('[');
+      outString(InFile->name), Env.put(':'), outWord(InFile->src);
+      Env.put(']'), space();
+   }
+   if (ex)
+      outString("!? "), print(ex), newline();
+   if (x)
+      print(x), outString(" -- ");
+   if (msg[0]) {
+      outString(msg), newline();
+      if (!isNil(val(Err)) && !Jam)
+         Jam = YES,  prog(val(Err)),  Jam = NO;
+      if (!isatty(STDIN_FILENO) || !isatty(STDOUT_FILENO))
+         bye(1);
+      load(NULL, '?', Nil);
+   }
+   unwind(NULL);
+   Env.stack = NULL;
+   Env.meth = NULL;
+   Env.protect = Env.trace = 0;
+   Env.next = -1;
+   Env.task = Nil;
+   Env.make = Env.yoke = NULL;
+   Env.parser = NULL;
+   longjmp(ErrRst, +1);
+}
+
+// (quit ['any ['any]])
+any doQuit(any x) {
+   any y;
+
+   x = cdr(x),  y = evSym(x);
+   {
+      char msg[bufSize(y)];
+
+      bufString(y, msg);
+      x = isCell(x = cdr(x))?  EVAL(car(x)) : NULL;
+      err(NULL, x, "%s", msg);
+   }
+}
+
+void argError(any ex, any x) {err(ex, x, "Bad argument");}
+void numError(any ex, any x) {err(ex, x, "Number expected");}
+void cntError(any ex, any x) {err(ex, x, "Small number expected");}
+void symError(any ex, any x) {err(ex, x, "Symbol expected");}
+void extError(any ex, any x) {err(ex, x, "External symbol expected");}
+void cellError(any ex, any x) {err(ex, x, "Cell expected");}
+void atomError(any ex, any x) {err(ex, x, "Atom expected");}
+void lstError(any ex, any x) {err(ex, x, "List expected");}
+void varError(any ex, any x) {err(ex, x, "Variable expected");}
+void protError(any ex, any x) {err(ex, x, "Protected symbol");}
+
+void pipeError(any ex, char *s) {err(ex, NULL, "Pipe %s error", s);}
+
+void unwind(catchFrame *catch) {
+   any x;
+   int i, j, n;
+   bindFrame *p;
+   catchFrame *q;
+
+   while (q = CatchPtr) {
+      while (p = Env.bind) {
+         if ((i = Env.bind->i) < 0) {
+            j = i, n = 0;
+            while (++n, ++j && (p = p->link))
+               if (p->i >= 0 || p->i < i)
+                  --j;
+            do {
+               for (p = Env.bind, j = n;  --j;  p = p->link);
+               if (p->i < 0  &&  ((p->i -= i) > 0? (p->i = 0) : p->i) == 0)
+                  for (j = p->cnt;  --j >= 0;) {
+                     x = val(p->bnd[j].sym);
+                     val(p->bnd[j].sym) = p->bnd[j].val;
+                     p->bnd[j].val = x;
+                  }
+            } while (--n);
+         }
+         if (Env.bind == q->env.bind)
+            break;
+         if (Env.bind->i == 0)
+            for (i = Env.bind->cnt;  --i >= 0;)
+               val(Env.bind->bnd[i].sym) = Env.bind->bnd[i].val;
+         Env.bind = Env.bind->link;
+      }
+      while (Env.inFrames != q->env.inFrames)
+         popInFiles();
+      while (Env.outFrames != q->env.outFrames)
+         popOutFiles();
+      while (Env.ctlFrames != q->env.ctlFrames)
+         popCtlFiles();
+      Env = q->env;
+      EVAL(q->fin);
+      CatchPtr = q->link;
+      if (q == catch)
+         return;
+   }
+   while (Env.bind) {
+      if (Env.bind->i == 0)
+         for (i = Env.bind->cnt;  --i >= 0;)
+            val(Env.bind->bnd[i].sym) = Env.bind->bnd[i].val;
+      Env.bind = Env.bind->link;
+   }
+   while (Env.inFrames)
+      popInFiles();
+   while (Env.outFrames)
+      popOutFiles();
+   while (Env.ctlFrames)
+      popCtlFiles();
+}
+
+/*** Evaluation ***/
+any evExpr(any expr, any x) {
+   any y = car(expr);
+   struct {  // bindFrame
+      struct bindFrame *link;
+      int i, cnt;
+      struct {any sym; any val;} bnd[length(y)+2];
+   } f;
+
+   f.link = Env.bind,  Env.bind = (bindFrame*)&f;
+   f.i = sizeof(f.bnd) / (2*sizeof(any)) - 1;
+   f.cnt = 1,  f.bnd[0].sym = At,  f.bnd[0].val = val(At);
+   while (isCell(y)) {
+      f.bnd[f.cnt].sym = car(y);
+      f.bnd[f.cnt].val = EVAL(car(x));
+      ++f.cnt, x = cdr(x), y = cdr(y);
+   }
+   if (isNil(y)) {
+      while (--f.i > 0) {
+         x = val(f.bnd[f.i].sym);
+         val(f.bnd[f.i].sym) = f.bnd[f.i].val;
+         f.bnd[f.i].val = x;
+      }
+      x = prog(cdr(expr));
+   }
+   else if (y != At) {
+      f.bnd[f.cnt].sym = y,  f.bnd[f.cnt++].val = val(y),  val(y) = x;
+      while (--f.i > 0) {
+         x = val(f.bnd[f.i].sym);
+         val(f.bnd[f.i].sym) = f.bnd[f.i].val;
+         f.bnd[f.i].val = x;
+      }
+      x = prog(cdr(expr));
+   }
+   else {
+      int n, cnt;
+      cell *arg;
+      cell c[n = cnt = length(x)];
+
+      while (--n >= 0)
+         Push(c[n], EVAL(car(x))),  x = cdr(x);
+      while (--f.i > 0) {
+         x = val(f.bnd[f.i].sym);
+         val(f.bnd[f.i].sym) = f.bnd[f.i].val;
+         f.bnd[f.i].val = x;
+      }
+      n = Env.next,  Env.next = cnt;
+      arg = Env.arg,  Env.arg = c;
+      x = prog(cdr(expr));
+      if (cnt)
+         drop(c[cnt-1]);
+      Env.arg = arg,  Env.next = n;
+   }
+   while (--f.cnt >= 0)
+      val(f.bnd[f.cnt].sym) = f.bnd[f.cnt].val;
+   Env.bind = f.link;
+   return x;
+}
+
+any funq(any x) {
+   any y;
+
+   if (isSym(x))
+      return Nil;
+   if (isNum(x))
+      return (unDig(x)&3) || isNum(cdr(numCell(x)))? Nil : x;
+   for (y = cdr(x); isCell(y); y = cdr(y)) {
+      if (y == x)
+         return Nil;
+      if (isCell(car(y))) {
+         if (isNum(caar(y))) {
+            if (isCell(cdr(y)))
+               return Nil;
+         }
+         else if (isNil(caar(y)) || caar(y) == T)
+            return Nil;
+      }
+      else if (!isNil(cdr(y)))
+         return Nil;
+   }
+   if (!isNil(y))
+      return Nil;
+   if (isNil(x = car(x)))
+      return T;
+   for (y = x; isCell(y);)
+      if (isNum(car(y)) || isCell(car(y)) || isNil(car(y)) || car(y)==T || x==(y=cdr(y)))
+         return Nil;
+   return isNum(y) || y==T? Nil : x;
+}
+
+bool sharedLib(any x) {
+   void *h;
+   char *p, nm[bufSize(x)];
+
+   bufString(x, nm);
+   if (!(p = strchr(nm,':'))  ||  p == nm  ||  p[1] == '\0')
+      return NO;
+   *p++ = '\0';
+   {
+      int n = Home? strlen(Home) : 0;
+#ifndef __CYGWIN__
+      char buf[n + strlen(nm) + 4 + 1];
+#else
+      char buf[n + strlen(nm) + 4 + 4 + 1];
+#endif
+
+      if (strchr(nm,'/'))
+         strcpy(buf, nm);
+      else {
+         if (n)
+            memcpy(buf, Home, n);
+         strcpy(buf + n, "lib/"),  strcpy(buf + n + 4, nm);
+#ifdef __CYGWIN__
+         strcpy(buf + n + 4 + strlen(nm), ".dll");
+#endif
+      }
+      if (!(h = dlopen(buf, RTLD_LAZY | RTLD_GLOBAL))  ||  !(h = dlsym(h,p)))
+         return NO;
+      val(x) = box(num(h));
+   }
+   return YES;
+}
+
+void undefined(any x, any ex) {
+   if (!sharedLib(x))
+      err(ex, x, "Undefined");
+}
+
+static any evList2(any foo, any ex) {
+   cell c1;
+
+   Push(c1, foo);
+   if (isCell(foo)) {
+      foo = evExpr(foo, cdr(ex));
+      drop(c1);
+      return foo;
+   }
+   for (;;) {
+      if (isNil(val(foo)))
+         undefined(foo,ex);
+      if (Signal)
+         sighandler(ex);
+      if (isNum(foo = val(foo))) {
+         foo = evSubr(foo,ex);
+         drop(c1);
+         return foo;
+      }
+      if (isCell(foo)) {
+         foo = evExpr(foo, cdr(ex));
+         drop(c1);
+         return foo;
+      }
+   }
+}
+
+/* Evaluate a list */
+any evList(any ex) {
+   any foo;
+
+   if (!isSym(foo = car(ex))) {
+      if (isNum(foo))
+         return ex;
+      if (Signal)
+         sighandler(ex);
+      if (isNum(foo = evList(foo)))
+         return evSubr(foo,ex);
+      return evList2(foo,ex);
+   }
+   for (;;) {
+      if (isNil(val(foo)))
+         undefined(foo,ex);
+      if (Signal)
+         sighandler(ex);
+      if (isNum(foo = val(foo)))
+         return evSubr(foo,ex);
+      if (isCell(foo))
+         return evExpr(foo, cdr(ex));
+   }
+}
+
+/* Evaluate any to sym */
+any evSym(any x) {return xSym(EVAL(car(x)));}
+
+any xSym(any x) {
+   int i;
+   any nm;
+   cell c1, c2;
+
+   if (isSym(x))
+      return x;
+   Push(c1,x);
+   nm = NULL,  pack(x, &i, &nm, &c2);
+   drop(c1);
+   return nm? consStr(data(c2)) : Nil;
+}
+
+/* Evaluate count */
+long evCnt(any ex, any x) {return xCnt(ex, EVAL(car(x)));}
+
+long xCnt(any ex, any x) {
+   NeedCnt(ex,x);
+   return unBox(x);
+}
+
+/* Evaluate double */
+double evDouble(any ex, any x) {
+   x = EVAL(car(x));
+   NeedNum(ex,x);
+   return numToDouble(x);
+}
+
+// (args) -> flg
+any doArgs(any ex __attribute__((unused))) {
+   return Env.next > 0? T : Nil;
+}
+
+// (next) -> any
+any doNext(any ex __attribute__((unused))) {
+   if (Env.next > 0)
+      return data(Env.arg[--Env.next]);
+   if (Env.next == 0)
+      Env.next = -1;
+   return Nil;
+}
+
+// (arg ['cnt]) -> any
+any doArg(any ex) {
+   long n;
+
+   if (Env.next < 0)
+      return Nil;
+   if (!isCell(cdr(ex)))
+      return data(Env.arg[Env.next]);
+   if ((n = evCnt(ex,cdr(ex))) > 0  &&  n <= Env.next)
+      return data(Env.arg[Env.next - n]);
+   return Nil;
+}
+
+// (rest) -> lst
+any doRest(any x) {
+   int i;
+   cell c1;
+
+   if ((i = Env.next) <= 0)
+      return Nil;
+   Push(c1, x = cons(data(Env.arg[--i]), Nil));
+   while (i)
+      x = cdr(x) = cons(data(Env.arg[--i]), Nil);
+   return Pop(c1);
+}
+
+static struct tm *TM;
+
+any mkDat(int y, int m, int d) {
+   int n;
+   static char mon[13] = {31,31,28,31,30,31,30,31,31,30,31,30,31};
+
+   if (m<1 || m>12 || d<1 || d>mon[m] && (m!=2 || d!=29 || y%4 || !(y%100) && y%400))
+      return Nil;
+   n = (12*y + m - 3) / 12;
+   return boxCnt((4404*y+367*m-1094)/12 - 2*n + n/4 - n/100 + n/400 + d);
+}
+
+// (date ['T]) -> dat
+// (date 'dat) -> (y m d)
+// (date 'y 'm 'd) -> dat | NIL
+// (date '(y m d)) -> dat | NIL
+any doDate(any ex) {
+   any x, z;
+   int y, m, d, n;
+   cell c1;
+   time_t tim;
+
+   if (!isCell(x = cdr(ex))) {
+      time(&tim);
+      TM = localtime(&tim);
+      return mkDat(TM->tm_year+1900,  TM->tm_mon+1,  TM->tm_mday);
+   }
+   if ((z = EVAL(car(x))) == T) {
+      time(&tim);
+      TM = gmtime(&tim);
+      return mkDat(TM->tm_year+1900,  TM->tm_mon+1,  TM->tm_mday);
+   }
+   if (isNil(z))
+      return Nil;
+   if (isCell(z))
+      return mkDat(xCnt(ex, car(z)),  xCnt(ex, cadr(z)),  xCnt(ex, caddr(z)));
+   if (!isCell(x = cdr(x))) {
+      n = xCnt(ex,z);
+      y = (100*n - 20) / 3652425;
+      n += (y - y/4);
+      y = (100*n - 20) / 36525;
+      n -= 36525*y / 100;
+      m = (10*n - 5) / 306;
+      d = (10*n - 306*m + 5) / 10;
+      if (m < 10)
+         m += 3;
+      else
+         ++y,  m -= 9;
+      Push(c1, cons(boxCnt(d), Nil));
+      data(c1) = cons(boxCnt(m), data(c1));
+      data(c1) = cons(boxCnt(y), data(c1));
+      return Pop(c1);
+   }
+   y = xCnt(ex,z);
+   m = evCnt(ex,x);
+   return mkDat(y, m, evCnt(ex,cdr(x)));
+}
+
+any mkTime(int h, int m, int s) {
+   if (h < 0 || h > 23  ||  m < 0 || m > 59  ||  s < 0 || s > 60)
+      return Nil;
+   return boxCnt(h * 3600 + m * 60 + s);
+}
+
+// (time ['T]) -> tim
+// (time 'tim) -> (h m s)
+// (time 'h 'm ['s]) -> tim | NIL
+// (time '(h m [s])) -> tim | NIL
+any doTime(any ex) {
+   any x, z;
+   int h, m, s;
+   cell c1;
+   time_t tim;
+   struct tm *p;
+
+   if (!isCell(x = cdr(ex))) {
+      time(&tim);
+      p = localtime(&tim);
+      return boxCnt(p->tm_hour * 3600 + p->tm_min * 60 + p->tm_sec);
+   }
+   if ((z = EVAL(car(x))) == T)
+      return TM? boxCnt(TM->tm_hour * 3600 + TM->tm_min * 60 + TM->tm_sec) : Nil;
+   if (isNil(z))
+      return Nil;
+   if (isCell(z))
+      return mkTime(xCnt(ex, car(z)), xCnt(ex, cadr(z)), isCell(cddr(z))? xCnt(ex, caddr(z)) : 0);
+   if (!isCell(x = cdr(x))) {
+      s = xCnt(ex,z);
+      Push(c1, cons(boxCnt(s % 60), Nil));
+      data(c1) = cons(boxCnt(s / 60 % 60), data(c1));
+      data(c1) = cons(boxCnt(s / 3600), data(c1));
+      return Pop(c1);
+   }
+   h = xCnt(ex, z);
+   m = evCnt(ex, x);
+   return mkTime(h, m, isCell(cdr(x))? evCnt(ex, cdr(x)) : 0);
+}
+
+// (usec) -> num
+any doUsec(any ex __attribute__((unused))) {
+   gettimeofday(&Tv,NULL);
+   return boxWord2((word2)Tv.tv_sec*1000000 + Tv.tv_usec - USec);
+}
+
+// (pwd) -> sym
+any doPwd(any x) {
+   char *p;
+
+   if ((p = getcwd(NULL,0)) == NULL)
+      return Nil;
+   x = mkStr(p);
+   free(p);
+   return x;
+}
+
+// (cd 'any) -> sym
+any doCd(any x) {
+   x = evSym(cdr(x));
+   {
+      char *p, path[pathSize(x)];
+
+      pathString(x, path);
+      if ((p = getcwd(NULL,0)) == NULL  ||  path[0] && chdir(path) < 0)
+         return Nil;
+      x = mkStr(p);
+      free(p);
+      return x;
+   }
+}
+
+// (ctty 'sym|pid) -> flg
+any doCtty(any ex) {
+   any x;
+
+   if (isNum(x = EVAL(cadr(ex))))
+      TtyPid = unDig(x) / 2;
+   else {
+      if (!isSym(x))
+         argError(ex,x);
+      {
+         char tty[bufSize(x)];
+
+         bufString(x, tty);
+         if (!freopen(tty,"r",stdin) || !freopen(tty,"w",stdout) || !freopen(tty,"w",stderr))
+            return Nil;
+         OutFiles[STDOUT_FILENO]->tty = YES;
+      }
+   }
+   return T;
+}
+
+// (info 'any) -> (cnt|T dat . tim)
+any doInfo(any x) {
+   cell c1;
+   struct tm *p;
+   struct stat st;
+
+   x = evSym(cdr(x));
+   {
+      char nm[pathSize(x)];
+
+      pathString(x, nm);
+      if (stat(nm, &st) < 0)
+         return Nil;
+      p = gmtime(&st.st_mtime);
+      Push(c1, boxCnt(p->tm_hour * 3600 + p->tm_min * 60 + p->tm_sec));
+      data(c1) = cons(mkDat(p->tm_year+1900,  p->tm_mon+1,  p->tm_mday), data(c1));
+      data(c1) = cons(S_ISDIR(st.st_mode)? T : boxWord2((word2)st.st_size), data(c1));
+      return Pop(c1);
+   }
+}
+
+// (file) -> (sym1 sym2 . num) | NIL
+any doFile(any ex __attribute__((unused))) {
+   char *s, *p;
+   cell c1;
+
+   if (!InFile || !InFile->name)
+      return Nil;
+   Push(c1, boxCnt(InFile->src));
+   s = strdup(InFile->name);
+   if (p = strrchr(s, '/')) {
+      data(c1) = cons(mkStr(p+1), data(c1));
+      *(p+1) = '\0';
+      data(c1) = cons(mkStr(s), data(c1));
+   }
+   else {
+      data(c1) = cons(mkStr(s), data(c1));
+      data(c1) = cons(mkStr("./"), data(c1));
+   }
+   free(s);
+   return Pop(c1);
+}
+
+// (dir ['any]) -> lst
+any doDir(any x) {
+   any y;
+   DIR *dp;
+   struct dirent *p;
+   cell c1;
+
+   if (isNil(x = evSym(cdr(x))))
+      dp = opendir(".");
+   else {
+      char nm[pathSize(x)];
+
+      pathString(x, nm);
+      dp = opendir(nm);
+   }
+   if (!dp)
+      return Nil;
+   do {
+      if (!(p = readdir(dp))) {
+         closedir(dp);
+         return Nil;
+      }
+   } while (p->d_name[0] == '.');
+   Push(c1, y = cons(mkStr(p->d_name), Nil));
+   while (p = readdir(dp))
+      if (p->d_name[0] != '.')
+         y = cdr(y) = cons(mkStr(p->d_name), Nil);
+   closedir(dp);
+   return Pop(c1);
+}
+
+// (cmd ['any]) -> sym
+any doCmd(any x) {
+   if (isNil(x = evSym(cdr(x))))
+      return mkStr(AV0);
+   bufString(x, AV0);
+   return x;
+}
+
+// (argv [var ..] [. sym]) -> lst|sym
+any doArgv(any ex) {
+   any x, y;
+   char **p;
+   cell c1;
+
+   if (*(p = AV) && strcmp(*p,"-") == 0)
+      ++p;
+   if (isNil(x = cdr(ex))) {
+      if (!*p)
+         return Nil;
+      Push(c1, x = cons(mkStr(*p++), Nil));
+      while (*p)
+         x = cdr(x) = cons(mkStr(*p++), Nil);
+      return Pop(c1);
+   }
+   do {
+      if (!isCell(x)) {
+         NeedSym(ex,x);
+         CheckVar(ex,x);
+         if (!*p)
+            return val(x) = Nil;
+         Push(c1, y = cons(mkStr(*p++), Nil));
+         while (*p)
+            y = cdr(y) = cons(mkStr(*p++), Nil);
+         return val(x) = Pop(c1);
+      }
+      y = car(x);
+      NeedVar(ex,y);
+      CheckVar(ex,y);
+      val(y) = *p? mkStr(*p++) : Nil;
+   } while (!isNil(x = cdr(x)));
+   return val(y);
+}
+
+// (opt) -> sym
+any doOpt(any ex __attribute__((unused))) {
+   return *AV && strcmp(*AV,"-")? mkStr(*AV++) : Nil;
+}
+
+any loadAll(any ex) {
+   any x = Nil;
+
+   while (*AV  &&  strcmp(*AV,"-") != 0)
+      x = load(ex, 0, mkStr(*AV++));
+   return x;
+}
+
+/*** Main ***/
+static void init(int ac, char *av[]) {
+   int i;
+   char *p;
+   sigset_t sigs;
+
+   for (i = 1; i < ac; ++i)
+      if (*av[i] != '-') {
+         if ((p = strrchr(av[i], '/')) && !(p == av[i]+1 && *av[i] == '.')) {
+            Home = malloc(p - av[i] + 2);
+            memcpy(Home, av[i], p - av[i] + 1);
+            Home[p - av[i] + 1] = '\0';
+         }
+         break;
+      }
+   AV0 = *av++;
+   AV = av;
+   heapAlloc();
+   initSymbols();
+   Env.get = getStdin;
+   InFile = initInFile(STDIN_FILENO, NULL);
+   Env.put = putStdout;
+   initOutFile(STDERR_FILENO);
+   OutFile = initOutFile(STDOUT_FILENO);
+   Env.task = Alarm = Line = Nil;
+   setrlimit(RLIMIT_STACK, &ULim);
+   Tio = tcgetattr(STDIN_FILENO, &OrgTermio) == 0;
+   ApplyArgs = cons(cons(consSym(Nil,Nil), Nil), Nil);
+   ApplyBody = cons(Nil,Nil);
+   sigfillset(&sigs);
+   sigprocmask(SIG_UNBLOCK, &sigs, NULL);
+   iSignal(SIGHUP, sig);
+   iSignal(SIGINT, sigTerm);
+   iSignal(SIGUSR1, sig);
+   iSignal(SIGUSR2, sig);
+   iSignal(SIGALRM, sig);
+   iSignal(SIGTERM, sig);
+   signal(SIGCHLD, sigChld);
+   signal(SIGPIPE, SIG_IGN);
+   signal(SIGTTIN, SIG_IGN);
+   signal(SIGTTOU, SIG_IGN);
+   gettimeofday(&Tv,NULL);
+   USec = (word2)Tv.tv_sec*1000000 + Tv.tv_usec;
+}
+
+int MAIN(int ac, char *av[]) {
+   init(ac,av);
+   if (!setjmp(ErrRst)) {
+      loadAll(NULL);
+      ++Repl;
+      iSignal(SIGINT, sig);
+   }
+   load(NULL, ':', Nil);
+   bye(0);
+}
diff --git a/src/net.c b/src/net.c
@@ -0,0 +1,204 @@
+/* 08oct09abu
+ * (c) Software Lab. Alexander Burger
+ */
+
+#include "pico.h"
+
+#include <netdb.h>
+#include <sys/socket.h>
+#include <arpa/inet.h>
+#include <netinet/tcp.h>
+#include <netinet/in.h>
+
+static void ipErr(any ex, char *s) {
+   err(ex, NULL, "IP %s error: %s", s, strerror(errno));
+}
+
+// (port ['T] 'cnt|(cnt . cnt) ['var]) -> cnt
+any doPort(any ex) {
+   any x, y;
+   int type, n, sd;
+   unsigned short port;
+   struct sockaddr_in addr;
+
+   x = cdr(ex);
+   type = SOCK_STREAM;
+   if ((y = EVAL(car(x))) == T)
+      type = SOCK_DGRAM,  x = cdr(x),  y = EVAL(car(x));
+   if ((sd = socket(AF_INET, type, 0)) < 0)
+      ipErr(ex, "socket");
+   closeOnExec(ex, sd);
+   memset(&addr, 0, sizeof(addr));
+   addr.sin_family = AF_INET;
+   addr.sin_addr.s_addr = htonl(INADDR_ANY);
+   if (isNum(y)) {
+      if ((port = (unsigned short)xCnt(ex,y)) != 0) {
+         n = 1;
+         if (setsockopt(sd, SOL_SOCKET, SO_REUSEADDR, &n, sizeof(n)) < 0)
+            ipErr(ex, "setsockopt");
+      }
+   }
+   else if (isCell(y))
+      port = (unsigned short)xCnt(ex,car(y));
+   else
+      argError(ex,y);
+   for (;;) {
+      addr.sin_port = htons(port);
+      if (bind(sd, (struct sockaddr*)&addr, sizeof(addr)) >= 0)
+         break;
+      if (!isCell(y)  ||  ++port > xCnt(ex,cdr(y)))
+         close(sd),  ipErr(ex, "bind");
+   }
+   if (type == SOCK_STREAM  &&  listen(sd,5) < 0)
+      close(sd),  ipErr(ex, "listen");
+   if (!isNil(y = EVAL(cadr(x)))) {
+      socklen_t len = sizeof(addr);
+      if (getsockname(sd, (struct sockaddr*)&addr, &len) < 0)
+         close(sd),  ipErr(ex, "getsockname");
+      NeedVar(ex,y);
+      CheckVar(ex,y);
+      val(y) = boxCnt(ntohs(addr.sin_port));
+   }
+   return boxCnt(sd);
+}
+
+static any tcpAccept(int sd) {
+   int i, f, sd2;
+   struct sockaddr_in addr;
+
+   f = nonblocking(sd);
+   i = 200; do {
+      socklen_t len = sizeof(addr);
+      if ((sd2 = accept(sd, (struct sockaddr*)&addr, &len)) >= 0) {
+         fcntl(sd, F_SETFL, f);
+         val(Adr) = mkStr(inet_ntoa(addr.sin_addr));
+         initInFile(sd2,NULL), initOutFile(sd2);
+         return boxCnt(sd2);
+      }
+      usleep(100000);  // 100 ms
+   } while (errno == EAGAIN  &&  --i >= 0);
+   fcntl(sd, F_SETFL, f);
+   return NULL;
+}
+
+// (accept 'cnt) -> cnt | NIL
+any doAccept(any ex) {
+   return tcpAccept((int)evCnt(ex, cdr(ex))) ?: Nil;
+}
+
+// (listen 'cnt1 ['cnt2]) -> cnt | NIL
+any doListen(any ex) {
+   any x;
+   int sd;
+   long ms;
+
+   sd = (int)evCnt(ex, x = cdr(ex));
+   x = cdr(x);
+   ms = isNil(x = EVAL(car(x)))? -1 : xCnt(ex,x);
+   for (;;) {
+      if (!waitFd(ex, sd, ms))
+         return Nil;
+      if (x = tcpAccept(sd))
+         return x;
+   }
+}
+
+// (host 'any) -> sym
+any doHost(any x) {
+   struct in_addr in;
+   struct hostent *p;
+
+   x = evSym(cdr(x));
+   {
+      char nm[bufSize(x)];
+
+      bufString(x, nm);
+      if (inet_aton(nm, &in) && (p = gethostbyaddr((char*)&in, sizeof(in), AF_INET)))
+         return mkStr(p->h_name);
+      return Nil;
+   }
+}
+
+static bool server(any host, unsigned short port, struct sockaddr_in *addr) {
+   struct hostent *p;
+   char nm[bufSize(host)];
+
+   memset(addr, 0, sizeof(struct sockaddr_in));
+   addr->sin_port = htons(port);
+   addr->sin_family = AF_INET;
+   bufString(host, nm);
+   if (!inet_aton(nm, &addr->sin_addr)) {
+      if (!(p = gethostbyname(nm))  ||  p->h_length == 0)
+         return NO;
+      addr->sin_addr.s_addr = ((struct in_addr*)p->h_addr_list[0])->s_addr;
+   }
+   return YES;
+}
+
+// (connect 'any 'cnt) -> cnt | NIL
+any doConnect(any ex) {
+   int sd, port;
+   cell c1;
+   struct sockaddr_in addr;
+
+   Push(c1, evSym(cdr(ex)));
+   port = evCnt(ex, cddr(ex));
+   if (!server(Pop(c1), (unsigned short)port, &addr))
+      return Nil;
+   if ((sd = socket(AF_INET, SOCK_STREAM, 0)) < 0)
+      ipErr(ex, "socket");
+   closeOnExec(ex, sd);
+   if (connect(sd, (struct sockaddr*)&addr, sizeof(addr)) < 0) {
+      close(sd);
+      return Nil;
+   }
+   initInFile(sd,NULL), initOutFile(sd);
+   return boxCnt(sd);
+}
+
+/*** UDP send/receive ***/
+#define UDPMAX 4096
+static byte *UdpBuf, *UdpPtr;
+
+static void putUdp(int c) {
+   if (UdpPtr == UdpBuf + UDPMAX)
+      err(NULL, NULL, "UDP overflow");
+   *UdpPtr++ = c;
+}
+
+static int getUdp(void) {
+   if (UdpPtr == UdpBuf + UDPMAX)
+      return -1;
+   return *UdpPtr++;
+}
+
+// (udp 'any1 'cnt 'any2) -> any
+// (udp 'cnt) -> any
+any doUdp(any ex) {
+   any x;
+   int sd;
+   cell c1;
+   struct sockaddr_in addr;
+   byte buf[UDPMAX];
+
+   x = cdr(ex),  data(c1) = EVAL(car(x));
+   if (!isCell(x = cdr(x))) {
+      if (recv((int)xCnt(ex, data(c1)), buf, UDPMAX, 0) < 0)
+         return Nil;
+      getBin = getUdp,  UdpPtr = UdpBuf = buf;
+      return binRead(ExtN) ?: Nil;
+   }
+   Save(c1);
+   if (!server(xSym(data(c1)), (unsigned short)evCnt(ex,x), &addr))
+      x = Nil;
+   else {
+      x = cdr(x),  x = EVAL(car(x));
+      putBin = putUdp,  UdpPtr = UdpBuf = buf,  binPrint(ExtN, x);
+      if ((sd = socket(AF_INET, SOCK_DGRAM, 0)) < 0)
+         ipErr(ex, "socket");
+      sendto(sd, buf, UdpPtr-buf, 0, (struct sockaddr*)&addr, sizeof(struct sockaddr_in));
+      close(sd);
+   }
+   drop(c1);
+   return x;
+}
diff --git a/src/pico.h b/src/pico.h
@@ -0,0 +1,852 @@
+/* 17mar10abu
+ * (c) Software Lab. Alexander Burger
+ */
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <stdarg.h>
+#include <unistd.h>
+#include <limits.h>
+#include <ctype.h>
+#include <string.h>
+#include <math.h>
+#include <errno.h>
+#include <fcntl.h>
+#include <dirent.h>
+#include <termios.h>
+#include <setjmp.h>
+#include <signal.h>
+#include <dlfcn.h>
+#include <time.h>
+#include <sys/types.h>
+#include <sys/time.h>
+#include <sys/times.h>
+#include <sys/stat.h>
+#include <sys/resource.h>
+#ifndef NOWAIT
+#include <sys/wait.h> // tcc doen't like it
+#endif
+
+#ifndef __CYGWIN__
+#define MAIN main
+#else
+#define MAIN main2
+#endif
+
+#define WORD ((int)sizeof(long))
+#define BITS (8*WORD)
+#define MASK ((word)-1)
+#define CELLS (1024*1024/sizeof(cell)) // Heap allocation unit 1MB
+#define IHASH 4999                     // Internal hash table size (should be prime)
+#define EHASH 49999                    // External hash table size (should be prime)
+#define TOP 0x10000                    // Character Top
+
+typedef unsigned long word;
+typedef unsigned char byte;
+typedef unsigned char *ptr;
+typedef unsigned long long word2;
+typedef long long adr;
+
+#undef bool
+typedef enum {NO,YES} bool;
+
+typedef struct cell {            // PicoLisp primary data type
+   struct cell *car;
+   struct cell *cdr;
+} cell, *any;
+
+typedef any (*fun)(any);
+
+typedef struct heap {
+   cell cells[CELLS];
+   struct heap *next;
+} heap;
+
+typedef struct child {
+   int pid;
+   int hear, tell;
+   int ofs, cnt;
+   byte *buf;
+} child;
+
+typedef struct bindFrame {
+   struct bindFrame *link;
+   int i, cnt;
+   struct {any sym; any val;} bnd[1];
+} bindFrame;
+
+typedef struct methFrame {
+   struct methFrame *link;
+   any key, cls;
+} methFrame;
+
+typedef struct inFile {
+   int fd, ix, cnt, next;
+   int line, src;
+   char *name;
+   byte buf[BUFSIZ];
+} inFile;
+
+typedef struct outFile {
+   int fd, ix;
+   bool tty;
+   byte buf[BUFSIZ];
+} outFile;
+
+typedef struct inFrame {
+   struct inFrame *link;
+   void (*get)(void);
+   pid_t pid;
+   int fd;
+} inFrame;
+
+typedef struct outFrame {
+   struct outFrame *link;
+   void (*put)(int);
+   pid_t pid;
+   int fd;
+} outFrame;
+
+typedef struct ctlFrame {
+   struct ctlFrame *link;
+   int fd;
+} ctlFrame;
+
+typedef struct parseFrame {
+   any name;
+   word dig, eof;
+} parseFrame;
+
+typedef struct stkEnv {
+   cell *stack, *arg;
+   bindFrame *bind;
+   methFrame *meth;
+   int next, protect, trace;
+   any task, *make, *yoke;
+   inFrame *inFrames;
+   outFrame *outFrames;
+   ctlFrame *ctlFrames;
+   parseFrame *parser;
+   void (*get)(void);
+   void (*put)(int);
+   bool brk;
+} stkEnv;
+
+typedef struct catchFrame {
+   struct catchFrame *link;
+   any tag, fin;
+   stkEnv env;
+   jmp_buf rst;
+} catchFrame;
+
+/*** Macros ***/
+#define Free(p)         ((p)->car=Avail, Avail=(p))
+#define cellPtr(x)      ((any)((word)(x) & ~(2*WORD-1)))
+
+/* Number access */
+#define num(x)          ((word)(x))
+#define numPtr(x)       ((any)(num(x)+(WORD/2)))
+#define numCell(n)      ((any)(num(n)-(WORD/2)))
+#define box(n)          (consNum(n,Nil))
+#define unDig(x)        num(car(numCell(x)))
+#define setDig(x,v)     (car(numCell(x))=(any)(v))
+#define isNeg(x)        (unDig(x) & 1)
+#define pos(x)          (car(numCell(x)) = (any)(unDig(x) & ~1))
+#define neg(x)          (car(numCell(x)) = (any)(unDig(x) ^ 1))
+#define lo(w)           num((w)&MASK)
+#define hi(w)           num((w)>>BITS)
+
+/* Symbol access */
+#define symPtr(x)       ((any)&(x)->cdr)
+#define val(x)          ((x)->car)
+#define tail(s)         (((s)-1)->cdr)
+#define tail1(s)        ((any)(num(tail(s)) & ~1))
+#define Tail(s,v)       (tail(s) = (any)(num(v) | num(tail(s)) & 1))
+#define ext(x)          ((any)(num(x) | 1))
+#define mkExt(s)        (*(word*)&tail(s) |= 1)
+
+/* Cell access */
+#define car(x)          ((x)->car)
+#define cdr(x)          ((x)->cdr)
+#define caar(x)         (car(car(x)))
+#define cadr(x)         (car(cdr(x)))
+#define cdar(x)         (cdr(car(x)))
+#define cddr(x)         (cdr(cdr(x)))
+#define caaar(x)        (car(car(car(x))))
+#define caadr(x)        (car(car(cdr(x))))
+#define cadar(x)        (car(cdr(car(x))))
+#define caddr(x)        (car(cdr(cdr(x))))
+#define cdaar(x)        (cdr(car(car(x))))
+#define cdadr(x)        (cdr(car(cdr(x))))
+#define cddar(x)        (cdr(cdr(car(x))))
+#define cdddr(x)        (cdr(cdr(cdr(x))))
+#define caaaar(x)       (car(car(car(car(x)))))
+#define caaadr(x)       (car(car(car(cdr(x)))))
+#define caadar(x)       (car(car(cdr(car(x)))))
+#define caaddr(x)       (car(car(cdr(cdr(x)))))
+#define cadaar(x)       (car(cdr(car(car(x)))))
+#define cadadr(x)       (car(cdr(car(cdr(x)))))
+#define caddar(x)       (car(cdr(cdr(car(x)))))
+#define cadddr(x)       (car(cdr(cdr(cdr(x)))))
+#define cdaaar(x)       (cdr(car(car(car(x)))))
+#define cdaadr(x)       (cdr(car(car(cdr(x)))))
+#define cdadar(x)       (cdr(car(cdr(car(x)))))
+#define cdaddr(x)       (cdr(car(cdr(cdr(x)))))
+#define cddaar(x)       (cdr(cdr(car(car(x)))))
+#define cddadr(x)       (cdr(cdr(car(cdr(x)))))
+#define cdddar(x)       (cdr(cdr(cdr(car(x)))))
+#define cddddr(x)       (cdr(cdr(cdr(cdr(x)))))
+
+#define data(c)         ((c).car)
+#define Save(c)         ((c).cdr=Env.stack, Env.stack=&(c))
+#define drop(c)         (Env.stack=(c).cdr)
+#define Push(c,x)       (data(c)=(x), Save(c))
+#define Tuck(c1,c2,x)   (data(c1)=(x), (c1).cdr=(c2).cdr, (c2).cdr=&(c1))
+#define Pop(c)          (drop(c), data(c))
+
+#define Bind(s,f)       ((f).i=0, (f).cnt=1, (f).bnd[0].sym=(s), (f).bnd[0].val=val(s), (f).link=Env.bind, Env.bind=&(f))
+#define Unbind(f)       (val((f).bnd[0].sym)=(f).bnd[0].val, Env.bind=(f).link)
+
+/* Predicates */
+#define isNil(x)        ((x)==Nil)
+#define isNum(x)        (num(x)&(WORD/2))
+#define isSym(x)        (num(x)&WORD)
+#define isCell(x)       (!(num(x)&(2*WORD-2)))
+#define isExt(s)        (num(tail(s))&1)
+#define IsZero(n)       (!unDig(n) && !isNum(cdr(numCell(n))))
+
+/* Evaluation */
+#define EVAL(x)         (isNum(x)? x : isSym(x)? val(x) : evList(x))
+#define evSubr(f,x)     (*(fun)unDig(f))(x)
+
+/* Error checking */
+#define NeedNum(ex,x)   if (!isNum(x)) numError(ex,x)
+#define NeedCnt(ex,x)   if (!isNum(x) || isNum(cdr(numCell(x)))) cntError(ex,x)
+#define NeedSym(ex,x)   if (!isSym(x)) symError(ex,x)
+#define NeedExt(ex,x)   if (!isSym(x) || !isExt(x)) extError(ex,x)
+#define NeedCell(ex,x)  if (!isCell(x)) cellError(ex,x)
+#define NeedAtom(ex,x)  if (isCell(x)) atomError(ex,x)
+#define NeedLst(ex,x)   if (!isCell(x) && !isNil(x)) lstError(ex,x)
+#define NeedVar(ex,x)   if (isNum(x)) varError(ex,x)
+#define CheckNil(ex,x)  if (isNil(x)) protError(ex,x)
+#define CheckVar(ex,x)  if ((x)>=Nil && (x)<=T) protError(ex,x)
+
+/* External symbol access */
+#define Fetch(ex,x)     if (isExt(x)) db(ex,x,1)
+#define Touch(ex,x)     if (isExt(x)) db(ex,x,2)
+
+/* Globals */
+extern int Signal, Repl, Chr, Slot, Spkr, Mic, Hear, Tell, Children, ExtN;
+extern char **AV, *AV0, *Home;
+extern child *Child;
+extern heap *Heaps;
+extern cell *Avail;
+extern stkEnv Env;
+extern catchFrame *CatchPtr;
+extern struct termios OrgTermio, *Termio;
+extern int InFDs, OutFDs;
+extern inFile *InFile, **InFiles;
+extern outFile *OutFile, **OutFiles;
+extern int (*getBin)(void);
+extern void (*putBin)(int);
+extern any TheKey, TheCls, Thrown;
+extern any Alarm, Line, Zero, One, Intern[IHASH], Transient[IHASH], Extern[EHASH];
+extern any ApplyArgs, ApplyBody, DbVal, DbTail;
+extern any Nil, DB, Meth, Quote, T;
+extern any Solo, PPid, Pid, At, At2, At3, This, Dbg, Zap, Ext, Scl, Class;
+extern any Run, Hup, Sig1, Sig2, Up, Err, Msg, Uni, Led, Tsm, Adr, Fork, Bye;
+
+/* Prototypes */
+void *alloc(void*,size_t);
+any apply(any,any,bool,int,cell*);
+void argError(any,any) __attribute__ ((noreturn));
+void atomError(any,any) __attribute__ ((noreturn));
+void begString(void);
+void bigAdd(any,any);
+int bigCompare(any,any);
+any bigCopy(any);
+void bigSub(any,any);
+void binPrint(int,any);
+any binRead(int);
+adr blk64(any);
+any boxChar(int,int*,any*);
+any boxWord2(word2);
+any brkLoad(any);
+int bufSize(any);
+void bufString(any,char*);
+void bye(int) __attribute__ ((noreturn));
+void byteSym(int,int*,any*);
+void cellError(any,any) __attribute__ ((noreturn));
+void charSym(int,int*,any*);
+void closeInFile(int);
+void closeOnExec(any,int);
+void closeOutFile(int);
+void cntError(any,any) __attribute__ ((noreturn));
+int compare(any,any);
+any cons(any,any);
+any consNum(word,any);
+any consStr(any);
+any consSym(any,any);
+void newline(void);
+void ctOpen(any,any,ctlFrame*);
+void db(any,any,int);
+int dbSize(any,any);
+void digAdd(any,word);
+void digDiv2(any);
+void digMul2(any);
+void digSub1(any);
+any doubleToNum(double);
+unsigned long ehash(any);
+any endString(void);
+bool eol(void);
+bool equal(any,any);
+void err(any,any,char*,...) __attribute__ ((noreturn));
+any evExpr(any,any);
+long evCnt(any,any);
+double evDouble(any,any);
+any evList(any);
+any evSym(any);
+void execError(char*) __attribute__ ((noreturn));
+void extError(any,any) __attribute__ ((noreturn));
+any extOffs(int,any);
+any findHash(any,any*);
+int firstByte(any);
+bool flush(outFile*);
+void flushAll(void);
+pid_t forkLisp(any);
+any funq(any);
+any get(any,any);
+int getChar(void);
+void getStdin(void);
+void giveup(char*) __attribute__ ((noreturn));
+bool hashed(any,long,any*);
+void heapAlloc(void);
+any idx(any,any,int);
+unsigned long ihash(any);
+inFile *initInFile(int,char*);
+outFile *initOutFile(int);
+void initSymbols(void);
+any intern(char*);
+bool isBlank(any);
+bool isLife(any);
+void lstError(any,any) __attribute__ ((noreturn));
+any load(any,int,any);
+any loadAll(any);
+any method(any);
+any mkChar(int);
+any mkDat(int,int,int);
+any mkName(char*);
+any mkStr(char*);
+any mkTime(int,int,int);
+any name(any);
+any new64(adr,any);
+any newId(any,int);
+int nonblocking(int);
+int numBytes(any);
+void numError(any,any) __attribute__ ((noreturn));
+double numToDouble(any);
+any numToSym(any,int,int,int);
+void outName(any);
+void outNum(any);
+void outString(char*);
+void outWord(word);
+void pack(any,int*,any*,cell*);
+int pathSize(any);
+void pathString(any,char*);
+void pipeError(any,char*);
+void popCtlFiles(void);
+void popInFiles(void);
+void popOutFiles(void);
+void pr(int,any);
+void prin(any);
+void prin1(any);
+void print(any);
+void print1(any);
+void prn(long);
+void protError(any,any) __attribute__ ((noreturn));
+void pushInFiles(inFrame*);
+void pushOutFiles(outFrame*);
+void pushCtlFiles(ctlFrame*);
+void put(any,any,any);
+void putStdout(int);
+void rdOpen(any,any,inFrame*);
+any read1(int);
+int rdBytes(int,byte*,int,bool);
+int secondByte(any);
+void setCooked(void);
+void setRaw(void);
+bool sharedLib(any);
+void sighandler(any);
+int slow(inFile*,bool);
+void space(void);
+bool subStr(any,any);
+int symByte(any);
+int symChar(any);
+void symError(any,any) __attribute__ ((noreturn));
+any symToNum(any,int,int,int);
+word2 unBoxWord2(any);
+void undefined(any,any);
+void unwind (catchFrame*);
+void varError(any,any) __attribute__ ((noreturn));
+long waitFd(any,int,long);
+bool wrBytes(int,byte*,int);
+void wrOpen(any,any,outFrame*);
+long xCnt(any,any);
+any xSym(any);
+void zapZero(any);
+
+any doAbs(any);
+any doAccept(any);
+any doAdd(any);
+any doAlarm(any);
+any doAll(any);
+any doAnd(any);
+any doAny(any);
+any doAppend(any);
+any doApply(any);
+any doArg(any);
+any doArgs(any);
+any doArgv(any);
+any doArrow(any);
+any doAsoq(any);
+any doAs(any);
+any doAssoc(any);
+any doAt(any);
+any doAtom(any);
+any doBind(any);
+any doBitAnd(any);
+any doBitOr(any);
+any doBitQ(any);
+any doBitXor(any);
+any doBool(any);
+any doBox(any);
+any doBoxQ(any);
+any doBreak(any);
+any doBy(any);
+any doBye(any) __attribute__ ((noreturn));
+any doCaaaar(any);
+any doCaaadr(any);
+any doCaaar(any);
+any doCaadar(any);
+any doCaaddr(any);
+any doCaadr(any);
+any doCaar(any);
+any doCadaar(any);
+any doCadadr(any);
+any doCadar(any);
+any doCaddar(any);
+any doCadddr(any);
+any doCaddr(any);
+any doCadr(any);
+any doCall(any);
+any doCar(any);
+any doCase(any);
+any doCatch(any);
+any doCdaaar(any);
+any doCdaadr(any);
+any doCdaar(any);
+any doCdadar(any);
+any doCdaddr(any);
+any doCdadr(any);
+any doCd(any);
+any doCdar(any);
+any doCddaar(any);
+any doCddadr(any);
+any doCddar(any);
+any doCdddar(any);
+any doCddddr(any);
+any doCdddr(any);
+any doCddr(any);
+any doCdr(any);
+any doChain(any);
+any doChar(any);
+any doChop(any);
+any doCirc(any);
+any doClip(any);
+any doClose(any);
+any doCmd(any);
+any doCnt(any);
+any doCol(any);
+any doCommit(any);
+any doCon(any);
+any doConc(any);
+any doCond(any);
+any doConnect(any);
+any doCons(any);
+any doCopy(any);
+any doCtl(any);
+any doCtty(any);
+any doCut(any);
+any doDate(any);
+any doDbck(any);
+any doDe(any);
+any doDec(any);
+any doDef(any);
+any doDefault(any);
+any doDel(any);
+any doDelete(any);
+any doDelq(any);
+any doDiff(any);
+any doDir(any);
+any doDiv(any);
+any doDm(any);
+any doDo(any);
+any doE(any);
+any doEcho(any);
+any doEnv(any);
+any doEof(any);
+any doEol(any);
+any doEq(any);
+any doEq0(any);
+any doEqT(any);
+any doEqual(any);
+any doEval(any);
+any doExt(any);
+any doExtern(any);
+any doExtQ(any);
+any doExtra(any);
+any doExtract(any);
+any doFifo(any);
+any doFile(any);
+any doFill(any);
+any doFilter(any);
+any doFin(any);
+any doFinally(any);
+any doFind(any);
+any doFish(any);
+any doFlgQ(any);
+any doFlip(any);
+any doFlush(any);
+any doFold(any);
+any doFor(any);
+any doFork(any);
+any doFormat(any);
+any doFree(any);
+any doFrom(any);
+any doFull(any);
+any doFunQ(any);
+any doGc(any);
+any doGe(any);
+any doGe0(any);
+any doGet(any);
+any doGetd(any);
+any doGetl(any);
+any doGlue(any);
+any doGt(any);
+any doGt0(any);
+any doHead(any);
+any doHeap(any);
+any doHear(any);
+any doHide(any);
+any doHost(any);
+any doId(any);
+any doIdx(any);
+any doIf(any);
+any doIf2(any);
+any doIfn(any);
+any doIn(any);
+any doInc(any);
+any doIndex(any);
+any doInfo(any);
+any doIntern(any);
+any doIpid(any);
+any doIsa(any);
+any doJob(any);
+any doJournal(any);
+any doKey(any);
+any doKill(any);
+any doLast(any);
+any doLe(any);
+any doLength(any);
+any doLet(any);
+any doLetQ(any);
+any doLieu(any);
+any doLine(any);
+any doLines(any);
+any doLink(any);
+any doList(any);
+any doListen(any);
+any doLit(any);
+any doLstQ(any);
+any doLoad(any);
+any doLock(any);
+any doLoop(any);
+any doLowQ(any);
+any doLowc(any);
+any doLt(any);
+any doLt0(any);
+any doLup(any);
+any doMade(any);
+any doMake(any);
+any doMap(any);
+any doMapc(any);
+any doMapcan(any);
+any doMapcar(any);
+any doMapcon(any);
+any doMaplist(any);
+any doMaps(any);
+any doMark(any);
+any doMatch(any);
+any doMax(any);
+any doMaxi(any);
+any doMember(any);
+any doMemq(any);
+any doMeta(any);
+any doMeth(any);
+any doMethod(any);
+any doMin(any);
+any doMini(any);
+any doMix(any);
+any doMmeq(any);
+any doMul(any);
+any doMulDiv(any);
+any doName(any);
+any doNand(any);
+any doNEq(any);
+any doNEq0(any);
+any doNEqT(any);
+any doNEqual(any);
+any doNeed(any);
+any doNew(any);
+any doNext(any);
+any doNil(any);
+any doNond(any);
+any doNor(any);
+any doNot(any);
+any doNth(any);
+any doNumQ(any);
+any doOff(any);
+any doOffset(any);
+any doOn(any);
+any doOne(any);
+any doOnOff(any);
+any doOpen(any);
+any doOpid(any);
+any doOpt(any);
+any doOr(any);
+any doOut(any);
+any doPack(any);
+any doPair(any);
+any doPass(any);
+any doPath(any);
+any doPatQ(any);
+any doPeek(any);
+any doPick(any);
+any doPid(any);
+any doPipe(any);
+any doPoll(any);
+any doPool(any);
+any doPop(any);
+any doPort(any);
+any doPr(any);
+any doPreQ(any);
+any doPrin(any);
+any doPrinl(any);
+any doPrint(any);
+any doPrintln(any);
+any doPrintsp(any);
+any doProg(any);
+any doProg1(any);
+any doProg2(any);
+any doProp(any);
+any doPropCol(any);
+any doProtect(any);
+any doProve(any);
+any doPush(any);
+any doPush1(any);
+any doPut(any);
+any doPutl(any);
+any doPwd(any);
+any doQueue(any);
+any doQuit(any);
+any doQuote(any);
+any doRand(any);
+any doRange(any);
+any doRank(any);
+any doRaw(any);
+any doRd(any);
+any doRead(any);
+any doRem(any);
+any doReplace(any);
+any doRest(any);
+any doReverse(any);
+any doRewind(any);
+any doRollback(any);
+any doRot(any);
+any doRpc(any);
+any doRun(any);
+any doSect(any);
+any doSeed(any);
+any doSeek(any);
+any doSemicol(any);
+any doSend(any);
+any doSeq(any);
+any doSet(any);
+any doSetCol(any);
+any doSetq(any);
+any doShift(any);
+any doSize(any);
+any doSkip(any);
+any doSort(any);
+any doSpace(any);
+any doSplit(any);
+any doSpQ(any);
+any doState(any);
+any doStem(any);
+any doStr(any);
+any doStrip(any);
+any doStrQ(any);
+any doSub(any);
+any doSubQ(any);
+any doSum(any);
+any doSuper(any);
+any doSym(any);
+any doSymQ(any);
+any doSync(any);
+any doSys(any);
+any doT(any);
+any doTail(any);
+any doTell(any);
+any doText(any);
+any doThrow(any);
+any doTick(any);
+any doTill(any);
+any doTime(any);
+any doTouch(any);
+any doTrace(any);
+any doTrim(any);
+any doTry(any);
+any doType(any);
+any doUdp(any);
+any doUnify(any);
+any doUnless(any);
+any doUntil(any);
+any doUp(any);
+any doUppQ(any);
+any doUppc(any);
+any doUse(any);
+any doUsec(any);
+any doVal(any);
+any doWait(any);
+any doWhen(any);
+any doWhile(any);
+any doWipe(any);
+any doWith(any);
+any doWr(any);
+any doXchg(any);
+any doXor(any);
+any doYoke(any);
+any doZap(any);
+any doZero(any);
+
+static inline long unBox(any x) {
+   long n = unDig(x) / 2;
+   return unDig(x) & 1? -n : n;
+}
+
+static inline any boxCnt(long n) {return box(n>=0?  n*2 : -n*2+1);}
+
+/* List element access */
+static inline any nCdr(int n, any x) {
+   while (--n >= 0)
+      x = cdr(x);
+   return x;
+}
+
+static inline any nth(int n, any x) {
+   if (--n < 0)
+      return Nil;
+   return nCdr(n,x);
+}
+
+static inline any getn(any x, any y) {
+   if (isNum(x)) {
+      long n = unDig(x) / 2;
+
+      if (isNeg(x)) {
+         while (--n)
+            y = cdr(y);
+         return cdr(y);
+      }
+      if (n == 0)
+         return Nil;
+      while (--n)
+         y = cdr(y);
+      return car(y);
+   }
+   do
+      if (isCell(car(y)) && x == caar(y))
+         return cdar(y);
+   while (isCell(y = cdr(y)));
+   return Nil;
+}
+
+/* List length calculation */
+static inline int length(any x) {
+   int n;
+
+   for (n = 0; isCell(x); x = cdr(x))
+      ++n;
+   return n;
+}
+
+/* Membership */
+static inline any member(any x, any y) {
+   any z = y;
+
+   while (isCell(y)) {
+      if (equal(x, car(y)))
+         return y;
+      if (z == (y = cdr(y)))
+         return NULL;
+   }
+   return isNil(y) || !equal(x,y)? NULL : y;
+}
+
+static inline any memq(any x, any y) {
+   any z = y;
+
+   while (isCell(y)) {
+      if (x == car(y))
+         return y;
+      if (z == (y = cdr(y)))
+         return NULL;
+   }
+   return isNil(y) || x != y? NULL : y;
+}
+
+static inline int indx(any x, any y) {
+   int n = 1;
+   any z = y;
+
+   while (isCell(y)) {
+      if (equal(x, car(y)))
+         return n;
+      ++n;
+      if (z == (y = cdr(y)))
+         return 0;
+   }
+   return 0;
+}
+
+/* List interpreter */
+static inline any prog(any x) {
+   any y;
+
+   do
+      y = EVAL(car(x));
+   while (isCell(x = cdr(x)));
+   return y;
+}
+
+static inline any run(any x) {
+   any y;
+   cell at;
+
+   Push(at,val(At));
+   do
+      y = EVAL(car(x));
+   while (isCell(x = cdr(x)));
+   val(At) = Pop(at);
+   return y;
+}
diff --git a/src/ssl.c b/src/ssl.c
@@ -0,0 +1,241 @@
+/* 20jul09abu
+ * (c) Software Lab. Alexander Burger
+ */
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <unistd.h>
+#include <fcntl.h>
+#include <dirent.h>
+#include <errno.h>
+#include <string.h>
+#include <signal.h>
+#include <netdb.h>
+#include <sys/stat.h>
+#include <sys/socket.h>
+#include <arpa/inet.h>
+#include <netinet/tcp.h>
+#include <netinet/in.h>
+
+#include <openssl/pem.h>
+#include <openssl/ssl.h>
+#include <openssl/err.h>
+
+typedef enum {NO,YES} bool;
+
+static char *File, *Dir, *Data;
+static off_t Size;
+
+static char Get[] =
+   "GET /%s HTTP/1.0\r\n"
+   "User-Agent: PicoLisp\r\n"
+   "Host: %s:%s\r\n"
+   "Accept-Charset: utf-8\r\n\r\n";
+
+static void errmsg(char *msg) {
+   fprintf(stderr, "ssl: %s\n", msg);
+}
+
+static void giveup(char *msg) {
+   errmsg(msg);
+   exit(1);
+}
+
+static void sslChk(int n) {
+   if (n < 0) {
+      ERR_print_errors_fp(stderr);
+      exit(1);
+   }
+}
+
+static int sslConnect(SSL *ssl, char *host, int port) {
+   struct sockaddr_in addr;
+   struct hostent *p;
+   int sd;
+
+   memset(&addr, 0, sizeof(addr));
+   if ((long)(addr.sin_addr.s_addr = inet_addr(host)) == -1) {
+      if (!(p = gethostbyname(host))  ||  p->h_length == 0)
+         return -1;
+      addr.sin_addr.s_addr = ((struct in_addr*)p->h_addr_list[0])->s_addr;
+   }
+
+   if ((sd = socket(AF_INET, SOCK_STREAM, 0)) < 0) {
+      errmsg("No socket");
+      return -1;
+   }
+   addr.sin_family = AF_INET;
+   addr.sin_port = htons((unsigned short)port);
+   if (connect(sd, (struct sockaddr*)&addr, sizeof(addr)) < 0) {
+      close(sd);
+      return -1;
+   }
+
+   SSL_set_fd(ssl,sd);
+   if (SSL_connect(ssl) >= 0)
+      return sd;
+   close(sd);
+   return -1;
+}
+
+static void sslClose(SSL *ssl, int sd) {
+   SSL_shutdown(ssl);
+   close(sd);
+}
+
+static bool sslFile(SSL *ssl, char *file) {
+   int fd, n;
+   char buf[BUFSIZ];
+
+   if (file[0] == '-')
+      return SSL_write(ssl, file+1, strlen(file)-1) >= 0;
+   if ((fd = open(file, O_RDONLY)) < 0)
+      return NO;
+   while ((n = read(fd, buf, sizeof(buf))) > 0)
+      if (SSL_write(ssl, buf, n) < 0) {
+         close(fd);
+         return NO;
+      }
+   close(fd);
+   return n == 0;
+}
+
+static void doSigTerm(int n __attribute__((unused))) {
+   int fd1, fd2, cnt;
+   char buf[BUFSIZ];
+
+   if (Data  &&  (fd1 = open(File, O_RDWR)) >= 0) {
+      if (unlink(File) < 0)
+         giveup("Can't unlink back");
+      if ((fd2 = open(File, O_CREAT|O_WRONLY|O_TRUNC, 0666)) < 0)
+         giveup("Can't create back");
+      if (write(fd2, Data, Size) != Size)
+         giveup("Can't write back");
+      while ((cnt = read(fd1, buf, sizeof(buf))) > 0)
+         write(fd2, buf, cnt);
+   }
+   exit(0);
+}
+
+// ssl host port url
+// ssl host port url file
+// ssl host port url key file
+// ssl host port url key file dir sec
+int main(int ac, char *av[]) {
+   SSL_CTX *ctx;
+   SSL *ssl;
+   bool bin;
+   int n, sec, getLen, lenLen, fd, sd;
+   DIR *dp;
+   struct dirent *p;
+   struct stat st;
+   struct flock fl;
+   char get[1024], buf[4096], nm[4096], len[64];
+
+   if (!(ac >= 4 && ac <= 6  ||  ac == 8))
+      giveup("host port url [[key] file] | host port url key file dir sec");
+   if (strlen(Get)+strlen(av[1])+strlen(av[2])+strlen(av[3]) >= sizeof(get))
+      giveup("Names too long");
+   if (strchr(av[3],'/'))
+      bin = NO,  getLen = sprintf(get, Get, av[3], av[1], av[2]);
+   else
+      bin = YES,  getLen = sprintf(get, "@%s ", av[3]);
+
+   SSL_library_init();
+   SSL_load_error_strings();
+   if (!(ctx = SSL_CTX_new(SSLv23_client_method()))) {
+      ERR_print_errors_fp(stderr);
+      giveup("SSL init");
+   }
+   ssl = SSL_new(ctx);
+
+   if (ac <= 6) {
+      if (sslConnect(ssl, av[1], atoi(av[2])) < 0) {
+         errmsg("Can't connect");
+         return 1;
+      }
+      sslChk(SSL_write(ssl, get, getLen));
+      if (ac > 4) {
+         if (*av[4]  &&  !sslFile(ssl,av[4]))
+            giveup(av[4]);
+         if (ac > 5  &&  *av[5]  &&  !sslFile(ssl,av[5]))
+            giveup(av[5]);
+      }
+      while ((n = SSL_read(ssl, buf, sizeof(buf))) > 0)
+         write(STDOUT_FILENO, buf, n);
+      return 0;
+   }
+
+   signal(SIGCHLD,SIG_IGN);  /* Prevent zombies */
+   if ((n = fork()) < 0)
+      giveup("detach");
+   if (n)
+      return 0;
+   setsid();
+
+   File = av[5];
+   Dir = av[6];
+   sec = atoi(av[7]);
+   signal(SIGINT, doSigTerm);
+   signal(SIGTERM, doSigTerm);
+   signal(SIGPIPE, SIG_IGN);
+   for (;;) {
+      if (*File && (fd = open(File, O_RDWR)) >= 0) {
+         if (fstat(fd,&st) < 0  ||  st.st_size == 0)
+            close(fd);
+         else {
+            fl.l_type = F_WRLCK;
+            fl.l_whence = SEEK_SET;
+            fl.l_start = 0;
+            fl.l_len = 0;
+            if (fcntl(fd, F_SETLKW, &fl) < 0)
+               giveup("Can't lock");
+            if (fstat(fd,&st) < 0  ||  (Size = st.st_size) == 0)
+               giveup("Can't access");
+            lenLen = sprintf(len, "%lld\n", Size);
+            if ((Data = malloc(Size)) == NULL)
+               giveup("Can't alloc");
+            if (read(fd, Data, Size) != Size)
+               giveup("Can't read");
+            if (ftruncate(fd,0) < 0)
+               errmsg("Can't truncate");
+            close(fd);
+            for (;;) {
+               if ((sd = sslConnect(ssl, av[1], atoi(av[2]))) >= 0) {
+                  if (SSL_write(ssl, get, getLen) == getLen  &&
+                           (!*av[4] || sslFile(ssl,av[4]))  &&                   // key
+                           (bin || SSL_write(ssl, len, lenLen) == lenLen)  &&    // length
+                           SSL_write(ssl, Data, Size) == Size  &&                // data
+                           SSL_write(ssl, bin? "\0" : "T", 1) == 1  &&           // ack
+                           SSL_read(ssl, buf, 1) == 1  &&  buf[0] == 'T' ) {
+                     sslClose(ssl,sd);
+                     break;
+                  }
+                  sslClose(ssl,sd);
+               }
+               sleep(sec);
+            }
+            free(Data),  Data = NULL;
+         }
+      }
+      if (*Dir && (dp = opendir(Dir))) {
+         while (p = readdir(dp)) {
+            if (p->d_name[0] != '.') {
+               snprintf(nm, sizeof(nm), "%s%s", Dir, p->d_name);
+               if ((n = readlink(nm, buf, sizeof(buf))) > 0  &&
+                        (sd = sslConnect(ssl, av[1], atoi(av[2]))) >= 0 ) {
+                  if (SSL_write(ssl, get, getLen) == getLen  &&
+                        (!*av[4] || sslFile(ssl,av[4]))  &&          // key
+                        (bin || SSL_write(ssl, buf, n) == n)  &&     // path
+                        (bin || SSL_write(ssl, "\n", 1) == 1)  &&    // nl
+                        sslFile(ssl, nm) )                           // file
+                     unlink(nm);
+                  sslClose(ssl,sd);
+               }
+            }
+         }
+         closedir(dp);
+      }
+      sleep(sec);
+   }
+}
diff --git a/src/start.c b/src/start.c
@@ -0,0 +1,10 @@
+/* 03sep06abu
+ * (c) Software Lab. Alexander Burger
+ */
+
+extern void main2(int ac, char *av[]) __attribute__ ((noreturn));
+int main(int ac, char *av[]) __attribute__ ((noreturn));
+
+int main(int ac, char *av[]) {
+   main2(ac,av);
+}
diff --git a/src/subr.c b/src/subr.c
@@ -0,0 +1,1686 @@
+/* 07nov09abu
+ * (c) Software Lab. Alexander Burger
+ */
+
+#include "pico.h"
+
+// (car 'var) -> any
+any doCar(any ex) {
+   any x = cdr(ex);
+   x = EVAL(car(x));
+   NeedVar(ex,x);
+   return car(x);
+}
+
+// (cdr 'lst) -> any
+any doCdr(any ex) {
+   any x = cdr(ex);
+   x = EVAL(car(x));
+   NeedLst(ex,x);
+   return cdr(x);
+}
+
+any doCaar(any ex) {
+   any x = cdr(ex);
+   x = EVAL(car(x));
+   NeedVar(ex,x);
+   return caar(x);
+}
+
+any doCadr(any ex) {
+   any x = cdr(ex);
+   x = EVAL(car(x));
+   NeedLst(ex,x);
+   return cadr(x);
+}
+
+any doCdar(any ex) {
+   any x = cdr(ex);
+   x = EVAL(car(x));
+   NeedVar(ex,x);
+   return cdar(x);
+}
+
+any doCddr(any ex) {
+   any x = cdr(ex);
+   x = EVAL(car(x));
+   NeedLst(ex,x);
+   return cddr(x);
+}
+
+any doCaaar(any ex) {
+   any x = cdr(ex);
+   x = EVAL(car(x));
+   NeedVar(ex,x);
+   return caaar(x);
+}
+
+any doCaadr(any ex) {
+   any x = cdr(ex);
+   x = EVAL(car(x));
+   NeedLst(ex,x);
+   return caadr(x);
+}
+
+any doCadar(any ex) {
+   any x = cdr(ex);
+   x = EVAL(car(x));
+   NeedVar(ex,x);
+   return cadar(x);
+}
+
+any doCaddr(any ex) {
+   any x = cdr(ex);
+   x = EVAL(car(x));
+   NeedLst(ex,x);
+   return caddr(x);
+}
+
+any doCdaar(any ex) {
+   any x = cdr(ex);
+   x = EVAL(car(x));
+   NeedVar(ex,x);
+   return cdaar(x);
+}
+
+any doCdadr(any ex) {
+   any x = cdr(ex);
+   x = EVAL(car(x));
+   NeedLst(ex,x);
+   return cdadr(x);
+}
+
+any doCddar(any ex) {
+   any x = cdr(ex);
+   x = EVAL(car(x));
+   NeedVar(ex,x);
+   return cddar(x);
+}
+
+any doCdddr(any ex) {
+   any x = cdr(ex);
+   x = EVAL(car(x));
+   NeedLst(ex,x);
+   return cdddr(x);
+}
+
+any doCaaaar(any ex) {
+   any x = cdr(ex);
+   x = EVAL(car(x));
+   NeedVar(ex,x);
+   return caaaar(x);
+}
+
+any doCaaadr(any ex) {
+   any x = cdr(ex);
+   x = EVAL(car(x));
+   NeedLst(ex,x);
+   return caaadr(x);
+}
+
+any doCaadar(any ex) {
+   any x = cdr(ex);
+   x = EVAL(car(x));
+   NeedVar(ex,x);
+   return caadar(x);
+}
+
+any doCaaddr(any ex) {
+   any x = cdr(ex);
+   x = EVAL(car(x));
+   NeedLst(ex,x);
+   return caaddr(x);
+}
+
+any doCadaar(any ex) {
+   any x = cdr(ex);
+   x = EVAL(car(x));
+   NeedVar(ex,x);
+   return cadaar(x);
+}
+
+any doCadadr(any ex) {
+   any x = cdr(ex);
+   x = EVAL(car(x));
+   NeedLst(ex,x);
+   return cadadr(x);
+}
+
+any doCaddar(any ex) {
+   any x = cdr(ex);
+   x = EVAL(car(x));
+   NeedVar(ex,x);
+   return caddar(x);
+}
+
+any doCadddr(any ex) {
+   any x = cdr(ex);
+   x = EVAL(car(x));
+   NeedLst(ex,x);
+   return cadddr(x);
+}
+
+any doCdaaar(any ex) {
+   any x = cdr(ex);
+   x = EVAL(car(x));
+   NeedVar(ex,x);
+   return cdaaar(x);
+}
+
+any doCdaadr(any ex) {
+   any x = cdr(ex);
+   x = EVAL(car(x));
+   NeedLst(ex,x);
+   return cdaadr(x);
+}
+
+any doCdadar(any ex) {
+   any x = cdr(ex);
+   x = EVAL(car(x));
+   NeedVar(ex,x);
+   return cdadar(x);
+}
+
+any doCdaddr(any ex) {
+   any x = cdr(ex);
+   x = EVAL(car(x));
+   NeedLst(ex,x);
+   return cdaddr(x);
+}
+
+any doCddaar(any ex) {
+   any x = cdr(ex);
+   x = EVAL(car(x));
+   NeedVar(ex,x);
+   return cddaar(x);
+}
+
+any doCddadr(any ex) {
+   any x = cdr(ex);
+   x = EVAL(car(x));
+   NeedLst(ex,x);
+   return cddadr(x);
+}
+
+any doCdddar(any ex) {
+   any x = cdr(ex);
+   x = EVAL(car(x));
+   NeedVar(ex,x);
+   return cdddar(x);
+}
+
+any doCddddr(any ex) {
+   any x = cdr(ex);
+   x = EVAL(car(x));
+   NeedLst(ex,x);
+   return cddddr(x);
+}
+
+// (nth 'lst 'cnt ..) -> lst
+any doNth(any ex) {
+   any x;
+   cell c1;
+
+   x = cdr(ex),  Push(c1, EVAL(car(x))),  x = cdr(x);
+   for (;;) {
+      if (!isCell(data(c1)))
+         return Pop(c1);
+      data(c1) = nth((int)evCnt(ex,x), data(c1));
+      if (!isCell(x = cdr(x)))
+         return Pop(c1);
+      data(c1) = car(data(c1));
+   }
+}
+
+// (con 'lst 'any) -> any
+any doCon(any ex) {
+   any x;
+   cell c1;
+
+   x = cdr(ex),  Push(c1, EVAL(car(x)));
+   NeedCell(ex,data(c1));
+   x = cdr(x),  x = cdr(data(c1)) = EVAL(car(x));
+   drop(c1);
+   return x;
+}
+
+// (cons 'any ['any ..]) -> lst
+any doCons(any x) {
+   any y;
+   cell c1;
+
+   x = cdr(x);
+   Push(c1, y = cons(EVAL(car(x)),Nil));
+   while (isCell(cdr(x = cdr(x))))
+      y = cdr(y) = cons(EVAL(car(x)),Nil);
+   cdr(y) = EVAL(car(x));
+   return Pop(c1);
+}
+
+// (conc 'lst ..) -> lst
+any doConc(any x) {
+   any y, z;
+   cell c1;
+
+   x = cdr(x),  Push(c1, y = EVAL(car(x)));
+   while (isCell(x = cdr(x))) {
+      z = EVAL(car(x));
+      if (!isCell(y))
+         y = data(c1) = z;
+      else {
+         while (isCell(cdr(y)))
+            y = cdr(y);
+         cdr(y) = z;
+      }
+   }
+   return Pop(c1);
+}
+
+// (circ 'any ..) -> lst
+any doCirc(any x) {
+   any y;
+   cell c1;
+
+   x = cdr(x);
+   Push(c1, y = cons(EVAL(car(x)),Nil));
+   while (isCell(x = cdr(x)))
+      y = cdr(y) = cons(EVAL(car(x)),Nil);
+   cdr(y) = data(c1);
+   return Pop(c1);
+}
+
+// (rot 'lst ['cnt]) -> lst
+any doRot(any ex) {
+   any x, y, z;
+   int n;
+   cell c1;
+
+   x = cdr(ex),  Push(c1, y = EVAL(car(x)));
+   if (isCell(y)) {
+      n = isCell(x = cdr(x))? (int)evCnt(ex,x) : 0;
+      x = car(y);
+      while (--n  &&  isCell(y = cdr(y))  &&  y != data(c1))
+         z = car(y),  car(y) = x,  x = z;
+      car(data(c1)) = x;
+   }
+   return Pop(c1);
+}
+
+// (list 'any ['any ..]) -> lst
+any doList(any x) {
+   any y;
+   cell c1;
+
+   x = cdr(x);
+   Push(c1, y = cons(EVAL(car(x)),Nil));
+   while (isCell(x = cdr(x)))
+      y = cdr(y) = cons(EVAL(car(x)),Nil);
+   return Pop(c1);
+}
+
+// (need 'cnt ['lst ['any]]) -> lst
+any doNeed(any ex) {
+   int n;
+   any x;
+   cell c1, c2;
+
+   n = (int)evCnt(ex, x = cdr(ex));
+   x = cdr(x),  Push(c1, EVAL(car(x)));
+   Push(c2, EVAL(cadr(x)));
+   x = data(c1);
+   if (n > 0)
+      for (n -= length(x); n > 0; --n)
+         data(c1) = cons(data(c2), data(c1));
+   else if (n) {
+      if (!isCell(x))
+         data(c1) = x = cons(data(c2),Nil);
+      else
+         while (isCell(cdr(x)))
+            ++n,  x = cdr(x);
+      while (++n < 0)
+         x = cdr(x) = cons(data(c2),Nil);
+   }
+   return Pop(c1);
+}
+
+// (range 'num1 'num2 ['num3]) -> lst
+any doRange(any ex) {
+   any x;
+   cell c1, c2, c3, c4;
+
+   x = cdr(ex),  Push(c1, EVAL(car(x)));  // Start value
+   NeedNum(ex,data(c1));
+   x = cdr(x),  Push(c2, EVAL(car(x)));  // End value
+   NeedNum(ex,data(c2));
+   x = cdr(x),  Push(c3, One);  // Increment
+   if (!isNil(x = EVAL(car(x)))) {
+      NeedNum(ex, data(c3) = x);
+      if (IsZero(x) || isNeg(x))
+         argError(ex,x);
+   }
+   Push(c4, x = cons(data(c1), Nil));
+   if (bigCompare(data(c2), data(c1)) >= 0) {
+      for (;;) {
+         data(c1) = bigCopy(data(c1));
+         if (!isNeg(data(c1)))
+            bigAdd(data(c1), data(c3));
+         else {
+            bigSub(data(c1), data(c3));
+            if (!IsZero(data(c1)))
+               neg(data(c1));
+         }
+         if (bigCompare(data(c2), data(c1)) < 0)
+            break;
+         x = cdr(x) = cons(data(c1), Nil);
+      }
+   }
+   else {
+      for (;;) {
+         data(c1) = bigCopy(data(c1));
+         if (!isNeg(data(c1)))
+            bigSub(data(c1), data(c3));
+         else {
+            bigAdd(data(c1), data(c3));
+            if (!IsZero(data(c1)))
+               neg(data(c1));
+         }
+         if (bigCompare(data(c2), data(c1)) > 0)
+            break;
+         x = cdr(x) = cons(data(c1),Nil);
+      }
+   }
+   drop(c1);
+   return data(c4);
+}
+
+// (full 'any) -> bool
+any doFull(any x) {
+   x = cdr(x);
+   for (x = EVAL(car(x)); isCell(x); x = cdr(x))
+      if (isNil(car(x)))
+         return Nil;
+   return T;
+}
+
+// (make .. [(made 'lst ..)] .. [(link 'any ..)] ..) -> any
+any doMake(any x) {
+   any *make, *yoke;
+   cell c1;
+
+   Push(c1, Nil);
+   make = Env.make;
+   yoke = Env.yoke;
+   Env.make = Env.yoke = &data(c1);
+   while (isCell(x = cdr(x)))
+      if (isCell(car(x)))
+         evList(car(x));
+   Env.yoke = yoke;
+   Env.make = make;
+   return Pop(c1);
+}
+
+static void makeError(any ex) {err(ex, NULL, "Not making");}
+
+// (made ['lst1 ['lst2]]) -> lst
+any doMade(any x) {
+   if (!Env.make)
+      makeError(x);
+   if (isCell(x = cdr(x))) {
+      *Env.yoke = EVAL(car(x));
+      if (x = cdr(x), !isCell(x = EVAL(car(x)))) {
+         x = *Env.yoke;
+         while (isCell(cdr(x = cdr(x))));
+      }
+      Env.make = &cdr(x);
+   }
+   return *Env.yoke;
+}
+
+// (chain 'lst ..) -> lst
+any doChain(any x) {
+   any y;
+
+   if (!Env.make)
+      makeError(x);
+   x = cdr(x);
+   do
+      if (isCell(*Env.make = y = EVAL(car(x))))
+         do
+            Env.make = &cdr(*Env.make);
+         while (isCell(*Env.make));
+   while (isCell(x = cdr(x)));
+   return y;
+}
+
+// (link 'any ..) -> any
+any doLink(any x) {
+   any y;
+
+   if (!Env.make)
+      makeError(x);
+   x = cdr(x);
+   do {
+      y = EVAL(car(x));
+      Env.make = &cdr(*Env.make = cons(y, Nil));
+   } while (isCell(x = cdr(x)));
+   return y;
+}
+
+// (yoke 'any ..) -> any
+any doYoke(any x) {
+   any y;
+
+   if (!Env.make)
+      makeError(x);
+   x = cdr(x);
+   do {
+      y = EVAL(car(x));
+      *Env.yoke = cons(y, *Env.yoke);
+   } while (isCell(x = cdr(x)));
+   while (isCell(*Env.make))
+      Env.make = &cdr(*Env.make);
+   return y;
+}
+
+// (copy 'any) -> any
+any doCopy(any x) {
+   any y, z;
+   cell c1;
+
+   x = cdr(x);
+   if (!isCell(x = EVAL(car(x))))
+      return x;
+   Push(c1, y = cons(car(x), cdr(z = x)));
+   while (isCell(x = cdr(y))) {
+      if (x == z) {
+         cdr(y) = data(c1);
+         break;
+      }
+      y = cdr(y) = cons(car(x), cdr(x));
+   }
+   return Pop(c1);
+}
+
+// (mix 'lst cnt|'any ..) -> lst
+any doMix(any x) {
+   any y;
+   cell c1, c2;
+
+   x = cdr(x);
+   if (!isCell(data(c1) = EVAL(car(x))) && !isNil(data(c1)))
+      return data(c1);
+   if (!isCell(x = cdr(x)))
+      return Nil;
+   Save(c1);
+   Push(c2,
+      y = cons(
+         isNum(car(x))? car(nth((int)unBox(car(x)),data(c1))) : EVAL(car(x)),
+         Nil ) );
+   while (isCell(x = cdr(x)))
+      y = cdr(y) = cons(
+         isNum(car(x))? car(nth((int)unBox(car(x)),data(c1))) : EVAL(car(x)),
+         Nil );
+   drop(c1);
+   return data(c2);
+}
+
+// (append 'lst ..) -> lst
+any doAppend(any x) {
+   any y, z;
+   cell c1;
+
+   while (isCell(cdr(x = cdr(x)))) {
+      if (isCell(y = EVAL(car(x)))) {
+         Push(c1, z = cons(car(y), cdr(y)));
+         while (isCell(y = cdr(z)))
+            z = cdr(z) = cons(car(y), cdr(y));
+         while (isCell(cdr(x = cdr(x)))) {
+            y = EVAL(car(x));
+            while (isCell(y)) {
+               z = cdr(z) = cons(car(y), cdr(y));
+               y = cdr(z);
+            }
+            cdr(z) = y;
+         }
+         cdr(z) = EVAL(car(x));
+         return Pop(c1);
+      }
+   }
+   return EVAL(car(x));
+}
+
+// (delete 'any 'lst) -> lst
+any doDelete(any x) {
+   any y, z;
+   cell c1, c2, c3;
+
+   x = cdr(x),  Push(c1, y = EVAL(car(x)));
+   x = cdr(x);
+   if (!isCell(x = EVAL(car(x)))) {
+      drop(c1);
+      return x;
+   }
+   if (equal(y, car(x))) {
+      drop(c1);
+      return cdr(x);
+   }
+   Push(c2, x);
+   Push(c3, z = cons(car(x), Nil));
+   while (isCell(x = cdr(x))) {
+      if (equal(y, car(x))) {
+         cdr(z) = cdr(x);
+         drop(c1);
+         return data(c3);
+      }
+      z = cdr(z) = cons(car(x), Nil);
+   }
+   cdr(z) = x;
+   drop(c1);
+   return data(c3);
+}
+
+// (delq 'any 'lst) -> lst
+any doDelq(any x) {
+   any y, z;
+   cell c1, c2, c3;
+
+   x = cdr(x),  Push(c1, y = EVAL(car(x)));
+   x = cdr(x);
+   if (!isCell(x = EVAL(car(x)))) {
+      drop(c1);
+      return x;
+   }
+   if (y == car(x)) {
+      drop(c1);
+      return cdr(x);
+   }
+   Push(c2, x);
+   Push(c3, z = cons(car(x), Nil));
+   while (isCell(x = cdr(x))) {
+      if (y == car(x)) {
+         cdr(z) = cdr(x);
+         drop(c1);
+         return data(c3);
+      }
+      z = cdr(z) = cons(car(x), Nil);
+   }
+   cdr(z) = x;
+   drop(c1);
+   return data(c3);
+}
+
+// (replace 'lst 'any1 'any2 ..) -> lst
+any doReplace(any x) {
+   any y;
+   int i, n = length(cdr(x = cdr(x))) + 1 & ~1;
+   cell c1, c2, c[n];
+
+   if (!isCell(data(c1) = EVAL(car(x))))
+      return data(c1);
+   Save(c1);
+   for (i = 0; i < n; ++i)
+      x = cdr(x),  Push(c[i], EVAL(car(x)));
+   for (i = 0;  i < n;  i += 2)
+      if (equal(car(data(c1)), data(c[i]))) {
+         x = data(c[i+1]);
+         goto rpl1;
+      }
+   x = car(data(c1));
+rpl1:
+   Push(c2, y = cons(x,Nil));
+   while (isCell(data(c1) = cdr(data(c1)))) {
+      for (i = 0;  i < n;  i += 2)
+         if (equal(car(data(c1)), data(c[i]))) {
+            x = data(c[i+1]);
+            goto rpl2;
+         }
+      x = car(data(c1));
+   rpl2:
+      y = cdr(y) = cons(x, Nil);
+   }
+   cdr(y) = data(c1);
+   drop(c1);
+   return data(c2);
+}
+
+// (strip 'any) -> any
+any doStrip(any x) {
+   x = cdr(x),  x = EVAL(car(x));
+   while (isCell(x)  &&  car(x) == Quote  && x != cdr(x))
+      x = cdr(x);
+   return x;
+}
+
+// (split 'lst 'any ..) -> lst
+any doSplit(any x) {
+   any y;
+   int i, n = length(cdr(x = cdr(x)));
+   cell c1, c[n], res, sub;
+
+   if (!isCell(data(c1) = EVAL(car(x))))
+      return data(c1);
+   Save(c1);
+   for (i = 0; i < n; ++i)
+      x = cdr(x),  Push(c[i], EVAL(car(x)));
+   Push(res, x = Nil);
+   Push(sub, y = Nil);
+   do {
+      for (i = 0;  i < n;  ++i) {
+         if (equal(car(data(c1)), data(c[i]))) {
+            if (isNil(x))
+               x = data(res) = cons(data(sub), Nil);
+            else
+               x = cdr(x) = cons(data(sub), Nil);
+            y = data(sub) = Nil;
+            goto spl1;
+         }
+      }
+      if (isNil(y))
+         y = data(sub) = cons(car(data(c1)), Nil);
+      else
+         y = cdr(y) = cons(car(data(c1)), Nil);
+   spl1: ;
+   } while (isCell(data(c1) = cdr(data(c1))));
+   y = cons(data(sub), Nil);
+   drop(c1);
+   if (isNil(x))
+      return y;
+   cdr(x) = y;
+   return data(res);
+}
+
+// (reverse 'lst) -> lst
+any doReverse(any x) {
+   any y;
+   cell c1;
+
+   x = cdr(x),  Push(c1, x = EVAL(car(x)));
+   for (y = Nil; isCell(x); x = cdr(x))
+      y = cons(car(x), y);
+   drop(c1);
+   return y;
+}
+
+// (flip 'lst ['cnt])) -> lst
+any doFlip(any ex) {
+   any x, y, z;
+   int n;
+   cell c1;
+
+   x = cdr(ex);
+   if (!isCell(y = EVAL(car(x))) || !isCell(z = cdr(y)))
+      return y;
+   if (!isCell(x = cdr(x))) {
+      cdr(y) = Nil;
+      for (;;) {
+         x = cdr(z),  cdr(z) = y;
+         if (!isCell(x))
+            return z;
+         y = z,  z = x;
+      }
+   }
+   Push(c1, y);
+   n = (int)evCnt(ex,x) - 1;
+   drop(c1);
+   if (n <= 0)
+      return y;
+   cdr(y) = cdr(z),  cdr(z) = y;
+   while (--n && isCell(x = cdr(y)))
+      cdr(y) = cdr(x),  cdr(x) = z,  z = x;
+   return z;
+}
+
+static any trim(any x) {
+   any y;
+
+   if (!isCell(x))
+      return x;
+   if (isNil(y = trim(cdr(x))) && isBlank(car(x)))
+      return Nil;
+   return cons(car(x),y);
+}
+
+// (trim 'lst) -> lst
+any doTrim(any x) {
+   cell c1;
+
+   x = cdr(x),  Push(c1, EVAL(car(x)));
+   x = trim(data(c1));
+   drop(c1);
+   return x;
+}
+
+// (clip 'lst) -> lst
+any doClip(any x) {
+   cell c1;
+
+   x = cdr(x),  Push(c1, EVAL(car(x)));
+   while (isCell(data(c1)) && isBlank(car(data(c1))))
+      data(c1) = cdr(data(c1));
+   x = trim(data(c1));
+   drop(c1);
+   return x;
+}
+
+// (head 'cnt|lst 'lst) -> lst
+any doHead(any ex) {
+   long n;
+   any x, y;
+   cell c1, c2;
+
+   x = cdr(ex);
+   if (isNil(data(c1) = EVAL(car(x))))
+      return Nil;
+   x = cdr(x);
+   if (isCell(data(c1))) {
+      Save(c1);
+      if (isCell(x = EVAL(car(x)))) {
+         for (y = data(c1);  equal(car(y), car(x));  x = cdr(x))
+            if (!isCell(y = cdr(y)))
+               return Pop(c1);
+      }
+      drop(c1);
+      return Nil;
+   }
+   if ((n = xCnt(ex,data(c1))) == 0)
+      return Nil;
+   if (!isCell(x = EVAL(car(x))))
+      return x;
+   if (n < 0  &&  (n += length(x)) <= 0)
+      return Nil;
+   Push(c1,x);
+   Push(c2, x = cons(car(data(c1)), Nil));
+   while (--n  &&  isCell(data(c1) = cdr(data(c1))))
+      x = cdr(x) = cons(car(data(c1)), Nil);
+   drop(c1);
+   return data(c2);
+}
+
+// (tail 'cnt|lst 'lst) -> lst
+any doTail(any ex) {
+   long n;
+   any x, y;
+   cell c1;
+
+   x = cdr(ex);
+   if (isNil(data(c1) = EVAL(car(x))))
+      return Nil;
+   x = cdr(x);
+   if (isCell(data(c1))) {
+      Save(c1);
+      if (isCell(x = EVAL(car(x)))) {
+         do
+            if (equal(x,data(c1)))
+               return Pop(c1);
+         while (isCell(x = cdr(x)));
+      }
+      drop(c1);
+      return Nil;
+   }
+   if ((n = xCnt(ex,data(c1))) == 0)
+      return Nil;
+   if (!isCell(x = EVAL(car(x))))
+      return x;
+   if (n < 0)
+      return nth(1 - n, x);
+   for (y = cdr(x);  --n;  y = cdr(y))
+      if (!isCell(y))
+         return x;
+   while (isCell(y))
+      x = cdr(x),  y = cdr(y);
+   return x;
+}
+
+// (stem 'lst 'any ..) -> lst
+any doStem(any x) {
+   int i, n = length(cdr(x = cdr(x)));
+   cell c1, c[n];
+
+   Push(c1, EVAL(car(x)));
+   for (i = 0; i < n; ++i)
+      x = cdr(x),  Push(c[i], EVAL(car(x)));
+   for (x = data(c1); isCell(x); x = cdr(x)) {
+      for (i = 0;  i < n;  ++i)
+         if (equal(car(x), data(c[i]))) {
+            data(c1) = cdr(x);
+            break;
+         }
+   }
+   return Pop(c1);
+}
+
+// (fin 'any) -> num|sym
+any doFin(any x) {
+   x = cdr(x),  x = EVAL(car(x));
+   while (isCell(x))
+      x = cdr(x);
+   return x;
+}
+
+// (last 'lst) -> any
+any doLast(any x) {
+   x = cdr(x),  x = EVAL(car(x));
+   if (!isCell(x))
+      return x;
+   while (isCell(cdr(x)))
+      x = cdr(x);
+   return car(x);
+}
+
+// (== 'any ..) -> flg
+any doEq(any x) {
+   cell c1;
+
+   x = cdr(x),  Push(c1, EVAL(car(x)));
+   while (isCell(x = cdr(x)))
+      if (data(c1) != EVAL(car(x))) {
+         drop(c1);
+         return Nil;
+      }
+   drop(c1);
+   return T;
+}
+
+// (n== 'any ..) -> flg
+any doNEq(any x) {
+   cell c1;
+
+   x = cdr(x),  Push(c1, EVAL(car(x)));
+   while (isCell(x = cdr(x)))
+      if (data(c1) != EVAL(car(x))) {
+         drop(c1);
+         return T;
+      }
+   drop(c1);
+   return Nil;
+}
+
+// (= 'any ..) -> flg
+any doEqual(any x) {
+   cell c1;
+
+   x = cdr(x),  Push(c1, EVAL(car(x)));
+   while (isCell(x = cdr(x)))
+      if (!equal(data(c1), EVAL(car(x)))) {
+         drop(c1);
+         return Nil;
+      }
+   drop(c1);
+   return T;
+}
+
+// (<> 'any ..) -> flg
+any doNEqual(any x) {
+   cell c1;
+
+   x = cdr(x),  Push(c1, EVAL(car(x)));
+   while (isCell(x = cdr(x)))
+      if (!equal(data(c1), EVAL(car(x)))) {
+         drop(c1);
+         return T;
+      }
+   drop(c1);
+   return Nil;
+}
+
+// (=0 'any) -> 0 | NIL
+any doEq0(any x) {
+   x = cdr(x);
+   return isNum(x = EVAL(car(x))) && IsZero(x)? x : Nil;
+}
+
+// (=T 'any) -> flg
+any doEqT(any x) {
+   x = cdr(x);
+   return T == EVAL(car(x))? T : Nil;
+}
+
+// (n0 'any) -> flg
+any doNEq0(any x) {
+   x = cdr(x);
+   return isNum(x = EVAL(car(x))) && IsZero(x)? Nil : T;
+}
+
+// (nT 'any) -> flg
+any doNEqT(any x) {
+   x = cdr(x);
+   return T == EVAL(car(x))? Nil : T;
+}
+
+// (< 'any ..) -> flg
+any doLt(any x) {
+   any y;
+   cell c1;
+
+   x = cdr(x),  Push(c1, EVAL(car(x)));
+   while (isCell(x = cdr(x))) {
+      y = EVAL(car(x));
+      if (compare(data(c1), y) >= 0) {
+         drop(c1);
+         return Nil;
+      }
+      data(c1) = y;
+   }
+   drop(c1);
+   return T;
+}
+
+// (<= 'any ..) -> flg
+any doLe(any x) {
+   any y;
+   cell c1;
+
+   x = cdr(x),  Push(c1, EVAL(car(x)));
+   while (isCell(x = cdr(x))) {
+      y = EVAL(car(x));
+      if (compare(data(c1), y) > 0) {
+         drop(c1);
+         return Nil;
+      }
+      data(c1) = y;
+   }
+   drop(c1);
+   return T;
+}
+
+// (> 'any ..) -> flg
+any doGt(any x) {
+   any y;
+   cell c1;
+
+   x = cdr(x),  Push(c1, EVAL(car(x)));
+   while (isCell(x = cdr(x))) {
+      y = EVAL(car(x));
+      if (compare(data(c1), y) <= 0) {
+         drop(c1);
+         return Nil;
+      }
+      data(c1) = y;
+   }
+   drop(c1);
+   return T;
+}
+
+// (>= 'any ..) -> flg
+any doGe(any x) {
+   any y;
+   cell c1;
+
+   x = cdr(x),  Push(c1, EVAL(car(x)));
+   while (isCell(x = cdr(x))) {
+      y = EVAL(car(x));
+      if (compare(data(c1), y) < 0) {
+         drop(c1);
+         return Nil;
+      }
+      data(c1) = y;
+   }
+   drop(c1);
+   return T;
+}
+
+// (max 'any ..) -> any
+any doMax(any x) {
+   any y;
+   cell c1;
+
+   x = cdr(x),  Push(c1, EVAL(car(x)));
+   while (isCell(x = cdr(x))) {
+      y = EVAL(car(x));
+      if (compare(y, data(c1)) > 0)
+         data(c1) = y;
+   }
+   return Pop(c1);
+}
+
+// (min 'any ..) -> any
+any doMin(any x) {
+   any y;
+   cell c1;
+
+   x = cdr(x),  Push(c1, EVAL(car(x)));
+   while (isCell(x = cdr(x))) {
+      y = EVAL(car(x));
+      if (compare(y, data(c1)) < 0)
+         data(c1) = y;
+   }
+   return Pop(c1);
+}
+
+// (atom 'any) -> flg
+any doAtom(any x) {
+   x = cdr(x);
+   return !isCell(EVAL(car(x)))? T : Nil;
+}
+
+// (pair 'any) -> any
+any doPair(any x) {
+   x = cdr(x);
+   return isCell(x = EVAL(car(x)))? x : Nil;
+}
+
+// (lst? 'any) -> flg
+any doLstQ(any x) {
+   x = cdr(x);
+   return isCell(x = EVAL(car(x))) || isNil(x)? T : Nil;
+}
+
+// (num? 'any) -> num | NIL
+any doNumQ(any x) {
+   x = cdr(x);
+   return isNum(x = EVAL(car(x)))? x : Nil;
+}
+
+// (sym? 'any) -> flg
+any doSymQ(any x) {
+   x = cdr(x);
+   return isSym(EVAL(car(x)))? T : Nil;
+}
+
+// (flg? 'any) -> flg
+any doFlgQ(any x) {
+   x = cdr(x);
+   return isNil(x = EVAL(car(x))) || x==T? T : Nil;
+}
+
+// (member 'any 'lst) -> any
+any doMember(any x) {
+   cell c1;
+
+   x = cdr(x),  Push(c1, EVAL(car(x)));
+   x = cdr(x),  x = EVAL(car(x));
+   return member(Pop(c1), x) ?: Nil;
+}
+
+// (memq 'any 'lst) -> any
+any doMemq(any x) {
+   cell c1;
+
+   x = cdr(x),  Push(c1, EVAL(car(x)));
+   x = cdr(x),  x = EVAL(car(x));
+   return memq(Pop(c1), x) ?: Nil;
+}
+
+// (mmeq 'lst 'lst) -> any
+any doMmeq(any x) {
+   any y, z;
+   cell c1;
+
+   x = cdr(x),  Push(c1, EVAL(car(x)));
+   x = cdr(x),  y = EVAL(car(x));
+   for (x = Pop(c1);  isCell(x);  x = cdr(x))
+      if (z = memq(car(x), y))
+         return z;
+   return Nil;
+}
+
+// (sect 'lst 'lst) -> lst
+any doSect(any x) {
+   cell c1, c2, c3;
+
+   x = cdr(x),  Push(c1, EVAL(car(x)));
+   x = cdr(x),  Push(c2, EVAL(car(x)));
+   Push(c3, x = Nil);
+   while (isCell(data(c1))) {
+      if (member(car(data(c1)), data(c2)))
+         if (isNil(x))
+            x = data(c3) = cons(car(data(c1)), Nil);
+         else
+            x = cdr(x) = cons(car(data(c1)), Nil);
+      data(c1) = cdr(data(c1));
+   }
+   drop(c1);
+   return data(c3);
+}
+
+// (diff 'lst 'lst) -> lst
+any doDiff(any x) {
+   cell c1, c2, c3;
+
+   x = cdr(x),  Push(c1, EVAL(car(x)));
+   x = cdr(x),  Push(c2, EVAL(car(x)));
+   Push(c3, x = Nil);
+   while (isCell(data(c1))) {
+      if (!member(car(data(c1)), data(c2)))
+         if (isNil(x))
+            x = data(c3) = cons(car(data(c1)), Nil);
+         else
+            x = cdr(x) = cons(car(data(c1)), Nil);
+      data(c1) = cdr(data(c1));
+   }
+   drop(c1);
+   return data(c3);
+}
+
+// (index 'any 'lst) -> cnt | NIL
+any doIndex(any x) {
+   int n;
+   cell c1;
+
+   x = cdr(x),  Push(c1, EVAL(car(x)));
+   x = cdr(x),  x = EVAL(car(x));
+   if (n = indx(Pop(c1), x))
+      return boxCnt(n);
+   return Nil;
+}
+
+// (offset 'lst1 'lst2) -> cnt | NIL
+any doOffset(any x) {
+   int n;
+   any y;
+   cell c1;
+
+   x = cdr(x),  Push(c1, EVAL(car(x)));
+   x = cdr(x),  y = EVAL(car(x));
+   for (n = 1, x = Pop(c1);  isCell(y);  ++n, y = cdr(y))
+      if (equal(x,y))
+         return boxCnt(n);
+   return Nil;
+}
+
+// (length 'any) -> cnt | T
+any doLength(any x) {
+   int n, c;
+   any y;
+
+   if (isNum(x = EVAL(cadr(x))))
+      return numToSym(x, 0, -1, 0);
+   if (isSym(x)) {
+      for (n = 0, c = symChar(name(x));  c;  ++n, c = symChar(NULL));
+      return boxCnt(n);
+   }
+   n = 1;
+   while (car(x) == Quote) {
+      if (x == cdr(x))
+         return T;
+      if (!isCell(x = cdr(x)))
+         return boxCnt(n);
+      ++n;
+   }
+   y = x;
+   while (isCell(x = cdr(x))) {
+      if (x == y)
+         return T;
+      ++n;
+   }
+   return boxCnt(n);
+}
+
+static int size(any x) {
+   int n;
+   any y;
+
+   n = 1;
+   while (car(x) == Quote) {
+      if (x == cdr(x)  ||  !isCell(x = cdr(x)))
+         return n;
+      ++n;
+   }
+   for (y = x;;) {
+      if (isCell(car(x)))
+         n += size(car(x));
+      if (!isCell(x = cdr(x))  ||  x == y)
+         break;
+      ++n;
+   }
+   return n;
+}
+
+// (size 'any) -> cnt
+any doSize(any ex) {
+   any x = cdr(ex);
+
+   if (isNum(x = EVAL(car(x))))
+      return boxCnt(numBytes(x));
+   if (!isSym(x))
+      return boxCnt(size(x));
+   if (isExt(x))
+      return boxCnt(dbSize(ex,x));
+   return isNum(x = name(x))? boxCnt(numBytes(x)) : Zero;
+}
+
+// (assoc 'any 'lst) -> lst
+any doAssoc(any x) {
+   any y;
+   cell c1;
+
+   x = cdr(x),  Push(c1, EVAL(car(x)));
+   x = cdr(x),  y = EVAL(car(x));
+   for (x = Pop(c1);  isCell(y);  y = cdr(y))
+      if (isCell(car(y)) && equal(x,caar(y)))
+         return car(y);
+   return Nil;
+}
+
+// (asoq 'any 'lst) -> lst
+any doAsoq(any x) {
+   any y;
+   cell c1;
+
+   x = cdr(x),  Push(c1, EVAL(car(x)));
+   x = cdr(x),  y = EVAL(car(x));
+   for (x = Pop(c1);  isCell(y);  y = cdr(y))
+      if (isCell(car(y)) && x == caar(y))
+         return car(y);
+   return Nil;
+}
+
+static any Rank;
+
+any rank1(any lst, int n) {
+   int i;
+
+   if (isCell(car(lst)) && compare(caar(lst), Rank) > 0)
+      return NULL;
+   if (n == 1)
+      return car(lst);
+   i = n / 2;
+   return rank1(nCdr(i,lst), n-i) ?: rank1(lst, i);
+}
+
+any rank2(any lst, int n) {
+   int i;
+
+   if (isCell(car(lst)) && compare(Rank, caar(lst)) > 0)
+      return NULL;
+   if (n == 1)
+      return car(lst);
+   i = n / 2;
+   return rank2(nCdr(i,lst), n-i) ?: rank2(lst, i);
+}
+
+// (rank 'any 'lst ['flg]) -> lst
+any doRank(any x) {
+   any y;
+   cell c1, c2;
+
+   x = cdr(x),  Push(c1, EVAL(car(x)));
+   x = cdr(x),  Push(c2, y = EVAL(car(x)));
+   x = cdr(x),  x = EVAL(car(x));
+   Rank = Pop(c1);
+   if (!isCell(y))
+      return Nil;
+   if (isNil(x))
+      return rank1(y, length(y)) ?: Nil;
+   return rank2(y, length(y)) ?: Nil;
+}
+
+/* Pattern matching */
+bool match(any p, any d) {
+   any x;
+
+   for (;;) {
+      if (!isCell(p)) {
+         if (isSym(p)  &&  firstByte(p) == '@') {
+            val(p) = d;
+            return YES;
+         }
+         return equal(p,d);
+      }
+      if (isSym(x = car(p))  &&  firstByte(x) == '@') {
+         if (!isCell(d)) {
+            if (equal(d, cdr(p))) {
+               val(x) = Nil;
+               return YES;
+            }
+            return NO;
+         }
+         if (match(cdr(p), cdr(d))) {
+            val(x) = cons(car(d), Nil);
+            return YES;
+         }
+         if (match(cdr(p), d)) {
+            val(x) = Nil;
+            return YES;
+         }
+         if (match(p, cdr(d))) {
+            val(x) = cons(car(d), val(x));
+            return YES;
+         }
+      }
+      if (!isCell(d) || !(match(x, car(d))))
+         return NO;
+      p = cdr(p);
+      d = cdr(d);
+   }
+}
+
+// (match 'lst1 'lst2) -> flg
+any doMatch(any x) {
+   cell c1, c2;
+
+   x = cdr(x),  Push(c1, EVAL(car(x)));
+   x = cdr(x),  Push(c2, EVAL(car(x)));
+   x = match(data(c1), data(c2))? T : Nil;
+   drop(c1);
+   return x;
+}
+
+// Fill template structure
+static any fill(any x, any s) {
+   any y;
+   cell c1;
+
+   if (isNum(x))
+      return NULL;
+   if (isSym(x))
+      return
+         (isNil(s)? x!=At && firstByte(x)=='@' : memq(x,s)!=NULL)?
+         val(x) : NULL;
+   if (y = fill(car(x),s)) {
+      Push(c1,y);
+      y = fill(cdr(x),s);
+      return cons(Pop(c1), y ?: cdr(x));
+   }
+   if (y = fill(cdr(x),s))
+      return cons(car(x), y);
+   return NULL;
+}
+
+// (fill 'any ['sym|lst]) -> any
+any doFill(any x) {
+   cell c1, c2;
+
+   x = cdr(x),  Push(c1, EVAL(car(x)));
+   x = cdr(x),  Push(c2, EVAL(car(x)));
+   if (x = fill(data(c1),data(c2))) {
+      drop(c1);
+      return x;
+   }
+   return Pop(c1);
+}
+
+/* Declarative Programming */
+cell *Penv, *Pnl;
+
+static bool unify(any n1, any x1, any n2, any x2) {
+   any x, env;
+
+   lookup1:
+   if (isSym(x1)  &&  firstByte(x1) == '@')
+      for (x = data(*Penv);  isCell(car(x));  x = cdr(x))
+         if (unDig(n1) == unDig(caaar(x))  &&  x1 == cdaar(x)) {
+            n1 = cadar(x);
+            x1 = cddar(x);
+            goto lookup1;
+         }
+   lookup2:
+   if (isSym(x2)  &&  firstByte(x2) == '@')
+      for (x = data(*Penv);  isCell(car(x));  x = cdr(x))
+         if (unDig(n2) == unDig(caaar(x))  &&  x2 == cdaar(x)) {
+            n2 = cadar(x);
+            x2 = cddar(x);
+            goto lookup2;
+         }
+   if (unDig(n1) == unDig(n2)  &&  equal(x1, x2))
+      return YES;
+   if (isSym(x1)  &&  firstByte(x1) == '@') {
+      if (x1 != At) {
+         data(*Penv) = cons(cons(cons(n1,x1), Nil), data(*Penv));
+         cdar(data(*Penv)) = cons(n2,x2);
+      }
+      return YES;
+   }
+   if (isSym(x2)  &&  firstByte(x2) == '@') {
+      if (x2 != At) {
+         data(*Penv) = cons(cons(cons(n2,x2), Nil), data(*Penv));
+         cdar(data(*Penv)) = cons(n1,x1);
+      }
+      return YES;
+   }
+   if (!isCell(x1) || !isCell(x2))
+      return equal(x1, x2);
+   env = data(*Penv);
+   if (unify(n1, car(x1), n2, car(x2))  &&  unify(n1, cdr(x1), n2, cdr(x2)))
+      return YES;
+   data(*Penv) = env;
+   return NO;
+}
+
+static any lup(any n, any x) {
+   any y;
+   cell c1;
+
+   lup:
+   if (isSym(x)  &&  firstByte(x) == '@')
+      for (y = data(*Penv);  isCell(car(y));  y = cdr(y))
+         if (unDig(n) == unDig(caaar(y))  &&  x == cdaar(y)) {
+            n = cadar(y);
+            x = cddar(y);
+            goto lup;
+         }
+   if (!isCell(x))
+      return x;
+   Push(c1, lup(n, car(x)));
+   x = lup(n, cdr(x));
+   return cons(Pop(c1), x);
+}
+
+static any lookup(any n, any x) {
+   return isSym(x = lup(n,x)) && firstByte(x)=='@'?  Nil : x;
+}
+
+static any uniFill(any x) {
+   cell c1;
+
+   if (isNum(x))
+      return x;
+   if (isSym(x))
+      return lup(car(data(*Pnl)), x);
+   Push(c1, uniFill(car(x)));
+   x = uniFill(cdr(x));
+   return cons(Pop(c1), x);
+}
+
+// (prove 'lst ['lst]) -> lst
+any doProve(any x) {
+   int i;
+   cell *envSave, *nlSave, at, q, dbg, env, n, nl, alt, tp1, tp2, e;
+
+   x = cdr(x);
+   if (!isCell(data(q) = EVAL(car(x))))
+      return Nil;
+   Save(q);
+   Push(at,val(At));
+   envSave = Penv,  Penv = &env,  nlSave = Pnl,  Pnl = &nl;
+   if (x = cdr(x), isNil(x = EVAL(car(x))))
+      data(dbg) = NULL;
+   else
+      Push(dbg, x);
+   Push(env, caar(data(q))),  car(data(q)) = cdar(data(q));
+   Push(n, car(data(env))),  data(env) = cdr(data(env));
+   Push(nl, car(data(env))),  data(env) = cdr(data(env));
+   Push(alt, car(data(env))),  data(env) = cdr(data(env));
+   Push(tp1, car(data(env))),  data(env) = cdr(data(env));
+   Push(tp2, car(data(env))),  data(env) = cdr(data(env));
+   Push(e,Nil);
+   while (isCell(data(tp1)) || isCell(data(tp2))) {
+      if (isCell(data(alt))) {
+         data(e) = data(env);
+         if (!unify(car(data(nl)), cdar(data(tp1)), data(n), caar(data(alt)))) {
+            if (!isCell(data(alt) = cdr(data(alt)))) {
+               data(env) = caar(data(q)),  car(data(q)) = cdar(data(q));
+               data(n) = car(data(env)),  data(env) = cdr(data(env));
+               data(nl) = car(data(env)),  data(env) = cdr(data(env));
+               data(alt) = car(data(env)),  data(env) = cdr(data(env));
+               data(tp1) = car(data(env)),  data(env) = cdr(data(env));
+               data(tp2) = car(data(env)),  data(env) = cdr(data(env));
+            }
+         }
+         else {
+            if (data(dbg)  &&  memq(caar(data(tp1)), data(dbg))) {
+               outWord(indx(car(data(alt)), get(caar(data(tp1)), T)));
+               space();
+               print(uniFill(car(data(tp1)))), newline();
+            }
+            if (isCell(cdr(data(alt))))
+               car(data(q)) =
+                  cons(
+                     cons(data(n),
+                        cons(data(nl),
+                           cons(cdr(data(alt)),
+                              cons(data(tp1), cons(data(tp2),data(e))) ) ) ),
+                     car(data(q)) );
+            data(nl) = cons(data(n), data(nl));
+            data(n) = box(2 + unDig(data(n)));
+            data(tp2) = cons(cdr(data(tp1)), data(tp2));
+            data(tp1) = cdar(data(alt));
+            data(alt) = Nil;
+         }
+      }
+      else if (!isCell(x = data(tp1))) {
+         data(tp1) = car(data(tp2)),  data(tp2) = cdr(data(tp2));
+         data(nl) = cdr(data(nl));
+      }
+      else if (car(x) == T) {
+         while (isCell(car(data(q)))  &&
+                              unDig(caaar(data(q))) >= unDig(car(data(nl))) )
+            car(data(q)) = cdar(data(q));
+         data(tp1) = cdr(x);
+      }
+      else if (isNum(caar(x))) {
+         data(e) = EVAL(cdar(x));
+         for (i = unDig(caar(x)), x = data(nl);  (i -= 2) > 0;)
+            x = cdr(x);
+         data(nl) = cons(car(x), data(nl));
+         data(tp2) = cons(cdr(data(tp1)), data(tp2));
+         data(tp1) = data(e);
+      }
+      else if (isSym(caar(x)) && firstByte(caar(x)) == '@') {
+         if (!isNil(data(e) = EVAL(cdar(x)))  &&
+                     unify(car(data(nl)), caar(x), car(data(nl)), data(e)) )
+            data(tp1) = cdr(x);
+         else {
+            data(env) = caar(data(q)),  car(data(q)) = cdar(data(q));
+            data(n) = car(data(env)),  data(env) = cdr(data(env));
+            data(nl) = car(data(env)),  data(env) = cdr(data(env));
+            data(alt) = car(data(env)),  data(env) = cdr(data(env));
+            data(tp1) = car(data(env)),  data(env) = cdr(data(env));
+            data(tp2) = car(data(env)),  data(env) = cdr(data(env));
+         }
+      }
+      else if (!isCell(data(alt) = get(caar(x), T))) {
+         data(env) = caar(data(q)),  car(data(q)) = cdar(data(q));
+         data(n) = car(data(env)),  data(env) = cdr(data(env));
+         data(nl) = car(data(env)),  data(env) = cdr(data(env));
+         data(alt) = car(data(env)),  data(env) = cdr(data(env));
+         data(tp1) = car(data(env)),  data(env) = cdr(data(env));
+         data(tp2) = car(data(env)),  data(env) = cdr(data(env));
+      }
+   }
+   for (data(e) = Nil,  x = data(env);  isCell(cdr(x));  x = cdr(x))
+      if (!unDig(caaar(x)))
+         data(e) = cons(cons(cdaar(x), lookup(Zero, cdaar(x))), data(e));
+   val(At) = data(at);
+   drop(q);
+   Penv = envSave,  Pnl = nlSave;
+   return isCell(data(e))? data(e) : isCell(data(env))? T : Nil;
+}
+
+// (-> sym [num]) -> any
+any doArrow(any x) {
+   int i;
+   any y;
+
+   if (!isNum(caddr(x)))
+      return lookup(car(data(*Pnl)), cadr(x));
+   for (i = unDig(caddr(x)), y = data(*Pnl);  (i -= 2) > 0;)
+      y = cdr(y);
+   return lookup(car(y), cadr(x));
+}
+
+// (unify 'any) -> lst
+any doUnify(any x) {
+   cell c1;
+
+   Push(c1, EVAL(cadr(x)));
+   if (unify(cadr(data(*Pnl)), data(c1), car(data(*Pnl)), data(c1))) {
+      drop(c1);
+      return data(*Penv);
+   }
+   drop(c1);
+   return Nil;
+}
+
+/* List Merge Sort: Bill McDaniel, DDJ Jun99 */
+static bool cmp(any ex, any foo, cell c[2]) {
+   if (isNil(foo))
+      return compare(car(data(c[0])), car(data(c[1]))) < 0;
+   return !isNil(apply(ex, foo, YES, 2, c));
+}
+
+// (sort 'lst ['fun]) -> lst
+any doSort(any ex) {
+   int i;
+   any x;
+   cell p, foo, in[2], out[2], last[2];
+   any *tail[2];
+
+   x = cdr(ex);
+   if (!isCell(data(out[0]) = EVAL(car(x))))
+      return data(out[0]);
+   Save(out[0]);
+   x = cdr(x),  Push(foo, EVAL(car(x)));
+   Push(out[1], Nil);
+   Save(in[0]);
+   Save(in[1]);
+   Push(p, Nil);
+   Push(last[1], Nil);
+   do {
+      data(in[0]) = data(out[0]);
+      data(in[1]) = data(out[1]);
+
+      i = isCell(data(in[1]))  &&  !cmp(ex, data(foo), in);
+      if (isCell(data(p) = data(in[i])))
+         data(in[i]) = cdr(data(in[i]));
+      data(out[0]) = data(p);
+      tail[0] = &cdr(data(p));
+      data(last[1]) = data(out[0]);
+      cdr(data(p)) = Nil;
+      i = 0;
+      data(out[1]) = Nil;
+      tail[1] = &data(out[1]);
+      while (isCell(data(in[0])) || isCell(data(in[1]))) {
+         if (!isCell(data(in[1]))) {
+            if (isCell(data(p) = data(in[0])))
+               data(in[0]) = cdr(data(in[0]));
+            data(last[0]) = data(p);
+            if (cmp(ex, data(foo), last))
+               i = 1 - i;
+         }
+         else if (!isCell(data(in[0]))) {
+            data(last[0]) = data(p) = data(in[1]),  data(in[1]) = cdr(data(in[1]));
+            if (cmp(ex, data(foo), last))
+               i = 1 - i;
+         }
+         else if (data(last[0]) = data(in[0]),  cmp(ex, data(foo), last)) {
+            data(last[0]) = data(in[1]);
+            if (!cmp(ex, data(foo), last))
+               data(p) = data(in[1]),  data(in[1]) = cdr(data(in[1]));
+            else {
+               if (cmp(ex, data(foo), in))
+                  data(p) = data(in[0]),  data(in[0]) = cdr(data(in[0]));
+               else
+                  data(p) = data(in[1]),  data(in[1]) = cdr(data(in[1]));
+               i = 1 - i;
+            }
+         }
+         else {
+            data(last[0]) = data(in[1]);
+            if (cmp(ex, data(foo), last))
+               data(p) = data(in[0]),  data(in[0]) = cdr(data(in[0]));
+            else {
+               if (cmp(ex, data(foo), in))
+                  data(p) = data(in[0]),  data(in[0]) = cdr(data(in[0]));
+               else
+                  data(p) = data(in[1]),  data(in[1]) = cdr(data(in[1]));
+            }
+         }
+         *tail[i] = data(p);
+         tail[i] = &cdr(data(p));
+         cdr(data(p)) = Nil;
+         data(last[1]) = data(p);
+      }
+   } while (isCell(data(out[1])));
+   return Pop(out[0]);
+}
diff --git a/src/sym.c b/src/sym.c
@@ -0,0 +1,1991 @@
+/* 24jun09abu
+ * (c) Software Lab. Alexander Burger
+ */
+
+#include "pico.h"
+
+/* Internal/transient hash */
+unsigned long ihash(any x) {
+   unsigned long g, h;
+   word n;
+
+   for (h = 0; isNum(x); x = cdr(numCell(x)))
+      for (n = unDig(x); n; n >>= 8)
+         g = (h = (h<<4) + (n&0xFF)) & 0xF0000000,  h = (h ^ g>>24) & ~g;
+   return h % IHASH;
+}
+
+/* External hash */
+unsigned long ehash(any x) {
+   unsigned long h;
+   word n;
+
+   for (h = 0; isNum(x); x = cdr(numCell(x)))
+      for (n = unDig(x); n; n >>= 11)
+         h += n;
+   return h % EHASH;
+}
+
+bool hashed(any s, long h, any *tab) {
+   any x;
+
+   for (x = tab[h];  isCell(x);  x = cdr(x))
+      if (s == car(x))
+         return YES;
+   return NO;
+}
+
+any findHash(any s, any *p) {
+   any x, y, *q, h;
+
+   if (isCell(h = *p)) {
+      x = s,  y = name(car(h));
+      while (unDig(x) == unDig(y)) {
+         x = cdr(numCell(x));
+         y = cdr(numCell(y));
+         if (!isNum(x) && !isNum(y))
+            return car(h);
+      }
+      while (isCell(h = *(q = &cdr(h)))) {
+         x = s,  y = name(car(h));
+         while (unDig(x) == unDig(y)) {
+            x = cdr(numCell(x));
+            y = cdr(numCell(y));
+            if (!isNum(x) && !isNum(y)) {
+               *q = cdr(h),  cdr(h) = *p,  *p = h;
+               return car(h);
+            }
+         }
+      }
+   }
+   return NULL;
+}
+
+/* Get symbol name */
+any name(any s) {
+   for (s = tail1(s); isCell(s); s = cdr(s));
+   return s;
+}
+
+// (name 'sym ['sym2]) -> sym
+any doName(any ex) {
+   any x, y, *p;
+   cell c1;
+
+   x = cdr(ex),  data(c1) = EVAL(car(x));
+   NeedSym(ex,data(c1));
+   y = name(data(c1));
+   if (!isCell(x = cdr(x)))
+      return isNum(y)? consStr(y) : Nil;
+   if (isNil(data(c1)) || isExt(data(c1)) || hashed(data(c1), ihash(y), Intern))
+      err(ex, data(c1), "Can't rename");
+   Save(c1);
+   x = EVAL(car(x));
+   NeedSym(ex,x);
+   for (p = &tail(data(c1)); isCell(*p); p = &cdr(*p));
+   *p = name(x);
+   return Pop(c1);
+}
+
+/* Find or create single-char symbol */
+any mkChar(int c) {
+   if (c >= 0x80) {
+      if (c < 0x800)
+         c = 0xC0 | c>>6 & 0x1F  |  (0x80 | c & 0x3F) << 8;
+      else if (c == TOP)
+         c = 0xFF;
+      else
+         c = 0xE0 | c>>12 & 0x0F  |  (0x80 | c>>6 & 0x3F) << 8  |  (0x80 | c & 0x3F) << 16;
+   }
+   return consStr(box(c));
+}
+
+/* Make name */
+any mkName(char *s) {
+   int i;
+   any nm;
+   cell c1;
+
+   i = 0,  Push(c1, nm = box(*(byte*)s++));
+   while (*s)
+      byteSym(*(byte*)s++, &i, &nm);
+   return Pop(c1);
+}
+
+any intern(char *s) {
+   any nm, x, *h;
+
+   if (!*s)
+      return Nil;
+   nm = mkName(s);
+   if (x = findHash(nm, h = Intern + ihash(nm)))
+      return x;
+   *h = cons(x = consStr(nm), *h);
+   return x;
+}
+
+/* Make string */
+any mkStr(char *s) {return s && *s? consStr(mkName(s)) : Nil;}
+
+/* Get first byte of symbol name */
+int firstByte(any s) {
+   return !isNum(s = name(s))? 0 : unDig(s) & 0xFF;
+}
+
+int secondByte(any s) {
+   return !isNum(s = name(s))? 0 : unDig(s) >> 8 & 0xFF;
+}
+
+bool isBlank(any x) {
+   int c;
+
+   if (!isSym(x))
+      return NO;
+   for (c = symChar(name(x)); c; c = symChar(NULL))
+      if (c > ' ')
+         return NO;
+   return YES;
+}
+
+// (sp? 'any) -> flg
+any doSpQ(any x) {
+   x = cdr(x);
+   return isBlank(EVAL(car(x)))? T : Nil;
+}
+
+// (pat? 'any) -> sym | NIL
+any doPatQ(any x) {
+   x = cdr(x);
+   return isSym(x = EVAL(car(x))) && firstByte(x) == '@'? x : Nil;
+}
+
+// (fun? 'any) -> any
+any doFunQ(any x) {
+   x = cdr(x);
+   return funq(EVAL(car(x)));
+}
+
+// (getd 'any) -> fun | NIL
+any doGetd(any x) {
+   x = cdr(x);
+   if (!isSym(x = EVAL(car(x))))
+      return Nil;
+   return !isNil(funq(val(x))) || isNil(val(x)) && sharedLib(x)?
+      val(x) : Nil;
+}
+
+// (all ['T | '0]) -> lst
+any doAll(any x) {
+   any *p;
+   int mod, i;
+   cell c1;
+
+   x = cdr(x),  x = EVAL(car(x));
+   if isNil(x)
+      p = Intern,  mod = IHASH;
+   else if (x == T)
+      p = Transient,  mod = IHASH;
+   else
+      p = Extern,  mod = EHASH;
+   Push(c1, Nil);
+   for (i = 0; i < mod; ++i)
+      for (x = p[i]; isCell(x); x = cdr(x))
+         data(c1) = cons(car(x), data(c1));
+   return Pop(c1);
+}
+
+// (intern 'sym) -> sym
+any doIntern(any ex) {
+   any x, y, z, *h;
+
+   x = cdr(ex),  x = EVAL(car(x));
+   NeedSym(ex,x);
+   if (!isNum(y = name(x)))
+      return Nil;
+   if (unDig(y) == ('L'<<16 | 'I'<<8 | 'N'))
+      return Nil;
+   if (z = findHash(y, h = Intern + ihash(y)))
+      return z;
+   *h = cons(x,*h);
+   return x;
+}
+
+// (extern 'sym) -> sym | NIL
+any doExtern(any ex) {
+   int c, i;
+   any x, y, *h, nm;
+   cell c1, c2;
+
+   x = cdr(ex),  x = EVAL(car(x));
+   NeedSym(ex,x);
+   if (!isNum(x = name(x)))
+      return Nil;
+   if (!(y = findHash(x, Extern + ehash(x)))) {
+      Push(c1, x);
+      if ((c = symChar(x)) == '{')
+         c = symChar(NULL);
+      Push(c2, boxChar(c, &i, &nm));
+      while ((c = symChar(NULL)) && c != '}')
+         charSym(c, &i, &nm);
+      if (!(y = findHash(data(c2), h = Extern + ehash(data(c2))))) {
+         mkExt(y = consSym(Nil,data(c2)));
+         *h = cons(y,*h);
+      }
+      drop(c1);
+   }
+   return isLife(y)? y : Nil;
+}
+
+// (==== ['sym ..]) -> NIL
+any doHide(any ex) {
+   any x, y, z, *h;
+   int i;
+
+   for (i = 0; i < IHASH; ++i)
+      Transient[i] = Nil;
+   for (x = cdr(ex); isCell(x); x = cdr(x)) {
+      y = EVAL(car(x));
+      NeedSym(ex,y);
+      if (isNum(z = name(y)) && !findHash(z, h = Transient + ihash(z)))
+         *h = cons(y,*h);
+   }
+   return Nil;
+}
+
+// (box? 'any) -> sym | NIL
+any doBoxQ(any x) {
+   x = cdr(x);
+   return isSym(x = EVAL(car(x))) && !isNum(name(x))? x : Nil;
+}
+
+// (str? 'any) -> sym | NIL
+any doStrQ(any x) {
+   x = cdr(x);
+   return isSym(x = EVAL(car(x))) &&
+         !isExt(x) && !hashed(x, ihash(name(x)), Intern)? x : Nil;
+}
+
+// (ext? 'any) -> sym | NIL
+any doExtQ(any x) {
+   x = cdr(x);
+   return isSym(x = EVAL(car(x))) && isExt(x) && isLife(x) ? x : Nil;
+}
+
+// (touch 'sym) -> sym
+any doTouch(any ex) {
+   any x = cdr(ex);
+   x = EVAL(car(x));
+   NeedSym(ex,x);
+   Touch(ex,x);
+   return x;
+}
+
+// (zap 'sym) -> sym
+any doZap(any ex) {
+   any x, y, *h;
+
+   x = cdr(ex),  x = EVAL(car(x));
+   NeedSym(ex,x);
+   if (isExt(x))
+      db(ex,x,3);
+   else {
+      if (x >= Nil  &&  x <= Bye)
+         protError(ex,x);
+      for (h = Intern + ihash(name(x)); isCell(y = *h); h = &y->cdr)
+         if (x == car(y)) {
+            *h = cdr(y);
+            break;
+         }
+   }
+   return x;
+}
+
+// (chop 'any) -> lst
+any doChop(any x) {
+   int c;
+   cell c1, c2;
+
+   if (isCell(x = EVAL(cadr(x))))
+      return x;
+   if (!(c = symChar(name(x = xSym(x)))))
+      return Nil;
+   Push(c1, x);
+   Push(c2, x = cons(mkChar(c), Nil));
+   while (c = symChar(NULL))
+      x = cdr(x) = cons(mkChar(c), Nil);
+   drop(c1);
+   return data(c2);
+}
+
+void pack(any x, int *i, any *nm, cell *p) {
+   int c;
+   cell c1;
+
+   if (isCell(x))
+      do
+         pack(car(x), i, nm, p);
+      while (isCell(x = cdr(x)));
+   if (!isNil(x)) {
+      if (isNum(x)) {
+         Push(c1, x = numToSym(x, 0, 0, 0));
+         c = symChar(name(x));
+         if (*nm)
+            charSym(c, i, nm);
+         else
+            Tuck(*p, c1, boxChar(c, i, nm));
+         while (c = symChar(NULL))
+            charSym(c, i, nm);
+         drop(c1);
+      }
+      else if (c = symChar(name(x))) {
+         if (*nm) {
+            if (isExt(x))
+               charSym('{', i, nm);
+            charSym(c, i, nm);
+         }
+         else if (!isExt(x))
+            Push(*p, boxChar(c, i, nm));
+         else {
+            Push(*p, boxChar('{', i, nm));
+            charSym(c, i, nm);
+         }
+         while (c = symChar(NULL))
+            charSym(c, i, nm);
+         if (isExt(x))
+            charSym('}', i, nm);
+      }
+   }
+}
+
+// (pack 'any ..) -> sym
+any doPack(any x) {
+   int i;
+   any nm;
+   cell c1, c2;
+
+   x = cdr(x),  Push(c1, EVAL(car(x)));
+   nm = NULL,  pack(data(c1), &i, &nm, &c2);
+   while (isCell(x = cdr(x)))
+      pack(data(c1) = EVAL(car(x)), &i, &nm, &c2);
+   drop(c1);
+   return nm? consStr(data(c2)) : Nil;
+}
+
+// (glue 'any 'lst) -> sym
+any doGlue(any x) {
+   int i;
+   any nm;
+   cell c1, c2, c3;
+
+   x = cdr(x),  Push(c1, EVAL(car(x)));
+   x = cdr(x),  Push(c2, x = EVAL(car(x)));
+   if (!isCell(x)) {
+      drop(c1);
+      return x;
+   }
+   nm = NULL,  pack(car(x), &i, &nm, &c3);
+   while (isCell(x = cdr(x))) {
+      pack(data(c1), &i, &nm, &c3);
+      pack(car(x), &i, &nm, &c3);
+   }
+   drop(c1);
+   return nm? consStr(data(c3)) : Nil;
+}
+
+// (text 'any1 'any ..) -> sym
+any doText(any x) {
+   int c, n, i;
+   any nm;
+   any y = evSym(x = cdr(x));
+   char *p, buf[bufSize(y)];
+   cell c1;
+
+   bufString(y, buf);
+   if (!*(p = buf))
+      return Nil;
+   {
+      cell arg[length(x = cdr(x))];
+
+      for (n = 0;  isCell(x);  ++n, x = cdr(x))
+         Push(arg[n], EVAL(car(x)));
+
+      nm = NULL;
+      do {
+         if ((c = *p++) != '@') {
+            if (nm)
+               byteSym(c, &i, &nm);
+            else
+               i = 0,  Push(c1, nm = box(c & 0xFF));
+         }
+         else if (!(c = *p++))
+            break;
+         else if (c == '@') {
+            if (nm)
+               byteSym('@', &i, &nm);
+            else
+               i = 0,  Push(c1, nm = box('@'));
+         }
+         else if (c >= '1') {
+            if ((c -= '1') > 8)
+               c -= 7;
+            if (n > c)
+               pack(data(arg[c]), &i, &nm, &c1);
+         }
+      } while (*p);
+      if (n)
+         drop(arg[0]);
+      else if (nm)
+         drop(c1);
+      return nm? consStr(data(c1)) : Nil;
+   }
+}
+
+static bool pre(word n1, any y, word n2, any x) {
+   for (;;) {
+      if ((n1 & 0xFF) != (n2 & 0xFF))
+         return NO;
+      if ((n1 >>= 8) == 0) {
+         if (!isNum(y = cdr(numCell(y))))
+            return YES;
+         n1 = unDig(y);
+      }
+      if ((n2 >>= 8) == 0) {
+         if (!isNum(x = cdr(numCell(x))))
+            return NO;
+         n2 = unDig(x);
+      }
+   }
+}
+
+bool subStr(any y, any x) {
+   word n;
+
+   if (!isNum(y = name(y)))
+      return YES;
+   if (!isNum(x = name(x)))
+      return NO;
+   n = unDig(x);
+   for (;;) {
+      if (pre(unDig(y), y, n, x))
+         return YES;
+      if ((n >>= 8) == 0) {
+         if (!isNum(x = cdr(numCell(x))))
+            return NO;
+         n = unDig(x);
+      }
+   }
+}
+
+// (pre? 'any1 'any2) -> any2 | NIL
+any doPreQ(any x) {
+   any y, z;
+   cell c1;
+
+   x = cdr(x),  Push(c1, evSym(x));
+   x = cdr(x),  x = evSym(x);
+   drop(c1);
+   if (!isNum(y = name(data(c1))))
+      return x;
+   if (!isNum(z = name(x)))
+      return Nil;
+   return pre(unDig(y), y, unDig(z), z)? x : Nil;
+}
+
+// (sub? 'any1 'any2) -> any2 | NIL
+any doSubQ(any x) {
+   cell c1;
+
+   x = cdr(x),  Push(c1, evSym(x));
+   x = cdr(x),  x = evSym(x);
+   drop(c1);
+   return subStr(data(c1), x)? x : Nil;
+}
+
+// (val 'var) -> any
+any doVal(any ex) {
+   any x;
+
+   x = cdr(ex),  x = EVAL(car(x));
+   NeedVar(ex,x);
+   if (isSym(x))
+      Fetch(ex,x);
+   return val(x);
+}
+
+// (set 'var 'any ..) -> any
+any doSet(any ex) {
+   any x;
+   cell c1, c2;
+
+   x = cdr(ex);
+   do {
+      Push(c1, EVAL(car(x))),  x = cdr(x);
+      NeedVar(ex,data(c1));
+      CheckVar(ex,data(c1));
+      if (isSym(data(c1)))
+         Touch(ex,data(c1));
+      Push(c2, EVAL(car(x))),  x = cdr(x);
+      val(data(c1)) = data(c2);
+      drop(c1);
+   } while (isCell(x));
+   return val(data(c1));
+}
+
+// (setq var 'any ..) -> any
+any doSetq(any ex) {
+   any x, y;
+
+   x = cdr(ex);
+   do {
+      y = car(x),  x = cdr(x);
+      NeedVar(ex,y);
+      CheckVar(ex,y);
+      val(y) = EVAL(car(x));
+   } while (isCell(x = cdr(x)));
+   return val(y);
+}
+
+// (xchg 'var 'var ..) -> any
+any doXchg(any ex) {
+   any x, y;
+   cell c1, c2;
+
+   x = cdr(ex);
+   do {
+      Push(c1, EVAL(car(x))),  x = cdr(x);
+      NeedVar(ex,data(c1));
+      CheckVar(ex,data(c1));
+      if (isSym(data(c1)))
+         Touch(ex,data(c1));
+      Push(c2, EVAL(car(x))),  x = cdr(x);
+      NeedVar(ex,data(c2));
+      CheckVar(ex,data(c2));
+      if (isSym(data(c2)))
+         Touch(ex,data(c2));
+      y = val(data(c1)),  val(data(c1)) = val(data(c2)),  val(data(c2)) = y;
+      drop(c1);
+   } while (isCell(x));
+   return y;
+}
+
+// (on var ..) -> T
+any doOn(any ex) {
+   any x = cdr(ex);
+   do {
+      NeedVar(ex,car(x));
+      CheckVar(ex,car(x));
+      val(car(x)) = T;
+   } while (isCell(x = cdr(x)));
+   return T;
+}
+
+// (off var ..) -> NIL
+any doOff(any ex) {
+   any x = cdr(ex);
+   do {
+      NeedVar(ex,car(x));
+      CheckVar(ex,car(x));
+      val(car(x)) = Nil;
+   } while (isCell(x = cdr(x)));
+   return Nil;
+}
+
+// (onOff var ..) -> flg
+any doOnOff(any ex) {
+   any x = cdr(ex);
+   any y;
+
+   do {
+      NeedVar(ex,car(x));
+      CheckVar(ex,car(x));
+      y = val(car(x)) = isNil(val(car(x)))? T : Nil;
+   } while (isCell(x = cdr(x)));
+   return y;
+}
+
+// (zero var ..) -> 0
+any doZero(any ex) {
+   any x = cdr(ex);
+   do {
+      NeedVar(ex,car(x));
+      CheckVar(ex,car(x));
+      val(car(x)) = Zero;
+   } while (isCell(x = cdr(x)));
+   return Zero;
+}
+
+// (one var ..) -> 1
+any doOne(any ex) {
+   any x = cdr(ex);
+   do {
+      NeedVar(ex,car(x));
+      CheckVar(ex,car(x));
+      val(car(x)) = One;
+   } while (isCell(x = cdr(x)));
+   return One;
+}
+
+// (default var 'any ..) -> any
+any doDefault(any ex) {
+   any x, y;
+
+   x = cdr(ex);
+   do {
+      y = car(x),  x = cdr(x);
+      NeedVar(ex,y);
+      CheckVar(ex,y);
+      if (isNil(val(y)))
+         val(y) = EVAL(car(x));
+   } while (isCell(x = cdr(x)));
+   return val(y);
+}
+
+// (push 'var 'any ..) -> any
+any doPush(any ex) {
+   any x;
+   cell c1, c2;
+
+   x = cdr(ex),  Push(c1, EVAL(car(x)));
+   NeedVar(ex,data(c1));
+   CheckVar(ex,data(c1));
+   if (isSym(data(c1)))
+      Touch(ex,data(c1));
+   x = cdr(x),  Push(c2, EVAL(car(x)));
+   val(data(c1)) = cons(data(c2), val(data(c1)));
+   while (isCell(x = cdr(x))) {
+      data(c2) = EVAL(car(x));
+      val(data(c1)) = cons(data(c2), val(data(c1)));
+   }
+   drop(c1);
+   return data(c2);
+}
+
+// (push1 'var 'any ..) -> any
+any doPush1(any ex) {
+   any x;
+   cell c1, c2;
+
+   x = cdr(ex),  Push(c1, EVAL(car(x)));
+   NeedVar(ex,data(c1));
+   CheckVar(ex,data(c1));
+   if (isSym(data(c1)))
+      Touch(ex,data(c1));
+   x = cdr(x),  Push(c2, EVAL(car(x)));
+   if (!member(data(c2), val(data(c1))))
+      val(data(c1)) = cons(data(c2), val(data(c1)));
+   while (isCell(x = cdr(x)))
+      if (!member(data(c2) = EVAL(car(x)), val(data(c1))))
+         val(data(c1)) = cons(data(c2), val(data(c1)));
+   drop(c1);
+   return data(c2);
+}
+
+// (pop 'var) -> any
+any doPop(any ex) {
+   any x, y;
+
+   x = cdr(ex),  x = EVAL(car(x));
+   NeedVar(ex,x);
+   CheckVar(ex,x);
+   if (isSym(x))
+      Touch(ex,x);
+   if (!isCell(y = val(x)))
+      return y;
+   val(x) = cdr(y);
+   return car(y);
+}
+
+// (cut 'cnt 'var) -> lst
+any doCut(any ex) {
+   long n;
+   any x, y;
+   cell c1, c2;
+
+   if ((n = evCnt(ex, x = cdr(ex))) <= 0)
+      return Nil;
+   x = cdr(x),  Push(c1, EVAL(car(x)));
+   NeedVar(ex,data(c1));
+   CheckVar(ex,data(c1));
+   if (isSym(data(c1)))
+      Touch(ex,data(c1));
+   if (isCell(val(data(c1)))) {
+      Push(c2, y = cons(car(val(data(c1))), Nil));
+      while (isCell(val(data(c1)) = cdr(val(data(c1)))) && --n)
+         y = cdr(y) = cons(car(val(data(c1))), Nil);
+      drop(c1);
+      return data(c2);
+   }
+   return val(Pop(c1));
+}
+
+// (del 'any 'var) -> lst
+any doDel(any ex) {
+   any x, y;
+   cell c1, c2, c3;
+
+   x = cdr(ex),  Push(c1, EVAL(car(x)));
+   x = cdr(x),  Push(c2, EVAL(car(x)));
+   NeedVar(ex,data(c2));
+   CheckVar(ex,data(c2));
+   if (isSym(data(c2)))
+      Touch(ex,data(c2));
+   if (isCell(x = val(data(c2)))) {
+      if (equal(data(c1), car(x))) {
+         drop(c1);
+         return val(data(c2)) = cdr(x);
+      }
+      Push(c3, y = cons(car(x), Nil));
+      while (isCell(x = cdr(x))) {
+         if (equal(data(c1), car(x))) {
+            cdr(y) = cdr(x);
+            drop(c1);
+            return val(data(c2)) = data(c3);
+         }
+         y = cdr(y) = cons(car(x), Nil);
+      }
+   }
+   drop(c1);
+   return val(data(c2));
+}
+
+// (queue 'var 'any) -> any
+any doQueue(any ex) {
+   any x, y;
+   cell c1;
+
+   x = cdr(ex),  Push(c1, EVAL(car(x)));
+   NeedVar(ex,data(c1));
+   CheckVar(ex,data(c1));
+   if (isSym(data(c1)))
+      Touch(ex,data(c1));
+   x = cdr(x),  x = EVAL(car(x));
+   if (!isCell(y = val(data(c1))))
+      val(data(c1)) = cons(x,Nil);
+   else {
+      while (isCell(cdr(y)))
+         y = cdr(y);
+      cdr(y) = cons(x,Nil);
+   }
+   drop(c1);
+   return x;
+}
+
+// (fifo 'var ['any ..]) -> any
+any doFifo(any ex) {
+   any x, y, z;
+   cell c1;
+
+   x = cdr(ex),  Push(c1, EVAL(car(x)));
+   NeedVar(ex,data(c1));
+   CheckVar(ex,data(c1));
+   if (isSym(data(c1)))
+      Touch(ex,data(c1));
+   if (isCell(x = cdr(x))) {
+      y = EVAL(car(x));
+      if (isCell(z = val(data(c1))))
+         val(data(c1)) = z = cdr(z) = cons(y,cdr(z));
+      else
+         cdr(z) = z = val(data(c1)) = cons(y,Nil);
+      while (isCell(x = cdr(x)))
+         val(data(c1)) = z = cdr(z) = cons(y = EVAL(car(x)), cdr(z));
+   }
+   else if (!isCell(z = val(data(c1))))
+      y = Nil;
+   else {
+      if (z == cdr(z)) {
+         y = car(z);
+         val(data(c1)) = Nil;
+      }
+      else {
+         y = cadr(z);
+         cdr(z) = cddr(z);
+      }
+   }
+   drop(c1);
+   return y;
+}
+
+any idx(any var, any key, int flg) {
+   any x, y, z, *p;
+   int n;
+
+   if (!key) {
+      cell c1, c2;
+
+      if (!isCell(x = val(var)))
+         return Nil;
+      y = Nil;  // Result
+      Push(c1, x);  // Tree
+      Push(c2, Nil);  // TOS
+      for (;;) {
+         while (isCell(cddr(data(c1))))
+            z = data(c1),  data(c1) = cddr(z),  cddr(z) = data(c2),  data(c2) = z;
+         for (;;) {
+            y = cons(car(data(c1)), y);
+            if (isCell(cadr(data(c1)))) {
+               z = data(c1),  data(c1) = cadr(z),  cadr(z) = data(c2),  data(c2) = symPtr(z);
+               break;
+            }
+            for (;;) {
+               if (isNil(data(c2))) {
+                  drop(c1);
+                  return y;
+               }
+               if (isCell(data(c2))) {
+                  z = data(c2),  data(c2) = cddr(z),  cddr(z) = data(c1),  data(c1) = z;
+                  break;
+               }
+               z = cellPtr(data(c2)),  data(c2) = cadr(z),  cadr(z) = data(c1),  data(c1) = z;
+            }
+         }
+      }
+   }
+   if (!isCell(x = val(var))) {
+      if (flg > 0)
+         val(var) = cons(key,Nil);
+      return Nil;
+   }
+   p = (any*)var;
+   for (;;) {
+      if ((n = compare(key, car(x))) == 0) {
+         if (flg < 0) {
+            if (!isCell(cadr(x)))
+               *p = cddr(x);
+            else if (!isCell(y = cddr(x)))
+               *p = cadr(x);
+            else if (!isCell(z = cadr(y)))
+               car(x) = car(y),  cddr(x) = cddr(y);
+            else {
+               while (isCell(cadr(z)))
+                  z = cadr(y = z);
+               car(x) = car(z),  cadr(y) = cddr(z);
+            }
+         }
+         return x;
+      }
+      if (!isCell(cdr(x))) {
+         if (flg > 0)
+            cdr(x) = n < 0? cons(cons(key,Nil), Nil) : cons(Nil, cons(key,Nil));
+         return Nil;
+      }
+      if (n < 0) {
+         if (!isCell(cadr(x))) {
+            if (flg > 0)
+               cadr(x) = cons(key,Nil);
+            return Nil;
+         }
+         x = *(p = &cadr(x));
+      }
+      else {
+         if (!isCell(cddr(x))) {
+            if (flg > 0)
+               cddr(x) = cons(key,Nil);
+            return Nil;
+         }
+         x = *(p = &cddr(x));
+      }
+   }
+}
+
+// (idx 'var 'any 'flg) -> lst
+// (idx 'var 'any) -> lst
+// (idx 'var) -> lst
+any doIdx(any ex) {
+   any x;
+   int flg;
+   cell c1, c2;
+
+   x = cdr(ex),  Push(c1, EVAL(car(x)));
+   NeedVar(ex,data(c1));
+   CheckVar(ex,data(c1));
+   if (!isCell(x = cdr(x)))
+      x = idx(data(c1), NULL, 0);
+   else {
+      Push(c2, EVAL(car(x)));
+      if (!isCell(cdr(x)))
+         flg = 0;
+      else
+         flg = isNil(EVAL(cadr(x)))? -1 : +1;
+      x = idx(data(c1), data(c2), flg);
+   }
+   drop(c1);
+   return x;
+}
+
+// (lup 'lst 'any) -> lst
+// (lup 'lst 'any 'any2) -> lst
+any doLup(any x) {
+   int n;
+   cell c1, c2, c3, c4, c5;
+
+   x = cdr(x),  data(c1) = EVAL(car(x));
+   if (!isCell(data(c1)))
+      return data(c1);
+   Save(c1);
+   x = cdr(x),  Push(c2, EVAL(car(x)));  // from
+   if (isCell(x = cdr(x))) {
+      Push(c3, EVAL(car(x)));  // to
+      Push(c4, Nil);  // tos
+      Push(c5, Nil);  // result
+      for (;;) {
+         while (isCell(cddr(data(c1))) && car(data(c1)) != T && (!isCell(car(data(c1))) || compare(data(c3), caar(data(c1))) >= 0))
+            x = data(c1),  data(c1) = cddr(x),  cddr(x) = data(c4),  data(c4) = x;
+         for (;;) {
+            if (isCell(car(data(c1))) && compare(data(c2), caar(data(c1))) <= 0) {
+               if (compare(data(c3), caar(data(c1))) >= 0)
+                  data(c5) = cons(car(data(c1)), data(c5));
+               if (isCell(cadr(data(c1)))) {
+                  x = data(c1),  data(c1) = cadr(x),  cadr(x) = data(c4),  data(c4) = symPtr(x);
+                  break;
+               }
+            }
+            for (;;) {
+               if (isNil(data(c4))) {
+                  drop(c1);
+                  return data(c5);
+               }
+               if (isCell(data(c4))) {
+                  x = data(c4),  data(c4) = cddr(x),  cddr(x) = data(c1),  data(c1) = x;
+                  break;
+               }
+               else
+                  x = cellPtr(data(c4)),  data(c4) = cadr(x),  cadr(x) = data(c1),  data(c1) = x;
+            }
+         }
+      }
+   }
+   do {
+      if (car(data(c1)) == T)
+         data(c1) = cadr(data(c1));
+      else if (!isCell(car(data(c1))))
+         data(c1) = cddr(data(c1));
+      else if (n = compare(data(c2), caar(data(c1))))
+         data(c1) = n < 0? cadr(data(c1)) : cddr(data(c1));
+      else {
+         drop(c1);
+         return car(data(c1));
+      }
+   } while (isCell(data(c1)));
+   drop(c1);
+   return Nil;
+}
+
+void put(any x, any key, any val) {
+   any y, z;
+
+   if (isCell(y = tail1(x))) {
+      if (isCell(car(y))) {
+         if (key == cdar(y)) {
+            if (isNil(val))
+               Tail(x, cdr(y));
+            else if (val == T)
+               car(y) = key;
+            else
+               caar(y) = val;
+            return;
+         }
+      }
+      else if (key == car(y)) {
+         if (isNil(val))
+            Tail(x, cdr(y));
+         else if (val != T)
+            car(y) = cons(val,key);
+         return;
+      }
+      while (isCell(z = cdr(y))) {
+         if (isCell(car(z))) {
+            if (key == cdar(z)) {
+               if (isNil(val))
+                  cdr(y) = cdr(z);
+               else {
+                  if (val == T)
+                     car(z) = key;
+                  else
+                     caar(z) = val;
+                  cdr(y) = cdr(z),  cdr(z) = tail1(x),  Tail(x, z);
+               }
+               return;
+            }
+         }
+         else if (key == car(z)) {
+            if (isNil(val))
+               cdr(y) = cdr(z);
+            else {
+               if (val != T)
+                  car(z) = cons(val,key);
+               cdr(y) = cdr(z),  cdr(z) = tail1(x),  Tail(x, z);
+            }
+            return;
+         }
+         y = z;
+      }
+   }
+   if (!isNil(val))
+      Tail(x, cons(val==T? key : cons(val,key), tail1(x)));
+}
+
+any get(any x, any key) {
+   any y, z;
+
+   if (!isCell(y = tail1(x)))
+      return Nil;
+   if (!isCell(car(y))) {
+      if (key == car(y))
+         return T;
+   }
+   else if (key == cdar(y))
+      return caar(y);
+   while (isCell(z = cdr(y))) {
+      if (!isCell(car(z))) {
+         if (key == car(z)) {
+            cdr(y) = cdr(z),  cdr(z) = tail1(x),  Tail(x, z);
+            return T;
+         }
+      }
+      else if (key == cdar(z)) {
+         cdr(y) = cdr(z),  cdr(z) = tail1(x),  Tail(x, z);
+         return caar(z);
+      }
+      y = z;
+   }
+   return Nil;
+}
+
+any prop(any x, any key) {
+   any y, z;
+
+   if (!isCell(y = tail1(x)))
+      return Nil;
+   if (!isCell(car(y))) {
+      if (key == car(y))
+         return key;
+   }
+   else if (key == cdar(y))
+      return car(y);
+   while (isCell(z = cdr(y))) {
+      if (!isCell(car(z))) {
+         if (key == car(z)) {
+            cdr(y) = cdr(z),  cdr(z) = tail1(x),  Tail(x, z);
+            return key;
+         }
+      }
+      else if (key == cdar(z)) {
+         cdr(y) = cdr(z),  cdr(z) = tail1(x),  Tail(x, z);
+         return car(z);
+      }
+      y = z;
+   }
+   return Nil;
+}
+
+// (put 'sym1|lst ['sym2|cnt ..] 'sym|0 'any) -> any
+any doPut(any ex) {
+   any x;
+   cell c1, c2, c3;
+
+   x = cdr(ex),  Push(c1, EVAL(car(x)));
+   x = cdr(x),  Push(c2, EVAL(car(x)));
+   while (isCell(cdr(x = cdr(x)))) {
+      if (isCell(data(c1)))
+         data(c1) = getn(data(c2), data(c1));
+      else {
+         NeedSym(ex,data(c1));
+         Fetch(ex,data(c1));
+         data(c1) = isNum(data(c2)) && !unDig(data(c2))? val(data(c1)) : get(data(c1), data(c2));
+      }
+      data(c2) = EVAL(car(x));
+   }
+   NeedSym(ex,data(c1));
+   CheckNil(ex,data(c1));
+   Push(c3, EVAL(car(x)));
+   Touch(ex,data(c1));
+   if (isNum(data(c2)) && IsZero(data(c2)))
+      val(data(c1)) = x = data(c3);
+   else
+      put(data(c1), data(c2), x = data(c3));
+   drop(c1);
+   return x;
+}
+
+// (get 'sym1|lst ['sym2|cnt ..]) -> any
+any doGet(any ex) {
+   any x, y;
+   cell c1;
+
+   x = cdr(ex),  data(c1) = EVAL(car(x));
+   if (!isCell(x = cdr(x)))
+      return data(c1);
+   Save(c1);
+   do {
+      y = EVAL(car(x));
+      if (isCell(data(c1)))
+         data(c1) = getn(y, data(c1));
+      else {
+         NeedSym(ex,data(c1));
+         Fetch(ex,data(c1));
+         data(c1) = isNum(y) && !unDig(y)? val(data(c1)) : get(data(c1), y);
+      }
+   } while (isCell(x = cdr(x)));
+   return Pop(c1);
+}
+
+// (prop 'sym1|lst ['sym2|cnt ..] 'sym) -> lst|sym
+any doProp(any ex) {
+   any x;
+   cell c1, c2;
+
+   x = cdr(ex),  Push(c1, EVAL(car(x)));
+   x = cdr(x),  Push(c2, EVAL(car(x)));
+   while (isCell(x = cdr(x))) {
+      if (isCell(data(c1)))
+         data(c1) = getn(data(c2), data(c1));
+      else {
+         NeedSym(ex,data(c1));
+         Fetch(ex,data(c1));
+         data(c1) = isNum(data(c2)) && !unDig(data(c2))? val(data(c1)) : get(data(c1), data(c2));
+      }
+      data(c2) = EVAL(car(x));
+   }
+   NeedSym(ex,data(c1));
+   Fetch(ex,data(c1));
+   return prop(Pop(c1), data(c2));
+}
+
+// (; 'sym1|lst [sym2|cnt ..]) -> any
+any doSemicol(any ex) {
+   any x;
+   cell c1;
+
+   x = cdr(ex),  data(c1) = EVAL(car(x));
+   if (!isCell(x = cdr(x)))
+      return data(c1);
+   Save(c1);
+   do {
+      if (isCell(data(c1)))
+         data(c1) = getn(car(x), data(c1));
+      else {
+         NeedSym(ex,data(c1));
+         Fetch(ex,data(c1));
+         data(c1) = isNum(car(x)) && !unDig(car(x))? val(data(c1)) : get(data(c1), car(x));
+      }
+   } while (isCell(x = cdr(x)));
+   return Pop(c1);
+}
+
+// (=: sym|0 [sym1|cnt .. sym2|0] 'any) -> any
+any doSetCol(any ex) {
+   any x, y, z;
+   cell c1;
+
+   x = cdr(ex),  y = val(This);
+   Fetch(ex,y);
+   if (z = car(x),  isCell(cdr(x = cdr(x)))) {
+      y = isNum(z) && !unDig(z)? val(y) : get(y,z);
+      while (z = car(x),  isCell(cdr(x = cdr(x)))) {
+         if (isCell(y))
+            y = getn(z,y);
+         else {
+            NeedSym(ex,y);
+            Fetch(ex,y);
+            y = isNum(z) && !unDig(z)? val(y) : get(y,z);
+         }
+      }
+   }
+   NeedSym(ex,y);
+   CheckNil(ex,y);
+   Push(c1, EVAL(car(x)));
+   Touch(ex,y);
+   if (isNum(z) && IsZero(z))
+      val(y) = x = data(c1);
+   else
+      put(y, z, x = data(c1));
+   drop(c1);
+   return x;
+}
+
+// (: sym|0 [sym1|cnt ..]) -> any
+any doCol(any ex) {
+   any x, y;
+
+   x = cdr(ex),  y = val(This);
+   Fetch(ex,y);
+   y = isNum(car(x)) && !unDig(car(x))? val(y) : get(y, car(x));
+   while (isCell(x = cdr(x))) {
+      if (isCell(y))
+         y = getn(car(x), y);
+      else {
+         NeedSym(ex,y);
+         Fetch(ex,y);
+         y = isNum(car(x)) && !unDig(car(x))? val(y) : get(y, car(x));
+      }
+   }
+   return y;
+}
+
+// (:: sym|0 [sym1|cnt .. sym2]) -> lst|sym
+any doPropCol(any ex) {
+   any x, y;
+
+   x = cdr(ex),  y = val(This);
+   Fetch(ex,y);
+   if (isCell(cdr(x))) {
+      y = isNum(car(x)) && !unDig(car(x))? val(y) : get(y, car(x));
+      while (isCell(cdr(x = cdr(x)))) {
+         if (isCell(y))
+            y = getn(car(x), y);
+         else {
+            NeedSym(ex,y);
+            Fetch(ex,y);
+            y = isNum(car(x)) && !unDig(car(x))? val(y) : get(y, car(x));
+         }
+      }
+   }
+   return prop(y, car(x));
+}
+
+// (putl 'sym1|lst1 ['sym2|cnt ..] 'lst) -> lst
+any doPutl(any ex) {
+   any x;
+   cell c1, c2;
+
+   x = cdr(ex),  Push(c1, EVAL(car(x)));
+   x = cdr(x),  Push(c2, EVAL(car(x)));
+   while (isCell(x = cdr(x))) {
+      if (isCell(data(c1)))
+         data(c1) = getn(data(c2), data(c1));
+      else {
+         NeedSym(ex,data(c1));
+         Fetch(ex,data(c1));
+         data(c1) = isNum(data(c2)) && !unDig(data(c2))? val(data(c1)) : get(data(c1), data(c2));
+      }
+      data(c2) = EVAL(car(x));
+   }
+   NeedSym(ex,data(c1));
+   CheckNil(ex,data(c1));
+   Touch(ex,data(c1));
+   while (isCell(tail(data(c1))))
+      Tail(data(c1), cdr(tail1(data(c1))));
+   for (x = data(c2);  isCell(x);  x = cdr(x)) {
+      if (!isCell(car(x)))
+         Tail(data(c1), cons(car(x), tail1(data(c1))));
+      else if (!isNil(caar(x)))
+         Tail(data(c1), cons(caar(x)==T? cdar(x) : car(x), tail1(data(c1))));
+   }
+   drop(c1);
+   return data(c2);
+}
+
+// (getl 'sym1|lst1 ['sym2|cnt ..]) -> lst
+any doGetl(any ex) {
+   any x, y;
+   cell c1, c2;
+
+   x = cdr(ex),  Push(c1, EVAL(car(x)));
+   while (isCell(x = cdr(x))) {
+      y = EVAL(car(x));
+      if (isCell(data(c1)))
+         data(c1) = getn(y, data(c1));
+      else {
+         NeedSym(ex,data(c1));
+         Fetch(ex,data(c1));
+         data(c1) = isNum(y) && !unDig(y)? val(data(c1)) : get(data(c1), y);
+      }
+   }
+   NeedSym(ex,data(c1));
+   Fetch(ex,data(c1));
+   if (!isCell(x = tail1(data(c1))))
+      data(c2) = Nil;
+   else {
+      Push(c2, y = cons(car(x),Nil));
+      while (isCell(x = cdr(x)))
+         y = cdr(y) = cons(car(x),Nil);
+   }
+   drop(c1);
+   return data(c2);
+}
+
+static void wipe(any x) {
+   any y, z;
+
+   for (y = tail1(x); isCell(y); y = cdr(y));
+   if (!isNum(y)) {
+      val(x) = Nil;
+      tail(x) = y;
+   }
+   else {
+      z = numCell(y);
+      while (isNum(cdr(z)))
+         z = numCell(cdr(z));
+      if (isNil(cdr(z)) || cdr(z) == At) {
+         val(x) = Nil;
+         Tail(x, y);
+         cdr(z) = Nil;
+      }
+   }
+}
+
+// (wipe 'sym|lst) -> sym
+any doWipe(any x) {
+   any y;
+
+   x = cdr(x);
+   if (!isNil(x = EVAL(car(x))))
+      if (!isCell(x))
+         wipe(x);
+      else {
+         y = x; do
+            wipe(car(y));
+         while (isCell(y = cdr(y)));
+      }
+   return x;
+}
+
+static any meta(any x, any y) {
+   any z;
+
+   while (isCell(x)) {
+      if (isSym(car(x)))
+         if (!isNil(z = get(car(x),y)) || !isNil(z = meta(val(car(x)), y)))
+            return z;
+      x = cdr(x);
+   }
+   return Nil;
+}
+
+// (meta 'obj|typ 'sym ['sym2|cnt ..]) -> any
+any doMeta(any ex) {
+   any x, y;
+   cell c1;
+
+   x = cdr(ex),  Push(c1, EVAL(car(x)));
+   if (isSym(data(c1))) {
+      Fetch(ex,data(c1));
+      data(c1) = val(data(c1));
+   }
+   x = cdr(x),  y = EVAL(car(x));
+   data(c1) = meta(data(c1), y);
+   while (isCell(x = cdr(x))) {
+      y = EVAL(car(x));
+      if (isCell(data(c1)))
+         data(c1) = getn(y, data(c1));
+      else {
+         NeedSym(ex,data(c1));
+         Fetch(ex,data(c1));
+         data(c1) = isNum(y) && !unDig(y)? val(data(c1)) : get(data(c1), y);
+      }
+   }
+   return Pop(c1);
+}
+
+/*** Case mappings from the GNU Kaffe Project ***/
+#define CHAR_UPPERCASE  1
+#define CHAR_LOWERCASE  2
+#define CHAR_LETTER     62
+#define CHAR_DIGIT      512
+
+static u_int16_t Blocks[] = {
+   0x1C2, 0x1C2, 0x1C1, 0x12C, 0x12B, 0x1A0, 0x1F8, 0x2DC, 0x25F, 0x2EE, 0x215, 0x346, 0x2DC, 0x326, 0x2BC, 0x216,
+   0x15F, 0x2D4, 0x376, 0x376, 0x376, 0x369, 0xFE8F, 0x344, 0xFF85, 0xFF65, 0xFDB5, 0xFDA1, 0x1B, 0x2C4, 0x1C, 0x47,
+   0xFEA8, 0xFF8C, 0x235, 0xFEFF, 0x1A, 0xFEBF, 0x26, 0xFB20, 0xFE28, 0x113, 0x104, 0xFB61, 0xFB5A, 0x10B, 0x109, 0xFE,
+   0xFF08, 0x229, 0x25E, 0x1C7, 0x1FC, 0x1DC, 0xFC46, 0x229, 0xFE27, 0xFB55, 0x169, 0xFBC8, 0xFC, 0x103, 0xFB68, 0xFB48,
+   0xFB28, 0xFB08, 0xFAE8, 0xFAC8, 0xFAA8, 0xFA88, 0xFA68, 0xFA48, 0x65, 0x50, 0xAB, 0x139, 0xFE0E, 0x63, 0x155, 0x1A8,
+   0xF669, 0x129, 0x128, 0xF91F, 0xFE56, 0x108, 0x107, 0xFAC0, 0xFC8E, 0xFEAD, 0xC6, 0xFCA7, 0xFB95, 0xF47D, 0x9F, 0xFB17,
+   0xFE20, 0xFD28, 0xFB2F, 0x3B, 0xF3B9, 0xFE57, 0xFCCE, 0xFFBB, 0xF339, 0xFA98, 0xFF8B, 0xFF3B, 0xFA54, 0xF7E3, 0xFF2B, 0xFAD7,
+   0xFB69, 0xFC3A, 0xFEE5, 0xF4C8, 0xFCB0, 0xFA88, 0xFDBF, 0xF448, 0xFE45, 0xFCC7, 0xFE4F, 0xF7F1, 0xF715, 0xF2E8, 0xFD9F, 0xF348,
+   0xF96A, 0xFC02, 0xFD97, 0xF2C8, 0xF2A8, 0xF4B9, 0xF4B3, 0xEF6B, 0xF86A, 0xF84A, 0xFC58, 0xF80A, 0xF7EA, 0xFC0F, 0xF7AA, 0xEE9C,
+   0xFB90, 0xF74A, 0xF7FA, 0xF70A, 0xF7CA, 0xF792, 0xF471, 0xF4D2, 0xF732, 0xF64A, 0xF401, 0xF64D, 0xEFA8, 0xF5CA, 0xF5AA, 0xECA1,
+   0xF569, 0xF54A, 0xF52A, 0xF50A, 0xF4EA, 0xF4CA, 0xF4AA, 0xF48A, 0xF46A, 0xF44A, 0xF42A, 0xF40A, 0xF3EA, 0xF3CA, 0xF3AA, 0xF38A,
+   0xF36A, 0xF34A, 0xF32A, 0xF289, 0xF777, 0xF2CA, 0xF2AA, 0xF737, 0xEC28, 0xEC08, 0xEBE8, 0xEBC8, 0xF1EA, 0xF4A2, 0xF545, 0xEDC6,
+   0xF2D7, 0xF14A, 0xE8ED, 0xE81E, 0xF0EA, 0xF597, 0xEA68, 0xEA48, 0xEA28, 0xEA08, 0xE9E8, 0xE9C8, 0xE9A8, 0xE988, 0xE968, 0xE948,
+   0xE928, 0xE908, 0xE8E8, 0xE8C8, 0xE8A8, 0xE888, 0xE868, 0xE848, 0xE828, 0xE808, 0xE7E8, 0xE7C8, 0xE7A8, 0xE788, 0xE768, 0xE748,
+   0xE728, 0xE708, 0xE6E8, 0xE6C8, 0xE6A8, 0xE688, 0xE668, 0xE648, 0xE628, 0xE608, 0xE5E8, 0xE5C8, 0xE5A8, 0xE588, 0xE568, 0xE548,
+   0xE55F, 0xE53F, 0xE51F, 0xE4FF, 0xEFD7, 0xE4BF, 0xE49F, 0xE485, 0xEF87, 0xEF57, 0xEF57, 0xEF57, 0xEF57, 0xEF47, 0xE1AD, 0xEF46,
+   0xEF46, 0xEF46, 0xE1E0, 0xE3DD, 0xEF06, 0xE9D9, 0xEBEB, 0xE244, 0xEED4, 0xEF65, 0xE1F5, 0xEF45, 0xEEE9, 0xEF7C, 0xEE74, 0xEF70,
+   0xEF7D, 0xEF78, 0xEE91, 0xEFD3, 0xEE7D, 0xEE25, 0xEE27, 0xEF65, 0xEFDD, 0xEE96, 0xEFD3, 0xEFE1, 0xEF69, 0xDF88, 0xDF68, 0xDF48,
+   0xED2B, 0xED3D, 0xED19, 0xEF1C, 0xEF08, 0xED47, 0xED3D, 0xED33, 0xEC2B, 0xEC0B, 0xEBEB, 0xEBCB, 0xEBCE, 0xEA7C, 0xEB69, 0xEB6C,
+   0xE9B6, 0xEB0B, 0xEAEB, 0xE9E9, 0xDCA8, 0xDC88, 0xDC68, 0xDC48, 0xE910, 0xEA23, 0xEB58, 0xEB4F, 0xEB45, 0xEAE5, 0xDB68, 0xDB48,
+   0xE92B, 0xE90B, 0xE8EB, 0xE8CB, 0xE8AB, 0xE88B, 0xE86B, 0xE84B, 0xDA28, 0xDA08, 0xD9E8, 0xD9C8, 0xD9A8, 0xD988, 0xD968, 0xD948,
+   0xD928, 0xD908, 0xD8E8, 0xD8C8, 0xD8A8, 0xD888, 0xD868, 0xD848, 0xD828, 0xD808, 0xD7E8, 0xD7C8, 0xD7A8, 0xD788, 0xD768, 0xD748,
+   0xD728, 0xD708, 0xD6E8, 0xD6C8, 0xD6A8, 0xD688, 0xD668, 0xD648, 0xD628, 0xD608, 0xD5E8, 0xD5C8, 0xD5A8, 0xD588, 0xD568, 0xD548,
+   0xD528, 0xD508, 0xD4E8, 0xD4C8, 0xE2B1, 0xE28B, 0xE26B, 0xE270, 0xE22B, 0xE20B, 0xE1EB, 0xE1CB, 0xE1AB, 0xE18B, 0xE18E, 0xDD8F,
+   0xE3A8, 0xDFD3, 0xD929, 0xD90A, 0xE348, 0xD8C9, 0xD8AA, 0xDCD7, 0xDCB2, 0xD681, 0xD82A, 0xD80A, 0xE268, 0xCEDE, 0xD168, 0xD148,
+   0xE116, 0xE0E9, 0xE1CB, 0xE0B7, 0xE0B7, 0xE15E, 0xDF17, 0xE034, 0xE013, 0xDFF3, 0xDFD3, 0xDE6C, 0xDF93, 0xDF73, 0xDF55, 0xDF34,
+   0xD56A, 0xD54A, 0xD52A, 0xD50A, 0xD4EA, 0xD4CA, 0xD4AA, 0xD48A, 0xD46A, 0xD44A, 0xD42A, 0xD40A, 0xD3EA, 0xD3CA, 0xD3AA, 0xD38A,
+   0xD36A, 0xD34A, 0xD32A, 0xD30A, 0xD2EA, 0xD2CA, 0xD2AA, 0xD28A, 0xD26A, 0xD24A, 0xD22A, 0xD20A, 0xD1EA, 0xD1CA, 0xD1AA, 0xD18A,
+   0xD16A, 0xD14A, 0xD12A, 0xD10A, 0xD0EA, 0xD0CA, 0xD0AA, 0xD08A, 0xD06A, 0xD04A, 0xD02A, 0xD00A, 0xCFEA, 0xCFCA, 0xCFAA, 0xCF8A,
+   0xCF6A, 0xCF4A, 0xCF2A, 0xCF0A, 0xCEEA, 0xCECA, 0xCEAA, 0xCE8A, 0xCE6A, 0xCE4A, 0xCE2A, 0xCE0A, 0xCDEA, 0xCDCA, 0xCDAA, 0xCD8A,
+   0xCD6A, 0xCD4A, 0xCD2A, 0xCD0A, 0xCCEA, 0xCCCA, 0xCCAA, 0xCC8A, 0xCC6A, 0xCC4A, 0xCC2A, 0xCC0A, 0xCBEA, 0xCBCA, 0xCBAA, 0xCB8A,
+   0xCB6A, 0xCB4A, 0xCB2A, 0xCB0A, 0xCAEA, 0xCACA, 0xCAAA, 0xCA8A, 0xCA6A, 0xCA4A, 0xCA2A, 0xCA0A, 0xC9EA, 0xC9CA, 0xC9AA, 0xC98A,
+   0xC96A, 0xC94A, 0xC92A, 0xC90A, 0xC8EA, 0xC8CA, 0xC8AA, 0xC88A, 0xC86A, 0xC84A, 0xC82A, 0xC80A, 0xC7EA, 0xC7CA, 0xC7AA, 0xC78A,
+   0xC76A, 0xC74A, 0xC72A, 0xC70A, 0xC6EA, 0xC6CA, 0xC6AA, 0xC68A, 0xC66A, 0xC64A, 0xC62A, 0xC60A, 0xC5EA, 0xC5CA, 0xC5AA, 0xC58A,
+   0xC56A, 0xC54A, 0xC52A, 0xC50A, 0xC4EA, 0xC4CA, 0xC4AA, 0xC48A, 0xC46A, 0xC44A, 0xC42A, 0xC40A, 0xC3EA, 0xC3CA, 0xC3AA, 0xC38A,
+   0xC36A, 0xC34A, 0xC32A, 0xC30A, 0xC2EA, 0xC2CA, 0xC2AA, 0xC28A, 0xC26A, 0xC24A, 0xC22A, 0xC20A, 0xC1EA, 0xC1CA, 0xC1AA, 0xC18A,
+   0xC16A, 0xC14A, 0xC12A, 0xC10A, 0xC0EA, 0xC0CA, 0xC0AA, 0xC08A, 0xC06A, 0xC04A, 0xC02A, 0xC00A, 0xBFEA, 0xBFCA, 0xBFAA, 0xBF8A,
+   0xBF6A, 0xBF4A, 0xBF2A, 0xBF0A, 0xBEEA, 0xBECA, 0xBEAA, 0xBE8A, 0xBE6A, 0xBE4A, 0xBE2A, 0xBE0A, 0xBDEA, 0xBDCA, 0xBDAA, 0xBD8A,
+   0xBD6A, 0xBD4A, 0xBD2A, 0xBD0A, 0xBCEA, 0xBCCA, 0xBCAA, 0xBC8A, 0xBC6A, 0xBC4A, 0xBC2A, 0xBC0A, 0xBBEA, 0xB2E0, 0xB568, 0xB548,
+   0xBB6A, 0xBB4A, 0xBB2A, 0xBB0A, 0xBAEA, 0xBACA, 0xBAAA, 0xBA8A, 0xBA6A, 0xBA4A, 0xBA2A, 0xBA0A, 0xB9EA, 0xB9CA, 0xB9AA, 0xB98A,
+   0xB96A, 0xB94A, 0xB92A, 0xB90A, 0xB8EA, 0xB8CA, 0xB8AA, 0xB88A, 0xB86A, 0xB84A, 0xB82A, 0xB80A, 0xB7EA, 0xB7CA, 0xB7AA, 0xB78A,
+   0xB76A, 0xB74A, 0xB72A, 0xB70A, 0xB6EA, 0xB6CA, 0xB6AA, 0xB68A, 0xB66A, 0xB64A, 0xB62A, 0xB60A, 0xB5EA, 0xB5CA, 0xB5AA, 0xB58A,
+   0xB56A, 0xB54A, 0xB52A, 0xB50A, 0xB4EA, 0xB4CA, 0xB4AA, 0xB48A, 0xB46A, 0xB44A, 0xB42A, 0xB40A, 0xB3EA, 0xB3CA, 0xB3AA, 0xB38A,
+   0xB36A, 0xB34A, 0xB32A, 0xB30A, 0xB2EA, 0xB2CA, 0xB2AA, 0xB28A, 0xB26A, 0xB24A, 0xB22A, 0xB20A, 0xB1EA, 0xB1CA, 0xB1AA, 0xB18A,
+   0xB16A, 0xB14A, 0xB12A, 0xB10A, 0xB0EA, 0xB0CA, 0xB0AA, 0xB08A, 0xB06A, 0xB04A, 0xB02A, 0xB00A, 0xAFEA, 0xAFCA, 0xAFAA, 0xAF8A,
+   0xAF6A, 0xAF4A, 0xAF2A, 0xAF0A, 0xAEEA, 0xAECA, 0xAEAA, 0xAE8A, 0xAE6A, 0xAE4A, 0xAE2A, 0xAE0A, 0xADEA, 0xADCA, 0xADAA, 0xAD8A,
+   0xAD6A, 0xAD4A, 0xAD2A, 0xAD0A, 0xACEA, 0xACCA, 0xACAA, 0xAC8A, 0xAC6A, 0xAC4A, 0xAC2A, 0xAC0A, 0xABEA, 0xABCA, 0xABAA, 0xAB8A,
+   0xAB6A, 0xAB4A, 0xAB2A, 0xAB0A, 0xAAEA, 0xAACA, 0xAAAA, 0xAA8A, 0xAA6A, 0xAA4A, 0xAA2A, 0xAA0A, 0xA9EA, 0xA9CA, 0xA9AA, 0xA98A,
+   0xA96A, 0xA94A, 0xA92A, 0xA90A, 0xA8EA, 0xA8CA, 0xA8AA, 0xA88A, 0xA86A, 0xA84A, 0xA82A, 0xA80A, 0xA7EA, 0xA7CA, 0xA7AA, 0xA78A,
+   0xA76A, 0xA74A, 0xA72A, 0xA70A, 0xA6EA, 0xA6CA, 0xA6AA, 0xA68A, 0xA66A, 0xA64A, 0xA62A, 0xA60A, 0xA5EA, 0xA5CA, 0xA5AA, 0xA58A,
+   0xA56A, 0xA54A, 0xA52A, 0xA50A, 0xA4EA, 0xA4CA, 0xA4AA, 0xA48A, 0xA46A, 0xA44A, 0xA42A, 0xA40A, 0xA3EA, 0xA3CA, 0xA3AA, 0xA38A,
+   0xA36A, 0xA34A, 0xA32A, 0xA30A, 0xA2EA, 0xA2CA, 0xA2AA, 0xA28A, 0xA26A, 0xA24A, 0xA22A, 0xA20A, 0xA1EA, 0xA1CA, 0xA1AA, 0xA18A,
+   0xA16A, 0xA14A, 0xA12A, 0xA10A, 0xA0EA, 0xA0CA, 0xA0AA, 0xA08A, 0xA06A, 0xA04A, 0xA02A, 0xA00A, 0x9FEA, 0x9FCA, 0x9FAA, 0x9F8A,
+   0x9F6A, 0x9F4A, 0x9F2A, 0x9F0A, 0x9EEA, 0x9ECA, 0x9EAA, 0x9E8A, 0x9E6A, 0x9E4A, 0x9E2A, 0x9E0A, 0x9DEA, 0x9DCA, 0x9DAA, 0x9D8A,
+   0x9D6A, 0x9D4A, 0x9D2A, 0x9D0A, 0x9CEA, 0x9CCA, 0x9CAA, 0x9C8A, 0x9C6A, 0x9C4A, 0x9C2A, 0x9C0A, 0x9BEA, 0x9BCA, 0x9BAA, 0x9B8A,
+   0x9B6A, 0x9B4A, 0x9B2A, 0x9B0A, 0x9AEA, 0x9ACA, 0x9AAA, 0x9A8A, 0x9A6A, 0x9A4A, 0x9A2A, 0x9A0A, 0x99EA, 0x99CA, 0x99AA, 0x998A,
+   0x996A, 0x994A, 0x992A, 0x990A, 0x98EA, 0x98CA, 0x98AA, 0x988A, 0x986A, 0x984A, 0x982A, 0x980A, 0x97EA, 0x97CA, 0x97AA, 0x978A,
+   0x976A, 0x974A, 0x972A, 0x970A, 0x96EA, 0x96CA, 0x96AA, 0x968A, 0x966A, 0x964A, 0x962A, 0x960A, 0x95EA, 0x95CA, 0x95AA, 0x958A,
+   0x956A, 0x954A, 0x952A, 0x950A, 0x94EA, 0x94CA, 0x94AA, 0x948A, 0x946A, 0x944A, 0x942A, 0x940A, 0x93EA, 0x93CA, 0x93AA, 0x938A,
+   0x936A, 0x934A, 0x932A, 0x930A, 0x92EA, 0x92CA, 0x92AA, 0x928A, 0x926A, 0x924A, 0x922A, 0x920A, 0x91EA, 0x91CA, 0x91AA, 0x918A,
+   0x916A, 0x914A, 0x912A, 0x910A, 0x90EA, 0x90CA, 0x90AA, 0x908A, 0x906A, 0x904A, 0x902A, 0x900A, 0x8FEA, 0x8FCA, 0x8FAA, 0x8F8A,
+   0x8F6A, 0x8F4A, 0x8F2A, 0x8F0A, 0x8EEA, 0x8ECA, 0x8EAA, 0x8E8A, 0x8E6A, 0x8E4A, 0x8E2A, 0x8E0A, 0x8DEA, 0x8DCA, 0x8DAA, 0x8D8A,
+   0x8D6A, 0x8D4A, 0x8D2A, 0x8D0A, 0x8CEA, 0x8CCA, 0x8CAA, 0x8C8A, 0x8C6A, 0x8C4A, 0x8C2A, 0x8C0A, 0x8BEA, 0x8BCA, 0x8BAA, 0x8B8A,
+   0x8B6A, 0x8B4A, 0x8B2A, 0x8B0A, 0x8AEA, 0x8ACA, 0x8AAA, 0x8A8A, 0x8A6A, 0x8A4A, 0x8A2A, 0x8A0A, 0x89EA, 0x89CA, 0x89AA, 0x898A,
+   0x896A, 0x894A, 0x892A, 0x890A, 0x88EA, 0x88CA, 0x88AA, 0x888A, 0x886A, 0x884A, 0x882A, 0x880A, 0x87EA, 0x87CA, 0x87AA, 0x878A,
+   0x876A, 0x874A, 0x872A, 0x870A, 0x86EA, 0x86CA, 0x86AA, 0x868A, 0x866A, 0x864A, 0x862A, 0x860A, 0x85EA, 0x85CA, 0x85AA, 0x858A,
+   0x856A, 0x854A, 0x852A, 0x850A, 0x84EA, 0x84CA, 0x84AA, 0x848A, 0x846A, 0x844A, 0x842A, 0x840A, 0x83EA, 0x83CA, 0x83AA, 0x838A,
+   0x836A, 0x834A, 0x832A, 0x830A, 0x82EA, 0x82CA, 0x82AA, 0x828A, 0x826A, 0x824A, 0x822A, 0x820A, 0x81EA, 0x81CA, 0x81AA, 0x818A,
+   0x816A, 0x814A, 0x812A, 0x810A, 0x80EA, 0x80CA, 0x80AA, 0x808A, 0x806A, 0x804A, 0x802A, 0x800A, 0x7FEA, 0x7FCA, 0x7FAA, 0x7F8A,
+   0x7F6A, 0x7F4A, 0x7F2A, 0x7F0A, 0x7EEA, 0x7ECA, 0x7EAA, 0x7E8A, 0x7E6A, 0x7E4A, 0x7E2A, 0x7E0A, 0x7DEA, 0x7DCA, 0x7DAA, 0x7D8A,
+   0x7D6A, 0x7D4A, 0x7D2A, 0x7D0A, 0x7CEA, 0x7CCA, 0x7CAA, 0x7C8A, 0x7C6A, 0x7C4A, 0x7C2A, 0x7C0A, 0x7BEA, 0x7BCA, 0x7BAA, 0x7B8A,
+   0x7B6A, 0x7B4A, 0x7B2A, 0x7B0A, 0x7AEA, 0x7ACA, 0x7AAA, 0x7A8A, 0x7A6A, 0x7A4A, 0x7A2A, 0x7A0A, 0x79EA, 0x79CA, 0x79AA, 0x798A,
+   0x796A, 0x794A, 0x792A, 0x790A, 0x78EA, 0x78CA, 0x78AA, 0x788A, 0x786A, 0x784A, 0x782A, 0x780A, 0x77EA, 0x77CA, 0x77AA, 0x778A,
+   0x776A, 0x774A, 0x772A, 0x770A, 0x76EA, 0x76CA, 0x76AA, 0x768A, 0x766A, 0x764A, 0x762A, 0x760A, 0x75EA, 0x75CA, 0x75AA, 0x758A,
+   0x756A, 0x754A, 0x752A, 0x750A, 0x74EA, 0x74CA, 0x74AA, 0x748A, 0x746A, 0x744A, 0x742A, 0x740A, 0x73EA, 0x73CA, 0x73AA, 0x738A,
+   0x736A, 0x734A, 0x732A, 0x730A, 0x72EA, 0x72CA, 0x72AA, 0x728A, 0x726A, 0x724A, 0x722A, 0x720A, 0x71EA, 0x71CA, 0x71AA, 0x718A,
+   0x716A, 0x714A, 0x712A, 0x710A, 0x70EA, 0x70CA, 0x70AA, 0x708A, 0x706A, 0x704A, 0x702A, 0x700A, 0x6FEA, 0x6FCA, 0x6FAA, 0x6F8A,
+   0x6F6A, 0x6F4A, 0x6F2A, 0x6F0A, 0x6EEA, 0x6ECA, 0x6EAA, 0x6E8A, 0x6E6A, 0x6E4A, 0x6E2A, 0x6E0A, 0x6DEA, 0x6DCA, 0x6DAA, 0x6D8A,
+   0x6D6A, 0x6D4A, 0x6D2A, 0x6D0A, 0x6CEA, 0x6CCA, 0x6CAA, 0x6C8A, 0x6C6A, 0x6C4A, 0x6C2A, 0x6C0A, 0x6BEA, 0x6BCA, 0x6BAA, 0x6B8A,
+   0x6B6A, 0x6B4A, 0x6B2A, 0x6B0A, 0x6AEA, 0x6ACA, 0x6AAA, 0x6A8A, 0x6A6A, 0x6A4A, 0x6A2A, 0x6A0A, 0x69EA, 0x60F0, 0x6368, 0x6348,
+   0x696A, 0x694A, 0x692A, 0x690A, 0x68EA, 0x68CA, 0x68AA, 0x688A, 0x686A, 0x684A, 0x682A, 0x680A, 0x67EA, 0x67CA, 0x67AA, 0x678A,
+   0x676A, 0x674A, 0x672A, 0x670A, 0x66EA, 0x66CA, 0x66AA, 0x668A, 0x666A, 0x664A, 0x662A, 0x660A, 0x65EA, 0x65CA, 0x65AA, 0x658A,
+   0x656A, 0x654A, 0x652A, 0x650A, 0x6B26, 0x6DE1, 0x6E9C, 0x5E48, 0x5E28, 0x5E08, 0x5DE8, 0x5DC8, 0x5DA8, 0x5D88, 0x5D68, 0x5D48,
+   0x5D28, 0x5D08, 0x5CE8, 0x5CC8, 0x5CA8, 0x5C88, 0x5C68, 0x5C48, 0x5C28, 0x5C08, 0x5BE8, 0x5BC8, 0x5BA8, 0x5B88, 0x5B68, 0x5B48,
+   0x5B28, 0x5B08, 0x5AE8, 0x5AC8, 0x5AA8, 0x5A88, 0x5A68, 0x5A48, 0x5A28, 0x5A08, 0x59E8, 0x59C8, 0x59A8, 0x5988, 0x5968, 0x5948,
+   0x5928, 0x5908, 0x58E8, 0x58C8, 0x58A8, 0x5888, 0x5868, 0x5848, 0x5828, 0x5808, 0x57E8, 0x57C8, 0x57A8, 0x5788, 0x5768, 0x5748,
+   0x5D6A, 0x5D4A, 0x5D2A, 0x5D0A, 0x5CEA, 0x5CCA, 0x5CAA, 0x5C8A, 0x5C6A, 0x5C4A, 0x5C2A, 0x5C0A, 0x5BEA, 0x5BCA, 0x5BAA, 0x5B8A,
+   0x5B6A, 0x5B4A, 0x5B2A, 0x5B0A, 0x5AEA, 0x5ACA, 0x5AAA, 0x5A8A, 0x5A6A, 0x5A4A, 0x5A2A, 0x5A0A, 0x59EA, 0x59CA, 0x59AA, 0x598A,
+   0x596A, 0x594A, 0x592A, 0x590A, 0x58EA, 0x58CA, 0x58AA, 0x588A, 0x586A, 0x584A, 0x582A, 0x580A, 0x57EA, 0x57CA, 0x57AA, 0x578A,
+   0x576A, 0x574A, 0x572A, 0x570A, 0x56EA, 0x56CA, 0x56AA, 0x568A, 0x566A, 0x564A, 0x562A, 0x560A, 0x55EA, 0x55CA, 0x55AA, 0x558A,
+   0x556A, 0x554A, 0x552A, 0x550A, 0x54EA, 0x54CA, 0x54AA, 0x548A, 0x546A, 0x544A, 0x542A, 0x540A, 0x53EA, 0x53CA, 0x53AA, 0x538A,
+   0x536A, 0x534A, 0x532A, 0x530A, 0x52EA, 0x52CA, 0x52AA, 0x528A, 0x526A, 0x524A, 0x522A, 0x520A, 0x51EA, 0x51CA, 0x51AA, 0x518A,
+   0x516A, 0x514A, 0x512A, 0x510A, 0x50EA, 0x50CA, 0x50AA, 0x508A, 0x506A, 0x504A, 0x502A, 0x500A, 0x4FEA, 0x4FCA, 0x4FAA, 0x4F8A,
+   0x4F6A, 0x4F4A, 0x4F2A, 0x4F0A, 0x4EEA, 0x4ECA, 0x4EAA, 0x4E8A, 0x4E6A, 0x4E4A, 0x4E2A, 0x4E0A, 0x4DEA, 0x4DCA, 0x4DAA, 0x4D8A,
+   0x4D6A, 0x4D4A, 0x4D2A, 0x4D0A, 0x4CEA, 0x4CCA, 0x4CAA, 0x4C8A, 0x4C6A, 0x4C4A, 0x4C2A, 0x4C0A, 0x4BEA, 0x4BCA, 0x4BAA, 0x4B8A,
+   0x4B6A, 0x4B4A, 0x4B2A, 0x4B0A, 0x4AEA, 0x4ACA, 0x4AAA, 0x4A8A, 0x4A6A, 0x4A4A, 0x4A2A, 0x4A0A, 0x49EA, 0x49CA, 0x49AA, 0x498A,
+   0x496A, 0x494A, 0x492A, 0x490A, 0x48EA, 0x48CA, 0x48AA, 0x488A, 0x486A, 0x484A, 0x482A, 0x480A, 0x47EA, 0x47CA, 0x47AA, 0x478A,
+   0x476A, 0x474A, 0x472A, 0x470A, 0x46EA, 0x46CA, 0x46AA, 0x468A, 0x466A, 0x464A, 0x462A, 0x460A, 0x45EA, 0x45CA, 0x45AA, 0x458A,
+   0x456A, 0x454A, 0x452A, 0x450A, 0x44EA, 0x44CA, 0x44AA, 0x448A, 0x446A, 0x444A, 0x442A, 0x440A, 0x43EA, 0x43CA, 0x43AA, 0x438A,
+   0x436A, 0x434A, 0x432A, 0x430A, 0x42EA, 0x42CA, 0x42AA, 0x428A, 0x426A, 0x424A, 0x422A, 0x420A, 0x41EA, 0x41CA, 0x41AA, 0x418A,
+   0x416A, 0x414A, 0x412A, 0x410A, 0x40EA, 0x40CA, 0x40AA, 0x408A, 0x406A, 0x404A, 0x402A, 0x400A, 0x3FEA, 0x3FCA, 0x3FAA, 0x3F8A,
+   0x3F6A, 0x3F4A, 0x3F2A, 0x3F0A, 0x3EEA, 0x3ECA, 0x3EAA, 0x3E8A, 0x3E6A, 0x3E4A, 0x3E2A, 0x3E0A, 0x3DEA, 0x3DCA, 0x3DAA, 0x3D8A,
+   0x3D6A, 0x3D4A, 0x3D2A, 0x3D0A, 0x3CEA, 0x3CCA, 0x3CAA, 0x3C8A, 0x3C6A, 0x3C4A, 0x3C2A, 0x3C0A, 0x3BEA, 0x3BCA, 0x3BAA, 0x3B8A,
+   0x3B6A, 0x3B4A, 0x3B2A, 0x3B0A, 0x3AEA, 0x3ACA, 0x3AAA, 0x3A8A, 0x3A6A, 0x3A4A, 0x3A2A, 0x3A0A, 0x39EA, 0x39CA, 0x39AA, 0x398A,
+   0x396A, 0x394A, 0x392A, 0x390A, 0x38EA, 0x38CA, 0x38AA, 0x388A, 0x386A, 0x384A, 0x382A, 0x380A, 0x37EA, 0x37CA, 0x37AA, 0x378A,
+   0x376A, 0x374A, 0x372A, 0x370A, 0x36EA, 0x36CA, 0x36AA, 0x368A, 0x366A, 0x364A, 0x362A, 0x360A, 0x35EA, 0x35CA, 0x35AA, 0x358A,
+   0x356A, 0x354A, 0x352A, 0x350A, 0x34EA, 0x34CA, 0x34AA, 0x348A, 0x346A, 0x344A, 0x342A, 0x340A, 0x33EA, 0x33CA, 0x33AA, 0x338A,
+   0x336A, 0x334A, 0x332A, 0x330A, 0x32EA, 0x32CA, 0x32AA, 0x328A, 0x326A, 0x324A, 0x322A, 0x320A, 0x31EA, 0x28F2, 0x2B68, 0x2B48,
+   0x3C2B, 0x3C0B, 0x3BEB, 0x3BCB, 0x3BAB, 0x3B8B, 0x3B6B, 0x3B4B, 0x3B2B, 0x3B0B, 0x3AEB, 0x3ACB, 0x3AAB, 0x3A8B, 0x3A6B, 0x3A4B,
+   0x3A2B, 0x3A0B, 0x39EB, 0x39CB, 0x39AB, 0x398B, 0x396B, 0x394B, 0x392B, 0x390B, 0x38EB, 0x38CB, 0x38AB, 0x388B, 0x386B, 0x384B,
+   0x382B, 0x380B, 0x37EB, 0x37CB, 0x37AB, 0x378B, 0x376B, 0x374B, 0x372B, 0x370B, 0x36EB, 0x36CB, 0x36AB, 0x368B, 0x366B, 0x364B,
+   0x362B, 0x360B, 0x35EB, 0x35CB, 0x35AB, 0x358B, 0x356B, 0x354B, 0x352B, 0x350B, 0x34EB, 0x34CB, 0x34AB, 0x348B, 0x346B, 0x344B,
+   0x344B, 0x342B, 0x340B, 0x33EB, 0x33CB, 0x33AB, 0x338B, 0x336B, 0x334B, 0x332B, 0x330B, 0x32EB, 0x32CB, 0x32AB, 0x328B, 0x326B,
+   0x324B, 0x322B, 0x320B, 0x31EB, 0x31CB, 0x31AB, 0x318B, 0x316B, 0x314B, 0x312B, 0x310B, 0x30EB, 0x30CB, 0x30AB, 0x308B, 0x306B,
+   0x304B, 0x302B, 0x300B, 0x2FEB, 0x2FCB, 0x2FAB, 0x2F8B, 0x2F6B, 0x2F4B, 0x2F2B, 0x2F0B, 0x2EEB, 0x2ECB, 0x2EAB, 0x2E8B, 0x2E6B,
+   0x2E4B, 0x2E2B, 0x2E0B, 0x2DEB, 0x2DCB, 0x2DAB, 0x2D8B, 0x2D6B, 0x2D4B, 0x2D2B, 0x2D0B, 0x2CEB, 0x2CCB, 0x2CAB, 0x2C8B, 0x2C6B,
+   0x2C4B, 0x2C2B, 0x2C0B, 0x2BEB, 0x2BCB, 0x2BAB, 0x2B8B, 0x2B6B, 0x2B4B, 0x2B2B, 0x2B0B, 0x2AEB, 0x2ACB, 0x2AAB, 0x2A8B, 0x2A6B,
+   0x2A4B, 0x2A2B, 0x2A0B, 0x29EB, 0x29CB, 0x29AB, 0x298B, 0x296B, 0x294B, 0x292B, 0x290B, 0x28EB, 0x28CB, 0x28AB, 0x288B, 0x286B,
+   0x284B, 0x282B, 0x280B, 0x27EB, 0x27CB, 0x27AB, 0x278B, 0x276B, 0x274B, 0x272B, 0x270B, 0x26EB, 0x26CB, 0x26AB, 0x268B, 0x266B,
+   0x264B, 0x262B, 0x260B, 0x25EB, 0x25CB, 0x25AB, 0x258B, 0x256B, 0x254B, 0x252B, 0x250B, 0x24EB, 0x24CB, 0x24AB, 0x248B, 0x246B,
+   0x244B, 0x242B, 0x240B, 0x23EB, 0x23CB, 0x23AB, 0x238B, 0x236B, 0x234B, 0x232B, 0x230B, 0x22EB, 0x22CB, 0x22AB, 0x228B, 0x226B,
+   0x224B, 0x222B, 0x220B, 0x21EB, 0x21CB, 0x21AB, 0x218B, 0x216B, 0x214B, 0x212B, 0x210B, 0x20EB, 0x20CB, 0x20AB, 0x208B, 0x206B,
+   0x204B, 0x202B, 0x200B, 0x1FEB, 0x1FCB, 0x1FAB, 0x1F8B, 0x1F6B, 0x1F4B, 0x1F2B, 0x1F0B, 0x1EEB, 0x1ECB, 0x1EAB, 0x1E8B, 0x1E6B,
+   0x1E4B, 0x1E2B, 0x1E0B, 0x1DEB, 0x1DCB, 0x1DAB, 0x1D8B, 0x1D6B, 0x1D4B, 0x1D2B, 0x1D0B, 0x1CEB, 0x1CCB, 0x1CAB, 0x1C8B, 0x1C6B,
+   0x1C4B, 0x1C2B, 0x1C0B, 0x1BEB, 0x1BCB, 0x1BAB, 0x1B8B, 0x1B6B, 0x106A, 0x104A, 0x102A, 0x100A, 0xFEA, 0xFCA, 0xFAA, 0xF8A,
+   0xF6A, 0x668, 0x8E8, 0x8C8, 0x8A8, 0x888, 0x868, 0x848, 0x7D7, 0x194B, 0x7B6, 0xD1C, 0xCFC, 0xCB2, 0xCA9, 0xC9C,
+   0xC7C, 0xC5C, 0xC3C, 0xC1C, 0xBFC, 0xBDC, 0xBBC, 0xB9C, 0xB7C, 0xB5E, 0xB2C, 0xB1C, 0xAB8, 0xADC, 0xA9C, 0x2C2,
+   0x528, 0x166B, 0x1667, 0x3FF, 0x9FC, 0x9DC, 0x9BC, 0x659, 0xBB8, 0x15A7, 0xFC6, 0x1C0, 0x1B1, 0x9CB, 0x82C, 0x1285,
+};
+
+static u_int16_t Data[] = {
+   0x3001, 0x3082, 0x3001, 0x3082, 0x3001, 0x3082, 0x3001, 0x3082, 0x3001, 0x3082, 0x3001, 0x3082, 0x3001, 0x3082, 0x3001, 0x3082,
+   0x3001, 0x3082, 0x3001, 0x3082, 0x3001, 0x3082, 0x3E80, 0x3E80, 0x3001, 0x3082, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80,
+   0x3A85, 0x3A85, 0x3E80, 0x3E80, 0x3E80, 0x3A85, 0x3A85, 0x3A85, 0x3E80, 0x3E80, 0x3E80, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85,
+   0x3A85, 0x3A85, 0x3A85, 0x3E80, 0x3A85, 0x3A85, 0x3A85, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x5B88, 0x5B88, 0x3E80, 0x3A85, 0x3A85,
+   0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3E80, 0x3A85, 0x3A85, 0x3A85, 0x3E80, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85,
+   0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85,
+   0x3A85, 0x3A85, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x5198, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x4606, 0x3E80, 0x3E80, 0x3A85, 0x3A85,
+   0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3A85, 0x3A85, 0x3E80, 0x3E80, 0x3A85, 0x3A85, 0x3A85, 0x3A85,
+   0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85,
+   0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80,
+   0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80,
+   0x3E80, 0x3E80, 0x5405, 0x5405, 0x5405, 0x5405, 0x5405, 0x5405, 0x5405, 0x5405, 0x5405, 0x5405, 0x5405, 0x5405, 0x3E80, 0x3E80,
+   0x3E80, 0x3E80, 0x5202, 0x5202, 0x5202, 0x5202, 0x5202, 0x5202, 0x5202, 0x5202, 0x5202, 0x5202, 0x5202, 0x5202, 0x5202, 0x5202,
+   0x5202, 0x5202, 0x5202, 0x5202, 0x5202, 0x5202, 0x5202, 0x5202, 0x5202, 0x5202, 0x5202, 0x5202, 0x5202, 0x5202, 0x5202, 0x5202,
+   0x5202, 0x2E82, 0x3E80, 0x5198, 0x2A14, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x4606, 0x4606, 0x4606, 0x4606, 0x4606,
+   0x4606, 0x4606, 0x4606, 0x4606, 0x4606, 0x4606, 0x4606, 0x4606, 0x4606, 0x4606, 0x4686, 0x4606, 0x4606, 0x4606, 0x4606, 0x4606,
+   0x4606, 0x4606, 0x4606, 0x4606, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80,
+   0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x1A1B, 0x1A1B, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x4584, 0x3E80, 0x3E80, 0x3E80, 0x298,
+   0x3E80, 0x298, 0x6615, 0x6696, 0x298, 0x1A97, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85,
+   0x4584, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85,
+   0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x4584,
+   0x4584, 0x1A1B, 0x1A1B, 0x1A1B, 0x1A1B, 0x1A1B, 0x1A1B, 0x1A1B, 0x1A1B, 0x1A1B, 0x1A1B, 0x1A1B, 0x1A1B, 0x1A1B, 0x1A1B, 0x4584,
+   0x4584, 0x1A1B, 0x1A1B, 0x1A1B, 0x1A1B, 0x1A1B, 0x1A1B, 0x1A1B, 0x1A1B, 0x1A1B, 0x1A1B, 0x1A1B, 0x1A1B, 0x1A1B, 0x1A1B, 0x2E82,
+   0x7282, 0x2E82, 0x3E80, 0x2E82, 0x4902, 0x7481, 0x7481, 0x7481, 0x7481, 0x7383, 0x1A1B, 0x1A1B, 0x1A1B, 0x6D82, 0x6D82, 0x4902,
+   0x4902, 0x3E80, 0x3E80, 0x2E82, 0x4902, 0x6E01, 0x6E01, 0x7501, 0x7501, 0x3E80, 0x1A1B, 0x1A1B, 0x1A1B, 0x1B02, 0x1B82, 0x1C02,
+   0x1C82, 0x1D02, 0x1D82, 0x1E02, 0x1E82, 0x1F02, 0x1F82, 0x2002, 0x2082, 0x2102, 0x2182, 0x2202, 0x2282, 0x2302, 0x2382, 0x2402,
+   0x2482, 0x2502, 0x2582, 0x2602, 0x2682, 0x2702, 0x2782, 0x455, 0xC99, 0x4D6, 0xC99, 0xF, 0xF, 0xF, 0xF, 0xF,
+   0x10F, 0xF, 0xF, 0xF, 0xF, 0xF, 0xF, 0xF, 0xF, 0xF, 0xF, 0xF, 0xF, 0xF, 0xF, 0xF,
+   0xF, 0xF, 0xF, 0xF, 0xF, 0xF, 0xF, 0xF, 0xF, 0xF, 0xF, 0x8F, 0x10F, 0x8F, 0x18F, 0x10F,
+   0xF, 0xF, 0xF, 0xF, 0xF, 0xF, 0xF, 0xF, 0xF, 0xF, 0xF, 0xF, 0xF, 0xF, 0x10F, 0x10F,
+   0x10F, 0x8F, 0x20C, 0x298, 0x298, 0x318, 0x39A, 0x318, 0x298, 0x298, 0x455, 0x4D6, 0x298, 0x519, 0x598, 0x614,
+   0x598, 0x698, 0x709, 0x789, 0x809, 0x889, 0x909, 0x989, 0xA09, 0xA89, 0xB09, 0xB89, 0x598, 0x298, 0xC59, 0xC99,
+   0xC59, 0x298, 0xD01, 0xD81, 0xE01, 0xE81, 0xF01, 0xF81, 0x1001, 0x1081, 0x1101, 0x1181, 0x1201, 0x1281, 0x1301, 0x1381,
+   0x1401, 0x1481, 0x1501, 0x1581, 0x1601, 0x1681, 0x1701, 0x1781, 0x1801, 0x1881, 0x1901, 0x1981, 0x455, 0x298, 0x4D6, 0x1A1B,
+   0x1A97, 0x298, 0x298, 0x298, 0xC99, 0x455, 0x4D6, 0x3E80, 0x298, 0x298, 0x298, 0x298, 0x298, 0x298, 0x3E80, 0x3E80,
+   0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80,
+   0x282C, 0x298, 0x39A, 0x39A, 0x39A, 0x39A, 0x289C, 0x289C, 0x1A1B, 0x289C, 0x2902, 0x29DD, 0xC99, 0x2A14, 0x289C, 0x1A1B,
+   0x2A9C, 0x519, 0x2B0B, 0x2B8B, 0x1A1B, 0x2C02, 0x289C, 0x298, 0x1A1B, 0x2C8B, 0x2902, 0x2D5E, 0x2D8B, 0x2D8B, 0x2D8B, 0x298,
+   0x298, 0x519, 0x614, 0xC99, 0xC99, 0xC99, 0x3E80, 0x298, 0x39A, 0x318, 0x298, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x5405,
+   0x5405, 0x5405, 0x3E80, 0x5405, 0x3E80, 0x5405, 0x5405, 0x5405, 0x5405, 0x5405, 0x5405, 0x5405, 0x5405, 0x5405, 0x5405, 0x5405,
+   0x5405, 0x5405, 0x3E80, 0x3E80, 0x3E80, 0x4606, 0x4606, 0x4606, 0x4606, 0x4606, 0x4606, 0x4606, 0x4606, 0x4606, 0x4606, 0x4606,
+   0x4606, 0x4606, 0x4606, 0x4606, 0x4606, 0x4606, 0x4606, 0x4606, 0x4606, 0x4606, 0x4606, 0x4606, 0x4606, 0x4606, 0x4606, 0x4606,
+   0x4606, 0x4606, 0x4606, 0x4606, 0x4606, 0x3E80, 0x501C, 0x501C, 0x4F81, 0x4F81, 0x4F81, 0x4F81, 0x4F81, 0x4F81, 0x4F81, 0x4F81,
+   0x4F81, 0x4F81, 0x4F81, 0x4F81, 0x4F81, 0x4F81, 0x4F81, 0x4F81, 0x2E01, 0x2E01, 0x2E01, 0x2E01, 0x2E01, 0x2E01, 0x2E01, 0x2E01,
+   0x2E01, 0x2E01, 0x2E01, 0x2E01, 0x2E01, 0x2E01, 0x2E01, 0x2E01, 0x2E01, 0x2E01, 0x2E01, 0x2E01, 0x2E01, 0x2E01, 0x2E01, 0xC99,
+   0x2E01, 0x2E01, 0x2E01, 0x2E01, 0x2E01, 0x2E01, 0x2E01, 0x2E82, 0x2E82, 0x2E82, 0x4902, 0x4902, 0x2E82, 0x2E82, 0x3E80, 0x3E80,
+   0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x2E82, 0x2E82, 0x2E82, 0x2E82, 0x2E82, 0x3E80,
+   0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x5305, 0x4606, 0x5305, 0x5305, 0x3E80, 0x5305, 0x5305, 0x3E80, 0x5305, 0x5305, 0x5305, 0x5305,
+   0x5305, 0x5305, 0x5305, 0x5305, 0x5305, 0x5305, 0x5405, 0x5405, 0x5405, 0x5405, 0x5405, 0x5405, 0x5405, 0x5405, 0x5405, 0x5405,
+   0x5405, 0x5405, 0x5405, 0x5405, 0x5405, 0x5405, 0x5405, 0x5405, 0x5405, 0x5405, 0x5398, 0x5405, 0x4606, 0x4606, 0x4606, 0x4606,
+   0x4606, 0x4606, 0x4606, 0x5087, 0x5087, 0x4606, 0x5087, 0x5087, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80,
+   0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80,
+   0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x2D8B, 0x2D8B, 0x2D8B, 0x2D8B, 0x2D8B, 0x2D8B, 0x2D8B, 0x2D8B,
+   0x2D8B, 0x2D8B, 0x2D8B, 0x2D8B, 0x840B, 0x3082, 0x3001, 0x3082, 0x3001, 0x3082, 0x3001, 0x3082, 0x3001, 0x3082, 0x2E82, 0x3001,
+   0x3082, 0x3001, 0x3082, 0x3001, 0x3082, 0x3001, 0x3082, 0x3001, 0x3082, 0x3001, 0x3082, 0x3001, 0x3082, 0x3001, 0x3082, 0x3001,
+   0x3082, 0x3001, 0x3082, 0x3001, 0x3082, 0x3001, 0x3082, 0x3001, 0x3082, 0x3001, 0x3082, 0x3001, 0x3082, 0x3001, 0x3082, 0x3E80,
+   0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x5C09, 0x5C89, 0x5D09, 0x5D89, 0x5E09, 0x5E89, 0x5F09, 0x5F89, 0x6009, 0x6089, 0x4606,
+   0x4606, 0x3A85, 0x3A85, 0x3A85, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x1A1B,
+   0x1A1B, 0x4701, 0x298, 0x4781, 0x4781, 0x4781, 0x3E80, 0x4801, 0x3E80, 0x4881, 0x4881, 0x4902, 0x2E01, 0x2E01, 0x2E01, 0x2E01,
+   0x2E01, 0x2E01, 0x2E01, 0x2E01, 0x2E01, 0x2E01, 0x2E01, 0x2E01, 0x2E01, 0x2E01, 0x2E01, 0x2E01, 0x2F02, 0x2F02, 0x2F02, 0x2F02,
+   0x2F02, 0x2F02, 0x2F02, 0x2F02, 0x2F02, 0x2F02, 0x2F02, 0x2F02, 0x2F02, 0x2F02, 0x2F02, 0x2F02, 0x2F02, 0x2F02, 0x2F02, 0x2F02,
+   0x2F02, 0x2F02, 0x2F02, 0xC99, 0x2F02, 0x2F02, 0x2F02, 0x2F02, 0x2F02, 0x2F02, 0x2F02, 0x2F82, 0x2F02, 0x2F02, 0x4A82, 0x2F02,
+   0x2F02, 0x2F02, 0x2F02, 0x2F02, 0x2F02, 0x2F02, 0x2F02, 0x2F02, 0x4B02, 0x4B82, 0x4B82, 0x3E80, 0x4C02, 0x4C82, 0x4D01, 0x4D01,
+   0x4D01, 0x4D82, 0x4E02, 0x2902, 0x3E80, 0x3E80, 0x3001, 0x3082, 0x3001, 0x3082, 0x3001, 0x3082, 0x3001, 0x3082, 0x3001, 0x3082,
+   0x3001, 0x3082, 0x3001, 0x3082, 0x3001, 0x3082, 0x2E82, 0x3B81, 0x3C03, 0x3C82, 0x3001, 0x3082, 0x3D81, 0x3E01, 0x3001, 0x3082,
+   0x3001, 0x3082, 0x3001, 0x3082, 0x3001, 0x3082, 0x3001, 0x3082, 0x3001, 0x3082, 0x3001, 0x3082, 0x3001, 0x3082, 0x3101, 0x3182,
+   0x3001, 0x3082, 0x3001, 0x3082, 0x3001, 0x3082, 0x2902, 0x3001, 0x3082, 0x3001, 0x3082, 0x3001, 0x3082, 0x3001, 0x3082, 0x3001,
+   0x3082, 0x3001, 0x3082, 0x3001, 0x3082, 0x3001, 0x3082, 0x4E82, 0x4F02, 0x3D02, 0x2902, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80,
+   0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x5B10, 0x5B10, 0x5B10, 0x5B10, 0x5B10, 0x5B10, 0x7F0B, 0x3E80, 0x3E80,
+   0x3E80, 0x7F8B, 0x800B, 0x808B, 0x810B, 0x818B, 0x820B, 0x519, 0x519, 0xC99, 0x455, 0x4D6, 0x2902, 0x3301, 0x3001, 0x3082,
+   0x3001, 0x3082, 0x3381, 0x3001, 0x3082, 0x3401, 0x3401, 0x3001, 0x3082, 0x2902, 0x3481, 0x3501, 0x3581, 0x3001, 0x3082, 0x3401,
+   0x3601, 0x3682, 0x3701, 0x3781, 0x3001, 0x3082, 0x2902, 0x2902, 0x3701, 0x3801, 0x2902, 0x3881, 0x3A85, 0x3A85, 0x3A85, 0x3A85,
+   0x3B81, 0x3C03, 0x3C82, 0x3B81, 0x3C03, 0x3C82, 0x3B81, 0x3C03, 0x3C82, 0x3001, 0x3082, 0x3001, 0x3082, 0x3001, 0x3082, 0x3001,
+   0x3082, 0x3001, 0x3082, 0x3001, 0x3082, 0x3001, 0x3082, 0x3001, 0x3082, 0x3D02, 0x3001, 0x3082, 0x501C, 0x4606, 0x4606, 0x4606,
+   0x4606, 0x3E80, 0x5087, 0x5087, 0x3E80, 0x3E80, 0x3001, 0x3082, 0x3001, 0x3082, 0x3001, 0x3082, 0x3001, 0x3082, 0x3001, 0x3082,
+   0x3001, 0x3082, 0x3001, 0x3082, 0x3001, 0x3082, 0x3001, 0x3082, 0x3001, 0x3082, 0x3001, 0x3082, 0x3001, 0x3082, 0x3201, 0x3001,
+   0x3082, 0x3001, 0x3082, 0x3001, 0x3082, 0x3282, 0x3001, 0x3082, 0x3001, 0x3082, 0x3001, 0x3082, 0x3901, 0x3001, 0x3082, 0x3901,
+   0x2902, 0x2902, 0x3001, 0x3082, 0x3901, 0x3001, 0x3082, 0x3981, 0x3981, 0x3001, 0x3082, 0x3001, 0x3082, 0x3A01, 0x3001, 0x3082,
+   0x2902, 0x3A85, 0x3001, 0x3082, 0x2902, 0x3B02, 0x4D01, 0x3001, 0x3082, 0x3001, 0x3082, 0x3E80, 0x3E80, 0x3001, 0x3082, 0x3E80,
+   0x3E80, 0x3001, 0x3082, 0x3E80, 0x3E80, 0x3E80, 0x3001, 0x3082, 0x3001, 0x3082, 0x3001, 0x3082, 0x3001, 0x3082, 0x3001, 0x3082,
+   0x3001, 0x3082, 0x3001, 0x3082, 0x3001, 0x3082, 0x3001, 0x3082, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80,
+   0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x598, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80,
+   0x3E80, 0x3E80, 0x3E80, 0x5398, 0x3E80, 0x3E80, 0x3E80, 0x5398, 0x5398, 0x5398, 0x5398, 0x5398, 0x5398, 0x5398, 0x5398, 0x5398,
+   0x5398, 0x5398, 0x5398, 0x5398, 0x5398, 0x3E80, 0x5B10, 0x5405, 0x4606, 0x5405, 0x5405, 0x5405, 0x5405, 0x5405, 0x5405, 0x5405,
+   0x5405, 0x5405, 0x5405, 0x5405, 0x5405, 0x5405, 0x5405, 0x5405, 0x5405, 0x5405, 0x5405, 0x5405, 0x5405, 0x5405, 0x5405, 0x5405,
+   0x5405, 0x5405, 0x5405, 0x5405, 0x5405, 0x5405, 0x3E80, 0x3E80, 0x5B10, 0x4D01, 0x4D01, 0x4D01, 0x4D01, 0x4D01, 0x4D01, 0x4D01,
+   0x4D01, 0x4D01, 0x4D01, 0x4D01, 0x4D01, 0x4D01, 0x4D01, 0x4D01, 0x4D01, 0x4D01, 0x4D01, 0x4D01, 0x4D01, 0x4D01, 0x4D01, 0x4D01,
+   0x4D01, 0x4D01, 0x4D01, 0x4D01, 0x4D01, 0x4D01, 0x4D01, 0x4D01, 0x4D01, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80,
+   0x3E80, 0x3E80, 0x3E80, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85,
+   0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3E80, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3E80,
+   0x3A85, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x5C09, 0x5C89, 0x5D09, 0x5D89, 0x5E09, 0x5E89, 0x5F09, 0x5F89, 0x6009, 0x6089,
+   0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80,
+   0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x2902, 0x2902, 0x2902, 0x3F02, 0x3F82, 0x2902, 0x4002, 0x4002, 0x2902, 0x4082,
+   0x2902, 0x4102, 0x2902, 0x2902, 0x2902, 0x2902, 0x4002, 0x2902, 0x2902, 0x4182, 0x2902, 0x2902, 0x2902, 0x2902, 0x4202, 0x4282,
+   0x2902, 0x2902, 0x2902, 0x2902, 0x2902, 0x4282, 0x2902, 0x2902, 0x4302, 0x2902, 0x2902, 0x4382, 0x2902, 0x2902, 0x2902, 0x2902,
+   0x2902, 0x2902, 0x2902, 0x2902, 0x2902, 0x2902, 0x4402, 0x2902, 0x2902, 0x4402, 0x2902, 0x2902, 0x2902, 0x2902, 0x4402, 0x2902,
+   0x4482, 0x4482, 0x2902, 0x2902, 0x2902, 0x2902, 0x2902, 0x2902, 0x4502, 0x2902, 0x2902, 0x2902, 0x2902, 0x2902, 0x2902, 0x2902,
+   0x2902, 0x2902, 0x2902, 0x2902, 0x2902, 0x2902, 0x2902, 0x3E80, 0x3E80, 0x4584, 0x4584, 0x4584, 0x4584, 0x4584, 0x4584, 0x4584,
+   0x4584, 0x4584, 0x1A1B, 0x1A1B, 0x4584, 0x4584, 0x4584, 0x4584, 0x4584, 0x1A1B, 0x1A1B, 0x1A1B, 0x1A1B, 0x1A1B, 0x1A1B, 0x1A1B,
+   0x1A1B, 0x1A1B, 0x4584, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80,
+   0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x5101, 0x5101, 0x5101, 0x5101, 0x5101, 0x5101, 0x5101, 0x5101, 0x5101, 0x5101, 0x5101, 0x5101,
+   0x5101, 0x5101, 0x5101, 0x5101, 0x5101, 0x5101, 0x5101, 0x5101, 0x5101, 0x5101, 0x5101, 0x3E80, 0x3E80, 0x4584, 0x5198, 0x5198,
+   0x5198, 0x5198, 0x5198, 0x5198, 0x2E01, 0x2E01, 0x3E80, 0x2E01, 0x2E01, 0x2E01, 0x2E01, 0x2E01, 0x2E01, 0x2E01, 0x2E01, 0x2E01,
+   0x4982, 0x4A02, 0x4A02, 0x4A02, 0x4902, 0x2F02, 0x2F02, 0x2F02, 0x2F02, 0x2F02, 0x2F02, 0x2F02, 0x2F02, 0x2F02, 0x2F02, 0x2F02,
+   0x2F02, 0x2F02, 0x2F02, 0x2F02, 0x2F02, 0x4F02, 0x4F02, 0x4F02, 0x4F02, 0x4F02, 0x4F02, 0x4F02, 0x4F02, 0x4F02, 0x4F02, 0x4F02,
+   0x4F02, 0x4F02, 0x4F02, 0x4F02, 0x4F02, 0x4606, 0x4606, 0x4606, 0x4606, 0x4606, 0x5198, 0x4606, 0x4606, 0x3A85, 0x3A85, 0x3A85,
+   0x3A85, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x4606, 0x4606, 0x4606, 0x4606, 0x4606, 0x4606, 0x4606, 0x4606, 0x3E80, 0x4606, 0x4606,
+   0x4606, 0x4606, 0x4606, 0x4606, 0x4606, 0x4606, 0x4606, 0x4606, 0x4606, 0x4606, 0x4606, 0x4606, 0x4606, 0x4606, 0x4606, 0x4606,
+   0x4606, 0x4606, 0x4606, 0x4606, 0x4606, 0x3E80, 0x4606, 0x4606, 0x4606, 0x5298, 0x4606, 0x4606, 0x5298, 0x4606, 0x3E80, 0x3E80,
+   0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x5305, 0x5305, 0x5305, 0x5305, 0x5305, 0x5305, 0x5305,
+   0x5305, 0x5305, 0x5305, 0x5305, 0x5305, 0x5305, 0x5305, 0x5305, 0x5305, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x5305, 0x5305,
+   0x5305, 0x5298, 0x5298, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x5C89, 0x5D09,
+   0x5D89, 0x5E09, 0x5E89, 0x5F09, 0x5F89, 0x6009, 0x6089, 0x640B, 0x648B, 0x650B, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80,
+   0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x4606, 0x5B88, 0x3E80, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85,
+   0x3E80, 0x3E80, 0x3E80, 0x3A85, 0x3A85, 0x3A85, 0x3E80, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3E80, 0x3E80, 0x3E80, 0x3A85, 0x3A85,
+   0x3E80, 0x3A85, 0x3E80, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3E80, 0x3E80, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85,
+   0x3E80, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3E80, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85,
+   0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3E80, 0x3E80, 0x3E80, 0x3E80,
+   0x3E80, 0x3E80, 0x4606, 0x4606, 0x4606, 0x4606, 0x4606, 0x4606, 0x4606, 0x4606, 0x4606, 0x4606, 0x4606, 0x4606, 0x4606, 0x4606,
+   0x5B88, 0x5B88, 0x5B88, 0x5B88, 0x3E80, 0x4606, 0x4606, 0x4606, 0x3E80, 0x4606, 0x4606, 0x4606, 0x4606, 0x3E80, 0x3E80, 0x3E80,
+   0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x4606, 0x4606, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x4606,
+   0x5B88, 0x5B88, 0x3E80, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3E80, 0x3E80, 0x3A85, 0x3A85, 0x3E80,
+   0x3E80, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3E80, 0x3E80,
+   0x3E80, 0x3E80, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85,
+   0x3A85, 0x3E80, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85,
+   0x3A85, 0x3A85, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x5B88, 0x5B88, 0x3E80, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85,
+   0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3E80, 0x3E80, 0x3E80, 0x3A85, 0x3A85,
+   0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3E80, 0x3E80, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3E80, 0x3E80, 0x3A85, 0x3A85,
+   0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3E80, 0x3E80, 0x3A85, 0x3A85, 0x3A85, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x5C09, 0x5C89, 0x5D09,
+   0x5D89, 0x5E09, 0x5E89, 0x5F09, 0x5F89, 0x6009, 0x6089, 0x501C, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80,
+   0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x5509, 0x5589, 0x5609, 0x5689, 0x5709, 0x5789, 0x5809, 0x5889, 0x5909,
+   0x5989, 0x318, 0x5A18, 0x5A18, 0x5398, 0x3E80, 0x3E80, 0x4606, 0x5405, 0x5405, 0x5405, 0x5405, 0x5405, 0x5405, 0x5405, 0x5405,
+   0x5405, 0x5405, 0x5405, 0x5405, 0x5405, 0x5405, 0x5405, 0x5405, 0x3E80, 0x3E80, 0x5405, 0x5405, 0x5405, 0x5405, 0x5405, 0x5405,
+   0x5405, 0x5405, 0x5405, 0x5405, 0x5405, 0x5405, 0x5405, 0x5405, 0x5405, 0x5405, 0x5405, 0x5405, 0x5405, 0x5405, 0x5405, 0x5405,
+   0x5405, 0x5405, 0x5405, 0x5405, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80,
+   0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x5405, 0x5405, 0x5405, 0x5405,
+   0x5405, 0x5405, 0x5405, 0x5405, 0x5405, 0x5405, 0x5405, 0x5405, 0x5405, 0x5405, 0x5405, 0x5405, 0x5405, 0x5405, 0x5405, 0x5405,
+   0x5405, 0x5405, 0x5405, 0x5405, 0x5405, 0x5405, 0x5405, 0x5405, 0x5405, 0x5405, 0x5405, 0x5405, 0x6615, 0x6696, 0x5484, 0x5405,
+   0x5405, 0x5405, 0x5405, 0x5405, 0x5405, 0x5405, 0x5405, 0x5405, 0x5405, 0x4606, 0x4606, 0x4606, 0x4606, 0x4606, 0x4606, 0x4606,
+   0x4606, 0x4606, 0x4606, 0x4606, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80,
+   0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x5B88, 0x5B88, 0x5198, 0x3E80, 0x3E80, 0x3E80, 0x3E80,
+   0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x4606, 0x4606, 0x5B88, 0x3E80, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85,
+   0x3A85, 0x3A85, 0x3E80, 0x3A85, 0x3E80, 0x3A85, 0x3A85, 0x3A85, 0x3E80, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85,
+   0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x5198, 0x5198, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85,
+   0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x4606, 0x4606, 0x4606, 0x4606, 0x4606, 0x5484, 0x5484,
+   0x4606, 0x4606, 0x289C, 0x4606, 0x4606, 0x4606, 0x4606, 0x3E80, 0x3E80, 0x709, 0x789, 0x809, 0x889, 0x909, 0x989, 0xA09,
+   0xA89, 0xB09, 0xB89, 0x5405, 0x5405, 0x5405, 0x5A9C, 0x5A9C, 0x3E80, 0x3A85, 0x3A85, 0x3A85, 0x3E80, 0x3A85, 0x3E80, 0x3A85,
+   0x3E80, 0x3E80, 0x3A85, 0x3A85, 0x3E80, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x4606, 0x3A85, 0x3A85, 0x4606, 0x4606, 0x4606, 0x4606,
+   0x4606, 0x4606, 0x3E80, 0x4606, 0x4606, 0x3A85, 0x3E80, 0x3E80, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85,
+   0x3A85, 0x3E80, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3E80, 0x3A85, 0x3A85, 0x3A85,
+   0x3A85, 0x3A85, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x4606, 0x4606, 0x5B88, 0x3E80, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85,
+   0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85,
+   0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3E80, 0x3E80, 0x4606, 0x3A85, 0x5B88, 0x5B88,
+   0x5B88, 0x5B88, 0x5B88, 0x3E80, 0x4606, 0x5B88, 0x5B88, 0x3E80, 0x5B88, 0x5B88, 0x4606, 0x4606, 0x3E80, 0x3E80, 0x3E80, 0x3E80,
+   0x3E80, 0x3E80, 0x3E80, 0x5B88, 0x5B88, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3A85, 0x3E80, 0x5198, 0x5198,
+   0x5198, 0x5198, 0x5198, 0x5198, 0x5198, 0x5198, 0x5C89, 0x5D09, 0x5D89, 0x5E09, 0x5E89, 0x5F09, 0x5F89, 0x6009, 0x6089, 0x640B,
+   0x670B, 0x678B, 0x680B, 0x688B, 0x690B, 0x698B, 0x6A0B, 0x6A8B, 0x648B, 0x6B0B, 0x3E80, 0x3E80, 0x3E80, 0x3A85, 0x3A85, 0x3A85,
+   0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3E80, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3E80, 0x3A85,
+   0x3A85, 0x3E80, 0x3E80, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3E80, 0x3E80, 0x4606, 0x3A85, 0x5B88, 0x4606, 0x4606, 0x4606, 0x4606,
+   0x4606, 0x4606, 0x4606, 0x4606, 0x5B88, 0x5B88, 0x5B88, 0x5B88, 0x4606, 0x3E80, 0x3E80, 0x3A85, 0x4606, 0x4606, 0x4606, 0x4606,
+   0x3E80, 0x3E80, 0x3E80, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3E80, 0x3A85, 0x3A85, 0x3A85,
+   0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3E80, 0x3A85, 0x3E80, 0x3E80, 0x3E80, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3E80, 0x3E80, 0x4606,
+   0x3E80, 0x5B88, 0x5B88, 0x5B88, 0x3E80, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3E80, 0x3A85, 0x3A85,
+   0x3A85, 0x3E80, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85,
+   0x3A85, 0x3E80, 0x3A85, 0x3E80, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3E80, 0x3E80, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85,
+   0x3A85, 0x3E80, 0x3A85, 0x3E80, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3E80, 0x3E80, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85,
+   0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x4606, 0x3A85, 0x3A85, 0x4606, 0x4606,
+   0x4606, 0x4606, 0x4606, 0x4606, 0x4606, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x39A, 0x39A, 0x39A, 0x39A, 0x39A, 0x39A, 0x39A,
+   0x39A, 0x39A, 0x39A, 0x39A, 0x39A, 0x39A, 0x39A, 0x39A, 0x39A, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80,
+   0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3A85, 0x3A85, 0x4606, 0x4606, 0x5198, 0x5198, 0x5C09,
+   0x5C89, 0x5D09, 0x5D89, 0x5E09, 0x5E89, 0x5F09, 0x5F89, 0x6009, 0x6089, 0x5198, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80,
+   0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x298, 0x298, 0x318, 0x39A, 0x318, 0x298, 0x298,
+   0x6615, 0x6696, 0x298, 0x519, 0x598, 0x614, 0x598, 0x698, 0x709, 0x789, 0x809, 0x889, 0x909, 0x989, 0xA09, 0xA89,
+   0xB09, 0xB89, 0x598, 0x298, 0xC99, 0xC99, 0xC99, 0x298, 0x298, 0x298, 0x298, 0x298, 0x298, 0x2A14, 0x298, 0x298,
+   0x298, 0x298, 0x5B10, 0x5B10, 0x5B10, 0x5B10, 0x3E80, 0x5C09, 0x5C89, 0x5D09, 0x5D89, 0x5E09, 0x5E89, 0x5F09, 0x5F89, 0x6009,
+   0x6089, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85,
+   0x3E80, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3E80, 0x3A85, 0x3A85, 0x3A85, 0x3A85,
+   0x3A85, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x5B88, 0x4606, 0x4606, 0x4606, 0x4606, 0x3E80, 0x3E80, 0x5B88, 0x5B88, 0x3E80, 0x3E80,
+   0x5B88, 0x5B88, 0x4606, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x5B88, 0x3E80, 0x3E80, 0x3E80,
+   0x3E80, 0x3A85, 0x3A85, 0x3E80, 0x3A85, 0x3E80, 0x3E80, 0x3A85, 0x3A85, 0x3E80, 0x3A85, 0x3E80, 0x3E80, 0x3A85, 0x3E80, 0x3E80,
+   0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3E80, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85,
+   0x3A85, 0x3A85, 0x3E80, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3E80, 0x3A85, 0x3A85, 0x3E80, 0x3A85, 0x3A85,
+   0x3E80, 0x3A85, 0x3A85, 0x3E80, 0x3E80, 0x4606, 0x3E80, 0x5B88, 0x5B88, 0x4606, 0x4606, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x4606,
+   0x4606, 0x3E80, 0x3E80, 0x4606, 0x4606, 0x4606, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80,
+   0x3E80, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3E80, 0x3A85, 0x3E80, 0x3A85, 0x3A85, 0x4606, 0x4606, 0x3E80, 0x3E80, 0x5C09, 0x5C89,
+   0x5D09, 0x5D89, 0x5E09, 0x5E89, 0x5F09, 0x5F89, 0x6009, 0x6089, 0x3A85, 0x3A85, 0x39A, 0x39A, 0x610B, 0x618B, 0x620B, 0x628B,
+   0x630B, 0x638B, 0x501C, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85,
+   0x3A85, 0x3E80, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3E80, 0x3A85, 0x3A85, 0x3E80, 0x3A85, 0x3A85, 0x3A85,
+   0x3A85, 0x3A85, 0x3E80, 0x3E80, 0x4606, 0x3A85, 0x5B88, 0x5B88, 0x4606, 0x4606, 0x4606, 0x4606, 0x4606, 0x3E80, 0x4606, 0x4606,
+   0x5B88, 0x3E80, 0x5B88, 0x5B88, 0x4606, 0x3E80, 0x3E80, 0x3A85, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80,
+   0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x5C09, 0x5C89, 0x5D09, 0x5D89, 0x5E09, 0x5E89, 0x5F09, 0x5F89, 0x6009,
+   0x6089, 0x630B, 0x630B, 0x630B, 0x630B, 0x630B, 0x630B, 0x630B, 0x630B, 0x630B, 0x630B, 0x501C, 0x4606, 0x501C, 0x4606, 0x501C,
+   0x4606, 0x6615, 0x6696, 0x6615, 0x6696, 0x5B88, 0x5B88, 0x4606, 0x4606, 0x4606, 0x3E80, 0x3E80, 0x3E80, 0x5B88, 0x5B88, 0x3E80,
+   0x3E80, 0x5B88, 0x5B88, 0x4606, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x4606, 0x5B88, 0x3E80, 0x3E80,
+   0x3E80, 0x3E80, 0x3A85, 0x3A85, 0x3E80, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3E80, 0x3A85, 0x3A85, 0x3E80, 0x5B88, 0x4606,
+   0x4606, 0x4606, 0x4606, 0x5B88, 0x4606, 0x3E80, 0x3E80, 0x3E80, 0x4606, 0x4606, 0x5B88, 0x4606, 0x3E80, 0x3E80, 0x3E80, 0x3E80,
+   0x3E80, 0x3E80, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85,
+   0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x5B88, 0x5B88, 0x5B88, 0x4606, 0x4606, 0x4606, 0x4606, 0x4606, 0x4606, 0x4606,
+   0x5B88, 0x5B88, 0x3E80, 0x3E80, 0x3E80, 0x5B88, 0x5B88, 0x5B88, 0x3E80, 0x5B88, 0x5B88, 0x5B88, 0x4606, 0x3E80, 0x3E80, 0x3E80,
+   0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x5B88, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3A85,
+   0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3E80, 0x4584, 0x3E80, 0x4606, 0x4606, 0x4606, 0x4606, 0x4606, 0x4606, 0x3E80, 0x3E80, 0x5C09,
+   0x5C89, 0x5D09, 0x5D89, 0x5E09, 0x5E89, 0x5F09, 0x5F89, 0x6009, 0x6089, 0x3E80, 0x3E80, 0x3A85, 0x3A85, 0x3E80, 0x3E80, 0x3E80,
+   0x3E80, 0x5C09, 0x5C89, 0x5D09, 0x5D89, 0x5E09, 0x5E89, 0x5F09, 0x5F89, 0x6009, 0x6089, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80,
+   0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x4606, 0x4606, 0x4606, 0x4606, 0x4606,
+   0x4606, 0x4606, 0x4606, 0x4606, 0x4606, 0x4606, 0x4606, 0x4606, 0x5087, 0x5087, 0x5087, 0x5B88, 0x4606, 0x4606, 0x4606, 0x3E80,
+   0x3E80, 0x5B88, 0x5B88, 0x5B88, 0x3E80, 0x5B88, 0x5B88, 0x5B88, 0x4606, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80,
+   0x3E80, 0x3E80, 0x5B88, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85,
+   0x3A85, 0x3A85, 0x3E80, 0x3E80, 0x3E80, 0x4606, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x5B88, 0x5B88, 0x5B88, 0x4606, 0x4606, 0x4606,
+   0x3E80, 0x4606, 0x3E80, 0x5B88, 0x5B88, 0x5B88, 0x5B88, 0x5B88, 0x5B88, 0x5B88, 0x5B88, 0x4606, 0x5B88, 0x5B88, 0x4606, 0x4606,
+   0x4606, 0x4606, 0x4606, 0x4606, 0x4606, 0x4606, 0x4606, 0x4606, 0x4606, 0x5198, 0x5198, 0x5198, 0x5198, 0x5198, 0x5198, 0x5198,
+   0x39A, 0x5198, 0x3E80, 0x3E80, 0x3E80, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x4584, 0x4606, 0x4606, 0x4606, 0x4606,
+   0x4606, 0x4606, 0x4606, 0x4606, 0x5198, 0x5C09, 0x5C89, 0x5D09, 0x5D89, 0x5E09, 0x5E89, 0x5F09, 0x5F89, 0x6009, 0x6089, 0x5198,
+   0x5198, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3A85, 0x501C, 0x501C, 0x501C, 0x5198, 0x5198, 0x5198, 0x5198, 0x5198, 0x5198, 0x5198,
+   0x5198, 0x65B8, 0x5198, 0x5198, 0x5198, 0x5198, 0x5198, 0x5198, 0x501C, 0x501C, 0x501C, 0x501C, 0x501C, 0x4606, 0x4606, 0x501C,
+   0x501C, 0x501C, 0x501C, 0x501C, 0x501C, 0x4606, 0x501C, 0x501C, 0x501C, 0x501C, 0x501C, 0x501C, 0x3E80, 0x3E80, 0x501C, 0x3E80,
+   0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x289C,
+   0x289C, 0x289C, 0x289C, 0x289C, 0x289C, 0x289C, 0x289C, 0x289C, 0x289C, 0x289C, 0x289C, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3A85,
+   0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3E80, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85,
+   0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85,
+   0x3A85, 0x3A85, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85,
+   0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85,
+   0x3A85, 0x3A85, 0x1A97, 0x4584, 0x4584, 0x4584, 0x3E80, 0x5C09, 0x5C89, 0x5D09, 0x5D89, 0x5E09, 0x5E89, 0x5F09, 0x5F89, 0x6009,
+   0x6089, 0x5198, 0x5198, 0x5198, 0x5198, 0x5198, 0x5198, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x5B88, 0x5B88, 0x4606,
+   0x4606, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x20C, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85,
+   0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85,
+   0x3A85, 0x3A85, 0x6615, 0x6696, 0x3E80, 0x3E80, 0x3E80, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85,
+   0x3A85, 0x3A85, 0x5198, 0x5198, 0x5198, 0x6B8B, 0x6C0B, 0x6C8B, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80,
+   0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85,
+   0x4606, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80,
+   0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3001, 0x3082, 0x3001, 0x3082, 0x3001, 0x3082, 0x3001, 0x3082, 0x3001,
+   0x3082, 0x3001, 0x3082, 0x3001, 0x3082, 0x3001, 0x3082, 0x3001, 0x3082, 0x3001, 0x3082, 0x3001, 0x3082, 0x2E82, 0x2E82, 0x2E82,
+   0x2E82, 0x2E82, 0x6D02, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x6D82, 0x6D82, 0x6D82, 0x6D82, 0x6D82, 0x6D82, 0x6D82, 0x6D82, 0x6E01,
+   0x6E01, 0x6E01, 0x6E01, 0x6E01, 0x6E01, 0x6E01, 0x6E01, 0x6D82, 0x6D82, 0x6D82, 0x6D82, 0x6D82, 0x6D82, 0x6D82, 0x6D82, 0x6E01,
+   0x6E01, 0x6E01, 0x6E01, 0x6E01, 0x6E01, 0x6E01, 0x6E01, 0x6D82, 0x6D82, 0x6D82, 0x6D82, 0x6D82, 0x6D82, 0x3E80, 0x3E80, 0x6E01,
+   0x6E01, 0x6E01, 0x6E01, 0x6E01, 0x6E01, 0x3E80, 0x3E80, 0x2E82, 0x6D82, 0x4902, 0x6D82, 0x4902, 0x6D82, 0x4902, 0x6D82, 0x3E80,
+   0x6E01, 0x3E80, 0x6E01, 0x3E80, 0x6E01, 0x3E80, 0x6E01, 0x6D82, 0x6D82, 0x6D82, 0x6D82, 0x6D82, 0x6D82, 0x6D82, 0x6D82, 0x6E01,
+   0x6E01, 0x6E01, 0x6E01, 0x6E01, 0x6E01, 0x6E01, 0x6E01, 0x6E82, 0x6E82, 0x6F02, 0x6F02, 0x6F02, 0x6F02, 0x6F82, 0x6F82, 0x7002,
+   0x7002, 0x7082, 0x7082, 0x7102, 0x7102, 0x3E80, 0x3E80, 0x7182, 0x7182, 0x7182, 0x7182, 0x7182, 0x7182, 0x7182, 0x7182, 0x7203,
+   0x7203, 0x7203, 0x7203, 0x7203, 0x7203, 0x7203, 0x7203, 0x7182, 0x7182, 0x7182, 0x7182, 0x7182, 0x7182, 0x7182, 0x7182, 0x7203,
+   0x7203, 0x7203, 0x7203, 0x7203, 0x7203, 0x7203, 0x7203, 0x6D82, 0x6D82, 0x2E82, 0x7282, 0x2E82, 0x3E80, 0x2E82, 0x4902, 0x6E01,
+   0x6E01, 0x7301, 0x7301, 0x7383, 0x1A1B, 0x7402, 0x1A1B, 0x1B02, 0x1B82, 0x1C02, 0x1C82, 0x1D02, 0x1D82, 0x1E02, 0x1E82, 0x1F02,
+   0x1F82, 0x2002, 0x2082, 0x2102, 0x2182, 0x2202, 0x2282, 0x2302, 0x2382, 0x2402, 0x2482, 0x2502, 0x2582, 0x2602, 0x2682, 0x2702,
+   0x2782, 0x6615, 0xC99, 0x6696, 0xC99, 0x3E80, 0x6D82, 0x6D82, 0x4902, 0x4902, 0x2E82, 0x7582, 0x2E82, 0x4902, 0x6E01, 0x6E01,
+   0x7601, 0x7601, 0x7681, 0x1A1B, 0x1A1B, 0x1A1B, 0x3E80, 0x3E80, 0x2E82, 0x7282, 0x2E82, 0x3E80, 0x2E82, 0x4902, 0x7701, 0x7701,
+   0x7781, 0x7781, 0x7383, 0x1A1B, 0x1A1B, 0x3E80, 0x20C, 0x20C, 0x20C, 0x20C, 0x20C, 0x20C, 0x20C, 0x782C, 0x20C, 0x20C,
+   0x20C, 0x788C, 0x5B10, 0x5B10, 0x7910, 0x7990, 0x2A14, 0x7A34, 0x2A14, 0x2A14, 0x2A14, 0x2A14, 0x298, 0x298, 0x7A9D, 0x7B1E,
+   0x6615, 0x7A9D, 0x7A9D, 0x7B1E, 0x6615, 0x7A9D, 0x298, 0x298, 0x298, 0x298, 0x298, 0x298, 0x298, 0x298, 0x7B8D, 0x7C0E,
+   0x7C90, 0x7D10, 0x7D90, 0x7E10, 0x7E90, 0x782C, 0x318, 0x318, 0x318, 0x318, 0x318, 0x298, 0x298, 0x298, 0x298, 0x29DD,
+   0x2D5E, 0x298, 0x298, 0x298, 0x298, 0x1A97, 0x7F0B, 0x2C8B, 0x2B0B, 0x2B8B, 0x7F8B, 0x800B, 0x808B, 0x810B, 0x818B, 0x820B,
+   0x519, 0x519, 0xC99, 0x455, 0x4D6, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80,
+   0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85,
+   0x3A85, 0x3A85, 0x3A85, 0x3E80, 0x3E80, 0x3E80, 0x289C, 0x289C, 0x289C, 0x289C, 0x289C, 0x289C, 0x289C, 0x289C, 0x289C, 0x289C,
+   0x289C, 0x289C, 0x289C, 0x289C, 0x289C, 0x289C, 0x289C, 0x289C, 0x289C, 0x289C, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x289C,
+   0x289C, 0x289C, 0x289C, 0x289C, 0x289C, 0x289C, 0x4D01, 0x289C, 0x289C, 0x289C, 0x289C, 0x4D01, 0x289C, 0x289C, 0x2902, 0x4D01,
+   0x4D01, 0x4D01, 0x2902, 0x2902, 0x4D01, 0x4D01, 0x4D01, 0x2902, 0x289C, 0x4D01, 0x289C, 0x289C, 0x289C, 0x4D01, 0x4D01, 0x4D01,
+   0x4D01, 0x4D01, 0x289C, 0x289C, 0xA20A, 0xA28A, 0xA30A, 0xA38A, 0xA40A, 0xA48A, 0xA50A, 0xA58A, 0xA60A, 0x4606, 0x4606, 0x4606,
+   0x4606, 0x4606, 0x4606, 0x2A14, 0x4584, 0x4584, 0x4584, 0x4584, 0x4584, 0x289C, 0x289C, 0xA68A, 0xA70A, 0xA78A, 0x3E80, 0x3E80,
+   0x3E80, 0x289C, 0x289C, 0x289C, 0x289C, 0x3E80, 0x289C, 0x289C, 0x289C, 0x289C, 0x3E80, 0x3E80, 0x289C, 0x289C, 0x289C, 0x289C,
+   0x289C, 0x289C, 0x289C, 0x289C, 0x289C, 0x289C, 0x289C, 0x289C, 0x289C, 0x289C, 0x289C, 0x289C, 0x289C, 0x289C, 0x289C, 0x289C,
+   0x289C, 0x289C, 0x289C, 0xC99, 0x289C, 0x289C, 0x289C, 0x289C, 0x289C, 0x289C, 0x289C, 0x289C, 0x289C, 0x289C, 0x289C, 0x289C,
+   0x289C, 0x289C, 0xC99, 0xC99, 0x289C, 0x289C, 0xC99, 0x289C, 0xC99, 0x289C, 0x289C, 0x289C, 0x289C, 0x289C, 0x289C, 0x289C,
+   0x289C, 0x289C, 0x289C, 0x289C, 0x289C, 0x289C, 0x289C, 0x289C, 0xC99, 0x289C, 0x289C, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80,
+   0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x948A, 0x950A, 0x958A, 0x960A, 0x3E80, 0x3E80, 0x3E80,
+   0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0xC99, 0xC99, 0xC99, 0xC99, 0xC99, 0x289C, 0x289C,
+   0x289C, 0x289C, 0x289C, 0xC99, 0xC99, 0x289C, 0x289C, 0x289C, 0x289C, 0x4D01, 0x289C, 0x8281, 0x289C, 0x4D01, 0x289C, 0x8301,
+   0x8381, 0x4D01, 0x4D01, 0x2A9C, 0x2902, 0x4D01, 0x4D01, 0x289C, 0x4D01, 0x2902, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x2902, 0x289C,
+   0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x848A, 0x850A, 0x858A, 0x860A, 0x868A, 0x870A, 0x878A, 0x880A, 0x888A, 0x890A, 0x898A,
+   0x8A0A, 0x8A8A, 0x8B0A, 0x8B8A, 0x8C0A, 0x8C8A, 0x8D0A, 0x8D8A, 0x8E0A, 0x8E8A, 0x8F0A, 0x8F8A, 0x900A, 0x908A, 0x910A, 0x918A,
+   0x920A, 0x928A, 0x930A, 0x938A, 0x940A, 0xC99, 0xC99, 0xC59, 0xC59, 0xC99, 0xC99, 0xC59, 0xC59, 0xC59, 0xC59, 0xC59,
+   0xC59, 0xC59, 0xC59, 0xC59, 0xC59, 0xC59, 0xC59, 0xC59, 0xC59, 0xC59, 0xC59, 0xC59, 0xC59, 0xC59, 0xC99, 0xC99,
+   0xC99, 0xC99, 0xC99, 0xC59, 0xC59, 0xC59, 0xC59, 0xC99, 0xC99, 0xC99, 0xC99, 0xC99, 0xC99, 0xC99, 0xC99, 0xC99,
+   0xC59, 0xC59, 0xC59, 0xC59, 0xC59, 0xC99, 0xC99, 0xC59, 0xC59, 0xC99, 0xC99, 0xC99, 0xC99, 0xC59, 0xC59, 0xC59,
+   0xC59, 0xC59, 0xC59, 0xC59, 0xC59, 0xC59, 0xC59, 0xC59, 0xC59, 0xC59, 0xC99, 0xC99, 0xC59, 0xC59, 0xC59, 0xC59,
+   0xC99, 0xC99, 0xC99, 0xC99, 0xC99, 0xC59, 0xC99, 0xC99, 0xC99, 0xC99, 0xC99, 0xC99, 0xC99, 0x289C, 0x289C, 0xC99,
+   0x289C, 0x289C, 0xC99, 0x289C, 0x289C, 0x289C, 0x289C, 0x289C, 0x289C, 0x289C, 0xC99, 0x289C, 0x289C, 0x289C, 0x289C, 0x289C,
+   0x289C, 0x289C, 0x289C, 0x289C, 0x289C, 0x289C, 0x289C, 0x289C, 0x289C, 0x289C, 0x289C, 0x289C, 0x289C, 0x289C, 0x289C, 0x289C,
+   0x289C, 0x289C, 0x289C, 0x289C, 0x289C, 0x289C, 0x289C, 0x289C, 0x289C, 0x289C, 0x289C, 0x3E80, 0x289C, 0x289C, 0x289C, 0x289C,
+   0x289C, 0x289C, 0x289C, 0x289C, 0x289C, 0x289C, 0x289C, 0x289C, 0x289C, 0x289C, 0x289C, 0x289C, 0x289C, 0x289C, 0x289C, 0x289C,
+   0x289C, 0x289C, 0x289C, 0x289C, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80,
+   0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0xC99, 0xC59, 0xC59,
+   0xC59, 0xC59, 0xC99, 0xC99, 0xC99, 0xC59, 0xC59, 0xC59, 0xC59, 0xC59, 0xC59, 0xC99, 0xC99, 0xC99, 0xC59, 0x519,
+   0x519, 0xC99, 0xC59, 0xC59, 0xC99, 0xC99, 0xC99, 0xC59, 0xC59, 0xC59, 0xC59, 0xC99, 0xC59, 0xC99, 0xC59, 0xC99,
+   0xC99, 0xC99, 0xC99, 0xC59, 0xC59, 0xC59, 0xC59, 0xC59, 0xC59, 0xC59, 0xC59, 0xC59, 0xC99, 0xC99, 0xC99, 0xC99,
+   0xC99, 0xC59, 0xC99, 0xC59, 0xC59, 0xC59, 0xC59, 0xC59, 0x289C, 0x289C, 0x289C, 0x289C, 0x289C, 0x289C, 0x289C, 0x455,
+   0x4D6, 0x289C, 0x289C, 0x289C, 0x289C, 0x289C, 0x289C, 0x289C, 0x289C, 0x289C, 0x289C, 0x289C, 0x501C, 0x501C, 0x501C, 0x501C,
+   0x501C, 0x501C, 0x501C, 0x501C, 0x501C, 0x501C, 0x501C, 0x501C, 0x501C, 0x501C, 0x501C, 0x501C, 0x501C, 0x501C, 0x501C, 0x501C,
+   0x501C, 0x501C, 0x501C, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x501C, 0x501C, 0x501C, 0x501C, 0x501C, 0x501C, 0x501C, 0x501C, 0x501C,
+   0x501C, 0x501C, 0x501C, 0x501C, 0x501C, 0x501C, 0x501C, 0x501C, 0x501C, 0x501C, 0x501C, 0x501C, 0x501C, 0x9C1C, 0x9C1C, 0x9C1C,
+   0x9C1C, 0x9C1C, 0x9C1C, 0x9C1C, 0x9C1C, 0x9C1C, 0x9C1C, 0x9C1C, 0x9C1C, 0x9C1C, 0x9C1C, 0x9C1C, 0x9C1C, 0x9C9C, 0x9C9C, 0x9C9C,
+   0x9C9C, 0x9C9C, 0x9C9C, 0x9C9C, 0x9C9C, 0x9C9C, 0x9C9C, 0x9C9C, 0x9C9C, 0x9C9C, 0x9C9C, 0x9C9C, 0x9C9C, 0x7F0B, 0x3E80, 0x3E80,
+   0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80,
+   0x3E80, 0x3E80, 0x3E80, 0xC59, 0xC99, 0xC59, 0xC99, 0xC59, 0xC59, 0xC59, 0xC59, 0xC59, 0xC59, 0xC59, 0xC59, 0xC99,
+   0xC99, 0xC59, 0xC59, 0xC59, 0xC59, 0xC59, 0xC59, 0xC59, 0xC59, 0xC59, 0xC59, 0xC59, 0xC59, 0xC59, 0xC59, 0xC59,
+   0xC59, 0xC59, 0xC59, 0xC99, 0xC99, 0xC59, 0xC59, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80,
+   0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x39A, 0x39A, 0xC99, 0x1A1B, 0x289C, 0x39A, 0x39A, 0x3E80, 0x289C, 0xC99, 0xC99,
+   0xC99, 0xC99, 0x289C, 0x289C, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x5B10, 0x5B10,
+   0x5B10, 0x289C, 0x289C, 0x3E80, 0x3E80, 0x289C, 0x289C, 0x289C, 0x289C, 0x289C, 0x289C, 0x289C, 0x289C, 0x289C, 0x289C, 0x289C,
+   0x289C, 0x289C, 0x289C, 0x289C, 0x289C, 0x3E80, 0x289C, 0x289C, 0x289C, 0x289C, 0x289C, 0x289C, 0x289C, 0x289C, 0x289C, 0x289C,
+   0x289C, 0x289C, 0x289C, 0x289C, 0x3E80, 0x289C, 0x3E80, 0x289C, 0x289C, 0x289C, 0x289C, 0x3E80, 0x3E80, 0x3E80, 0x289C, 0x3E80,
+   0x289C, 0x289C, 0x289C, 0x289C, 0x289C, 0x289C, 0x289C, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80,
+   0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x840B, 0x9D0B, 0x9D8B, 0x9E0B, 0x9E8B, 0x9F0B, 0x9F8B, 0xA00B, 0xA08B, 0xA10B, 0x840B,
+   0x9D0B, 0x9D8B, 0x9E0B, 0x9E8B, 0x9F0B, 0x9F8B, 0xA00B, 0xA08B, 0xA10B, 0x289C, 0x3E80, 0x3E80, 0x3E80, 0x289C, 0x289C, 0x289C,
+   0x289C, 0x289C, 0x289C, 0x289C, 0x289C, 0xC59, 0xC59, 0xC59, 0xC59, 0x289C, 0x289C, 0x289C, 0x289C, 0x289C, 0x289C, 0x289C,
+   0x289C, 0x289C, 0x289C, 0x289C, 0x289C, 0x289C, 0x289C, 0x289C, 0x289C, 0x289C, 0x289C, 0x289C, 0x289C, 0x289C, 0x501C, 0x289C,
+   0x289C, 0x289C, 0x289C, 0x289C, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x630B, 0x630B, 0x630B, 0x630B, 0x630B, 0x630B, 0x630B,
+   0x630B, 0x630B, 0x630B, 0x501C, 0x501C, 0x501C, 0x501C, 0x501C, 0x501C, 0x501C, 0x501C, 0x501C, 0x501C, 0x501C, 0x501C, 0x501C,
+   0x501C, 0x501C, 0x501C, 0x501C, 0x501C, 0x501C, 0x501C, 0x501C, 0x501C, 0x501C, 0x501C, 0x501C, 0x501C, 0x501C, 0x501C, 0x501C,
+   0x501C, 0x501C, 0x501C, 0x3E80, 0x3E80, 0x3E80, 0x501C, 0x610B, 0x618B, 0x620B, 0x628B, 0xA80B, 0xA88B, 0xA90B, 0xA98B, 0xAA0B,
+   0x640B, 0x501C, 0x501C, 0x501C, 0x501C, 0x501C, 0x501C, 0x501C, 0x501C, 0x501C, 0x501C, 0x501C, 0x501C, 0x501C, 0x501C, 0x501C,
+   0x501C, 0x501C, 0x501C, 0x501C, 0x501C, 0x501C, 0x501C, 0x501C, 0x501C, 0x501C, 0x501C, 0x501C, 0x289C, 0x3E80, 0x289C, 0x289C,
+   0x289C, 0x3E80, 0x289C, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80,
+   0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x2C8B, 0x2B0B, 0x2B8B, 0x7F8B,
+   0x800B, 0x808B, 0x810B, 0x818B, 0x820B, 0x968B, 0x970B, 0x978B, 0x980B, 0x988B, 0x990B, 0x998B, 0x9A0B, 0x9A8B, 0x9B0B, 0x9B8B,
+   0x2C8B, 0x2B0B, 0x2B8B, 0x7F8B, 0x800B, 0x808B, 0x810B, 0x818B, 0x820B, 0x968B, 0x970B, 0x978B, 0x980B, 0x988B, 0x990B, 0x998B,
+   0x9A0B, 0x9A8B, 0x9B0B, 0x9B8B, 0x501C, 0x501C, 0x501C, 0x501C, 0x20C, 0x298, 0x298, 0x298, 0x289C, 0x4584, 0x3A85, 0xA18A,
+   0x455, 0x4D6, 0x455, 0x4D6, 0x455, 0x4D6, 0x455, 0x4D6, 0x455, 0x4D6, 0x289C, 0x289C, 0x455, 0x4D6, 0x455, 0x4D6,
+   0x455, 0x4D6, 0x455, 0x4D6, 0x2A14, 0x6615, 0x6696, 0x6696, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85,
+   0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3E80, 0x3E80, 0x3E80,
+   0x3E80, 0x4606, 0x4606, 0x1A1B, 0x1A1B, 0x4584, 0x4584, 0x3E80, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85,
+   0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3A85, 0x3E80, 0x501C, 0x501C, 0x630B, 0x630B, 0x630B, 0x630B, 0x501C, 0x501C,
+   0x501C, 0x501C, 0x501C, 0x501C, 0x501C, 0x501C, 0x501C, 0x501C, 0x501C, 0x501C, 0x501C, 0x501C, 0x501C, 0x501C, 0x501C, 0x3E80,
+   0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80,
+   0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0xAA93, 0xAA93, 0xAA93, 0xAA93, 0xAA93,
+   0xAA93, 0xAA93, 0xAA93, 0xAA93, 0xAA93, 0xAA93, 0xAA93, 0xAA93, 0xAA93, 0xAA93, 0xAA93, 0xAA93, 0xAA93, 0xAA93, 0xAA93, 0xAA93,
+   0xAA93, 0xAA93, 0xAA93, 0xAA93, 0xAA93, 0xAA93, 0xAA93, 0xAA93, 0xAA93, 0xAA93, 0xAA93, 0xAB12, 0xAB12, 0xAB12, 0xAB12, 0xAB12,
+   0xAB12, 0xAB12, 0xAB12, 0xAB12, 0xAB12, 0xAB12, 0xAB12, 0xAB12, 0xAB12, 0xAB12, 0xAB12, 0xAB12, 0xAB12, 0xAB12, 0xAB12, 0xAB12,
+   0xAB12, 0xAB12, 0xAB12, 0xAB12, 0xAB12, 0xAB12, 0xAB12, 0xAB12, 0xAB12, 0xAB12, 0xAB12, 0x5305, 0x5305, 0x5305, 0x5305, 0x5305,
+   0x5305, 0x5305, 0x5305, 0x5305, 0x519, 0x5305, 0x5305, 0x5305, 0x5305, 0x5305, 0x5305, 0x5305, 0x5305, 0x5305, 0x5305, 0x5305,
+   0x5305, 0x5305, 0x3E80, 0x5305, 0x5305, 0x5305, 0x5305, 0x5305, 0x3E80, 0x5305, 0x3E80, 0x4606, 0x4606, 0x4606, 0x4606, 0x3E80,
+   0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x3E80, 0x298, 0x2A14, 0x2A14, 0x1A97, 0x1A97,
+   0x6615, 0x6696, 0x6615, 0x6696, 0x6615, 0x6696, 0x6615, 0x6696, 0x6615, 0x6696, 0x6615, 0x6696, 0x3E80, 0x3E80, 0x3E80, 0x3E80,
+   0x298, 0x298, 0x298, 0x298, 0x1A97, 0x1A97, 0x1A97, 0x598, 0x298, 0x598, 0x3E80, 0x298, 0x598, 0x298, 0x298, 0x2A14,
+   0x6615, 0x6696, 0x6615, 0x6696, 0x6615, 0x6696, 0x318, 0x298, 0xD01, 0xD81, 0xE01, 0xE81, 0xF01, 0xF81, 0x1001, 0x1081,
+   0x1101, 0x1181, 0x1201, 0x1281, 0x1301, 0x1381, 0x1401, 0x1481, 0x1501, 0x1581, 0x1601, 0x1681, 0x1701, 0x1781, 0x1801, 0x1881,
+   0x1901, 0x1981, 0x6615, 0x298, 0x6696, 0x1A1B, 0x1A97,
+};
+
+static int16_t Upper[] = {
+   0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0,
+   0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0,
+   0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0,
+   0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0xFFE0, 0xFFE0, 0xFFE0, 0xFFE0, 0xFFE0, 0xFFE0, 0xFFE0, 0xFFE0, 0xFFE0, 0xFFE0,
+   0xFFE0, 0xFFE0, 0xFFE0, 0xFFE0, 0xFFE0, 0xFFE0, 0xFFE0, 0xFFE0, 0xFFE0, 0xFFE0, 0xFFE0, 0xFFE0, 0xFFE0, 0xFFE0, 0xFFE0, 0xFFE0,
+   0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x2E7, 0x0, 0x0, 0x0, 0x0, 0x0, 0xFFE0, 0x79,
+   0x0, 0xFFFF, 0x0, 0xFF18, 0x0, 0xFED4, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x61, 0x0, 0x0,
+   0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x38, 0x0, 0xFFFF, 0xFFFE, 0xFFB1, 0x0, 0x0, 0x0, 0xFF2E, 0xFF32,
+   0xFF33, 0xFF36, 0xFF35, 0xFF31, 0xFF2F, 0xFF2D, 0xFF2B, 0xFF2A, 0xFF26, 0xFF27, 0xFF25, 0x0, 0x0, 0x54, 0x0, 0x0,
+   0x0, 0x0, 0x0, 0xFFDA, 0xFFDB, 0xFFE1, 0xFFC0, 0xFFC1, 0xFFC2, 0xFFC7, 0x0, 0xFFD1, 0xFFCA, 0xFFAA, 0xFFB0, 0x0,
+   0x0, 0x0, 0x0, 0x0, 0xFFD0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0,
+   0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0,
+   0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0,
+   0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0xFFC5, 0x8, 0x0, 0x4A, 0x56, 0x64,
+   0x80, 0x70, 0x7E, 0x8, 0x0, 0x9, 0x0, 0x0, 0xE3DB, 0x0, 0x0, 0x7, 0x0, 0x0, 0x0, 0x0,
+   0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0,
+   0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0,
+   0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0xFFF0, 0xFFF0, 0xFFF0, 0xFFF0, 0xFFF0, 0xFFF0, 0xFFF0,
+   0xFFF0, 0xFFF0, 0xFFF0, 0xFFF0, 0xFFF0, 0xFFF0, 0xFFF0, 0xFFF0, 0xFFF0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0,
+   0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0xFFE6, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0,
+   0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0,
+   0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0,
+};
+
+static int16_t Lower[] = {
+   0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0,
+   0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20,
+   0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20,
+   0x20, 0x20, 0x20, 0x20, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0,
+   0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0,
+   0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x20, 0x0, 0x0, 0x0,
+   0x1, 0x0, 0xFF39, 0x0, 0xFF87, 0x0, 0xD2, 0xCE, 0xCD, 0x4F, 0xCA, 0xCB, 0xCF, 0x0, 0xD3, 0xD1,
+   0xD5, 0xD6, 0xDA, 0xD9, 0xDB, 0x0, 0x0, 0x2, 0x1, 0x0, 0x0, 0xFF9F, 0xFFC8, 0x0, 0x0, 0x0,
+   0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x26, 0x25,
+   0x40, 0x3F, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x50,
+   0x0, 0x0, 0x30, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0,
+   0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0,
+   0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0,
+   0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0xFFF8, 0x0, 0x0, 0x0,
+   0x0, 0x0, 0x0, 0x0, 0xFFF8, 0x0, 0xFFB6, 0xFFF7, 0x0, 0xFFAA, 0xFF9C, 0x0, 0xFF90, 0xFFF9, 0xFF80, 0xFF82,
+   0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0,
+   0x0, 0x0, 0x0, 0x0, 0x0, 0xE2A3, 0xDF41, 0xDFBA, 0x0, 0x10, 0x10, 0x10, 0x10, 0x10, 0x10, 0x10,
+   0x10, 0x10, 0x10, 0x10, 0x10, 0x10, 0x10, 0x10, 0x10, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0,
+   0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0,
+   0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x1A, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0,
+   0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0,
+   0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0,
+};
+
+static inline int charType(int c) {return Data[Blocks[c>>5]+c & 0xFFFF] & 0x1F;}
+
+static inline bool isLowc(int c) {return charType(c) == CHAR_LOWERCASE;}
+static inline bool isUppc(int c) {return charType(c) == CHAR_UPPERCASE;}
+
+static inline bool isLetterOrDigit(int c) {
+   return (1 << charType(c)) & (CHAR_DIGIT | CHAR_LETTER);
+}
+
+static int toUpperCase(int c) {
+   return c + Upper[Data[Blocks[c>>5]+c & 0xFFFF] >> 7];
+}
+
+static int toLowerCase(int c) {
+   return c + Lower[Data[Blocks[c>>5]+c & 0xFFFF] >> 7];
+}
+
+// (low? 'any) -> sym | NIL
+any doLowQ(any x) {
+   x = cdr(x);
+   return isSym(x = EVAL(car(x))) && isLowc(symChar(name(x)))? x : Nil;
+}
+
+// (upp? 'any) -> sym | NIL
+any doUppQ(any x) {
+   x = cdr(x);
+   return isSym(x = EVAL(car(x))) && isUppc(symChar(name(x)))? x : Nil;
+}
+
+// (lowc 'any) -> any
+any doLowc(any x) {
+   int c, i;
+   any nm;
+   cell c1, c2;
+
+   x = cdr(x);
+   if (!isSym(x = EVAL(car(x))) || !(c = symChar(name(x))))
+      return x;
+   Push(c1, x);
+   Push(c2, boxChar(toLowerCase(c), &i, &nm));
+   while (c = symChar(NULL))
+      charSym(toLowerCase(c), &i, &nm);
+   drop(c1);
+   return consStr(data(c2));
+}
+
+// (uppc 'any) -> any
+any doUppc(any x) {
+   int c, i;
+   any nm;
+   cell c1, c2;
+
+   x = cdr(x);
+   if (!isSym(x = EVAL(car(x))) || !(c = symChar(name(x))))
+      return x;
+   Push(c1, x);
+   Push(c2, boxChar(toUpperCase(c), &i, &nm));
+   while (c = symChar(NULL))
+      charSym(toUpperCase(c), &i, &nm);
+   drop(c1);
+   return consStr(data(c2));
+}
+
+// (fold 'any ['cnt]) -> sym
+any doFold(any ex) {
+   int n, c, i;
+   any x, nm;
+   cell c1, c2;
+
+   x = cdr(ex);
+   if (!isSym(x = EVAL(car(x))) || !(c = symChar(name(x))))
+      return Nil;
+   while (!isLetterOrDigit(c))
+      if (!(c = symChar(NULL)))
+         return Nil;
+   Push(c1, x);
+   n = isCell(x = cddr(ex))? evCnt(ex,x) : 24;
+   Push(c2, boxChar(toLowerCase(c), &i, &nm));
+   while (c = symChar(NULL))
+      if (isLetterOrDigit(c)) {
+         if (!--n)
+            break;
+         charSym(toLowerCase(c), &i, &nm);
+      }
+   drop(c1);
+   return consStr(data(c2));
+}
diff --git a/src/tab.c b/src/tab.c
@@ -0,0 +1,410 @@
+/* 14nov09abu
+ * (c) Software Lab. Alexander Burger
+ */
+
+#include "pico.h"
+
+typedef struct symInit {fun code; char *name;} symInit;
+
+static symInit Symbols[] = {
+   {doAbs, "abs"},
+   {doAccept, "accept"},
+   {doAdd, "+"},
+   {doAlarm, "alarm"},
+   {doAll, "all"},
+   {doAnd, "and"},
+   {doAny, "any"},
+   {doAppend, "append"},
+   {doApply, "apply"},
+   {doArg, "arg"},
+   {doArgs, "args"},
+   {doArgv, "argv"},
+   {doArrow, "->"},
+   {doAs, "as"},
+   {doAsoq, "asoq"},
+   {doAssoc, "assoc"},
+   {doAt, "at"},
+   {doAtom, "atom"},
+   {doBind, "bind"},
+   {doBitAnd, "&"},
+   {doBitOr, "|"},
+   {doBitQ, "bit?"},
+   {doBitXor, "x|"},
+   {doBool, "bool"},
+   {doBox, "box"},
+   {doBoxQ, "box?"},
+   {doBreak, "!"},
+   {doBy, "by"},
+   {doBye, "bye"},
+   {doCaaaar, "caaaar"},
+   {doCaaadr, "caaadr"},
+   {doCaaar, "caaar"},
+   {doCaadar, "caadar"},
+   {doCaaddr, "caaddr"},
+   {doCaadr, "caadr"},
+   {doCaar, "caar"},
+   {doCadaar, "cadaar"},
+   {doCadadr, "cadadr"},
+   {doCadar, "cadar"},
+   {doCaddar, "caddar"},
+   {doCadddr, "cadddr"},
+   {doCaddr, "caddr"},
+   {doCadr, "cadr"},
+   {doCall, "call"},
+   {doCar, "car"},
+   {doCase, "case"},
+   {doCatch, "catch"},
+   {doCdaaar, "cdaaar"},
+   {doCdaadr, "cdaadr"},
+   {doCdaar, "cdaar"},
+   {doCdadar, "cdadar"},
+   {doCdaddr, "cdaddr"},
+   {doCdadr, "cdadr"},
+   {doCd, "cd"},
+   {doCdar, "cdar"},
+   {doCddaar, "cddaar"},
+   {doCddadr, "cddadr"},
+   {doCddar, "cddar"},
+   {doCdddar, "cdddar"},
+   {doCddddr, "cddddr"},
+   {doCdddr, "cdddr"},
+   {doCddr, "cddr"},
+   {doCdr, "cdr"},
+   {doChar, "char"},
+   {doChain, "chain"},
+   {doChop, "chop"},
+   {doCirc, "circ"},
+   {doClip, "clip"},
+   {doClose, "close"},
+   {doCmd, "cmd"},
+   {doCnt, "cnt"},
+   {doCol, ":"},
+   {doCommit, "commit"},
+   {doCon, "con"},
+   {doConc, "conc"},
+   {doCond, "cond"},
+   {doConnect, "connect"},
+   {doCons, "cons"},
+   {doCopy, "copy"},
+   {doCtl, "ctl"},
+   {doCtty, "ctty"},
+   {doCut, "cut"},
+   {doDate, "date"},
+   {doDbck, "dbck"},
+   {doDe, "de"},
+   {doDec, "dec"},
+   {doDef, "def"},
+   {doDefault, "default"},
+   {doDel, "del"},
+   {doDelete, "delete"},
+   {doDelq, "delq"},
+   {doDiff, "diff"},
+   {doDir, "dir"},
+   {doDiv, "/"},
+   {doDm, "dm"},
+   {doDo, "do"},
+   {doE, "e"},
+   {doEcho, "echo"},
+   {doEnv, "env"},
+   {doEof, "eof"},
+   {doEol, "eol"},
+   {doEq, "=="},
+   {doEq0, "=0"},
+   {doEqT, "=T"},
+   {doEqual, "="},
+   {doEval, "eval"},
+   {doExt, "ext"},
+   {doExtern, "extern"},
+   {doExtQ, "ext?"},
+   {doExtra, "extra"},
+   {doExtract, "extract"},
+   {doFifo, "fifo"},
+   {doFile, "file"},
+   {doFill, "fill"},
+   {doFilter, "filter"},
+   {doFin, "fin"},
+   {doFinally, "finally"},
+   {doFind, "find"},
+   {doFish, "fish"},
+   {doFlgQ, "flg?"},
+   {doFlip, "flip"},
+   {doFlush, "flush"},
+   {doFold, "fold"},
+   {doFor, "for"},
+   {doFork, "fork"},
+   {doFormat, "format"},
+   {doFree, "free"},
+   {doFrom, "from"},
+   {doFull, "full"},
+   {doFunQ, "fun?"},
+   {doGc, "gc"},
+   {doGe, ">="},
+   {doGe0, "ge0"},
+   {doGet, "get"},
+   {doGetd, "getd"},
+   {doGetl, "getl"},
+   {doGlue, "glue"},
+   {doGt, ">"},
+   {doGt0, "gt0"},
+   {doHead, "head"},
+   {doHeap, "heap"},
+   {doHear, "hear"},
+   {doHide, "===="},
+   {doHost, "host"},
+   {doId, "id"},
+   {doIdx, "idx"},
+   {doIf, "if"},
+   {doIf2, "if2"},
+   {doIfn, "ifn"},
+   {doIn, "in"},
+   {doInc, "inc"},
+   {doIndex, "index"},
+   {doInfo, "info"},
+   {doIntern, "intern"},
+   {doIpid, "ipid"},
+   {doIsa, "isa"},
+   {doJob, "job"},
+   {doJournal, "journal"},
+   {doKey, "key"},
+   {doKill, "kill"},
+   {doLast, "last"},
+   {doLe, "<="},
+   {doLength, "length"},
+   {doLet, "let"},
+   {doLetQ, "let?"},
+   {doLieu, "lieu"},
+   {doLine, "line"},
+   {doLines, "lines"},
+   {doLink, "link"},
+   {doList, "list"},
+   {doListen, "listen"},
+   {doLit, "lit"},
+   {doLstQ, "lst?"},
+   {doLoad, "load"},
+   {doLock, "lock"},
+   {doLoop, "loop"},
+   {doLowQ, "low?"},
+   {doLowc, "lowc"},
+   {doLt, "<"},
+   {doLt0, "lt0"},
+   {doLup, "lup"},
+   {doMade, "made"},
+   {doMake, "make"},
+   {doMap, "map"},
+   {doMapc, "mapc"},
+   {doMapcan, "mapcan"},
+   {doMapcar, "mapcar"},
+   {doMapcon, "mapcon"},
+   {doMaplist, "maplist"},
+   {doMaps, "maps"},
+   {doMark, "mark"},
+   {doMatch, "match"},
+   {doMax, "max"},
+   {doMaxi, "maxi"},
+   {doMember, "member"},
+   {doMemq, "memq"},
+   {doMeta, "meta"},
+   {doMethod, "method"},
+   {doMin, "min"},
+   {doMini, "mini"},
+   {doMix, "mix"},
+   {doMmeq, "mmeq"},
+   {doMul, "*"},
+   {doMulDiv, "*/"},
+   {doName, "name"},
+   {doNand, "nand"},
+   {doNEq, "n=="},
+   {doNEq0, "n0"},
+   {doNEqT, "nT"},
+   {doNEqual, "<>"},
+   {doNeed, "need"},
+   {doNew, "new"},
+   {doNext, "next"},
+   {doNil, "nil"},
+   {doNond, "nond"},
+   {doNor, "nor"},
+   {doNot, "not"},
+   {doNth, "nth"},
+   {doNumQ, "num?"},
+   {doOff, "off"},
+   {doOffset, "offset"},
+   {doOn, "on"},
+   {doOne, "one"},
+   {doOnOff, "onOff"},
+   {doOpen, "open"},
+   {doOpid, "opid"},
+   {doOpt, "opt"},
+   {doOr, "or"},
+   {doOut, "out"},
+   {doPack, "pack"},
+   {doPair, "pair"},
+   {doPass, "pass"},
+   {doPath, "path"},
+   {doPatQ, "pat?"},
+   {doPeek, "peek"},
+   {doPid, "pid"},
+   {doPick, "pick"},
+   {doPipe, "pipe"},
+   {doPoll, "poll"},
+   {doPool, "pool"},
+   {doPop, "pop"},
+   {doPort, "port"},
+   {doPr, "pr"},
+   {doPreQ, "pre?"},
+   {doPrin, "prin"},
+   {doPrinl, "prinl"},
+   {doPrint, "print"},
+   {doPrintln, "println"},
+   {doPrintsp, "printsp"},
+   {doProg, "prog"},
+   {doProg1, "prog1"},
+   {doProg2, "prog2"},
+   {doProp, "prop"},
+   {doPropCol, "::"},
+   {doProtect, "protect"},
+   {doProve, "prove"},
+   {doPush, "push"},
+   {doPush1, "push1"},
+   {doPut, "put"},
+   {doPutl, "putl"},
+   {doPwd, "pwd"},
+   {doQueue, "queue"},
+   {doQuit, "quit"},
+   {doRand, "rand"},
+   {doRange, "range"},
+   {doRank, "rank"},
+   {doRaw, "raw"},
+   {doRd, "rd"},
+   {doRead, "read"},
+   {doRem, "%"},
+   {doReplace, "replace"},
+   {doRest, "rest"},
+   {doReverse, "reverse"},
+   {doRewind, "rewind"},
+   {doRollback, "rollback"},
+   {doRot, "rot"},
+   {doRpc, "rpc"},
+   {doRun, "run"},
+   {doSect, "sect"},
+   {doSeed, "seed"},
+   {doSeek, "seek"},
+   {doSemicol, ";"},
+   {doSend, "send"},
+   {doSeq, "seq"},
+   {doSet, "set"},
+   {doSetCol, "=:"},
+   {doSetq, "setq"},
+   {doShift, ">>"},
+   {doSize, "size"},
+   {doSkip, "skip"},
+   {doSort, "sort"},
+   {doSpace, "space"},
+   {doSplit, "split"},
+   {doSpQ, "sp?"},
+   {doState, "state"},
+   {doStem, "stem"},
+   {doStr, "str"},
+   {doStrip, "strip"},
+   {doStrQ, "str?"},
+   {doSub, "-"},
+   {doSubQ, "sub?"},
+   {doSum, "sum"},
+   {doSuper, "super"},
+   {doSym, "sym"},
+   {doSymQ, "sym?"},
+   {doSync, "sync"},
+   {doSys, "sys"},
+   {doT, "t"},
+   {doTail, "tail"},
+   {doTell, "tell"},
+   {doText, "text"},
+   {doThrow, "throw"},
+   {doTick, "tick"},
+   {doTill, "till"},
+   {doTime, "time"},
+   {doTouch, "touch"},
+   {doTrace, "$"},
+   {doTrim, "trim"},
+   {doTry, "try"},
+   {doType, "type"},
+   {doUdp, "udp"},
+   {doUnify, "unify"},
+   {doUnless, "unless"},
+   {doUntil, "until"},
+   {doUp, "up"},
+   {doUppQ, "upp?"},
+   {doUppc, "uppc"},
+   {doUse, "use"},
+   {doUsec, "usec"},
+   {doVal, "val"},
+   {doWait, "wait"},
+   {doWhen, "when"},
+   {doWhile, "while"},
+   {doWipe, "wipe"},
+   {doWith, "with"},
+   {doWr, "wr"},
+   {doXchg, "xchg"},
+   {doXor, "xor"},
+   {doYoke, "yoke"},
+   {doZap, "zap"},
+   {doZero, "zero"},
+};
+
+static any initSym(any v, char *s) {
+   any x, *h;
+
+   h = Intern + ihash(x = mkName(s));
+   x = consSym(v,x);
+   *h = cons(x,*h);
+   return x;
+}
+
+void initSymbols(void) {
+   int i;
+
+   Nil = symPtr(Avail),  Avail = Avail->car->car;  // Allocate 2 cells for NIL
+   val(Nil) = tail(Nil) = val(Nil+1) = tail(Nil+1) = Nil;
+   Zero = box(0);
+   One = box(2);
+   for (i = 0; i < IHASH; ++i)
+      Intern[i] = Transient[i] = Nil;
+   for (i = 0; i < EHASH; ++i)
+      Extern[i] = Nil;
+   initSym(mkStr(_OS), "*OS");
+   DB    = initSym(Nil, "*DB");
+   Meth  = initSym(box(num(doMeth)), "meth");
+   Quote = initSym(box(num(doQuote)), "quote");
+   T     = initSym(Nil, "T"),  val(T) = T;  // Last protected symbol
+
+   mkExt(val(DB) = DbVal = consStr(DbTail = box('1')));
+   Extern['1'] = cons(DbVal, Nil);
+
+   Solo  = initSym(Zero, "*Solo");
+   PPid  = initSym(Nil, "*PPid");
+   Pid   = initSym(boxCnt(getpid()), "*Pid");
+   At    = initSym(Nil, "@");
+   At2   = initSym(Nil, "@@");
+   At3   = initSym(Nil, "@@@");
+   This  = initSym(Nil, "This");
+   Dbg   = initSym(Nil, "*Dbg");
+   Zap   = initSym(Nil, "*Zap");
+   Ext   = initSym(Nil, "*Ext");
+   Scl   = initSym(Zero, "*Scl");
+   Class = initSym(Nil, "*Class");
+   Run   = initSym(Nil, "*Run");
+   Hup   = initSym(Nil, "*Hup");
+   Sig1  = initSym(Nil, "*Sig1");
+   Sig2  = initSym(Nil, "*Sig2");
+   Up    = initSym(Nil, "^");
+   Err   = initSym(Nil, "*Err");
+   Msg   = initSym(Nil, "*Msg");
+   Uni   = initSym(Nil, "*Uni");
+   Led   = initSym(Nil, "*Led");
+   Tsm   = initSym(Nil, "*Tsm");
+   Adr   = initSym(Nil, "*Adr");
+   Fork  = initSym(Nil, "*Fork");
+   Bye   = initSym(Nil, "*Bye");  // Last unremovable symbol
+
+   for (i = 0; i < (int)(sizeof(Symbols)/sizeof(symInit)); ++i)
+      initSym(box(num(Symbols[i].code)), Symbols[i].name);
+}
diff --git a/src/utf2.c b/src/utf2.c
@@ -0,0 +1,68 @@
+/* utf2.c
+ * 31mar05abu
+ * Convert process or file (ISO-8859-15) to stdout (UTF-8, 2-Byte)
+ */
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <unistd.h>
+#include <errno.h>
+#include <signal.h>
+#include <sys/wait.h>
+
+// utf2 [-<cmd> [<arg> ..]]
+// utf2 [<Infile/ISO-8859-15>]
+int main(int ac, char *av[]) {
+	int c;
+   pid_t pid = 0;
+   FILE *fp = stdin;
+
+   if (ac > 1) {
+      if (*av[1] == '-') {
+         int pfd[2];
+
+         if (pipe(pfd) < 0) {
+            fprintf(stderr, "utf2: Pipe error\n");
+            return 1;
+         }
+         if ((pid = fork()) == 0) {
+            close(pfd[0]);
+            if (pfd[1] != STDOUT_FILENO)
+               dup2(pfd[1], STDOUT_FILENO),  close(pfd[1]);
+            execvp(av[1]+1, av+1);
+         }
+         if (pid < 0) {
+            fprintf(stderr, "utf2: Fork error\n");
+            return 1;
+         }
+         close(pfd[1]);
+         if (!(fp = fdopen(pfd[0], "r"))) {
+            fprintf(stderr, "utf2: Pipe open error\n");
+            return 1;
+         }
+      }
+      else if (!(fp = fopen(av[1], "r"))) {
+         fprintf(stderr, "utf2: '%s' open error\n", av[1]);
+         return 1;
+      }
+   }
+	while ((c = getc_unlocked(fp)) != EOF) {
+      if (c == 0xA4)
+         putchar_unlocked(0xE2), putchar_unlocked(0x82), putchar_unlocked(0xAC);
+      else if (c >= 0x80) {
+         putchar_unlocked(0xC0 | c>>6 & 0x1F);
+         putchar_unlocked(0x80 | c & 0x3F);
+      }
+      else
+         putchar_unlocked(c);
+	}
+   if (pid) {
+      fclose(fp);
+      while (waitpid(pid, NULL, 0) < 0)
+         if (errno != EINTR) {
+            fprintf(stderr, "utf2: Pipe close error\n");
+            return 1;
+         }
+   }
+   return 0;
+}
diff --git a/src/z3d.c b/src/z3d.c
@@ -0,0 +1,468 @@
+/* 22apr08abu
+ * (c) Software Lab. Alexander Burger
+ */
+
+#include "pico.h"
+
+#define SCL 1000000.0
+
+typedef struct {double x, y, z;} vector;
+typedef struct {vector a, b, c;} matrix;
+
+static bool Snap;
+static int SnapD, Snap1h, Snap1v, Snap2h, Snap2v;
+static double FocLen, PosX, PosY, PosZ, Pos6, Pos9, SnapX, SnapY, SnapZ;
+static double Coeff1, Coeff2, Coeff4, Coeff5, Coeff6, Coeff7, Coeff8, Coeff9;
+
+
+static any getVector(any lst, vector *dst) {
+   dst->x = numToDouble(car(lst)) / SCL,  lst = cdr(lst);
+   dst->y = numToDouble(car(lst)) / SCL,  lst = cdr(lst);
+   dst->z = numToDouble(car(lst)) / SCL;
+   return cdr(lst);
+}
+
+static any putVector(vector *src, any lst) {
+   car(lst) = doubleToNum(src->x * SCL),  lst = cdr(lst);
+   car(lst) = doubleToNum(src->y * SCL),  lst = cdr(lst);
+   car(lst) = doubleToNum(src->z * SCL);
+   return cdr(lst);
+}
+
+static any getMatrix(any lst, matrix *dst) {
+   return getVector(getVector(getVector(lst, &dst->a), &dst->b), &dst->c);
+}
+
+static any putMatrix(matrix *src, any lst) {
+   return putVector(&src->c, putVector(&src->b, putVector(&src->a, lst)));
+}
+
+static void xrot(matrix *p, double ca, double sa) {
+   matrix m = *p;
+
+   p->b.x = ca * m.b.x - sa * m.c.x;
+   p->b.y = ca * m.b.y - sa * m.c.y;
+   p->b.z = ca * m.b.z - sa * m.c.z;
+   p->c.x = sa * m.b.x + ca * m.c.x;
+   p->c.y = sa * m.b.y + ca * m.c.y;
+   p->c.z = sa * m.b.z + ca * m.c.z;
+}
+
+// (z3d:Xrot 'angle 'model) -> T
+any Xrot(any ex) {
+   any x;
+   double a;
+   matrix m;
+
+   a = evDouble(ex, x = cdr(ex)) / SCL;
+   x = EVAL(cadr(x));
+   Touch(ex,x);
+   x = cdddr(val(x));
+   getMatrix(x, &m),  xrot(&m, cos(a), sin(a)),  putMatrix(&m, x);
+   return T;
+}
+
+static void yrot(matrix *p, double ca, double sa) {
+   matrix m = *p;
+
+   p->a.x = ca * m.a.x + sa * m.c.x;
+   p->a.y = ca * m.a.y + sa * m.c.y;
+   p->a.z = ca * m.a.z + sa * m.c.z;
+   p->c.x = ca * m.c.x - sa * m.a.x;
+   p->c.y = ca * m.c.y - sa * m.a.y;
+   p->c.z = ca * m.c.z - sa * m.a.z;
+}
+
+// (z3d:Yrot 'angle 'model) -> T
+any Yrot(any ex) {
+   any x;
+   double a;
+   matrix m;
+
+   a = evDouble(ex, x = cdr(ex)) / SCL;
+   x = EVAL(cadr(x));
+   Touch(ex,x);
+   x = cdddr(val(x));
+   getMatrix(x, &m),  yrot(&m, cos(a), sin(a)),  putMatrix(&m, x);
+   return T;
+}
+
+static void zrot(matrix *p, double ca, double sa) {
+   matrix m = *p;
+
+   p->a.x = ca * m.a.x + sa * m.b.x;
+   p->a.y = ca * m.a.y + sa * m.b.y;
+   p->a.z = ca * m.a.z + sa * m.b.z;
+   p->b.x = ca * m.b.x - sa * m.a.x;
+   p->b.y = ca * m.b.y - sa * m.a.y;
+   p->b.z = ca * m.b.z - sa * m.a.z;
+}
+
+// (z3d:Zrot 'angle 'model) -> T
+any Zrot(any ex) {
+   any x;
+   double a;
+   matrix m;
+
+   a = evDouble(ex, x = cdr(ex)) / SCL;
+   x = EVAL(cadr(x));
+   Touch(ex,x);
+   x = cdddr(val(x));
+   getMatrix(x, &m),  zrot(&m, cos(a), sin(a)),  putMatrix(&m, x);
+   return T;
+}
+
+// (z3d:Arot 'angle 'model) -> T
+any Arot(any ex) {
+   any x;
+   double a, n;
+   matrix m;
+   vector pt;
+
+   a = evDouble(ex, x = cdr(ex)) / SCL;
+   x = EVAL(cadr(x));
+   Touch(ex,x);
+   x = cdddr(val(x));
+   getVector(cddar(getMatrix(x, &m)), &pt);
+   n = sqrt(pt.x*pt.x + pt.y*pt.y + pt.z*pt.z);
+   pt.x /= n,  pt.y /= n,  pt.z /= n;  // Axis unit vector
+   if ((n = sqrt(pt.y*pt.y + pt.z*pt.z)) == 0.0)  // Axis parallel to x-axis
+      a *= pt.x,  xrot(&m, cos(a), sin(a));
+   else {
+      xrot(&m, pt.z/n, -pt.y/n);
+      yrot(&m, n, pt.x);
+      zrot(&m, cos(a), sin(a));
+      yrot(&m, n, -pt.x);
+      xrot(&m, pt.z/n, pt.y/n);
+   }
+   putMatrix(&m, x);
+   return T;
+}
+
+// (z3d:Rotate 'X 'Y 'Z 'model 'varX 'varY 'varZ ['flg]) -> T
+any Rotate(any ex) {
+   any x;
+   double vx, vy, vz;
+   matrix m;
+   cell c1, c2, c3;
+
+   vx = evDouble(ex, x = cdr(ex)) / SCL;
+   vy = evDouble(ex, x = cdr(x)) / SCL;
+   vz = evDouble(ex, x = cdr(x)) / SCL;
+   x = cdr(x),  getMatrix(cdddr(val(EVAL(car(x)))), &m);
+   x = cdr(x),  Push(c1, EVAL(car(x)));
+   NeedVar(ex,data(c1));
+   x = cdr(x),  Push(c2, EVAL(car(x)));
+   NeedVar(ex,data(c2));
+   x = cdr(x),  Push(c3, EVAL(car(x)));
+   NeedVar(ex,data(c3));
+   if (isNil(EVAL(cadr(x)))) {
+      if (!isNil(data(c1)))
+         val(data(c1)) = doubleToNum((vx * m.a.x + vy * m.b.x + vz * m.c.x) * SCL);
+      if (!isNil(data(c2)))
+         val(data(c2)) = doubleToNum((vx * m.a.y + vy * m.b.y + vz * m.c.y) * SCL);
+      if (!isNil(data(c3)))
+         val(data(c3)) = doubleToNum((vx * m.a.z + vy * m.b.z + vz * m.c.z) * SCL);
+   }
+   else {
+      if (!isNil(data(c1)))
+         val(data(c1)) = doubleToNum((vx * m.a.x + vy * m.a.y + vz * m.a.z) * SCL);
+      if (!isNil(data(c2)))
+         val(data(c2)) = doubleToNum((vx * m.b.x + vy * m.b.y + vz * m.b.z) * SCL);
+      if (!isNil(data(c3)))
+         val(data(c3)) = doubleToNum((vx * m.c.x + vy * m.c.y + vz * m.c.z) * SCL);
+   }
+   drop(c1);
+   return T;
+}
+
+static void _approach(any ex, double d, any dst, any src) {
+   any l1, l2;
+   int i;
+   double n;
+
+   Touch(ex,dst);
+   l1 = val(dst);
+   Fetch(ex,src);
+   l2 = val(src);
+   for (i = 0;  i < 12;  ++i) {
+      n = numToDouble(car(l1)) / SCL;
+      car(l1) = doubleToNum((n + d * (numToDouble(car(l2)) / SCL - n)) * SCL);
+      l1 = cdr(l1),  l2 = cdr(l2);
+   }
+   do {
+      while (!isSym(car(l1)))
+         if (!isCell(l1 = cdr(l1)))
+            return;
+      while (!isSym(car(l2)))
+         if (!isCell(l2 = cdr(l2)))
+            return;
+      _approach(ex, d, car(l1), car(l2));
+   } while (isCell(l1 = cdr(l1))  &&  isCell(l2 = cdr(l2)));
+}
+
+// (z3d:Approach 'num 'model 'model) -> T
+any Approach(any ex) {
+   any x;
+   long n;
+   cell c1, c2;
+
+   n = evCnt(ex, x = cdr(ex));
+   x = cdr(x),  Push(c1, EVAL(car(x)));
+   x = cdr(x),  Push(c2, EVAL(car(x)));
+   _approach(ex, 1.0 / (double)n, data(c1), data(c2));
+   drop(c1);
+   return T;
+}
+
+// (z3d:Spot 'dx 'dy 'dz ['x 'y 'z]) -> (yaw . pitch)
+any Spot(any ex) {
+   any x;
+   double dx, dy, dz;
+   cell c1;
+
+   dx = evDouble(ex, x = cdr(ex)) / SCL;
+   dy = evDouble(ex, x = cdr(x)) / SCL;
+   dz = evDouble(ex, x = cdr(x)) / SCL;
+
+   if (isCell(x = cdr(x))) {
+      dx -= evDouble(ex, x) / SCL;
+      dy -= evDouble(ex, x = cdr(x)) / SCL;
+      dz -= evDouble(ex, x = cdr(x)) / SCL;
+   }
+
+   Push(c1, doubleToNum(atan2(dy,dx) * SCL));
+   dx = sqrt(dx*dx + dy*dy + dz*dz);
+   data(c1) = cons(data(c1), doubleToNum(dx==0.0? 0.0 : asin(dz/dx)*SCL));
+   return Pop(c1);
+}
+
+static void rotate(vector *src, matrix *p, vector *dst) {
+   dst->x = src->x * p->a.x + src->y * p->b.x + src->z * p->c.x;
+   dst->y = src->x * p->a.y + src->y * p->b.y + src->z * p->c.y;
+   dst->z = src->x * p->a.z + src->y * p->b.z + src->z * p->c.z;
+}
+
+#if 0
+/* (lst -- x y z) */
+void Locate(void) {
+   any lst;
+   vector pos, v, w;
+   matrix rot, r;
+
+   lst = Tos;
+   getMatrix(getVector(car(lst), &pos), &rot);
+   while (isCell(lst = cdr(lst))) {
+      getMatrix(getVector(car(lst), &v), &r);
+      rotate(&v, &rot, &w);
+      pos.x += w.x,  pos.y += w.y,  pos.z += w.z;
+      v = r.a,  rotate(&v, &rot, &r.a);
+      v = r.b,  rotate(&v, &rot, &r.b);
+      v = r.c,  rotate(&v, &rot, &r.c);
+      rot = r;
+   }
+   Tos = doubleToNum(pos.x) * SCL;
+   push(doubleToNum(pos.y)) * SCL;
+   push(doubleToNum(pos.z)) * SCL;
+}
+#endif
+
+static void shadowPt(double vx, double vy) {
+   double z;
+
+   z = Coeff7 * vx + Coeff8 * vy - Pos9;
+   prn((int)(FocLen * (Coeff1 * vx + Coeff2 * vy) / z));
+   prn((int)(FocLen * (Coeff4 * vx + Coeff5 * vy - Pos6) / z));
+   prn(num(1000.0 * z));
+}
+
+static void transPt(double vx, double vy, double vz) {
+   double x, y, z;
+   int h, v, dh, dv, d;
+
+   x = Coeff1 * vx + Coeff2 * vy;
+   y = Coeff4 * vx + Coeff5 * vy + Coeff6 * vz;
+   z = Coeff7 * vx + Coeff8 * vy + Coeff9 * vz;
+   prn(h = (int)(FocLen * x/z));
+   prn(v = (int)(FocLen * y/z));
+   prn(num(1000.0 * z));
+   if (Snap) {
+      if ((dh = h - Snap1h) < 0)
+         dh = -dh;
+      if ((dv = v - Snap1v) < 0)
+         dv = -dv;
+      if ((d = dh>dv? dh+dv*41/100-dh/24 : dv+dh*41/100-dv/24) < SnapD) {
+         SnapD = d;
+         Snap2h = h;  Snap2v = v;
+         SnapX = vx;  SnapY = vy;  SnapZ = vz;
+      }
+   }
+}
+
+static void doDraw(any ex, any mdl, matrix *r, double x, double y, double z) {
+   any face, c1, c2, txt;
+   long n, pix;
+   double dx, dy, dz;
+   vector pos, pt1, pt2, pt3, v, w, nv;
+   matrix rot;
+
+   Fetch(ex,mdl);
+   mdl = getMatrix(getVector(val(mdl), &pos), &rot);
+   if (!r)
+      r = &rot;
+   else {
+      v = pos,  rotate(&v, r, &pos);
+      pos.x += x,  pos.y += y,  pos.z += z;
+      v = rot.a,  rotate(&v, r, &rot.a);
+      v = rot.b,  rotate(&v, r, &rot.b);
+      v = rot.c,  rotate(&v, r, &rot.c);
+   }
+   dx = pos.x - PosX;
+   dy = pos.y - PosY;
+   dz = pos.z - PosZ;
+
+   if ((z = Coeff7*dx + Coeff8*dy + Coeff9*dz) < 0.1)
+      return;
+   if (z < fabs(Coeff1*dx + Coeff2*dy))
+      return;
+   if (z < fabs(Coeff4*dx + Coeff5*dy + Coeff6*dz))
+      return;
+
+   while (isCell(mdl)) {
+      face = car(mdl),  mdl = cdr(mdl);
+      if (isSym(face))
+         doDraw(ex, face, &rot, pos.x, pos.y, pos.z);
+      else {
+         c1 = car(face),  face = cdr(face);
+         c2 = car(face),  face = cdr(face);
+         if (!isSym(car(face)))
+            txt = Nil;
+         else
+            txt = car(face),  face = cdr(face);
+         face = getVector(getVector(face, &v), &w);
+         if ((v.x || v.y || v.z) && (w.x || w.y || w.z))
+            r = &rot,  rotate(&v, r, &pt1),  rotate(&w, r, &pt2);
+         else
+            rotate(&v, r, &pt1),  rotate(&w, r, &pt2),  r = &rot;
+         face = getVector(face, &v),  rotate(&v, r, &pt3);
+         if (c2 == T) {
+            n = length(face) / 3;
+            prn(n+2);
+            shadowPt(pt1.x + dx + pt1.z + pos.z, pt1.y + dy);
+            pr(0,txt);
+            shadowPt(pt2.x + dx + pt2.z + pos.z, pt2.y + dy);
+            shadowPt(pt3.x + dx + pt3.z + pos.z, pt3.y + dy);
+            while (--n >= 0) {
+               face = getVector(face, &v),  rotate(&v, r, &pt1);
+               shadowPt(pt1.x + dx + pt1.z + pos.z, pt1.y + dy);
+            }
+            prn(0);
+         }
+         else {
+            v.x = pt1.x - pt2.x;
+            v.y = pt1.y - pt2.y;
+            v.z = pt1.z - pt2.z;
+            w.x = pt3.x - pt2.x;
+            w.y = pt3.y - pt2.y;
+            w.z = pt3.z - pt2.z;
+            nv.x = v.y * w.z - v.z * w.y;
+            nv.y = v.z * w.x - v.x * w.z;
+            nv.z = v.x * w.y - v.y * w.x;
+            pt1.x += dx,  pt1.y += dy,  pt1.z += dz;
+            if (isNil(c1) && isNil(c2))
+               pix = -1;  // Transparent
+            else {
+               if (pt1.x * nv.x + pt1.y * nv.y + pt1.z * nv.z >= 0.0) {
+                  if (isNil(c1))
+                     continue;  // Backface culling
+                  pix = unDig(c1) / 2;
+                  n = 80 - num(14.14 * (nv.z-nv.x) / sqrt(nv.x*nv.x + nv.y*nv.y + nv.z*nv.z));
+               }
+               else {
+                  if (isNil(c2))
+                     continue;  // Backface culling
+                  pix = unDig(c2) / 2;
+                  n = 80 + num(14.14 * (nv.z-nv.x) / sqrt(nv.x*nv.x + nv.y*nv.y + nv.z*nv.z));
+               }
+               pix = ((pix >> 16) & 255) * n / 100 << 16  |
+                     ((pix >> 8) & 255) * n / 100 << 8  |  (pix & 255) * n / 100;
+            }
+            n = length(face) / 3;
+            prn(n+2);
+            transPt(pt1.x, pt1.y, pt1.z);
+            pr(0,txt);
+            transPt(pt2.x + dx, pt2.y + dy, pt2.z + dz);
+            transPt(pt3.x + dx, pt3.y + dy, pt3.z + dz);
+            while (--n >= 0) {
+               face = getVector(face, &v),  rotate(&v, r, &pt1);
+               transPt(pt1.x + dx, pt1.y + dy, pt1.z + dz);
+            }
+            prn(pix);
+         }
+      }
+   }
+}
+
+// (z3d:Draw 'foc 'yaw 'pitch 'x 'y 'z 'sky 'gnd ['h 'v]) -> NIL
+// (z3d:Draw 'sym) -> NIL
+// (z3d:Draw 'NIL) -> lst
+any Draw(any ex) {
+   any x, y;
+   double a, sinY, cosY, sinP, cosP;
+
+   x = cdr(ex);
+   if (isNil(y = EVAL(car(x)))) {
+      cell c1;
+
+      prn(0);
+      if (!Snap) {
+         prn(32767);
+         return Nil;
+      }
+      prn(Snap2h),  prn(Snap2v);
+      Push(c1, doubleToNum(SnapZ * SCL));
+      data(c1) = cons(doubleToNum(SnapY * SCL), data(c1));
+      data(c1) = cons(doubleToNum(SnapX * SCL), data(c1));
+      return Pop(c1);
+   }
+   if (isSym(y)) {
+      doDraw(ex, y, NULL, 0.0, 0.0, 0.0);
+      return Nil;
+   }
+   FocLen = numToDouble(y) / SCL;
+   a = evDouble(ex, x = cdr(x)) / SCL,  sinY = sin(a),  cosY = cos(a);
+   a = evDouble(ex, x = cdr(x)) / SCL,  sinP = sin(a),  cosP = cos(a);
+   PosX = evDouble(ex, x = cdr(x)) / SCL;
+   PosY = evDouble(ex, x = cdr(x)) / SCL;
+   PosZ = evDouble(ex, x = cdr(x)) / SCL;
+
+   Coeff1 = -sinY;
+   Coeff2 = cosY;
+   Coeff4 = cosY * sinP;
+   Coeff5 = sinY * sinP;
+   Coeff6 = -cosP;
+   Coeff7 = cosY * cosP;
+   Coeff8 = sinY * cosP;
+   Coeff9 = sinP;
+
+   Pos6 = Coeff6 * PosZ;
+   Pos9 = Coeff9 * PosZ;
+
+   if (cosP == 0.0)
+      prn(sinP > 0.0? +16383 : -16384);
+   else if ((a = FocLen * sinP/cosP) > +16383.0)
+      prn(+16383);
+   else if (a < -16384.0)
+      prn(-16384);
+   else
+      prn(num(a));
+   prn(evCnt(ex, x = cdr(x)));
+   prn(evCnt(ex, x = cdr(x)));
+   x = cdr(x);
+   if (Snap = !isNil(y = EVAL(car(x)))) {
+      SnapD = 32767;
+      Snap1h = (int)xCnt(ex,y);
+      Snap1v = (int)evCnt(ex,cdr(x));
+   }
+   return Nil;
+}
diff --git a/src/z3dClient.c b/src/z3dClient.c
@@ -0,0 +1,532 @@
+/* 12nov09abu
+ * (c) Software Lab. Alexander Burger
+ */
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <sys/time.h>
+#include <unistd.h>
+#include <string.h>
+#include <errno.h>
+
+#include <netdb.h>
+#include <sys/socket.h>
+#include <netinet/in.h>
+#include <arpa/inet.h>
+
+#include <X11/Xlib.h>
+#include <X11/Xutil.h>
+#include <sys/shm.h>
+#include <X11/extensions/XShm.h>
+
+
+typedef unsigned char byte;
+typedef struct {long h[2]; unsigned long z[2];} edge;
+
+/* Globals */
+static int Socket;
+static Display *Disp;
+static int Scrn;
+static int Dpth;
+static int PixSize;
+static Colormap Cmap;
+static GC Gc;
+static Window Win;
+static long long Tim;
+
+/* 3D-Environment */
+static int SizX, SizY, OrgX, OrgY, SnapX, SnapY;
+static unsigned long *Zbuff;
+static edge *Edges;
+static XImage *Img;
+static XShmSegmentInfo Info;
+
+
+/* Error exit */
+static void giveup(char *msg) {
+   fprintf(stderr, "z3dClient: %s\r\n", msg);
+   exit(1);
+}
+
+/* Memory allocation */
+void *alloc(long siz) {
+   void *p;
+
+   if (!(p = malloc(siz)))
+      giveup("No memory");
+   return p;
+}
+
+static void paint(void) {
+   XEvent ev;
+
+   while (XCheckTypedEvent(Disp, Expose, &ev));
+   XShmPutImage(Disp, Win, Gc, Img, 0, 0, 0, 0, SizX, SizY, False);
+   if (SnapX != 32767) {
+      XSetFunction(Disp, Gc, GXinvert);
+      XFillRectangle(Disp, Win, Gc, OrgX+SnapX-3, OrgY+SnapY-3, 6, 6);
+      XSetFunction(Disp, Gc, GXcopy);
+   }
+   XSync(Disp,False);
+}
+
+static void prLong(long n) {
+   int i;
+   char buf[8];
+
+   n = n >= 0? n * 2 : -n * 2 + 1;
+   if ((n & 0xFFFFFF00) == 0)
+      i = 2, buf[0] = 1*4, buf[1] = n;
+   else if ((n & 0xFFFF0000) == 0)
+      i = 3, buf[0] = 2*4, buf[1] = n, buf[2] = n>>8;
+   else if ((n & 0xFF000000) == 0)
+      i = 4, buf[0] = 3*4, buf[1] = n, buf[2] = n>>8, buf[3] = n>>16;
+   else
+      i = 5, buf[0] = 4*4, buf[1] = n, buf[2] = n>>8, buf[3] = n>>16, buf[4] = n>>24;
+   if (write(Socket, buf, i) <= 0)
+      giveup("Socket write error");
+}
+
+
+static byte get1(void) {
+   static int n, cnt;
+   static byte buf[1024];
+
+   while (n == cnt) {
+      int fd;
+      fd_set fdSet;
+
+      fd = ConnectionNumber(Disp);
+      FD_ZERO(&fdSet);
+      FD_SET(fd, &fdSet);
+      FD_SET(Socket, &fdSet);
+      while (select((fd > Socket? fd : Socket) + 1, &fdSet, NULL,NULL,NULL) < 0)
+         if (errno != EINTR)
+            giveup("Select error");
+      if (FD_ISSET(fd, &fdSet)) {
+         XEvent ev;
+
+         XNextEvent(Disp, &ev);
+         switch (ev.type) {
+         case Expose:
+            paint();
+            break;
+         case KeyPress:
+            if (((XKeyEvent*)&ev)->state == 37)  // Ctrl-Key
+               printf("Ok\n");  //#?
+            break;
+         case KeyRelease:
+            break;
+         case ButtonPress:
+            prLong('c');  // clk
+            prLong(((XButtonEvent*)&ev)->x - OrgX);
+            prLong(((XButtonEvent*)&ev)->y - OrgY);
+            break;
+         case MotionNotify:  //#?
+            break;
+         }
+      }
+      if (FD_ISSET(Socket, &fdSet)) {
+         while ((cnt = read(Socket, buf, sizeof(buf))) < 0)
+            if (errno != EINTR)
+               giveup("Socket read error");
+         if (cnt == 0)
+            exit(0);
+         n = 0;
+      }
+   }
+   return buf[n++];
+}
+
+static long getNum(void) {
+   int cnt = get1() / 4;
+   long n = get1();
+   int i = 0;
+
+   while (--cnt)
+      n |= get1() << (i += 8);
+   if (n & 1)
+      n = -n;
+   return n / 2;
+}
+
+static void skipStr(void) {
+   int cnt = get1() / 4;
+   while (--cnt >= 0)
+      get1();
+}
+
+static long getColor(long c) {
+   XColor col;
+
+   col.red   = c >> 8  &  0xFF00;
+   col.green = c & 0xFF00;
+   col.blue  = (c & 0xFF) << 8;
+   col.flags = DoRed | DoGreen | DoBlue;
+   if (!XAllocColor(Disp, Cmap, &col))
+      giveup("Can't allocate color");
+   return col.pixel;
+}
+
+static void mkEdge(int x1, int y1, int z1, int x2, int y2, int z2) {
+   int a, dx, dy, dz, sx, xd, xe, sz, zd, ze;
+   edge *p;
+
+   if (y2 < y1) {
+      a = x1,  x1 = x2,  x2 = a;
+      a = y1,  y1 = y2,  y2 = a;
+      a = z1,  z1 = z2,  z2 = a;
+   }
+   if (y1 > OrgY  ||  ((y2 += OrgY) <= 0))
+      return;
+   if ((dy  =  y2 - (y1 += OrgY)) == 0)
+      return;
+   dx = x2 - x1,  dz = z2 - z1;
+   if (y1 < 0) {
+      x1 += -y1 * dx / dy;
+      z1 += -y1 * dz / dy;
+      y1 = 0;
+      if ((dy = y2) == 0)
+         return;
+      dx = x2 - x1,  dz = z2 - z1;
+   }
+   if (y2 > SizY) {
+      x2 += (SizY - y2) * dx / dy;
+      z2 += (SizY - y2) * dz / dy;
+      y2 = SizY;
+      if ((dy = y2 - y1) == 0)
+         return;
+      dx = x2 - x1,  dz = z2 - z1;
+   }
+   sx = 0;
+   if (dx > 0)
+      sx = 1;
+   else if (dx < 0)
+      dx = -dx,  sx = -1;
+   xd = 0;
+   if (dx > dy)
+      xd = dx/dy,  dx -= xd*dy,  xd *= sx;
+   xe = (dx *= 2) - dy;
+   sz = 0;
+   if (dz > 0)
+      sz = 1;
+   else if (dz < 0)
+      dz = -dz,  sz = -1;
+   zd = 0;
+   if (dz > dy)
+      zd = dz/dy,  dz -= zd*dy,  zd *= sz;
+   ze = (dz *= 2) - dy;
+   dy *= 2;
+   x1 += OrgX;
+   p = Edges + y1;
+   do {
+      if ((a = x1) < 0)
+         a = 0;
+      else if (a > SizX)
+         a = SizX;
+      if (a < p->h[1]) {
+         p->h[0] = a;
+         p->z[0] = z1;
+      }
+      else {
+         p->h[0] = p->h[1];
+         p->z[0] = p->z[1];
+         p->h[1] = a;
+         p->z[1] = z1;
+      }
+      ++p;
+      x1 += xd;
+      if (xe >= 0)
+         x1 += sx,  xe -= dy;
+      xe += dx;
+      z1 += zd;
+      if (ze >= 0)
+         z1 += sz,  ze -= dy;
+      ze += dz;
+   } while (++y1 < y2);
+}
+
+static void zDots(long i, long h, long h2, unsigned long z, unsigned long z2) {
+   char *frame;
+   unsigned long *zbuff;
+
+   i = i * SizX + h;
+   frame = Img->data + i * PixSize;
+   zbuff = Zbuff + i;
+   i = h2 - h;
+   switch (PixSize) {
+   case 1:
+      if (z < *zbuff)
+         *zbuff = z,  *frame = 0;
+      if (z2 < *(zbuff += i))
+         *zbuff = z2,  *(frame + i) = 0;
+      break;
+   case 2:
+      if (z < *zbuff)
+         *zbuff = z,  *(short*)frame = (short)0;
+      if (z2 < *(zbuff += i))
+         *zbuff = z2,  *(short*)(frame + 2 * i) = (short)0;
+      break;
+   case 3:
+      if (z < *zbuff) {
+         *zbuff = z;
+         frame[0] = 0;
+         frame[1] = 0;
+         frame[2] = 0;
+      }
+      if (z2 < *(zbuff += i)) {
+         *zbuff = z2;
+         frame += 3 * i;
+         frame[0] = 0;
+         frame[1] = 0;
+         frame[2] = 0;
+      }
+      break;
+   case 4:
+      if (z < *zbuff)
+         *zbuff = z,  *(long*)frame = (long)0;
+      if (z2 < *(zbuff += i))
+         *zbuff = z2,  *(long*)(frame + 4 * i) = (long)0;
+      break;
+   }
+}
+
+static void zLine(long pix, long v, long h, long h2,
+                                       unsigned long z, unsigned long z2) {
+   char *frame;
+   unsigned long *zbuff;
+   long d, e, dh, dz, sz;
+
+   if (dh = h2 - h) {
+      v = v * SizX + h;
+      frame = Img->data + v * PixSize;
+      zbuff = Zbuff + v;
+      sz = 0;
+      if ((dz = z2 - z) > 0)
+         sz = 1;
+      else if (dz < 0)
+         dz = -dz,  sz = -1;
+      d = 0;
+      if (dz > dh)
+         d = dz/dh,  dz -= d*dh,  d *= sz;
+      e = (dz *= 2) - dh;
+      dh *= 2;
+      switch (PixSize) {
+      case 1:
+         do {
+            if (z < *zbuff)
+               *zbuff = z,  *frame = pix;
+            z += d;
+            if (e >= 0)
+               z += sz,  e -= dh;
+            ++zbuff,  ++frame;
+            e += dz;
+         } while (++h < h2);
+         break;
+      case 2:
+         do {
+            if (z < *zbuff)
+               *zbuff = z,  *(short*)frame = (short)pix;
+            z += d;
+            if (e >= 0)
+               z += sz,  e -= dh;
+            ++zbuff,  frame += 2;
+            e += dz;
+         } while (++h < h2);
+         break;
+      case 3:
+         do {
+            if (z < *zbuff) {
+               *zbuff = z;
+               frame[0] = pix;
+               frame[1] = (pix >> 8);
+               frame[2] = (pix >> 16);
+            }
+            z += d;
+            if (e >= 0)
+               z += sz,  e -= dh;
+            ++zbuff,  frame += 3;
+            e += dz;
+         } while (++h < h2);
+         break;
+      case 4:
+         do {
+            if (z < *zbuff)
+               *zbuff = z,  *(long*)frame = pix;
+            z += d;
+            if (e >= 0)
+               z += sz,  e -= dh;
+            ++zbuff,  frame += 4;
+            e += dz;
+         } while (++h < h2);
+         break;
+      }
+   }
+}
+
+/*** Main entry point ***/
+int main(int ac, char *av[]) {
+   struct sockaddr_in addr;
+   struct hostent *hp;
+   XPixmapFormatValues *pmFormat;
+   long hor, sky, gnd, pix, v;
+   int n, i, x0, y0, z0, x1, y1, z1, x2, y2, z2;
+   char *frame;
+   edge *e;
+   long long t;
+   struct timeval tv;
+
+   if (ac != 3)
+      giveup("Use: <host> <port>");
+
+   /* Open Connection */
+   memset(&addr, 0, sizeof(addr));
+   if ((long)(addr.sin_addr.s_addr = inet_addr(av[1])) == -1) {
+      if (!(hp = gethostbyname(av[1]))  ||  hp->h_length == 0)
+         giveup("Can't get host");
+      addr.sin_addr.s_addr = ((struct in_addr*)hp->h_addr_list[0])->s_addr;
+   }
+   if ((Socket = socket(AF_INET, SOCK_STREAM, 0)) < 0)
+      giveup("Can't create socket");
+   addr.sin_family = AF_INET;
+   addr.sin_port = htons(atol(av[2]));
+   if (connect(Socket, (struct sockaddr*)&addr, sizeof(addr)) < 0)
+      giveup("Can't connect");
+
+   /* Open Display */
+   if ((Disp = XOpenDisplay(NULL)) == NULL)
+      giveup("Can't open Display");
+   Scrn = DefaultScreen(Disp);
+   Cmap = DefaultColormap(Disp,Scrn);
+   Dpth = PixSize = 0;
+   pmFormat = XListPixmapFormats(Disp, &n);
+   for (i = 0; i < n; i++) {
+      if (pmFormat[i].depth == 24) {
+         Dpth = 24;
+         if (PixSize != 4)
+            PixSize = (pmFormat[i].bits_per_pixel + 7) / 8 & ~8;
+      }
+      else if (pmFormat[i].depth == 16 && (PixSize < 3 || PixSize > 4)) {
+         Dpth = 16;
+         PixSize = (pmFormat[i].bits_per_pixel + 7) / 8 & ~8;
+      }
+      else if (pmFormat[i].depth == 8 && (PixSize < 2 || PixSize > 4)) {
+         Dpth = 8;
+         PixSize = (pmFormat[i].bits_per_pixel + 7) / 8 & ~8;
+      }
+   }
+   if (!Dpth)
+      giveup("Bad Display Depth");
+   Gc = XCreateGC(Disp,RootWindow(Disp,Scrn), 0, NULL);
+
+   OrgX = (SizX = getNum()) / 2;
+   OrgY = (SizY = getNum()) / 2;
+
+   /* Create Window */
+   Win = XCreateSimpleWindow(Disp, RootWindow(Disp,Scrn), 0, 0, SizX, SizY,
+                        1, BlackPixel(Disp,Scrn), WhitePixel(Disp,Scrn) );
+   XStoreName(Disp, Win, "PicoLisp z3d");
+   XSelectInput(Disp, Win,
+      ExposureMask |
+      KeyPressMask | KeyReleaseMask |
+      ButtonPressMask |
+      PointerMotionMask );
+   XMapWindow(Disp, Win);
+
+   /* Create Image */
+   SizX = SizX + 3 & ~3;
+   SizY = SizY + 3 & ~3;
+   Zbuff = alloc(SizX * SizY * sizeof(unsigned long));
+   Edges = alloc(SizY * sizeof(edge));
+   if (!XShmQueryExtension(Disp)  ||
+         !(Img = XShmCreateImage(Disp, DefaultVisual(Disp, Scrn),
+                  Dpth, ZPixmap, NULL, &Info, SizX, SizY ))  ||
+         (Info.shmid = shmget(IPC_PRIVATE,
+                  SizX * SizY * PixSize, IPC_CREAT | 0777 )) < 0  ||
+         (Info.shmaddr = Img->data =
+                           shmat(Info.shmid, 0, 0) ) == (char*)-1  ||
+         !XShmAttach(Disp, &Info) )
+      giveup("Can't create XImage");
+
+   /* Main loop */
+   for (;;) {
+      prLong('o');  // ok
+      hor = getNum() + OrgY;
+      sky = getColor(getNum());
+      gnd = getColor(getNum());
+      for (v = 0; v < SizY; ++v) {
+         pix  =  v < hor? sky : gnd;
+         frame = Img->data + v * SizX * PixSize;
+         switch (PixSize) {
+         case 1:
+            memset(frame, pix, SizX);
+            break;
+         case 2:
+            pix |= pix<<16;
+            i = 0;
+            do
+               *(long*)frame = pix,  frame += 4;
+            while ((i+=2) < SizX);
+            break;
+         case 3:
+            i = 0;
+            do {
+               frame[0] = pix;
+               frame[1] = (pix >> 8);
+               frame[2] = (pix >> 16);
+               frame += 3;
+            } while (++i < SizX);
+            break;
+         case 4:
+            i = 0;
+            do
+               *(long*)frame = pix,  frame += 4;
+            while (++i < SizX);
+            break;
+         }
+      }
+      memset(Zbuff, 0xFF, SizX * SizY * sizeof(unsigned long));
+
+      while (n = getNum()) {
+         memset(Edges, 0, SizY * sizeof(edge));
+         x0 = x1 = getNum();
+         y0 = y1 = getNum();
+         z0 = z1 = getNum();
+         skipStr();
+         for (;;) {
+            x2 = getNum();
+            y2 = getNum();
+            z2 = getNum();
+            mkEdge(x1, y1, z1, x2, y2, z2);
+            if (--n == 0)
+               break;
+            x1 = x2,  y1 = y2,  z1 = z2;
+         }
+         mkEdge(x2, y2, z2, x0, y0, z0);
+         i = 0,  e = Edges;
+         if ((pix = getNum()) < 0) {
+            do  // Transparent
+               if (e->h[1])
+                  zDots(i, e->h[0], e->h[1], e->z[0], e->z[1]);
+            while (++e, ++i < SizY);
+         }
+         else {
+            pix = getColor(pix);  // Face color
+            do
+               if (e->h[1])
+                  zLine(pix, i, e->h[0], e->h[1], e->z[0], e->z[1]);
+            while (++e, ++i < SizY);
+         }
+      }
+      if ((SnapX = getNum()) != 32767)
+         SnapY = getNum();
+      paint();
+      gettimeofday(&tv,NULL),  t = tv.tv_sec * 1000LL + tv.tv_usec / 1000;
+      if (Tim > t) {
+         tv.tv_sec = 0,  tv.tv_usec = (Tim - t) * 1000;
+         select(0, NULL, NULL, NULL, &tv);
+         t = Tim;
+      }
+      Tim = t + 40;
+   }
+}
diff --git a/src64/Makefile b/src64/Makefile
@@ -0,0 +1,65 @@
+# 03mar10abu
+# (c) Software Lab. Alexander Burger
+
+.SILENT:
+
+bin = ../bin
+lib = ../lib
+
+ifeq ($(shell uname), Linux)
+	OS = Linux
+	SYS = linux
+	ARCH = x86-64
+	LINK-FLAGS = -rdynamic -lc -lm -ldl
+	DYNAMIC-LIB-FLAGS = -shared -export-dynamic
+	STRIP = strip
+else
+ifeq ($(shell uname), Darwin)
+	OS = Darwin
+	SYS = darwin
+	ARCH = x86-64
+	export MACOSX_DEPLOYMENT_TARGET=10.4
+	LINK-FLAGS = -lc -lm -ldl
+	DYNAMIC-LIB-FLAGS = -dynamiclib -undefined dynamic_lookup -export-dynamic
+	STRIP = :
+endif
+endif
+
+baseFiles = version.l glob.l main.l sys/$(SYS).code.l \
+	gc.l apply.l flow.l sym.l subr.l big.l io.l db.l net.l err.l
+
+picolisp: $(bin)/picolisp $(lib)/ext $(lib)/ht
+
+all: picolisp
+
+$(bin)/picolisp: $(ARCH).$(SYS).base.o
+	mkdir -p $(bin) $(lib)
+	gcc -o $(bin)/picolisp $(LINK-FLAGS) $(ARCH).$(SYS).base.o
+	$(STRIP) $(bin)/picolisp
+
+$(lib)/ext: $(ARCH).$(SYS).ext.o
+	gcc -o $(lib)/ext $(DYNAMIC-LIB-FLAGS) $(ARCH).$(SYS).ext.o
+	$(STRIP) $(lib)/ext
+
+$(lib)/ht: $(ARCH).$(SYS).ht.o
+	gcc -o $(lib)/ht $(DYNAMIC-LIB-FLAGS) $(ARCH).$(SYS).ht.o
+	$(STRIP) $(lib)/ht
+
+.s.o:
+	as -o $*.o $*.s
+
+$(ARCH).$(SYS).base.s: $(baseFiles)
+	./mkAsm $(ARCH) $(SYS) $(OS) base $(lib)/tags $(baseFiles)
+
+$(ARCH).$(SYS).ext.s: ext.l
+	./mkAsm $(ARCH) $(SYS) $(OS) ext "" -fpic ext.l
+
+$(ARCH).$(SYS).ht.s: ht.l
+	./mkAsm $(ARCH) $(SYS) $(OS) ht "" -fpic ht.l
+
+
+# Clean up
+clean:
+	rm -f *.s *.o
+
+# vi:noet:ts=4:sw=4
diff --git a/src64/apply.l b/src64/apply.l
@@ -0,0 +1,1606 @@
+# 22sep09abu
+# (c) Software Lab. Alexander Burger
+
+(code 'applyXYZ_E 0)
+   ld C (Y)  # Get 'foo'
+   do
+      cnt C  # Short number?
+      if nz  # Yes
+         push (EnvApply)  # Build apply frame
+         link
+         sym S  # Align stack to cell boundary
+         if nz
+            push ZERO
+         end
+         push Nil  # Init CDR
+         push C  # 'fun'
+         ld E S  # 'exe in E
+         do
+            cmp Y Z  # Any args?
+         while ne  # Yes
+            sub Y I
+            push (Y)  # Next arg
+            push ZERO  # Dummy symbol's tail
+            push Nil  # Init CDR
+            lea A (S II)  # Value address
+            push A  # CAR
+            ld (S V) S  # Store CDR of previous cell
+         loop
+         link
+         ld (EnvApply) L  # Close apply frame
+         call (C)  # Eval SUBR
+         drop
+         pop (EnvApply)
+         ret
+      end
+      big C  # Undefined if bignum
+      jnz undefinedCX
+      atom C  # Cell?
+      if z  # Yes
+         # Apply EXPR
+         push X
+         ld X (C)  # Parameter list in X
+         push (EnvBind)  # Build bind frame
+         link
+         push (At)  # Bind At
+         push At
+         do
+            atom X  # More parameters?
+         while z  # Yes
+            ld E (X)  # Get symbol
+            ld X (X CDR)
+            push (E)  # Save old value
+            push E  # Save symbol
+            cmp Y Z  # More args?
+            if ne  # Yes
+               sub Y I
+               ld (E) (Y)  # Set new value to next arg
+            else
+               ld (E) Nil  # New value NIL
+            end
+         loop
+         cmp X Nil  # NIL-terminated parameter list?
+         if eq  # Yes
+            link
+            ld (EnvBind) L  # Close bind frame
+            push 0  # Init env swap
+            ld Z (C CDR)  # Body in Z
+            prog Z  # Run body
+            pop A  # Drop env swap
+            pop L  # Get link
+            do  # Unbind symbols
+               pop X  # Next symbol
+               pop (X)  # Restore value
+               cmp S L  # More?
+            until eq  # No
+            pop L  # Restore link
+            pop (EnvBind)  # Restore bind link
+            pop X
+            ret
+         end
+         # Non-NIL parameter
+         cmp X At  # '@'?
+         if ne  # No
+            push (X)  # Save last parameter's old value
+            push X  # and the last parameter
+            ld (X) Nil  # Set new value to NIL
+            link
+            ld (EnvBind) L  # Close bind frame
+            push 0  # Init env swap
+            ld Z (C CDR)  # Body in Z
+            prog Z  # Run body
+            pop A  # Drop env swap
+            pop L  # Get link
+            do  # Unbind symbols
+               pop X  # Next symbol
+               pop (X)  # Restore value
+               cmp S L  # More?
+            until eq  # No
+            pop L  # Restore link
+            pop (EnvBind)  # Restore bind link
+            pop X
+            ret
+         end
+         # Evaluated argument list
+         link
+         ld (EnvBind) L  # Close bind frame
+         push 0  # Init env swap
+         push (EnvNext)   # Save current 'next'
+         push (EnvArgs)  # and varArgs base
+         cmp Y Z  # Any args?
+         if eq  # No
+            ld (EnvArgs) 0
+            ld (EnvNext) 0
+         else
+            link  # Build varArgs frame
+            do
+               sub Y I
+               push (Y)  # Push next argument
+               cmp Y Z   # More args?
+            until eq  # No
+            ld (EnvArgs) S  # Set new varArgs base
+            ld (EnvNext) L  # Set new 'next'
+            link  # Close varArgs frame
+         end
+         ld Z (C CDR)  # Body in Z
+         prog Z  # Run body
+         null (EnvNext)  # VarArgs?
+         if nz  # Yes
+            drop  # Drop varArgs
+         end
+         pop (EnvArgs)  # Restore varArgs base
+         pop (EnvNext)   # and 'next'
+         pop A  # Drop env swap
+         pop L  # Get link
+         do  # Unbind symbols
+            pop X  # Next symbol
+            pop (X)  # Restore value
+            cmp S L  # More?
+         until eq  # No
+         pop L  # Restore link
+         pop (EnvBind)  # Restore bind link
+         pop X
+         ret
+      end
+      ld A (C)  # Else symbolic, get value
+      cmp A doMeth  # Method?
+      if eq  # Yes
+         sub Y I  # First arg
+         ld E (Y)  # Get object
+         num E  # Need symbol
+         jnz symErrEX
+         sym E
+         jz symErrEX
+         sym (E TAIL)  # External symbol?
+         if nz  # Yes
+            call dbFetchEX  # Fetch it
+         end
+         push X
+         push Z  # Save arg pointers
+         push Y
+         ld Y C  # 'msg'
+         ld Z Nil  # No classes
+         call methodEY_FCYZ  # Found?
+         jne msgErrYX  # No
+         xchg Z (S I)  # 'cls'
+         xchg Y (S)  # 'key'
+         push (EnvMeth)  # Method frame
+         ld (EnvMeth) S
+         ld X (C)  # Parameter list in X
+         push (EnvBind)  # Build bind frame
+         link
+         push (At)  # Bind At
+         push At
+         push (This)  # Bind This
+         push This
+         ld (This) (Y)  # to object
+         do
+            atom X  # More parameters?
+         while z  # Yes
+            ld E (X)  # Get symbol
+            ld X (X CDR)
+            push (E)  # Save old value
+            push E  # Save symbol
+            cmp Y Z  # More args?
+            if ne  # Yes
+               sub Y I
+               ld (E) (Y)  # Set new value to next arg
+            else
+               ld (E) Nil  # New value NIL
+            end
+         loop
+         cmp X Nil  # NIL-terminated parameter list?
+         if eq  # Yes
+            link
+            ld (EnvBind) L  # Close bind frame
+            push 0  # Init env swap
+            ld Z (C CDR)  # Body in Z
+            prog Z  # Run body
+            pop A  # Drop env swap
+            pop L  # Get link
+            do  # Unbind symbols
+               pop X  # Next symbol
+               pop (X)  # Restore value
+               cmp S L  # More?
+            until eq  # No
+            pop L  # Restore link
+            pop (EnvBind)  # Restore bind link
+            pop (EnvMeth)  # and method link
+            pop A  # Drop frame
+            pop A
+            pop X
+            ret
+         end
+         # Non-NIL parameter
+         cmp X At  # '@'?
+         if ne  # No
+            push (X)  # Save last parameter's old value
+            push X  # and the last parameter
+            ld (X) Nil  # Set new value to NIL
+            link
+            ld (EnvBind) L  # Close bind frame
+            push 0  # Init env swap
+            ld Z (C CDR)  # Body in Z
+            prog Z  # Run body
+            pop A  # Drop env swap
+            pop L  # Get link
+            do  # Unbind symbols
+               pop X  # Next symbol
+               pop (X)  # Restore value
+               cmp S L  # More?
+            until eq  # No
+            pop L  # Restore link
+            pop (EnvBind)  # Restore bind link
+            pop (EnvMeth)  # and method link
+            pop A  # Drop frame
+            pop A
+            pop X
+            ret
+         end
+         # Evaluated argument list
+         link
+         ld (EnvBind) L  # Close bind frame
+         push 0  # Init env swap
+         push (EnvNext)   # Save current 'next'
+         push (EnvArgs)  # and varArgs base
+         cmp Y Z  # Any args?
+         if eq  # No
+            ld (EnvArgs) 0
+            ld (EnvNext) 0
+         else
+            link  # Build varArgs frame
+            do
+               sub Y I
+               push (Y)  # Push next argument
+               cmp Y Z   # More args?
+            until eq  # No
+            ld (EnvArgs) S  # Set new varArgs base
+            ld (EnvNext) L  # Set new 'next'
+            link  # Close varArgs frame
+         end
+         ld Z (C CDR)  # Body in Z
+         prog Z  # Run body
+         null (EnvNext)  # VarArgs?
+         if nz  # Yes
+            drop  # Drop varArgs
+         end
+         pop (EnvArgs)  # Restore varArgs base
+         pop (EnvNext)   # and 'next'
+         pop A  # Drop env swap
+         pop L  # Get link
+         do  # Unbind symbols
+            pop X  # Next symbol
+            pop (X)  # Restore value
+            cmp S L  # More?
+         until eq  # No
+         pop L  # Restore link
+         pop (EnvBind)  # Restore bind link
+         pop (EnvMeth)  # and method link
+         pop A  # Drop frame
+         pop A
+         pop X
+         ret
+      end
+      cmp A (A)  # Auto-symbol?
+      if eq  # Yes
+         call sharedLibC_FA  # Try dynamic load
+         jz undefinedCX
+      end
+      ld C A
+   loop
+
+(code 'applyVarXYZ_E 0)
+   ld C (Y)  # Get 'foo'
+   do
+      cnt C  # Short number?
+      if nz  # Yes
+         push (EnvApply)  # Build apply frame
+         link
+         sym S  # Align stack to cell boundary
+         if nz
+            push ZERO
+         end
+         push Nil  # Init CDR
+         push C  # 'fun'
+         ld E S  # 'exe in E
+         do
+            cmp Y Z  # Any args?
+         while ne  # Yes
+            sub Y I
+            push ((Y))  # CAR of next arg
+            push ZERO  # Dummy symbol's tail
+            push Nil  # Init CDR
+            lea A (S II)  # Value address
+            push A  # CAR
+            ld (S V) S  # Store CDR of previous cell
+         loop
+         link
+         ld (EnvApply) L  # Close apply frame
+         call (C)  # Eval SUBR
+         drop
+         pop (EnvApply)
+         ret
+      end
+      big C  # Undefined if bignum
+      jnz undefinedCX
+      atom C  # Cell?
+      if z  # Yes
+         # Apply EXPR
+         push X
+         ld X (C)  # Parameter list in X
+         push (EnvBind)  # Build bind frame
+         link
+         push (At)  # Bind At
+         push At
+         do
+            atom X  # More parameters?
+         while z  # Yes
+            ld E (X)  # Get symbol
+            ld X (X CDR)
+            push (E)  # Save old value
+            push E  # Save symbol
+            cmp Y Z  # More args?
+            if ne  # Yes
+               sub Y I
+               ld (E) ((Y))  # Set new value to CAR of next arg
+            else
+               ld (E) Nil  # New value NIL
+            end
+         loop
+         cmp X Nil  # NIL-terminated parameter list?
+         if eq  # Yes
+            link
+            ld (EnvBind) L  # Close bind frame
+            push 0  # Init env swap
+            ld Z (C CDR)  # Body in Z
+            prog Z  # Run body
+            pop A  # Drop env swap
+            pop L  # Get link
+            do  # Unbind symbols
+               pop X  # Next symbol
+               pop (X)  # Restore value
+               cmp S L  # More?
+            until eq  # No
+            pop L  # Restore link
+            pop (EnvBind)  # Restore bind link
+            pop X
+            ret
+         end
+         # Non-NIL parameter
+         cmp X At  # '@'?
+         if ne  # No
+            push (X)  # Save last parameter's old value
+            push X  # and the last parameter
+            ld (X) Nil  # Set new value to NIL
+            link
+            ld (EnvBind) L  # Close bind frame
+            push 0  # Init env swap
+            ld Z (C CDR)  # Body in Z
+            prog Z  # Run body
+            pop A  # Drop env swap
+            pop L  # Get link
+            do  # Unbind symbols
+               pop X  # Next symbol
+               pop (X)  # Restore value
+               cmp S L  # More?
+            until eq  # No
+            pop L  # Restore link
+            pop (EnvBind)  # Restore bind link
+            pop X
+            ret
+         end
+         # Evaluated argument list
+         link
+         ld (EnvBind) L  # Close bind frame
+         push 0  # Init env swap
+         push (EnvNext)   # Save current 'next'
+         push (EnvArgs)  # and varArgs base
+         cmp Y Z  # Any args?
+         if eq  # No
+            ld (EnvArgs) 0
+            ld (EnvNext) 0
+         else
+            link  # Build varArgs frame
+            do
+               sub Y I
+               push ((Y))  # Push CAR of next argument
+               cmp Y Z   # More args?
+            until eq  # No
+            ld (EnvArgs) S  # Set new varArgs base
+            ld (EnvNext) L  # Set new 'next'
+            link  # Close varArgs frame
+         end
+         ld Z (C CDR)  # Body in Z
+         prog Z  # Run body
+         null (EnvNext)  # VarArgs?
+         if nz  # Yes
+            drop  # Drop varArgs
+         end
+         pop (EnvArgs)  # Restore varArgs base
+         pop (EnvNext)   # and 'next'
+         pop A  # Drop env swap
+         pop L  # Get link
+         do  # Unbind symbols
+            pop X  # Next symbol
+            pop (X)  # Restore value
+            cmp S L  # More?
+         until eq  # No
+         pop L  # Restore link
+         pop (EnvBind)  # Restore bind link
+         pop X
+         ret
+      end
+      ld A (C)  # Else symbolic, get value
+      cmp A doMeth  # Method?
+      if eq  # Yes
+         sub Y I  # First arg
+         ld E ((Y))  # Get object
+         num E  # Need symbol
+         jnz symErrEX
+         sym E
+         jz symErrEX
+         sym (E TAIL)  # External symbol?
+         if nz  # Yes
+            call dbFetchEX  # Fetch it
+         end
+         push X
+         push Z  # Save arg pointers
+         push Y
+         ld Y C  # 'msg'
+         ld Z Nil  # No classes
+         call methodEY_FCYZ  # Found?
+         jne msgErrYX  # No
+         xchg Z (S I)  # 'cls'
+         xchg Y (S)  # 'key'
+         push (EnvMeth)  # Method frame
+         ld (EnvMeth) S
+         ld X (C)  # Parameter list in X
+         push (EnvBind)  # Build bind frame
+         link
+         push (At)  # Bind At
+         push At
+         push (This)  # Bind This
+         push This
+         ld (This) ((Y))  # to object
+         do
+            atom X  # More parameters?
+         while z  # Yes
+            ld E (X)  # Get symbol
+            ld X (X CDR)
+            push (E)  # Save old value
+            push E  # Save symbol
+            cmp Y Z  # More args?
+            if ne  # Yes
+               sub Y I
+               ld (E) ((Y))  # Set new value to CAR of next arg
+            else
+               ld (E) Nil  # New value NIL
+            end
+         loop
+         cmp X Nil  # NIL-terminated parameter list?
+         if eq  # Yes
+            link
+            ld (EnvBind) L  # Close bind frame
+            push 0  # Init env swap
+            ld Z (C CDR)  # Body in Z
+            prog Z  # Run body
+            pop A  # Drop env swap
+            pop L  # Get link
+            do  # Unbind symbols
+               pop X  # Next symbol
+               pop (X)  # Restore value
+               cmp S L  # More?
+            until eq  # No
+            pop L  # Restore link
+            pop (EnvBind)  # Restore bind link
+            pop (EnvMeth)  # and method link
+            pop A  # Drop frame
+            pop A
+            pop X
+            ret
+         end
+         # Non-NIL parameter
+         cmp X At  # '@'?
+         if ne  # No
+            push (X)  # Save last parameter's old value
+            push X  # and the last parameter
+            ld (X) Nil  # Set new value to NIL
+            link
+            ld (EnvBind) L  # Close bind frame
+            push 0  # Init env swap
+            ld Z (C CDR)  # Body in Z
+            prog Z  # Run body
+            pop A  # Drop env swap
+            pop L  # Get link
+            do  # Unbind symbols
+               pop X  # Next symbol
+               pop (X)  # Restore value
+               cmp S L  # More?
+            until eq  # No
+            pop L  # Restore link
+            pop (EnvBind)  # Restore bind link
+            pop (EnvMeth)  # and method link
+            pop A  # Drop frame
+            pop A
+            pop X
+            ret
+         end
+         # Evaluated argument list
+         link
+         ld (EnvBind) L  # Close bind frame
+         push 0  # Init env swap
+         push (EnvNext)   # Save current 'next'
+         push (EnvArgs)  # and varArgs base
+         cmp Y Z  # Any args?
+         if eq  # No
+            ld (EnvArgs) 0
+            ld (EnvNext) 0
+         else
+            link  # Build varArgs frame
+            do
+               sub Y I
+               push ((Y))  # Push CAR of next argument
+               cmp Y Z   # More args?
+            until eq  # No
+            ld (EnvArgs) S  # Set new varArgs base
+            ld (EnvNext) L  # Set new 'next'
+            link  # Close varArgs frame
+         end
+         ld Z (C CDR)  # Body in Z
+         prog Z  # Run body
+         null (EnvNext)  # VarArgs?
+         if nz  # Yes
+            drop  # Drop varArgs
+         end
+         pop (EnvArgs)  # Restore varArgs base
+         pop (EnvNext)   # and 'next'
+         pop A  # Drop env swap
+         pop L  # Get link
+         do  # Unbind symbols
+            pop X  # Next symbol
+            pop (X)  # Restore value
+            cmp S L  # More?
+         until eq  # No
+         pop L  # Restore link
+         pop (EnvBind)  # Restore bind link
+         pop (EnvMeth)  # and method link
+         pop A  # Drop frame
+         pop A
+         pop X
+         ret
+      end
+      cmp A (A)  # Auto-symbol?
+      if eq  # Yes
+         call sharedLibC_FA  # Try dynamic load
+         jz undefinedCX
+      end
+      ld C A
+   loop
+
+# (apply 'fun 'lst ['any ..]) -> any
+(code 'doApply 2)
+   push X
+   push Y
+   push Z
+   ld X E  # Keep expression in X
+   ld Z (E CDR)  # Z on args
+   ld E (Z)
+   eval  # Eval 'fun'
+   link
+   push E
+   ld Y S  # Pointer to 'fun' in Y
+   ld Z (Z CDR)  # Second arg
+   ld E (Z)
+   eval+  # Eval 'lst'
+   do
+      ld Z (Z CDR)  # Args
+      atom Z  # More?
+   while z  # Yes
+      push E  # Save 'lst'
+      ld E (Z)
+      eval+  # Eval next arg
+      xchg E (S)  # Keep 'lst' in E
+   loop
+   do
+      atom E  # Expand 'lst'
+   while z
+      push (E)
+      ld E (E CDR)
+   loop
+   ld Z S  # Z on last argument
+   link  # Close frame
+   call applyXYZ_E  # Apply
+   drop
+   pop Z
+   pop Y
+   pop X
+   ret
+
+# (pass 'fun ['any ..]) -> any
+(code 'doPass 2)
+   push X
+   push Y
+   push Z
+   ld X E  # Keep expression in X
+   ld Z (E CDR)  # Z on args
+   ld E (Z)
+   eval  # Eval 'fun'
+   link
+   push E  # Push 'fun'
+   ld Y S  # Pointer to 'fun' in Y
+   do  # 'any' args
+      ld Z (Z CDR)  # Any?
+      atom Z
+   while z  # Yes
+      ld E (Z)
+      eval+  # Eval next 'lst'
+      push E
+   loop
+   ld C (EnvNext)  # VarArgs
+   do
+      cmp C (EnvArgs)  # Any?
+   while ne  # Yes
+      sub C I
+      push (C)  # Next arg
+   loop
+   ld Z S  # Z on last argument
+   link  # Close frame
+   call applyXYZ_E  # Apply
+   drop
+   pop Z
+   pop Y
+   pop X
+   ret
+
+# (maps 'fun 'sym ['lst ..]) -> any
+(code 'doMaps 2)
+   push X
+   push Y
+   push Z
+   ld X E  # Keep expression in X
+   ld Z (E CDR)  # Z on args
+   ld E (Z)
+   ld Z (Z CDR)
+   eval  # Eval 'fun'
+   link
+   push E  # Save 'fun'
+   ld Y S  # Pointer to 'fun' in Y
+   ld E (Z)
+   ld Z (Z CDR)
+   eval+  # Eval 'sym'
+   push E  # <Y -I> 'sym'
+   do  # 'lst' args
+      atom Z  # More 'lst' args?
+   while z  # Yes
+      ld E (Z)
+      eval+  # Eval next 'lst'
+      push E
+      ld Z (Z CDR)
+   loop
+   link  # <L I> Last argument
+   ld E (Y -I)  # Get 'sym'
+   num E  # Need symbol
+   jnz symErrEX
+   sym E
+   jz symErrEX
+   sym (E TAIL)  # External symbol?
+   if nz  # Yes
+      call dbFetchEX  # Fetch it
+   end
+   ld E (E TAIL)  # Get property list
+   off E SYM  # Clear 'extern' tag
+   ld (Y -I) E
+   ld E Nil  # Preset return value
+   do
+      atom (Y -I)  # First 'lst' done?
+   while z  # No
+      push Y
+      lea Z (L I)  # Last arg
+      call applyVarXYZ_E  # Apply
+      pop Y
+      lea Z (L I)  # Last arg
+      do
+         ld (Z) ((Z) CDR)  # Pop all lists
+         add Z I
+         cmp Z Y  # Reached 'fun'?
+      until eq  # Yes
+   loop
+   drop
+   pop Z
+   pop Y
+   pop X
+   ret
+
+# (map 'fun 'lst ..) -> lst
+(code 'doMap 2)
+   push X
+   push Y
+   push Z
+   ld X E  # Keep expression in X
+   ld Z (E CDR)  # Z on args
+   ld E (Z)
+   ld Z (Z CDR)
+   eval  # Eval 'fun'
+   link
+   push E  # Push 'fun'
+   ld Y S  # Pointer to 'fun' in Y
+   do  # 'lst' args
+      ld E (Z)
+      eval+  # Eval next 'lst'
+      push E
+      ld Z (Z CDR)
+      atom Z  # More 'lst' args?
+   until nz  # No
+   link  # <L I> Last argument
+   ld E Nil  # Preset return value
+   do
+      atom (Y -I)  # First 'lst' done?
+   while z  # No
+      push Y
+      lea Z (L I)  # Last arg
+      call applyXYZ_E  # Apply
+      pop Y
+      lea Z (L I)  # Last arg
+      do
+         ld (Z) ((Z) CDR)  # Pop all lists
+         add Z I
+         cmp Z Y  # Reached 'fun'?
+      until eq  # Yes
+   loop
+   drop
+   pop Z
+   pop Y
+   pop X
+   ret
+
+# (mapc 'fun 'lst ..) -> lst
+(code 'doMapc 2)
+   push X
+   push Y
+   push Z
+   ld X E  # Keep expression in X
+   ld Z (E CDR)  # Z on args
+   ld E (Z)
+   ld Z (Z CDR)
+   eval  # Eval 'fun'
+   link
+   push E  # Push 'fun'
+   ld Y S  # Pointer to 'fun' in Y
+   do  # 'lst' args
+      ld E (Z)
+      eval+  # Eval next 'lst'
+      push E
+      ld Z (Z CDR)
+      atom Z  # More 'lst' args?
+   until nz  # No
+   link  # <L I> Last argument
+   ld E Nil  # Preset return value
+   do
+      atom (Y -I)  # First 'lst' done?
+   while z  # No
+      push Y
+      lea Z (L I)  # Last arg
+      call applyVarXYZ_E  # Apply
+      pop Y
+      lea Z (L I)  # Last arg
+      do
+         ld (Z) ((Z) CDR)  # Pop all lists
+         add Z I
+         cmp Z Y  # Reached 'fun'?
+      until eq  # Yes
+   loop
+   drop
+   pop Z
+   pop Y
+   pop X
+   ret
+
+# (maplist 'fun 'lst ..) -> lst
+(code 'doMaplist 2)
+   push X
+   push Y
+   push Z
+   ld X E  # Keep expression in X
+   ld Z (E CDR)  # Z on args
+   ld E (Z)
+   ld Z (Z CDR)
+   eval  # Eval 'fun'
+   link
+   push E  # Push 'fun'
+   ld Y S  # Pointer to 'fun' in Y
+   do  # 'lst' args
+      ld E (Z)
+      eval+  # Eval next 'lst'
+      push E
+      ld Z (Z CDR)
+      atom Z  # More 'lst' args?
+   until nz  # No
+   push Nil  # <L I> Result
+   link  # <L II> Last argument
+   push 0  # <L -I> Result tail
+   do
+      atom (Y -I)  # First 'lst' done?
+   while z  # No
+      push Y
+      lea Z (L II)  # Last arg
+      call applyXYZ_E  # Apply
+      pop Y
+      call consE_C  # Cons with NIL
+      ld (C) E
+      ld (C CDR) Nil
+      null (L -I)  # Result tail?
+      if z  # No
+         ld (L I) C  # Store result
+      else
+         ld ((L -I) CDR) C  # Set new CDR of result tail
+      end
+      ld (L -I) C  # Store result tail
+      lea Z (L II)  # Last arg
+      do
+         ld (Z) ((Z) CDR)  # Pop all lists
+         add Z I
+         cmp Z Y  # Reached 'fun'?
+      until eq  # Yes
+   loop
+   ld E (L I)  # Result
+   drop
+   pop Z
+   pop Y
+   pop X
+   ret
+
+# (mapcar 'fun 'lst ..) -> lst
+(code 'doMapcar 2)
+   push X
+   push Y
+   push Z
+   ld X E  # Keep expression in X
+   ld Z (E CDR)  # Z on args
+   ld E (Z)
+   ld Z (Z CDR)
+   eval  # Eval 'fun'
+   link
+   push E  # Push 'fun'
+   ld Y S  # Pointer to 'fun' in Y
+   do  # 'lst' args
+      ld E (Z)
+      eval+  # Eval next 'lst'
+      push E
+      ld Z (Z CDR)
+      atom Z  # More 'lst' args?
+   until nz  # No
+   push Nil  # <L I> Result
+   link  # <L II> Last argument
+   push 0  # <L -I> Result tail
+   do
+      atom (Y -I)  # First 'lst' done?
+   while z  # No
+      push Y
+      lea Z (L II)  # Last arg
+      call applyVarXYZ_E  # Apply
+      pop Y
+      call consE_C  # Cons with NIL
+      ld (C) E
+      ld (C CDR) Nil
+      null (L -I)  # Result tail?
+      if z  # No
+         ld (L I) C  # Store result
+      else
+         ld ((L -I) CDR) C  # Set new CDR of result tail
+      end
+      ld (L -I) C  # Store result tail
+      lea Z (L II)  # Last arg
+      do
+         ld (Z) ((Z) CDR)  # Pop all lists
+         add Z I
+         cmp Z Y  # Reached 'fun'?
+      until eq  # Yes
+   loop
+   ld E (L I)  # Result
+   drop
+   pop Z
+   pop Y
+   pop X
+   ret
+
+# (mapcon 'fun 'lst ..) -> lst
+(code 'doMapcon 2)
+   push X
+   push Y
+   push Z
+   ld X E  # Keep expression in X
+   ld Z (E CDR)  # Z on args
+   ld E (Z)
+   ld Z (Z CDR)
+   eval  # Eval 'fun'
+   link
+   push E  # Push 'fun'
+   ld Y S  # Pointer to 'fun' in Y
+   do  # 'lst' args
+      ld E (Z)
+      eval+  # Eval next 'lst'
+      push E
+      ld Z (Z CDR)
+      atom Z  # More 'lst' args?
+   until nz  # No
+   push Nil  # <L I> Result
+   link  # <L II> Last argument
+   push 0  # <L -I> Result tail
+   do
+      atom (Y -I)  # First 'lst' done?
+   while z  # No
+      push Y
+      lea Z (L II)  # Last arg
+      call applyXYZ_E  # Apply
+      pop Y
+      atom E  # Got cell?
+      if z  # Yes
+         null (L -I)  # Result tail?
+         if z  # No
+            ld (L I) E  # Store result
+         else
+            ld A (L -I)  # Else get result tail
+            do
+               atom (A CDR)  # Find last cell
+            while z
+               ld A (A CDR)
+            loop
+            ld (A CDR) E  # Set new CDR
+         end
+         ld (L -I) E  # Store result tail
+      end
+      lea Z (L II)  # Last arg
+      do
+         ld (Z) ((Z) CDR)  # Pop all lists
+         add Z I
+         cmp Z Y  # Reached 'fun'?
+      until eq  # Yes
+   loop
+   ld E (L I)  # Result
+   drop
+   pop Z
+   pop Y
+   pop X
+   ret
+
+# (mapcan 'fun 'lst ..) -> lst
+(code 'doMapcan 2)
+   push X
+   push Y
+   push Z
+   ld X E  # Keep expression in X
+   ld Z (E CDR)  # Z on args
+   ld E (Z)
+   ld Z (Z CDR)
+   eval  # Eval 'fun'
+   link
+   push E  # Push 'fun'
+   ld Y S  # Pointer to 'fun' in Y
+   do  # 'lst' args
+      ld E (Z)
+      eval+  # Eval next 'lst'
+      push E
+      ld Z (Z CDR)
+      atom Z  # More 'lst' args?
+   until nz  # No
+   push Nil  # <L I> Result
+   link  # <L II> Last argument
+   push 0  # <L -I> Result tail
+   do
+      atom (Y -I)  # First 'lst' done?
+   while z  # No
+      push Y
+      lea Z (L II)  # Last arg
+      call applyVarXYZ_E  # Apply
+      pop Y
+      atom E  # Got cell?
+      if z  # Yes
+         null (L -I)  # Result tail?
+         if z  # No
+            ld (L I) E  # Store result
+         else
+            ld A (L -I)  # Else get result tail
+            do
+               atom (A CDR)  # Find last cell
+            while z
+               ld A (A CDR)
+            loop
+            ld (A CDR) E  # Set new CDR
+         end
+         ld (L -I) E  # Store result tail
+      end
+      lea Z (L II)  # Last arg
+      do
+         ld (Z) ((Z) CDR)  # Pop all lists
+         add Z I
+         cmp Z Y  # Reached 'fun'?
+      until eq  # Yes
+   loop
+   ld E (L I)  # Result
+   drop
+   pop Z
+   pop Y
+   pop X
+   ret
+
+# (filter 'fun 'lst ..) -> lst
+(code 'doFilter 2)
+   push X
+   push Y
+   push Z
+   ld X E  # Keep expression in X
+   ld Z (E CDR)  # Z on args
+   ld E (Z)
+   ld Z (Z CDR)
+   eval  # Eval 'fun'
+   link
+   push E  # Push 'fun'
+   ld Y S  # Pointer to 'fun' in Y
+   do  # 'lst' args
+      ld E (Z)
+      eval+  # Eval next 'lst'
+      push E
+      ld Z (Z CDR)
+      atom Z  # More 'lst' args?
+   until nz  # No
+   push Nil  # <L I> Result
+   link  # <L II> Last argument
+   push 0  # <L -I> Result tail
+   do
+      atom (Y -I)  # First 'lst' done?
+   while z  # No
+      push Y
+      lea Z (L II)  # Last arg
+      call applyVarXYZ_E  # Apply
+      pop Y
+      cmp E Nil  # NIL?
+      if ne  # No
+         call consE_C  # Cons with NIL
+         ld (C) ((Y -I))  # Element of first 'lst'
+         ld (C CDR) Nil
+         null (L -I)  # Result tail?
+         if z  # No
+            ld (L I) C  # Store result
+         else
+            ld ((L -I) CDR) C  # Set new CDR of result tail
+         end
+         ld (L -I) C  # Store result tail
+      end
+      lea Z (L II)  # Last arg
+      do
+         ld (Z) ((Z) CDR)  # Pop all lists
+         add Z I
+         cmp Z Y  # Reached 'fun'?
+      until eq  # Yes
+   loop
+   ld E (L I)  # Result
+   drop
+   pop Z
+   pop Y
+   pop X
+   ret
+
+# (extract 'fun 'lst ..) -> lst
+(code 'doExtract 2)
+   push X
+   push Y
+   push Z
+   ld X E  # Keep expression in X
+   ld Z (E CDR)  # Z on args
+   ld E (Z)
+   ld Z (Z CDR)
+   eval  # Eval 'fun'
+   link
+   push E  # Push 'fun'
+   ld Y S  # Pointer to 'fun' in Y
+   do  # 'lst' args
+      ld E (Z)
+      eval+  # Eval next 'lst'
+      push E
+      ld Z (Z CDR)
+      atom Z  # More 'lst' args?
+   until nz  # No
+   push Nil  # <L I> Result
+   link  # <L II> Last argument
+   push 0  # <L -I> Result tail
+   do
+      atom (Y -I)  # First 'lst' done?
+   while z  # No
+      push Y
+      lea Z (L II)  # Last arg
+      call applyVarXYZ_E  # Apply
+      pop Y
+      cmp E Nil  # NIL?
+      if ne  # No
+         call consE_C  # Cons with NIL
+         ld (C) E
+         ld (C CDR) Nil
+         null (L -I)  # Result tail?
+         if z  # No
+            ld (L I) C  # Store result
+         else
+            ld ((L -I) CDR) C  # Set new CDR of result tail
+         end
+         ld (L -I) C  # Store result tail
+      end
+      lea Z (L II)  # Last arg
+      do
+         ld (Z) ((Z) CDR)  # Pop all lists
+         add Z I
+         cmp Z Y  # Reached 'fun'?
+      until eq  # Yes
+   loop
+   ld E (L I)  # Result
+   drop
+   pop Z
+   pop Y
+   pop X
+   ret
+
+# (seek 'fun 'lst ..) -> lst
+(code 'doSeek 2)
+   push X
+   push Y
+   push Z
+   ld X E  # Keep expression in X
+   ld Z (E CDR)  # Z on args
+   ld E (Z)
+   ld Z (Z CDR)
+   eval  # Eval 'fun'
+   link
+   push E  # Push 'fun'
+   ld Y S  # Pointer to 'fun' in Y
+   do  # 'lst' args
+      ld E (Z)
+      eval+  # Eval next 'lst'
+      push E
+      ld Z (Z CDR)
+      atom Z  # More 'lst' args?
+   until nz  # No
+   link  # <L I> Last argument
+   ld E Nil  # Preset return value
+   do
+      atom (Y -I)  # First 'lst' done?
+   while z  # No
+      push Y
+      lea Z (L I)  # Last arg
+      call applyXYZ_E  # Apply
+      pop Y
+      cmp E Nil  # NIL?
+      if ne  # No
+         ld E (Y -I)  # Return first 'lst'
+         break T
+      end
+      lea Z (L I)  # Last arg
+      do
+         ld (Z) ((Z) CDR)  # Pop all lists
+         add Z I
+         cmp Z Y  # Reached 'fun'?
+      until eq  # Yes
+   loop
+   drop
+   pop Z
+   pop Y
+   pop X
+   ret
+
+# (find 'fun 'lst ..) -> any
+(code 'doFind 2)
+   push X
+   push Y
+   push Z
+   ld X E  # Keep expression in X
+   ld Z (E CDR)  # Z on args
+   ld E (Z)
+   ld Z (Z CDR)
+   eval  # Eval 'fun'
+   link
+   push E  # Push 'fun'
+   ld Y S  # Pointer to 'fun' in Y
+   do  # 'lst' args
+      ld E (Z)
+      eval+  # Eval next 'lst'
+      push E
+      ld Z (Z CDR)
+      atom Z  # More 'lst' args?
+   until nz  # No
+   link  # <L I> Last argument
+   ld E Nil  # Preset return value
+   do
+      atom (Y -I)  # First 'lst' done?
+   while z  # No
+      push Y
+      lea Z (L I)  # Last arg
+      call applyVarXYZ_E  # Apply
+      pop Y
+      cmp E Nil  # NIL?
+      if ne  # No
+         ld E ((Y -I))  # Return CAR of first 'lst'
+         break T
+      end
+      lea Z (L I)  # Last arg
+      do
+         ld (Z) ((Z) CDR)  # Pop all lists
+         add Z I
+         cmp Z Y  # Reached 'fun'?
+      until eq  # Yes
+   loop
+   drop
+   pop Z
+   pop Y
+   pop X
+   ret
+
+# (pick 'fun 'lst ..) -> any
+(code 'doPick 2)
+   push X
+   push Y
+   push Z
+   ld X E  # Keep expression in X
+   ld Z (E CDR)  # Z on args
+   ld E (Z)
+   ld Z (Z CDR)
+   eval  # Eval 'fun'
+   link
+   push E  # Push 'fun'
+   ld Y S  # Pointer to 'fun' in Y
+   do  # 'lst' args
+      ld E (Z)
+      eval+  # Eval next 'lst'
+      push E
+      ld Z (Z CDR)
+      atom Z  # More 'lst' args?
+   until nz  # No
+   link  # <L I> Last argument
+   ld E Nil  # Preset return value
+   do
+      atom (Y -I)  # First 'lst' done?
+   while z  # No
+      push Y
+      lea Z (L I)  # Last arg
+      call applyVarXYZ_E  # Apply
+      pop Y
+      cmp E Nil  # NIL?
+      break ne  # No
+      lea Z (L I)  # Last arg
+      do
+         ld (Z) ((Z) CDR)  # Pop all lists
+         add Z I
+         cmp Z Y  # Reached 'fun'?
+      until eq  # Yes
+   loop
+   drop
+   pop Z
+   pop Y
+   pop X
+   ret
+
+# (cnt 'fun 'lst ..) -> cnt
+(code 'doCnt 2)
+   push X
+   push Y
+   push Z
+   ld X E  # Keep expression in X
+   ld Z (E CDR)  # Z on args
+   ld E (Z)
+   ld Z (Z CDR)
+   eval  # Eval 'fun'
+   link
+   push E  # Push 'fun'
+   ld Y S  # Pointer to 'fun' in Y
+   do  # 'lst' args
+      ld E (Z)
+      eval+  # Eval next 'lst'
+      push E
+      ld Z (Z CDR)
+      atom Z  # More 'lst' args?
+   until nz  # No
+   link  # <L I> Last argument
+   push ZERO  # <L -I> Result
+   do
+      atom (Y -I)  # First 'lst' done?
+   while z  # No
+      push Y
+      lea Z (L I)  # Last arg
+      call applyVarXYZ_E  # Apply
+      pop Y
+      cmp E Nil  # NIL?
+      if ne  # No
+         add (S) (hex "10")  # Increment count
+      end
+      lea Z (L I)  # Last arg
+      do
+         ld (Z) ((Z) CDR)  # Pop all lists
+         add Z I
+         cmp Z Y  # Reached 'fun'?
+      until eq  # Yes
+   loop
+   pop E  # Get result
+   drop
+   pop Z
+   pop Y
+   pop X
+   ret
+
+# (sum 'fun 'lst ..) -> num
+(code 'doSum 2)
+   push X
+   push Y
+   push Z
+   ld X E  # Keep expression in X
+   ld Z (E CDR)  # Z on args
+   ld E (Z)
+   ld Z (Z CDR)
+   eval  # Eval 'fun'
+   link
+   push E  # Push 'fun'
+   ld Y S  # Pointer to 'fun' in Y
+   do  # 'lst' args
+      ld E (Z)
+      eval+  # Eval next 'lst'
+      push E
+      ld Z (Z CDR)
+      atom Z  # More 'lst' args?
+   until nz  # No
+   push ZERO  # <L II> Safe
+   push ZERO  # <L I> Result
+   link  # <L III> Last argument
+   do
+      atom (Y -I)  # First 'lst' done?
+   while z  # No
+      push Y
+      lea Z (L III)  # Last arg
+      call applyVarXYZ_E  # Apply
+      pop Y
+      num E  # Number?
+      if nz  # Yes
+         ld (L II) E  # Save
+         ld A (L I)  # Result so far
+         call addAE_A  # Add
+         ld (L I) A  # Result
+      end
+      lea Z (L III)  # Last arg
+      do
+         ld (Z) ((Z) CDR)  # Pop all lists
+         add Z I
+         cmp Z Y  # Reached 'fun'?
+      until eq  # Yes
+   loop
+   ld E (L I)  # Result
+   drop
+   pop Z
+   pop Y
+   pop X
+   ret
+
+# (maxi 'fun 'lst ..) -> any
+(code 'doMaxi 2)
+   push X
+   push Y
+   push Z
+   ld X E  # Keep expression in X
+   ld Z (E CDR)  # Z on args
+   ld E (Z)
+   ld Z (Z CDR)
+   eval  # Eval 'fun'
+   link
+   push E  # Push 'fun'
+   ld Y S  # Pointer to 'fun' in Y
+   do  # 'lst' args
+      ld E (Z)
+      eval+  # Eval next 'lst'
+      push E
+      ld Z (Z CDR)
+      atom Z  # More 'lst' args?
+   until nz  # No
+   push Nil  # <L II> Value
+   push Nil  # <L I> Result
+   link  # <L III> Last argument
+   do
+      atom (Y -I)  # First 'lst' done?
+   while z  # No
+      push Y
+      lea Z (L III)  # Last arg
+      call applyVarXYZ_E  # Apply
+      ld Y E  # Keep
+      ld A (L II)  # Maximal value
+      call compareAE_F  # Compare with current
+      if lt
+         ld (L I) (((S) -I))  # New result
+         ld (L II) Y  # New maximum
+      end
+      pop Y
+      lea Z (L III)  # Last arg
+      do
+         ld (Z) ((Z) CDR)  # Pop all lists
+         add Z I
+         cmp Z Y  # Reached 'fun'?
+      until eq  # Yes
+   loop
+   ld E (L I)  # Result
+   drop
+   pop Z
+   pop Y
+   pop X
+   ret
+
+# (mini 'fun 'lst ..) -> any
+(code 'doMini 2)
+   push X
+   push Y
+   push Z
+   ld X E  # Keep expression in X
+   ld Z (E CDR)  # Z on args
+   ld E (Z)
+   ld Z (Z CDR)
+   eval  # Eval 'fun'
+   link
+   push E  # Push 'fun'
+   ld Y S  # Pointer to 'fun' in Y
+   do  # 'lst' args
+      ld E (Z)
+      eval+  # Eval next 'lst'
+      push E
+      ld Z (Z CDR)
+      atom Z  # More 'lst' args?
+   until nz  # No
+   push TSym  # <L II> Value
+   push Nil  # <L I> Result
+   link  # <L III> Last argument
+   do
+      atom (Y -I)  # First 'lst' done?
+   while z  # No
+      push Y
+      lea Z (L III)  # Last arg
+      call applyVarXYZ_E  # Apply
+      ld Y E  # Keep
+      ld A (L II)  # Minimal value
+      call compareAE_F  # Compare with current
+      if gt
+         ld (L I) (((S) -I))  # New result
+         ld (L II) Y  # New minimum
+      end
+      pop Y
+      lea Z (L III)  # Last arg
+      do
+         ld (Z) ((Z) CDR)  # Pop all lists
+         add Z I
+         cmp Z Y  # Reached 'fun'?
+      until eq  # Yes
+   loop
+   ld E (L I)  # Result
+   drop
+   pop Z
+   pop Y
+   pop X
+   ret
+
+# (fish 'fun 'any) -> lst
+(code 'doFish 2)
+   push X
+   push Y
+   push Z
+   ld X E  # Keep expression in X
+   ld Z (E CDR)  # Z on args
+   ld E (Z)
+   eval  # Eval 'fun'
+   link
+   push E  # Push 'fun'
+   ld Y S  # Pointer to 'fun' in Y
+   ld Z (Z CDR)  # Second arg
+   ld E (Z)
+   eval+  # Eval 'any'
+   push ZERO  # <L III> Apply arg
+   push E  # <L II> 'any'
+   push Nil  # <L I> Result
+   link  # Close frame
+   ld A (L II)  # Get 'any'
+   call fishAXY  # Fish for results
+   ld E (L I)  # Result
+   drop
+   pop Z
+   pop Y
+   pop X
+   ret
+
+(code 'fishAXY 0)
+   push A  # Save arg
+   push Y
+   lea Z (L III)  # Set apply arg
+   ld (Z) A
+   call applyXYZ_E  # Apply
+   pop Y
+   pop A
+   cmp E Nil  # NIL?
+   if ne  # No
+      call cons_C  # New cell
+      ld (C) A  # Cons arg
+      ld (C CDR) (L I)  # into result
+      ld (L I) C
+      ret
+   end
+   atom A  # Cell?
+   jnz ret  # No
+   cmp (A CDR) Nil  # CDR?
+   if ne  # Yes
+      push A
+      ld A (A CDR)
+      call fishAXY  # Recurse on CDR
+      pop A
+   end
+   ld A (A)
+   jmp fishAXY  # Recurse on CAR
+
+# (by 'fun1 'fun2 'lst ..) -> lst
+(code 'doBy 2)
+   push X
+   push Y
+   push Z
+   ld X E  # Keep expression in X
+   ld Z (E CDR)  # Z on args
+   ld E (Z)
+   ld Z (Z CDR)
+   eval  # Eval 'fun1'
+   link
+   push E  # Push 'fun1'
+   ld E (Z)
+   ld Z (Z CDR)
+   eval+  # Eval 'fun2'
+   xchg E (S)  # Push
+   push E  # Push 'fun1'
+   ld Y S  # Pointer to 'fun1' in Y
+   do  # 'lst' args
+      ld E (Z)
+      eval+  # Eval next 'lst'
+      push E
+      ld Z (Z CDR)
+      atom Z  # More 'lst' args?
+   until nz  # No
+   push Nil  # <L I> Result
+   link  # <L II> Last argument
+   push 0  # <L -I> Result tail
+   do
+      atom (Y -I)  # First 'lst' done?
+   while z  # No
+      push Y
+      lea Z (L II)  # Last arg
+      call applyVarXYZ_E  # Apply
+      pop Y
+      call consE_C  # Cons with element from first 'lst'
+      ld (C) E
+      ld (C CDR) ((Y -I))
+      call consC_A  # Concat to result
+      ld (A) C
+      ld (A CDR) Nil
+      null (L -I)  # Result tail?
+      if z  # No
+         ld (L I) A  # Store result
+      else
+         ld ((L -I) CDR) A  # Set new CDR of result tail
+      end
+      ld (L -I) A  # Store result tail
+      lea Z (L II)  # Last arg
+      do
+         ld (Z) ((Z) CDR)  # Pop all lists
+         add Z I
+         cmp Z Y  # Reached 'fun1'?
+      until eq  # Yes
+   loop
+   ld Z Y  # Point to 'fun1'
+   add Y I  # Pointer to 'fun2' in Y
+   ld (Z) (L I)  # Result
+   call applyXYZ_E  # Apply
+   ld C E  # Remove CARs in result list
+   do
+      atom C  # More elements?
+   while z  # Yes
+      ld (C) ((C) CDR)
+      ld C (C CDR)
+   loop
+   drop
+   pop Z
+   pop Y
+   pop X
+   ret
+
+# vi:et:ts=3:sw=3
diff --git a/src64/arch/x86-64.l b/src64/arch/x86-64.l
@@ -0,0 +1,772 @@
+# 07mar10abu
+# (c) Software Lab. Alexander Burger
+
+# Byte order
+(on *LittleEndian)
+
+# Register assignments
+(de *Registers
+   (A . "%rax") (C . "%rdx") (E . "%rbx")
+   (B . "%al") (D "%rax" . "%rdx")
+   (X . "%r13") (Y . "%r14") (Z . "%r15")
+   (L . "%rbp") (S . "%rsp")
+   (F . T) )
+# NULL: %r12
+# Temporary: %r10 %r11
+# Block operations: %rcx %rsi %rdi
+# C arguments: %rdi %rsi %rdx %rcx %r8 %r9
+
+# Addressing modes
+(de byteReg (Reg)
+   (cdr
+      (assoc Reg
+         (quote
+            ("%rax" . "%al")
+            ("%al" . "%al")
+            ("%rdx" . "%dl")
+            ("%rbx" . "%bl")
+            ("%r12" . "%r12b")
+            ("%r13" . "%r13b")
+            ("%r14" . "%r14b")
+            ("%r15" . "%r15b")
+            ("%rbp" . "%bpl")
+            ("%rsp" . "%spl") ) ) ) )
+
+(de byteVal (Adr)
+   (if (= "%r12" Adr)
+      "$0"  # %r12b needs 3 bytes
+      (or
+         (byteReg Adr)  # Register
+         Adr ) ) )  # Byte address
+
+(de lowByte (Adr)
+   (or
+      (byteReg Adr)  # Register
+      Adr ) )  # Word address
+
+(de highWord (S)
+   (cond
+      ((= `(char "(") (char S))
+         (pack "8" S) )
+      ((>= `(char "9") (char S) `(char "0"))
+         (pack "8+" S) )
+      (T (pack S "+8")) ) )
+
+(de immediate (Src)
+   (setq Src (chop Src))
+   (when (= "$" (pop 'Src))
+      (and (= "~" (car Src)) (pop 'Src))
+      (format (pack Src)) ) )
+
+(de target (Adr F)
+   (if
+      (or
+         (not *FPic)
+         (= `(char ".") (char Adr))  # Local label ".1"
+         (use (@L @N)
+            (and
+               (match '(@L "_" @N) (chop Adr))  # Local jump "foo_22"
+               (= @L (chop *Label))
+               (format (pack @N)) ) ) )
+      Adr
+      (ifn F
+         (pack Adr "@plt")
+         (prinst "mov" (pack Adr "@GOTPCREL(%rip)") "%r10")
+         "(%r10)") ) )
+
+(de src (Src S)
+   (cond
+      ((=0 S) (if (= "$0" Src) "%r12" Src))     # Immediate
+      ((not S) Src)                             # Register
+      ((=T S)                                   # Direct
+         (if (and *FPic (not (pre? "(" Src)))
+            (pack Src "@GOTPCREL(%rip)")
+            (pack "$" Src) ) )
+      ((not (car S))
+         (ifn (and *FPic (=T (cdr S)))
+            (pack (cdr Src) "(" (car Src) ")")
+            (prinst "add" (pack (cdr Src) "@GOTPCREL(%rip)") (car Src))
+            (pack "(" (car Src) ")") ) )
+      ((=T (car S))
+         (ifn *FPic
+            (if (cdr S)
+               (pack (car Src) "+" (cdr Src))
+               (car Src) )
+            (prinst "mov" (pack (car Src) "@GOTPCREL(%rip)") "%r10")
+            (pack (cdr Src) "(%r10)") ) )
+      (T
+         (prinst "mov" (src (car Src) (car S)) "%r10")
+         (ifn (and *FPic (=T (cdr S)))
+            (pack (cdr Src) "(%r10)")
+            (prinst "add" (pack (cdr Src) "@GOTPCREL(%rip)") "%r10")
+            "(%r10)" ) ) ) )
+
+(de lea (Src S Reg)
+   (cond
+      ((not S) (prinst "mov" Src Reg))          # Register
+      ((=T S) (prinst "mov" (src Src T) Reg))   # Direct
+      ((not (car S))
+         (cond
+            ((and *FPic (=T (cdr S)))
+               (prinst "add" (pack (cdr Src) "@GOTPCREL(%rip)") (car Src))
+               (prinst "mov" (pack "(" (car Src) ")") Reg) )
+            ((cdr Src)
+               (prinst "lea" (pack (cdr Src) "(" (car Src) ")") Reg) )
+            (T (prinst "mov" (car Src) Reg)) ) )
+      ((=T (car S))
+         (ifn *FPic
+            (prinst "lea"
+               (if (cdr S)
+                  (pack (car Src) "+" (cdr Src))
+                  (car Src) )
+               Reg )
+            (prinst "mov" (pack (car Src) "@GOTPCREL(%rip)") Reg)
+            (prinst "lea" (pack (cdr Src) "(%r10)") Reg) ) )
+      (T (prinst "mov" (src (car Src) (car S)) Reg)) ) )
+
+(de dst (Dst D)
+   (cond
+      ((not D) Dst)                             # Register
+      ((not (car D))
+         (ifn (and *FPic (=T (cdr D)))
+            (pack (cdr Dst) "(" (car Dst) ")")
+            (prinst "add" (pack (cdr Dst) "@GOTPCREL(%rip)") (car Dst))
+            (pack "(" (car Dst) ")") ) )
+      ((=T (car D))
+         (ifn *FPic
+            (if (cdr D)
+               (pack (car Dst) "+" (cdr Dst))
+               (car Dst) )
+            (prinst "mov" (pack (car Dst) "@GOTPCREL(%rip)") "%r11")
+            (pack (cdr Dst) "(%r11)") ) )
+      (T
+         (prinst "mov" (dst (car Dst) (car D)) "%r11")
+         (ifn (and *FPic (=T (cdr D)))
+            (pack (cdr Dst) "(%r11)")
+            (prinst "add" (pack (cdr Dst) "@GOTPCREL(%rip)") "%r11")
+            "(%r11)" ) ) ) )
+
+(de dstSrc (Cmd Dst Src)
+   (cond
+      ((= "%al" Dst)
+         (prinst Cmd (byteVal Src) "%al") )
+      ((= "%al" Src)
+         (prinst Cmd "%al" (byteVal Dst)) )
+      ((and (immediate Src) (not (>= 2147483647 @ -2147483648)))
+         (prinst "mov" Src "%r10")
+         (prinst Cmd "%r10" Dst) )
+      ((or (pre? "%" Src) (pre? "%" Dst))
+         (prinst Cmd Src Dst) )
+      ((pre? "$" Src)
+         (prinst (pack Cmd "q") Src Dst) )
+      (T
+         (prinst "mov" Src "%r10")
+         (prinst Cmd "%r10" Dst) ) ) )
+
+(de dstSrcByte (Cmd Dst Src)
+   (cond
+      ((= "%r12" Src)
+         (prinst Cmd "%r12b" (lowByte Dst)) )
+      ((and (immediate Src) (>= 255 @ 0))
+         (prinst (pack Cmd "b") Src (lowByte Dst)) )
+      (T (dstSrc Cmd Dst Src)) ) )
+
+(de dstDst (Cmd Dst Dst2)
+   (cond
+      ((= "%al" Dst)
+         (prinst Cmd (byteVal Dst2) "%al") )
+      ((= "%al" Dst2)
+         (prinst Cmd "%al" (byteVal Dst)) )
+      ((or (pre? "%" Dst) (pre? "%" Dst2))
+         (prinst Cmd Dst2 Dst) )
+      (T
+         (prinst "mov" Dst "%r10")
+         (prinst Cmd "%r10" Dst2)
+         (prinst "mov" "%r10" Dst) ) ) )
+
+(de dstShift (Cmd Dst Src)
+   (if (pre? "$" Src)
+      (prinst (pack Cmd (unless (pre? "%" Dst) "q")) Src Dst)
+      (prinst "mov" (byteVal Src) "%cl")
+      (prinst (pack Cmd (unless (pre? "%" Dst) "q")) "%cl" Dst) ) )
+
+
+### Instruction set ###
+(asm nop ()
+   (prinst "nop") )
+
+# Move data
+(asm ld (Dst D Src S)
+   (setq Dst (dst Dst D)  Src (src Src S))
+   (cond
+      ((= "%al" Dst)
+         (prinst "mov" (byteVal Src) "%al") )
+      ((= "%al" Src)
+         (prinst "mov" "%al" (byteVal Dst)) )
+      ((pair Dst)
+         (prinst "mov" (if (= "$0" Src) "%r12" Src) (car Dst))
+         (prinst "mov" (if (= "$0" Src) "%r12" (highWord Src)) (cdr Dst)) )
+      ((pair Src)
+         (prinst "mov" (car Src) Dst)
+         (prinst "mov" (cdr Src) (highWord Dst)) )
+      ((or (pre? "%" Src) (pre? "%" Dst))
+         (prinst "mov" Src Dst) )
+      ((pre? "$" Src)
+         (prinst "movq" Src Dst) )
+      (T
+         (prinst "mov" Src "%r10")
+         (prinst "mov" "%r10" Dst) ) ) )
+
+(asm ld2 (Src S)
+   (prinst "movswq" (src Src S) "%rax") )
+
+(asm ld4 (Src S)
+   (prinst "movslq" (src Src S) "%rax") )
+
+(de _cmov (Cmd Jmp)
+   (setq Dst (dst Dst D)  Src (src Src S))
+   (when (pre? "$" Src)
+      (prinst "mov" Src "%r10")
+      (setq Src "%r10") )
+   (if (pre? "%" Dst)
+      (prinst Cmd Src Dst)
+      (warn "Using suboptimal emulation code")
+      (prinst Jmp "1f")
+      (if (pre? "%"  Src)
+         (prinst "movq" Src Dst)
+         (prinst "mov" Src "%r10")
+         (prinst "mov" "%r10" Dst) )
+      (prinl "1:") ) )
+
+(asm ldc (Dst D Src S)
+   (_cmov "cmovcq" "jnc") )
+
+(asm ldnc (Dst D Src S)
+   (_cmov "cmovncq" "jc") )
+
+(asm ldz (Dst D Src S)
+   (_cmov "cmovzq" "jnz") )
+
+(asm ldnz (Dst D Src S)
+   (_cmov "cmovnzq" "jz") )
+
+(asm lea (Dst D Src S)
+   (setq Dst (dst Dst D)  Src (src Src S))
+   (if (pre? "%" Dst)
+      (prinst "lea" Src Dst)
+      (prinst "lea" Src "%r11")
+      (prinst "mov" "%r11" Dst) ) )
+
+(asm st2 (Dst D)
+   (prinst "movw" "%ax" (dst Dst D)) )
+
+(asm st4 (Dst D)
+   (prinst "movl" "%eax" (dst Dst D)) )
+
+(asm xchg (Dst D Dst2 D2)
+   (dstDst "xchg" (dst Dst D) (src Dst2 D2)) )
+
+(asm movm (Dst D Src S End E)
+   (setq Dst (dst Dst D))
+   (prinst (if (pre? "%" Dst) "mov" "lea") Dst "%rdi")
+   (lea Src S "%rsi")
+   (prinst "lea" (src End E) "%rcx")
+   (prinst "sub" "%rsi" "%rcx")
+   (prinst "cld")
+   (prinst "rep movsb") )
+
+(asm movn (Dst D Src S Cnt C)
+   (lea Dst D "%rdi")
+   (lea Src S "%rsi")
+   (prinst "mov" (src Cnt C) "%rcx")
+   (prinst "cld")
+   (prinst "rep movsb") )
+
+(asm mset (Dst D Cnt C)
+   (prinst (if (pre? "%" Dst) "mov" "lea") Dst "%rdi")
+   (prinst "mov" (src Cnt C) "%rcx")
+   (prinst "cld")
+   (prinst "rep stosb") )
+
+
+# Arithmetics
+(asm add (Dst D Src S)
+   (setq Dst (dst Dst D)  Src (src Src S))
+   (ifn (pair Dst)
+      (dstSrc "add" Dst Src)
+      (prinst "add" Src (car Dst))
+      (prinst "adc" "%r12" (cdr Dst)) ) )
+
+(asm addc (Dst D Src S)
+   (setq Dst (dst Dst D)  Src (src Src S))
+   (ifn (pair Dst)
+      (dstSrc "adc" Dst Src)
+      (prinst "adc" Src (car Dst))
+      (prinst "adc" "%r12" (cdr Dst)) ) )
+
+
+(asm sub (Dst D Src S)
+   (setq Dst (dst Dst D)  Src (src Src S))
+   (ifn (pair Dst)
+      (dstSrc "sub" Dst Src)
+      (prinst "sub" Src (car Dst))
+      (prinst "sbb" "%r12" (cdr Dst)) ) )
+
+(asm subc (Dst D Src S)
+   (setq Dst (dst Dst D)  Src (src Src S))
+   (ifn (pair Dst)
+      (dstSrc "sbb" Dst Src)
+      (prinst "sbb" Src (car Dst))
+      (prinst "sbb" "%r12" (cdr Dst)) ) )
+
+(asm not (Dst D)
+   (if (pre? "%" (setq Dst (dst Dst D)))
+      (prinst "not" Dst)
+      (prinst "notq" Dst) ) )
+
+(asm neg (Dst D)
+   (if (pre? "%" (setq Dst (dst Dst D)))
+      (prinst "neg" Dst)
+      (prinst "negq" Dst) ) )
+
+(asm and (Dst D Src S)
+   (dstSrc "and" (dst Dst D) (src Src S)) )
+
+(asm or (Dst D Src S)
+   (dstSrcByte "or" (dst Dst D) (src Src S)) )
+
+(asm xor (Dst D Src S)
+   (dstSrcByte "xor" (dst Dst D) (src Src S)) )
+
+(asm off (Dst D Src S)
+   (dstSrcByte "and" (dst Dst D) (src Src S)) )
+
+(asm test (Dst D Src S)
+   (dstSrcByte "test" (dst Dst D) (src Src S)) )
+
+(asm shl (Dst D Src S)
+   (dstShift "shl" (dst Dst D) (src Src S)) )
+
+(asm shr (Dst D Src S)
+   (dstShift "shr" (dst Dst D) (src Src S)) )
+
+(asm rol (Dst D Src S)
+   (dstShift "rol" (dst Dst D) (src Src S)) )
+
+(asm ror (Dst D Src S)
+   (dstShift "ror" (dst Dst D) (src Src S)) )
+
+(asm rcl (Dst D Src S)
+   (dstShift "rcl" (dst Dst D) (src Src S)) )
+
+(asm rcr (Dst D Src S)
+   (dstShift "rcr" (dst Dst D) (src Src S)) )
+
+(asm mul (Src S)
+   (ifn (pre? "$" (setq Src (src Src S)))
+      (prinst "mulq" Src)
+      (prinst "mov" Src "%r10")
+      (prinst "mul" "%r10") ) )
+
+(asm div (Src S)
+   (ifn (pre? "$" (setq Src (src Src S)))
+      (prinst "divq" Src)
+      (prinst "mov" Src "%r10")
+      (prinst "div" "%r10") ) )
+
+(asm zxt ()  # 8 bit -> 64 bit
+   (prinst "movzx" "%al" "%rax") )
+
+(asm sxt ()  # 8 bit -> 64 bit
+   (prinst "movsx" "%al" "%rax") )
+
+(asm int ()  # 32 bit -> 64 bit
+   (prinst "movsx" "%eax" "%rax") )
+
+
+(asm setc ()
+   (prinst "stc") )
+
+(asm clrc ()
+   (prinst "clc") )
+
+(asm setz ()
+   (prinst "or" "%r12" "%r12") )
+
+(asm clrz ()
+   (prinst "cmp" "%rsp" "%r12") )
+
+
+# Comparisons
+(asm cmp (Dst D Src S)
+   (dstSrc "cmp" (dst Dst D) (src Src S)) )
+
+(asm cmp4 (Src S)
+   (prinst "cmp" (src Src S) "%eax") )
+
+(asm cmpm (Dst D Src S End E)
+   (setq Dst (dst Dst D))
+   (prinst (if (pre? "%" Dst) "mov" "lea") Dst "%rsi")
+   (lea Src S "%rdi")
+   (prinst "lea" End "%rcx")
+   (prinst "sub" "%rsi" "%rcx")
+   (prinst "cld")
+   (prinst "repnz cmpsb") )
+
+(asm cmpn (Dst D Src S Cnt C)
+   (setq Dst (dst Dst D))
+   (prinst (if (pre? "%" Dst) "mov" "lea") Dst "%rsi")
+   (lea Src S "%rdi")
+   (prinst "mov" (src Cnt C) "%rcx")
+   (prinst "cld")
+   (prinst "repnz cmpsb") )
+
+(asm slen (Dst D Src S)
+   (setq Dst (dst Dst D))
+   (prinst "cld")
+   (prinst "xor" "%rcx" "%rcx")
+   (prinst "not" "%rcx")
+   (lea Src S "%rdi")
+   (prinst "xchg" "%al" "%r12b")
+   (prinst "repnz scasb")
+   (prinst "xchg" "%al" "%r12b")
+   (prinst "not" "%rcx")
+   (prinst "dec" "%rcx")
+   (prinst "mov" "%rcx" Dst) )
+
+(asm memb (Src S Cnt C)
+   (prinst "cld")
+   (lea Src S "%rdi")
+   (setq Cnt (src Cnt C))
+   (prinst "mov" Cnt "%rcx")
+   (prinst "repnz scasb")
+   (unless S (prinst "cmovzq" "%rdi" Src))
+   (unless C (prinst "cmovzq" "%rcx" Cnt)) )
+
+(asm null (Src S)
+   (prinst "cmp" "%r12" (src Src S)) )
+
+(asm zero (Src S)
+   (prinst "cmpq" "$2" (src Src S)) )
+
+(asm nul4 ()
+   (prinst "cmp" "%r12d" "%eax") )
+
+
+# Byte addressing
+(asm set (Dst D Src S)
+   (setq Dst (dst Dst D)  Src (src Src S))
+   (cond
+      ((= "%r12" Src)
+         (prinst "mov" "%r12b" (lowByte Dst)) )
+      ((or (pre? "$" Src) (pre? "%" Src) (pre? "%" Dst))
+         (prinst "movb" Src Dst) )
+      (T
+         (prinst "mov" Src "%r10b")
+         (prinst "mov" "%r10b" Dst) ) ) )
+
+(asm nul (Src S)
+   (prinst "cmp" "%r12b" (src Src S)) )
+
+
+# Types
+(asm cnt (Src S)
+   (prinst "testb" "$0x02" (lowByte (src Src S))) )
+
+(asm big (Src S)
+   (prinst "testb" "$0x04" (lowByte (src Src S))) )
+
+(asm num (Src S)
+   (prinst "testb" "$0x06" (lowByte (src Src S))) )
+
+(asm sym (Src S)
+   (prinst "testb" "$0x08" (lowByte (src Src S))) )
+
+(asm atom (Src S)
+   (prinst "testb" "$0x0E" (lowByte (src Src S))) )
+
+
+# Flow Control
+(asm call (Adr A)
+   (nond
+      (A (prinst "call" (target Adr)))
+      ((=T A) (prinst "call" (pack "*" Adr)))
+      (NIL
+         (prinst "mov" (target Adr T) "%r10")
+         (prinst "call" "*%r10") ) ) )
+
+(asm jmp (Adr A)
+   (nond
+      (A (prinst "jmp" (target Adr)))
+      ((=T A) (prinst "jmp" (pack "*" Adr)))
+      (NIL
+         (prinst "mov" (target Adr T) "%r10")
+         (prinst "jmp" "*%r10") ) ) )
+
+(de _jmp (Opc Opc2)
+   (ifn A
+      (prinst Opc (target Adr))
+      (prinst Opc2 "1f")
+      (ifn (=T A)
+         (prinst "jmp" (pack "*" Adr))
+         (prinst "mov" (target Adr T) "%r10")
+         (prinst "jmp" "*%r10") )
+      (prinl "1:") ) )
+
+(asm jz (Adr A)
+   (_jmp "jz" "jnz") )
+
+(asm jeq (Adr A)
+   (_jmp "jz" "jnz") )
+
+(asm jnz (Adr A)
+   (_jmp "jnz" "jz") )
+
+(asm jne (Adr A)
+   (_jmp "jnz" "jz") )
+
+(asm js (Adr A)
+   (_jmp "js" "jns") )
+
+(asm jns (Adr A)
+   (_jmp "jns" "js") )
+
+(asm jsz (Adr A)
+   (_jmp "jle" "jg") )
+
+(asm jnsz (Adr A)
+   (_jmp "jg" "jle") )
+
+(asm jc (Adr A)
+   (_jmp "jc" "jnc") )
+
+(asm jlt (Adr A)
+   (_jmp "jc" "jnc") )
+
+(asm jnc (Adr A)
+   (_jmp "jnc" "jc") )
+
+(asm jge (Adr A)
+   (_jmp "jnc" "jc") )
+
+(asm jcz (Adr A)
+   (_jmp "jbe" "ja") )
+
+(asm jle (Adr A)
+   (_jmp "jbe" "ja") )
+
+(asm jncz (Adr A)
+   (_jmp "ja" "jbe") )
+
+(asm jgt (Adr A)
+   (_jmp "ja" "jbe") )
+
+(asm cc (Adr A Arg M)
+   (unless (== 'cc (caar (seek '((L) (== (cadr L) *Statement)) *Program)))
+      (prinst "mov" "%rdx" "%r12") )
+   (let Reg '("%rdi" "%rsi" "%rdx" "%rcx" "%r8" "%r9")
+      (if (lst? Arg)
+         (let  Lea NIL
+            (when (nth Arg 7)
+               (setq  # Maximally 6 args in registers
+                  Arg (append (head 6 Arg) (reverse (tail -6 Arg)))
+                  M (append (head 6 M) (reverse (tail -6 M))) ) )
+            (mapc
+               '((Src S)
+                  (if (== '& Src)
+                     (on Lea)
+                     (unless (= "$0" Src)  # Keep for 'xor' later
+                        (setq Src
+                           (src
+                              (recur (Src)
+                                 (cond
+                                    ((= "%rdx" Src) "%r12")
+                                    ((atom Src) Src)
+                                    (T (cons (recurse (car Src)) (recurse (cdr Src)))) ) )
+                              S ) ) )
+                     (cond
+                        ((not Reg)  # 'Src' not stack-relative here!
+                           (ifn Lea
+                              (prinst "pushq" Src)
+                              (prinst "lea" Src "%rax")
+                              (prinst "pushq" "%rax") ) )
+                        ((= "$0" Src)
+                           (prinst "xor" (car Reg) (pop 'Reg)) )
+                        ((= "$pop" Src)
+                           (prinst "pop" (pop 'Reg)) )
+                        (T (prinst (if Lea "lea" "mov") Src (pop 'Reg))) )
+                     (off Lea) ) )
+               Arg
+               M )
+            # Don't use SSE registers if varargs
+            (when (member Adr '("printf" "fprintf" "sprintf"))
+               (prinst "xor" "%rax" "%rax") ) )
+         (for R Reg
+            (prinst "cmp" "%rsp" Arg)
+            (prinst "jz" "1f")
+            (prinst "pop" R) )
+         (prinl "1:")
+         # Don't use SSE registers if varargs
+         (prinst "xor" "%rax" "%rax") ) )
+   ((get 'call 'asm) Adr A)
+   (if (lst? Arg)
+      (when (gt0 (- (length Arg) 6))
+         (prinst "lea" (pack (* @ 8) "(%rsp)") "%rsp") )
+      (prinst "mov" Arg "%rsp") )
+   (unless (== 'cc (caadr (memq *Statement *Program)))
+      (prinst "mov" "%r12" "%rdx")
+      (prinst "xor" "%r12" "%r12") ) )
+
+(asm ret ()
+   (unless
+      (and
+         (seek '((L) (== (cadr L) *Statement)) *Program)
+         (not (memq (caar @) '`(cons ': (cdr *Transfers)))) )
+      (prinst "rep") )
+   (prinst "ret") )
+
+(asm begin (N)
+   (prinst "push" "%rbx")
+   (prinst "push" "%r12")
+   (prinst "xor" "%r12" "%r12")  # NULL register
+   (when (>= N 6)                                  # Z
+      (prinst "push" "%r15")
+      (prinst "mov" "%r9" "%r15") )
+   (when (>= N 5)                                  # Y
+      (prinst "push" "%r14")
+      (prinst "mov" "%r8" "%r14") )
+   (when (>= N 4)                                  # X
+      (prinst "push" "%r13")
+      (prinst "mov" "%rcx" "%r13") )
+   (and (>= N 3) (prinst "mov" "%rdx" "%rbx"))     # E
+   (and (>= N 2) (prinst "mov" "%rsi" "%rdx"))     # C
+   (and (>= N 1) (prinst "mov" "%rdi" "%rax")) )   # A
+
+(asm return (N)
+   (and (>= N 4) (prinst "pop" "%r13"))
+   (and (>= N 5) (prinst "pop" "%r14"))
+   (and (>= N 6) (prinst "pop" "%r15"))
+   (prinst "pop" "%r12")
+   (prinst "pop" "%rbx")
+   (prinst "ret") )
+
+
+# Stack Manipulations
+(asm push (Src S)
+   (setq Src (src Src S))
+   (cond
+      ((=T Src) (prinst "pushf"))
+      ((pre? "%" Src) (prinst "push" Src))
+      (T (prinst "pushq" Src)) ) )
+
+(asm pop (Dst D)
+   (setq Dst (dst Dst D))
+   (cond
+      ((=T Dst) (prinst "popf"))
+      ((pre? "%" Dst) (prinst "pop" Dst))
+      (T (prinst "popq" Dst)) ) )
+
+(asm link ()
+   (prinst "push" "%rbp")
+   (prinst "mov" "%rsp" "%rbp") )
+
+(asm tuck (Src S)
+   (setq Src (src Src S))
+   (prinst "mov" "(%rsp)" "%rbp")
+   (if (or (pre? "$" Src) (pre? "%" Src))
+      (prinst "movq" Src "(%rsp)")
+      (prinst "mov" Src "%r10")
+      (prinst "mov" "%r10" "(%rsp)") ) )
+
+(asm drop ()
+   (prinst "mov" "(%rbp)" "%rsp")
+   (prinst "pop" "%rbp") )
+
+# Evaluation
+(asm eval ()
+   (prinst "test" "$0x06" "%bl")       # Number?
+   (prinst "jnz" "1f")                 # Yes: Skip
+   (prinst "test" "$0x08" "%bl")       # Symbol?
+   (prinst "cmovnzq" "(%rbx)" "%rbx")  # Yes: Get value
+   (prinst "jnz" "1f")                 # and skip
+   (prinst "call" (target 'evListE_E)) # Else evaluate list
+   (prinl "1:") )
+
+(asm eval+ ()
+   (prinst "test" "$0x06" "%bl")       # Number?
+   (prinst "jnz" "1f")                 # Yes: Skip
+   (prinst "test" "$0x08" "%bl")       # Symbol?
+   (prinst "cmovnzq" "(%rbx)" "%rbx")  # Yes: Get value
+   (prinst "jnz" "1f")                 # and skip
+   (prinst "push" "%rbp")              # Else 'link'
+   (prinst "mov" "%rsp" "%rbp")
+   (prinst "call" (target 'evListE_E)) # Evaluate list
+   (prinst "pop" "%rbp")
+   (prinl "1:") )
+
+(asm eval/ret ()
+   (prinst "test" "$0x06" "%bl")       # Number?
+   (prinst "jnz" "ret")                # Yes: Return
+   (prinst "test" "$0x08" "%bl")       # Symbol?
+   (prinst "jz" 'evListE_E)            # No: Evaluate list
+   (prinst "movq" "(%rbx)" "%rbx")     # Get value
+   (prinst "ret") )
+
+(asm exec (Reg)
+   (prinl "1:")                        # do
+   (prinst "mov"                       # ld E (R)
+      (pack "(" Reg ")")
+      "%rbx" )
+   (prinst "test" "$0x0E" "%bl")       # atom E
+   (prinst "jnz" "2f")
+   (prinst "call" (target 'evListE_E)) # evList
+   (prinl "2:")
+   (prinst "mov"                       # ld R (R CDR)
+      (pack "8(" Reg ")")
+      Reg )
+   (prinst "testb"                     # atom R
+      "$0x0E"
+      (byteReg Reg) )
+   (prinst "jz" "1b") )                # until nz
+
+(asm prog (Reg)
+   (prinl "1:")                        # do
+   (prinst "mov"                       # ld E (R)
+      (pack "(" Reg ")")
+      "%rbx" )
+   (prinst "test" "$0x06" "%bl")       # eval
+   (prinst "jnz" "2f")
+   (prinst "test" "$0x08" "%bl")
+   (prinst "cmovnzq" "(%rbx)" "%rbx")
+   (prinst "jnz" "2f")
+   (prinst "call" (target 'evListE_E))
+   (prinl "2:")
+   (prinst "mov"                       # ld R (R CDR)
+      (pack "8(" Reg ")")
+      Reg )
+   (prinst "testb"                     # atom R
+      "$0x0E"
+      (byteReg Reg) )
+   (prinst "jz" "1b") )                # until nz
+
+
+# System
+(asm init ()
+   (prinst "xor" "%r12" "%r12")  # Init NULL register
+   (prinst "mov" "(%rsi)" "%r10")  # Get command
+   (ifn *FPic
+      (prinst "mov" "%r10" "AV0")
+      (prinst "mov" "AV0@GOTPCREL(%rip)" "%r11")
+      (prinst "mov" "%r10" "(%r11)") )
+   (prinst "lea" "8(%rsi)" "%r10")  # Get argument vector
+   (ifn *FPic
+      (prinst "mov" "%r10" "AV")
+      (prinst "mov" "AV@GOTPCREL(%rip)" "%r11")
+      (prinst "mov" "%r10" "(%r11)") ) )
+
+
+### Optimizer ###
+# Replace the the next 'cnt' elements with 'lst'
+(de optimize (L))  #> (cnt . lst)
+
+# vi:et:ts=3:sw=3
diff --git a/src64/big.l b/src64/big.l
@@ -0,0 +1,2673 @@
+# 02mar10abu
+# (c) Software Lab. Alexander Burger
+
+### Destructive primitives ###
+# Remove leading zeroes
+(code 'zapZeroA_A 0)
+   push A  # Save number
+   ld C S  # Short-tail in C
+   ld E C  # Null-tail in E
+   do
+      cnt (A BIG)  # Last cell?
+   while z  # No
+      null (A DIG)  # Null digit?
+      if nz  # No
+         ld E C  # New null-tail
+      end
+      lea C (A BIG)  # New short-tail
+      ld A (C)  # Next cell
+   loop
+   zero (A BIG)  # Trailing short zero?
+   if eq  # Yes
+      ld A (A DIG)
+      null A  # Null digit?
+      if nz  # No
+         test A (hex "F000000000000000")  # Fit in short number?
+         if z  # Yes
+            shl A 4  # Make short number
+            or A CNT
+            ld (C) A  # Store in short-tail
+         end
+      else
+         ld A ((E) DIG)  # Digit in null-tail
+         test A (hex "F000000000000000")  # Fit in short number?
+         if nz  # No
+            ld (C) ZERO  # Trim short-tail
+         else
+            shl A 4  # Make short number
+            or A CNT
+            ld (E) A  # Store in null-tail
+         end
+      end
+   end
+   pop A  # Result
+   ret
+
+# Multiply (unsigned) number by 2
+(code 'twiceA_A 0)
+   cnt A  # A short?
+   if nz  # Yes
+      xor A 3  # Prepare tag bit
+      shl A 1  # Shift left
+      jnc Ret  # Done
+      rcr A 1  # Else normalize
+      shr A 3
+      jmp boxNumA_A  # Return bignum
+   end
+   push A  # Save bignum
+   ld C (A DIG)  # Lowest digit
+   shl C 1  # Shift left
+   do
+      push F  # Save carry
+      ld (A DIG) C  # Store digit
+      ld E (A BIG)  # Next cell
+      cnt E  # End of bignum?
+   while z  # No
+      ld A E
+      ld C (A DIG)  # Next digit
+      pop F
+      rcl C 1  # Rotate left
+   loop
+   shr E 4  # Normalize
+   pop F
+   rcl E 1  # Rotate left
+   test E (hex "F000000000000000")  # Fit in short number?
+   if z  # Yes
+      shl E 4  # Make short number
+      or E CNT
+   else
+      call boxNumE_E  # New cell
+   end
+   ld (A BIG) E  # Store in final cell
+   pop A  # Return bignum
+   ret
+
+# Divide (unsigned) number by 2
+(code 'halfA_A 0)
+   cnt A  # A short?
+   if nz  # Yes
+      shr A 1  # Shift right
+      off A 9  # Clear lowest bit and tag
+      or A CNT  # Make short number
+      ret
+   end
+   ld C (A DIG)  # Lowest digit
+   ld E (A BIG)  # Next cell
+   cnt E  # Any?
+   if nz  # No
+      shr E 5  # Normalize and shift right
+      if nz  # Non-empty
+         rcr C 1  # Rotate right
+      else
+         rcr C 1  # Rotate right
+         test C (hex "F000000000000000")  # Fit in short number?
+         if z  # Yes
+            shl C 4  # Return short number
+            or C CNT
+            ld A C
+            ret
+         end
+      end
+      ld (A DIG) C  # Store lowest digit
+      shl E 4  # Make short number
+      or E CNT
+      ld (A BIG) E  # Store in the cell
+      ret
+   end
+   push A  # Save bignum
+   do
+      test (E DIG) 1  # Shift bit?
+      if nz  # Yes
+         setc
+      end
+      rcr C 1  # Rotate right with carry
+      ld (A DIG) C  # Store digit
+      ld C (E BIG)  # More cells?
+      cnt C
+   while z  # Yes
+      ld A E  # Advance pointers
+      ld E C
+      ld C (A DIG)  # Next digit
+   loop
+   shr C 5  # Normalize and shift right
+   if nz  # Non-empty
+      rcr (E DIG) 1  # Shift previous digit
+      shl C 4  # Make short number
+      or C CNT
+   else
+      ld C (E DIG)  # Shift previous digit
+      rcr C 1
+      test C (hex "F000000000000000")  # Fit in short number?
+      if z  # Yes
+         shl C 4  # Make short number
+         or C CNT
+         ld (A BIG) C
+         pop A  # Return bignum
+         ret
+      end
+      ld (E DIG) C
+      ld C ZERO
+   end
+   ld (E BIG) C  # Store in the cell
+   pop A  # Return bignum
+   ret
+
+# Multiply (unsigned) number by 10
+(code 'tenfoldA_A 0)
+   cnt A  # A short?
+   if nz  # Yes
+      shr A 4  # Normalize
+      mul 10  # Multiply by 10
+      test A (hex "F000000000000000")  # Fit in short number?
+      jnz boxNumA_A  # No: Return bignum
+      shl A 4  # Make short number
+      or A CNT
+      ret
+   end
+   push X
+   push A  # Save bignum
+   ld X A  # Bignum in X
+   ld A (X DIG)  # Multiply lowest digit by 10
+   mul 10
+   do
+      ld (X DIG) A  # Store lower word
+      ld E C  # Keep upper word in E
+      ld A (X BIG)  # Next cell
+      cnt A  # End of bignum?
+   while z  # No
+      ld X A
+      ld A (X DIG)  # Next digit
+      mul 10  # Multiply by 10
+      add D E  # Add previous upper word
+   loop
+   shr A 4  # Normalize
+   mul 10  # Multiply by 10
+   add A E  # Add previous upper word
+   test A (hex "F000000000000000")  # Fit in short number?
+   if z  # Yes
+      shl A 4  # Make short number
+      or A CNT
+   else
+      call boxNumA_A  # Return bignum
+   end
+   ld (X BIG) A  # Store in final cell
+   pop A  # Return bignum
+   pop X
+   ret
+
+### Non-destructive primitives ###
+# Multiply (unsigned) number by 2
+(code 'shluA_A 0)
+   cnt A  # A short?
+   if nz  # Yes
+      xor A 3  # Prepare tag bit
+      shl A 1  # Shift left
+      jnc Ret  # Done
+      rcr A 1  # Else normalize
+      shr A 3
+      jmp boxNumA_A  # Return bignum
+   end
+   call boxNum_E  # Build new head
+   ld (E DIG) (A DIG)  # Lowest digit
+   link
+   push E  # <L I> Result
+   link
+   shl (E DIG) 1  # Shift left
+   push F  # Save carry
+   do
+      ld A (A BIG)  # Next cell
+      cnt A  # End of bignum?
+   while z  # No
+      call boxNum_C  # Build next cell
+      ld (E BIG) C
+      ld E (A DIG)  # Next digit
+      pop F
+      rcl E 1  # Rotate left
+      push F  # Save carry
+      ld (C DIG) E
+      ld E C
+   loop
+   shr A 4  # Normalize
+   pop F
+   rcl A 1  # Rotate left
+   test A (hex "F000000000000000")  # Fit in short number?
+   if z  # Yes
+      shl A 4  # Make short number
+      or A CNT
+   else
+      call boxNumA_A  # New cell
+   end
+   ld (E BIG) A  # Store in final cell
+   ld A (L I)  # Return bignum
+   drop
+   ret
+
+# Divide (unsigned) number by 2
+(code 'shruA_A 0)
+   cnt A  # A short?
+   if nz  # Yes
+      shr A 1  # Shift right
+      off A 9  # Clear lowest bit and tag
+      or A CNT  # Make short number
+      ret
+   end
+   ld E (A BIG)  # Next cell
+   cnt E  # Any?
+   if nz  # No
+      ld C (A DIG)  # Lowest digit
+      shr E 5  # Normalize and shift right
+      if nz  # Non-empty
+         rcr C 1  # Rotate right
+      else
+         rcr C 1  # Rotate right
+         test C (hex "F000000000000000")  # Fit in short number?
+         if z  # Yes
+            shl C 4  # Return short number
+            or C CNT
+            ld A C
+            ret
+         end
+      end
+      shl E 4  # Make short number
+      or E CNT
+      jmp consNumCE_A  # Return bignum
+   end
+   call boxNum_C  # Build new head
+   ld (C DIG) (A DIG)  # Lowest digit
+   link
+   push C  # <L I> Result
+   link
+   do
+      test (E DIG) 1  # Shift bit?
+      if nz  # Yes
+         setc
+      end
+      rcr (C DIG) 1  # Rotate right with carry
+      cnt (E BIG)  # More cells?
+   while z  # Yes
+      call boxNum_A  # Build next digit
+      ld (A DIG) (E DIG)
+      ld (C BIG) A
+      ld E (E BIG)  # Advance pointers
+      ld C A
+   loop
+   ld A (E BIG)  # Final short number
+   shr A 5  # Normalize and shift right
+   if nz  # Non-empty
+      ld E (E DIG)  # Shift previous digit
+      rcr E 1
+      shl A 4  # Make short number
+      or A CNT
+      call consNumEA_E  # Last cell
+      ld (C BIG) E  # Store in the cell
+   else
+      ld E (E DIG)  # Shift previous digit
+      rcr E 1
+      test E (hex "F000000000000000")  # Fit in short number?
+      if z  # Yes
+         shl E 4  # Make short number
+         or E CNT
+         ld (C BIG) E
+         ld A (L I)  # Return bignum
+         drop
+         ret
+      end
+      call boxNum_A  # New cell
+      ld (A DIG) E
+      ld (C BIG) A
+   end
+   ld A (L I)  # Return bignum
+   drop
+   ret
+
+# Bitwise AND of two (unsigned) numbers
+(code 'anduAE_A 0)
+   cnt A  # A short?
+   if nz  # Yes
+      cnt E  # E also short?
+      if z  # No
+         ld E (E DIG)  # Get digit
+         shl E 4  # Make short number
+         or E CNT
+      end
+      and A E  # Return short number
+      ret
+   end
+   # A is big
+   cnt E  # E short?
+   if nz  # Yes
+      ld A (A DIG)  # Get digit
+      shl A 4  # Make short number
+      or A CNT
+      and A E  # Return short number
+      ret
+   end
+   # Both are big
+   push X
+   link
+   push ZERO  # <L I> Result
+   link
+   ld C (A DIG)  # AND first digits
+   and C (E DIG)
+   call boxNum_X  # Make bignum
+   ld (X DIG) C
+   ld (L I) X  # Init result
+   do
+      ld A (A BIG)  # Get tails
+      ld E (E BIG)
+      cnt A  # End of A?
+      if nz  # Yes
+         cnt E  # Also end of E?
+         if z  # No
+            ld E (E DIG)  # Get digit
+            shl E 4  # Make short number
+            or E CNT
+         end
+         and A E  # Concat short
+         ld (X BIG) A
+         ld A (L I)  # Return bignum
+         drop
+         pop X
+         jmp zapZeroA_A  # Remove leading zeroes
+      end
+      cnt E  # End of E?
+      if nz  # Yes
+         ld A (A DIG)  # Get digit
+         shl A 4  # Make short number
+         or A CNT
+         and A E  # Concat short
+         ld (X BIG) A
+         ld A (L I)  # Return bignum
+         drop
+         pop X
+         jmp zapZeroA_A  # Remove leading zeroes
+      end
+      ld C (A DIG)  # AND digits
+      and C (E DIG)
+      call consNumCE_C  # New bignum cell
+      ld (X BIG) C  # Concat to result
+      ld X C
+   loop
+
+# Bitwise OR of two (unsigned) numbers
+(code 'oruAE_A 0)
+   cnt A  # A short?
+   if nz  # Yes
+      cnt E  # E also short?
+      if nz  # Yes
+         or A E  # Return short number
+         ret
+      end
+      shr A 4  # Normalize
+      or A (E DIG)  # OR digit
+      ld E (E BIG)  # Rest of E
+      jmp consNumAE_A  # Append rest
+   end
+   # A is big
+   cnt E  # E short?
+   if nz  # Yes
+      shr E 4  # Normalize
+      or E (A DIG)  # OR digit
+      ld A (A BIG)  # Rest of A
+      jmp consNumEA_A  # Append rest
+   end
+   # Both are big
+   push X
+   link
+   push ZERO  # <L I> Result
+   link
+   ld C (A DIG)  # OR first digits
+   or C (E DIG)
+   call boxNum_X  # Make bignum
+   ld (X DIG) C
+   ld (L I) X  # Init result
+   do
+      ld A (A BIG)  # Get tails
+      ld E (E BIG)
+      cnt A  # End of A?
+      if nz  # Yes
+         cnt E  # Also end of E?
+         if nz  # Yes
+            or A E  # Concat short number
+         else
+            shr A 4  # Normalize
+            or A (E DIG)  # OR digit
+            ld E (E BIG)  # Rest of E
+            call consNumAE_A  # Append rest
+         end
+         ld (X BIG) A
+         ld A (L I)  # Return bignum
+         drop
+         pop X
+         ret
+      end
+      cnt E  # End of E?
+      if nz  # Yes
+         shr E 4  # Normalize
+         or E (A DIG)  # OR digit
+         ld A (A BIG)  # Rest of A
+         call consNumEA_A  # Append rest
+         ld (X BIG) A
+         ld A (L I)  # Return bignum
+         drop
+         pop X
+         ret
+      end
+      ld C (A DIG)  # OR digits
+      or C (E DIG)
+      call consNumCE_C  # New bignum cell
+      ld (X BIG) C  # Concat to result
+      ld X C
+   loop
+
+# Bitwise XOR of two (unsigned) numbers
+(code 'xoruAE_A 0)
+   cnt A  # A short?
+   if nz  # Yes
+      cnt E  # E also short?
+      if nz  # Yes
+         xor A E  # Return short number
+         or A CNT
+         ret
+      end
+      shr A 4  # Normalize
+      xor A (E DIG)  # XOR digit
+      ld E (E BIG)  # Rest of E
+      call consNumAE_A  # Append rest
+      jmp zapZeroA_A  # Remove leading zeroes
+   end
+   # A is big
+   cnt E  # E short?
+   if nz  # Yes
+      shr E 4  # Normalize
+      xor E (A DIG)  # XOR digit
+      ld A (A BIG)  # Rest of A
+      call consNumEA_A  # Append rest
+      jmp zapZeroA_A  # Remove leading zeroes
+   end
+   # Both are big
+   push X
+   link
+   push ZERO  # <L I> Result
+   link
+   ld C (A DIG)  # XOR first digits
+   xor C (E DIG)
+   call boxNum_X  # Make bignum
+   ld (X DIG) C
+   ld (L I) X  # Init result
+   do
+      ld A (A BIG)  # Get tails
+      ld E (E BIG)
+      cnt A  # End of A?
+      if nz  # Yes
+         cnt E  # Also end of E?
+         if nz  # Yes
+            xor A E  # Concat short number
+            or A CNT
+         else
+            shr A 4  # Normalize
+            xor A (E DIG)  # XOR digit
+            ld E (E BIG)  # Rest of E
+            call consNumAE_A  # Append rest
+         end
+         ld (X BIG) A
+         ld A (L I)  # Return bignum
+         drop
+         pop X
+         jmp zapZeroA_A  # Remove leading zeroes
+      end
+      cnt E  # End of E?
+      if nz  # Yes
+         shr E 4  # Normalize
+         xor E (A DIG)  # XOR digit
+         ld A (A BIG)  # Rest of A
+         call consNumEA_A  # Append rest
+         ld (X BIG) A
+         ld A (L I)  # Return bignum
+         drop
+         pop X
+         jmp zapZeroA_A  # Remove leading zeroes
+      end
+      ld C (A DIG)  # XOR digits
+      xor C (E DIG)
+      call consNumCE_C  # New bignum cell
+      ld (X BIG) C  # Concat to result
+      ld X C
+   loop
+
+# Add two (unsigned) numbers
+(code 'adduAE_A 0)
+   cnt A  # A short?
+   if nz  # Yes
+      cnt E  # E also short?
+      jz 10  # No: Jump
+      off E CNT  # Else clear tag
+      add A E  # Add short numbers
+      jnc Ret  # Done
+      rcr A 1  # Get top bit
+      shr A 3  # Normalize
+      jmp boxNumA_A  # Return bignum
+   end
+   # A is big
+   cnt E  # E short?
+   if nz  # Yes
+      xchg A E  # Exchange args
+10    shr A 4  # Normalize short
+      add A (E DIG)  # Add first digit
+      ld E (E BIG)  # Tail in E
+      jnc consNumAE_A  # Cons new cell if no carry
+      call consNumAE_A  # Else build new head
+      link
+      push A  # <L I> Result
+      link
+      do
+         cnt E  # Short number?
+         if nz  # Yes
+            add E (hex "10")  # Add carry
+            if nc  # No further carry
+               ld (A BIG) E  # Append it
+            else  # Again carry
+               rcr E 1  # Get top bit
+               shr E 3  # Normalize
+               call boxNum_C  # New cell
+               ld (C DIG) E
+               ld (A BIG) C  # Append it
+            end
+            ld A (L I)  # Return bignum
+            drop
+            ret
+         end
+         ld C (E DIG)  # Next digit
+         ld E (E BIG)
+         add C 1  # Add carry
+         if nc  # None
+            call consNumCE_E  # New last cell
+            ld (A BIG) E
+            ld A (L I)  # Return bignum
+            drop
+            ret
+         end
+         call consNumCE_C  # New cell
+         ld (A BIG) C  # Append it
+         ld A C  # Tail of result
+      loop
+   end
+   # Both are big
+   push X
+   link
+   push ZERO  # <L I> Result
+   link
+   ld C (A DIG)  # Add first digits
+   add C (E DIG)
+   push F  # Save carry
+   call boxNum_X  # Make bignum
+   ld (X DIG) C
+   ld (L I) X  # Init result
+   do
+      ld A (A BIG)  # Get tails
+      ld E (E BIG)
+      cnt A  # End of A?
+      if nz  # Yes
+         cnt E  # Also end of E?
+         jz 20  # No: Jump
+         shr A 4  # Normalize A
+         shr E 4  # Normalize E
+         pop F
+         addc A E  # Add final shorts with carry
+         shl A 4
+         if nc
+            or A CNT  # Make short number
+         else  # Again carry
+            rcr A 1  # Get top bit
+            shr A 3  # Normalize
+            call boxNumA_A  # Make bignum
+         end
+         ld (X BIG) A
+         ld A (L I)  # Return bignum
+         drop
+         pop X
+         ret
+      end
+      cnt E  # End of E?
+      if nz  # Yes
+         xchg A E  # Exchange args
+20       shr A 4  # Normalize A
+         pop F
+         addc A (E DIG)  # Add next digit with carry
+         do
+            ld E (E BIG)
+            if nc  # No carry
+               call consNumAE_A  # Append rest
+               ld (X BIG) A
+               ld A (L I)  # Return bignum
+               drop
+               pop X
+               ret
+            end
+            call consNumAE_A  # New cell
+            ld (X BIG) A  # Concat to result
+            ld X A  # Pointer to last cell
+            cnt E  # End of E?
+            if nz  # Yes
+               add E (hex "10")  # Add carry
+               if nc  # No further carry
+                  ld (X BIG) E  # Append it
+               else  # Again carry
+                  rcr E 1  # Get top bit
+                  shr E 3  # Normalize
+                  call boxNum_C  # New cell
+                  ld (C DIG) E
+                  ld (X BIG) C  # Append it
+               end
+               ld A (L I)  # Return bignum
+               drop
+               pop X
+               ret
+            end
+            ld A (E DIG)  # Add carry to next digit
+            add A 1
+         loop
+      end
+      ld C (A DIG)  # Add digits
+      pop F
+      addc C (E DIG)
+      push F
+      call consNumCE_C  # New bignum cell
+      ld (X BIG) C  # Concat to result
+      ld X C
+   loop
+
+# Subtract two (unsigned) numbers
+(code 'subuAE_A 0)
+   cnt A  # A short?
+   if nz  # Yes
+      cnt E  # E also short?
+      if nz  # Yes
+         off E CNT  # Clear tag
+         sub A E  # Subtract short numbers
+         jnc Ret  # Done
+         xor A -16  # 2-complement
+         add A (hex "18")
+         ret
+      end
+      xchg A E  # Exchange args
+      call 10  # Subtract short from big
+      zero A  # Zero?
+      if ne  # No
+         or A SIGN  # Set negative
+      end
+      ret
+   end
+   # A is big
+   cnt E  # E short?
+   if nz  # Yes
+10    shr E 4  # Normalize short
+      ld C (A DIG)
+      sub C E  # Subtract from first digit
+      ld E (A BIG)  # Tail in E
+      if nc  # No borrow
+         zero E  # Leading zero?
+         jne consNumCE_A  # No: Cons new cell
+         test C (hex "F000000000000000")  # Fit in short number?
+         jnz consNumCE_A  # No: Cons new cell
+         ld A C  # Get digit
+         shl A 4  # Make short number
+         or A CNT
+         ret
+      end
+      call consNumCE_A  # Else build new head
+      link
+      push A  # <L I> Result
+      link
+      do
+         cnt E  # Short number?
+         if nz  # Yes
+            sub E (hex "10")  # Subtract borrow
+            if c  # Again borrow: Must be the first pass
+               ld A C  # C still has lowest digit
+               neg A  # Negate
+               shl A 4
+               or A (| SIGN CNT)  # Make short negative number
+               drop
+               ret
+            end
+            ld (A BIG) E  # Append it
+            ld A (L I)  # Return bignum
+            drop
+            jmp zapZeroA_A  # Remove leading zeroes
+         end
+         ld C (E DIG)  # Next digit
+         ld E (E BIG)
+         sub C 1  # Subtract borrow
+         if nc  # None
+            call consNumCE_E  # New last cell
+            ld (A BIG) E  # Append it
+            ld A (L I)  # Return bignum
+            drop
+            jmp zapZeroA_A  # Remove leading zeroes
+         end
+         call consNumCE_C  # New cell
+         ld (A BIG) C  # Append it
+         ld A C  # Tail of result
+      loop
+   end
+   # Both are big
+   push X
+   link
+   push ZERO  # <L I> Result
+   link
+   ld C (A DIG)  # Subtract first digits
+   sub C (E DIG)
+   push F  # Save borrow
+   ld A (A BIG)  # Get tail
+   call consNumCA_C  # First bignum cell
+   ld (L I) C  # Init result
+   do
+      ld X C  # Keep last cell in X
+      ld E (E BIG)  # Get tail
+      cnt E  # End of E?
+      if nz  # Yes
+         shr E 4  # Normalize E
+         do
+            cnt A  # Also end of A?
+         while z  # No
+            ld C (A DIG)  # Subtract final digit with borrow
+            ld A (A BIG)  # Next cell
+            pop F
+            subc C E  # Borrow again?
+            if nc  # No
+               call consNumCA_C  # Final new bignum tail
+               ld (X BIG) C  # Concat to result
+20             ld A (L I)  # Return bignum
+               drop
+               pop X
+               jmp zapZeroA_A  # Remove leading zeroes
+            end
+            push F  # Save borrow
+            call consNumCA_C  # New bignum tail
+            ld (X BIG) C  # Concat to result
+            ld X C  # Keep last cell
+            ld E 0
+         loop
+         shr A 4  # Normalize A
+         break T
+      end
+      cnt A  # End of A?
+      if nz  # Yes
+         shr A 4  # Normalize A
+         do
+            pop F
+            subc A (E DIG)  # Subtract next digit with borrow
+            push F
+            call boxNum_C  # New bignum tail
+            ld (C DIG) A
+            ld (X BIG) C  # Concat to result
+            ld X C  # Keep last cell
+            ld E (E BIG)  # Next cell
+            ld A 0
+            cnt E  # Also end of E?
+         until nz  # Yes
+         shr E 4  # Normalize E
+         break T
+      end
+      ld C (A DIG)  # Subtract digits
+      pop F
+      subc C (E DIG)
+      push F  # Save borrow
+      ld A (A BIG)
+      call consNumCA_C  # New bignum cell
+      ld (X BIG) C  # Concat to result
+   loop
+   pop F
+   subc A E  # Subtract final shorts with borrow
+   push F  # Save borrow
+   shl A 4
+   or A CNT  # Make short number
+   ld (X BIG) A
+   pop F  # Borrow?
+   jnc 20  # No
+   ld A (L I)  # Get result
+   ld E A  # 2-complement
+   do
+      not (E DIG)  # Invert
+      ld C (E BIG)  # Next digit
+      cnt C  # Done?
+   while z  # No
+      ld E C  # Next digit
+   loop
+   xor C -16  # Invert final short
+   ld (E BIG) C
+   ld E A  # Result again
+   do
+      add (E DIG) 1  # Increment
+      jnc 90  # Skip if no carry
+      ld C (E BIG)  # Next digit
+      cnt C  # Done?
+   while z  # No
+      ld E C  # Next digit
+   loop
+   add C (hex "10")  # Increment final short
+   ld (E BIG) C
+90 drop
+   pop X
+   call zapZeroA_A  # Remove leading zeroes
+   or A SIGN  # Set negative
+   ret
+
+# Multiply two (unsigned) numbers
+(code 'muluAE_A 0)
+   cnt A  # A short?
+   if nz  # Yes
+      zero A  # Multiply with zero?
+      jeq ret  # Yes: Return zero
+      shr A 4  # Normalize
+      cnt E  # E also short?
+      if nz  # Yes
+         xchg A E
+         shr A 4  # Normalize
+         mul E  # Multiply
+         if nc  # Only lower word
+            test A (hex "F000000000000000")  # Fit in short number?
+            if z  # Yes
+               shl A 4  # Make short number
+               or A CNT
+               ret
+            end
+         end
+         shl C 4  # Make short number
+         or C CNT
+         jmp consNumAC_A  # Return bignum
+      end
+10    push X
+      push Y
+      push Z
+      ld Y A  # Save digit in Y
+      mul (E DIG)  # Multiply lowest digit
+      call boxNum_X  # First cell
+      ld (X DIG) A
+      link
+      push X  # <L I> Safe
+      link
+      ld Z C  # Keep upper word in Z
+      do
+         ld E (E BIG)
+         cnt E  # End of bignum?
+      while z  # No
+         ld A (E DIG)  # Get next digit
+         mul Y  # Multiply digit
+         add D Z  # Add previous upper word
+         ld Z C
+         call boxNum_C  # Next cell
+         ld (C DIG) A
+         ld (X BIG) C
+         ld X C
+      loop
+      ld A Y  # Retrieve digit
+      shr E 4  # Normalize
+      mul E  # Multiply
+      add D Z  # Add previous upper word
+      if z  # Only lower word
+         test A (hex "F000000000000000")  # Fit in short number?
+         if z  # Yes
+            shl A 4  # Make short number
+            or A CNT
+20          ld (X BIG) A  # Store in final cell
+            ld A (L I)  # Return bignum
+            drop
+            pop Z
+            pop Y
+            pop X
+            ret
+         end
+      end
+      shl C 4  # Make short number
+      or C CNT
+      call consNumAC_A  # Return bignum
+      jmp 20
+   end
+   # A is big
+   cnt E  # E short?
+   if nz  # Yes
+      zero E  # Multiply with zero?
+      jeq ret  # Yes: Return zero
+      xchg A E  # Exchange args
+      shr A 4  # Normalize
+      jmp 10
+   end
+   # Both are big
+   push X
+   push Y
+   push Z
+   ld Y A  # Arg1 in Y
+   ld Z E  # Arg2 in Z
+   call boxNum_X  # Zero bignum
+   ld (X DIG) 0
+   link
+   push X  # <L I> Safe
+   link
+   push X  # <L -I> Safe index
+   push Y  # <L -II> Arg1 index
+   do
+      ld A (Y DIG)  # Multiply digits
+      mul (Z DIG)
+      add D (X DIG)  # Add lower word to safe
+      do
+         ld (X DIG) A  # Store lower word
+         ld E C  # Keep upper word in E
+         ld A (X BIG)  # Next safe cell
+         cnt A  # End of safe?
+         if nz  # Yes
+            call boxNum_A  # Extend safe
+            ld (A DIG) 0
+            ld (X BIG) A
+         end
+         ld X A
+         ld Y (Y BIG)  # Next cell of Arg1
+         cnt Y #  End of bignum?
+      while z  # No
+         ld A (Y DIG)  # Multiply digits
+         mul (Z DIG)
+         add D (X DIG)  # Add safe
+         addc D E  # plus carry
+      loop
+      ld A Y  # Final short number
+      shr A 4  # Normalize
+      mul (Z DIG)
+      add D (X DIG)  # Add safe
+      addc D E  # plus carry
+      ld (X DIG) A
+      if nz  # Uppper word
+         ld A (X BIG)  # Next safe cell
+         cnt A  # End of safe?
+         if nz  # Yes
+            call boxNum_A  # Extend safe
+            ld (A DIG) 0
+            ld (X BIG) A
+         end
+         ld (A DIG) C  # Store uppper word
+      end
+      ld Y (L -II)  # Get Arg1 index
+      ld X ((L -I) BIG)  # Advance safe index
+      ld (L -I) X
+      ld Z (Z BIG)  # Next cell of Arg2
+      cnt Z #  End of bignum?
+   until nz  # Yes
+   ld A Z
+   shr A 4  # Normalize
+   ld Z A
+   mul (Y DIG)  # Multiply digit
+   add D (X DIG)  # Add lower word to safe
+   do
+      ld (X DIG) A  # Store lower word
+      ld E C  # Keep upper word in E
+      ld A (X BIG)  # Next safe cell
+      cnt A  # End of safe?
+      if nz  # Yes
+         call boxNum_A  # Extend safe
+         ld (A DIG) 0
+         ld (X BIG) A
+      end
+      ld X A
+      ld Y (Y BIG)  # Next cell of Arg1
+      cnt Y #  End of bignum?
+   while z  # No
+      ld A (Y DIG)  # Multiply digit
+      mul Z
+      add D (X DIG)  # Add safe
+      addc D E  # plus carry
+   loop
+   ld A Y  # Final short number
+   shr A 4  # Normalize
+   mul Z  # Multiply digit
+   add D (X DIG)  # Add safe
+   addc D E  # plus carry
+   ld (X DIG) A
+   if nz  # Uppper word
+      ld A (X BIG)  # Next safe cell
+      cnt A  # End of safe?
+      if nz  # Yes
+         call boxNum_A  # Extend safe
+         ld (A DIG) 0
+         ld (X BIG) A
+      end
+      ld (A DIG) C  # Store uppper word
+   end
+   ld A (L I)  # Return bignum
+   drop
+   pop Z
+   pop Y
+   pop X
+   jmp zapZeroA_A  # Remove leading zeroes
+
+# Divide two (unsigned) numbers
+(code 'divuAE_AC 0)
+   cnt A  # A short?
+   if nz  # Yes
+      cnt E  # E also short?
+      if nz  # Yes
+         shr A 4  # Normalize A
+         ld C 0
+         shr E 4  # Normalize E
+         div E  # Divide
+         shl A 4  # Make short number
+         or A CNT  # Quotient
+         shl C 4
+         or C CNT  # Remainder
+         ret
+      end
+      ld C A
+      ld A ZERO  # Else return zero
+      ret
+   end
+   link
+   push ZERO  # <L III> Quotient
+   push A  # <L II> Dividend
+   push E  # <L I> Divisor
+   link
+   # Calculate dividend's bit count
+   ld C 0  # Counter
+   do
+      cnt (A BIG)  # Last cell?
+   while z  # No
+      add C 64  # Increment by digit size
+      ld A (A BIG)
+   loop
+   zero (A BIG)  # Last short zero?
+   if eq  # Yes
+      ld A (A DIG)  # Take last digit
+   else
+      add C 64  # Increment for last digit
+      ld A (A BIG)  # Take last short
+      shr A 4  # Normalize
+   end
+   do
+      add C 1  # Increment counter
+      shr A 1  # More bits?
+   until z  # No
+   # Subtract divisor's bit count
+   cnt E  # E short?
+   if nz  # Yes
+      shr E 4  # Normalize
+      do
+         sub C 1  # Decrement counter
+         shr E 1  # More bits?
+      until z  # No
+   else
+      do
+         cnt (E BIG)  # Last cell?
+      while z  # No
+         sub C 64  # Decrement by digit size
+         ld E (E BIG)
+      loop
+      zero (E BIG)  # Last short zero?
+      if eq  # Yes
+         ld E (E DIG)  # Take last digit
+      else
+         sub C 64  # Decrement for last digit
+         ld E (E BIG)  # Take last short
+         shr E 4  # Normalize
+      end
+      do
+         sub C 1  # Decrement counter
+         shr E 1  # More bits?
+      until z  # No
+   end
+   push C  # <L -I> Shift offsets
+   add C 1
+   push C  # <L -II>
+   sub (L -I) 1  # Any shift?
+   if ns  # Yes
+      ld A (L I)  # Get divisor
+      call shluA_A  # Shift (non-destructive)
+      ld (L I) A
+      ld C (L -I)  # Shift offset
+      do
+         cmp C 64  # More than 64 bits?
+      while ge  # Yes
+         sub C 64  # Decrement shift count by digit size
+         ld E 0  # Cons zero
+         call consNumEA_A
+      loop
+      ld (L I) A  # Save shifted divisor
+      ld (L -I) C  # Save remaining count
+      do
+         sub (L -I) 1  # Shift remaining bits?
+      while ns  # Yes
+         call twiceA_A  # Shift divisor left (destructive)
+         ld (L I) A  # Save again
+      loop
+   end
+   do
+      sub (L -II) 1  # Division steps?
+   while ns  # Yes
+      ld A (L III)  # Get quotient
+      call twiceA_A  # Shift (destructive)
+      ld (L III) A
+      ld E (L II)  # Get dividend
+      ld A (L I)  # and divisor
+      call cmpuAE_F  # Divisor <= dividend?
+      if le  # Yes
+         ld A (L II)  # Subtract divisor from dividend
+         ld E (L I)
+         call subuAE_A
+         ld (L II) A  # Save dividend
+         ld A (L III)  # Quotient
+         cnt A  # Short?
+         if nz  # Yes
+            add B (hex "10")  # Increment short
+            ld (L III) A
+         else
+            add (A DIG) 1  # Increment digit
+         end
+      end
+      ld A (L I)  # Divisor
+      call shruA_A  # Shift divisor right (non-destructive)
+      ld (L I) A
+   loop
+   ld A (L III)  # Return quotient in A
+   ld C (L II)  # and remainder in C
+   drop
+   ret
+
+# Increment a (signed) number
+(code 'incE_A 0)
+   ld A ONE
+   test E SIGN  # Positive?
+   jz adduAE_A  # Increment
+   off E SIGN  # Make positive
+   call subuAE_A  # Subtract
+   zero A  # Zero?
+   if ne  # No
+      or A SIGN  # Negate again
+   end
+   ret
+
+# Decrement a (signed) number
+(code 'decE_A 0)
+   ld A ONE
+   test E SIGN  # Positive?
+   if z  # Yes
+      xchg A E
+      jmp subuAE_A  # Decrement
+   end
+   off E SIGN  # Make positive
+   call adduAE_A  # Add
+   or A SIGN  # Negate again
+   ret
+
+# Add two (signed) numbers
+(code 'addAE_A 0)
+   test A SIGN  # Positive?
+   if z  # Yes
+      test E SIGN  # Arg also positive?
+      jz adduAE_A  # Add [+ A E]
+      off E SIGN  # [+ A -E]
+      jmp subuAE_A  # Sub
+   end
+   # Result negatve
+   test E SIGN  # Arg positive?
+   if z  # [+ -A E]
+      off A SIGN
+      call subuAE_A  # Sub
+   else  # [+ -A -E]
+      off A SIGN
+      off E SIGN
+      call adduAE_A  # Add
+   end
+   zero A  # Zero?
+   if ne  # No
+      xor A SIGN  # Negate
+   end
+   ret
+
+# Subtract to (signed) numbers
+(code 'subAE_A 0)
+   test A SIGN  # Positive?
+   if z  # Yes
+      test E SIGN  # Arg also positive?
+      jz subuAE_A  # Sub [- A E]
+      off E SIGN  # [- A -E]
+      jmp adduAE_A  # Add
+   end
+   # Result negatve
+   test E SIGN  # Arg positive?
+   if z  # [- -A E]
+      off A SIGN
+      call adduAE_A  # Add
+   else  # [- -A -E]
+      off A SIGN
+      off E SIGN
+      call subuAE_A  # Sub
+   end
+   zero A  # Zero?
+   if ne  # No
+      xor A SIGN  # Negate
+   end
+   ret
+
+### Comparisons ###
+(code 'cmpNumAE_F 0)
+   test A SIGN  # A positive?
+   if z  # Yes
+      test E SIGN  # E also positive?
+      jz cmpuAE_F  # Yes [A E]
+      clrc  # gt [A -E]
+      ret
+   end
+   # A negative
+   test E SIGN  # E positive?
+   if z  # Yes
+      or B B  # nz [-A E]
+      setc  # lt
+      ret
+   end
+   xchg A E  # [-A -E]
+   off A SIGN
+   off E SIGN
+
+# Compare two (unsigned) numbers
+(code 'cmpuAE_F 0)
+   cnt A  # A short?
+   if nz  # Yes
+      cnt E  # E also short?
+      if nz  # Yes
+         cmp A E  # F
+         ret
+      end
+      or B B  # nz (E is big)
+      setc  # lt
+      ret
+   end
+   # A is big
+   cnt E  # E short?
+   if nz  # Yes
+      clrc  # gt (E is short)
+      ret
+   end
+   # Both are big
+   push X
+   push Y
+   ld X 0  # Clear reverse pointers
+   ld Y 0
+   do
+      ld C (A BIG)  # Tails equal?
+      cmp C (E BIG)
+      if eq  # Yes
+         do
+            ld C (A DIG)  # Compare digits
+            cmp C (E DIG)
+         while eq
+            null X  # End of reversed list?
+            if z  # Yes
+               pop Y  # eq
+               pop X
+               ret
+            end
+            ld C (X BIG)  # Restore A
+            ld (X BIG) A
+            ld A X
+            ld X C
+            ld C (Y BIG)  # Restore E
+            ld (Y BIG) E
+            ld E Y
+            ld Y C
+         loop
+         push F
+         break T
+      end
+      cnt C  # End of A?
+      if nz  # Yes
+         cnt (E BIG)  # Also end of E?
+         if nz  # Yes
+            cmp C (E BIG)  # F
+         else
+            or B B  # nz (E is bigger)
+            setc  # lt
+         end
+         push F
+         break T
+      end
+      cnt (E BIG)  # End of E?
+      if nz  # Yes
+         clrc  # gt
+         push F
+         break T
+      end
+      ld (A BIG) X  # Reverse A
+      ld X A
+      ld A C
+      ld C (E BIG)  # Reverse E
+      ld (E BIG) Y
+      ld Y E
+      ld E C
+   loop
+   do
+      null X  # Reversed?
+   while nz  # Yes
+      ld C (X BIG)  # Restore A
+      ld (X BIG) A
+      ld A X
+      ld X C
+      ld C (Y BIG)  # Restore E
+      ld (Y BIG) E
+      ld E Y
+      ld Y C
+   loop
+   pop F  # Return flags
+   pop Y
+   pop X
+   ret
+
+### Conversions ###
+# Make number from symbol
+(code 'symToNumXA_FE 0)
+   link
+   push ZERO  # <L I> Safe
+   link
+   push A  # <L -I> Scale
+   push 0  # <L -II> Sign flag
+   push 0  # <L -III> Fraction flag
+   ld C 0
+   call symByteCX_FACX  # Get first byte
+   jz 99  # None
+   do
+      cmp B 32  # Skip white space
+   while le
+      call symByteCX_FACX  # Next byte
+      jz 99  # None
+   loop
+   cmp B (char "+")  # Plus sign?
+   jz 10  # Yes
+   cmp B (char "-")  # Plus sign?
+   if eq  # Yes
+      or (L -II) 1  # Set Sign
+10    call symByteCX_FACX  # Next byte
+      jz 99  # None
+   end
+   sub A (char "0")  # First digit
+   cmp A 10  # Too big?
+   jnc 99  # Return NO
+   shl A 4  # Make short number
+   or A CNT
+   ld (L I) A  # Save
+   do
+      call symCharCX_FACX  # More?
+   while nz  # Yes
+      test (L -III) 1  # Fraction?
+      if nz  # Yes
+         null (L -I)  # Scale?
+         if z  # No
+            sub A (char "0")  # Next digit
+            cmp A 10  # Too big?
+            jnc 99  # Return NO
+            cmp A 5  # Round?
+            if ge  # Yes
+               ld A ONE  # Increment
+               ld E (L I)
+               push C
+               call adduAE_A
+               pop C
+               ld (L I) A
+            end
+            do
+               call symByteCX_FACX  # More?
+            while nz  # Yes
+               sub A (char "0")  # Next digit
+               cmp A 10  # Too big?
+               jnc 99  # Return NO
+            loop
+            break T
+         end
+      end
+      cmp A (Sep0)  # Decimal separator?
+      if eq  # Yes
+         test (L -III) 1  # Fraction?
+         jnz 99  # Return NO
+         or (L -III) 1  # Set Fraction
+      else
+         cmp A (Sep3)  # Thousand separator?
+         if ne  # No
+            sub A (char "0")  # Next digit
+            cmp A 10  # Too big?
+            jnc 99  # Return NO
+            push C  # Save symByte args
+            push X
+            push A  # Save digit
+            ld A (L I)  # Multiply number by 10
+            call tenfoldA_A
+            ld (L I) A  # Save
+            pop E  # Get digit
+            shl E 4  # Make short number
+            or E CNT
+            call adduAE_A  # Add to number
+            ld (L I) A  # Save again
+            pop X  # Pop symByte args
+            pop C
+            test (L -III) 1  # Fraction?
+            if nz  # Yes
+               sub (L -I) 1  # Decrement Scale
+            end
+         end
+      end
+   loop
+   test (L -III) 1  # Fraction?
+   if nz  # Yes
+      do
+         sub (L -I) 1  # Decrement Scale
+      while nc  # >= 0
+         ld A (L I)  # Multiply number by 10
+         call tenfoldA_A
+         ld (L I) A  # Save
+      loop
+   end
+   ld E (L I)  # Get result
+   test (L -II) 1  # Sign?
+   if nz  # Yes
+      zero E  # Zero?
+      if ne  # No
+         xor E SIGN  # Negate
+      end
+   end
+   setc  # Return YES
+99 drop
+   ret
+
+# Format number to output, length, or symbol
+(code 'fmtNum0AE_E 0)
+   ld (Sep3) 0  # Thousand separator 0
+   ld (Sep0) 0  # Decimal separator 0
+(code 'fmtNumAE_E)
+   push C
+   push X
+   push Y
+   push Z
+   link
+   push ZERO  # <L I> Name
+   link
+   push A  # <L -I> Scale
+   ld A E  # Get number
+   cnt A  # Short number?
+   if nz  # Yes
+      push 16  # <L -II> mask
+   else
+      push 1  # <L -II> mask
+   end
+   shr B 3  # Get sign bit
+   push A  # <L -III> Sign flag
+   off E SIGN
+   # Calculate buffer size
+   ld A 19  # Decimal length of 'cnt' (60 bit)
+   ld C E  # Get number
+   do
+      cnt C  # Last digit?
+   while z  # No
+      add A 20  # Add decimal length of 'digit' (64 bit)
+      ld C (C BIG)
+   loop
+   add A 17  # Round up
+   ld C 0  # Divide by 18
+   div 18
+   shl A 3  # Word count
+   sub S A  # Space for incrementor
+   ld (S) 1  # Init to '1'
+   ld X S  # Keep pointer to incrementor in X
+   sub S A  # <S III> Accumulator
+   ld (S) 0  # Init to '0'
+   push S # <S II> Top of accumulator
+   push X  # <S I> Pointer to incrementor
+   push X  # <S> Top of incrementor
+   do
+      cnt E  # Short number?
+      ldnz Z E  # Yes
+      if z
+         ld Z (E DIG)  # Digit in Z
+      end
+      do
+         ld A Z  # Current digit
+         test A (L -II)  # Test next bit with mask
+         if nz
+            # Add incrementor to accumulator
+            ld C 0  # Carry for BCD addition
+            lea X (S III)  # Accumulator
+            ld Y (S I)  # Incrementor
+            do
+               cmp X (S II)  # X > Top of accumulator?
+               if gt  # Yes
+                  add (S II) 8  # Extend accumulator
+                  ld (X) 0  # with '0'
+               end
+               ld A (X)
+               add A (Y)  # Add BCD
+               add A C  # Add BCD-Carry
+               ld C 0  # Clear BCD-Carry
+               cmp A 1000000000000000000  # BCD overflow?
+               if nc  # Yes
+                  sub A 1000000000000000000
+                  ld C 1  # Set BCD-Carry
+               end
+               ld (X) A  # Store BCD digit in accumulator
+               add X 8
+               add Y 8
+               cmp Y (S)  # Reached top of incrementor?
+            until gt  # Yes
+            null C  # BCD-Carry?
+            if ne  # Yes
+               add (S II) 8  # Extend accumulator
+               ld (X) 1  # With '1'
+            end
+         end
+         # Shift incrementor left
+         ld C 0  # Clear BCD-Carry
+         ld Y (S I)  # Incrementor
+         do
+            ld A (Y)
+            add A A  # Double
+            add A C  # Add BCD-Carry
+            ld C 0  # Clear BCD-Carry
+            cmp A 1000000000000000000  # BCD overflow?
+            if nc  # Yes
+               sub A 1000000000000000000
+               ld C 1  # Set BCD-Carry
+            end
+            ld (Y) A  # Store BCD digit in incrementor
+            add Y 8
+            cmp Y (S)  # Reached top of incrementor?
+         until gt  # Yes
+         null C  # BCD-Carry?
+         if ne  # Yes
+            add (S) 8  # Extend incrementor
+            ld (Y) 1  # With '1'
+         end
+         shl (L -II) 1  # Shift bit mask
+      until z
+      cnt E  # Short number?
+   while z  # No
+      ld E (E BIG)  # Next digit
+      cnt E  # Short number?
+      if nz  # Yes
+         ld A 16  # Mask
+      else
+         ld A 1
+      end
+      ld (L -II) A  # Set bit mask
+   loop
+   ld Y (S II)  # Top of accumulator
+   lea Z (S III)  # Accumulator
+   null (L -I)  # Scale negative?
+   if s  # Yes
+      cmp (L -I) -1  # Direct print?
+      if eq  # Yes
+         test (L -III) 1  # Sign?
+         if nz  # Yes
+            ld B (char "-")  # Output sign
+            call (EnvPutB)
+         end
+         ld A (Y)  # Output highest word
+         call outWordA
+         do
+            sub Y 8  # More?
+            cmp Y Z
+         while ge  # Yes
+            ld A (Y)  # Output words in reverse order
+            ld E 100000000000000000  # Digit scale
+            do
+               ld C 0  # Divide by digit scale
+               div E
+               push C  # Save remainder
+               add B (char "0")  # Output next digit
+               call (EnvPutB)
+               cmp E 1  # Done?
+            while ne  # No
+               ld C 0  # Divide digit scale by 10
+               ld A E
+               div 10
+               ld E A
+               pop A  # Get remainder
+            loop
+         loop
+      else  # Calculate length
+         ld A Y  # Top of accumulator
+         sub A Z  # Accumulator
+         shr A 3  # Number of accumulator words
+         mul 18  # Number of digits
+         ld E A
+         ld A (Y)  # Length of highest word
+         do
+            add E 1  # Increment length
+            ld C 0  # Divide by 10
+            div 10
+            null A  # Done?
+         until z  # Yes
+         test (L -III) 1  # Sign?
+         if nz  # Yes
+            add E 1  # Space for '-'
+         end
+         shl E 4  # Make short number
+         or E CNT
+      end
+      drop
+   else
+      ld C 4  # Build name
+      lea X (L I)
+      test (L -III) 1  # Sign?
+      if nz  # Yes
+         ld B (char "-")  # Insert sign
+         call byteSymBCX_CX
+      end
+      push C  # Save name index
+      ld A Y  # Top of accumulator
+      sub A Z  # Accumulator
+      shr A 3  # Number of accumulator words
+      mul 18  # Number of digits
+      ld E A  # Calculate length-1
+      ld A (Y)  # Highest word
+      do
+         ld C 0  # Divide by 10
+         div 10
+         null A  # Done?
+      while nz  # No
+         add E 1  # Increment length
+      loop
+      pop C  # Restore name index
+      sub E (L -I)  # Scale
+      ld (L -I) E  # Decrement by Length-1
+      if lt  # Scale < 0
+         ld B (char "0")  # Prepend '0'
+         call byteSymBCX_CX
+         ld A (Sep0)  # Prepend decimal separator
+         call charSymACX_CX
+         do
+            cmp (L -I) -1   # Scale
+         while lt
+            add (L -I) 1  # Increment scale
+            ld B (char "0")  # Ouput zeroes
+            call byteSymBCX_CX
+         loop
+      end
+      ld A (Y)  # Pack highest word
+      call fmtWordACX_CX
+      do
+         sub Y 8  # More?
+         cmp Y Z
+      while ge  # Yes
+         ld A (Y)  # Pack words in reverse order
+         ld E 100000000000000000  # Digit scale
+         do
+            push A
+            call fmtScaleCX_CX  # Handle scale character(s)
+            pop A
+            push C  # Save name index
+            ld C 0  # Divide by digit scale
+            div E
+            xchg C (S)  # Save remainder, restore name index
+            add B (char "0")  # Pack next digit
+            call byteSymBCX_CX
+            cmp E 1  # Done?
+         while ne  # No
+            push C  # Save name index
+            ld C 0  # Divide digit scale by 10
+            ld A E
+            div 10
+            pop C  # Restore name index
+            ld E A
+            pop A  # Get remainder
+         loop
+      loop
+      ld X (L I)  # Get name
+      drop
+      call consSymX_E
+   end
+   pop Z
+   pop Y
+   pop X
+   pop C
+   ret
+
+(code 'fmtWordACX_CX 0)
+   cmp A 9  # Single digit?
+   if gt  # No
+      ld E C  # Save C
+      ld C 0  # Divide by 10
+      div 10
+      push C  # Save remainder
+      ld C E  # Restore C
+      call fmtWordACX_CX  # Recurse
+      call fmtScaleCX_CX  # Handle scale character(s)
+      pop A
+   end
+   add B (char "0")  # Make ASCII digit
+   jmp byteSymBCX_CX
+
+(code 'fmtScaleCX_CX 0)
+   null (L -I)  # Scale null?
+   if z  # Yes
+      ld A (Sep0)  # Output decimal separator
+      call charSymACX_CX
+   else
+      null (Sep3)  # Thousand separator?
+      if nz  # Yes
+         ld A (L -I)  # Scale > 0?
+         null A
+         if nsz  # Yes
+            push C
+            ld C 0  # Modulus 3
+            div 3
+            null C
+            pop C
+            if z
+               ld A (Sep3)  # Output thousand separator
+               call charSymACX_CX
+            end
+         end
+      end
+   end
+   sub (L -I) 1  # Decrement scale
+   ret
+
+# (format 'num ['cnt ['sym1 ['sym2]]]) -> sym
+# (format 'sym ['cnt ['sym1 ['sym2]]]) -> num
+(code 'doFormat 2)
+   push X
+   push Y
+   ld X E
+   ld Y (E CDR)  # Y on args
+   ld E (Y)  # Eval first
+   eval
+   link
+   push E  # <L I> 'num' | 'sym'
+   link
+   atom E  # Need atom
+   jz atomErrEX
+   ld Y (Y CDR)  # Second arg
+   ld E (Y)
+   eval  # Eval 'cnt'
+   cmp E Nil  # Any?
+   if eq  # No
+      ld E 0  # Zero
+   else
+      call xCntEX_FE  # Extract 'cnt'
+   end
+   push E  # <L -I> Scale
+   push (char ".")  # <L -II> Sep0
+   push 0  # Sep3
+   ld Y (Y CDR)  # Third arg?
+   atom Y
+   if z  # Yes
+      ld E (Y)
+      eval  # Eval 'sym1'
+      num E  # Need symbol
+      jnz symErrEX
+      sym E
+      jz symErrEX
+      call firstCharE_A
+      ld (L -II) A  # Sep0
+      ld Y (Y CDR)  # Fourth arg?
+      atom Y
+      if z  # Yes
+         ld E (Y)
+         eval  # Eval 'sym2'
+         num E  # Need symbol
+         jnz symErrEX
+         sym E
+         jz symErrEX
+         call firstCharE_A
+         ld (S) A
+      end
+   end
+   pop (Sep3)  # Get Sep3
+   pop (Sep0)  # and Sep0
+   pop A  # Get scale
+   ld E (L I)  # Get 'num' | 'sym'
+   num E  # Number?
+   if nz  # Yes
+      call fmtNumAE_E  # Convert to string
+   else
+      ld X (E TAIL)
+      call nameX_X  # Get name
+      call symToNumXA_FE  # Convert to number
+      if nc  # Failed
+         ld E Nil
+      end
+   end
+   drop
+   pop Y
+   pop X
+   ret
+
+### Arithmetics ###
+# (+ 'num ..) -> num
+(code 'doAdd 2)
+   push X
+   push Y
+   ld X E
+   ld Y (E CDR)  # Y on args
+   ld E (Y)
+   eval  # Eval first arg
+   cmp E Nil
+   if ne  # Non-NIL
+      num E  # Number?
+      jz numErrEX  # No
+      link
+      push ZERO  # <L II> Safe
+      push E  # <L I> Result
+      link
+      do
+         ld Y (Y CDR)  # More args?
+         atom Y
+      while z  # Yes
+         ld E (Y)
+         eval  # Eval next arg
+         cmp E Nil
+         jz 10  # Abort if NIL
+         num E  # Number?
+         jz numErrEX  # No
+         ld (L II) E  # Save arg
+         ld A (L I)  # Result
+         call addAE_A  # Add
+         ld (L I) A  # Result
+      loop
+      ld E (L I)  # Result
+10    drop
+   end
+   pop Y
+   pop X
+   ret
+
+# (- 'num ..) -> num
+(code 'doSub 2)
+   push X
+   push Y
+   ld X E
+   ld Y (E CDR)  # Y on args
+   ld E (Y)
+   eval  # Eval first arg
+   cmp E Nil
+   if ne  # Non-NIL
+      num E  # Number?
+      jz numErrEX  # No
+      ld Y (Y CDR)  # More than one arg?
+      atom Y
+      if nz  # No: Unary minus
+         zero E  # Zero?
+         if ne  # No
+            xor E SIGN  # Negate
+         end
+      else
+         link
+         push ZERO  # <L II> Safe
+         push E  # <L I> Result
+         link
+         do
+            ld E (Y)
+            eval  # Eval next arg
+            cmp E Nil
+            jz 10  # Abort if NIL
+            num E  # Number?
+            jz numErrEX  # No
+            ld (L II) E  # Save arg
+            ld A (L I)  # Result
+            call subAE_A  # Subtract
+            ld (L I) A  # Result
+            ld Y (Y CDR)  # More args?
+            atom Y
+         until nz  # No
+         ld E (L I)  # Result
+10       drop
+      end
+   end
+   pop Y
+   pop X
+   ret
+
+# (inc 'num) -> num
+# (inc 'var ['num]) -> num
+(code 'doInc 2)
+   push X
+   push Y
+   ld X E
+   ld Y (E CDR)  # Y on args
+   ld E (Y)
+   eval  # Eval first arg
+   cmp E Nil
+   if ne  # Non-NIL
+      link
+      push E  # <L I/II> First arg
+      link
+      num E  # Number?
+      if nz  # Yes
+         call incE_A  # Increment it
+      else
+         call checkVarEX
+         sym E  # Symbol?
+         if nz  # Yes
+            sym (E TAIL)  # External symbol?
+            if nz  # Yes
+               call dbTouchEX  # Touch it
+            end
+         end
+         ld Y (Y CDR)  # Next arg?
+         atom Y
+         if nz  # No
+            ld E (E)  # Get VAL
+            cmp E Nil  # NIL?
+            ldz A E
+            if ne  # No
+               num E  # Number?
+               jz numErrEX  # No
+               call incE_A  # Increment it
+               ld ((L I)) A  # Set new value
+            end
+         else
+            ld E (Y)
+            eval  # Eval next arg
+            tuck E  # <L I> Second arg
+            link
+            ld A ((L II))  # First arg's VAL
+            cmp A Nil  # NIL?
+            if ne  # No
+               num A  # Number?
+               jz numErrAX  # No
+               ld E (L I)  # Second arg
+               cmp E Nil  # NIL?
+               ldz A E
+               if ne  # No
+                  num E
+                  jz numErrEX  # No
+                  call addAE_A  # Add
+                  ld ((L II)) A  # Set new value
+               end
+            end
+         end
+      end
+      ld E A  # Get result
+      drop
+   end
+   pop Y
+   pop X
+   ret
+
+# (dec 'num) -> num
+# (dec 'var ['num]) -> num
+(code 'doDec 2)
+   push X
+   push Y
+   ld X E
+   ld Y (E CDR)  # Y on args
+   ld E (Y)
+   eval  # Eval first arg
+   cmp E Nil
+   if ne  # Non-NIL
+      link
+      push E  # <L I/II> First arg
+      link
+      num E  # Number?
+      if nz  # Yes
+         call decE_A  # Decrement it
+      else
+         call checkVarEX
+         sym E  # Symbol?
+         if nz  # Yes
+            sym (E TAIL)  # External symbol?
+            if nz  # Yes
+               call dbTouchEX  # Touch it
+            end
+         end
+         ld Y (Y CDR)  # Next arg?
+         atom Y
+         if nz  # No
+            ld E (E)  # Get VAL
+            cmp E Nil  # NIL?
+            ldz A E
+            if ne  # No
+               num E  # Number?
+               jz numErrEX  # No
+               call decE_A  # Decrement it
+               ld ((L I)) A  # Set new value
+            end
+         else
+            ld E (Y)
+            eval  # Eval next arg
+            tuck E  # <L I> Second arg
+            link
+            ld A ((L II))  # First arg's VAL
+            cmp A Nil  # NIL?
+            if ne  # No
+               num A  # Number?
+               jz numErrAX  # No
+               ld E (L I)  # Second arg
+               cmp E Nil  # NIL?
+               ldz A E
+               if ne  # No
+                  num E
+                  jz numErrEX  # No
+                  call subAE_A  # Subtract
+                  ld ((L II)) A  # Set new value
+               end
+            end
+         end
+      end
+      ld E A  # Get result
+      drop
+   end
+   pop Y
+   pop X
+   ret
+
+# (* 'num ..) -> num
+(code 'doMul 2)
+   push X
+   push Y
+   ld X E
+   ld Y (E CDR)  # Y on args
+   ld E (Y)
+   eval  # Eval first arg
+   cmp E Nil
+   if ne  # Non-NIL
+      num E  # Number?
+      jz numErrEX  # No
+      ld B 0  # Init sign
+      test E SIGN
+      if nz
+         off E SIGN
+         add B 1
+      end
+      link
+      push ZERO  # <L II> Safe
+      push E  # <L I> Result
+      link
+      push A  # <L -I> Sign flag
+      do
+         ld Y (Y CDR)  # More args?
+         atom Y
+      while z  # Yes
+         ld E (Y)
+         eval  # Eval next arg
+         cmp E Nil
+         jz 10  # Abort if NIL
+         num E  # Number?
+         jz numErrEX  # No
+         test E SIGN  # Arg negative?
+         if nz  # Yes
+            off E SIGN  # Make argument positive
+            xor (L -I) 1  # Toggle result sign
+         end
+         ld (L II) E  # Save arg
+         ld A (L I)  # Result
+         call muluAE_A  # Multiply
+         ld (L I) A  # Result
+      loop
+      ld E (L I)  # Result
+      test (L -I) 1  # Sign?
+      if nz  # Yes
+         zero E  # Zero?
+         if ne  # No
+            or E SIGN  # Set negative
+         end
+      end
+10    drop
+   end
+   pop Y
+   pop X
+   ret
+
+# (*/ 'num1 ['num2 ..] 'num3) -> num
+(code 'doMulDiv 2)
+   push X
+   push Y
+   ld X E
+   ld Y (E CDR)  # Y on args
+   ld E (Y)
+   eval  # Eval first arg
+   cmp E Nil
+   if ne  # Non-NIL
+      num E  # Number?
+      jz numErrEX  # No
+      ld B 0  # Init sign
+      test E SIGN
+      if nz
+         off E SIGN
+         add B 1
+      end
+      link
+      push ZERO  # <L II> Safe
+      push E  # <L I> Result
+      link
+      push A  # <L -I> Sign flag
+      do
+         ld Y (Y CDR)  # Next arg
+         ld E (Y)
+         eval  # Eval next arg
+         cmp E Nil
+         jz 10  # Abort if NIL
+         num E  # Number?
+         jz numErrEX  # No
+         test E SIGN  # Arg negative?
+         if nz  # Yes
+            off E SIGN  # Make argument positive
+            xor (L -I) 1  # Toggle result sign
+         end
+         ld (L II) E  # Save arg
+         atom (Y CDR)  # More args?
+      while z  # Yes
+         ld A (L I)  # Result
+         call muluAE_A  # Multiply
+         ld (L I) A  # Result
+      loop
+      zero E  # Zero?
+      jeq divErrX  # Yes
+      ld A E  # Last argument
+      call shruA_A  # / 2
+      ld E (L I)  # Product
+      call adduAE_A  # Add for rounding
+      ld E (L II)  # Last argument
+      call divuAE_AC  # Divide
+      ld E A  # Result
+      test (L -I) 1  # Sign?
+      if nz  # Yes
+         zero E  # Zero?
+         if ne  # No
+            or E SIGN  # Set negative
+         end
+      end
+10    drop
+   end
+   pop Y
+   pop X
+   ret
+
+# (/ 'num ..) -> num
+(code 'doDiv 2)
+   push X
+   push Y
+   ld X E
+   ld Y (E CDR)  # Y on args
+   ld E (Y)
+   eval  # Eval first arg
+   cmp E Nil
+   if ne  # Non-NIL
+      num E  # Number?
+      jz numErrEX  # No
+      ld B 0  # Init sign
+      test E SIGN
+      if nz
+         off E SIGN
+         add B 1
+      end
+      link
+      push ZERO  # <L II> Safe
+      push E  # <L I> Result
+      link
+      push A  # <L -I> Sign flag
+      do
+         ld Y (Y CDR)  # More args?
+         atom Y
+      while z  # Yes
+         ld E (Y)
+         eval  # Eval next arg
+         cmp E Nil
+         jz 10  # Abort if NIL
+         num E  # Number?
+         jz numErrEX  # No
+         zero E  # Zero?
+         jeq divErrX  # Yes
+         test E SIGN  # Arg negative?
+         if nz  # Yes
+            off E SIGN  # Make argument positive
+            xor (L -I) 1  # Toggle result sign
+         end
+         ld (L II) E  # Save arg
+         ld A (L I)  # Result
+         call divuAE_AC  # Divide
+         ld (L I) A  # Result
+      loop
+      ld E (L I)  # Result
+      test (L -I) 1  # Sign?
+      if nz  # Yes
+         zero E  # Zero?
+         if ne  # No
+            or E SIGN  # Set negative
+         end
+      end
+10    drop
+   end
+   pop Y
+   pop X
+   ret
+
+# (% 'num ..) -> num
+(code 'doRem 2)
+   push X
+   push Y
+   ld X E
+   ld Y (E CDR)  # Y on args
+   ld E (Y)
+   eval  # Eval first arg
+   cmp E Nil
+   if ne  # Non-NIL
+      num E  # Number?
+      jz numErrEX  # No
+      ld B 0  # Init sign
+      test E SIGN
+      if nz
+         off E SIGN
+         ld B 1
+      end
+      link
+      push ZERO  # <L II> Safe
+      push E  # <L I> Result
+      link
+      push A  # <L -I> Sign flag
+      do
+         ld Y (Y CDR)  # More args?
+         atom Y
+      while z  # Yes
+         ld E (Y)
+         eval  # Eval next arg
+         cmp E Nil
+         jz 10  # Abort if NIL
+         num E  # Number?
+         jz numErrEX  # No
+         zero E  # Zero?
+         jeq divErrX  # Yes
+         off E SIGN  # Make argument positive
+         ld (L II) E  # Save arg
+         ld A (L I)  # Result
+         call divuAE_AC  # Divide
+         ld (L I) C  # Result
+      loop
+      ld E (L I)  # Result
+      test (L -I) 1  # Sign?
+      if nz  # Yes
+         zero E  # Zero?
+         if ne  # No
+            or E SIGN  # Set negative
+         end
+      end
+10    drop
+   end
+   pop Y
+   pop X
+   ret
+
+# (>> 'cnt 'num) -> num
+(code 'doShift 2)
+   push X
+   push Y
+   ld X E
+   ld Y (E CDR)  # Y on args
+   call evCntXY_FE  # Get shift count
+   link
+   push ZERO  # <L I> Safe
+   link
+   push E  # <L -I> Shift count
+   ld Y (Y CDR)  # Second arg
+   ld E (Y)
+   eval  # Eval number
+   cmp E Nil  # Any?
+   if nz  # Yes
+      num E  # Number?
+      jz numErrEX  # No
+      ld A E  # Number in A
+      off A SIGN  # Make positive
+      and E SIGN  # Sign bit
+      push E  # <L -II> Sign bit
+      null (L -I)  # Shift count?
+      if nz  # Yes
+         if ns  # Positive
+            call shruA_A  # Non-destructive
+            ld (L I) A
+            do
+               sub (L -I) 1  # Shift count?
+            while nz
+               call halfA_A  # Shift right (destructive)
+               ld (L I) A
+            loop
+         else
+            call shluA_A  # Non-destructive
+            ld (L I) A
+            do
+               add (L -I) 1  # Shift count?
+            while nz
+               call twiceA_A  # Shift left (destructive)
+               ld (L I) A
+            loop
+         end
+      end
+      zero A  # Result zero?
+      if ne  # No
+         or A (L -II)  # Sign bit
+      end
+      ld E A  # Get result
+   end
+   drop
+   pop Y
+   pop X
+   ret
+
+# (lt0 'any) -> num | NIL
+(code 'doLt0 2)
+   ld E (E CDR)  # Get arg
+   ld E (E)
+   eval  # Eval it
+   num E  # Number?
+   jz retNil
+   test E SIGN  # Negative?
+   jz retNil
+   ret  # Yes: Return num
+
+# (ge0 'any) -> num | NIL
+(code 'doGe0 2)
+   ld E (E CDR)  # Get arg
+   ld E (E)
+   eval  # Eval it
+   num E  # Number?
+   jz retNil
+   test E SIGN  # Positive?
+   jnz retNil
+   ret  # Yes: Return num
+
+# (gt0 'any) -> num | NIL
+(code 'doGt0 2)
+   ld E (E CDR)  # Get arg
+   ld E (E)
+   eval  # Eval it
+   num E  # Number?
+   jz retNil
+   zero E  # Zero?
+   jeq retNil
+   test E SIGN  # Positive?
+   jnz retNil
+   ret  # Yes: Return num
+
+# (abs 'num) -> num
+(code 'doAbs 2)
+   push X
+   ld X E
+   ld E (E CDR)  # Get arg
+   ld E (E)
+   eval  # Eval it
+   cmp E Nil  # Any?
+   if nz  # Yes
+      num E  # Number?
+      jz numErrEX  # No
+      off E SIGN  # Clear sign
+   end
+   pop X
+   ret
+
+### Bit operations ###
+# (bit? 'num ..) -> num | NIL
+(code 'doBitQ 2)
+   push X
+   push Y
+   ld X E
+   ld Y (E CDR)  # Y on args
+   ld E (Y)
+   eval  # Eval first arg
+   num E  # Number?
+   jz numErrEX  # No
+   off E SIGN  # Clear sign
+   link
+   push E  # <L I> Bit mask
+   link
+   do
+      ld Y (Y CDR)  # More args?
+      atom Y
+   while z  # Yes
+      ld E (Y)
+      eval  # Eval next arg
+      cmp E Nil
+   while ne  # Abort if NIL
+      num E  # Number?
+      jz numErrEX  # No
+      off E SIGN  # Clear sign
+      ld C (L I)  # Get mask
+      do
+         cnt C  # C short?
+      while z  # No
+         cnt E  # E short?
+         jnz 10  # Yes: Return NIL
+         ld A (E DIG)  # Get digit
+         and A (C DIG)  # Match?
+         cmp A (C DIG)
+         jnz 10  # No: Return NIL
+         ld C (C BIG)
+         ld E (E BIG)
+      loop
+      cnt E  # E also short?
+      if z  # No
+         shr C 4  # Normalize
+         ld E (E DIG)  # Get digit
+      end
+      and E C  # Match?
+      cmp E C
+      if ne  # No
+10       ld E Nil  # Return NIL
+         drop
+         pop Y
+         pop X
+         ret
+      end
+   loop
+   ld E (L I)  # Return bit mask
+   drop
+   pop Y
+   pop X
+   ret
+
+# (& 'num ..) -> num
+(code 'doBitAnd 2)
+   push X
+   push Y
+   ld X E
+   ld Y (E CDR)  # Y on args
+   ld E (Y)
+   eval  # Eval first arg
+   cmp E Nil
+   if ne  # Non-NIL
+      num E  # Number?
+      jz numErrEX  # No
+      off E SIGN  # Clear sign
+      link
+      push ZERO  # <L II> Safe
+      push E  # <L I> Result
+      link
+      do
+         ld Y (Y CDR)  # More args?
+         atom Y
+      while z  # Yes
+         ld E (Y)
+         eval  # Eval next arg
+         cmp E Nil
+         jz 10  # Abort if NIL
+         num E  # Number?
+         jz numErrEX  # No
+         off E SIGN  # Clear sign
+         ld (L II) E  # Save arg
+         ld A (L I)  # Result
+         call anduAE_A  # Bitwise AND
+         ld (L I) A  # Result
+      loop
+      ld E (L I)  # Result
+10    drop
+   end
+   pop Y
+   pop X
+   ret
+
+# (| 'num ..) -> num
+(code 'doBitOr 2)
+   push X
+   push Y
+   ld X E
+   ld Y (E CDR)  # Y on args
+   ld E (Y)
+   eval  # Eval first arg
+   cmp E Nil
+   if ne  # Non-NIL
+      num E  # Number?
+      jz numErrEX  # No
+      off E SIGN  # Clear sign
+      link
+      push ZERO  # <L II> Safe
+      push E  # <L I> Result
+      link
+      do
+         ld Y (Y CDR)  # More args?
+         atom Y
+      while z  # Yes
+         ld E (Y)
+         eval  # Eval next arg
+         cmp E Nil
+         jz 10  # Abort if NIL
+         num E  # Number?
+         jz numErrEX  # No
+         off E SIGN  # Clear sign
+         ld (L II) E  # Save arg
+         ld A (L I)  # Result
+         call oruAE_A  # Bitwise OR
+         ld (L I) A  # Result
+      loop
+      ld E (L I)  # Result
+10    drop
+   end
+   pop Y
+   pop X
+   ret
+
+# (x| 'num ..) -> num
+(code 'doBitXor 2)
+   push X
+   push Y
+   ld X E
+   ld Y (E CDR)  # Y on args
+   ld E (Y)
+   eval  # Eval first arg
+   cmp E Nil
+   if ne  # Non-NIL
+      num E  # Number?
+      jz numErrEX  # No
+      off E SIGN  # Clear sign
+      link
+      push ZERO  # <L II> Safe
+      push E  # <L I> Result
+      link
+      do
+         ld Y (Y CDR)  # More args?
+         atom Y
+      while z  # Yes
+         ld E (Y)
+         eval  # Eval next arg
+         cmp E Nil
+         jz 10  # Abort if NIL
+         num E  # Number?
+         jz numErrEX  # No
+         off E SIGN  # Clear sign
+         ld (L II) E  # Save arg
+         ld A (L I)  # Result
+         call xoruAE_A  # Bitwise XOR
+         ld (L I) A  # Result
+      loop
+      ld E (L I)  # Result
+10    drop
+   end
+   pop Y
+   pop X
+   ret
+
+### Random generator ###
+(code 'initSeedE_E 0)
+   push C  # Counter
+   ld C 0
+   do
+      atom E  # Cell?
+   while z  # Yes
+      push E  # Recurse on CAR
+      ld E (E)
+      call initSeedE_E
+      add C E
+      pop E  # Loop on CDR
+      ld E (E CDR)
+   loop
+   cmp E Nil  # NIL?
+   if ne  # No
+      num E  # Need number
+      if z  # Must be symbol
+         ld E (E TAIL)
+         call nameE_E  # Get name
+      end
+      do
+         cnt E  # Short?
+      while z  # No
+         add C (E DIG)  # Add next digit
+         ld E (E BIG)
+      loop
+      add C E  # Add final short
+   end
+   ld E C  # Return counter
+   pop C
+   ret
+
+# (seed 'any) -> cnt
+(code 'doSeed 2)
+   ld E (E CDR)  # Get arg
+   ld E (E)
+   eval  # Eval it
+   call initSeedE_E  # Initialize 'Seed'
+   ld A 6364136223846793005  # Multiplier
+   mul E  # times 'Seed'
+   add D 1  # plus 1
+   ld (Seed) D  # Save
+   ld E (Seed 4)  # Get high halfword
+   off E 7  # Keep sign
+   or E CNT  # Make short number
+   ret
+
+# (rand ['cnt1 'cnt2] | ['T]) -> cnt | flg
+(code 'doRand 2)
+   push X
+   push Y
+   ld X E
+   ld Y (E CDR)  # Y on args
+   ld A 6364136223846793005  # Multiplier
+   mul (Seed)  # times 'Seed'
+   add D 1  # plus 1
+   ld (Seed) D  # Save
+   ld E (Y)
+   eval  # Eval first arg
+   cmp E Nil  # Any
+   if eq  # No
+      ld E (Seed 4)  # Get high halfword
+      off E 7  # Keep sign
+      or E CNT  # Make short number
+      pop Y
+      pop X
+      ret
+   end
+   cmp E TSym  # Boolean
+   if eq
+      ld A (Seed)
+      rcl A 1  # Highest bit?
+      if nc  # No
+         ld E Nil  # Return NIL
+      end  # else return T
+      pop Y
+      pop X
+      ret
+   end
+   call xCntEX_FE  # Get cnt1
+   push E  # Save it
+   ld Y (Y CDR)  # Second arg
+   call evCntXY_FE  # Get cnt2
+   add E 1  # Seed % (cnt2 + 1 - cnt1) + cnt1
+   sub E (S)
+   ld A (Seed 4)  # Get high halfword
+   ld C 0
+   div E  # Modulus in C
+   pop E  # + cnt1
+   add E C
+   pop Y
+   pop X
+   jmp boxCntE_E  # Return short number
+
+# vi:et:ts=3:sw=3
diff --git a/src64/db.l b/src64/db.l
@@ -0,0 +1,2249 @@
+# 08mar10abu
+# (c) Software Lab. Alexander Burger
+
+# 6 bytes in little endian format
+# Get block address from buffer
+(code 'getAdrZ_A 0)
+   ld B (Z 5)  # Highest byte
+   zxt
+   shl A 8
+   ld B (Z 4)
+   shl A 8
+   ld B (Z 3)
+   shl A 8
+   ld B (Z 2)
+   shl A 8
+   ld B (Z 1)
+   shl A 8
+   ld B (Z)  # Lowest byte
+   ret
+
+# Set block address in buffer
+(code 'setAdrAZ 0)
+   ld (Z) B  # Lowest byte
+   shr A 8
+   ld (Z 1) B
+   shr A 8
+   ld (Z 2) B
+   shr A 8
+   ld (Z 3) B
+   shr A 8
+   ld (Z 4) B
+   shr A 8
+   ld (Z 5) B  # Highest byte
+   ret
+
+(code 'setAdrAS 0)
+   ld (S (+ I 2)) B  # Write block address to stack
+   shr A 8
+   ld (S (+ I 3)) B
+   shr A 8
+   ld (S (+ I 4)) B
+   shr A 8
+   ld (S (+ I 5)) B
+   shr A 8
+   ld (S (+ I 6)) B
+   shr A 8
+   ld (S (+ I 7)) B  # Highest byte
+   ret
+
+# Read file number from 'Buf' into 'DbFile'
+(code 'dbfBuf_AF 0)
+   ld B (Buf 1)  # Two bytes little endian
+   zxt
+   shl A 8
+   ld B (Buf)
+   shl A 6  # 'dbFile' index
+   cmp A (DBs)  # Local file?
+   jge retc  # No
+   add A (DbFiles)  # Get DB file
+   ld (DbFile) A  # Set current
+   ret  # 'nc'
+
+# Build external symbol name
+(code 'extNmCE_X 0)
+   ld X C  # Get object ID into X
+   and X (hex "FFFFF")  # Lowest 20 bits
+   shr C 20  # Middle part of object ID
+   ld A C
+   and A (hex "FFF")  # Lowest 12 bits
+   shl A 28
+   or X A  # into X
+   shr C 12  # Rest of object ID
+   shl C 48
+   or X C  # into X
+   ld A E  # Get file number
+   and A (hex "FF")  # Lowest 8 bits
+   shl A 20  # Insert
+   or X A  # into X
+   shr E 8  # Rest of file number
+   shl E 40
+   or X E  # into X
+   shl X 4  # Make short name
+   or X CNT
+   ret
+
+# Pack external symbol name
+(code 'packExtNmX_E)
+   link
+   push ZERO  # <L I> Name
+   link
+   call fileObjX_AC  # Get file and object ID
+   push C  # Save object ID
+   ld C 4  # Build name
+   lea X (L I)
+   null A  # Any?
+   if nz  # Yes
+      call packAoACX_CX  # Pack file number
+   end
+   pop A  # Get object ID
+   call packOctACX_CX  # Pack it
+   call cons_E  # Cons symbol
+   ld (E) (L I)  # Set name
+   or E SYM  # Make symbol
+   ld (E) E  # Set value to itself
+   drop
+   ret
+
+(code 'packAoACX_CX 0)
+   cmp A 15  # Single digit?
+   if gt  # No
+      push A  # Save
+      shr A 4  # Divide by 16
+      call packAoACX_CX  # Recurse
+      pop A
+      and B 15  # Get remainder
+   end
+   add B (char "@")  # Make ASCII letter
+   jmp byteSymBCX_CX  # Pack byte
+
+(code 'packOctACX_CX 0)
+   cmp A 7  # Single digit?
+   if gt  # No
+      push A  # Save
+      shr A 3  # Divide by 8
+      call packOctACX_CX  # Recurse
+      pop A
+      and B 7  # Get remainder
+   end
+   add B (char "0")  # Make ASCII digit
+   jmp byteSymBCX_CX  # Pack byte
+
+# Chop external symbol name
+(code 'chopExtNmX_E)
+   call fileObjX_AC  # Get file and object ID
+   ld X A  # Keep file in X
+   call oct3C_CA  # Get lowest octal digits
+   call consA_E  # Final cell
+   ld (E) A
+   ld (E CDR) Nil
+   link
+   push E  # <L I> Result
+   link
+   do
+      shr C 3  # Higher octal digits?
+   while nz  # Yes
+      call oct3C_CA  # Get next three digits
+      call consA_E  # Cons into result
+      ld (E) A
+      ld (E CDR) (L I)
+      ld (L I) E
+   loop
+   null X  # File number?
+   if nz  # Yes
+      ld E 0  # Build A-O encoding
+      ld A 0
+      do
+         ld B X  # Next hax digit
+         and B 15  # Lowest four bits
+         add B (char "@")  # Make ASCII letter
+         or E B
+         shr X 4  # More hax digits?
+      while nz  # Yes
+         shl E 8  # Shift result
+      loop
+      shl E 4  # Make short name
+      or E CNT
+      call cons_A  # Make transient symbol
+      ld (A) E  # Set name
+      or A SYM  # Make symbol
+      ld (A) A  # Set value to itself
+      call consA_E  # Cons into result
+      ld (E) A
+      ld (E CDR) (L I)
+      ld (L I) E
+   end
+   ld E (L I)  # Get result
+   drop
+   ret
+
+(code 'oct3C_CA 0)
+   ld A 0
+   ld B C  # Lowest octal digit
+   and B 7
+   add B (char "0")  # Make ASCII digit
+   ld E A
+   shr C 3  # Next digit?
+   if nz  # Yes
+      ld B C  # Second octal digit
+      and B 7
+      add B (char "0")  # Make ASCII digit
+      shl E 8
+      or E B
+      shr C 3  # Next digit?
+      if nz  # Yes
+         ld B C  # Hightest octal digit
+         and B 7
+         add B (char "0")  # Make ASCII digit
+         shl E 8
+         or E B
+      end
+   end
+   shl E 4  # Make short name
+   or E CNT
+   call cons_A  # Make transient symbol
+   ld (A) E  # Set name
+   or A SYM  # Make symbol
+   ld (A) A  # Set value to itself
+   ret
+
+# Get file and object ID from external symbol name
+(code 'fileObjX_AC 0)
+   shl X 2  # Strip status bits
+   shr X 6  # Normalize
+   ld C X  # Get object ID
+   and C (hex "FFFFF")  # Lowest 20 bits
+   shr X 20  # Get file number
+   ld A X
+   and A (hex "FF")  # Lowest 8 bits
+   shr X 8  # More?
+   if nz  # Yes
+      ld E X  # Rest in E
+      and E (hex "FFF")  # Middle 12 bits of object ID
+      shl E 20
+      or C E  # into C
+      shr X 12  # High 8 bits of file number
+      ld E X  # into E
+      and E (hex "FF")  # Lowest 8 bits
+      shl E 8
+      or A E  # into A
+      shr X 8  # Rest of object ID
+      shl X 32
+      or C X  # into C
+   end
+   ret
+
+# Get file and object ID from external symbol
+(code 'fileObjE_AC 0)
+   push X
+   ld X (E TAIL)
+   call nameX_X  # Get name
+   call fileObjX_AC
+   pop X
+   ret
+
+# Get dbFile index and block index from external symbol
+(code 'dbFileBlkY_AC 0)
+   push X
+   ld X Y  # Name in X
+   call fileObjX_AC
+   shl A 6  # 'dbFile' index
+   shl C 6  # Block index
+   pop X
+   ret
+
+(code 'rdLockDb)
+   cmp (Solo) TSym  # Already locked whole DB?
+   if ne  # No
+      ld A (| F_RDLCK (hex "10000"))  # Read lock, length 1
+      ld C ((DbFiles))  # Descriptor of first file
+      jmp lockFileAC
+   end
+   ret
+
+(code 'wrLockDb)
+   cmp (Solo) TSym  # Already locked whole DB?
+   if ne  # No
+      ld A (| F_WRLCK (hex "10000"))  # Write lock, length 1
+      ld C ((DbFiles))  # Descriptor of first file
+      jmp lockFileAC
+   end
+   ret
+
+(code 'rwUnlockDbA)
+   cmp (Solo) TSym  # Already locked whole DB?
+   if ne  # No
+      null A  # Length zero?
+      if z  # Yes
+         push X
+         push Y
+         ld X (DbFiles)  # Iterate DB files
+         ld Y (DBs)  # Count
+         do
+            sub Y VIII  # Done?
+         while ne  # No
+            add X VIII  # Skip first, increment by sizeof(dbFile)
+            nul (X (+ IV 0))  # This one locked?
+            if nz  # Yes
+               ld A (| F_UNLCK (hex "00000"))  # Unlock, length 0
+               ld C (X)  # File descriptor
+               call unLockFileAC
+               set (X (+ IV 0)) 0  # Clear lock entry
+            end
+         loop
+         pop Y
+         pop X
+         ld (Solo) ZERO  # Reset solo mode
+         ld A 0  # Length zero again
+      end
+      or A F_UNLCK
+      ld C ((DbFiles))  # Unlock first file
+      call unLockFileAC
+   end
+   ret
+
+(code 'tryLockCE_FA)
+   do
+      ld (Flock L_START) C  # Start position ('l_whence' is SEEK_SET)
+      ld (Flock L_LEN) E  # Length
+      ld A F_WRLCK  # Write lock
+      st2 (Flock)  # 'l_type'
+      cc fcntl(((DbFile)) F_SETLK Flock)  # Try to lock
+      nul4  # OK?
+      if ns  # Yes
+         set ((DbFile) (+ IV 0)) 1  # Set lock flag
+         null C  # 'Start position is zero?
+         if z  # Yes
+            ld (Solo) TSym  # Set solo mode
+         else
+            cmp (Solo) TSym  # Already locked whole DB?
+            if ne  # No
+               ld (Solo) Nil  # Clear solo mode
+            end
+         end
+         setz
+         ret  # 'z'
+      end
+      call errno_A
+      cmp A EINTR  # Interrupted?
+      if ne  # No
+         cmp A EACCES  # Locked by another process?
+         if ne  # No
+            cmp A EAGAIN  # Memory-mapped by another process?
+            jne lockErr  # No
+         end
+      end
+      #? ld A F_WRLCK  # Write lock
+      #? st2 (Flock)  # 'l_type'
+      ld (Flock L_START) C  # Start position ('l_whence' is SEEK_SET)
+      ld (Flock L_LEN) E  # Length
+      do
+         cc fcntl(((DbFile)) F_GETLK Flock)  # Try to get lock
+         nul4  # OK?
+      while s  # No
+         call errno_A
+         cmp A EINTR  # Interrupted?
+         jne lockErr  # No
+      loop
+      ld2 (Flock)  # Get 'l_type'
+      cmp B F_UNLCK  # Locked by another process?
+   until ne  # Yes
+   ld4 (Flock L_PID)  # Return PID
+   ret  # 'nz'
+
+(code 'jnlFileno_A)
+   cc fileno((DbJnl))  # Get fd
+   ret
+
+(code 'logFileno_A)
+   cc fileno((DbLog))  # Get fd
+   ret
+
+(code 'lockJnl)
+   call jnlFileno_A  # Get fd
+   ld C A  # into C
+   jmp wrLockFileC  # Write lock journal
+
+(code 'unLockJnl)
+   cc fflush((DbJnl))  # Flush journal
+   call jnlFileno_A  # Get fd
+   ld C A  # into C
+   ld A (| F_UNLCK (hex "00000"))  # Unlock, length 0
+   jmp unLockFileAC  # Unlock journal
+
+(code 'setBlockAC_Z 0)
+   add A (DbFiles)  # Get DB file
+: setBlkAC_Z
+   ld (DbFile) A  # Set current
+   ld (BlkIndex) C  # Set block index
+   ld A (A III)  # Block size
+   ld Z (DbBlock)  # Get block buffer in Z
+   add A Z  # Caclulate data end
+   ld (BufEnd) A
+   ret
+
+(code 'rdBlockLinkZ_Z)
+   ld A (BlkLink)  # Next block
+(code 'rdBlockIndexAZ_Z)
+   ld (BlkIndex) A  # Set block index
+   ld Z (DbBlock)  # Block buffer in Z
+(code 'rdBlockZ_Z)
+   ld A (DbFile)  # Get current file
+   ld C (A III)  # Block size
+   ld E (BlkIndex)  # Get block index in E
+   shl E (A II)  # Shift for current file
+   call blkPeekCEZ  # Read block
+   call getAdrZ_A  # Get link address
+   off A BLKTAG
+   ld (BlkLink) A  # Store as next block
+   add Z BLK  # Point to block data
+   ret
+
+(code 'blkPeekCEZ)
+   cc pread(((DbFile)) Z C E)  # Read C bytes from pos E into buffer Z
+   cmp A C  # OK?
+   jne dbRdErr  # No
+   ret
+
+(code 'wrBlockZ)
+   ld A (DbFile)  # Get current file
+   ld C (A III)  # Block size
+   ld E (BlkIndex)  # Get block index in E
+   shl E (A II)  # Shift for current file
+(code 'blkPokeCEZ)
+   cc pwrite(((DbFile)) Z C E)  # Write C bytes from buffer Z to pos E
+   cmp A C  # OK?
+   jne dbWrErr  # No
+   null (DbJnl)  # Journal?
+   jz Ret  # No
+   cmp A ((DbFile) III)  # Size (in A and C) equal to current file's block size?
+   if eq  # Yes
+      ld A BLKSIZE  # Use block unit size instead
+   end
+   cc putc_unlocked(A (DbJnl))  # Write size
+   sub S (+ BLK 2)  # <S> Buffer
+   ld A ((DbFile) I)  # Get file number
+   ld (S) B  # Store low byte
+   shr A 8
+   ld (S 1) B  # and high byte
+   ld A E  # Get position
+   shr A ((DbFile) II)  # Un-shift for current file
+   call setAdrAS  # Set block address in buffer
+   cc fwrite(S (+ BLK 2) 1 (DbJnl))  # Write file number and address
+   cmp A 1  # OK?
+   jne wrJnlErr  # No
+   cc fwrite(Z C 1 (DbJnl))  # Write C bytes from buffer Z
+   cmp A 1  # OK?
+   jne wrJnlErr  # No
+   add S (+ BLK 2)  # Drop buffer
+   ret
+
+(code 'logBlock)
+   sub S (+ BLK 2)  # <S> Buffer
+   ld A ((DbFile) I)  # Get file number
+   ld (S) B  # Store low byte
+   shr A 8
+   ld (S 1) B  # and high byte
+   ld A (BlkIndex)  # Get block index in E
+   call setAdrAS  # Write into buffer
+   cc fwrite(S (+ BLK 2) 1 (DbLog))  # Write file number and address
+   cmp A 1  # OK?
+   jne wrLogErr  # No
+   cc fwrite((DbBlock) ((DbFile) III) 1 (DbLog))  # Write 'siz' bytes from block buffer
+   cmp A 1  # OK?
+   jne wrLogErr  # No
+   add S (+ BLK 2)  # Drop buffer
+   ret
+
+(code 'newBlock_X)
+   push Z
+   ld C (* 2 BLK)  # Read 'free' and 'next'
+   ld E 0  # from block zero
+   ld Z Buf  # into 'Buf'
+   call blkPeekCEZ
+   call getAdrZ_A  # 'free'?
+   null A
+   jz 10  # No
+   null ((DbFile) VII)  # 'fluse'?
+   if nz  # Yes
+      ld X A  # Keep 'free' in X
+      ld C (DbFile)
+      shl A (C II)  # Shift 'free'
+      sub (C VII) 1  # Decrement 'fluse'
+      ld E A  # Read 'free' link
+      ld C BLK
+      call blkPeekCEZ  # into 'Buf'
+      ld E 0  # Restore block zero in E
+      ld C (* 2 BLK)  # and poke size in C
+   else
+10    add Z BLK  # Get 'next'
+      call getAdrZ_A
+      cmp A (hex "FFFFFFFFFFC0")  # Max object ID
+      jeq dbSizErr  # DB Oversize
+      ld X A  # Keep in X
+      add A BLKSIZE  # Increment 'next'
+      call setAdrAZ
+      sub Z BLK  # Restore 'Buf' in Z
+   end
+   call blkPokeCEZ  # Write 'Buf' back
+   ld C ((DbFile) III)  # Current file's block size
+   sub S C  # <S> Buffer
+   ld B 0  # Clear buffer
+   mset (S) C  # with block size
+   ld E X  # Get new block address
+   shl E ((DbFile) II)  # Shift it
+   ld Z S  # Write initblock
+   call blkPokeCEZ
+   add S ((DbFile) III)  # Drop buffer
+   pop Z
+   ret
+
+(code 'newIdEX_X)
+   sub E 1  # Zero-based
+   shl E 6  # 'dbFile' index
+   cmp E (DBs)  # In Range?
+   jge dbfErrX  # No
+   add E (DbFiles)  # Get DB file
+   ld (DbFile) E  # Set current
+   null (DbLog)  # Transaction log?
+   if z  # No
+      add (EnvProtect) 1  # Protect the operation
+   end
+   call wrLockDb  # Write lock DB
+   null (DbJnl)  # Journal?
+   if nz  # Yes
+      call lockJnl  # Write lock journal
+   end
+   call newBlock_X  # Allocate new block
+   ld C X  # Object ID
+   shr C 6  # Normalize
+   ld E ((DbFile) I)  # Get file number
+   call extNmCE_X  # Build external symbol name
+   null (DbJnl)  # Journal?
+   if nz  # Yes
+      call unLockJnl  # Unlock journal
+   end
+   ld A (hex "10000")  # Length 1
+   call rwUnlockDbA  # Unlock
+   null (DbLog)  # Transaction log?
+   if z  # No
+      sub (EnvProtect) 1  # Unprotect
+   end
+   ret
+
+(code 'isLifeE_F)
+   push E  # Save symbol
+   call fileObjE_AC  # Get file and ID
+   pop E  # Restore symbol
+   shl C 6  # Block index?
+   jz retnz  # No
+   shl A 6  # 'dbFile' index
+   cmp A (DBs)  # Local file?
+   if lt  # Yes
+      add A (DbFiles)  # Get DB file
+      ld (DbFile) A  # Set current
+      ld A (E TAIL)  # Get tail
+      call nameA_A  # Get name
+      shl A 1  # Dirty?
+      jc retz  # Yes
+      shl A 1  # Loaded?
+      jc Retz  # Yes
+      push E
+      push Z
+      push C  # Save block index
+      ld C BLK  # Read 'next'
+      ld E BLK
+      ld Z Buf  # into 'Buf'
+      call blkPeekCEZ
+      call getAdrZ_A  # Get 'next'
+      pop C  # Get block index
+      cmp C A  # Less than 'next'?
+      jge retnz  # No
+      ld E C  # Block index
+      shl E ((DbFile) II)  # Shift
+      ld C BLK  # Read link field
+      call blkPeekCEZ  # into 'Buf'
+      ld B (Z)  # Get tag byte
+      and B BLKTAG  # Block tag
+      cmp B 1  # One?
+      pop Z
+      pop E
+   else
+      atom (Ext)  # Remote databases?
+   end
+   ret  # 'z' if OK
+
+(code 'cleanUpY)
+   ld C BLK  # Read 'free'
+   ld E 0  # from block zero
+   ld Z Buf  # into 'Buf'
+   call blkPeekCEZ
+   call getAdrZ_A  # Get 'free'
+   push A  # Save 'free'
+   ld A Y  # Deleted block
+   call setAdrAZ  # Store in buffer
+   call blkPokeCEZ  # Set new 'free'
+   ld E Y  # Deleted block
+   do
+      shl E ((DbFile) II)  # Shift it
+      call blkPeekCEZ  # Get block link
+      off (Z) BLKTAG  # Clear tag
+      call getAdrZ_A  # Get link
+      null A  # Any?
+   while nz  # Yes
+      ld Y A  # Keep link in Y
+      call blkPokeCEZ  # Write link
+      ld E Y  # Get link
+   loop
+   pop A  # Retrieve 'free'
+   call setAdrAZ  # Store in buffer
+   jmp blkPokeCEZ  # Append old 'free' list
+
+(code 'getBlockZ_FB 0)
+   cmp Z (BufEnd)  # End of block data?
+   if eq  # Yes
+      ld A (BlkLink)  # Next block?
+      null A
+      jz ret  # No: Return 0
+      push C
+      push E
+      call rdBlockIndexAZ_Z  # Read block
+      pop E
+      pop C
+   end
+   ld B (Z)  # Next byte
+   add Z 1  # (nc)
+   ret
+
+(code 'putBlockBZ 0)
+   cmp Z (BufEnd)  # End of block data?
+   if eq  # Yes
+      push A  # Save byte
+      push C
+      push E
+      ld Z (DbBlock)  # Block buffer
+      null (BlkLink)  # Next block?
+      if nz  # Yes
+         call wrBlockZ  # Write current block
+         call rdBlockLinkZ_Z  # Read next block
+      else
+         push X
+         call newBlock_X  # Allocate new block
+         ld B (Z)  # Get block count (link is zero)
+         zxt
+         push A  # Save count
+         or A X  # Combine with new link
+         call setAdrAZ  # Store in current block
+         call wrBlockZ  # Write current block
+         ld (BlkIndex) X  # Set new block index
+         pop A  # Retrieve count
+         cmp A BLKTAG  # Max reached?
+         if ne  # No
+            add A 1  # Increment count
+         end
+         call setAdrAZ  # Store in new current block
+         add Z BLK  # Point to block data
+         pop X
+      end
+      pop E
+      pop C
+      pop A  # Retrieve byte
+   end
+   ld (Z) B  # Store byte
+   add Z 1  # Increment pointer
+   ret
+
+# (pool ['sym1 ['lst] ['sym2] ['sym3]]) -> T
+(code 'doPool 2)
+   push X
+   push Y
+   push Z
+   ld X E
+   ld Y (E CDR)  # Y on args
+   call evSymY_E  # Eval database name
+   link
+   push E  # <L IV> 'sym1'
+   ld Y (Y CDR)
+   ld E (Y)  # Eval scale factor list
+   eval+
+   push E  # <L III> 'lst'
+   link
+   cmp E Nil  # Need list
+   if ne
+      atom E
+      jnz lstErrEX
+   end
+   ld Y (Y CDR)
+   call evSymY_E  # Eval replication journal
+   tuck E  # <L II> 'sym2'
+   link
+   ld Y (Y CDR)
+   call evSymY_E  # Eval transaction log
+   tuck E  # <L I> 'sym3'
+   link
+   ld (Solo) ZERO  # Reset solo mode
+   null (DBs)  # DB open?
+   if nz  # Yes
+      call doRollback  # Roll back possible changes
+      ld E (DbFiles)  # Iterate DB files
+      ld C (DBs)  # Count
+      do
+         ld A (E)  # File descriptor
+         call closeAX  # Close it
+         cc free((E VI))  # Free mark bit vector
+         add E VIII  # Increment by sizeof(dbFile)
+         sub C VIII  # Done?
+      until z  # Yes
+      ld (DBs) 0
+      null (DbJnl)  # Journal?
+      if nz  # Yes
+         cc fclose((DbJnl))  # Close it
+         ld (DbJnl) 0
+      end
+      null (DbLog)  # Transaction log?
+      if nz  # Yes
+         cc fclose((DbLog))  # Close it
+         ld (DbLog) 0
+      end
+   end
+   ld E (L IV)  # Database name
+   cmp E Nil  # Given?
+   if ne  # Yes
+      push A  # 8 bytes additional buffer space
+      call pathStringE_SZ  # <S II> DB name
+      slen C S  # String length in C
+      add C S  # Add to buffer
+      push C  # <S I> DB name end pointer
+      ld E VIII  # Default to single dbFile
+      ld A (L III)  # Get scale factor list
+      atom A  # Any?
+      if z  # Yes
+         ld E 0  # Calculate length
+         do
+            add E VIII  # Increment by sizeof(dbFile)
+            ld A (A CDR)
+            atom A  # More cells?
+         until nz  # No
+      end
+      ld A (DbFiles)  # DB file structure array
+      call allocAE_A  # Set to new size
+      ld (DbFiles) A
+      ld Y A  # Index in Y
+      add A E
+      push A  # <S> Limit
+      ld (MaxBlkSize) 0  # Init block size maximum
+      do
+         ld C (S I)  # Get DB name end pointer
+         ld A Y  # Get index
+         sub A (DbFiles)
+         shr A 6  # Revert to file number
+         ld (Y I) A  # Store in 'dbFile'
+         atom (L III)  # Scale factor list?
+         if z  # Yes
+            call bufAoAC_C  # Append AO encoding to DB base name
+         end
+         set (C) 0  # Null-byte string terminator
+         ld A (L III)  # Scale factor list
+         ld (L III) (A CDR)
+         ld A (A)  # Next scale factor
+         cnt A  # Given?
+         ldz A 2  # No: Default to 2
+         if nz
+            shr A 4  # Else normalize
+         end
+         ld (Y II) B  # Set block shift
+         ld (DbFile) Y  # Set current file
+         cc open(&(S II) O_RDWR)  # Try to open
+         nul4  # OK?
+         if ns  # Yes
+            ld (Y) A  # Set file descriptor
+            ld C (+ BLK BLK 1)  # Read block shift
+            ld E 0  # from block zero
+            ld Z Buf  # into 'Buf'
+            call blkPeekCEZ
+            ld B (Z (+ BLK BLK))  # Get block shift
+            ld (Y II) B  # Override argument block shift
+            ld C BLKSIZE  # Calculate block size
+            shl C B
+            ld (Y III) C  # Set in dbFile
+         else
+            ld E (L IV)  # Database name (if error)
+            call errno_A
+            cmp A ENOENT  # Non-existing?
+            jne openErrEX  # No
+            cc open(&(S II) (| O_CREAT O_EXCL O_RDWR) (oct "0666"))  # Try to create
+            nul4  # OK?
+            js openErrEX  # No
+            ld (Y) A  # Set file descriptor
+            ld C BLKSIZE  # Calculate block size
+            shl C (Y II)
+            ld (Y III) C  # Set in dbFile
+            sub S C  # <S> Buffer
+            ld B 0  # Clear buffer
+            mset (S) C  # with block size
+            ld E 0  # Position of DB block zero
+            lea Z (S BLK)  # Address of 'next' in buffer
+            cmp Y (DbFiles)  # First file?
+            if ne  # No
+               ld A BLKSIZE  # Only block zero
+            else
+               ld A (* 2 BLKSIZE)  # Block zero plus DB root
+            end
+            call setAdrAZ  # into 'next'
+            ld Z S  # Buffer address
+            set (Z (* 2 BLK)) (Y II)  # Set block shift in block zero
+            call blkPokeCEZ  # Write DB block zero
+            cmp Y (DbFiles)  # First file?
+            if eq  # Yes
+               ld (S) 0  # Clear 'next' link in buffer
+               ld (S I) 0
+               ld Z S  # Address of 'link' in buffer
+               ld A 1  # First block for DB root
+               call setAdrAZ  # into link field
+               ld E (Y III)  # Second block has block size position
+               call blkPokeCEZ  # Write first ID-block (DB root block)
+            end
+            add S (Y III)  # Drop buffer
+         end
+         ld A (Y)  # Get fd
+         call closeOnExecAX
+         ld A (Y III)  # Block size
+         cmp A (MaxBlkSize)  # Calculate maximum
+         if gt
+            ld (MaxBlkSize) A
+         end
+         ld (Y IV) 0  # Clear 'flgs'
+         ld (Y V) 0  # mark vector size
+         ld (Y VI) 0  # and mark bit vector
+         ld (Y VII) -1  # Init 'fluse'
+         add Y VIII  # Increment index by sizeof(dbFile)
+         ld A Y  # Get index
+         sub A (DbFiles)  # Advanced so far
+         ld (DBs) A  # Set new scaled DB file count
+         cmp Y (S)  # Done?
+      until eq  # Yes
+      ld A (DbBlock)  # Allocate block buffer
+      ld E (MaxBlkSize)  # for maximal block size
+      call allocAE_A
+      ld (DbBlock) A
+      ld E (L II)  # Replication journal?
+      cmp E Nil
+      if ne  # Yes
+         call pathStringE_SZ  # Write journal to stack buffer
+         cc fopen(S _a_)  # Open for appending
+         ld S Z  # Drop buffer
+         null A  # OK?
+         jz openErrEX  # No
+         ld (DbJnl) A
+         call jnlFileno_A  # Get fd
+         call closeOnExecAX
+      end
+      ld E (L I)  # Transaction log?
+      cmp E Nil
+      if ne  # Yes
+         call pathStringE_SZ  # Write journal to stack buffer
+         cc fopen(S _ap_)  # Open for reading and appending
+         ld S Z  # Drop buffer
+         null A  # OK?
+         jz openErrEX  # No
+         ld (DbLog) A
+         call logFileno_A  # Get fd
+         call closeOnExecAX
+         call rewindLog  # Test for existing transaction
+         cc fread(Buf 2 1 (DbLog))  # Read first file number
+         null A  # Any?
+         if nz  # Yes
+            cc feof((DbLog))  # EOF?
+            nul4
+            if z  # No
+               call ignLog  # Discard incomplete transaction
+            else
+               do
+                  ld2 (Buf)  # Get file number (byte order doesn't matter)
+                  cmp A -1  # End marker?
+                  if eq  # Yes
+                     cc fprintf((stderr) RolbLog)  # Rollback incomplete transaction
+                     call rewindLog  # Rewind transaction log
+                     ld E (DbFiles)  # Iterate DB files
+                     ld C (DBs)  # Count
+                     do
+                        set (E (+ IV 1)) 0  # Clear dirty flag
+                        sub C VIII  # Done?
+                     until z  # Yes
+                     sub S (MaxBlkSize)  # <S> Buffer
+                     do
+                        cc fread(Buf 2 1 (DbLog))  # Read file number
+                        null A  # Any?
+                        jz jnlErrX  # No
+                        ld2 (Buf)  # Get file number (byte order doesn't matter)
+                        cmp A -1  # End marker?
+                     while ne  # No
+                        call dbfBuf_AF  # Read file number from 'Buf' to 'DbFile'
+                        jc jnlErrX  # No local file
+                        cc fread(Buf BLK 1 (DbLog))  # Read object ID
+                        cmp A 1  # OK?
+                        jne jnlErrX  # No
+                        cc fread(S ((DbFile) III) 1 (DbLog))  # Read block data
+                        cmp A 1  # OK?
+                        jne jnlErrX  # No
+                        ld Z Buf  # Get object ID from 'Buf'
+                        call getAdrZ_A
+                        shl A ((DbFile) II)  # Shift
+                        ld C ((DbFile) III)  # Block size
+                        cc pwrite(((DbFile)) S C A)  # Write C bytes from stack buffer to pos A
+                        cmp A C  # OK?
+                        jne dbWrErr
+                        set ((DbFile) (+ IV 1)) 1  # Set dirty flag
+                     loop
+                     add S (MaxBlkSize)  # Drop buffer
+                     call fsyncDB  # Sync DB files to disk
+                     break T
+                  end
+                  call dbfBuf_AF  # Read file number from 'Buf' into 'DbFile'
+                  jc 40  # No local file
+                  cc fread(Buf BLK 1 (DbLog))  # Read object ID
+                  cmp A 1  # OK?
+                  jne 40  # No
+                  cc fseek((DbLog) ((DbFile) III) SEEK_CUR)  # Skip by 'siz'
+                  nul4  # OK?
+                  jnz 40  # No
+                  cc fread(Buf 2 1 (DbLog))  # Read next file number
+                  cmp A 1  # OK?
+                  if nz  # No
+40                   call ignLog  # Discard incomplete transaction
+                     break T
+                  end
+               loop
+            end
+         end
+         call truncLog  # Truncate log file
+      end
+   end
+   drop
+   pop Z
+   pop Y
+   pop X
+   ld E TSym  # Return T
+   ret
+: RolbLog asciz "Last transaction not completed: Rollback\n"
+
+(code 'ignLog)
+   cc fprintf((stderr) IgnLog)
+   ret
+: IgnLog asciz "Discarding incomplete transaction.\n"
+
+(code 'rewindLog)
+   cc fseek((DbLog) 0 SEEK_SET)  # Rewind transaction log
+   ret
+
+(code 'fsyncDB)
+   ld E (DbFiles)  # Iterate DB files
+   ld C (DBs)  # Count
+   do
+      nul (E (+ IV 1))  # Dirty?
+      if nz  # Yes
+         cc fsync((E))  # Sync DB file to disk
+         nul4  # OK?
+         js dbSyncErrX  # No
+      end
+      sub C VIII  # Done?
+   until z  # Yes
+   ret
+
+(code 'truncLog)
+   call rewindLog  # Rewind transaction log
+   call logFileno_A  # Get fd
+   cc ftruncate(A 0)  # Truncate log file
+   nul4  # OK?
+   jnz truncErrX
+   ret
+
+# Append A-O encoding to string
+(code 'bufAoAC_C 0)
+   cmp A 15  # Single digit?
+   if gt  # No
+      push A  # Save
+      shr A 4  # Divide by 16
+      call bufAoAC_C  # Recurse
+      pop A
+      and B 15  # Get remainder
+   end
+   add B (char "@")  # Make ASCII letter
+   ld (C) B  # Store in buffer
+   add C 1
+   ret
+
+# (journal 'any ..) -> T
+(code 'doJournal 2)
+   push X
+   push Y
+   push Z
+   ld X E
+   ld Y (E CDR)  # Y on args
+   sub S (MaxBlkSize)  # <S /I> Buffer
+   do
+      atom Y  # More args?
+   while z  # Yes
+      call evSymY_E  # Next file name
+      call pathStringE_SZ  # Write to stack buffer
+      cc fopen(S _r_)  # Open file
+      ld S Z  # Drop buffer
+      null A  # OK?
+      jz openErrEX  # No
+      ld E A  # Keep journal file pointer in E
+      do
+         cc getc_unlocked(E)  # Next char
+         nul4  # EOF?
+      while ns  # No
+         ld C A  # Size in C
+         cc fread(Buf 2 1 E)  # Read file number
+         cmp A 1  # OK?
+         jne jnlErrX  # No
+         call dbfBuf_AF  # Read file number from 'Buf' to 'DbFile'
+         jc dbfErrX  # No local file
+         cmp C BLKSIZE  # Whole block?
+         ldz C (A III)  # Yes: Take file's block size
+         cc fread(Buf BLK 1 E)  # Read object ID
+         cmp A 1  # OK?
+         jne jnlErrX  # No
+         cc fread(S C 1 E)  # Read data into buffer
+         cmp A 1  # OK?
+         jne jnlErrX  # No
+         push E  # Save journal file pointer
+         ld Z Buf  # Get object ID from 'Buf'
+         call getAdrZ_A
+         ld E A  # into E
+         shl E ((DbFile) II)  # Shift
+         lea Z (S I)  # Buffer
+         call blkPokeCEZ  # Write object data
+         pop E  # Restore journal file pointer
+      loop
+      cc fclose(E)  # Close file pointer
+      ld Y (Y CDR)
+   loop
+   add S (MaxBlkSize)  # Drop buffer
+   ld E TSym  # Return T
+   pop Z
+   pop Y
+   pop X
+   ret
+
+# (id 'num ['num]) -> sym
+# (id 'sym [NIL]) -> num
+# (id 'sym T) -> (num . num)
+(code 'doId 2)
+   push X
+   push Y
+   ld X E
+   ld Y (E CDR)  # Y on args
+   ld E (Y)  # Eval first
+   eval
+   num E  # File number?
+   if nz  # Yes
+      shr E 4  # Normalize
+      push E  # <S> Scaled file number or object ID
+      ld Y (Y CDR)  # Next arg
+      ld E (Y)
+      eval  # Eval object ID
+      cmp E Nil  # Given?
+      if eq  # No
+         pop C  # Get object ID
+         ld E 0  # File defaults to zero
+      else
+         call xCntEX_FE  # Eval object ID
+         ld C E  # into C
+         pop E  # Get file number
+         sub E 1  # Zero-based
+      end
+      call extNmCE_X  # Build external symbol name
+      call externX_E  # New external symbol
+      pop Y
+      pop X
+      ret
+   end
+   sym E  # Need symbol
+   jz symErrEX
+   sym (E TAIL)  # External symbol?
+   jz extErrEX  # No
+   xchg E Y  # Keep symbol in Y
+   ld E ((E CDR))  # Eval second arg
+   eval  # Eval flag
+   xchg E Y  # Keep flag in Y, get symbol in E
+   call fileObjE_AC  # Get file and ID
+   shl C 4  # Make short object ID
+   or C CNT
+   cmp Y Nil  # Return only object ID?
+   ldz E C  # Yes
+   if ne  # No
+      add A 1  # File is zero-based
+      shl A 4  # Make short file number
+      or A CNT
+      call cons_E  # Return (file . id)
+      ld (E) A
+      ld (E CDR) C
+   end
+   pop Y
+   pop X
+   ret
+
+# (seq 'cnt|sym1) -> sym | NIL
+(code 'doSeq 2)
+   push X
+   push Y
+   push Z
+   ld X E
+   ld E ((E CDR))  # Eval arg
+   eval
+   num E  # File number?
+   if nz  # Yes
+      off E 15  # Normalize + 'dbFile' index
+      sub E (hex "10")  # Zero-based
+      shl E 2
+      push E  # <S> Scaled file number
+      cmp E (DBs)  # Local file?
+      jge dbfErrX  # No
+      add E (DbFiles)  # Get DB file
+      ld (DbFile) E  # Set current
+      ld X 0  # Block index zero
+   else
+      sym E  # Need symbol
+      jz symErrEX
+      sym (E TAIL)  # External symbol?
+      jz extErrEX  # No
+      call fileObjE_AC  # Get file and ID
+      shl A 6  # 'dbFile' index
+      push A  # <S> Scaled file number
+      cmp A (DBs)  # Local file?
+      jge dbfErrX  # No
+      add A (DbFiles)  # Get DB file
+      ld (DbFile) A  # Set current
+      shl C 6  # Block index from object ID
+      ld X C  # Block index in X
+   end
+   call rdLockDb  # Lock for reading
+   ld C BLK  # Read 'next'
+   ld E BLK
+   ld Z Buf  # into 'Buf'
+   call blkPeekCEZ
+   call getAdrZ_A  # Get 'next'
+   ld Y A  # into Y
+   do
+      add X BLKSIZE  # Increment block index
+      cmp X Y  # Less than 'next'?
+      if ge  # No
+         pop A  # Drop file number
+         ld E Nil  # Return NIL
+         break T
+      end
+      ld E X  # Block index
+      shl E ((DbFile) II)  # Shift
+      ld C BLK  # Read link field
+      call blkPeekCEZ  # into 'Buf'
+      ld B (Z)  # Get tag byte
+      and B BLKTAG  # Block tag
+      cmp B 1  # One?
+      if eq  # Yes
+         pop E  # Get scaled file number
+         shr E 6  # Normalize
+         ld C X  # Object ID
+         shr C 6  # Normalize
+         call extNmCE_X  # Build external symbol name
+         call externX_E  # New external symbol
+         break T
+      end
+   loop
+   ld A (hex "10000")  # Length 1
+   call rwUnlockDbA  # Unlock
+   pop Z
+   pop Y
+   pop X
+   ret
+
+# (lieu 'any) -> sym | NIL
+(code 'doLieu 2)
+   ld E ((E CDR))  # Get arg
+   eval  # Eval it
+   num E  # Number?
+   jnz retNil  # Yes
+   sym E  # Symbol?
+   jz retNil  # No
+   ld A (E TAIL)  # Get tail
+   sym A  # External symbol?
+   jz retNil  # No
+   off A SYM  # Clear 'extern' tag
+   do
+      num A  # Found name?
+      if nz  # Yes
+         shl A 1  # Dirty?
+         if nc  # No
+            shl A 1  # Loaded?
+            ldnc E Nil  # No
+            ret
+         end
+         shl A 1  # Deleted?
+         ldc E Nil  # Yes
+         ret
+      end
+      ld A (A CDR)  # Skip property
+   loop
+
+# (lock ['sym]) -> cnt | NIL
+(code 'doLock 2)
+   push X
+   ld X E
+   ld E ((E CDR))  # E on arg
+   eval  # Eval it
+   cmp E Nil  # NIL?
+   if eq  # Yes
+      ld (DbFile) (DbFiles)  # Use first dbFile
+      ld C 0  # Start
+      ld E 0  # Length
+      call tryLockCE_FA  # Lock whole DB
+   else
+      num E  # Need symbol
+      jnz symErrEX
+      sym E
+      jz symErrEX
+      sym (E TAIL)  # External symbol?
+      jz extErrEX  # No
+      call fileObjE_AC  # Get file and ID
+      shl A 6  # 'dbFile' index
+      cmp A (DBs)  # Local file?
+      jge dbfErrX  # No
+      add A (DbFiles)  # Get DB file
+      ld (DbFile) A
+      ld A (A III)  # Get block size
+      mul C  # Multiply with object ID for start position
+      ld C A  # Start
+      ld E 1  # Length
+      call tryLockCE_FA  # Lock external symbol
+   end
+   ld E Nil  # Preload NIL
+   if nz  # Locked by another process
+      ld E A  # Get PID
+      shl E 4  # Make short number
+      or E CNT
+   end
+   pop X
+   ret
+
+(code 'dbSizeX_A 0)
+   cnt X  # Short number?
+   if nz  # Yes
+      shr X 3  # Normalize short, keep sign bit
+      jmp 20
+   end
+   big X  # Big number?
+   if nz  # Yes
+      ld A 9  # Count 8 significant bytes plus 1
+      do
+         ld C (X DIG)  # Keep digit
+         ld X (X BIG)  # More cells?
+         cnt X
+      while z  # Yes
+         add A 8  # Increment count by 8
+      loop
+      shr X 4  # Normalize short
+      shl C 1  # Get most significant bit of last digit
+      addc X X  # Any significant bits in short number?
+      jmp 40
+   end
+   ld A 1  # Preload 1
+   cmp X Nil  # NIL?
+   if ne  # No
+      sym X  # Symbol?
+      if nz  # Yes
+         ld X (X TAIL)
+         call nameX_X  # Get name
+         zero X  # Any?
+         if ne  # Yes
+            cnt X  # Short name?
+            if nz  # Yes
+               shl X 2  # Strip status bits
+               shr X 6  # Normalize
+20             ld A 2  # Count significant bytes plus 1
+               do
+                  shr X 8  # More bytes?
+               while nz  # Yes
+                  add A 1  # Increment count
+               loop
+               ret
+            end
+            ld A 9  # Count significant bytes plus 1
+            do
+               ld X (X BIG)  # More cells?
+               cnt X
+            while z  # Yes
+               add A 8  # Increment count by 8
+            loop
+            shr X 4  # Any significant bits in short name/number?
+40          if nz  # Yes
+               do
+                  add A 1  # Increment count
+                  shr X 8  # More bytes?
+               until z  # No
+            end
+            cmp A (+ 63 1)  # More than one chunk?
+            if ge  # Yes
+               ld X A  # Keep size+1 in X
+               sub A 64  # Size-63
+               ld C 0  # Divide by 255
+               div 255
+               setc  # Plus 1
+               addc A X  # Plus size+1
+            end
+         end
+         ret
+      end
+      push X  # <S I> List head
+      push 2  # <S> Count
+      do
+         push (X CDR)  # Save rest
+         ld X (X)  # Recurse on CAR
+         call dbSizeX_A
+         pop X
+         add (S) A  # Add result to count
+         cmp X Nil  # CDR is NIL?
+      while ne  # No
+         cmp X (S I)  # Circular?
+         if eq  # Yes
+            add (S) 1  # Increment count once more
+            break T
+         end
+         atom X  # Atomic CDR?
+         if nz  # Yes
+            call dbSizeX_A  # Get size
+            add (S) A  # Add result to count
+            break T
+         end
+      loop
+      pop A  # Get result
+      pop C  # Drop list head
+   end
+   ret
+
+(code 'dbFetchEX 0)
+   ld A (E TAIL)  # Get tail
+   num A  # Any properties?
+   jz Ret  # Yes
+   rcl A 1  # Dirty?
+   jc ret  # Yes
+   rcl A 1  # Loaded?
+   jc ret  # Yes
+   setc  # Set "loaded"
+   rcr A 1
+   shr A 1
+   push C
+: dbAEX
+   push Y
+   push Z
+   link
+   push E  # <L I> Symbol
+   link
+   ld Y A  # Status/name in Y
+   call dbFileBlkY_AC  # Get file and block index
+   cmp A (DBs)  # Local file?
+   if lt  # Yes
+      call setBlockAC_Z  # Set up block env
+      call rdLockDb  # Lock for reading
+      call rdBlockZ_Z  # Read first block
+      ld B (Z (- BLK))  # Get tag byte
+      and B BLKTAG  # Block tag
+      cmp B 1  # One?
+      jne idErrXL  # Bad ID
+      ld (GetBinZ_FB) getBlockZ_FB  # Set binary read function
+      ld (Extn) 0  # Set external symbol offset to zero
+      call binReadZ_FE  # Read first item
+      ld A (L I)  # Get symbol
+      ld (A) E  # Set value
+      ld (A TAIL) Y  # and status/name
+      call binReadZ_FE  # Read first property key
+      cmp E Nil  # Any?
+      if ne  # Yes
+         call consE_A  # Build first property cell
+         ld (A) E  # Cons key
+         ld (A CDR) Y  # With status/name
+         ld Y A  # Keep cell in Y
+         or A SYM  # Set 'extern' tag
+         ld ((L I) TAIL) A  # Set symbol's tail
+         call binReadZ_FE  # Read property value
+         cmp E TSym  # T?
+         if ne  # No
+            call consE_A  # Cons property value
+            ld (A) E
+            ld (A CDR) (Y)  # With key
+            ld (Y) A  # Save in first property cell
+         end
+         do
+            call binReadZ_FE  # Read next property key
+            cmp E Nil  # Any?
+         while ne  # Yes
+            call consE_A  # Build next property cell
+            ld (A) E  # Cons key
+            ld (A CDR) (Y CDR)  # With name
+            ld (Y CDR) A  # Insert
+            ld Y A  # Point Y to new cell
+            call binReadZ_FE  # Read property value
+            cmp E TSym  # T?
+            if ne  # No
+               call consE_A  # Cons property value
+               ld (A) E
+               ld (A CDR) (Y)  # With key
+               ld (Y) A  # Save in property cell
+            end
+         loop
+      end
+      ld A (hex "10000")  # Length 1
+      call rwUnlockDbA  # Unlock
+   else
+      shr A 6  # Revert to file number
+      ld Z (Ext)  # Remote databases?
+      atom Z
+      jnz dbfErrX  # No
+      ld C ((Z))  # First offset
+      shr C 4  # Normalize
+      cmp A C  # First offset too big?
+      jlt dbfErrX  # Yes
+      do
+         ld E (Z CDR)  # More?
+         atom E
+      while z  # Yes
+         ld C ((E))  # Next offset
+         shr C 4  # Normalize
+         cmp A C  # Matching entry?
+      while ge  # No
+         ld Z E  # Try next remote DB
+      loop
+      push Y  # Save name
+      push ((Z) CDR)  # fun ((Obj) ..)
+      ld Y S  # Pointer to fun in Y
+      push (L I)  # Symbol
+      ld Z S  # Z on (last) argument
+      call applyXYZ_E  # Apply
+      pop Z  # Get symbol
+      pop A  # Drop 'fun'
+      pop Y  # Get name
+      ld (Z) (E)  # Set symbol's value
+      ld E (E CDR)  # Properties?
+      atom E
+      if z  # Yes
+         or E SYM  # Set 'extern' tag
+         ld (Z TAIL) E  # Set property list
+         do
+            atom (E CDR)  # Find end
+         while z
+            ld E (E CDR)
+         loop
+         ld (E CDR) Y  # Set name
+      else
+         or Y SYM  # Set 'extern' tag
+         ld (Z TAIL) Y  # Set name
+      end
+   end
+   ld E (L I)  # Restore symbol
+   drop
+   pop Z
+   pop Y
+   pop C
+   ret
+
+(code 'dbTouchEX 0)
+   push C
+   lea C (E TAIL)  # Get tail
+   ld A (C)
+   num A  # Any properties?
+   if z  # Yes
+      off A SYM  # Clear 'extern' tag
+      do
+         lea C (A CDR)  # Skip property
+         ld A (C)
+         num A  # Find name
+      until nz
+   end
+   rcl A 1  # Already dirty?
+   if nc  # No
+      rcl A 1  # Loaded?
+      if c  # Yes
+         shr A 1
+         setc  # Set "dirty"
+         rcr A 1
+         ld (C) A  # in status/name
+         pop C
+         ret
+      end
+      shr A 1
+      setc  # Set "dirty"
+      rcr A 1
+      jmp dbAEX
+   end
+   pop C
+   ret
+
+(code 'dbZapE 0)
+   ld A (E TAIL)  # Get tail
+   num A  # Any properties?
+   if z  # Yes
+      off A SYM  # Clear 'extern' tag
+      do
+         ld A (A CDR)  # Skip property
+         num A  # Find name
+      until nz
+      or A SYM  # Set 'extern' tag
+   end
+   shl A 2  # Set "deleted"
+   setc
+   rcr A 1
+   setc
+   rcr A 1
+   ld (E TAIL) A  # Set empty tail
+   ld (E) Nil  # Clear value
+   ret
+
+# (commit ['any] [exe1] [exe2]) -> T
+(code 'doCommit 2)
+   push X
+   push Y
+   push Z
+   ld X E
+   ld Y (E CDR)  # Y on args
+   ld E (Y)  # Eval 'any'
+   eval
+   link
+   push E  # <L I> 'any'
+   link
+   null (DbLog)  # Transaction log?
+   if z  # No
+      add (EnvProtect) 1  # Protect the operation
+   end
+   call wrLockDb  # Write lock DB
+   null (DbJnl)  # Journal?
+   if nz  # Yes
+      call lockJnl  # Write lock journal
+   end
+   null (DbLog)  # Transaction log?
+   if nz  # Yes
+      ld E (DbFiles)  # Iterate DB files
+      ld C (DBs)  # Count
+      do
+         set (E (+ IV 1)) 0  # Clear dirty flag
+         ld (E VII) 0  # and 'fluse'
+         sub C VIII  # Done?
+      until z  # Yes
+      push X
+      push Y
+      ld X Extern  # Iterate external symbol tree
+      ld Y 0  # Clear TOS
+      do
+         do
+            ld A (X CDR)  # Get subtrees
+            atom (A CDR)  # Right subtree?
+         while z  # Yes
+            ld C X  # Go right
+            ld X (A CDR)  # Invert tree
+            ld (A CDR) Y  # TOS
+            ld Y C
+         loop
+         do
+            ld A ((X) TAIL)  # Get external symbol's tail
+            call nameA_A  # Get name
+            rcl A 1  # Dirty or deleted?
+            if c  # Yes
+               push Y
+               rcr A 1
+               ld Y A  # Name in Y
+               call dbFileBlkY_AC  # Get file and block index
+               cmp A (DBs)  # Local file?
+               if lt  # Yes
+                  call setBlockAC_Z  # Set up block env
+                  call rdBlockZ_Z  # Read first block
+                  do
+                     call logBlock  # Write to transaction log
+                     null (BlkLink)  # More blocks?
+                  while nz  # Yes
+                     call rdBlockLinkZ_Z  # Read next block
+                  loop
+                  ld C (DbFile)
+                  set (C (+ IV 1)) 1  # Set dirty flag
+                  rcl Y 2  # Deleted?
+                  if nc  # No
+                     add (C VII) 1  # Increment 'fluse'
+                  end
+               end
+               pop Y
+            end
+            ld A (X CDR)  # Left subtree?
+            atom (A)
+            if z  # Yes
+               ld C X  # Go left
+               ld X (A)  # Invert tree
+               ld (A) Y  # TOS
+               or C SYM  # First visit
+               ld Y C
+               break T
+            end
+            do
+               ld A Y  # TOS
+               null A  # Empty?
+               jeq 20  # Done
+               sym A  # Second visit?
+               if z  # Yes
+                  ld C (A CDR)  # Nodes
+                  ld Y (C CDR)  # TOS on up link
+                  ld (C CDR) X
+                  ld X A
+                  break T
+               end
+               off A SYM  # Set second visit
+               ld C (A CDR)  # Nodes
+               ld Y (C)
+               ld (C) X
+               ld X A
+            loop
+         loop
+      loop
+20    ld X (DbFiles)  # Iterate DB files
+      ld Y (DBs)  # Count
+      do
+         ld A (X VII)  # Get 'fluse'
+         null A  # Any?
+         if nz  # Yes
+            push A  # Save as count
+            ld A X
+            ld C 0  # Save Block 0 and free list
+            call setBlkAC_Z  # Set up block env
+            call rdBlockZ_Z  # Read first block
+            do
+               call logBlock  # Write to transaction log
+               null (BlkLink)  # More blocks?
+            while nz  # Yes
+               sub (S) 1  # Decrement count
+            while nc
+               call rdBlockLinkZ_Z  # Read next block
+            loop
+            pop A  # Drop count
+         end
+         sub Y VIII  # Done?
+      until z  # Yes
+      cc putc_unlocked((hex "FF") (DbLog))  # Write end marker
+      cc putc_unlocked((hex "FF") (DbLog))
+      cc fflush((DbLog))  # Flush Transaction log
+      call logFileno_A  # Sync log file to disk
+      cc fsync(A)
+      nul4  # OK?
+      js trSyncErrX  # No
+      pop Y
+      pop X
+   end
+   ld Y (Y CDR)  # Eval pre-expression
+   ld E (Y)
+   eval
+   cmp (L I) Nil  # 'any'?
+   if eq  # No
+      push 0  # <L -I> No notification
+   else
+      ld A (Tell)
+      or A (Children)
+      push A  # <L -I> Notify flag
+      if nz
+         push A  # <L -II> Tell's buffer pointer
+         push (TellBuf)  # <L -III> Save current 'tell' env
+         sub S PIPE_BUF  # <L - III - PIPE_BUF> New 'tell' buffer
+         ld Z S  # Buffer pointer
+         call tellBegZ_Z  # Start 'tell' message
+         ld E (L I)  # Get 'any'
+         call prTellEZ  # Print to 'tell'
+         ld (L -II) Z  # Save buffer pointer
+      end
+   end
+   push X
+   push Y
+   ld X Extern  # Iterate external symbol tree
+   ld Y 0  # Clear TOS
+   do
+      do
+         ld A (X CDR)  # Get subtrees
+         atom (A CDR)  # Right subtree?
+      while z  # Yes
+         ld C X  # Go right
+         ld X (A CDR)  # Invert tree
+         ld (A CDR) Y  # TOS
+         ld Y C
+      loop
+      do
+         lea C ((X) TAIL)  # Get external symbol's tail
+         ld A (C)
+         num A  # Any properties?
+         if z  # Yes
+            off A SYM  # Clear 'extern' tag
+            do
+               lea C (A CDR)  # Skip property
+               ld A (C)
+               num A  # Find name
+            until nz
+         end
+         rcl A 1  # Dirty?
+         if c  # Yes
+            push Y
+            rcl A 1  # Deleted?
+            if nc  # No
+               setc  # Set "loaded"
+               rcr A 1
+               shr A 1
+               ld (C) A  # in status/name
+               ld Y A  # Name in Y
+               call dbFileBlkY_AC  # Get file and block index
+               cmp A (DBs)  # Local file?
+               if lt  # Yes
+                  call setBlockAC_Z  # Set up block env
+                  call rdBlockZ_Z  # Read first block
+                  ld B 1  # First block in object (might be a new object)
+                  or (Z (- BLK)) B  # Set in tag byte
+                  ld (PutBinBZ) putBlockBZ  # Set binary print function
+                  ld Y (X)  # Get external symbol
+                  ld E (Y)  # Print value
+                  ld (Extn) 0  # Set external symbol offset to zero
+                  call binPrintEZ
+                  ld Y (Y TAIL)  # Get tail
+                  off Y SYM  # Clear 'extern' tag
+                  do
+                     num Y  # Properties?
+                  while z  # Yes
+                     atom (Y)  # Flag?
+                     if z  # No
+                        ld E ((Y) CDR)  # Print key
+                        call binPrintEZ
+                        ld E ((Y))  # Print value
+                        call binPrintEZ
+                     else
+                        ld E (Y)  # Print key
+                        call binPrintEZ
+                        ld E TSym  # Print 'T'
+                        call binPrintEZ
+                     end
+                     ld Y (Y CDR)
+                  loop
+                  ld A NIX
+                  call putBlockBZ  # Output NIX
+                  ld Z (DbBlock)  # Block buffer in Z again
+                  ld B (Z)  # Lowest byte of link field
+                  and B BLKTAG  # Clear link
+                  zxt
+                  call setAdrAZ  # Store in last block
+                  call wrBlockZ  # Write block
+                  ld Y (BlkLink)  # More blocks?
+                  null Y
+                  if nz  # Yes
+                     call cleanUpY  # Clean up
+                  end
+                  null (L -I)  # Notify?
+                  if nz  # Yes
+                     ld Z (L -II)  # Get buffer pointer
+                     lea A ((TellBuf) (- PIPE_BUF 10))  # Space for EXTERN+<8>+END?
+                     cmp Z A
+                     if ge  # No
+                        call tellEndZ  # Close 'tell'
+                        lea Z (L (- (+ III PIPE_BUF)))  # Reset buffer pointer
+                        call tellBegZ_Z  # Start new 'tell' message
+                     end
+                     ld E (X)  # Get external symbol
+                     call prTellEZ  # Print to 'tell'
+                     ld (L -II) Z  # Save buffer pointer
+                  end
+               end
+            else  # Deleted
+               shr A 2  # Set "not loaded"
+               ld (C) A  # in status/name
+               ld Y A  # Name in Y
+               call dbFileBlkY_AC  # Get file and block index
+               cmp A (DBs)  # Local file?
+               if lt  # Yes
+                  add A (DbFiles)  # Get DB file
+                  ld (DbFile) A  # Set current
+                  ld Y C
+                  call cleanUpY  # Clean up
+                  null (L -I)  # Notify?
+                  if nz  # Yes
+                     ld Z (L -II)  # Get buffer pointer
+                     lea A ((TellBuf) (- PIPE_BUF 10))  # Space for EXTERN+<8>+END?
+                     cmp Z A
+                     if ge  # No
+                        call tellEndZ  # Close 'tell'
+                        lea Z (L (- (+ III PIPE_BUF)))  # Reset buffer pointer
+                        call tellBegZ_Z  # Start new 'tell' message
+                     end
+                     ld E (X)  # Get external symbol
+                     call prTellEZ  # Print to 'tell'
+                     ld (L -II) Z  # Save buffer pointer
+                  end
+               end
+            end
+            pop Y
+         end
+         ld A (X CDR)  # Left subtree?
+         atom (A)
+         if z  # Yes
+            ld C X  # Go left
+            ld X (A)  # Invert tree
+            ld (A) Y  # TOS
+            or C SYM  # First visit
+            ld Y C
+            break T
+         end
+         do
+            ld A Y  # TOS
+            null A  # Empty?
+            jeq 40  # Done
+            sym A  # Second visit?
+            if z  # Yes
+               ld C (A CDR)  # Nodes
+               ld Y (C CDR)  # TOS on up link
+               ld (C CDR) X
+               ld X A
+               break T
+            end
+            off A SYM  # Set second visit
+            ld C (A CDR)  # Nodes
+            ld Y (C)
+            ld (C) X
+            ld X A
+         loop
+      loop
+   loop
+40 pop Y
+   pop X
+   null (L -I)  # Notify?
+   if nz  # Yes
+      ld Z (L -II)  # Get buffer pointer
+      call tellEndZ  # Close 'tell'
+      add S PIPE_BUF  # Drop 'tell' buffer
+      pop (TellBuf)
+   end
+   ld Y (Y CDR)  # Eval post-expression
+   ld E (Y)
+   eval
+   null (DbJnl)  # Journal?
+   if nz  # Yes
+      call unLockJnl  # Unlock journal
+   end
+   ld Y (Zap)  # Objects to delete?
+   atom Y
+   if z  # Yes
+      push (OutFile)  # Save output channel
+      sub S (+ III BUFSIZ)  # <S> Local buffer with sizeof(outFile)
+      ld E (Y CDR)  # Get zap file pathname
+      call pathStringE_SZ  # Write to stack buffer
+      cc open(S (| O_APPEND O_CREAT O_WRONLY) (oct "0666"))  # Open zap file
+      nul4  # OK?
+      js openErrEX  # No
+      ld S Z  # Drop buffer
+      ld (S) A  # Store 'fd' in outFile
+      ld (S I) 0  # Clear 'ix'
+      ld (S II) 0  # and 'tty'
+      ld (OutFile) S  # Set OutFile
+      ld (PutBinBZ) putStdoutB  # Set binary print function
+      ld Y (Y)  # Get zap list
+      do
+         atom Y  # More symbols?
+      while z  # Yes
+         ld E (Y)  # Get next
+         ld (Extn) 0  # Set external symbol offset to zero
+         call binPrintEZ  # Print it
+         ld Y (Y CDR)
+      loop
+      ld A S  # Flush file
+      call flushA_F
+      ld A S  # Close file
+      call closeAX
+      ld ((Zap)) Nil  # Clear zap list
+      add S (+ III BUFSIZ)  # Drop buffer
+      pop (OutFile)  # Restore output channel
+   end
+   null (DbLog)  # Transaction log?
+   if nz  # Yes
+      call fsyncDB  # Sync DB files to disk
+      call truncLog  # Truncate log file
+   end
+   ld A 0  # Length
+   call rwUnlockDbA  # Unlock all
+   null (DbLog)  # Transaction log?
+   if z  # No
+      sub (EnvProtect) 1  # Unprotect
+   end
+   ld E (DbFiles)  # Iterate DB files
+   ld C (DBs)  # Count
+   do
+      ld (E VII) -1  # Init 'fluse'
+   until z  # Yes
+   drop
+   pop Z
+   pop Y
+   pop X
+   ld E TSym  # Return T
+   ret
+
+# (rollback) -> T
+(code 'doRollback 2)
+   push X
+   push Y
+   ld X Extern  # Iterate external symbol tree
+   ld Y 0  # Clear TOS
+   do
+      do
+         ld A (X CDR)  # Get subtrees
+         atom (A CDR)  # Right subtree?
+      while z  # Yes
+         ld C X  # Go right
+         ld X (A CDR)  # Invert tree
+         ld (A CDR) Y  # TOS
+         ld Y C
+      loop
+      do
+         ld E (X)  # Get external symbol
+         ld A (E TAIL)
+         num A  # Any properties?
+         if z  # Yes
+            off A SYM  # Clear 'extern' tag
+            do
+               ld A (A CDR)  # Skip property
+               num A  # Find name
+            until nz
+            or A SYM  # Set 'extern' tag
+         end
+         shl A 2  # Strip status bits
+         shr A 2
+         ld (E TAIL) A  # Set status/name
+         ld (E) Nil  # Clear value
+         ld A (X CDR)  # Left subtree?
+         atom (A)
+         if z  # Yes
+            ld C X  # Go left
+            ld X (A)  # Invert tree
+            ld (A) Y  # TOS
+            or C SYM  # First visit
+            ld Y C
+            break T
+         end
+         do
+            ld A Y  # TOS
+            null A  # Empty?
+            jeq 90  # Done
+            sym A  # Second visit?
+            if z  # Yes
+               ld C (A CDR)  # Nodes
+               ld Y (C CDR)  # TOS on up link
+               ld (C CDR) X
+               ld X A
+               break T
+            end
+            off A SYM  # Set second visit
+            ld C (A CDR)  # Nodes
+            ld Y (C)
+            ld (C) X
+            ld X A
+         loop
+      loop
+   loop
+90 pop Y
+   pop X
+   ld E TSym  # Return T
+   ret
+
+# (mark 'sym|0 [NIL | T | 0]) -> flg
+(code 'doMark 2)
+   push X
+   push Y
+   ld X E
+   ld Y (E CDR)  # Y on args
+   ld E (Y)  # Eval first
+   eval
+   zero E  # Zero?
+   if eq  # Yes
+      ld X (DbFiles)  # Iterate DB files
+      ld Y (DBs)  # Count
+      do
+         sub Y VIII  # Done?
+      while ge  # No
+         ld (X V) 0  # Mark vector size zero
+         cc free((X VI))  # Free mark bit vector
+         ld (X VI) 0  # Set to null
+         add X VIII  # Increment by sizeof(dbFile)
+      loop
+      ld E Nil  # Return NIL
+      pop Y
+      pop X
+      ret
+   end
+   num E  # Need symbol
+   jnz symErrEX
+   sym E
+   jz symErrEX
+   sym (E TAIL)  # External symbol?
+   jz extErrEX  # No
+   push E  # <S> 'sym'
+   ld E ((Y CDR))  # Eval second arg
+   eval
+   xchg E (S)  # <S> NIL | T | 0
+   call fileObjE_AC  # Get file and ID
+   shl A 6  # 'dbFile' index
+   cmp A (DBs)  # Local file?
+   jge dbfErrX  # No
+   add A (DbFiles)  # Get DB file
+   ld X A  # into X
+   ld E C  # Object ID in E
+   shr E 3  # Byte position
+   cmp E (X V)  # Greater or equal to mark vector size?
+   if ge  # Yes
+      push E  # Save byte position
+      add E 1  # New size
+      ld Y E  # Keep in Y
+      ld A (X VI)  # Get mark bit vector
+      call allocAE_A  # Increase to new size
+      ld (X VI) A
+      xchg E (X V)  # Store size in 'dbFile', get old size
+      sub Y E  # Length of new area
+      add E A  # Start position of new area
+      ld B 0  # Clear new area
+      mset (E) Y
+      pop E  # Restore byte position
+   end
+   add E (X VI)  # Byte position in bit vector
+   and C 7  # Lowest three bits of object ID
+   ld B 1  # Bit position
+   shl B C  # in B
+   test (E) B  # Bit test
+   if z  # Not set
+      cmp (S) TSym  # Second arg 'T'?
+      if eq  # Yes
+         or (E) B  # Set mark
+      end
+      ld E Nil  # Return NIL
+   else  # Bit was set
+      zero (S)  # Second arg '0'?
+      if eq  # Yes
+         not B
+         and (E) B  # Clear mark
+      end
+      ld E TSym  # Return T
+   end
+   pop A  # Drop second arg
+   pop Y
+   pop X
+   ret
+
+# (free 'cnt) -> (sym . lst)
+(code 'doFree 2)
+   push X
+   push Y
+   push Z
+   ld X E
+   ld E ((E CDR))  # Eval 'cnt'
+   call evCntEX_FE
+   sub E 1  # File is zero-based
+   shl E 6  # 'dbFile' index
+   cmp E (DBs)  # Local file?
+   jge dbfErrX  # No
+   add E (DbFiles)  # Get DB file
+   ld (DbFile) E  # Set current
+   call rdLockDb  # Lock for reading
+   ld C (* 2 BLK)  # Read 'free' and 'next'
+   ld E 0  # from block zero
+   ld Z Buf  # into 'Buf'
+   call blkPeekCEZ
+   call getAdrZ_A  # Get 'free'
+   ld (BlkLink) A  # Store as next block
+   add Z BLK
+   call getAdrZ_A  # Get 'next'
+   ld C A  # Object ID
+   shr C 6  # Normalize
+   ld E ((DbFile) I)  # Get file number
+   call extNmCE_X  # Build external symbol name
+   call externX_E  # New external symbol
+   call cons_Y  # Cons as CAR of result list
+   ld (Y) E
+   ld (Y CDR) Nil
+   link
+   push Y  # (L I) Result list
+   link
+   do  # Collect free list
+      ld C (BlkLink)  # Next free block?
+      null C
+   while nz  # Yes
+      shr C 6  # Normalize
+      ld E ((DbFile) I)  # Get file number
+      call extNmCE_X  # Build external symbol name
+      call externX_E  # New external symbol
+      call cons_A  # Next cell
+      ld (A) E
+      ld (A CDR) Nil
+      ld (Y CDR) A  # Append ot result list
+      ld Y A
+      call rdBlockLinkZ_Z  # Read next block
+   loop
+   ld A (hex "10000")  # Length 1
+   call rwUnlockDbA  # Unlock
+   ld E (L I)  # Get result list
+   drop
+   pop Z
+   pop Y
+   pop X
+   ret
+
+# (dbck ['cnt] 'flg) -> any
+(code 'doDbck 2)
+   push X
+   push Y
+   push Z
+   ld X E
+   ld Y (E CDR)  # Y on args
+   ld E (Y)  # Eval first
+   eval
+   ld (DbFile) (DbFiles)  # Default to first dbFile
+   cnt E  # 'cnt' arg?
+   if nz  # Yes
+      off E 15  # Normalize + 'dbFile' index
+      sub E (hex "10")  # Zero-based
+      shl E 2
+      cmp E (DBs)  # Local file?
+      jge dbfErrX  # No
+      add E (DbFiles)  # Get DB file
+      ld (DbFile) E  # Set current
+      ld Y (Y CDR)  # Next arg
+      ld E (Y)
+      eval  # Eval next arg
+   end
+   push E  # <S III> 'flg'
+   push ZERO  # <S II> 'syms'
+   push ZERO  # <S I> 'blks'
+   add (EnvProtect) 1  # Protect the operation
+   call wrLockDb  # Write lock DB
+   null (DbJnl)  # Journal?
+   if nz  # Yes
+      call lockJnl  # Write lock journal
+   end
+   ld C (* 2 BLK)  # Read 'free' and 'next'
+   ld E 0  # from block zero
+   ld Z Buf  # into 'Buf'
+   call blkPeekCEZ
+   call getAdrZ_A  # Get 'free'
+   ld (BlkLink) A  # Store as next block
+   add Z BLK
+   call getAdrZ_A  # Get 'next'
+   push A  # <S> 'next'
+   ld Y BLKSIZE  # 'cnt' in Y
+   do  # Check free list
+      ld A (BlkLink)  # Next block?
+      null A
+   while nz  # Yes
+      call rdBlockIndexAZ_Z  # Read next block
+      add Y BLKSIZE  # Increment 'cnt'
+      cmp Y (S)  # Greater than 'next'?
+      if gt  # Yes
+         ld E CircFree  # Circular free list
+         call mkStrE_E  # Return message
+         jmp 90
+      end
+      ld Z (DbBlock)  # Block buffer in Z again
+      or (Z) BLKTAG  # Mark free list
+      call wrBlockZ  # Write block
+   loop
+   ld X BLKSIZE  # 'p' in X
+   do  # Check all chains
+      cmp X (S)  # Reached 'next'?
+   while ne  # No
+      ld A X  # Get 'p'
+      call rdBlockIndexAZ_Z  # Read next block
+      sub Z BLK  # Block buffer in Z again
+      ld B (Z)  # Get tag byte
+      and B BLKTAG  # Block tag zero?
+      if z  # Yes
+         add Y BLKSIZE  # Increment 'cnt'
+         movn (Z) (Buf) BLK  # Insert into free list
+         call wrBlockZ  # Write block
+         ld A X  # Write 'free'
+         ld Z Buf  # into 'Buf'
+         call setAdrAZ
+         ld C BLK
+         ld E 0  # 'free' address
+         call blkPokeCEZ  # Write 'Buf'
+      else
+         cmp B 1  # ID-block of symbol?
+         if eq  # Yes
+            push X
+            add (S II) (hex "10")  # Increment 'blks'
+            add (S III) (hex "10")  # Increment 'syms'
+            add Y BLKSIZE  # Increment 'cnt'
+            ld X 2  # Init 'i'
+            do
+               ld A (BlkLink)  # Next block?
+               null A
+            while nz  # Yes
+               add Y BLKSIZE  # Increment 'cnt'
+               add (S II) (hex "10")  # Increment 'blks'
+               call rdBlockIndexAZ_Z  # Read next block
+               ld B (Z (- BLK))  # Get tag byte
+               and B BLKTAG  # Block tag
+               cmp B X  # Same as 'i'?
+               if ne  # No
+                  ld E BadChain  # Bad object chain
+                  call mkStrE_E  # Return message
+                  jmp 90
+               end
+               cmp X BLKTAG  # Less than maximum?
+               if lt  # Yes
+                  add X 1  # Increment
+               end
+            loop
+            pop X
+         end
+      end
+      add X BLKSIZE  # Increment 'p'
+   loop
+   ld Z Buf  # Get 'free'
+   call getAdrZ_A
+   ld (BlkLink) A  # Store as next block
+   do  # Unmark free list
+      null A  # Any?
+   while nz  # Yes
+      call rdBlockIndexAZ_Z  # Read next block
+      sub Z BLK  # Block buffer in Z again
+      ld B (Z)  # Get tag byte
+      and B BLKTAG  # Block tag non-zero?
+      if nz  # Nes
+         off (Z) BLKTAG  # Clear tag
+         call wrBlockZ  # Write block
+      end
+      ld A (BlkLink)  # Get next block
+   loop
+   cmp Y (S)  # 'cnt' == 'next'?
+   if ne  # No
+      ld E BadCount  # Circular free list
+      call mkStrE_E  # Return message
+   else
+      cmp (S III) Nil  # 'flg' is NIL?
+      ldz E Nil  # Yes: Return NIL
+      if ne  # No
+         call cons_E  # Return (blks . syms)
+         ld (E) (S I)  # 'blks'
+         ld (E CDR) (S II)  # 'syms'
+      end
+   end
+90 pop A  # Drop 'next'
+   pop A  # and 'blks'
+   pop A  # and 'syms'
+   pop A  # and 'flg'
+   null (DbJnl)  # Journal?
+   if nz  # Yes
+      call unLockJnl  # Unlock journal
+   end
+   ld A (hex "10000")  # Length 1
+   call rwUnlockDbA  # Unlock
+   sub (EnvProtect) 1  # Unprotect
+   pop Z
+   pop Y
+   pop X
+   ret
+: CircFree asciz "Circular free list"
+: BadChain asciz "Bad chain"
+: BadCount asciz "Bad count"
+
+# vi:et:ts=3:sw=3
diff --git a/src64/defs.l b/src64/defs.l
@@ -0,0 +1,65 @@
+# 03mar10abu
+# (c) Software Lab. Alexander Burger
+
+# Constants
+(equ HEAP (* 1024 1024))   # Heap size in bytes
+(equ CELLS (/ HEAP 16))    # Number of cells in a single heap (65536)
+(equ ZERO (short 0))       # Short number '0'
+(equ ONE (short 1))        # Short number '1'
+(equ TOP (hex "10000"))    # Character top
+(equ DB1 (hex "1A"))       # Name of '{1}'
+
+# Pointer offsets
+(equ I 8)
+(equ II 16)
+(equ III 24)
+(equ IV 32)
+(equ V 40)
+(equ VI 48)
+(equ VII 56)
+(equ VIII 64)
+(equ IX 72)
+
+(equ -I . -8)
+(equ -II . -16)
+(equ -III . -24)
+(equ -IV . -32)
+(equ -V . -40)
+(equ -VI . -48)
+(equ -VII . -56)
+(equ -VIII . -64)
+
+# Cell offsets
+(equ CNT 2)    # Count tag
+(equ BIG 4)    # Rest of a bignum + bignum tag
+(equ DIG -4)   # First digit of a big number
+(equ CDR 8)    # CDR part of a list cell
+(equ SIGN 8)   # Sign bit of a number
+(equ SYM 8)    # Symbol tag
+(equ TAIL -8)  # Tail of a symbol
+
+# I/O Tokens
+(equ NIX 0)       # NIL
+(equ BEG 1)       # Begin list
+(equ DOT 2)       # Dotted pair
+(equ END 3)       # End list
+(equ NUMBER 0)    # Number
+(equ INTERN 1)    # Internal symbol
+(equ TRANSIENT 2) # Transient symbol
+(equ EXTERN 3)    # External symbol
+
+# DB-I/O
+(equ BLK 6)       # Block address size
+(equ BLKSIZE 64)  # DB block unit size
+(equ BLKTAG 63)   # Block tag mask
+
+# Networking
+(equ UDPMAX 4096) # UDP buffer size
+
+# Case mappings from the GNU Kaffe Project
+(equ CHAR_UPPERCASE 1)
+(equ CHAR_LOWERCASE 2)
+(equ CHAR_LETTER 62)
+(equ CHAR_DIGIT 512)
+
+# vi:et:ts=3:sw=3
diff --git a/src64/err.l b/src64/err.l
@@ -0,0 +1,726 @@
+# 08mar10abu
+# (c) Software Lab. Alexander Burger
+
+# Debug print routine
+(code 'dbgS)
+   xchg E (S)  # Get return address
+   xchg E (S I)  # Get argument, save return
+   push C  # Save all registers
+   push A
+   push F  # And flags
+   push (OutFile)  # Save output channel
+   ld (OutFile) ((OutFiles) II)  # Set to OutFiles[2] (stderr)
+   push (EnvPutB)  # Save 'put'
+   ld (EnvPutB) putStdoutB  # Set new
+   call printE  # Print argument
+   call newline  # and a newline
+   pop (EnvPutB)  # Restore 'put'
+   pop (OutFile)  # and output channel
+   pop F
+   pop A
+   pop C
+   pop E
+   ret
+
+# System error number
+(code 'errnoEXY)
+   call errno_A  # Get 'errno'
+   cc strerror(A)  # Convert to string
+   ld Z A
+
+# E reason
+# X context
+# Y message format
+# Z message parameter
+(code 'errEXYZ)
+   sub S (+ 240 IV)  # <S> Message buffer, <S 240> outFrame
+   cc sprintf(S Y Z)  # Build message
+   null X  # Error context?
+   ld A Nil
+   ldnz A X  # Yes
+   ld (Up) A  # Save it
+   nul (S)  # Message empty?
+   if nz  # No
+      push E  # Save reason
+      lea E (S I)  # Make transient symbol
+      call mkStrE_E
+      ld (Msg) E  # Store in '*Msg'
+      ld C (Catch)  # Search catch frames
+      do
+         null C  # Any?
+      while nz  # Yes
+         ld Y (C I)  # Tag non-zero?
+         null Y
+         if nz  # Yes
+            do
+               atom Y  # List?
+            while z  # Yes
+               ld A (Y)  # Next element of tag list
+               ld E (Msg)  # Substring of '*Msg'?
+               push C
+               call subStrAE_F
+               pop C
+               if eq  # Yes
+                  ld Y (Y)  # Get tag list element
+                  cmp Y Nil  # NIL?
+                  ldz Y (Msg)  # Yes: Use *Msg instead
+                  push Y  # Save tag list element
+                  call unwindC_Z  # Unwind environments
+                  pop E  # Return tag list element from 'catch'
+                  ld S Z  # Restore stack
+                  jmp caught
+               end
+               ld Y (Y CDR)  # Tag list
+            loop
+         end
+         ld C (C)  # Next frame
+      loop
+      pop E  # Retrieve reason
+   end
+   ld (Chr) 0  # Init globals
+   ld (ExtN) 0
+   ld (EnvBrk) 0
+   ld (Alarm) Nil
+   ld (LineX) ZERO
+   ld (LineC) -1
+   lea Y (S 240)  # Pointer to outFrame
+   ld (Y I) 2  # fd = stderr
+   ld (Y II) 0  # pid = 0
+   call pushOutFilesY
+   ld Y (InFile)  # Current InFile
+   null Y  # Any?
+   if nz  # Yes
+      ld C (Y VI)  # Filename?
+      null C
+      if nz  # Yes
+         ld B (char "[")  # Output location
+         call (EnvPutB)
+         call outStringC  # Print filename
+         ld B (char ":")  # Separator ':'
+         call (EnvPutB)
+         ld A (Y V)  # Get 'src'
+         call outWordA  # Print line number
+         ld B (char "]")
+         call (EnvPutB)
+         call space
+      end
+   end
+   null X  # Error context?
+   if nz  # Yes
+      ld C ErrTok  # Print error token
+      call outStringC
+      push E  # Save reason
+      ld E X  # Get context
+      call printE  # Print context
+      call newline
+      pop E  # Retrieve reason
+   end
+   null E  # Reason?
+   if nz  # Yes
+      call printE  # Print reason
+      ld C Dashes  # Print " -- "
+      call outStringC
+   end
+   nul (S)  # Message empty?
+   if nz  # No
+      call outStringS  # Print message
+      call newline
+      cmp (Err) Nil  # Error handler?
+      if ne  # Yes
+         nul (Jam)  # Jammed?
+         if z  # No
+            set (Jam) 1  # Set flag
+            ld X (Err)  # Run error handler
+            prog X
+            set (Jam) 0  # Reset flag
+         end
+      end
+      ld E 1  # Exit error code
+      cc isatty(0)  # STDIN
+      nul4  # on a tty?
+      jz byeE  # No
+      cc isatty(1)  # STDOUT
+      nul4  # on a tty?
+      jz byeE  # No
+      ld B (char "?")  # Prompt
+      ld E Nil  # Load argument
+      ld X 0  # Runtime expression
+      call loadBEX_E
+   end
+   ld C 0  # Top frame
+   call unwindC_Z  # Unwind
+   ld (EnvProtect) 0  # Reset environments
+   ld (EnvTask) Nil
+   ld (EnvArgs) 0
+   ld (EnvNext) 0
+   ld (EnvMeth) 0
+   ld (EnvMake) 0
+   ld (EnvYoke) 0
+   ld (EnvTrace) 0
+   ld L 0  # Init link register
+   ld S (Stack0)  # and stack pointer
+   jmp restart  # Restart interpreter
+: ErrTok asciz "!? "
+: Dashes asciz " -- "
+
+(code 'unwindC_Z 0)
+   push C  # <S> Target frame
+   ld X (Catch)  # Catch link
+   ld Y (EnvBind)  # Bindings
+   do
+      null X  # Catch frames?
+   while nz  # Yes
+      do
+         null Y  # Bindings?
+      while nz  # Yes
+         ld C (Y -I)  # First env swap
+         null C  # Zero?
+         if nz  # No
+            ld A C  # 'j'
+            ld E 0  # 'n'
+            ld Z Y  # Bindings in Z
+            do
+               add E 1  # Increment 'n'
+               add A 1  # Done?
+            while nz  # No
+               ld Z ((Z) I)  # Follow link
+               null Z  # Any?
+            while nz  # Yes
+               cmp (Z -I) A  # Env swap nesting?
+               if lt  # Yes
+                  sub A 1  # Adjust
+               end
+            loop
+            do
+               ld A E  # Get 'n'
+               ld Z Y  # Bindings
+               do
+                  sub A 1  # 'n-1' times
+               while nz
+                  ld Z ((Z) I)  # Follow link
+               loop
+               ld A (Z)  # End of bindings in A
+               sub (Z -I) C  # Increment 'eswp' by absolute first eswp
+               if gt  # Overflowed
+                  ld (Z -I) 0  # Reset
+               end
+               if ge  # Last pass
+                  sub A II
+                  do
+                     xchg ((A)) (A I)  # Exchange next symbol value with saved value
+                     sub A II
+                     cmp A Z  # More?
+                  until lt  # No
+               end
+               sub E 1  # Decrement 'n'
+            until z  # Done
+         end
+         cmp Y (X III)  #  Reached last bind frame?
+      while ne  # No
+         ld C (Y)  # C on link
+         null (Y -I)  # Env swap now zero?
+         if z  # Yes
+            add Y I  # Y on bindings
+            do
+               ld Z (Y)  # Next symbol
+               add Y I
+               ld (Z) (Y)  # Restore value
+               add Y I
+               cmp Y C  # More?
+            until eq  # No
+         end
+         ld Y (C I)  # Bind link
+      loop
+      do
+         cmp (EnvInFrames) (X IV)  # Open input frames?
+      while nz  # Yes
+         call popInFiles  # Clean up
+      loop
+      do
+         cmp (EnvOutFrames) (X V)  # Open output frames?
+      while nz  # Yes
+         call popOutFiles  # Clean up
+      loop
+      do
+         cmp (EnvCtlFrames) (X VI)  # Open control frames?
+      while nz  # Yes
+         call popCtlFiles  # Clean up
+      loop
+      movn (Env) (X III) "(EnvEnd-Env)"  # Restore environment
+      ld E (X II)  # 'fin'
+      eval  # Evaluate 'finally' expression
+      cmp X (S)  # Reached target catch frame?
+      ld X (X)  # Catch link
+      ld (Catch) X
+      if eq  # Yes
+         pop Z  # Get target frame
+         ret
+      end
+   loop
+   pop A  # Drop target frame
+   do  # Top level bindings
+      null Y  # Any?
+   while nz  # Yes
+      ld C (Y)  # C on link
+      null (Y -I)  # Env swap zero?
+      if z  # Yes
+         add Y I  # Y on bindings
+         do
+            ld Z (Y)  # Next symbol
+            add Y I
+            ld (Z) (Y)  # Restore value
+            add Y I
+            cmp Y C  # More?
+         until eq  # No
+      end
+      ld Y (C I)  # Bind link
+   loop
+   ld (EnvBind) 0
+   do
+      null (EnvInFrames)  # Open input frames?
+   while nz  # Yes
+      call popInFiles  # Clean up
+   loop
+   do
+      null (EnvOutFrames)  # Open output frames?
+   while nz  # Yes
+      call popOutFiles  # Clean up
+   loop
+   do
+      null (EnvCtlFrames)  # Open control frames?
+   while nz  # Yes
+      call popCtlFiles  # Clean up
+   loop
+   ret
+
+### Checks ###
+(code 'needSymAX 0)
+   num A  # Need symbol
+   jnz symErrAX
+   sym A
+   jz symErrAX
+   cmp A Nil  # A < NIL ?
+   jc ret  # Yes
+   cmp A TSym  # A > T ?
+   jncz Ret  # Yes
+   ld E A
+   jmp protErrEX
+
+(code 'needSymEX 0)
+   num E  # Need symbol
+   jnz symErrEX
+   sym E
+   jz symErrEX
+   cmp E Nil  # E < NIL ?
+   jc ret  # Yes
+   cmp E TSym  # E > T ?
+   jncz Ret  # Yes
+   jmp protErrEX
+
+(code 'needVarAX 0)
+   num A  # Need variable
+   jnz varErrAX
+   cmp A Nil  # A < NIL ?
+   jc ret  # Yes
+   cmp A TSym  # A > T ?
+   jncz Ret  # Yes
+   ld E A
+   jmp protErrEX
+
+(code 'needVarEX 0)
+   num E  # Need variable
+   jnz varErrEX
+   cmp E Nil  # E < NIL ?
+   jc ret  # Yes
+   cmp E TSym  # E > T ?
+   jncz Ret  # Yes
+   jmp protErrEX
+
+(code 'checkVarAX 0)
+   cmp A Nil  # A < NIL ?
+   jc ret  # Yes
+   cmp A TSym  # A > T ?
+   jncz Ret  # Yes
+   ld E A
+   jmp protErrEX
+
+(code 'checkVarYX 0)
+   cmp Y Nil  # Y < NIL ?
+   jc ret  # Yes
+   cmp Y TSym  # Y > T ?
+   jncz Ret  # Yes
+   ld E Y
+   jmp protErrEX
+
+(code 'checkVarEX 0)
+   cmp E Nil  # E < NIL ?
+   jc ret  # Yes
+   cmp E TSym  # E > T ?
+   jncz Ret  # Yes
+(code 'protErrEX)
+   ld Y ProtErr
+   jmp errEXYZ
+: ProtErr asciz "Protected symbol"
+
+### Error messages ###
+(code 'argErrAX)
+   ld E A
+(code 'argErrEX)
+   ld Y ArgErr
+   jmp errEXYZ
+: ArgErr asciz "Bad argument"
+
+(code 'numErrAX)
+   ld E A
+(code 'numErrEX)
+   ld Y NumErr
+   jmp errEXYZ
+: NumErr asciz "Number expected"
+
+(code 'cntErrAX)
+   ld C A
+(code 'cntErrCX)
+   ld E C
+(code 'cntErrEX)
+   ld Y CntErr
+   jmp errEXYZ
+: CntErr asciz "Small number expected"
+
+(code 'symErrAX)
+   ld Y A
+(code 'symErrYX)
+   ld E Y
+(code 'symErrEX)
+   ld Y SymErr
+   jmp errEXYZ
+: SymErr asciz "Symbol expected"
+
+(code 'extErrEX)
+   ld Y ExtErr
+   jmp errEXYZ
+: ExtErr asciz "External symbol expected"
+
+(code 'cellErrAX)
+   ld E A
+(code 'cellErrEX)
+   ld Y CellErr
+   jmp errEXYZ
+: CellErr asciz "Cell expected"
+
+(code 'atomErrAX)
+   ld E A
+(code 'atomErrEX)
+   ld Y AtomErr
+   jmp errEXYZ
+: AtomErr asciz "Atom expected"
+
+(code 'lstErrAX)
+   ld E A
+(code 'lstErrEX)
+   ld Y LstErr
+   jmp errEXYZ
+: LstErr asciz "List expected"
+
+(code 'varErrAX)
+   ld E A
+(code 'varErrEX)
+   ld Y VarErr
+   jmp errEXYZ
+: VarErr asciz "Variable expected"
+
+(code 'divErrX)
+   ld E 0
+   ld Y DivErr
+   jmp errEXYZ
+: DivErr asciz "Div/0"
+
+(code 'renErrEX)
+   ld Y RenErr
+   jmp errEXYZ
+: RenErr asciz "Can't rename"
+
+(code 'makeErrEX)
+   ld Y MakeErr
+   jmp errEXYZ
+: MakeErr asciz "Not making"
+
+(code 'msgErrYX)
+   ld A Y
+(code 'msgErrAX)
+   ld E A
+(code 'msgErrEX)
+   ld Y MsgErr
+   jmp errEXYZ
+: MsgErr asciz "Bad message"
+
+(code 'brkErrX)
+   ld E 0
+   ld Y BrkErr
+   jmp errEXYZ
+: BrkErr asciz "No Break"
+
+# I/O errors
+(code 'openErrEX)
+   ld Y OpenErr
+   jmp errnoEXY
+: OpenErr asciz "Open error: %s"
+
+(code 'closeErrX)
+   ld E 0
+(code 'closeErrEX)
+   ld Y CloseErr
+   jmp errnoEXY
+: CloseErr asciz "Close error: %s"
+
+(code 'pipeErrX)
+   ld E 0
+   ld Y PipeErr
+   jmp errnoEXY
+: PipeErr asciz "Pipe error: %s"
+
+(code 'forkErrX)
+   ld E 0
+   ld Y ForkErr
+   jmp errEXYZ
+: ForkErr asciz "Can't fork"
+
+(code 'waitPidErrX)
+   ld E 0
+   ld Y WaitPidErr
+   jmp errnoEXY
+: WaitPidErr asciz "wait pid"
+
+(code 'badFdErrEX)
+   ld Y BadFdErr
+   jmp errEXYZ
+: BadFdErr asciz "Bad FD"
+
+(code 'noFdErrX)
+   ld E 0
+   ld Y NoFdErr
+   jmp errEXYZ
+: NoFdErr asciz "No current fd"
+
+(code 'eofErr)
+   ld E 0
+   ld X 0
+   ld Y EofErr
+   jmp errEXYZ
+: EofErr asciz "EOF Overrun"
+
+(code 'suparErrE)
+   ld X 0
+   ld Y SuparErr
+   jmp errEXYZ
+: SuparErr asciz "Super parentheses mismatch"
+
+(code 'badInputErrB)
+   zxt
+   ld Z A
+   ld E 0
+   ld X 0
+   ld Y BadInput
+   jmp errEXYZ
+: BadInput asciz "Bad input '%c'"
+
+(code 'badDotErrE)
+   ld X 0
+   ld Y BadDot
+   jmp errEXYZ
+: BadDot asciz "Bad dotted pair"
+
+(code 'selectErrX)
+   ld E 0
+   ld Y SelectErr
+   jmp errnoEXY
+: SelectErr asciz "Select error: %s"
+
+(code 'wrBytesErr)
+   ld E 0
+   ld X 0
+   ld Y WrBytesErr
+   jmp errnoEXY
+: WrBytesErr asciz "bytes write: %s"
+
+(code 'wrChildErr)
+   ld E 0
+   ld X 0
+   ld Y WrChildErr
+   jmp errnoEXY
+: WrChildErr asciz "child write: %s"
+
+(code 'wrSyncErrX)
+   ld E 0
+   ld Y WrSyncErr
+   jmp errnoEXY
+: WrSyncErr asciz "sync write: %s"
+
+(code 'wrJnlErr)
+   ld E 0
+   ld X 0
+   ld Y WrJnlErr
+   jmp errnoEXY
+: WrJnlErr asciz "Journal write: %s"
+
+(code 'wrLogErr)
+   ld E 0
+   ld X 0
+   ld Y WrLogErr
+   jmp errnoEXY
+: WrLogErr asciz "Log write: %s"
+
+(code 'truncErrX)
+   ld E 0
+   ld Y TruncErr
+   jmp errnoEXY
+: TruncErr asciz "Log truncate error: %s"
+
+(code 'dbSyncErrX)
+   ld E 0
+   ld Y DbSyncErr
+   jmp errnoEXY
+: DbSyncErr asciz "DB fsync error: %s"
+
+(code 'trSyncErrX)
+   ld E 0
+   ld Y TrSyncErr
+   jmp errnoEXY
+: TrSyncErr asciz "Transaction fsync error: %s"
+
+(code 'lockErr)
+   ld E 0
+   ld X 0
+   ld Y LockErr
+   jmp errnoEXY
+: LockErr asciz "File lock: %s"
+
+(code 'dbfErrX)
+   ld E 0
+   ld Y DbfErr
+   jmp errEXYZ
+: DbfErr asciz "Bad DB file"
+
+(code 'jnlErrX)
+   ld E 0
+   ld Y JnlErr
+   jmp errEXYZ
+: JnlErr asciz "Bad Journal"
+
+(code 'idErrXL)
+   ld E (L I)  # Get symbol
+   ld Y IdErr
+   jmp errEXYZ
+: IdErr asciz "Bad ID"
+
+(code 'dbRdErr)
+   ld E 0
+   ld X 0
+   ld Y DbRdErr
+   jmp errnoEXY
+: DbRdErr asciz "DB read: %s"
+
+(code 'dbWrErr)
+   ld E 0
+   ld X 0
+   ld Y DbWrErr
+   jmp errnoEXY
+: DbWrErr asciz "DB write: %s"
+
+(code 'dbSizErr)
+   ld E 0
+   ld X 0
+   ld Y DbSizErr
+   jmp errEXYZ
+: DbSizErr asciz "DB Oversize"
+
+(code 'tellErr)
+   ld E 0
+   ld X 0
+   ld Y TellErr
+   jmp errEXYZ
+: TellErr asciz "Tell PIPE_BUF"
+
+(code 'ipSocketErrX)
+   ld E 0
+   ld Y IpSocketErr
+   jmp errnoEXY
+: IpSocketErr asciz "IP socket error: %s"
+
+(code 'ipGetsocknameErrX)
+   ld E 0
+   ld Y IpGetsocknameErr
+   jmp errnoEXY
+: IpGetsocknameErr asciz "IP getsockname error: %s"
+
+(code 'ipSetsockoptErrX)
+   ld E 0
+   ld Y IpSetsockoptErr
+   jmp errnoEXY
+: IpSetsockoptErr asciz "IP setsockopt error: %s"
+
+(code 'ipBindErrX)
+   ld E 0
+   ld Y IpBindErr
+   jmp errnoEXY
+: IpBindErr asciz "IP bind error: %s"
+
+(code 'ipListenErrX)
+   ld E 0
+   ld Y IpListenErr
+   jmp errnoEXY
+: IpListenErr asciz "IP listen error: %s"
+
+(code 'udpOvflErr)
+   ld E 0
+   ld X 0
+   ld Y UdpOvflErr
+   jmp errEXYZ
+: UdpOvflErr asciz "UDP overflow"
+
+### Undefined symbol ###
+(code 'undefinedCE)
+   ld X E
+(code 'undefinedCX)
+   ld E C
+(code 'undefinedEX)
+   ld Y UndefErr
+   jmp errEXYZ
+: UndefErr asciz "Undefined"
+
+(code 'dlErrX)
+   ld E 0
+   cc dlerror()  # Get dynamic loader error message
+   ld Y DlErr
+   ld Z A
+   jmp errEXYZ
+: DlErr asciz "[DLL] %s"
+
+### Global return labels ###
+(code 'ret 0)
+   ret
+(code 'retc 0)
+   setc
+   ret
+(code 'retnc 0)
+   clrc
+   ret
+(code 'retz 0)
+   setz
+   ret
+(code 'retnz 0)
+   clrz
+   ret
+(code 'retNull 0)
+   ld E 0
+   ret
+(code 'retNil 0)
+   ld E Nil
+   ret
+(code 'retT 0)
+   ld E TSym
+   ret
+(code 'retE_E 0)
+   ld E (E)  # Get value or CAR
+   ret
+
+# vi:et:ts=3:sw=3
diff --git a/src64/ext.l b/src64/ext.l
@@ -0,0 +1,248 @@
+# 05mar10abu
+# (c) Software Lab. Alexander Burger
+
+### Soundex Algorithm ###
+(data 'SnxTab)
+bytes (
+   (char "0") (char "1") (char "2") (char "3") (char "4") (char "5") (char "6") (char "7")  # 48
+   (char "8") (char "9")        0          0          0          0          0          0
+          0          0   (char "F") (char "S") (char "T")        0   (char "F") (char "S")  # 64
+          0          0   (char "S") (char "S") (char "L") (char "N") (char "N")        0
+   (char "F") (char "S") (char "R") (char "S") (char "T")        0   (char "F") (char "F")
+   (char "S")        0   (char "S")        0          0          0          0          0
+          0          0   (char "F") (char "S") (char "T")        0   (char "F") (char "S")  # 96
+          0          0   (char "S") (char "S") (char "L") (char "N") (char "N")        0
+   (char "F") (char "S") (char "R") (char "S") (char "T")        0   (char "F") (char "F")
+   (char "S")        0   (char "S")        0          0          0          0          0
+          0          0          0          0          0          0          0          0  # 128
+          0          0          0          0          0          0          0          0
+          0          0          0          0          0          0          0          0
+          0          0          0          0          0          0          0          0
+          0          0          0          0          0          0          0          0  # 160
+          0          0          0          0          0          0          0          0
+          0          0          0          0          0          0          0          0
+          0          0          0          0          0          0          0          0
+          0          0          0          0          0          0          0   (char "S")  # 192
+          0          0          0          0          0          0          0          0
+   (char "T") (char "N")   0    0          0          0          0   (char "S")
+          0          0          0          0          0          0          0   (char "S")
+          0          0          0          0          0          0          0   (char "S")  # 224
+          0          0          0          0          0          0          0          0
+          0   (char "N") )
+
+(equ SNXBASE 48)
+(equ SNXSIZE (+ (* 24 8) 2))
+
+# (ext:Snx 'any ['cnt]) -> sym
+(code 'Snx 2)
+   push X
+   push Y
+   ld X E
+   ld Y (E CDR)  # Y on args
+   call evSymY_E  # Eval 'any'
+   cmp E Nil
+   if ne  # No
+      ld E (E TAIL)
+      call nameE_E  # Get name
+      link
+      push E  # <L II> Save Name
+      link
+      ld Y (Y CDR)  # Next arg
+      atom Y  # Any?
+      ldnz E 24  # Default to 24
+      if z  # Yes
+         call evCntXY_FE  # Eval 'cnt'
+      end
+      tuck ZERO  # <L I> Result
+      ld X S
+      link
+      push 4  # <S II> Build name
+      push X  # <S I> Pack status
+      ld X (L II) # Get name
+      ld C 0  # Index
+      do
+         call symCharCX_FACX  # First char?
+         jz 90  # No
+         cmp A SNXBASE  # Too small?
+      until ge  # No
+      cmp A (char "a")  # Lower case?
+      if ge
+         cmp A (char "z")
+         jle 40  # Yes
+      end
+      cmp A 128
+      jeq 40  # Yes
+      cmp A 224
+      if ge
+         cmp A 255
+         if le  # Yes
+40          off B 32  # Convert to lower case
+         end
+      end
+      push A  # <S> Last character
+      xchg C (S II)  # Swap status
+      xchg X (S I)
+      call charSymACX_CX  # Pack first char
+      xchg X (S I)  # Swap status
+      xchg C (S II)
+      do
+         call symCharCX_FACX  # Next char?
+      while nz  # Yes
+         cmp A 32  # Non-white?
+         if gt  # Yes
+            sub A SNXBASE  # Too small?
+            jlt 60  # Yes
+            cmp A SNXSIZE  # Too big?
+            jge 60  # Yes
+            ld B (A SnxTab)  # Character entry?
+            zxt
+            or A A
+            if z  # No
+60             ld (S) 0  # Clear last character
+            else
+               cmp A (S)  # Same as last?
+               if ne  # No
+                  sub E 1  # Decrement count
+                  break z
+                  ld (S) A  # Save last character
+                  xchg C (S II)  # Swap status
+                  xchg X (S I)
+                  call charSymACX_CX  # Pack char
+                  xchg X (S I)  # Swap status
+                  xchg C (S II)
+               end
+            end
+         end
+      loop
+90    ld X (L I)  # Get result
+      call consSymX_E  # Make transient symbol
+      drop
+   end
+   pop Y
+   pop X
+   ret
+
+
+(equ BIAS 132)
+(equ CLIP (- 32767 BIAS))
+
+# (ext:Ulaw 'cnt) -> cnt  # SEEEMMMM
+(code 'Ulaw 2)
+   push X
+   ld X E
+   ld E ((E CDR))  # Get arg
+   eval  # Eval 'cnt'
+   cnt E  #  # Short number?
+   jz cntErrEX  # No
+   ld X 0  # No sign
+   shr E 4  # Normalize
+   if c  # Negative?
+      ld X (hex "80")  # Set sign
+   end
+   cmp E (+ CLIP 1)  # Clip the value
+   ldnc E CLIP
+   add E BIAS  # Increment by BIAS
+   ld A E  # Double value
+   add A A  # in 'tmp'
+   ld C 7  # Exponent
+   do
+      test A (hex "8000")
+   while z
+      add A A  # Double 'tmp'
+      sub C 1  # Decrement exponent
+   until z
+   ld A C  # Get exponent
+   add A 3  # plus 3
+   shr E A  # Shift value right
+   and E 15  # Lowest 4 bits
+   shl C 4  # Shift exponent left
+   or E C  # Combine with value
+   or E X  # and sign
+   not E  # Negate
+   and E (hex "FF")  # Get byte value
+   shl E 4  # Make short number
+   or E CNT
+   pop X
+   ret
+
+
+### Base64 Encoding ###
+(data 'Chr64)
+ascii "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
+
+# (ext:Base64 'num1|NIL ['num2|NIL ['num3|NIL]]) -> flg
+(code 'Base64 2)
+   push X
+   push Y
+   push Z
+   ld X E
+   ld Y (E CDR)  # Y on args
+   ld E (Y)  # Eval first 'num|NIL'
+   eval
+   cmp E Nil  # NIL?
+   if ne  # No
+      shr E 4  # Normalize first arg
+      ld Z E  # Keep in Z
+      shr E 2  # Upper 6 bits
+      call chr64E  # Output encoded
+      ld Y (Y CDR)  # Next arg
+      ld E (Y)
+      eval  # Eval second arg
+      cmp E Nil  # NIL?
+      if eq  # Yes
+         ld E Z  # Get first arg
+         and E 3  # Mask
+         shl E 4  # Shift to upper position
+         call chr64E  # Output encoded
+         ld B (char "=")  # and two equal signs
+         call envPutB
+         ld B (char "=")
+         call envPutB
+         ld E Nil  # Return NIL
+      else
+         shr E 4  # Normalize second arg
+         and Z 3  # Mask first arg
+         shl Z 4  # Shift to upper position
+         ld A E  # Get second arg
+         shr A 4  # Normalize
+         or A Z  # Combine
+         ld Z E  # Keep second arg in Z
+         call chr64A  # Output encoded
+         ld Y (Y CDR)  # Next arg
+         ld E (Y)
+         eval  # Eval third arg
+         cmp E Nil  # NIL?
+         if eq  # Yes
+            ld A Z  # Get second
+            and A 15  # Lowest four bits
+            shl A 2  # Shift
+            call chr64A  # Output encoded
+            ld B (char "=")  # and an equal sign
+            call envPutB
+            ld E Nil  # Return NIL
+         else
+            shr E 4  # Normalize third arg
+            ld A E
+            shr A 6  # Upper bits
+            and Z 15  # Lowest four bits of second arg
+            shl Z 2  # Shift
+            or A Z  # Combine
+            call chr64A  # Output encoded
+            and E 63  # Last arg
+            call chr64E  # Output encoded
+            ld E TSym  # Return T
+         end
+      end
+   end
+   pop Z
+   pop Y
+   pop X
+   ret
+
+(code 'chr64E)
+   ld A E
+(code 'chr64A)
+   ld B (A Chr64)  # Fetch from table
+   jmp envPutB  # Output byte
+
+# vi:et:ts=3:sw=3
diff --git a/src64/flow.l b/src64/flow.l
@@ -0,0 +1,3150 @@
+# 19apr10abu
+# (c) Software Lab. Alexander Burger
+
+(code 'redefMsgEC)
+   push (OutFile)  # Save output channel
+   ld (OutFile) ((OutFiles) II)  # Set to OutFiles[2] (stderr)
+   push (EnvPutB)  # Save 'put'
+   ld (EnvPutB) putStdoutB  # Set new
+   push C  # Save optional class
+   ld C HashBlank  # Print comment
+   call outStringC
+   call printE  # Print sym
+   pop E  # Class?
+   null E
+   if nz  # Yes
+      call space
+      call printE_E  # Print class
+   end
+   ld C Redefined  # Print message
+   call outStringC
+   pop (EnvPutB)  # Restore 'put'
+   pop (OutFile)  # and output channel
+   ret
+: HashBlank asciz "# "
+: Redefined asciz " redefined\\n"
+
+(code 'putSrcEC_E)
+   cmp (Dbg) Nil  # Debug?
+   if ne  # Yes
+      sym (E TAIL)  # External symbol?
+      if z  # No
+         ld A (InFile)  # Current InFile
+         null A  # Any?
+         if nz  # Yes
+            null (A VI)  # Filename?
+            if nz  # Yes
+               push X
+               push E  # <S I> sym
+               push C  # <S> key
+               ld C Dbg
+               call getEC_E  # Get '*Dbg' properties
+               ld X E  # into X
+               ld E ((InFile) VI)  # Get filename
+               call mkStrE_E  # Make string
+               ld A ((InFile) V)  # Get 'src'
+               shl A 4  # Make short number
+               or A CNT
+               push E
+               call consE_E  # (<src> . "filename")
+               ld (E) A
+               pop (E CDR)
+               ld A (S)  # Get key
+               null A  # Any?
+               if z  # No
+                  cmp X Nil  # '*Dbg' properties?
+                  if eq  # No
+                     push E
+                     call consE_E  # Make list
+                     pop (E)
+                     ld (E CDR) Nil
+                     ld A (S I)  # Put initial '*Dbg' properties
+                     ld C Dbg
+                     call putACE
+                  else
+                     ld (X) E  # Set first '*Dbg' property
+                  end
+               else
+                  cmp X Nil  # '*Dbg' properties?
+                  if eq  # No
+                     call consE_C  # Make list
+                     ld (C) E
+                     ld (C CDR) Nil
+                     call consC_E  # Empty first property
+                     ld (E) Nil
+                     ld (E CDR) C
+                     ld A (S I)  # Put initial '*Dbg' properties
+                     ld C Dbg
+                     call putACE
+                  else
+                     ld C (X CDR)  # Search secondary properties
+                     do
+                        atom C  # Any?
+                        if nz  # No
+                           call consE_C
+                           ld (C) (S)  # Get key
+                           ld (C CDR) E  # Cons with value
+                           call consC_A  # Insert into list
+                           ld (A) C
+                           ld (A CDR) (X CDR)
+                           ld (X CDR) A
+                           break T
+                        end
+                        cmp ((C)) (S)  # Found key?
+                        if eq  # Yes
+                           ld ((C) CDR) E  # Store value
+                           break T
+                        end
+                        ld C (C CDR)
+                     loop
+                  end
+               end
+               pop C
+               pop E
+               pop X
+            end
+         end
+      end
+   end
+   ret
+
+(code 'redefineCEX 0)
+   num E  # Need symbol
+   jnz symErrEX
+   sym E
+   jz symErrEX
+   call checkVarEX
+   ld A (E)  # Current value
+   cmp A Nil  # NIL?
+   if ne  # NO
+      cmp A E  # Auto-symbol?
+      if ne  # No
+         push C  # Save definition
+         push E  # and sym
+         ld E C  # Value
+         call equalAE_F  # Changing?
+         if ne  # Yes
+            ld E (S)  # Get sym
+            ld C 0  # No class
+            call redefMsgEC
+         end
+         pop E  # Retrieve sym
+         pop C  # and definition
+      end
+   end
+   ld (E) C  # Set definition
+   ld C 0  # No class
+   call putSrcEC_E  # Put source information
+   ret
+
+# (quote . any) -> any
+(code 'doQuote 2)
+   ld E (E CDR)  # Get CDR
+   ret
+
+# (as 'any1 . any2) -> any2 | NIL
+(code 'doAs 2)
+   ld E (E CDR)
+   push E  # Save args
+   ld E (E)  # Eval condition
+   eval
+   pop A  # Retrieve args
+   cmp E Nil  # Result NIL?
+   ldnz E (A CDR)  # No: Return 'any2'
+   ret
+
+# (pid 'pid|lst . exe) -> any
+(code 'doPid 2)
+   ld E (E CDR)
+   push (E CDR)  # Push rest
+   ld E (E)  # Eval condition
+   eval
+   ld A (Pid)  # Get '*Pid'
+   atom E  # Single 'pid'?
+   if nz  # Yes
+      cmp E A  # Matches '*Pid'?
+      pop E
+      jne retNil  # No
+      eval/ret  # Evaluate 'exe'
+   end
+   do
+      cmp (E) A  # CAR matches '*Pid'?
+      if eq
+         pop E
+         eval/ret  # Evaluate 'exe'
+      end
+      ld E (E CDR)  # Try next
+      atom E  # Any?
+   until nz  # No
+   pop A  # Drop 'exe'
+   ret
+
+# (lit 'any) -> any
+(code 'doLit 2)
+   ld E (E CDR)  # Get arg
+   ld E (E)  # Eval it
+   eval
+   num E  # Number?
+   if z  # No
+      cmp E Nil  # NIL?
+      if ne  # No
+         cmp E TSym  # T?
+         if ne  # No
+            atom E  # Cell?
+            jnz 10  # No
+            num (E)  # CAR number?
+            if z  # No
+10             ld A E
+               call consE_E  # Cons with 'quote'
+               ld (E) Quote
+               ld (E CDR) A
+            end
+         end
+      end
+   end
+   ret
+
+# (eval 'any ['cnt ['lst]]) -> any
+(code 'doEval 2)
+   push X
+   ld X (E CDR)  # Args
+   ld E (X)  # Eval first
+   eval
+   link
+   push E  # <L I> 'any'
+   link
+   ld X (X CDR)  # X on rest
+   atom X  # Any?
+   if nz  # No
+10    eval  # Evaluate 'any'
+      drop
+      pop X
+      ret
+   end
+   null (EnvBind)  # Bindings?
+   jz 10  # No
+   ld E (X)  # Eval 'cnt'
+   eval
+   shr E 4  # Normalize
+   push E  # <L -I> 'cnt'
+   push 0  # <L -II> 'n'
+   ld E ((X CDR))  # Last argument
+   eval  # Exclusion list 'lst' in E
+   push Y
+   ld C (L -I)  # Get 'cnt'
+   ld Y (EnvBind)  # and bindings
+   do
+      ld A (Y)  # End of bindings in A
+      add (L -II) 1  # Increment 'n'
+      sub (Y -I) (L -I)  # Decrement 'eswp' by 'cnt'
+      if c  # First pass
+         add Y I
+         do
+            ld X (Y)  # Next symbol
+            xchg (X) (Y I)  # Exchange symbol value with saved value
+            add Y II
+            cmp Y A  # More?
+         until eq  # No
+         cmp X At  # Lambda frame?
+         if eq  # Yes
+            sub C 1  # Decrement local 'cnt'
+            break z  # Done
+         end
+      end
+      ld Y (A I)  # Bind link
+      null Y  # More bindings?
+   until z  # No
+   atom E  # Exclusion list?
+   if nz  # No
+      ld E (L I)  # Get 'any'
+      eval  # Evaluate it
+   else
+      push (EnvBind)  # Build bind frame
+      link
+      do
+         ld X (E)  # Next excluded symbol
+         push (X)  # Save in bind frame
+         push X
+         ld C (L -II)  # Get 'n'
+         ld Y (EnvBind)  # Bindings
+         do
+            ld A (Y)  # End of bindings in A
+            add Y I
+            do
+               cmp X (Y)  # Found excluded symbol?
+               if eq  # Yes
+                  ld (X) (Y I)  # Bind to found value
+                  jmp 20
+               end
+               add Y II
+               cmp Y A  # More?
+            until eq  # No
+            sub C 1  # Traversed 'n' frames?
+         while nz  # No
+            ld Y (A I)  # Bind link
+            null Y  # More bindings?
+         until z  # No
+20       ld E (E CDR)
+         atom E  # Exclusion list?
+      until nz  # No
+      ld E ((L) I)  # Get 'any'
+      link
+      ld (EnvBind) L  # Close bind frame
+      push 0  # Init env swap
+      eval  # Evaluate 'any'
+      pop A  # Drop env swap
+      pop L  # Get link
+      do  # Unbind excluded symbols
+         pop X  # Next symbol
+         pop (X)  # Restore value
+         cmp S L  # More?
+      until eq  # No
+      pop L  # Restore link
+      pop (EnvBind)  # Restore bind link
+   end
+   ld C (L -II)  # Get 'n'
+   do
+      ld A C  # in A
+      ld Y (EnvBind)  # Bindings
+      do
+         sub A 1  # 'n-1' times
+      while nz
+         ld Y ((Y) I)  # Follow link
+      loop
+      ld A (Y)  # End of bindings in A
+      add (Y -I) (L -I)  # Increment 'eswp' by 'cnt'
+      if z  # Last pass
+         sub A II
+         do
+            xchg ((A)) (A I)  # Exchange next symbol value with saved value
+            sub A II
+            cmp A Y  # More?
+         until lt  # No
+      end
+      sub C 1  # Decrement 'n'
+   until z  # Done
+   pop Y
+   drop
+   pop X
+   ret
+
+# (run 'any ['cnt ['lst]]) -> any
+(code 'doRun 2)
+   push X
+   ld X (E CDR)  # Args
+   ld E (X)  # Eval first
+   eval
+   num E  # 'any' is number?
+   if z  # No
+      link
+      push E  # <L I> 'any'
+      link
+      ld X (X CDR)  # X on rest
+      atom X  # Any?
+      if nz  # No
+10       sym E  # Symbolic?
+         if nz  # Yes
+            ld E (E)  # Get value
+         else
+            call runE_E  # Execute
+         end
+         drop
+         pop X
+         ret
+      end
+      null (EnvBind)  # Bindings?
+      jz 10  # No
+      ld E (X)  # Eval 'cnt'
+      eval
+      shr E 4  # Normalize
+      push E  # <L -I> 'cnt'
+      push 0  # <L -II> 'n'
+      ld E ((X CDR))  # Last argument
+      eval  # Exclusion list 'lst' in E
+      push Y
+      ld C (L -I)  # Get 'cnt'
+      ld Y (EnvBind)  # and bindings
+      do
+         ld A (Y)  # End of bindings in A
+         add (L -II) 1  # Increment 'n'
+         sub (Y -I) (L -I)  # Decrement 'eswp' by 'cnt'
+         if c  # First pass
+            add Y I
+            do
+               ld X (Y)  # Next symbol
+               xchg (X) (Y I)  # Exchange symbol value with saved value
+               add Y II
+               cmp Y A  # More?
+            until eq  # No
+            cmp X At  # Lambda frame?
+            if eq  # Yes
+               sub C 1  # Decrement local 'cnt'
+               break z  # Done
+            end
+         end
+         ld Y (A I)  # Bind link
+         null Y  # More bindings?
+      until z  # No
+      atom E  # Exclusion list?
+      if nz  # No
+         ld X (L I)  # Run 'any'
+         sym X  # Symbolic?
+         if nz  # Yes
+            ld E (X)  # Get value
+         else
+            prog X  # Execute
+         end
+      else
+         push (EnvBind)  # Build bind frame
+         link
+         do
+            ld X (E)  # Next excluded symbol
+            push (X)  # Save in bind frame
+            push X
+            ld C (L -II)  # Get 'n'
+            ld Y (EnvBind)  # Bindings
+            do
+               ld A (Y)  # End of bindings in A
+               add Y I
+               do
+                  cmp X (Y)  # Found excluded symbol?
+                  if eq  # Yes
+                     ld (X) (Y I)  # Bind to found value
+                     jmp 20
+                  end
+                  add Y II
+                  cmp Y A  # More?
+               until eq  # No
+               sub C 1  # Traversed 'n' frames?
+            while nz  # No
+               ld Y (A I)  # Bind link
+               null Y  # More bindings?
+            until z  # No
+20          ld E (E CDR)
+            atom E  # Exclusion list?
+         until nz  # No
+         ld X ((L) I)  # Get 'any'
+         link
+         ld (EnvBind) L  # Close bind frame
+         push 0  # Init env swap
+         sym X  # 'any' symbolic?
+         if nz  # Yes
+            ld E (X)  # Get value
+         else
+            prog X  # Execute
+         end
+         pop A  # Drop env swap
+         pop L  # Get link
+         do  # Unbind excluded symbols
+            pop X  # Next symbol
+            pop (X)  # Restore value
+            cmp S L  # More?
+         until eq  # No
+         pop L  # Restore link
+         pop (EnvBind)  # Restore bind link
+      end
+      ld C (L -II)  # Get 'n'
+      do
+         ld A C  # in A
+         ld Y (EnvBind)  # Bindings
+         do
+            sub A 1  # 'n-1' times
+         while nz
+            ld Y ((Y) I)  # Follow link
+         loop
+         ld A (Y)  # End of bindings in A
+         add (Y -I) (L -I)  # Increment 'eswp' by 'cnt'
+         if z  # Last pass
+            sub A II
+            do
+               xchg ((A)) (A I)  # Exchange next symbol value with saved value
+               sub A II
+               cmp A Y  # More?
+            until lt  # No
+         end
+         sub C 1  # Decrement 'n'
+      until z  # Done
+      pop Y
+      drop
+   end
+   pop X
+   ret
+
+# (def 'sym 'any) -> sym
+# (def 'sym 'sym 'any) -> sym
+(code 'doDef 2)
+   push X
+   push Y
+   ld X E
+   ld Y (E CDR)  # Y on args
+   ld E (Y)  # Eval first
+   eval
+   call needSymEX  # Check symbol
+   sym (E TAIL)  # External symbol?
+   if nz  # Yes
+      call dbTouchEX  # Touch it
+   end
+   link
+   push E  # <L II/III> First symbol
+   ld Y (Y CDR)  # Next arg
+   ld E (Y)
+   eval+  # Eval next arg
+   push E  # <L I/II> Second arg
+   link
+   ld Y (Y CDR)  # Third arg?
+   atom Y
+   if nz  # No
+      ld C (L II)  # First symbol
+      ld A (C)  # Current value
+      cmp A Nil  # NIL?
+      if ne  # NO
+         cmp A C  # Auto-symbol?
+         if ne  # No
+            call equalAE_F  # Changing?
+            if ne  # Yes
+               ld E C  # Get sym
+               ld C 0  # No class
+               call redefMsgEC
+            end
+         end
+      end
+      ld E (L II)  # Get symbol
+      ld (E) (L I)  # Set new value
+      ld C 0  # No class
+      call putSrcEC_E  # Put source information
+   else
+      ld E (Y)
+      eval  # Eval next arg
+      tuck E  # <L I> Third arg
+      link
+      ld E (L III)  # First symbol
+      sym (E TAIL)  # External symbol?
+      if nz  # Yes
+         call dbTouchEX  # Touch it
+      end
+      ld C (L II)  # Second arg
+      call getEC_E  # Current property value
+      cmp E Nil  # NIL?
+      if ne  # NO
+         ld A (L I)  # New value
+         call equalAE_F  # Changing?
+         if ne  # Yes
+            ld E (L III)  # First symbol
+            ld C (L II)  # Property key
+            call redefMsgEC
+         end
+      end
+      ld A (L III)  # Symbol
+      ld C (L II)  # Key
+      ld E (L I)  # Value
+      call putACE
+      ld E (L III)  # Symbol
+      ld C (L II)  # Key
+      call putSrcEC_E  # Put source information
+   end
+   drop  # Return first symbol
+   pop Y
+   pop X
+   ret
+
+# (de sym . any) -> sym
+(code 'doDe 2)
+   push X
+   ld X (E CDR)  # Args
+   ld E (X)  # Symbol in E
+   ld C (X CDR)  # Body in C
+   call redefineCEX  # Redefine
+   pop X
+   ret
+
+# (dm sym . fun|cls2) -> sym
+# (dm (sym . cls) . fun|cls2) -> sym
+# (dm (sym sym2 [. cls]) . fun|cls2) -> sym
+(code 'doDm 2)
+   push X
+   push Y
+   ld X E
+   ld Y (E CDR)  # Y on args
+   ld E (Y)  # Get first
+   atom E  # First form?
+   if nz  # Yes
+      ld C (Class)  # Get 'cls' from Class
+   else
+      ld C (E CDR)
+      atom C  # Second form?
+      if z  # No
+         ld E (C CDR)  # 'cls'?
+         cmp E Nil
+         if eq  # No
+            ld E (Class)  # Default to Class
+         end
+         ld C (C)  # 'sym'
+         call getEC_E  # Get instance object
+         ld C E  # into C
+         ld E (Y)  # Get first again
+      end
+      ld E (E)  # msg
+   end
+   cmp E TSym  # 'msg' is T?
+   if ne  # No
+      push C  # Save class
+      ld C doMeth  # Get 'meth' code pointer
+      call redefineCEX  # Redefine
+      pop C
+   end
+   ld A (Y CDR)  # Explicit inheritance?
+   num A
+   if z  # No
+      sym A
+      if nz  # Yes
+         ld A (A)  # Get cls2's value
+         do
+            atom A  # More method definitions?
+            jnz msgErrAX  # No
+            atom (A)
+            jnz msgErrAX
+            cmp E ((A))  # Found 'msg'?
+            if eq  # Yes
+               ld Y (A)  # Get method entry
+               break T
+            end
+            ld A (A CDR)
+         loop
+      end
+   end
+   ld X (C)  # Get cls's value
+   do
+      atom X  # More method definitions?
+   while z  # Yes
+      atom (X)
+   while z
+      cmp E ((X))  # Found 'msg'?
+      if eq  # Yes
+         push E  # Save 'msg'
+         ld E ((X) CDR)  # Old body
+         ld A (Y CDR)  # New body
+         call equalAE_F  # Changing?
+         if ne  # Yes
+            ld E (S)  # Get 'msg'
+            push C  # Save 'cls'
+            call redefMsgEC
+            pop C
+         end
+         pop E
+         ld ((X) CDR) (Y CDR)  # Set new body
+         call putSrcEC_E  # Put source information
+         pop Y
+         pop X
+         ret
+      end
+      ld X (X CDR)
+   loop
+   atom (Y)  # First form or explict inheritance?
+   if nz  # Yes
+      call cons_A  # Cons into methods
+      ld (A) Y
+      ld (A CDR) (C)
+   else
+      call cons_A  # Cons 'msg'
+      ld (A) E
+      ld (A CDR) (Y CDR)  # With method body
+      push A
+      call consA_A  # Cons into methods
+      pop (A)
+      ld (A CDR) (C)
+   end
+   ld (C) A
+   call putSrcEC_E  # Put source information
+   pop Y
+   pop X
+   ret
+
+# Apply METH in C to X, with object A
+(code 'evMethodACXYZ_E 0)
+   push Z  # 'cls'
+   push Y  # 'key'
+   push (EnvMeth)  # <(L) II> Method frame
+   ld Y (C)  # Parameter list in Y
+   ld Z (C CDR)  # Body in Z
+   push (EnvBind)  # Build bind frame
+   link
+   push (At)  # Bind At
+   push At
+   push A  # Bind object in A
+   push This  # to 'This'
+   do
+      atom Y  # More evaluating parameters?
+   while z  # Yes
+      ld E (X)  # Get next argument
+      ld X (X CDR)
+      eval+  # Evaluate and save
+      push E
+      push (Y)  # Save symbol
+      ld Y (Y CDR)
+   loop
+   cmp Y Nil  # NIL-terminated parameter list?
+   if eq  # Yes: Bind parameter symbols
+      ld Y S  # Y on bindings
+      do
+         ld X (Y)  # Symbol in X
+         add Y I
+         ld A (X)  # Old value in A
+         ld (X) (Y)  # Set new value
+         ld (Y) A  # Save old value
+         add Y I
+         cmp Y L  # End?
+      until eq  # Yes
+      link
+      ld (EnvBind) L  # Close bind frame
+      push 0  # Init env swap
+      lea (EnvMeth) ((L) II)  # and method frame
+      prog Z  # Run body
+      pop A  # Drop env swap
+      pop L  # Get link
+      do  # Unbind symbols
+         pop X  # Next symbol
+         pop (X)  # Restore value
+         cmp S L  # More?
+      until eq  # No
+      pop L  # Restore link
+      pop (EnvBind)  # Restore bind link
+      pop (EnvMeth)  # and method link
+      pop A  # Drop frame
+      pop A
+      ret
+   end
+   # Non-NIL parameter
+   cmp Y At  # '@'?
+   if ne  # No
+      push (Y)  # Save last parameter's old value
+      push Y  # and the last parameter
+      ld (Y) X  # Set to unevaluated argument list
+      lea Y (S II)  # Y on evaluated bindings
+      do
+         ld X (Y)  # Symbol in X
+         add Y I
+         ld A (X)  # Old value in A
+         ld (X) (Y)  # Set new value
+         ld (Y) A  # Save old value
+         add Y I
+         cmp Y L  # End?
+      until eq  # Yes
+      link
+      ld (EnvBind) L  # Close bind frame
+      push 0  # Init env swap
+      lea (EnvMeth) ((L) II)  # and method frame
+      prog Z  # Run body
+      pop A  # Drop env swap
+      pop L  # Get link
+      do  # Unbind symbols
+         pop X  # Next symbol
+         pop (X)  # Restore value
+         cmp S L  # More?
+      until eq  # No
+      pop L  # Restore link
+      pop (EnvBind)  # Restore bind link
+      pop (EnvMeth)  # and method link
+      pop A  # Drop frame
+      pop A
+      ret
+   end
+   # Evaluated argument list
+   link  # Close bind frame
+   ld Y L  # Y on frame
+   push 0  # Init env swap
+   push (EnvNext)   # Save current 'next'
+   push (EnvArgs)  # and varArgs base
+   atom X  # Any args?
+   if nz  # No
+      ld (EnvArgs) 0
+      ld (EnvNext) 0
+   else
+      link  # Build varArgs frame
+      do
+         ld E (X)  # Get next argument
+         eval+  # Evaluate and save
+         push E
+         ld X (X CDR)
+         atom X  # More args?
+      until nz  # No
+      ld (EnvArgs) S  # Set new varArgs base
+      ld (EnvNext) L  # Set new 'next'
+      link  # Close varArgs frame
+   end
+   ld (EnvBind) Y  # Close bind frame
+   lea (EnvMeth) ((Y) II)  # and method frame
+   ld C (Y)  # End of bindings in C
+   add Y I
+   do
+      ld X (Y)  # Symbol in X
+      add Y I
+      ld A (X)  # Old value in A
+      ld (X) (Y)  # Set new value
+      ld (Y) A  # Save old value
+      add Y I
+      cmp Y C  # End?
+   until eq  # Yes
+   prog Z  # Run body
+   null (EnvNext)  # VarArgs?
+   if nz  # Yes
+      drop  # Drop varArgs
+   end
+   pop (EnvArgs)  # Restore varArgs base
+   pop (EnvNext)   # and 'next'
+   pop A  # Drop env swap
+   pop L  # Get link
+   do  # Unbind symbols
+      pop X  # Next symbol
+      pop (X)  # Restore value
+      cmp S L  # More?
+   until eq  # No
+   pop L  # Restore link
+   pop (EnvBind)  # Restore bind link
+   pop (EnvMeth)  # and method link
+   pop A  # Drop frame
+   pop A
+   ret
+
+(code 'methodEY_FCYZ 0)
+   ld A (E)  # Get class definition (methods and superclasses)
+   atom A  # Any?
+   if z  # Yes
+      do
+         ld C (A)  # First item
+         atom C  # Method definition?
+      while z  # Yes
+         cmp Y (C)  # Found method definition?
+         if eq  # Yes
+            ld C (C CDR)  # Return method
+            ret  # 'z'
+         end
+         ld A (A CDR)  # Next item
+         atom A  # Any?
+         jnz ret  # Return 'nz'
+      loop
+      do
+         ld Z A  # Set class list
+         ld E (A)  # Class symbol
+         push A
+         call methodEY_FCYZ  # Found method definition?
+         pop A
+         jeq ret  # 'z'
+         ld A (A CDR)  # Next superclass
+         atom A  # Any?
+      until nz  # No
+   end
+   ret  # 'nz'
+
+# (box 'any) -> sym
+(code 'doBox 2)
+   ld E ((E CDR))  # Get arg
+   eval  # Eval it
+   call consE_A  # New symbol
+   ld (A) ZERO  # anonymous
+   or A SYM
+   ld (A) E  # Set value
+   ld E A
+   ret
+
+# (new ['flg|num] ['typ ['any ..]]) -> obj
+(code 'doNew 2)
+   push X
+   push Y
+   push Z
+   ld X E
+   ld Y (E CDR)  # Y on args
+   ld E (Y)  # Eval first
+   eval
+   atom E  # 'typ' list?
+   if z  # Yes
+      call consE_A  # New object
+      ld (A) ZERO  # anonymous
+      or A SYM  # Make symbol
+      ld (A) E  # Set 'typ'
+      link
+      push A  # <L II> 'obj'
+      push Nil  # <L I> Safe
+      link
+   else
+      cmp E Nil  # 'flg'?
+      if eq  # NIL
+         call cons_E  # New object
+         ld (E) ZERO  # anonymous
+         or E SYM  # Make symbol
+         ld (E) Nil  # Init to 'NIL'
+      else  # External object
+         cnt E  # File number?
+         ldz E ONE  # Default to '1'
+         shr E 4  # Normalize
+         call newIdEX_X  # Allocate new external name
+         call externX_E  # Intern external symbol
+         ld A (E TAIL)  # Get name again
+         shl A 1
+         setc  # Set "dirty"
+         rcr A 1
+         ld (E TAIL) A  # Set name
+      end
+      link
+      push E  # <L II> 'obj'
+      push Nil  # <L I> Safe
+      link
+      ld Y (Y CDR)  # Next arg
+      ld E (Y)
+      eval  # Eval 'typ'
+      ld A (L II)  # Object in A
+      ld (A) E  #  Set value in 'obj'
+   end
+   ld X (Y CDR)  # Keep args in X
+   ld E A  # Object
+   ld Y TSym  # Search for initial method
+   ld Z Nil  # No classes
+   call methodEY_FCYZ  # Found?
+   if eq  # Yes
+      ld A (L II)  # 'obj'
+      call evMethodACXYZ_E
+   else
+      do
+         atom X  # More args?
+      while z  # Yes
+         ld E (X)  # Eval next key
+         eval
+         ld (L I) E  # Save it
+         ld X (X CDR)
+         ld E (X)  # Eval next value
+         eval
+         ld A (L II)  # 'obj'
+         ld C (L I)  # Key
+         call putACE  # Put value
+         ld X (X CDR)
+      loop
+   end
+   ld E (L II)  # Return 'obj'
+   drop
+   pop Z
+   pop Y
+   pop X
+   ret
+
+# (type 'any) -> lst
+(code 'doType 2)
+   push X
+   ld X E
+   ld E ((E CDR))  # E on arg
+   eval  # Eval it
+   num E  # Symbol?
+   if z
+      sym E
+      if nz  # Yes
+         sym (E TAIL)  # External symbol?
+         if nz  # Yes
+            call dbFetchEX  # Fetch it
+         end
+         pop X
+         ld E (E)  # Get value
+         ld C E  # Keep in C
+         do
+            atom E  # Class definitions?
+            jnz retNil  # No
+            atom (E)  # Class?
+            if nz  # Yes
+               ld A E
+               do
+                  num (A)  # Symbol?
+                  jnz retNil  # No
+                  ld A (A CDR)  # Next class
+                  atom A  # Any?
+                  if nz  # No
+                     cmp A Nil  # End of classes?
+                     jnz retNil  # No
+                     ret  # Return E
+                  end
+                  cmp C A  # Circular?
+                  jeq retNil  # Yes
+               loop
+            end
+            ld E (E CDR)  # Next definition
+            cmp C E  # Circular?
+            jeq retNil  # Yes
+         loop
+      end
+   end
+   pop X
+   ld E Nil  # Return NIL
+   ret
+
+# (isa 'cls|typ 'any) -> obj | NIL
+(code 'doIsa 2)
+   push X
+   push Y
+   ld X E
+   ld Y (E CDR)  # Y on args
+   ld E (Y)  # Eval first
+   eval
+   link
+   push E  # <L I> 'cls|typ'
+   link
+   ld Y (Y CDR)  # Next arg
+   ld E (Y)
+   eval  # Eval 'any'
+   num E  # Symbol?
+   if z
+      sym E
+      if nz  # Yes
+         sym (E TAIL)  # External symbol?
+         if nz  # Yes
+            call dbFetchEX  # Fetch it
+         end
+         ld C (L I)  # Get 'cls|typ'
+         atom C  # 'cls'?
+         if nz  # Yes
+            call isaCE_F  # Check
+            ldnz E Nil  # Return NIL if no match
+         else
+            ld Y C  # Get 'typ' in Y
+            do
+               ld C (Y)  # Next class
+               call isaCE_F  # Check
+               if nz
+                  ld E Nil  # Return NIL if no match
+                  break T
+               end
+               ld Y (Y CDR)  # More?
+               atom Y
+            until nz  # No
+         end
+         drop
+         pop Y
+         pop X
+         ret
+      end
+   end
+   ld E Nil  # Return NIL
+   drop
+   pop Y
+   pop X
+   ret
+
+: isaCE_F  # A, X
+   ld X (E)  # Get value
+   ld A X  # Keep in A
+   do
+      atom X  # Atomic value?
+      jnz ret  # Return NO
+      atom (X)  # Next item atomic?
+      if nz  # Yes
+         do
+            num (X)  # Numeric?
+            jnz ret  # Return NO
+            sym ((X) TAIL)  # External?
+            jnz ret  # Return NO
+            cmp C (X)  # Match?
+            jeq ret  # Return YES
+            push A  # Save list head
+            push E  # object
+            push X  # and list
+            ld E (X)  # Recurse
+            call isaCE_F  # Match?
+            pop X
+            pop E
+            pop A
+            jeq ret  # Return YES
+            ld X (X CDR)  # Next class
+            atom X  # Any?
+            jnz ret  # Return NO
+            cmp A X  # Circular?
+            jeq retnz  # Return NO
+            atom (X)  # Next item a list?
+            jz retnz  # Return NO
+         loop
+      end
+      ld X (X CDR)  # Next item
+      cmp A X  # Circular?
+      jeq retnz  # Yes
+   loop
+
+# (method 'msg 'obj) -> fun
+(code 'doMethod 2)
+   push X
+   push Y
+   push Z
+   ld X E
+   ld Y (E CDR)  # Y on args
+   ld E (Y)  # Eval first
+   eval  # Eval it
+   num E  # Need symbol
+   jnz symErrEX
+   sym E
+   jz symErrEX
+   link
+   push E  # <L I> 'msg'
+   link
+   ld E ((Y CDR))  # Second
+   eval  # 'obj'
+   num E  # Need symbol
+   jnz symErrEX
+   sym E
+   jz symErrEX
+   sym (E TAIL)  # External symbol?
+   if nz  # Yes
+      call dbFetchEX  # Fetch it
+   end
+   ld Y (L I)  # 'msg'
+   call methodEY_FCYZ  # Found?
+   ld E C  # Yes
+   ldnz E Nil  # No
+   drop
+   pop Z
+   pop Y
+   pop X
+   ret
+
+# (meth 'obj ..) -> any
+(code 'doMeth 2)
+   push X
+   push Y
+   push Z
+   ld X E
+   ld Y (E CDR)  # Y on args
+   ld E (Y)  # Eval 'obj'
+   eval
+   num E  # Need symbol
+   jnz symErrEX
+   sym E
+   jz symErrEX
+   link
+   push E  # <L I> 'obj'
+   link
+   sym (E TAIL)  # External symbol?
+   if nz  # Yes
+      call dbFetchEX  # Fetch it
+   end
+   push (Y CDR)  # Save args
+   ld Y (X)  # Get 'msg'
+   do
+      num Y  # Need symbol
+      jnz msgErrYX
+      sym Y
+      jz msgErrYX
+      cnt (Y)  # Value numeric?
+      if nz  # Yes
+         ld Z Nil  # No classes
+         call methodEY_FCYZ  # Found?
+         jne msgErrYX  # No
+         ld A (L I)  # Get 'obj'
+         pop X  # and args
+         call evMethodACXYZ_E
+         drop
+         pop Z
+         pop Y
+         pop X
+         ret
+      end
+      ld Y (Y)  # Get value
+   loop
+
+# (send 'msg 'obj ['any ..]) -> any
+(code 'doSend 2)
+   push X
+   push Y
+   push Z
+   ld X E
+   ld Y (E CDR)  # Y on args
+   ld E (Y)  # Eval 'msg'
+   eval
+   num E  # Need symbol
+   jnz symErrEX
+   sym E
+   jz symErrEX
+   link
+   push E  # <L II> 'msg'
+   ld Y (Y CDR)  # Next arg
+   ld E (Y)
+   eval+  # Eval 'obj'
+   push E  # <L I> 'obj'
+   link
+   num E  # Need symbol
+   jnz symErrEX
+   sym E
+   jz symErrEX
+   sym (E TAIL)  # External symbol?
+   if nz  # Yes
+      call dbFetchEX  # Fetch it
+   end
+   ld X (Y CDR)  # Keep args in X
+   ld Y (L II)  # Get 'msg'
+   ld Z Nil  # No classes
+   call methodEY_FCYZ  # Found?
+   jne msgErrYX  # No
+   ld A (L I)  # Get 'obj'
+   call evMethodACXYZ_E
+   drop
+   pop Z
+   pop Y
+   pop X
+   ret
+
+# (try 'msg 'obj ['any ..]) -> any
+(code 'doTry 2)
+   push X
+   push Y
+   push Z
+   ld X E
+   ld Y (E CDR)  # Y on args
+   ld E (Y)  # Eval 'msg'
+   eval
+   num E  # Need symbol
+   jnz symErrEX
+   sym E
+   jz symErrEX
+   link
+   push E  # <L II> 'msg'
+   ld Y (Y CDR)  # Next arg
+   ld E (Y)
+   eval+  # Eval
+   push E  # <L I> 'obj'
+   link
+   num E  # Symbol?
+   jnz 90
+   sym E
+   jz 90  # No
+   sym (E TAIL)  # External symbol?
+   if nz  # Yes
+      call isLifeE_F  # Alive?
+      jnz 90  # No
+      call dbFetchEX  # Fetch it
+   end
+   ld X (Y CDR)  # Keep args in X
+   ld Y (L II)  # Get 'msg'
+   ld Z Nil  # No classes
+   call methodEY_FCYZ  # Found?
+   if eq  # Yes
+      ld A (L I)  # Get 'obj'
+      call evMethodACXYZ_E
+   else
+90    ld E Nil
+   end
+   drop
+   pop Z
+   pop Y
+   pop X
+   ret
+
+# (super ['any ..]) -> any
+(code 'doSuper 2)
+   push X
+   push Y
+   push Z
+   push E  # Save expression
+   ld A (EnvMeth)  # Method frame
+   ld Y (A I)  # 'key'
+   ld X (A II)  # 'cls'
+   cmp X Nil  # Any?
+   ldnz X (X)  # Yes: First class
+   ldz X (This)  # No: 'This'
+   ld X (X)  # Get class definition
+   do
+      atom (X)  # Method?
+   while z  # Yes
+      ld X (X CDR)  # Skip
+   loop
+   do
+      atom X  # Classes?
+   while z  # Yes
+      ld E (X)  # First class
+      ld Z X  # 'cls'
+      call methodEY_FCYZ  # Found?
+      if eq  # Yes
+         pop E  # Get expression
+         push Z  # 'cls'
+         push Y  # 'key'
+         push (EnvMeth)  # Build method frame
+         ld (EnvMeth) S
+         call evExprCE_E  # Evaluate expression
+         pop (EnvMeth)  # Restore method link
+         pop A  # Drop frame
+         pop A
+         pop Z
+         pop Y
+         pop X
+         ret
+      end
+      ld X (X CDR)
+   loop
+   ld E Y  # 'key'
+   pop X  # Expression
+   ld Y SuperErr
+   jmp errEXYZ
+: SuperErr asciz "Bad super"
+
+# (extra ['any ..]) -> any
+(code 'doExtra 2)
+   push X
+   push Y
+   push Z
+   push E  # Save expression
+   ld Y ((EnvMeth) I)  # Get 'key'
+   ld X (This)  # Current object
+   call extraXY_FCYZ  # Locate extra method
+   if eq
+      pop E  # Get expression
+      push Z  # 'cls'
+      push Y  # 'key'
+      push (EnvMeth)  # Build method frame
+      ld (EnvMeth) S
+      call evExprCE_E  # Evaluate expression
+      pop (EnvMeth)  # Restore method link
+      pop A  # Drop frame
+      pop A
+      pop Z
+      pop Y
+      pop X
+      ret
+   end
+   ld E Y  # 'key'
+   pop X  # Expression
+   ld Y ExtraErr
+   jmp errEXYZ
+: ExtraErr asciz "Bad extra"
+
+(code 'extraXY_FCYZ 0)
+   ld X (X)  # Get class definition
+   do
+      atom (X)  # Method?
+   while z  # Yes
+      ld X (X CDR)  # Skip
+   loop
+   do
+      atom X  # Classes?
+   while z  # Yes
+      cmp X ((EnvMeth) II)  # Hit current 'cls' list?
+      if eq  # Yes
+10       do
+            ld X (X CDR)  # Locate method in extra classes
+            atom X  # Any?
+         while z  # No: Return 'gt'
+            ld E (X)  # Superclass
+            ld Z X  # 'cls'
+            call methodEY_FCYZ  # Found?
+         until eq  # Return 'eq'
+         ret
+      end
+      push X
+      ld X (X)  # Recurse on superclass
+      call extraXY_FCYZ  # Found?
+      pop X
+      jeq ret  # Yes
+      jgt 10  # Else try extra classes
+      ld X (X CDR)  # Try next in 'cls' list
+   loop
+   setc  # Return 'lt'
+   ret
+
+# (with 'sym . prg) -> any
+(code 'doWith 2)
+   push X
+   ld X (E CDR)  # Args
+   ld E (X)  # Eval first
+   eval
+   cmp E Nil  # Non-NIL?
+   if ne  # Yes
+      num E  # Need symbol
+      jnz symErrEX
+      sym E
+      jz symErrEX
+      push (EnvBind)  # Build bind frame
+      link
+      push (This)  # Save old 'This'
+      push This  # and 'sym'
+      link
+      ld (EnvBind) L  # Close bind frame
+      push 0  # Init env swap
+      ld (This) E  # Set new
+      ld X (X CDR)  # Run 'prg'
+      prog X
+      pop A  # Drop 'eswp' + link + 'This'
+      pop A
+      pop A
+      pop (This)  # Restore value
+      pop L  # Restore link
+      pop (EnvBind)  # Restore bind link
+   end
+   pop X
+   ret
+
+# (bind 'sym|lst . prg) -> any
+(code 'doBind 2)
+   push X
+   ld X (E CDR)  # Args
+   ld E (X)  # Eval first
+   eval
+   num E  # Need sym|lst
+   jnz argErrEX
+   ld X (X CDR)  # X on 'prg'
+   cmp E Nil  # No bindings?
+   if eq  # Yes
+      prog X  # Run 'prg'
+      pop X
+      ret
+   end
+   push (EnvBind)  # Build bind frame
+   link
+   sym E  # Single symbol?
+   if nz  # Yes
+      push (E)  # Save value
+      push E  # and 'sym'
+      link
+      ld (EnvBind) L  # Close bind frame
+      push 0  # Init env swap
+      prog X  # Run 'prg'
+      pop A  # Drop env swap
+      pop L  # Get link
+      pop X  # Unbind symbol
+      pop (X)  # Restore value
+      pop L  # Restore link
+      pop (EnvBind)  # Restore bind link
+      pop X
+      ret
+   end
+   do
+      ld A (E)  # Next item
+      num A  # Need symbol or pair
+      jnz argErrAX
+      ld C (A)  # Get VAL or CAR
+      sym A  # Symbol?
+      if nz  # Yes
+         push C  # Save value
+         push A  # and 'sym'
+      else
+         push (C)  # Save value
+         push C  # and 'sym'
+         ld (C) (A CDR)  # Set new value
+      end
+      ld E (E CDR)  # More items?
+      atom E
+   until nz  # No
+   link
+   ld (EnvBind) L  # Close bind frame
+   push 0  # Init env swap
+   prog X  # Run 'prg'
+   pop A  # Drop env swap
+   pop L  # Get link
+   do  # Unbind symbols
+      pop X  # Next symbol
+      pop (X)  # Restore value
+      cmp S L  # More?
+   until eq  # No
+   pop L  # Restore link
+   pop (EnvBind)  # Restore bind link
+   pop X
+   ret
+
+# (job 'lst . prg) -> any
+(code 'doJob 2)
+   push X
+   ld X (E CDR)  # Args
+   ld E (X)  # Eval first
+   eval
+   cmp E Nil  # Empty env 'lst'?
+   if ne  # No
+      push (EnvBind)  # Build bind frame
+      link
+      ld A E  # Get 'lst'
+      do
+         ld C (A)  # Next cell
+         push ((C))  # Save value
+         push (C)  # and sym
+         ld ((C)) (C CDR)  # Set new value
+         ld A (A CDR)
+         atom A  # More cells?
+      until nz  # No
+      link
+      ld (EnvBind) L  # Close bind frame
+      push 0  # Init env swap
+   end
+   link
+   push E  # <L I> 'lst'
+   link
+   ld X (X CDR)  # X on 'prg'
+   prog X  # Run 'prg'
+   pop A  # Drop link
+   pop C  # Retrieve 'lst'
+   pop L  # Unlink
+   cmp C Nil  # Empty env 'lst'?
+   if ne  # No
+      pop A  # Drop env swap
+      lea X ((L) -II)  # X on bindings
+      do  # Unbind symbols
+         ld A (X)  # Next symbol
+         ld ((C) CDR) (A)  # Store value in env
+         ld (A) (X I)  # Restore value
+         ld C (C CDR)
+         sub X II  # Reverse stacked order
+         cmp X L  # More?
+      until lt  # No
+      drop  # Restore link
+      pop (EnvBind)  # Restore bind link
+   end
+   pop X
+   ret
+
+# (let sym 'any . prg) -> any
+# (let (sym 'any ..) . prg) -> any
+(code 'doLet 2)
+   push X
+   push Y
+   ld X (E CDR)  # Args
+   ld Y (X)  # First arg
+   ld X (X CDR)
+   push (EnvBind)  # Build bind frame
+   link
+   sym Y  # Single symbol?
+   if nz  # Yes
+      push (Y)  # Save old value
+      push Y  # and 'sym'
+      link
+      ld (EnvBind) L  # Close bind frame
+      push 0  # Init env swap
+      ld E (X)  # Eval 'any'
+      eval
+      ld (Y) E  # Set new value
+      ld X (X CDR)  # Run 'prg'
+      prog X
+      pop A  # Drop env swap
+      pop L  # Get link
+      pop X  # Unbind symbol
+      pop (X)  # Restore value
+      pop L  # Restore link
+      pop (EnvBind)  # Restore bind link
+      pop Y
+      pop X
+      ret
+   end
+   do
+      ld A (Y)  # Next sym
+      push (A)  # Save old value
+      push A  # and sym
+      link
+      ld (EnvBind) L  # Close bind frame
+      push 0  # Init env swap
+      ld E ((Y CDR))  # Eval 'any'
+      eval
+      ld ((Y)) E  # Set new value
+      ld Y ((Y CDR) CDR)  # More symbols?
+      atom Y
+   while z  # Yes
+      pop A  # Drop env swap
+      pop L  # and link
+   loop
+   prog X  # Run 'prg'
+   pop A  # Drop env swap
+   pop L  # Get link
+   do  # Unbind symbols
+      pop X  # Next symbol
+      pop (X)  # Restore value
+      cmp S L  # More?
+   until eq  # No
+   pop L  # Restore link
+   pop (EnvBind)  # Restore bind link
+   pop Y
+   pop X
+   ret
+
+# (let? sym 'any . prg) -> any
+(code 'doLetQ 2)
+   push X
+   push Y
+   ld X (E CDR)  # Args
+   ld Y (X)  # Get 'sym'
+   ld X (X CDR)
+   ld E (X)  # Eval 'any'
+   eval
+   cmp E Nil  # NIL?
+   if ne  # No
+      push (EnvBind)  # Build bind frame
+      link
+      push (Y)  # Save old value
+      push Y  # and 'sym'
+      link
+      ld (EnvBind) L  # Close bind frame
+      push 0  # Init env swap
+      ld (Y) E  # Set new value
+      ld X (X CDR)  # Run 'prg'
+      prog X
+      pop A  # Drop env swap
+      pop L  # Get link
+      pop X  # Unbind symbol
+      pop (X)  # Restore value
+      pop L  # Restore link
+      pop (EnvBind)  # Restore bind link
+   end
+   pop Y
+   pop X
+   ret
+
+# (use sym . prg) -> any
+# (use (sym ..) . prg) -> any
+(code 'doUse 2)
+   push X
+   push Y
+   ld X (E CDR)  # Args
+   ld Y (X)  # First arg
+   ld X (X CDR)
+   push (EnvBind)  # Build bind frame
+   link
+   sym Y  # Single symbol?
+   if nz  # Yes
+      push (Y)  # Save old value
+      push Y  # and 'sym'
+      link
+      ld (EnvBind) L  # Close bind frame
+      push 0  # Init env swap
+      prog X  # Run 'prg'
+      pop A  # Drop env swap
+      pop L  # Get link
+      pop X  # Unbind symbol
+      pop (X)  # Restore value
+      pop L  # Restore link
+      pop (EnvBind)  # Restore bind link
+      pop Y
+      pop X
+      ret
+   end
+   do
+      ld A (Y)  # Next sym
+      push (A)  # Save old value
+      push A  # and sym
+      ld Y (Y CDR)  # More symbols?
+      atom Y
+   until nz  # No
+   link
+   ld (EnvBind) L  # Close bind frame
+   push 0  # Init env swap
+   prog X  # Run 'prg'
+   pop A  # Drop env swap
+   pop L  # Get link
+   do  # Unbind symbols
+      pop X  # Next symbol
+      pop (X)  # Restore value
+      cmp S L  # More?
+   until eq  # No
+   pop L  # Restore link
+   pop (EnvBind)  # Restore bind link
+   pop Y
+   pop X
+   ret
+
+# (and 'any ..) -> any
+(code 'doAnd 2)
+   push X
+   ld X (E CDR)  # Args
+   do
+      ld E (X)  # Eval next
+      eval
+      cmp E Nil  # NIL?
+   while ne  # No
+      ld (At) E
+      ld X (X CDR)  # X on rest
+      atom X  # Done?
+   until nz  # Yes
+   pop X
+   ret
+
+# (or 'any ..) -> any
+(code 'doOr 2)
+   push X
+   ld X (E CDR)  # Args
+   do
+      ld E (X)  # Eval next
+      eval
+      cmp E Nil  # NIL?
+      if ne  # No
+         ld (At) E
+         pop X
+         ret
+      end
+      ld X (X CDR)  # X on rest
+      atom X  # Done?
+   until nz  # Yes
+   pop X
+   ret
+
+# (nand 'any ..) -> flg
+(code 'doNand 2)
+   push X
+   ld X (E CDR)  # Args
+   do
+      ld E (X)  # Eval next
+      eval
+      cmp E Nil  # NIL?
+      if eq  # Yes
+         ld E TSym  # Return T
+         pop X
+         ret
+      end
+      ld (At) E
+      ld X (X CDR)  # X on rest
+      atom X  # Done?
+   until nz  # Yes
+   ld E Nil  # Return NIL
+   pop X
+   ret
+
+# (nor 'any ..) -> flg
+(code 'doNor 2)
+   push X
+   ld X (E CDR)  # Args
+   do
+      ld E (X)  # Eval next
+      eval
+      cmp E Nil  # NIL?
+      if ne  # No
+         ld (At) E
+         ld E Nil  # Return NIL
+         pop X
+         ret
+      end
+      ld X (X CDR)  # X on rest
+      atom X  # Done?
+   until nz  # Yes
+   ld E TSym  # Return T
+   pop X
+   ret
+
+# (xor 'any 'any) -> flg
+(code 'doXor 2)
+   ld E (E CDR)
+   push (E CDR)  # Push rest
+   ld E (E)  # Eval first
+   eval
+   cmp E Nil  # NIL?
+   if eq  # Yes
+      pop E  # Get rest
+      ld E (E)  # Eval second
+      eval
+      cmp E Nil  # NIL again?
+      ldnz E TSym  # No
+      ret
+   end
+   pop E  # Get rest
+   ld E (E)  # Eval second
+   eval
+   cmp E Nil  # NIL?
+   ld E Nil
+   ldz E TSym  # Yes
+   ret
+
+# (bool 'any) -> flg
+(code 'doBool 2)
+   ld E ((E CDR))  # Get arg
+   eval  # Eval it
+   cmp E Nil  # NIL?
+   ldnz E TSym  # No
+   ret
+
+# (not 'any) -> flg
+(code 'doNot 2)
+   ld E ((E CDR))  # Get arg
+   eval  # Eval it
+   cmp E Nil  # NIL?
+   jeq retT  # Yes
+   ld (At) E
+   ld E Nil
+   ret
+
+# (nil . prg) -> NIL
+(code 'doNil 2)
+   push X
+   ld X (E CDR)  # Get 'prg'
+   exec X  # Execute it
+   ld E Nil  # Return NIL
+   pop X
+   ret
+
+# (t . prg) -> T
+(code 'doT 2)
+   push X
+   ld X (E CDR)  # Get 'prg'
+   exec X  # Execute it
+   ld E TSym  # Return T
+   pop X
+   ret
+
+# (prog . prg) -> any
+(code 'doProg 2)
+   push X
+   ld X (E CDR)  # Get 'prg'
+   prog X  # Run it
+   pop X
+   ret
+
+# (prog1 'any1 . prg) -> any1
+(code 'doProg1 2)
+   push X
+   ld X (E CDR)  # Args
+   ld E (X)  # Eval first
+   eval
+   ld (At) E
+   link
+   push E  # <L I> Result
+   link
+   ld X (X CDR)  # Get 'prg'
+   exec X  # Execute it
+   ld E (L I)  # Get result
+   drop
+   pop X
+   ret
+
+# (prog2 'any1 'any2 . prg) -> any2
+(code 'doProg2 2)
+   push X
+   ld X (E CDR)  # Args
+   ld E (X)  # Eval first
+   eval
+   ld X (X CDR)  # Eval second
+   ld E (X)
+   eval
+   ld (At) E
+   link
+   push E  # <L I> Result
+   link
+   ld X (X CDR)  # Get 'prg'
+   exec X  # Execute it
+   ld E (L I)  # Get result
+   drop
+   pop X
+   ret
+
+# (if 'any1 'any2 . prg) -> any
+(code 'doIf 2)
+   ld E (E CDR)
+   push (E CDR)  # Push rest
+   ld E (E)  # Eval condition
+   eval
+   cmp E Nil
+   if ne  # Non-NIL
+      ld (At) E
+      pop E  # Get rest
+      ld E (E)  # Consequent
+      eval/ret
+   end
+   xchg X (S)  # Get rest in X
+   ld X (X CDR)  # Else
+   prog X
+   pop X
+   ret
+
+# (if2 'any1 'any2 'any3 'any4 'any5 . prg) -> any
+(code 'doIf2 2)
+   ld E (E CDR)
+   push (E CDR)  # Push rest
+   ld E (E)  # Eval first condition 'any1'
+   eval
+   cmp E Nil
+   if eq  # NIL
+      xchg X (S)  # Get rest in X
+      ld E (X)  # Eval second condition 'any2'
+      eval
+      cmp E Nil
+      if eq  # Also NIL
+         ld X ((((X CDR) CDR) CDR) CDR)  # Run 'prg'
+         prog X
+         pop X
+         ret
+      end
+      ld (At) E
+      ld X (((X CDR) CDR) CDR)  # Eval 'any5'
+      ld E (X)
+      pop X
+      eval/ret
+   end
+   ld (At) E  # 'any1' is non-Nil
+   xchg X (S)  # Get rest in X
+   ld E (X)  # Eval second condition 'any2'
+   eval
+   cmp E Nil
+   if eq  # NIL
+      ld X ((X CDR) CDR)  # Eval 'any4'
+      ld E (X)
+      pop X
+      eval/ret
+   end
+   ld (At) E  # Both are non-Nil
+   ld X (X CDR)  # Eval 'any3'
+   ld E (X)
+   pop X
+   eval/ret
+
+# (ifn 'any1 'any2 . prg) -> any
+(code 'doIfn 2)
+   ld E (E CDR)
+   push (E CDR)  # Push body
+   ld E (E)  # Eval condition
+   eval
+   cmp E Nil
+   if eq  # NIL
+      pop E  # Get rest
+      ld E (E)  # Consequent
+      eval/ret
+   end
+   ld (At) E
+   xchg X (S)  # Get rest in X
+   ld X (X CDR)  # Else
+   prog X
+   pop X
+   ret
+
+# (when 'any . prg) -> any
+(code 'doWhen 2)
+   ld E (E CDR)
+   push (E CDR)  # Push body
+   ld E (E)  # Get condition
+   eval  # Eval condition
+   cmp E Nil
+   if eq  # NIL
+      pop A  # Drop rest
+      ret
+   end
+   ld (At) E
+   xchg X (S)  # Run body
+   prog X
+   pop X
+   ret
+
+# (unless 'any . prg) -> any
+(code 'doUnless 2)
+   ld E (E CDR)
+   push (E CDR)  # Push body
+   ld E (E)  # Get condition
+   eval  # Eval condition
+   cmp E Nil
+   if ne  # NIL
+      ld (At) E
+      pop A  # Drop rest
+      ld E Nil  # Return NIL
+      ret
+   end
+   xchg X (S)  # Run body
+   prog X
+   pop X
+   ret
+
+# (cond ('any1 . prg1) ('any2 . prg2) ..) -> any
+(code 'doCond 2)
+   push X
+   ld X E  # Clauses in X
+   do
+      ld X (X CDR)  # Next clause
+      atom X  # Any?
+   while z  # Yes
+      ld E ((X))  # Eval CAR
+      eval
+      cmp E Nil
+      if ne  # Non-NIL
+         ld (At) E
+         ld X ((X) CDR)  # Run body
+         prog X
+         pop X
+         ret
+      end
+   loop
+   ld E Nil  # Return NIL
+   pop X
+   ret
+
+# (nond ('any1 . prg1) ('any2 . prg2) ..) -> any
+(code 'doNond 2)
+   push X
+   ld X E  # Clauses in X
+   do
+      ld X (X CDR)  # Next clause
+      atom X  # Any?
+   while z  # Yes
+      ld E ((X))  # Eval CAR
+      eval
+      cmp E Nil
+      if eq  # NIL
+         ld X ((X) CDR)  # Run body
+         prog X
+         pop X
+         ret
+      end
+      ld (At) E
+   loop
+   ld E Nil  # Return NIL
+   pop X
+   ret
+
+# (case 'any (any1 . prg1) (any2 . prg2) ..) -> any
+(code 'doCase 2)
+   push X
+   ld X (E CDR)  # Arguments in X
+   ld E (X)  # Eval argument item
+   eval
+   ld (At) E
+   do
+      ld X (X CDR)  # Next clause
+      atom X  # Any?
+   while z  # Yes
+      ld C ((X))  # Item(s) in C
+      cmp C TSym  # Catch-all?
+      jz 10  # Yes
+      ld A (At)  # Equal to argument item?
+      ld E C
+      call equalAE_F
+      if eq  # Yes
+10       ld X ((X) CDR)  # Run body
+         prog X
+         pop X
+         ret
+      end
+      atom C  # List of items?
+      if z  # Yes
+         do
+            ld A (At)  # Argument item member?
+            ld E (C)
+            call equalAE_F
+            if eq  # Yes
+               ld X ((X) CDR)  # Run body
+               prog X
+               pop X
+               ret
+            end
+            ld C (C CDR)  # End of list?
+            atom C
+         until nz  # Yes
+      end
+   loop
+   ld E Nil  # Return NIL
+   pop X
+   ret
+
+# (state 'var (sym|lst exe [. prg]) ..) -> any
+(code 'doState 2)
+   push X
+   push Y
+   ld X E
+   ld Y (E CDR)  # Y on args
+   ld E (Y)  # Eval 'var'
+   eval
+   link
+   push E  # <L I> 'var'
+   link
+   call needVarEX  # Need variable
+   do
+      ld Y (Y CDR)  # Next clause
+      atom Y  # Any?
+   while z  # Yes
+      ld X (Y)  # Get clause in X
+      ld E (X)  # Get sym|lst in E
+      cmp E TSym  # T?
+      jz 10  # Yes
+      ld A ((L I))  # 'var's value
+      cmp A E  #  Same?
+      jz 10  # Yes
+      do  # 'memq'
+         atom E  # List?
+      while z  # Yes
+         cmp A (E)  # Member?
+      while ne  # No
+         ld E (E CDR)
+      loop
+      if eq  # Yes
+10       ld X (X CDR)  # Eval 'exe'
+         ld E (X)
+         eval
+         cmp E Nil
+         if ne  # Non-NIL
+            ld ((L I)) E  # Set target state
+            ld (At) E
+            drop
+            ld X (X CDR)  # Get body in X
+            pop Y
+            prog X  # Run body
+            pop X
+            ret
+         end
+      end
+   loop
+   drop
+   pop Y
+   pop X
+   ret
+
+# (while 'any . prg) -> any
+(code 'doWhile 2)
+   push X
+   push Y
+   ld X (E CDR)  # X arguments
+   link
+   push Nil  # <L I> Result
+   link
+   do
+      ld E (X)  # Eval condition
+      eval
+      cmp E Nil
+   while ne  # Non-NIL
+      ld (At) E
+      ld Y (X CDR)  # Run body
+      prog Y
+      ld (L I) E  # Save result
+   loop
+   ld E (L I)  # Get result
+   drop
+   pop Y
+   pop X
+   ret
+
+# (until 'any . prg) -> any
+(code 'doUntil 2)
+   push X
+   push Y
+   ld X (E CDR)  # X arguments
+   link
+   push Nil  # <L I> Result
+   link
+   do
+      ld E (X)  # Eval condition
+      eval
+      cmp E Nil
+   while eq  # NIL
+      ld Y (X CDR)  # Run body
+      prog Y
+      ld (L I) E  # Save result
+   loop
+   ld (At) E
+   ld E (L I)  # Get result
+   drop
+   pop Y
+   pop X
+   ret
+
+# (at '(cnt1 . cnt2) . prg) -> any
+(code 'doAt 2)
+   push X
+   push Y
+   ld X E
+   ld Y (E CDR)  # Y on args
+   ld E (Y)  # Eval first
+   eval
+   atom E  # Need cell
+   jnz cellErrEX
+   ld A (E)  # Get 'cnt1'
+   cnt A  # Need short
+   jz cntErrAX
+   ld C (E CDR)  # Get 'cnt2'
+   cnt C  # Need short
+   jz cntErrCX
+   add A (hex "10")  # Increment
+   cmp A C  # Reached count?
+   if lt  # No
+      ld (E) A
+      ld E Nil
+   else
+      ld (E) ZERO
+      ld Y (Y CDR)  # Run body
+      prog Y
+   end
+   pop Y
+   pop X
+   ret
+
+# (do 'flg|cnt ['any | (NIL 'any . prg) | (T 'any . prg) ..]) -> any
+(code 'doDo 2)
+   push X
+   push Y
+   push Z
+   ld X (E CDR)  # Args
+   ld E (X)  # Eval 'flg|cnt'
+   ld X (X CDR)  # Body
+   eval
+   cmp E Nil  # Ever?
+   if ne  # Yes
+      cnt E  # Short number?
+      jz loopX  # No: Non-NIL 'flg'
+      shr E 4  # Normalize
+      if gt  # Greater zero
+         push E  # <S> Count
+         do
+            ld Y X  # Loop body
+            call loopY_FE
+         while nz
+            sub (S) 1  # Decrement count
+         until z
+         pop A  # Drop count
+      else
+         ld E Nil  # Return NIL if zero
+      end
+   end
+   pop Z
+   pop Y
+   pop X
+   ret
+
+# (loop ['any | (NIL 'any . prg) | (T 'any . prg) ..]) -> any
+(code 'doLoop 2)
+   push X
+   push Y
+   push Z
+   ld X (E CDR)  # Body
+: loopX
+   do
+      ld Y X  # Body in Y
+      do
+         ld E (Y)  # Next expression
+         atom E  # Cell?
+         if z  # Yes
+            ld A (E)  # Get CAR
+            cmp A Nil  # NIL?
+            if eq  # Yes
+               ld Z (E CDR)  # Sub-body in Z
+               ld E (Z)
+               eval  # Evaluate condition
+               cmp E Nil  # NIL?
+               if eq  # Yes
+                  ld Y (Z CDR)  # Run sub-body
+                  prog Y
+                  pop Z
+                  pop Y
+                  pop X
+                  ret
+               end
+               ld (At) E
+            else
+               cmp A TSym  # T?
+               if eq  # Yes
+                  ld Z (E CDR)  # Sub-body in Z
+                  ld E (Z)
+                  eval  # Evaluate condition
+                  cmp E Nil  # NIL?
+                  if ne  # No
+                     ld (At) E
+                     ld Y (Z CDR)  # Run sub-body
+                     prog Y
+                     pop Z
+                     pop Y
+                     pop X
+                     ret
+                  end
+               else
+                  call evListE_E  # Else evaluate expression
+               end
+            end
+         end
+         ld Y (Y CDR)
+         atom Y  # Finished one pass?
+      until nz  # Yes
+   loop
+
+# (for sym 'cnt ['any | (NIL 'any . prg) | (T 'any . prg) ..]) -> any
+# (for sym|(sym2 . sym) 'lst ['any | (NIL 'any . prg) | (T 'any . prg) ..]) -> any
+# (for (sym|(sym2 . sym) 'any1 'any2 [. prg]) ['any | (NIL 'any . prg) | (T 'any . prg) ..]) -> any
+(code 'doFor 2)
+   push X
+   push Y
+   push Z
+   ld X (E CDR)  # X on args
+   ld Y (X)  # Y on first arg
+   ld X (X CDR)
+   push (EnvBind)  # Build bind frame
+   link
+   atom Y  # 'sym'?
+   if nz  # Yes
+      # (for sym 'cnt|lst ..)
+      push (Y)  # Save old value
+      push Y  # <L V> and 'sym'
+      link
+      ld (EnvBind) L  # Close bind frame
+      push 0  # Init env swap
+      ld E (X)  # Eval 'cnt|lst'
+      eval
+      link
+      push E  # <L I> 'cnt|lst'
+      link
+      ld X (X CDR)  # X on body
+      ld A E
+      ld E Nil  # Preload NIL
+      num A  # Number?
+      if nz  # Yes
+         test A SIGN  # Negative?
+         if z  # No
+            ld (Y) ZERO  # Init 'sym' to zero
+            do
+               ld A ((L V))  # Get value of 'sym'
+               add A (hex "10")  # Increment
+               cmp A (L I)  # Greater than 'num'?
+            while le  # No
+               ld ((L V)) A  # Set incremented value of 'sym'
+               ld Y X  # Loop body
+               call loopY_FE
+            until z
+         end
+      else
+         do
+            ld A (L I)  # Get 'lst'
+            atom A  # Any?
+         while z  # Yes
+            ld (L I) (A CDR)
+            ld ((L V)) (A)  # Set value
+            ld Y X  # Loop body
+            call loopY_FE
+         until z
+      end
+      drop
+      pop A  # Drop env swap
+      pop L  # Get link
+   else
+      ld Z (Y CDR)  # CDR of first arg
+      atom Z  # 'sym'?
+      if nz  # Yes
+         # (for (sym2 . sym) 'lst ..)
+         push (Z)  # Value of 'sym'
+         push Z  # <L VII> 'sym'
+         ld Z (Y)
+         push (Z)  # Value of 'sym2'
+         push Z  # <L V> 'sym2'
+         link
+         ld (EnvBind) L  # Close bind frame
+         push 0  # Init env swap
+         ld E (X)  # Eval 'lst'
+         eval
+         link
+         push E  # <L I> 'lst'
+         link
+         ld (Z) ZERO  # Init 'sym2' to zero
+         ld X (X CDR)  # X on body
+         do
+            ld A (L I)  # Get 'lst'
+            atom A  # Any?
+         while z  # Yes
+            ld (L I) (A CDR)
+            ld ((L VII)) (A)  # Set value of 'sym'
+            add ((L V)) (hex "10")  # Increment 'sym2'
+            ld Y X  # Loop body
+            call loopY_FE
+         until z
+         drop
+         pop A  # Drop env swap
+         pop L  # Get link
+         pop X  # Unbind 'sym2'
+         pop (X)  # Restore value
+      else
+         ld Z (Y)  # CAR of first arg
+         ld Y (Y CDR)
+         atom Z  # 'sym'?
+         if nz  # Yes
+            # (for (sym ..) ..)
+            push (Z)  # Save old value
+            push Z  # <L V> and 'sym'
+            link
+            ld (EnvBind) L  # Close bind frame
+            push 0  # Init env swap
+            ld E (Y)  # Eval 'any1' init-expression
+            eval
+            ld (Z) E  # Set new value
+            link
+            push Nil  # <L I> Result
+            link
+            push (Y CDR)  # <S> (any2 . prg)
+            do
+               ld E ((S))  # Evaluate condition
+               eval
+               cmp E Nil  # NIL?
+               if eq  # Yes
+                  ld E (L I)  # Get result
+                  break T
+               end
+               ld (At) E
+               ld Y X  # Loop body
+               call loopY_FE
+            while nz
+               ld (L I) E  # Keep result
+               ld Y ((S) CDR)  # 'prg' re-init?
+               atom Y
+               if z  # Yes
+                  prog Y
+                  ld ((L V)) E  # Set new value
+               end
+            loop
+            drop
+            pop A  # Drop env swap
+            pop L  # Get link
+         else
+            # (for ((sym2 . sym) ..) ..)
+            ld C (Z CDR)  # 'sym'
+            push (C)  # Save old value
+            push C  # <L VII> and 'sym'
+            ld C (Z)  # 'sym2'
+            push (C)  # Value of 'sym2'
+            push C  # <L V> and 'sym2'
+            link
+            ld (EnvBind) L  # Close bind frame
+            push 0  # Init env swap
+            ld E (Y)  # Eval 'any1' init-expression
+            eval
+            ld ((Z CDR)) E  # Set new value of 'sym'
+            ld ((Z)) ZERO  # Init 'sym2' to zero
+            link
+            push Nil  # <L I> Result
+            link
+            push (Y CDR)  # <S> (any2 . prg)
+            do
+               ld E ((S))  # Evaluate condition
+               eval
+               cmp E Nil  # NIL?
+               if eq  # Yes
+                  ld E (L I)  # Get result
+                  break T
+               end
+               ld (At) E
+               add ((L V)) (hex "10")  # Increment 'sym2'
+               ld Y X  # Loop body
+               call loopY_FE
+            while nz
+               ld (L I) E  # Keep result
+               ld Y ((S) CDR)  # 'prg' re-init?
+               atom Y
+               if z  # Yes
+                  prog Y
+                  ld ((L VII)) E  # Set new value
+               end
+            loop
+            drop
+            pop A  # Drop env swap
+            pop L  # Get link
+            pop X  # Unbind 'sym2'
+            pop (X)  # Restore value
+         end
+      end
+   end
+   pop X  # Unbind 'sym'
+   pop (X)  # Restore value
+   pop L  # Restore link
+   pop (EnvBind)  # Restore bind link
+   pop Z
+   pop Y
+   pop X
+   ret
+
+(code 'loopY_FE 0)  # Z
+   do
+      ld E (Y)  # Next expression
+      num E  # Number?
+      if z  # No
+         sym E  # Symbol?
+         if nz  # Yes
+            ld E (E)  # Get value
+         else
+            ld A (E)  # Else get CAR
+            cmp A Nil  # NIL?
+            if eq  # Yes
+               ld Z (E CDR)  # Sub-body in Z
+               ld E (Z)
+               eval  # Evaluate condition
+               cmp E Nil  # NIL?
+               if eq  # Yes
+                  ld Y (Z CDR)  # Run sub-body
+                  prog Y
+                  setz  # Return 'z'
+                  ret
+               end
+               ld (At) E
+               ld E Nil
+            else
+               cmp A TSym  # T?
+               if eq  # Yes
+                  ld Z (E CDR)  # Sub-body in Z
+                  ld E (Z)
+                  eval  # Evaluate condition
+                  cmp E Nil  # NIL?
+                  if ne  # No
+                     ld (At) E
+                     ld Y (Z CDR)  # Run sub-body
+                     prog Y
+                     setz  # Return 'z'
+                     ret
+                  end
+               else
+                  call evListE_E  # Else evaluate expression
+               end
+            end
+         end
+      end
+      ld Y (Y CDR)
+      atom Y  # Done?
+   until nz  #  Yes
+   ret  # Return 'nz'
+
+# (catch 'any . prg) -> any
+(code 'doCatch 2)
+   push X
+   push Y
+   push Z
+   push L
+   ld X (E CDR)
+   ld E (X)  # Get tag
+   ld X (X CDR)  # X on body
+   eval  # Evaluate tag
+   sub S "(EnvEnd-Env)"  # Build catch frame
+   movn (S) (Env) "(EnvEnd-Env)"  # Save environment
+   push ZERO  # 'fin'
+   push E  # 'tag'
+   push (Catch)  # Link
+   ld (Catch) S  # Close catch frame
+   prog X  # Run body
+: caught
+   pop (Catch)  # Restore catch link
+   add S "(EnvEnd-Env)+8+8"  # Clean up
+   pop L
+   pop Z
+   pop Y
+   pop X
+   ret
+
+# (throw 'sym 'any)
+(code 'doThrow 2)
+   ld X E
+   ld Y (X CDR)
+   ld E (Y)  # Get sym
+   ld Y (Y CDR)
+   eval  # Evaluate tag
+   ld Z E  # into Z
+   ld E (Y)  # Get value
+   eval  # Keep thrown value in E
+   ld C (Catch)  # Search catch frames
+   do
+      null C  # Any?
+      jz throwErrZX  # No
+      cmp (C I) TSym  # Catch-all?
+   while nz  # No
+      cmp Z (C I)  # Found tag?
+   while nz  # No
+      ld C (C)  # Next frame
+   loop
+   push E  # Save thrown value
+   call unwindC_Z  # Unwind environments
+   pop E
+   ld S Z  # Restore stack
+   jmp caught  # Return E
+
+(code 'throwErrZX)
+   ld E Z
+   ld Y ThrowErr
+   jmp errEXYZ
+: ThrowErr asciz "Tag not found"
+
+# (finally exe . prg) -> any
+(code 'doFinally 2)
+   push X
+   sub S "(EnvEnd-Env)"  # Build catch frame
+   movn (S) (Env) "(EnvEnd-Env)"  # Save environment
+   ld X (E CDR)
+   push (X)  # 'exe' -> 'fin'
+   ld X (X CDR)
+   push 0  # 'tag'
+   push (Catch)  # Link
+   ld (Catch) S  # Close catch frame
+   prog X  # Run body
+   link
+   push E  # <L I> Result
+   link
+   ld E (S V)  # Get 'fin'
+   eval  # Evaluate it
+   ld E (L I)  # Get result
+   drop
+   pop (Catch)  # Restore catch link
+   add S "(EnvEnd-Env)+8+8"  # Clean up
+   pop X
+   ret
+
+# (! . exe) -> any
+(code 'doBreak 2)
+   ld E (E CDR)  # exe
+   cmp (Dbg) Nil  # Debug?
+   if ne  # Yes
+      call brkLoadE_E  # Enter debug breakpoint
+   end
+   eval/ret
+
+(code 'brkLoadE_E)
+   null (EnvBrk)  # Already in breakpoint?
+   if z  # No
+      cc isatty(0)  # STDIN
+      nul4  # on a tty?
+      if nz  # Yes
+         cc isatty(1)  # STDOUT
+         nul4  # on a tty?
+         if nz  # Yes
+            push X
+            push Y
+            push (EnvBind)  # Build bind frame
+            link
+            push (Up)  # <L VI> Bind '^'
+            push Up
+            ld (Up) E  # to expression
+            push (Run)  # <L IV> Bind '*Run' to NIL
+            push Run
+            ld (Run) Nil
+            push (At)  # <L II> Save '@'
+            push At
+            link
+            ld (EnvBind) L  # Close bind frame
+            ld (EnvBrk) L  # Set break env
+            push 0  # Init env swap
+            sub S IV  # <L -V> OutFrame
+            ld Y S
+            ld (Y I) 1  # fd = stdout
+            ld (Y II) 0  # pid = 0
+            call pushOutFilesY
+            call printE  # Print expression
+            call newline
+            ld B (char "!")  # Prompt
+            ld E Nil  # REPL
+            ld X 0  # Runtime expression
+            call loadBEX_E
+            call popOutFiles
+            add S (+ IV III)  # Drop outFrame, env swap, bind link and '@'
+            pop (At)  # Restore '@'
+            pop A
+            pop (Run)  # '*Run'
+            pop A
+            ld E (Up)  # runtime expression
+            pop (Up)  # and '^'
+            pop L  # Restore link
+            pop (EnvBind)  # Restore bind link
+            ld (EnvBrk) 0  # Leave breakpoint
+            pop Y
+            pop X
+         end
+      end
+   end
+   ret
+
+# (e . prg) -> any
+(code 'doE 2)
+   push X
+   push Y
+   ld X E
+   null (EnvBrk)  # Breakpoint?
+   jz brkErrX  # No
+   link
+   push (Dbg)  # Save '*Dbg'
+   push (At)  # '@'
+   push (Run)  # and '*Run'
+   link
+   ld (Dbg) Nil  # Switch off debug mode
+   ld C (EnvBrk)  # Get break env
+   ld (At) (C II)  # Set '@'
+   ld (Run) (C IV)  # and '*Run'
+   call popOutFiles  # Leave debug I/O env
+   ld Y (EnvInFrames)  # Keep InFrames
+   call popInFiles
+   ld X (X CDR)  # 'prg'?
+   atom X
+   if z  # Yes
+      prog X
+   else
+      ld E (Up)  # Get '^'
+      eval
+   end
+   call pushInFilesY  # Restore debug I/O env
+   lea Y ((EnvBrk) -V)
+   call pushOutFilesY
+   pop L  # Restore debug env
+   pop (Run)
+   pop (At)
+   pop (Dbg)
+   pop L
+   pop Y
+   pop X
+   ret
+
+# ($ sym|lst lst . prg) -> any
+(code 'doTrace 2)
+   push X
+   ld X (E CDR)  # Get args
+   cmp (Dbg) Nil  # Debug?
+   if eq  # No
+      ld X ((X CDR) CDR)  # Get 'prg'
+      prog X  # Run it
+   else
+      push Y
+      push Z
+      push (OutFile)  # Save output channel
+      ld (OutFile) ((OutFiles) II)  # Set to OutFiles[2] (stderr)
+      push (EnvPutB)  # Save 'put'
+      ld (EnvPutB) putStdoutB  # Set new
+      ld Y (X)  # Get 'sym|lst'
+      ld X (X CDR)
+      ld Z (X CDR)  # Get 'prg'
+      add (EnvTrace) 1  # Increment trace level
+      ld C (EnvTrace)  # Get it
+      call traceCY  # Print trace information
+      ld C trc1  # Print " :"
+      call outStringC
+      ld X (X)  # Get 'lst'
+      do
+         atom X  # List?
+      while z  # Yes
+         call space
+         ld E (X)  # Print value of CAR
+         ld E (E)
+         call printE
+         ld X (X CDR)
+      loop
+      cmp X Nil  # Last CDR is NIL?
+      if ne  # No
+         cmp X At  # Variable arguments?
+         if ne  # No
+            call space
+            ld E (X)  # Print value
+            call printE
+         else
+            ld X (EnvNext)  # VarArgs
+            do
+               cmp X (EnvArgs)  # Any?
+            while ne  # Yes
+               call space
+               sub X I  # Next
+               ld E (X)  # Next arg
+               call printE
+            loop
+         end
+      end
+      call newline
+      ld (EnvPutB) (S)  # Restore 'put'
+      ld (OutFile) (S I)  # and output channel
+      prog Z  # Run 'prg'
+      ld (OutFile) ((OutFiles) II)  # Set output channel again
+      ld (EnvPutB) putStdoutB
+      ld C (EnvTrace)  # Get trace level
+      sub (EnvTrace) 1  # Decrement it
+      call traceCY  # Print trace information
+      ld C trc2  # Print " = "
+      call outStringC
+      call printE_E  # Print result
+      call newline
+      pop (EnvPutB)  # Restore 'put'
+      pop (OutFile)  # and output channel
+      pop Z
+      pop Y
+   end
+   pop X
+   ret
+: trc1 asciz " :"
+: trc2 asciz " = "
+
+(code 'traceCY)
+   cmp C 64  # Limit to 64
+   if gt
+      ld C 64
+   end
+   do
+      call space  # Output spaces
+      sub C 1  # 'cnt' times
+   until sz
+   push E
+   atom Y  # 'sym'?
+   if nz  # Yes
+      ld E Y  # Print symbol
+      call printE
+   else
+      ld E (Y)  # Print method
+      call printE
+      call space
+      ld E (Y CDR)  # Print class
+      call printE
+      call space
+      ld E (This)  # Print 'This'
+      call printE
+   end
+   pop E
+   ret
+
+# (sys 'any ['any]) -> sym
+(code 'doSys 2)
+   push X
+   push Z
+   ld X (E CDR)  # X on args
+   call evSymX_E  # Evaluate first symbol
+   call bufStringE_SZ  # Write to stack buffer
+   ld X (X CDR)  # Next arg?
+   atom X
+   if nz  # No
+      cc getenv(S)  # Get value from system
+      ld E A
+      call mkStrE_E  # Make transient symbol
+   else
+      push Z
+      call evSymX_E  # Evaluate second symbol
+      lea X (S I)  # Keep pointer to first buffer
+      call bufStringE_SZ  # Write to stack buffer
+      cc setenv(X S 1)  # Set system value
+      nul4  # OK?
+      ldnz E Nil  # No
+      ld S Z  # Drop buffer
+      pop Z
+   end
+   ld S Z  # Drop buffer
+   pop Z
+   pop X
+   ret
+
+# (call 'any ..) -> flg
+(code 'doCall 2)
+   push X
+   push Z
+   ld X (E CDR)  # X on args
+   push E  # Save expression
+   push 0  # End-of-buffers marker
+   call evSymX_E  # Pathname
+   call pathStringE_SZ  # Write to stack buffer
+   do
+      ld X (X CDR)  # Arguments?
+      atom X
+   while z  # Yes
+      push Z  # Buffer chain
+      call evSymX_E  # Next argument
+      call bufStringE_SZ  # Write to stack buffer
+   loop
+   push Z
+   ld Z S  # Point to chain
+   ld X Z
+   push 0  # NULL terminator
+   do
+      lea A (X I)  # Buffer pointer
+      push A  # Push to vector
+      ld X (X)  # Follow chain
+      null (X)  # Done?
+   until z  # Yes
+   ld X (X I)  # Retrieve expression
+   call flushAll  # Flush all output channels
+   cc fork()  # Fork child process
+   nul4  # In child?
+   if z  # Yes
+      cc setpgid(0 0)  # Set process group
+      cc getpgrp()  # Set terminal process group
+      cc tcsetpgrp(0 A)
+      cc execvp((S) S)  # Execute program
+      jmp execErrS  # Error if failed
+   end
+   js forkErrX
+   do
+      ld S Z  # Clean up buffers
+      pop Z  # Chain
+      null Z  # End?
+   until z  # Yes
+   ld Z A  # Keep pid in Z
+   cc setpgid(Z 0)  # Set process group
+   cc tcsetpgrp(0 Z)  # Set terminal process group
+   do  # Re-use expression stack entry
+      do
+         cc waitpid(Z S WUNTRACED)  # Wait for child
+         nul4  # OK?
+      while s  # No
+         call errno_A
+         cmp A EINTR  # Interrupted?
+         jne waitPidErrX  # No
+         nul (Signal)  # Signal?
+         if nz  # Yes
+            call sighandlerX
+         end
+      loop
+      cc getpgrp()  # Set terminal process group
+      cc tcsetpgrp(0 A)
+      call wifstoppedS_F  # WIFSTOPPED(S)?
+      if ne  # No
+         ld4 (S)  # Result?
+         or A A
+         ld E TSym  # Return 'flg'
+         ldnz E Nil
+         pop X  # Drop expression
+         pop Z
+         pop X
+         ret
+      end
+      ld B (char "+")  # Prompt
+      ld E Nil  # REPL
+      call loadBEX_E
+      cc tcsetpgrp(0 Z)  # Set terminal process group
+      cc kill(Z SIGCONT)
+   loop
+
+# (tick (cnt1 . cnt2) . prg) -> any
+(code 'doTick 2)
+   push X
+   push (TickU)  # <S III> User ticks
+   push (TickS)  # <S II> System ticks
+   cc times(Tms)  # Get ticks
+   push (Tms TMS_UTIME)  # <S I> User time
+   push (Tms TMS_STIME)  # <S> User time
+   ld E (E CDR)
+   push (E)  # Save pointer to count pair
+   ld X (E CDR)
+   prog X  # Run 'prg'
+   pop X  # Get count pair
+   cc times(Tms)  # Get ticks again
+   ld A (Tms TMS_UTIME)  # User time
+   sub A (S I)  # Subtract previous user time
+   sub A (TickU)  # Subtract user ticks
+   add A (S III)  # Adjust by saved ticks
+   add (TickU) A  # Save new user ticks
+   shl A 4  # Adjust to short number
+   add (X) A  # Add to 'cnt1'
+   ld A (Tms TMS_STIME)  # System time
+   sub A (S)  # Subtract previous system time
+   sub A (TickS)  # Subtract system ticks
+   add A (S II)  # Adjust by saved ticks
+   add (TickS) A  # Save new system ticks
+   shl A 4  # Adjust to short number
+   add (X CDR) A  # Add to 'cnt2'
+   add S IV  # Drop locals
+   pop X
+   ret
+
+# (ipid) -> pid | NIL
+(code 'doIpid 2)
+   ld C (EnvInFrames)  # OutFrames?
+   null C
+   if nz
+      ld E (C II)  # 'pid'
+      cmp E 1  # 'pid' > 1?
+      if gt  # Yes
+         shl E 4  # Make short number
+         or E CNT
+         ret
+      end
+   end
+   ld E Nil  # Return NIL
+   ret
+
+# (opid) -> pid | NIL
+(code 'doOpid 2)
+   ld C (EnvOutFrames)  # OutFrames?
+   null C
+   if nz
+      ld E (C II)  # 'pid'
+      cmp E 1  # 'pid' > 1?
+      if gt  # Yes
+         shl E 4  # Make short number
+         or E CNT
+         ret
+      end
+   end
+   ld E Nil  # Return NIL
+   ret
+
+# (kill 'pid ['cnt]) -> flg
+(code 'doKill 2)
+   push X
+   push Y
+   ld X E
+   ld Y (E CDR)  # Y on args
+   call evCntXY_FE  # Eval 'pid'
+   ld Y (Y CDR)  # Second arg?
+   atom Y
+   if nz  # No
+      cc kill(E SIGTERM)  # Send TERM signal
+   else
+      push E  # Save signal number
+      call evCntXY_FE  # Eval 'cnt'
+      cc kill(pop E)  # Send signal
+   end
+   nul4  # OK?
+   ld E TSym  # Yes
+   ldnz E Nil  # No
+   pop Y
+   pop X
+   ret
+
+# (fork) -> pid | NIL
+(code 'doFork 2)
+   push X
+   ld X E  # Get expression
+   call forkLispX_FE  # Fork child process
+   if c
+      ld E Nil  # In child
+   else
+      shl E 4  # In parent
+      or E CNT  # Return PID
+   end
+   pop X
+   ret
+
+(code 'forkLispX_FE 0)
+   call flushAll  # Flush all output channels
+   null (Spkr)  # Not listening for children yet?
+   if z  # Yes
+      cc pipe(SpMiPipe)  # Open speaker/microphone pipe
+      nul4  # OK?
+      jnz pipeErrX
+      ld4 (SpMiPipe)  # Read end
+      ld (Spkr) A  # into the speaker
+      call closeOnExecAX
+      ld4 (SpMiPipe 4)  # Write end
+      call closeOnExecAX
+   end
+   push A  # Create 'hear' and 'tell' pipes
+   push A
+   cc pipe(S)  # Open 'hear' pipe
+   nul4  # OK?
+   jnz pipeErrX
+   cc pipe(&(S 8))  # Open 'tell' pipe
+   nul4  # OK?
+   jnz pipeErrX
+   ld4 (S)  # Read end of 'hear'
+   call closeOnExecAX
+   ld4 (S 4)  # Write end
+   call closeOnExecAX
+   ld4 (S 8)  # Read end of 'tell'
+   call closeOnExecAX
+   ld4 (S 12)  # Write end
+   call closeOnExecAX
+   ld C 0  # Index
+   ld A (Child)  # Find a free child slot
+   do
+      cmp C (Children)  # Tried all children?
+   while ne  # No
+      null (A)  # Found empty 'pid'?
+   while nz  # No
+      add A VI  # Increment by sizeof(child)
+      add C VI
+   loop
+   cc fork()  # Fork child process
+   nul4  # In child?
+   js forkErrX
+   if z  # Yes
+      ld (Slot) C  # Set child index
+      ld (Spkr) 0  # No children yet
+      ld4 (SpMiPipe 4)  # Set microphone to write end
+      ld (Mic) A
+      ld4 (S 4)  # Close write end of 'hear'
+      call closeAX
+      ld4 (S 8)  # Close read end of 'tell'
+      call closeAX
+      ld4 (SpMiPipe)  # Close read end
+      call closeAX
+      ld A (Hear)  # Already hearing?
+      null A
+      if nz  # Yes
+         call closeAX  # Close it
+         ld A (Hear)
+         call closeInFileA
+         ld A (Hear)
+         call closeOutFileA
+      end
+      ld4 (S)  # Read end of 'hear'
+      ld (Hear) A
+      call initInFileA_A  # Create input file
+      ld A (Tell)  # Telling?
+      null A
+      if nz  # Yes
+         call closeAX
+      end
+      ld4 (S 12)  # Write end of 'tell'
+      ld (Tell) A
+      ld E (Child)  # Iterate children
+      ld C (Children)  # Count
+      do
+         sub C VI  # More?
+      while ge  # Yes
+         null (E)  # 'pid'?
+         if nz  # Yes
+            cc close((E I))  # Close 'hear'
+            cc close((E II))  # Close 'tell'
+            cc free((E V))  # Free buffer
+         end
+         add E VI  # Increment by sizeof(child)
+      loop
+      ld (Children) 0  # No children
+      cc free((Child))
+      ld (Child) 0
+      ld A (EnvInFrames)  # Clear pids in InFrames
+      do
+         null A  # More frames?
+      while nz  # Yes
+         ld (A II) 0  # Clear 'pid'
+         ld A (A)  # Follow link
+      loop
+      ld A (EnvOutFrames)  # Clear pids in OutFrames
+      do
+         null A  # More frames?
+      while nz  # Yes
+         ld (A II) 0  # Clear 'pid'
+         ld A (A)  # Follow link
+      loop
+      ld A (Catch)  # Clear 'finally' expressions in Catch frames
+      do
+         null A  # More frames?
+      while nz  # Yes
+         ld (A II) ZERO  # Clear 'fin'
+         ld A (A)  # Follow link
+      loop
+      cc free((Termio))  # Give up terminal control
+      ld (Termio) 0
+      set (PRepl) (Repl)  # Set parent REPL flag
+      ld (PPid) (Pid)  # Set parent process ID
+      cc getpid()  # Get new process ID
+      shl A 4  # Make short number
+      or A CNT
+      ld (Pid) A  # Set new process ID
+      ld E (Fork)  # Run '*Fork'
+      call execE
+      ld (Fork) Nil  # Clear '*Fork'
+      pop A  # Drop 'hear' and 'tell' pipes
+      pop A
+      setc  # Return "in child"
+      ret
+   end
+   cmp C (Children)  # Children table full?
+   ldnz E A  # No: Get 'pid' into E
+   if eq  # Yes
+      push A  # Save child's 'pid'
+      ld A (Child)  # Get vector
+      ld E C  # Children
+      add E (* 8 VI)  # Eight more slots
+      ld (Children) E
+      call allocAE_A  # Extend vector
+      ld (Child) A
+      add A E  # Point A to the end
+      ld E 8  # Init eight new slots
+      do
+         sub A VI  # Decrement pointer
+         ld (A) 0  # Clear 'pid'
+         sub E 1  # Done?
+      until z  # Yes
+      pop E  # Get 'pid'
+   end
+   add C (Child)  # Point C to free 'child' entry
+   ld (C) E  # Set 'pid'
+   ld4 (S)  # Close read end of 'hear'
+   call closeAX
+   ld4 (S 4)  # Write end of 'hear'
+   ld (C II) A  # Into 'tell'
+   call nonblockingA_A  # Set to non-blocking
+   ld4 (S 8)  # Read end of 'tell'
+   ld (C I) A  # Into 'hear'
+   ld4 (S 12)  # Close write end of 'tell'
+   call closeAX
+   ld (C III) 0  # Init buffer offset
+   ld (C IV) 0  # buffer count
+   ld (C V) 0  # No buffer yet
+   pop A  # Drop 'hear' and 'tell' pipes
+   pop A
+   clrc  # Return "in parent"
+   ret
+
+# (bye 'cnt|NIL)
+(code 'doBye 2)
+   ld X E
+   ld E (E CDR)
+   ld E (E)
+   eval  # Get exit code
+   cmp E Nil
+   if eq
+      ld E 0  # Zero if NIL
+   else
+      call xCntEX_FE
+   end
+   jmp byeE
+
+# vi:et:ts=3:sw=3
diff --git a/src64/gc.l b/src64/gc.l
@@ -0,0 +1,1002 @@
+# 13oct09abu
+# (c) Software Lab. Alexander Burger
+
+# Mark data
+(code 'markE 0)
+   ld X 0  # Clear TOS
+   do
+      do
+         cnt E  # Short number?
+      while z  # No
+         ld A E  # Get cell pointer in A
+         off A 15
+         test (A CDR) 1  # Already marked?
+      while nz  # No
+         off (A CDR) 1  # Mark cell
+         big E  # Bigum?
+         if nz  # Yes
+            ld C (A CDR)  # Second digit
+            do
+               cnt C  # Any?
+            while z  # Yes
+               test (C BIG) 1  # Marked?
+            while nz  # Yes
+               off (C BIG) 1  # Else mark it
+               ld C (C BIG)  # Next digit
+            loop
+            break T
+         end
+         ld C E  # Previous item
+         ld E (A)  # Get CAR
+         or X 1  # First visit
+         ld (A) X  # Keep TOS
+         ld X C  # TOS on previous
+      loop
+      do
+         ld A X  # TOS cell pointer in A
+         and A -16  # Empty?
+         jz ret  # Yes
+         test (A) 1  # Second visit?
+      while z  # Yes
+         ld C X  # TMP
+         ld X (A CDR)  # TOS up
+         ld (A CDR) E  # Restore CDR
+         ld E C  # E up
+      loop
+      ld C (A)  # Up pointer
+      ld (A) E  # Restore CAR
+      ld E (A CDR)  # Get CDR
+      off C 1  # Set second visit
+      ld (A CDR) C  # Store up pointer
+   loop
+
+# Reserve cells
+(code 'needC 0)
+   ld A (Avail)  # Get avail list
+   do
+      null A  # Enough free cells?
+      jeq gc  # No: Collect garbage
+      ld A (A)
+      sub C 1
+   until z
+   ret
+
+# Garbage collector
+(code 'gc 0)
+   push A  # Save
+   push C
+   push E
+   push X
+   push Y
+   push Z
+   ld (DB) ZERO  # Cut off DB root
+   ### Prepare all cells ###
+   ld X Nil  # Symbol table
+   or (X) 1  # Set mark bit
+   add X 32  # Skip padding
+   do
+      or (X) 1  # Set mark bit
+      add X II  # Next symbol
+      cmp X GcMarkEnd
+   until gt
+   ld X (Heaps)  # Heap pointer
+   do
+      ld C CELLS
+      do
+         or (X CDR) 1  # Set mark bit
+         add X II  # Next cell
+         sub C 1  # Done?
+      until z  # Yes
+      ld X (X)  # Next heap
+      null X  # Done?
+   until eq  # Yes
+   ### Mark ###
+   ld E (Alarm)  # Mark globals
+   call markE
+   ld E (LineX)
+   call markE
+   ld E (Intern)  # Mark internal symbols
+   call markE
+   ld E (Intern I)
+   call markE
+   ld E (Transient)  # Mark transient symbols
+   call markE
+   ld E (Transient I)
+   call markE
+   ### Mark stack ###
+   ld Y L
+   do
+      null Y  # End of stack?
+   while ne  # No
+      ld Z (Y)  # Keep end of frame in Z
+      do
+         add Y I  # End of frame?
+         cmp Y Z
+      while ne  # No
+         ld E (Y)  # Next item
+         call markE  # Mark it
+      loop
+      ld Y (Y)  # Next frame
+   loop
+   ld Y (Catch)  # Catch frames
+   do
+      null Y  # Any?
+   while ne  # Yes
+      ld E (Y I)  # Mark 'tag'
+      null E  # Any?
+      if ne
+         call markE  # Yes
+      end
+      ld E (Y II)  # Mark 'fin'
+      call markE
+      ld Y (Y)  # Next frame
+   loop
+   ld Y (EnvMeth)  # Method frames
+   do
+      null Y  # Any?
+   while ne  # Yes
+      ld E (Y I)  # Mark 'key'
+      call markE
+      ld E (Y II)  # Mark 'cls'
+      call markE
+      ld Y (Y)  # Next frame
+   loop
+   # Mark externals
+   ld Y Extern
+   ld Z 0  # Clear TOS
+   do
+      do
+         off (Y CDR) 1  # Clear mark bit
+         ld A (Y CDR)  # Get subtrees
+         off (A CDR) 1  # Clear mark bit
+         atom (A CDR)  # Right subtree?
+      while z  # Yes
+         ld C Y  # Go right
+         ld Y (A CDR)  # Invert tree
+         ld (A CDR) Z  # TOS
+         ld Z C
+      loop
+      do
+         ld E (Y)  # Get external symbol
+         test (E) 1  # Already marked?
+         if nz  # No
+            ld A (E TAIL)
+            num A  # Any properties?
+            if z  # Yes
+               off A (| SYM 1)  # Clear 'extern' tag and mark bit
+               do
+                  ld A (A CDR)  # Skip property
+                  off A 1  # Clear mark bit
+                  num A  # Find name
+               until nz
+            end
+            rcl A 1  # Dirty or deleted?
+            if c  # Yes
+               call markE  # Mark external symbol
+            end
+         end
+         ld A (Y CDR)  # Left subtree?
+         atom (A)
+         if z  # Yes
+            ld C Y  # Go left
+            ld Y (A)  # Invert tree
+            ld (A) Z  # TOS
+            or C SYM  # First visit
+            ld Z C
+            break T
+         end
+         do
+            ld A Z  # TOS
+            null A  # Empty?
+            jeq 10  # Done
+            sym A  # Second visit?
+            if z  # Yes
+               ld C (A CDR)  # Nodes
+               ld Z (C CDR)  # TOS on up link
+               ld (C CDR) Y
+               ld Y A
+               break T
+            end
+            off A SYM  # Set second visit
+            ld C (A CDR)  # Nodes
+            ld Z (C)
+            ld (C) Y
+            ld Y A
+         loop
+      loop
+   loop
+10 ld A Db1  # DB root object
+   ld (DB) A  # Restore '*DB'
+   test (A) 1  # Marked?
+   if nz  # No
+      ld (A) Nil  # Clear
+      ld (A TAIL) DB1  # Set to "not loaded"
+   end
+   ld Y Extern  # Clean up
+   ld Z 0  # Clear TOS
+20 do
+      do
+         ld A (Y CDR)
+         atom (A CDR)  # Right subtree?
+      while z  # Yes
+         ld C Y  # Go right
+         ld Y (A CDR)  # Invert tree
+         ld (A CDR) Z  # TOS
+         ld Z C
+      loop
+      do
+         test ((Y)) 1  # External symbol marked?
+         if nz  # No: Remove it
+            ld A (Y CDR)  # Get subtrees
+            atom A  # Any?
+            if nz  # No
+               or (Y CDR) 1  # Set mark bit again
+               ld Y A  # Use NIL
+               jmp 40  # Already traversed
+            end
+            atom (A)  # Left branch?
+            if nz  # No
+               or (Y CDR) 1  # Set mark bit again
+               ld Y (A CDR)  # Use right branch
+               jmp 40  # Already traversed
+            end
+            atom (A CDR)  # Right branch?
+            if nz  # No
+               or (Y CDR) 1  # Set mark bit again
+               ld Y (A)  # Use left branch
+               jmp 20
+            end
+            ld A (A CDR)  # A on right branch
+            ld X (A CDR)  # X on sub-branches
+            atom (X)  # Left?
+            if nz  # No
+               ld (Y) (A)  # Insert right sub-branch
+               ld ((Y CDR) CDR) (X CDR)
+               jmp 30  # Traverse left branch
+            end
+            ld X (X)  # Left sub-branch
+            do
+               ld C (X CDR)  # More left branches?
+               atom (C)
+            while z  # Yes
+               ld A X  # Go down left
+               ld X (C)
+            loop
+            ld (Y) (X)  # Insert left sub-branch
+            ld ((A CDR)) (C CDR)
+         end
+30       ld A (Y CDR)  # Left subtree?
+         atom (A)
+         if z  # Yes
+            ld C Y  # Go left
+            ld Y (A)  # Invert tree
+            ld (A) Z  # TOS
+            or C SYM  # First visit
+            ld Z C
+            break T
+         end
+40       do
+            ld A Z  # TOS
+            null A  # Empty?
+            jeq 50  # Done
+            sym A  # Second visit?
+            if z  # Yes
+               ld C (A CDR)  # Nodes
+               ld Z (C CDR)  # TOS on up link
+               ld (C CDR) Y
+               ld Y A
+               break T
+            end
+            off A SYM  # Set second visit
+            ld C (A CDR)  # Nodes
+            ld Z (C)
+            ld (C) Y
+            ld Y A
+         loop
+      loop
+   loop
+50 ### Clean up ###
+   ld Y (EnvApply)  # Apply stack
+   do
+      null Y  # End of stack?
+   while ne  # No
+      ld Z (Y)  # Keep end of frame in Z
+      add Y II
+      do
+         off (Y) 1  # Clear
+         add Y II  # Next gc mark
+         cmp Y Z  # End of frame?
+      until ge  # Yes
+      ld Y (Z)  # Next frame
+   loop
+   ### Sweep ###
+   ld X 0  # Avail list
+   ld Y (Heaps)  # Heap list in Y
+   ld C (GcCount)  # Get cell count
+   null C
+   if ne  # Non-zero:
+      do
+         lea Z (Y (- HEAP II))  # Z on last cell in chunk
+         do
+            test (Z CDR) 1  # Free cell?
+            if nz  # Yes
+               ld (Z) X  # Link avail
+               ld X Z
+               sub C 1
+            end
+            sub Z II
+            cmp Z Y  # Done?
+         until lt  # Yes
+         ld Y (Y HEAP)  # Next heap
+         null Y
+      until eq  # All heaps done
+      ld (Avail) X  # Set new Avail
+      do
+         null C  # Count minimum reached?
+      while ns  # No
+         call heapAlloc  # Allocate heap
+         sub C CELLS
+      loop
+   else  # Zero: Try to free heaps
+      ld E Heaps  # Heap list link pointer in E
+      do
+         ld A (Avail)  # Keep avail list
+         ld C CELLS  # Counter
+         lea Z (Y (- HEAP II))  # Z on last cell in chunk
+         do
+            test (Z CDR) 1  # Free cell?
+            if nz  # Yes
+               ld (Z) X  # Link avail
+               ld X Z
+               sub C 1
+            end
+            sub Z II
+            cmp Z Y  # Done?
+         until lt  # Yes
+         null C  # Remaining cells?
+         if nz  # Yes
+            lea E (Y HEAP)  # Point to link of next heap
+            ld Y (E)  # Next heap
+         else
+            ld (Avail) A  # Reset avail list
+            ld Y (Y HEAP)  # Next heap
+            cc free((E))  # Free empty heap
+            ld (E) Y  # Store next heap in list link
+         end
+         null Y  # Next heap?
+      until z  # No
+   end
+   pop Z
+   pop Y
+   pop X
+   pop E
+   pop C
+   pop A
+   ret
+
+# (gc ['cnt]) -> cnt | NIL
+(code 'doGc 2)
+   push X
+   ld X E
+   ld E (E CDR)  # Get arg
+   ld E (E)
+   eval  # Eval
+   cmp E Nil  # Nil?
+   if eq  # Yes
+      call gc  # Collect with default
+   else
+      ld X E  # Save return value in X
+      call xCntEX_FE  # Else get number of megabytes
+      shl E 16  # Multiply with CELLS
+      ld C (GcCount)  # Save default
+      ld (GcCount) E  # Set new value
+      call gc  # Collect with given count
+      ld (GcCount) C  # Restore default
+      ld E X
+   end
+   pop X
+   ret
+
+### Build cons cells ###
+(code 'cons_A 0)
+   ld A (Avail)  # Get avail list
+   null A  # Empty?
+   if ne  # No
+      ld (Avail) (A)  # Set new avail list
+      ret
+   end
+   call gc  # Collect garbage
+   ld A (Avail)  # Get avail list again
+   ld (Avail) (A)  # Set new avail list
+   ret
+
+(code 'cons_C 0)
+   ld C (Avail)  # Get avail list
+   null C  # Empty?
+   if ne  # No
+      ld (Avail) (C)  # Set new avail list
+      ret
+   end
+   call gc  # Collect garbage
+   ld C (Avail)  # Get avail list again
+   ld (Avail) (C)  # Set new avail list
+   ret
+
+(code 'cons_E 0)
+   ld E (Avail)  # Get avail list
+   null E  # Empty?
+   if ne  # No
+      ld (Avail) (E)  # Set new avail list
+      ret
+   end
+   call gc  # Collect garbage
+   ld E (Avail)  # Get avail list again
+   ld (Avail) (E)  # Set new avail list
+   ret
+
+(code 'cons_X 0)
+   ld X (Avail)  # Get avail list
+   null X  # Empty?
+   if ne  # No
+      ld (Avail) (X)  # Set new avail list
+      ret
+   end
+   call gc  # Collect garbage
+   ld X (Avail)  # Get avail list again
+   ld (Avail) (X)  # Set new avail list
+   ret
+
+(code 'cons_Y 0)
+   ld Y (Avail)  # Get avail list
+   null Y  # Empty?
+   if ne  # No
+      ld (Avail) (Y)  # Set new avail list
+      ret
+   end
+   call gc  # Collect garbage
+   ld Y (Avail)  # Get avail list again
+   ld (Avail) (Y)  # Set new avail list
+   ret
+
+(code 'cons_Z 0)
+   ld Z (Avail)  # Get avail list
+   null Z  # Empty?
+   if ne  # No
+      ld (Avail) (Z)  # Set new avail list
+      ret
+   end
+   call gc  # Collect garbage
+   ld Z (Avail)  # Get avail list again
+   ld (Avail) (Z)  # Set new avail list
+   ret
+
+(code 'consA_A 0)
+   null (Avail)  # Avail list empty?
+   if ne  # No
+      ld A (Avail)  # Get avail list
+      ld (Avail) (A)  # Set new avail list
+      ret
+   end
+   link  # Save A
+   push A
+   link
+   call gc  # Collect garbage
+   drop
+   ld A (Avail)  # Get avail list
+   ld (Avail) (A)  # Set new avail list
+   ret
+
+(code 'consC_A 0)
+   ld A (Avail)  # Get avail list
+   null A  # Empty?
+   if ne  # No
+      ld (Avail) (A)  # Set new avail list
+      ret
+   end
+   link  # Save C
+   push C
+   link
+   call gc  # Collect garbage
+   drop
+   ld A (Avail)  # Get avail list again
+   ld (Avail) (A)  # Set new avail list
+   ret
+
+(code 'consE_A 0)
+   ld A (Avail)  # Get avail list
+   null A  # Empty?
+   if ne  # No
+      ld (Avail) (A)  # Set new avail list
+      ret
+   end
+   link  # Save E
+   push E
+   link
+   call gc  # Collect garbage
+   drop
+   ld A (Avail)  # Get avail list again
+   ld (Avail) (A)  # Set new avail list
+   ret
+
+(code 'consX_A 0)
+   ld A (Avail)  # Get avail list
+   null A  # Empty?
+   if ne  # No
+      ld (Avail) (A)  # Set new avail list
+      ret
+   end
+   link  # Save X
+   push X
+   link
+   call gc  # Collect garbage
+   drop
+   ld A (Avail)  # Get avail list again
+   ld (Avail) (A)  # Set new avail list
+   ret
+
+(code 'consA_C 0)
+   ld C (Avail)  # Get avail list
+   null C  # Empty?
+   if ne  # No
+      ld (Avail) (C)  # Set new avail list
+      ret
+   end
+   link  # Save A
+   push A
+   link
+   call gc  # Collect garbage
+   drop
+   ld C (Avail)  # Get avail list again
+   ld (Avail) (C)  # Set new avail list
+   ret
+
+(code 'consC_C 0)
+   null (Avail)  # Avail list empty?
+   if ne  # No
+      ld C (Avail)  # Get avail list
+      ld (Avail) (C)  # Set new avail list
+      ret
+   end
+   link  # Save C
+   push C
+   link
+   call gc  # Collect garbage
+   drop
+   ld C (Avail)  # Get avail list
+   ld (Avail) (C)  # Set new avail list
+   ret
+
+(code 'consE_C 0)
+   ld C (Avail)  # Get avail list
+   null C  # Empty?
+   if ne  # No
+      ld (Avail) (C)  # Set new avail list
+      ret
+   end
+   link  # Save E
+   push E
+   link
+   call gc  # Collect garbage
+   drop
+   ld C (Avail)  # Get avail list again
+   ld (Avail) (C)  # Set new avail list
+   ret
+
+(code 'consA_E 0)
+   ld E (Avail)  # Get avail list
+   null E  # Empty?
+   if ne  # No
+      ld (Avail) (E)  # Set new avail list
+      ret
+   end
+   link  # Save A
+   push A
+   link
+   call gc  # Collect garbage
+   drop
+   ld E (Avail)  # Get avail list again
+   ld (Avail) (E)  # Set new avail list
+   ret
+
+(code 'consC_E 0)
+   ld E (Avail)  # Get avail list
+   null E  # Empty?
+   if ne  # No
+      ld (Avail) (E)  # Set new avail list
+      ret
+   end
+   link  # Save C
+   push C
+   link
+   call gc  # Collect garbage
+   drop
+   ld E (Avail)  # Get avail list again
+   ld (Avail) (E)  # Set new avail list
+   ret
+
+(code 'consE_E 0)
+   null (Avail)  # Avail list empty?
+   if ne  # No
+      ld E (Avail)  # Get avail list
+      ld (Avail) (E)  # Set new avail list
+      ret
+   end
+   link  # Save E
+   push E
+   link
+   call gc  # Collect garbage
+   drop
+   ld E (Avail)  # Get avail list
+   ld (Avail) (E)  # Set new avail list
+   ret
+
+(code 'consX_E 0)
+   ld E (Avail)  # Get avail list
+   null E  # Empty?
+   if ne  # No
+      ld (Avail) (E)  # Set new avail list
+      ret
+   end
+   link  # Save X
+   push X
+   link
+   call gc  # Collect garbage
+   drop
+   ld E (Avail)  # Get avail list again
+   ld (Avail) (E)  # Set new avail list
+   ret
+
+(code 'consA_X 0)
+   ld X (Avail)  # Get avail list
+   null X  # Empty?
+   if ne  # No
+      ld (Avail) (X)  # Set new avail list
+      ret
+   end
+   link  # Save A
+   push A
+   link
+   call gc  # Collect garbage
+   drop
+   ld X (Avail)  # Get avail list again
+   ld (Avail) (X)  # Set new avail list
+   ret
+
+(code 'consE_X 0)
+   ld X (Avail)  # Get avail list
+   null X  # Empty?
+   if ne  # No
+      ld (Avail) (X)  # Set new avail list
+      ret
+   end
+   link  # Save E
+   push E
+   link
+   call gc  # Collect garbage
+   drop
+   ld X (Avail)  # Get avail list again
+   ld (Avail) (X)  # Set new avail list
+   ret
+
+(code 'consY_X 0)
+   ld X (Avail)  # Get avail list
+   null X  # Empty?
+   if ne  # No
+      ld (Avail) (X)  # Set new avail list
+      ret
+   end
+   link  # Save Y
+   push Y
+   link
+   call gc  # Collect garbage
+   drop
+   ld X (Avail)  # Get avail list again
+   ld (Avail) (X)  # Set new avail list
+   ret
+
+(code 'consA_Y 0)
+   ld Y (Avail)  # Get avail list
+   null Y  # Empty?
+   if ne  # No
+      ld (Avail) (Y)  # Set new avail list
+      ret
+   end
+   link  # Save A
+   push A
+   link
+   call gc  # Collect garbage
+   drop
+   ld Y (Avail)  # Get avail list again
+   ld (Avail) (Y)  # Set new avail list
+   ret
+
+(code 'consA_Z 0)
+   ld Z (Avail)  # Get avail list
+   null Z  # Empty?
+   if ne  # No
+      ld (Avail) (Z)  # Set new avail list
+      ret
+   end
+   link  # Save A
+   push A
+   link
+   call gc  # Collect garbage
+   drop
+   ld Z (Avail)  # Get avail list again
+   ld (Avail) (Z)  # Set new avail list
+   ret
+
+(code 'consAC_E 0)
+   ld E (Avail)  # Get avail list
+   null E  # Empty?
+   if ne  # No
+      ld (Avail) (E)  # Set new avail list
+      ret
+   end
+   link  # Save A and C
+   push A
+   push C
+   link
+   call gc  # Collect garbage
+   drop
+   ld E (Avail)  # Get avail list again
+   ld (Avail) (E)  # Set new avail list
+   ret
+
+### Build symbol cells ###
+(code 'consSymX_E 0)
+   cmp X ZERO  # Name?
+   jeq retNil  # No
+   ld E (Avail)  # Get avail list
+   null E  # Empty?
+   if eq  # Yes
+      link  # Save name
+      push X
+      link
+      call gc  # Collect garbage
+      drop
+      ld E (Avail)  # Get avail list again
+   end
+   ld (Avail) (E)  # Set new avail list
+   ld (E) X  # Set new symbol's name
+   or E SYM  # Make symbol
+   ld (E) E  # Set value to itself
+   ret
+
+### Build number cells ###
+(code 'boxNum_A 0)
+   ld A (Avail)  # Get avail list
+   null A  # Empty?
+   if eq  # Yes
+      call gc  # Collect garbage
+      ld A (Avail)  # Get avail list again
+   end
+   ld (Avail) (A)  # Set new avail list
+   ld (A CDR) ZERO  # Set CDR to ZERO
+   or B BIG  # Make number
+   ret
+
+(code 'boxNum_C 0)
+   ld C (Avail)  # Get avail list
+   null C  # Empty?
+   if eq  # Yes
+      call gc  # Collect garbage
+      ld C (Avail)  # Get avail list again
+   end
+   ld (Avail) (C)  # Set new avail list
+   ld (C CDR) ZERO  # Set CDR to ZERO
+   or C BIG  # Make number
+   ret
+
+(code 'boxNum_E 0)
+   ld E (Avail)  # Get avail list
+   null E  # Empty?
+   if eq  # Yes
+      call gc  # Collect garbage
+      ld E (Avail)  # Get avail list again
+   end
+   ld (Avail) (E)  # Set new avail list
+   ld (E CDR) ZERO  # Set CDR to ZERO
+   or E BIG  # Make number
+   ret
+
+(code 'boxNum_X 0)
+   ld X (Avail)  # Get avail list
+   null X  # Empty?
+   if eq  # Yes
+      call gc  # Collect garbage
+      ld X (Avail)  # Get avail list again
+   end
+   ld (Avail) (X)  # Set new avail list
+   ld (X CDR) ZERO  # Set CDR to ZERO
+   or X BIG  # Make number
+   ret
+
+(code 'boxNumA_A 0)
+   push A
+   ld A (Avail)  # Get avail list
+   null A  # Empty?
+   if eq  # Yes
+      call gc  # Collect garbage
+      ld A (Avail)  # Get avail list again
+   end
+   ld (Avail) (A)  # Set new avail list
+   pop (A)  # Set new cell's CAR
+   ld (A CDR) ZERO  # Set CDR to ZERO
+   or B BIG  # Make number
+   ret
+
+(code 'boxNumE_E 0)
+   push E
+   ld E (Avail)  # Get avail list
+   null E  # Empty?
+   if eq  # Yes
+      call gc  # Collect garbage
+      ld E (Avail)  # Get avail list again
+   end
+   ld (Avail) (E)  # Set new avail list
+   pop (E)  # Set new cell's CAR
+   ld (E CDR) ZERO  # Set CDR to ZERO
+   or E BIG  # Make number
+   ret
+
+(code 'consNumAC_A 0)
+   push A
+   ld A (Avail)  # Get avail list
+   null A  # Empty?
+   if eq  # Yes
+      link  # Save C
+      push C
+      link
+      call gc  # Collect garbage
+      drop
+      ld A (Avail)  # Get avail list again
+   end
+   ld (Avail) (A)  # Set new avail list
+   pop (A)  # Set new cell's CAR
+   ld (A CDR) C  # Set CDR
+   or B BIG  # Make number
+   ret
+
+(code 'consNumAE_A 0)
+   push A
+   ld A (Avail)  # Get avail list
+   null A  # Empty?
+   if eq  # Yes
+      link  # Save E
+      push E
+      link
+      call gc  # Collect garbage
+      drop
+      ld A (Avail)  # Get avail list again
+   end
+   ld (Avail) (A)  # Set new avail list
+   pop (A)  # Set new cell's CAR
+   ld (A CDR) E  # Set CDR
+   or B BIG  # Make number
+   ret
+
+(code 'consNumCA_C 0)
+   push C
+   ld C (Avail)  # Get avail list
+   null C  # Empty?
+   if eq  # Yes
+      link  # Save A
+      push A
+      link
+      call gc  # Collect garbage
+      drop
+      ld C (Avail)  # Get avail list again
+   end
+   ld (Avail) (C)  # Set new avail list
+   pop (C)  # Set new cell's CAR
+   ld (C CDR) A  # Set CDR
+   or C BIG  # Make number
+   ret
+
+(code 'consNumCE_A 0)
+   ld A (Avail)  # Get avail list
+   null A  # Empty?
+   if eq  # Yes
+      link  # Save E
+      push E
+      link
+      call gc  # Collect garbage
+      drop
+      ld A (Avail)  # Get avail list again
+   end
+   ld (Avail) (A)  # Set new avail list
+   ld (A) C  # Set new cell's CAR
+   ld (A CDR) E  # Set CDR
+   or B BIG  # Make number
+   ret
+
+(code 'consNumCE_C 0)
+   push C
+   ld C (Avail)  # Get avail list
+   null C  # Empty?
+   if eq  # Yes
+      link  # Save E
+      push E
+      link
+      call gc  # Collect garbage
+      drop
+      ld C (Avail)  # Get avail list again
+   end
+   ld (Avail) (C)  # Set new avail list
+   pop (C)  # Set new cell's CAR
+   ld (C CDR) E  # Set CDR
+   or C BIG  # Make number
+   ret
+
+(code 'consNumCE_E 0)
+   null (Avail)  # Avail list empty?
+   if eq  # Yes
+      link  # Save E
+      push E
+      link
+      call gc  # Collect garbage
+      drop
+   end
+   push E
+   ld E (Avail)  # Get avail list
+   ld (Avail) (E)  # Set new avail list
+   ld (E) C  # Set new cell's CAR
+   pop (E CDR)  # Set CDR
+   or E BIG  # Make number
+   ret
+
+(code 'consNumEA_A 0)
+   null (Avail)  # Avail list empty?
+   if eq  # Yes
+      link  # Save A
+      push A
+      link
+      call gc  # Collect garbage
+      drop
+   end
+   push A
+   ld A (Avail)  # Get avail list
+   ld (Avail) (A)  # Set new avail list
+   ld (A) E  # Set new cell's CAR
+   pop (A CDR)  # Set CDR
+   or B BIG  # Make number
+   ret
+
+(code 'consNumEA_E 0)
+   push E
+   ld E (Avail)  # Get avail list
+   null E  # Empty?
+   if eq  # Yes
+      link  # Save A
+      push A
+      link
+      call gc  # Collect garbage
+      drop
+      ld E (Avail)  # Get avail list again
+   end
+   ld (Avail) (E)  # Set new avail list
+   pop (E)  # Set new cell's CAR
+   ld (E CDR) A  # Set CDR
+   or E BIG  # Make number
+   ret
+
+(code 'consNumEC_E 0)
+   push E
+   ld E (Avail)  # Get avail list
+   null E  # Empty?
+   if eq  # Yes
+      link  # Save C
+      push C
+      link
+      call gc  # Collect garbage
+      drop
+      ld E (Avail)  # Get avail list again
+   end
+   ld (Avail) (E)  # Set new avail list
+   pop (E)  # Set new cell's CAR
+   ld (E CDR) C  # Set CDR
+   or E BIG  # Make number
+   ret
+
+# vi:et:ts=3:sw=3
diff --git a/src64/glob.l b/src64/glob.l
@@ -0,0 +1,1078 @@
+# 17mar10abu
+# (c) Software Lab. Alexander Burger
+
+(data 'Globals 0)
+:: AV          word  0           # Command line argument vector
+:: AV0         word  0           # Command name
+:: Home        word  0           # Home directory
+:: Heaps       word  0           # Heap list
+:: Avail       word  0           # Avail list
+:: Chr         word  0           # Single-char buffer
+:: EnvPutB     word  0           # Character output function
+:: EnvGet_A    word  0           # Character input function
+:: InFile      word  0           # Input file
+:: OutFile     word  0           # Output file
+:: Buf         word  0           # General 16-byte buffer
+               word  0
+
+: Stack0       word  0           # Initial stack pointer
+: Catch        word  0           # Catch frames
+: Termio       word  0           # Raw mode terminal I/O
+: Time         word  0           # Pointer to time structure
+: USec         word  0           # Startup microseconds
+: TtyPid       word  0           # Terminal process ID
+: InFDs        word  0           # Scaled number of input files
+: InFiles      word  0           # Input files
+: OutFDs       word  0           # Scaled number of output files
+: OutFiles     word  0           # Output files
+: PutBinBZ     word  0           # Binary output function
+: GetBinZ_FB   word  0           # Binary input function
+: Seed         word  0           # Random seed low
+               word  0           # Random seed high
+: TickU        word  0           # Ticks in user time
+: TickS        word  0           # Ticks in system time
+: Slot         word  0           # Child index
+: Spkr         word  0           # RPC loadspeaker
+: Mic          word  0           # RPC microphone
+: SpMiPipe     word  0           # Speaker/microphone pipe
+: Hear         word  0           # RPC listener
+: Tell         word  0           # RPC broadcaster
+: TellBuf      word  0           # RPC buffer
+: Children     word  0           # Scaled number of children
+: Child        word  0           # Child array
+: ExtN         word  0           # External symbol offset
+: Extn         word  0
+: StrX         word  0           # String status
+: StrC         word  0
+: Alarm        word  Nil         # Alarm handler
+: LineX        word  ZERO        # Console line
+: LineC        word  -1
+: GcCount      word  CELLS       # Collector count
+: Sep0         word  (char ".")  # Decimal separator
+: Sep3         word  (char ",")  # Thousand separator
+: BufEnd       word  0           # Common buffer end pointer
+
+: Penv         word  Nil         # Pilog environment
+: Pnl          word  Nil
+
+# Database
+: DBs          word  0           # Scaled number of DB files
+: DbFile       word  0           # DB file
+: DbFiles      word  0           # DB files
+: DbBlock      word  0           # Block buffer
+: MaxBlkSize   word  0           # Maximum block size
+: BlkIndex     word  0           # Block index
+: BlkLink      word  0           # Next block
+: DbJnl        word  0           # Journal file
+: DbLog        word  0           # Transaction log file
+
+# Symbol trees
+:: Intern      word  Nil         # Short internal names
+               word  Nil         # Long internal names
+:: Transient   word  Nil         # Short transient names
+               word  Nil         # Long transient names
+
+
+# Symbol Table
+(data 'SymTab 0)
+   initSym Nil       "NIL"       Nil
+               word  Nil         # CDR when NIL is accessed as an empty list
+               word  0           # Padding
+
+   # Protected symbols
+   initSym OS        "*OS"       TgOS
+   initSym DB        "*DB"       Db1
+   initSym Meth      "meth"      doMeth
+   initSym Quote     "quote"     doQuote
+   initSym TSym      "T"         TSym
+
+   # System globals
+   initSym ISym      "I"         Nil
+   initSym NSym      "N"         Nil
+   initSym SSym      "S"         Nil
+   initSym CSym      "C"         Nil
+   initSym BSym      "B"         Nil
+   initSym Solo      "*Solo"     ZERO
+   initSym PPid      "*PPid"     Nil
+   initSym Pid       "*Pid"      0
+   initSym At        "@"         Nil
+   initSym At2       "@@"        Nil
+   initSym At3       "@@@"       Nil
+   initSym This      "This"      Nil
+   initSym Dbg       "*Dbg"      Nil
+   initSym Zap       "*Zap"      Nil
+   initSym Ext       "*Ext"      Nil
+   initSym Scl       "*Scl"      ZERO
+   initSym Class     "*Class"    Nil
+   initSym Run       "*Run"      Nil
+   initSym Hup       "*Hup"      Nil
+   initSym Sig1      "*Sig1"     Nil
+   initSym Sig2      "*Sig2"     Nil
+   initSym Up        "\^"        Nil
+   initSym Err       "*Err"      Nil
+   initSym Msg       "*Msg"      Nil
+   initSym Uni       "*Uni"      Nil
+   initSym Led       "*Led"      Nil
+   initSym Tsm       "*Tsm"      Nil
+   initSym Adr       "*Adr"      Nil
+   initSym Fork      "*Fork"     Nil
+   initSym Bye       "*Bye"      Nil
+
+   # System functions
+   initSym NIL       "raw"       doRaw
+   initSym NIL       "alarm"     doAlarm
+   initSym NIL       "protect"   doProtect
+   initSym NIL       "heap"      doHeap
+   initSym NIL       "env"       doEnv
+   initSym NIL       "up"        doUp
+   initSym NIL       "quit"      doQuit
+   initSym NIL       "errno"     doErrno
+   initSym NIL       "native"    doNative
+   initSym NIL       "args"      doArgs
+   initSym NIL       "next"      doNext
+   initSym NIL       "arg"       doArg
+   initSym NIL       "rest"      doRest
+   initSym NIL       "date"      doDate
+   initSym NIL       "time"      doTime
+   initSym NIL       "usec"      doUsec
+   initSym NIL       "pwd"       doPwd
+   initSym NIL       "cd"        doCd
+   initSym NIL       "ctty"      doCtty
+   initSym NIL       "info"      doInfo
+   initSym NIL       "file"      doFile
+   initSym NIL       "dir"       doDir
+   initSym NIL       "cmd"       doCmd
+   initSym NIL       "argv"      doArgv
+   initSym NIL       "opt"       doOpt
+   initSym NIL       "version"   doVersion
+
+   # Garbage collection
+   initSym NIL       "gc"        doGc
+
+   # Mapping
+   initSym NIL       "apply"     doApply
+   initSym NIL       "pass"      doPass
+   initSym NIL       "maps"      doMaps
+   initSym NIL       "map"       doMap
+   initSym NIL       "mapc"      doMapc
+   initSym NIL       "maplist"   doMaplist
+   initSym NIL       "mapcar"    doMapcar
+   initSym NIL       "mapcon"    doMapcon
+   initSym NIL       "mapcan"    doMapcan
+   initSym NIL       "filter"    doFilter
+   initSym NIL       "extract"   doExtract
+   initSym NIL       "seek"      doSeek
+   initSym NIL       "find"      doFind
+   initSym NIL       "pick"      doPick
+   initSym NIL       "cnt"       doCnt
+   initSym NIL       "sum"       doSum
+   initSym NIL       "maxi"      doMaxi
+   initSym NIL       "mini"      doMini
+   initSym NIL       "fish"      doFish
+   initSym NIL       "by"        doBy
+
+   # Control flow
+   initSym NIL       "as"        doAs
+   initSym NIL       "pid"       doPid
+   initSym NIL       "lit"       doLit
+   initSym NIL       "eval"      doEval
+   initSym NIL       "run"       doRun
+   initSym NIL       "def"       doDef
+   initSym NIL       "de"        doDe
+   initSym NIL       "dm"        doDm
+   initSym NIL       "box"       doBox
+   initSym NIL       "new"       doNew
+   initSym NIL       "type"      doType
+   initSym NIL       "isa"       doIsa
+   initSym NIL       "method"    doMethod
+   initSym NIL       "send"      doSend
+   initSym NIL       "try"       doTry
+   initSym NIL       "super"     doSuper
+   initSym NIL       "extra"     doExtra
+   initSym NIL       "with"      doWith
+   initSym NIL       "bind"      doBind
+   initSym NIL       "job"       doJob
+   initSym NIL       "let"       doLet
+   initSym NIL       "let?"      doLetQ
+   initSym NIL       "use"       doUse
+   initSym NIL       "and"       doAnd
+   initSym NIL       "or"        doOr
+   initSym NIL       "nand"      doNand
+   initSym NIL       "nor"       doNor
+   initSym NIL       "xor"       doXor
+   initSym NIL       "bool"      doBool
+   initSym NIL       "not"       doNot
+   initSym NIL       "nil"       doNil
+   initSym NIL       "t"         doT
+   initSym NIL       "prog"      doProg
+   initSym NIL       "prog1"     doProg1
+   initSym NIL       "prog2"     doProg2
+   initSym NIL       "if"        doIf
+   initSym NIL       "if2"       doIf2
+   initSym NIL       "ifn"       doIfn
+   initSym NIL       "when"      doWhen
+   initSym NIL       "unless"    doUnless
+   initSym NIL       "cond"      doCond
+   initSym NIL       "nond"      doNond
+   initSym NIL       "case"      doCase
+   initSym NIL       "state"     doState
+   initSym NIL       "while"     doWhile
+   initSym NIL       "until"     doUntil
+   initSym NIL       "at"        doAt
+   initSym NIL       "do"        doDo
+   initSym NIL       "loop"      doLoop
+   initSym NIL       "for"       doFor
+   initSym NIL       "catch"     doCatch
+   initSym NIL       "throw"     doThrow
+   initSym NIL       "finally"   doFinally
+   initSym NIL       "!"         doBreak
+   initSym NIL       "e"         doE
+   initSym NIL       "$"         doTrace
+   initSym NIL       "sys"       doSys
+   initSym NIL       "call"      doCall
+   initSym NIL       "tick"      doTick
+   initSym NIL       "ipid"      doIpid
+   initSym NIL       "opid"      doOpid
+   initSym NIL       "kill"      doKill
+   initSym NIL       "fork"      doFork
+   initSym NIL       "bye"       doBye
+
+   # Symbol functions
+   initSym NIL       "name"      doName
+   initSym NIL       "sp?"       doSpQ
+   initSym NIL       "pat?"      doPatQ
+   initSym NIL       "fun?"      doFunQ
+   initSym NIL       "getd"      doGetd
+   initSym NIL       "all"       doAll
+   initSym NIL       "intern"    doIntern
+   initSym NIL       "extern"    doExtern
+   initSym NIL       "===="      doHide
+   initSym NIL       "box?"      doBoxQ
+   initSym NIL       "str?"      doStrQ
+   initSym NIL       "ext?"      doExtQ
+   initSym NIL       "touch"     doTouch
+   initSym NIL       "zap"       doZap
+   initSym NIL       "chop"      doChop
+   initSym NIL       "pack"      doPack
+   initSym NIL       "glue"      doGlue
+   initSym NIL       "text"      doText
+   initSym NIL       "pre?"      doPreQ
+   initSym NIL       "sub?"      doSubQ
+   initSym NIL       "val"       doVal
+   initSym NIL       "set"       doSet
+   initSym NIL       "setq"      doSetq
+   initSym NIL       "xchg"      doXchg
+   initSym NIL       "on"        doOn
+   initSym NIL       "off"       doOff
+   initSym NIL       "onOff"     doOnOff
+   initSym NIL       "zero"      doZero
+   initSym NIL       "one"       doOne
+   initSym NIL       "default"   doDefault
+   initSym NIL       "push"      doPush
+   initSym NIL       "push1"     doPush1
+   initSym NIL       "pop"       doPop
+   initSym NIL       "cut"       doCut
+   initSym NIL       "del"       doDel
+   initSym NIL       "queue"     doQueue
+   initSym NIL       "fifo"      doFifo
+   initSym NIL       "idx"       doIdx
+   initSym NIL       "lup"       doLup
+   initSym NIL       "put"       doPut
+   initSym NIL       "get"       doGet
+   initSym NIL       "prop"      doProp
+   initSym NIL       ";"         doSemicol
+   initSym NIL       "=:"        doSetCol
+   initSym NIL       ":"         doCol
+   initSym NIL       "::"        doPropCol
+   initSym NIL       "putl"      doPutl
+   initSym NIL       "getl"      doGetl
+   initSym NIL       "wipe"      doWipe
+   initSym NIL       "meta"      doMeta
+   initSym NIL       "low?"      doLowQ
+   initSym NIL       "upp?"      doUppQ
+   initSym NIL       "lowc"      doLowc
+   initSym NIL       "uppc"      doUppc
+   initSym NIL       "fold"      doFold
+
+   # List processing
+   initSym NIL       "car"       doCar
+   initSym NIL       "cdr"       doCdr
+   initSym NIL       "caar"      doCaar
+   initSym NIL       "cadr"      doCadr
+   initSym NIL       "cdar"      doCdar
+   initSym NIL       "cddr"      doCddr
+   initSym NIL       "caaar"     doCaaar
+   initSym NIL       "caadr"     doCaadr
+   initSym NIL       "cadar"     doCadar
+   initSym NIL       "caddr"     doCaddr
+   initSym NIL       "cdaar"     doCdaar
+   initSym NIL       "cdadr"     doCdadr
+   initSym NIL       "cddar"     doCddar
+   initSym NIL       "cdddr"     doCdddr
+   initSym NIL       "caaaar"    doCaaaar
+   initSym NIL       "caaadr"    doCaaadr
+   initSym NIL       "caadar"    doCaadar
+   initSym NIL       "caaddr"    doCaaddr
+   initSym NIL       "cadaar"    doCadaar
+   initSym NIL       "cadadr"    doCadadr
+   initSym NIL       "caddar"    doCaddar
+   initSym NIL       "cadddr"    doCadddr
+   initSym NIL       "cdaaar"    doCdaaar
+   initSym NIL       "cdaadr"    doCdaadr
+   initSym NIL       "cdadar"    doCdadar
+   initSym NIL       "cdaddr"    doCdaddr
+   initSym NIL       "cddaar"    doCddaar
+   initSym NIL       "cddadr"    doCddadr
+   initSym NIL       "cdddar"    doCdddar
+   initSym NIL       "cddddr"    doCddddr
+   initSym NIL       "nth"       doNth
+   initSym NIL       "con"       doCon
+   initSym NIL       "cons"      doCons
+   initSym NIL       "conc"      doConc
+   initSym NIL       "circ"      doCirc
+   initSym NIL       "rot"       doRot
+   initSym NIL       "list"      doList
+   initSym NIL       "need"      doNeed
+   initSym NIL       "range"     doRange
+   initSym NIL       "full"      doFull
+   initSym NIL       "make"      doMake
+   initSym NIL       "made"      doMade
+   initSym NIL       "chain"     doChain
+   initSym NIL       "link"      doLink
+   initSym NIL       "yoke"      doYoke
+   initSym NIL       "copy"      doCopy
+   initSym NIL       "mix"       doMix
+   initSym NIL       "append"    doAppend
+   initSym NIL       "delete"    doDelete
+   initSym NIL       "delq"      doDelq
+   initSym NIL       "replace"   doReplace
+   initSym NIL       "strip"     doStrip
+   initSym NIL       "split"     doSplit
+   initSym NIL       "reverse"   doReverse
+   initSym NIL       "flip"      doFlip
+   initSym NIL       "trim"      doTrim
+   initSym NIL       "clip"      doClip
+   initSym NIL       "head"      doHead
+   initSym NIL       "tail"      doTail
+   initSym NIL       "stem"      doStem
+   initSym NIL       "fin"       doFin
+   initSym NIL       "last"      doLast
+   initSym NIL       "=="        doEq
+   initSym NIL       "n=="       doNEq
+   initSym NIL       "="         doEqual
+   initSym NIL       "<>"        doNEqual
+   initSym NIL       "=0"        doEq0
+   initSym NIL       "=T"        doEqT
+   initSym NIL       "n0"        doNEq0
+   initSym NIL       "nT"        doNEqT
+   initSym NIL       "<"         doLt
+   initSym NIL       "<="        doLe
+   initSym NIL       ">"         doGt
+   initSym NIL       ">="        doGe
+   initSym NIL       "max"       doMax
+   initSym NIL       "min"       doMin
+   initSym NIL       "atom"      doAtom
+   initSym NIL       "pair"      doPair
+   initSym NIL       "lst?"      doLstQ
+   initSym NIL       "num?"      doNumQ
+   initSym NIL       "sym?"      doSymQ
+   initSym NIL       "flg?"      doFlgQ
+   initSym NIL       "member"    doMember
+   initSym NIL       "memq"      doMemq
+   initSym NIL       "mmeq"      doMmeq
+   initSym NIL       "sect"      doSect
+   initSym NIL       "diff"      doDiff
+   initSym NIL       "index"     doIndex
+   initSym NIL       "offset"    doOffset
+   initSym NIL       "length"    doLength
+   initSym NIL       "size"      doSize
+   initSym NIL       "assoc"     doAssoc
+   initSym NIL       "asoq"      doAsoq
+   initSym NIL       "rank"      doRank
+   initSym NIL       "match"     doMatch
+   initSym NIL       "fill"      doFill
+   initSym NIL       "prove"     doProve
+   initSym NIL       "->"        doArrow
+   initSym NIL       "unify"     doUnify
+   initSym NIL       "sort"      doSort
+
+   # Arithmetics
+   initSym NIL       "format"    doFormat
+   initSym NIL       "+"         doAdd
+   initSym NIL       "-"         doSub
+   initSym NIL       "inc"       doInc
+   initSym NIL       "dec"       doDec
+   initSym NIL       "*"         doMul
+   initSym NIL       "*/"        doMulDiv
+   initSym NIL       "/"         doDiv
+   initSym NIL       "%"         doRem
+   initSym NIL       ">>"        doShift
+   initSym NIL       "lt0"       doLt0
+   initSym NIL       "ge0"       doGe0
+   initSym NIL       "gt0"       doGt0
+   initSym NIL       "abs"       doAbs
+   initSym NIL       "bit?"      doBitQ
+   initSym NIL       "&"         doBitAnd
+   initSym NIL       "|"         doBitOr
+   initSym NIL       "x|"        doBitXor
+   initSym NIL       "seed"      doSeed
+   initSym NIL       "rand"      doRand
+
+   # Input/Output
+   initSym NIL       "path"      doPath
+   initSym NIL       "read"      doRead
+   initSym NIL       "wait"      doWait
+   initSym NIL       "sync"      doSync
+   initSym NIL       "hear"      doHear
+   initSym NIL       "tell"      doTell
+   initSym NIL       "poll"      doPoll
+   initSym NIL       "key"       doKey
+   initSym NIL       "peek"      doPeek
+   initSym NIL       "char"      doChar
+   initSym NIL       "skip"      doSkip
+   initSym NIL       "eol"       doEol
+   initSym NIL       "eof"       doEof
+   initSym NIL       "from"      doFrom
+   initSym NIL       "till"      doTill
+   initSym NIL       "line"      doLine
+   initSym NIL       "lines"     doLines
+   initSym NIL       "any"       doAny
+   initSym NIL       "sym"       doSym
+   initSym NIL       "str"       doStr
+   initSym NIL       "load"      doLoad
+   initSym NIL       "in"        doIn
+   initSym NIL       "out"       doOut
+   initSym NIL       "pipe"      doPipe
+   initSym NIL       "ctl"       doCtl
+   initSym NIL       "open"      doOpen
+   initSym NIL       "close"     doClose
+   initSym NIL       "echo"      doEcho
+   initSym NIL       "prin"      doPrin
+   initSym NIL       "prinl"     doPrinl
+   initSym NIL       "space"     doSpace
+   initSym NIL       "print"     doPrint
+   initSym NIL       "printsp"   doPrintsp
+   initSym NIL       "println"   doPrintln
+   initSym NIL       "flush"     doFlush
+   initSym NIL       "rewind"    doRewind
+   initSym NIL       "ext"       doExt
+   initSym NIL       "rd"        doRd
+   initSym NIL       "pr"        doPr
+   initSym NIL       "wr"        doWr
+   initSym NIL       "rpc"       doRpc
+
+   # Database
+   initSym NIL       "pool"      doPool
+   initSym NIL       "journal"   doJournal
+   initSym NIL       "id"        doId
+   initSym NIL       "seq"       doSeq
+   initSym NIL       "lieu"      doLieu
+   initSym NIL       "lock"      doLock
+   initSym NIL       "commit"    doCommit
+   initSym NIL       "rollback"  doRollback
+   initSym NIL       "mark"      doMark
+   initSym NIL       "free"      doFree
+   initSym NIL       "dbck"      doDbck
+
+   # Networking
+   initSym NIL       "port"      doPort
+   initSym NIL       "accept"    doAccept
+   initSym NIL       "listen"    doListen
+   initSym NIL       "host"      doHost
+   initSym NIL       "connect"   doConnect
+   initSym NIL       "udp"       doUdp
+
+: SymTabEnd
+
+# Transient symbols
+   initSym TgOS      `*TargetOS  TgOS
+
+# Database root symbol '{1}'
+   word DB1  # Name
+: Db1
+   word Nil  # Value
+:: Extern  # External symbol tree root node
+   word  Db1
+   word  Nil
+
+# Version number
+:: Version
+   word (short `(car *Version))
+   word .+8
+   word (short `(cadr *Version))
+   word .+8
+   word (short `(caddr *Version))
+   word .+8
+   word (short `(cadddr *Version))
+   word Nil
+
+: GcMarkEnd
+
+# Structures
+: Env                      # <Catch III> Environment
+: EnvBind      word  0        # <III> Bind frames (first item in Env)
+: EnvInFrames  word  0        # <IV> Input frames
+: EnvOutFrames word  0        # <V> Output frames
+: EnvCtlFrames word  0        # <VI> Control frames
+: EnvArgs      word  0        # Varargs frame
+: EnvNext      word  0        # Next vararg
+: EnvApply     word  0        # Apply frames
+: EnvMeth      word  0        # Method frames
+: EnvTask      word  Nil      # Task list
+: EnvMake      word  0        # 'make' env
+: EnvYoke      word  0
+: EnvParseX    word  0        # Parser status
+: EnvParseC    word  0
+: EnvParseEOF  word  -1
+: EnvSort      word  0        # Sort function
+: EnvProtect   word  0        # Signal protection
+: EnvTrace     word  0        # Trace level
+: EnvBrk       word  0        # Breakpoint
+               align 8        # Padding
+: EnvEnd
+
+: OrgTermio skip TERMIOS         # Original termio structure
+: Flock     skip FLOCK           # File lock structure
+: Tms       skip TMS             # 'times' structure
+: Addr      skip SOCKADDR_IN     # Internet socket address
+
+: TBuf      byte (+ INTERN 4)    # 'T' in PLIO format
+            byte (char "T")
+
+# Strings
+:: _r_ asciz "r"
+:: _w_ asciz "w"
+:: _a_ asciz "a"
+:: _ap_ asciz "a+"
+:: _dot_ asciz "."
+
+# Bytes
+:: Signal   byte 0            # Signal flag
+:: Tio      byte 0            # Terminal I/O
+:: Flg      byte 0            # General flag value
+
+: Repl      byte 0            # REPL flag
+: PRepl     byte 0            # Parent REPL
+: Jam       byte 0            # Error jam
+: InBye     byte 0            # Exit status
+: Sync      byte 0            # Family IPC synchronization
+
+
+# Case mappings from the GNU Kaffe Project
+   align 2
+: CaseBlocks
+   hx2 ("1C2" "1C2" "1C1" "12C" "12B" "1A0" "1F8" "2DC" "25F" "2EE" "215" "346" "2DC" "326" "2BC" "216")
+   hx2 ("15F" "2D4" "376" "376" "376" "369" "FE8F" "344" "FF85" "FF65" "FDB5" "FDA1" "1B" "2C4" "1C" "47")
+   hx2 ("FEA8" "FF8C" "235" "FEFF" "1A" "FEBF" "26" "FB20" "FE28" "113" "104" "FB61" "FB5A" "10B" "109" "FE")
+   hx2 ("FF08" "229" "25E" "1C7" "1FC" "1DC" "FC46" "229" "FE27" "FB55" "169" "FBC8" "FC" "103" "FB68" "FB48")
+   hx2 ("FB28" "FB08" "FAE8" "FAC8" "FAA8" "FA88" "FA68" "FA48" "65" "50" "AB" "139" "FE0E" "63" "155" "1A8")
+   hx2 ("F669" "129" "128" "F91F" "FE56" "108" "107" "FAC0" "FC8E" "FEAD" "C6" "FCA7" "FB95" "F47D" "9F" "FB17")
+   hx2 ("FE20" "FD28" "FB2F" "3B" "F3B9" "FE57" "FCCE" "FFBB" "F339" "FA98" "FF8B" "FF3B" "FA54" "F7E3" "FF2B" "FAD7")
+   hx2 ("FB69" "FC3A" "FEE5" "F4C8" "FCB0" "FA88" "FDBF" "F448" "FE45" "FCC7" "FE4F" "F7F1" "F715" "F2E8" "FD9F" "F348")
+   hx2 ("F96A" "FC02" "FD97" "F2C8" "F2A8" "F4B9" "F4B3" "EF6B" "F86A" "F84A" "FC58" "F80A" "F7EA" "FC0F" "F7AA" "EE9C")
+   hx2 ("FB90" "F74A" "F7FA" "F70A" "F7CA" "F792" "F471" "F4D2" "F732" "F64A" "F401" "F64D" "EFA8" "F5CA" "F5AA" "ECA1")
+   hx2 ("F569" "F54A" "F52A" "F50A" "F4EA" "F4CA" "F4AA" "F48A" "F46A" "F44A" "F42A" "F40A" "F3EA" "F3CA" "F3AA" "F38A")
+   hx2 ("F36A" "F34A" "F32A" "F289" "F777" "F2CA" "F2AA" "F737" "EC28" "EC08" "EBE8" "EBC8" "F1EA" "F4A2" "F545" "EDC6")
+   hx2 ("F2D7" "F14A" "E8ED" "E81E" "F0EA" "F597" "EA68" "EA48" "EA28" "EA08" "E9E8" "E9C8" "E9A8" "E988" "E968" "E948")
+   hx2 ("E928" "E908" "E8E8" "E8C8" "E8A8" "E888" "E868" "E848" "E828" "E808" "E7E8" "E7C8" "E7A8" "E788" "E768" "E748")
+   hx2 ("E728" "E708" "E6E8" "E6C8" "E6A8" "E688" "E668" "E648" "E628" "E608" "E5E8" "E5C8" "E5A8" "E588" "E568" "E548")
+   hx2 ("E55F" "E53F" "E51F" "E4FF" "EFD7" "E4BF" "E49F" "E485" "EF87" "EF57" "EF57" "EF57" "EF57" "EF47" "E1AD" "EF46")
+   hx2 ("EF46" "EF46" "E1E0" "E3DD" "EF06" "E9D9" "EBEB" "E244" "EED4" "EF65" "E1F5" "EF45" "EEE9" "EF7C" "EE74" "EF70")
+   hx2 ("EF7D" "EF78" "EE91" "EFD3" "EE7D" "EE25" "EE27" "EF65" "EFDD" "EE96" "EFD3" "EFE1" "EF69" "DF88" "DF68" "DF48")
+   hx2 ("ED2B" "ED3D" "ED19" "EF1C" "EF08" "ED47" "ED3D" "ED33" "EC2B" "EC0B" "EBEB" "EBCB" "EBCE" "EA7C" "EB69" "EB6C")
+   hx2 ("E9B6" "EB0B" "EAEB" "E9E9" "DCA8" "DC88" "DC68" "DC48" "E910" "EA23" "EB58" "EB4F" "EB45" "EAE5" "DB68" "DB48")
+   hx2 ("E92B" "E90B" "E8EB" "E8CB" "E8AB" "E88B" "E86B" "E84B" "DA28" "DA08" "D9E8" "D9C8" "D9A8" "D988" "D968" "D948")
+   hx2 ("D928" "D908" "D8E8" "D8C8" "D8A8" "D888" "D868" "D848" "D828" "D808" "D7E8" "D7C8" "D7A8" "D788" "D768" "D748")
+   hx2 ("D728" "D708" "D6E8" "D6C8" "D6A8" "D688" "D668" "D648" "D628" "D608" "D5E8" "D5C8" "D5A8" "D588" "D568" "D548")
+   hx2 ("D528" "D508" "D4E8" "D4C8" "E2B1" "E28B" "E26B" "E270" "E22B" "E20B" "E1EB" "E1CB" "E1AB" "E18B" "E18E" "DD8F")
+   hx2 ("E3A8" "DFD3" "D929" "D90A" "E348" "D8C9" "D8AA" "DCD7" "DCB2" "D681" "D82A" "D80A" "E268" "CEDE" "D168" "D148")
+   hx2 ("E116" "E0E9" "E1CB" "E0B7" "E0B7" "E15E" "DF17" "E034" "E013" "DFF3" "DFD3" "DE6C" "DF93" "DF73" "DF55" "DF34")
+   hx2 ("D56A" "D54A" "D52A" "D50A" "D4EA" "D4CA" "D4AA" "D48A" "D46A" "D44A" "D42A" "D40A" "D3EA" "D3CA" "D3AA" "D38A")
+   hx2 ("D36A" "D34A" "D32A" "D30A" "D2EA" "D2CA" "D2AA" "D28A" "D26A" "D24A" "D22A" "D20A" "D1EA" "D1CA" "D1AA" "D18A")
+   hx2 ("D16A" "D14A" "D12A" "D10A" "D0EA" "D0CA" "D0AA" "D08A" "D06A" "D04A" "D02A" "D00A" "CFEA" "CFCA" "CFAA" "CF8A")
+   hx2 ("CF6A" "CF4A" "CF2A" "CF0A" "CEEA" "CECA" "CEAA" "CE8A" "CE6A" "CE4A" "CE2A" "CE0A" "CDEA" "CDCA" "CDAA" "CD8A")
+   hx2 ("CD6A" "CD4A" "CD2A" "CD0A" "CCEA" "CCCA" "CCAA" "CC8A" "CC6A" "CC4A" "CC2A" "CC0A" "CBEA" "CBCA" "CBAA" "CB8A")
+   hx2 ("CB6A" "CB4A" "CB2A" "CB0A" "CAEA" "CACA" "CAAA" "CA8A" "CA6A" "CA4A" "CA2A" "CA0A" "C9EA" "C9CA" "C9AA" "C98A")
+   hx2 ("C96A" "C94A" "C92A" "C90A" "C8EA" "C8CA" "C8AA" "C88A" "C86A" "C84A" "C82A" "C80A" "C7EA" "C7CA" "C7AA" "C78A")
+   hx2 ("C76A" "C74A" "C72A" "C70A" "C6EA" "C6CA" "C6AA" "C68A" "C66A" "C64A" "C62A" "C60A" "C5EA" "C5CA" "C5AA" "C58A")
+   hx2 ("C56A" "C54A" "C52A" "C50A" "C4EA" "C4CA" "C4AA" "C48A" "C46A" "C44A" "C42A" "C40A" "C3EA" "C3CA" "C3AA" "C38A")
+   hx2 ("C36A" "C34A" "C32A" "C30A" "C2EA" "C2CA" "C2AA" "C28A" "C26A" "C24A" "C22A" "C20A" "C1EA" "C1CA" "C1AA" "C18A")
+   hx2 ("C16A" "C14A" "C12A" "C10A" "C0EA" "C0CA" "C0AA" "C08A" "C06A" "C04A" "C02A" "C00A" "BFEA" "BFCA" "BFAA" "BF8A")
+   hx2 ("BF6A" "BF4A" "BF2A" "BF0A" "BEEA" "BECA" "BEAA" "BE8A" "BE6A" "BE4A" "BE2A" "BE0A" "BDEA" "BDCA" "BDAA" "BD8A")
+   hx2 ("BD6A" "BD4A" "BD2A" "BD0A" "BCEA" "BCCA" "BCAA" "BC8A" "BC6A" "BC4A" "BC2A" "BC0A" "BBEA" "B2E0" "B568" "B548")
+   hx2 ("BB6A" "BB4A" "BB2A" "BB0A" "BAEA" "BACA" "BAAA" "BA8A" "BA6A" "BA4A" "BA2A" "BA0A" "B9EA" "B9CA" "B9AA" "B98A")
+   hx2 ("B96A" "B94A" "B92A" "B90A" "B8EA" "B8CA" "B8AA" "B88A" "B86A" "B84A" "B82A" "B80A" "B7EA" "B7CA" "B7AA" "B78A")
+   hx2 ("B76A" "B74A" "B72A" "B70A" "B6EA" "B6CA" "B6AA" "B68A" "B66A" "B64A" "B62A" "B60A" "B5EA" "B5CA" "B5AA" "B58A")
+   hx2 ("B56A" "B54A" "B52A" "B50A" "B4EA" "B4CA" "B4AA" "B48A" "B46A" "B44A" "B42A" "B40A" "B3EA" "B3CA" "B3AA" "B38A")
+   hx2 ("B36A" "B34A" "B32A" "B30A" "B2EA" "B2CA" "B2AA" "B28A" "B26A" "B24A" "B22A" "B20A" "B1EA" "B1CA" "B1AA" "B18A")
+   hx2 ("B16A" "B14A" "B12A" "B10A" "B0EA" "B0CA" "B0AA" "B08A" "B06A" "B04A" "B02A" "B00A" "AFEA" "AFCA" "AFAA" "AF8A")
+   hx2 ("AF6A" "AF4A" "AF2A" "AF0A" "AEEA" "AECA" "AEAA" "AE8A" "AE6A" "AE4A" "AE2A" "AE0A" "ADEA" "ADCA" "ADAA" "AD8A")
+   hx2 ("AD6A" "AD4A" "AD2A" "AD0A" "ACEA" "ACCA" "ACAA" "AC8A" "AC6A" "AC4A" "AC2A" "AC0A" "ABEA" "ABCA" "ABAA" "AB8A")
+   hx2 ("AB6A" "AB4A" "AB2A" "AB0A" "AAEA" "AACA" "AAAA" "AA8A" "AA6A" "AA4A" "AA2A" "AA0A" "A9EA" "A9CA" "A9AA" "A98A")
+   hx2 ("A96A" "A94A" "A92A" "A90A" "A8EA" "A8CA" "A8AA" "A88A" "A86A" "A84A" "A82A" "A80A" "A7EA" "A7CA" "A7AA" "A78A")
+   hx2 ("A76A" "A74A" "A72A" "A70A" "A6EA" "A6CA" "A6AA" "A68A" "A66A" "A64A" "A62A" "A60A" "A5EA" "A5CA" "A5AA" "A58A")
+   hx2 ("A56A" "A54A" "A52A" "A50A" "A4EA" "A4CA" "A4AA" "A48A" "A46A" "A44A" "A42A" "A40A" "A3EA" "A3CA" "A3AA" "A38A")
+   hx2 ("A36A" "A34A" "A32A" "A30A" "A2EA" "A2CA" "A2AA" "A28A" "A26A" "A24A" "A22A" "A20A" "A1EA" "A1CA" "A1AA" "A18A")
+   hx2 ("A16A" "A14A" "A12A" "A10A" "A0EA" "A0CA" "A0AA" "A08A" "A06A" "A04A" "A02A" "A00A" "9FEA" "9FCA" "9FAA" "9F8A")
+   hx2 ("9F6A" "9F4A" "9F2A" "9F0A" "9EEA" "9ECA" "9EAA" "9E8A" "9E6A" "9E4A" "9E2A" "9E0A" "9DEA" "9DCA" "9DAA" "9D8A")
+   hx2 ("9D6A" "9D4A" "9D2A" "9D0A" "9CEA" "9CCA" "9CAA" "9C8A" "9C6A" "9C4A" "9C2A" "9C0A" "9BEA" "9BCA" "9BAA" "9B8A")
+   hx2 ("9B6A" "9B4A" "9B2A" "9B0A" "9AEA" "9ACA" "9AAA" "9A8A" "9A6A" "9A4A" "9A2A" "9A0A" "99EA" "99CA" "99AA" "998A")
+   hx2 ("996A" "994A" "992A" "990A" "98EA" "98CA" "98AA" "988A" "986A" "984A" "982A" "980A" "97EA" "97CA" "97AA" "978A")
+   hx2 ("976A" "974A" "972A" "970A" "96EA" "96CA" "96AA" "968A" "966A" "964A" "962A" "960A" "95EA" "95CA" "95AA" "958A")
+   hx2 ("956A" "954A" "952A" "950A" "94EA" "94CA" "94AA" "948A" "946A" "944A" "942A" "940A" "93EA" "93CA" "93AA" "938A")
+   hx2 ("936A" "934A" "932A" "930A" "92EA" "92CA" "92AA" "928A" "926A" "924A" "922A" "920A" "91EA" "91CA" "91AA" "918A")
+   hx2 ("916A" "914A" "912A" "910A" "90EA" "90CA" "90AA" "908A" "906A" "904A" "902A" "900A" "8FEA" "8FCA" "8FAA" "8F8A")
+   hx2 ("8F6A" "8F4A" "8F2A" "8F0A" "8EEA" "8ECA" "8EAA" "8E8A" "8E6A" "8E4A" "8E2A" "8E0A" "8DEA" "8DCA" "8DAA" "8D8A")
+   hx2 ("8D6A" "8D4A" "8D2A" "8D0A" "8CEA" "8CCA" "8CAA" "8C8A" "8C6A" "8C4A" "8C2A" "8C0A" "8BEA" "8BCA" "8BAA" "8B8A")
+   hx2 ("8B6A" "8B4A" "8B2A" "8B0A" "8AEA" "8ACA" "8AAA" "8A8A" "8A6A" "8A4A" "8A2A" "8A0A" "89EA" "89CA" "89AA" "898A")
+   hx2 ("896A" "894A" "892A" "890A" "88EA" "88CA" "88AA" "888A" "886A" "884A" "882A" "880A" "87EA" "87CA" "87AA" "878A")
+   hx2 ("876A" "874A" "872A" "870A" "86EA" "86CA" "86AA" "868A" "866A" "864A" "862A" "860A" "85EA" "85CA" "85AA" "858A")
+   hx2 ("856A" "854A" "852A" "850A" "84EA" "84CA" "84AA" "848A" "846A" "844A" "842A" "840A" "83EA" "83CA" "83AA" "838A")
+   hx2 ("836A" "834A" "832A" "830A" "82EA" "82CA" "82AA" "828A" "826A" "824A" "822A" "820A" "81EA" "81CA" "81AA" "818A")
+   hx2 ("816A" "814A" "812A" "810A" "80EA" "80CA" "80AA" "808A" "806A" "804A" "802A" "800A" "7FEA" "7FCA" "7FAA" "7F8A")
+   hx2 ("7F6A" "7F4A" "7F2A" "7F0A" "7EEA" "7ECA" "7EAA" "7E8A" "7E6A" "7E4A" "7E2A" "7E0A" "7DEA" "7DCA" "7DAA" "7D8A")
+   hx2 ("7D6A" "7D4A" "7D2A" "7D0A" "7CEA" "7CCA" "7CAA" "7C8A" "7C6A" "7C4A" "7C2A" "7C0A" "7BEA" "7BCA" "7BAA" "7B8A")
+   hx2 ("7B6A" "7B4A" "7B2A" "7B0A" "7AEA" "7ACA" "7AAA" "7A8A" "7A6A" "7A4A" "7A2A" "7A0A" "79EA" "79CA" "79AA" "798A")
+   hx2 ("796A" "794A" "792A" "790A" "78EA" "78CA" "78AA" "788A" "786A" "784A" "782A" "780A" "77EA" "77CA" "77AA" "778A")
+   hx2 ("776A" "774A" "772A" "770A" "76EA" "76CA" "76AA" "768A" "766A" "764A" "762A" "760A" "75EA" "75CA" "75AA" "758A")
+   hx2 ("756A" "754A" "752A" "750A" "74EA" "74CA" "74AA" "748A" "746A" "744A" "742A" "740A" "73EA" "73CA" "73AA" "738A")
+   hx2 ("736A" "734A" "732A" "730A" "72EA" "72CA" "72AA" "728A" "726A" "724A" "722A" "720A" "71EA" "71CA" "71AA" "718A")
+   hx2 ("716A" "714A" "712A" "710A" "70EA" "70CA" "70AA" "708A" "706A" "704A" "702A" "700A" "6FEA" "6FCA" "6FAA" "6F8A")
+   hx2 ("6F6A" "6F4A" "6F2A" "6F0A" "6EEA" "6ECA" "6EAA" "6E8A" "6E6A" "6E4A" "6E2A" "6E0A" "6DEA" "6DCA" "6DAA" "6D8A")
+   hx2 ("6D6A" "6D4A" "6D2A" "6D0A" "6CEA" "6CCA" "6CAA" "6C8A" "6C6A" "6C4A" "6C2A" "6C0A" "6BEA" "6BCA" "6BAA" "6B8A")
+   hx2 ("6B6A" "6B4A" "6B2A" "6B0A" "6AEA" "6ACA" "6AAA" "6A8A" "6A6A" "6A4A" "6A2A" "6A0A" "69EA" "60F0" "6368" "6348")
+   hx2 ("696A" "694A" "692A" "690A" "68EA" "68CA" "68AA" "688A" "686A" "684A" "682A" "680A" "67EA" "67CA" "67AA" "678A")
+   hx2 ("676A" "674A" "672A" "670A" "66EA" "66CA" "66AA" "668A" "666A" "664A" "662A" "660A" "65EA" "65CA" "65AA" "658A")
+   hx2 ("656A" "654A" "652A" "650A" "6B26" "6DE1" "6E9C" "5E48" "5E28" "5E08" "5DE8" "5DC8" "5DA8" "5D88" "5D68" "5D48")
+   hx2 ("5D28" "5D08" "5CE8" "5CC8" "5CA8" "5C88" "5C68" "5C48" "5C28" "5C08" "5BE8" "5BC8" "5BA8" "5B88" "5B68" "5B48")
+   hx2 ("5B28" "5B08" "5AE8" "5AC8" "5AA8" "5A88" "5A68" "5A48" "5A28" "5A08" "59E8" "59C8" "59A8" "5988" "5968" "5948")
+   hx2 ("5928" "5908" "58E8" "58C8" "58A8" "5888" "5868" "5848" "5828" "5808" "57E8" "57C8" "57A8" "5788" "5768" "5748")
+   hx2 ("5D6A" "5D4A" "5D2A" "5D0A" "5CEA" "5CCA" "5CAA" "5C8A" "5C6A" "5C4A" "5C2A" "5C0A" "5BEA" "5BCA" "5BAA" "5B8A")
+   hx2 ("5B6A" "5B4A" "5B2A" "5B0A" "5AEA" "5ACA" "5AAA" "5A8A" "5A6A" "5A4A" "5A2A" "5A0A" "59EA" "59CA" "59AA" "598A")
+   hx2 ("596A" "594A" "592A" "590A" "58EA" "58CA" "58AA" "588A" "586A" "584A" "582A" "580A" "57EA" "57CA" "57AA" "578A")
+   hx2 ("576A" "574A" "572A" "570A" "56EA" "56CA" "56AA" "568A" "566A" "564A" "562A" "560A" "55EA" "55CA" "55AA" "558A")
+   hx2 ("556A" "554A" "552A" "550A" "54EA" "54CA" "54AA" "548A" "546A" "544A" "542A" "540A" "53EA" "53CA" "53AA" "538A")
+   hx2 ("536A" "534A" "532A" "530A" "52EA" "52CA" "52AA" "528A" "526A" "524A" "522A" "520A" "51EA" "51CA" "51AA" "518A")
+   hx2 ("516A" "514A" "512A" "510A" "50EA" "50CA" "50AA" "508A" "506A" "504A" "502A" "500A" "4FEA" "4FCA" "4FAA" "4F8A")
+   hx2 ("4F6A" "4F4A" "4F2A" "4F0A" "4EEA" "4ECA" "4EAA" "4E8A" "4E6A" "4E4A" "4E2A" "4E0A" "4DEA" "4DCA" "4DAA" "4D8A")
+   hx2 ("4D6A" "4D4A" "4D2A" "4D0A" "4CEA" "4CCA" "4CAA" "4C8A" "4C6A" "4C4A" "4C2A" "4C0A" "4BEA" "4BCA" "4BAA" "4B8A")
+   hx2 ("4B6A" "4B4A" "4B2A" "4B0A" "4AEA" "4ACA" "4AAA" "4A8A" "4A6A" "4A4A" "4A2A" "4A0A" "49EA" "49CA" "49AA" "498A")
+   hx2 ("496A" "494A" "492A" "490A" "48EA" "48CA" "48AA" "488A" "486A" "484A" "482A" "480A" "47EA" "47CA" "47AA" "478A")
+   hx2 ("476A" "474A" "472A" "470A" "46EA" "46CA" "46AA" "468A" "466A" "464A" "462A" "460A" "45EA" "45CA" "45AA" "458A")
+   hx2 ("456A" "454A" "452A" "450A" "44EA" "44CA" "44AA" "448A" "446A" "444A" "442A" "440A" "43EA" "43CA" "43AA" "438A")
+   hx2 ("436A" "434A" "432A" "430A" "42EA" "42CA" "42AA" "428A" "426A" "424A" "422A" "420A" "41EA" "41CA" "41AA" "418A")
+   hx2 ("416A" "414A" "412A" "410A" "40EA" "40CA" "40AA" "408A" "406A" "404A" "402A" "400A" "3FEA" "3FCA" "3FAA" "3F8A")
+   hx2 ("3F6A" "3F4A" "3F2A" "3F0A" "3EEA" "3ECA" "3EAA" "3E8A" "3E6A" "3E4A" "3E2A" "3E0A" "3DEA" "3DCA" "3DAA" "3D8A")
+   hx2 ("3D6A" "3D4A" "3D2A" "3D0A" "3CEA" "3CCA" "3CAA" "3C8A" "3C6A" "3C4A" "3C2A" "3C0A" "3BEA" "3BCA" "3BAA" "3B8A")
+   hx2 ("3B6A" "3B4A" "3B2A" "3B0A" "3AEA" "3ACA" "3AAA" "3A8A" "3A6A" "3A4A" "3A2A" "3A0A" "39EA" "39CA" "39AA" "398A")
+   hx2 ("396A" "394A" "392A" "390A" "38EA" "38CA" "38AA" "388A" "386A" "384A" "382A" "380A" "37EA" "37CA" "37AA" "378A")
+   hx2 ("376A" "374A" "372A" "370A" "36EA" "36CA" "36AA" "368A" "366A" "364A" "362A" "360A" "35EA" "35CA" "35AA" "358A")
+   hx2 ("356A" "354A" "352A" "350A" "34EA" "34CA" "34AA" "348A" "346A" "344A" "342A" "340A" "33EA" "33CA" "33AA" "338A")
+   hx2 ("336A" "334A" "332A" "330A" "32EA" "32CA" "32AA" "328A" "326A" "324A" "322A" "320A" "31EA" "28F2" "2B68" "2B48")
+   hx2 ("3C2B" "3C0B" "3BEB" "3BCB" "3BAB" "3B8B" "3B6B" "3B4B" "3B2B" "3B0B" "3AEB" "3ACB" "3AAB" "3A8B" "3A6B" "3A4B")
+   hx2 ("3A2B" "3A0B" "39EB" "39CB" "39AB" "398B" "396B" "394B" "392B" "390B" "38EB" "38CB" "38AB" "388B" "386B" "384B")
+   hx2 ("382B" "380B" "37EB" "37CB" "37AB" "378B" "376B" "374B" "372B" "370B" "36EB" "36CB" "36AB" "368B" "366B" "364B")
+   hx2 ("362B" "360B" "35EB" "35CB" "35AB" "358B" "356B" "354B" "352B" "350B" "34EB" "34CB" "34AB" "348B" "346B" "344B")
+   hx2 ("344B" "342B" "340B" "33EB" "33CB" "33AB" "338B" "336B" "334B" "332B" "330B" "32EB" "32CB" "32AB" "328B" "326B")
+   hx2 ("324B" "322B" "320B" "31EB" "31CB" "31AB" "318B" "316B" "314B" "312B" "310B" "30EB" "30CB" "30AB" "308B" "306B")
+   hx2 ("304B" "302B" "300B" "2FEB" "2FCB" "2FAB" "2F8B" "2F6B" "2F4B" "2F2B" "2F0B" "2EEB" "2ECB" "2EAB" "2E8B" "2E6B")
+   hx2 ("2E4B" "2E2B" "2E0B" "2DEB" "2DCB" "2DAB" "2D8B" "2D6B" "2D4B" "2D2B" "2D0B" "2CEB" "2CCB" "2CAB" "2C8B" "2C6B")
+   hx2 ("2C4B" "2C2B" "2C0B" "2BEB" "2BCB" "2BAB" "2B8B" "2B6B" "2B4B" "2B2B" "2B0B" "2AEB" "2ACB" "2AAB" "2A8B" "2A6B")
+   hx2 ("2A4B" "2A2B" "2A0B" "29EB" "29CB" "29AB" "298B" "296B" "294B" "292B" "290B" "28EB" "28CB" "28AB" "288B" "286B")
+   hx2 ("284B" "282B" "280B" "27EB" "27CB" "27AB" "278B" "276B" "274B" "272B" "270B" "26EB" "26CB" "26AB" "268B" "266B")
+   hx2 ("264B" "262B" "260B" "25EB" "25CB" "25AB" "258B" "256B" "254B" "252B" "250B" "24EB" "24CB" "24AB" "248B" "246B")
+   hx2 ("244B" "242B" "240B" "23EB" "23CB" "23AB" "238B" "236B" "234B" "232B" "230B" "22EB" "22CB" "22AB" "228B" "226B")
+   hx2 ("224B" "222B" "220B" "21EB" "21CB" "21AB" "218B" "216B" "214B" "212B" "210B" "20EB" "20CB" "20AB" "208B" "206B")
+   hx2 ("204B" "202B" "200B" "1FEB" "1FCB" "1FAB" "1F8B" "1F6B" "1F4B" "1F2B" "1F0B" "1EEB" "1ECB" "1EAB" "1E8B" "1E6B")
+   hx2 ("1E4B" "1E2B" "1E0B" "1DEB" "1DCB" "1DAB" "1D8B" "1D6B" "1D4B" "1D2B" "1D0B" "1CEB" "1CCB" "1CAB" "1C8B" "1C6B")
+   hx2 ("1C4B" "1C2B" "1C0B" "1BEB" "1BCB" "1BAB" "1B8B" "1B6B" "106A" "104A" "102A" "100A" "FEA" "FCA" "FAA" "F8A")
+   hx2 ("F6A" "668" "8E8" "8C8" "8A8" "888" "868" "848" "7D7" "194B" "7B6" "D1C" "CFC" "CB2" "CA9" "C9C")
+   hx2 ("C7C" "C5C" "C3C" "C1C" "BFC" "BDC" "BBC" "B9C" "B7C" "B5E" "B2C" "B1C" "AB8" "ADC" "A9C" "2C2")
+   hx2 ("528" "166B" "1667" "3FF" "9FC" "9DC" "9BC" "659" "BB8" "15A7" "FC6" "1C0" "1B1" "9CB" "82C" "1285")
+
+: CaseData
+   hx2 ("3001" "3082" "3001" "3082" "3001" "3082" "3001" "3082" "3001" "3082" "3001" "3082" "3001" "3082" "3001" "3082")
+   hx2 ("3001" "3082" "3001" "3082" "3001" "3082" "3E80" "3E80" "3001" "3082" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80")
+   hx2 ("3A85" "3A85" "3E80" "3E80" "3E80" "3A85" "3A85" "3A85" "3E80" "3E80" "3E80" "3A85" "3A85" "3A85" "3A85" "3A85")
+   hx2 ("3A85" "3A85" "3A85" "3E80" "3A85" "3A85" "3A85" "3E80" "3E80" "3E80" "3E80" "5B88" "5B88" "3E80" "3A85" "3A85")
+   hx2 ("3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3E80" "3A85" "3A85" "3A85" "3E80" "3A85" "3A85" "3A85" "3A85" "3A85")
+   hx2 ("3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85")
+   hx2 ("3A85" "3A85" "3E80" "3E80" "3E80" "3E80" "5198" "3E80" "3E80" "3E80" "3E80" "4606" "3E80" "3E80" "3A85" "3A85")
+   hx2 ("3A85" "3A85" "3A85" "3A85" "3E80" "3E80" "3E80" "3E80" "3A85" "3A85" "3E80" "3E80" "3A85" "3A85" "3A85" "3A85")
+   hx2 ("3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85")
+   hx2 ("3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80")
+   hx2 ("3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80")
+   hx2 ("3E80" "3E80" "5405" "5405" "5405" "5405" "5405" "5405" "5405" "5405" "5405" "5405" "5405" "5405" "3E80" "3E80")
+   hx2 ("3E80" "3E80" "5202" "5202" "5202" "5202" "5202" "5202" "5202" "5202" "5202" "5202" "5202" "5202" "5202" "5202")
+   hx2 ("5202" "5202" "5202" "5202" "5202" "5202" "5202" "5202" "5202" "5202" "5202" "5202" "5202" "5202" "5202" "5202")
+   hx2 ("5202" "2E82" "3E80" "5198" "2A14" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "4606" "4606" "4606" "4606" "4606")
+   hx2 ("4606" "4606" "4606" "4606" "4606" "4606" "4606" "4606" "4606" "4606" "4686" "4606" "4606" "4606" "4606" "4606")
+   hx2 ("4606" "4606" "4606" "4606" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80")
+   hx2 ("3E80" "3E80" "3E80" "3E80" "3E80" "1A1B" "1A1B" "3E80" "3E80" "3E80" "3E80" "4584" "3E80" "3E80" "3E80" "298")
+   hx2 ("3E80" "298" "6615" "6696" "298" "1A97" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85")
+   hx2 ("4584" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85")
+   hx2 ("3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "4584")
+   hx2 ("4584" "1A1B" "1A1B" "1A1B" "1A1B" "1A1B" "1A1B" "1A1B" "1A1B" "1A1B" "1A1B" "1A1B" "1A1B" "1A1B" "1A1B" "4584")
+   hx2 ("4584" "1A1B" "1A1B" "1A1B" "1A1B" "1A1B" "1A1B" "1A1B" "1A1B" "1A1B" "1A1B" "1A1B" "1A1B" "1A1B" "1A1B" "2E82")
+   hx2 ("7282" "2E82" "3E80" "2E82" "4902" "7481" "7481" "7481" "7481" "7383" "1A1B" "1A1B" "1A1B" "6D82" "6D82" "4902")
+   hx2 ("4902" "3E80" "3E80" "2E82" "4902" "6E01" "6E01" "7501" "7501" "3E80" "1A1B" "1A1B" "1A1B" "1B02" "1B82" "1C02")
+   hx2 ("1C82" "1D02" "1D82" "1E02" "1E82" "1F02" "1F82" "2002" "2082" "2102" "2182" "2202" "2282" "2302" "2382" "2402")
+   hx2 ("2482" "2502" "2582" "2602" "2682" "2702" "2782" "455" "C99" "4D6" "C99" "F" "F" "F" "F" "F")
+   hx2 ("10F" "F" "F" "F" "F" "F" "F" "F" "F" "F" "F" "F" "F" "F" "F" "F")
+   hx2 ("F" "F" "F" "F" "F" "F" "F" "F" "F" "F" "F" "8F" "10F" "8F" "18F" "10F")
+   hx2 ("F" "F" "F" "F" "F" "F" "F" "F" "F" "F" "F" "F" "F" "F" "10F" "10F")
+   hx2 ("10F" "8F" "20C" "298" "298" "318" "39A" "318" "298" "298" "455" "4D6" "298" "519" "598" "614")
+   hx2 ("598" "698" "709" "789" "809" "889" "909" "989" "A09" "A89" "B09" "B89" "598" "298" "C59" "C99")
+   hx2 ("C59" "298" "D01" "D81" "E01" "E81" "F01" "F81" "1001" "1081" "1101" "1181" "1201" "1281" "1301" "1381")
+   hx2 ("1401" "1481" "1501" "1581" "1601" "1681" "1701" "1781" "1801" "1881" "1901" "1981" "455" "298" "4D6" "1A1B")
+   hx2 ("1A97" "298" "298" "298" "C99" "455" "4D6" "3E80" "298" "298" "298" "298" "298" "298" "3E80" "3E80")
+   hx2 ("3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80")
+   hx2 ("282C" "298" "39A" "39A" "39A" "39A" "289C" "289C" "1A1B" "289C" "2902" "29DD" "C99" "2A14" "289C" "1A1B")
+   hx2 ("2A9C" "519" "2B0B" "2B8B" "1A1B" "2C02" "289C" "298" "1A1B" "2C8B" "2902" "2D5E" "2D8B" "2D8B" "2D8B" "298")
+   hx2 ("298" "519" "614" "C99" "C99" "C99" "3E80" "298" "39A" "318" "298" "3E80" "3E80" "3E80" "3E80" "5405")
+   hx2 ("5405" "5405" "3E80" "5405" "3E80" "5405" "5405" "5405" "5405" "5405" "5405" "5405" "5405" "5405" "5405" "5405")
+   hx2 ("5405" "5405" "3E80" "3E80" "3E80" "4606" "4606" "4606" "4606" "4606" "4606" "4606" "4606" "4606" "4606" "4606")
+   hx2 ("4606" "4606" "4606" "4606" "4606" "4606" "4606" "4606" "4606" "4606" "4606" "4606" "4606" "4606" "4606" "4606")
+   hx2 ("4606" "4606" "4606" "4606" "4606" "3E80" "501C" "501C" "4F81" "4F81" "4F81" "4F81" "4F81" "4F81" "4F81" "4F81")
+   hx2 ("4F81" "4F81" "4F81" "4F81" "4F81" "4F81" "4F81" "4F81" "2E01" "2E01" "2E01" "2E01" "2E01" "2E01" "2E01" "2E01")
+   hx2 ("2E01" "2E01" "2E01" "2E01" "2E01" "2E01" "2E01" "2E01" "2E01" "2E01" "2E01" "2E01" "2E01" "2E01" "2E01" "C99")
+   hx2 ("2E01" "2E01" "2E01" "2E01" "2E01" "2E01" "2E01" "2E82" "2E82" "2E82" "4902" "4902" "2E82" "2E82" "3E80" "3E80")
+   hx2 ("3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "2E82" "2E82" "2E82" "2E82" "2E82" "3E80")
+   hx2 ("3E80" "3E80" "3E80" "3E80" "5305" "4606" "5305" "5305" "3E80" "5305" "5305" "3E80" "5305" "5305" "5305" "5305")
+   hx2 ("5305" "5305" "5305" "5305" "5305" "5305" "5405" "5405" "5405" "5405" "5405" "5405" "5405" "5405" "5405" "5405")
+   hx2 ("5405" "5405" "5405" "5405" "5405" "5405" "5405" "5405" "5405" "5405" "5398" "5405" "4606" "4606" "4606" "4606")
+   hx2 ("4606" "4606" "4606" "5087" "5087" "4606" "5087" "5087" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80")
+   hx2 ("3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80")
+   hx2 ("3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "2D8B" "2D8B" "2D8B" "2D8B" "2D8B" "2D8B" "2D8B" "2D8B")
+   hx2 ("2D8B" "2D8B" "2D8B" "2D8B" "840B" "3082" "3001" "3082" "3001" "3082" "3001" "3082" "3001" "3082" "2E82" "3001")
+   hx2 ("3082" "3001" "3082" "3001" "3082" "3001" "3082" "3001" "3082" "3001" "3082" "3001" "3082" "3001" "3082" "3001")
+   hx2 ("3082" "3001" "3082" "3001" "3082" "3001" "3082" "3001" "3082" "3001" "3082" "3001" "3082" "3001" "3082" "3E80")
+   hx2 ("3E80" "3E80" "3E80" "3E80" "3E80" "5C09" "5C89" "5D09" "5D89" "5E09" "5E89" "5F09" "5F89" "6009" "6089" "4606")
+   hx2 ("4606" "3A85" "3A85" "3A85" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "1A1B")
+   hx2 ("1A1B" "4701" "298" "4781" "4781" "4781" "3E80" "4801" "3E80" "4881" "4881" "4902" "2E01" "2E01" "2E01" "2E01")
+   hx2 ("2E01" "2E01" "2E01" "2E01" "2E01" "2E01" "2E01" "2E01" "2E01" "2E01" "2E01" "2E01" "2F02" "2F02" "2F02" "2F02")
+   hx2 ("2F02" "2F02" "2F02" "2F02" "2F02" "2F02" "2F02" "2F02" "2F02" "2F02" "2F02" "2F02" "2F02" "2F02" "2F02" "2F02")
+   hx2 ("2F02" "2F02" "2F02" "C99" "2F02" "2F02" "2F02" "2F02" "2F02" "2F02" "2F02" "2F82" "2F02" "2F02" "4A82" "2F02")
+   hx2 ("2F02" "2F02" "2F02" "2F02" "2F02" "2F02" "2F02" "2F02" "4B02" "4B82" "4B82" "3E80" "4C02" "4C82" "4D01" "4D01")
+   hx2 ("4D01" "4D82" "4E02" "2902" "3E80" "3E80" "3001" "3082" "3001" "3082" "3001" "3082" "3001" "3082" "3001" "3082")
+   hx2 ("3001" "3082" "3001" "3082" "3001" "3082" "2E82" "3B81" "3C03" "3C82" "3001" "3082" "3D81" "3E01" "3001" "3082")
+   hx2 ("3001" "3082" "3001" "3082" "3001" "3082" "3001" "3082" "3001" "3082" "3001" "3082" "3001" "3082" "3101" "3182")
+   hx2 ("3001" "3082" "3001" "3082" "3001" "3082" "2902" "3001" "3082" "3001" "3082" "3001" "3082" "3001" "3082" "3001")
+   hx2 ("3082" "3001" "3082" "3001" "3082" "3001" "3082" "4E82" "4F02" "3D02" "2902" "3E80" "3E80" "3E80" "3E80" "3E80")
+   hx2 ("3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "5B10" "5B10" "5B10" "5B10" "5B10" "5B10" "7F0B" "3E80" "3E80")
+   hx2 ("3E80" "7F8B" "800B" "808B" "810B" "818B" "820B" "519" "519" "C99" "455" "4D6" "2902" "3301" "3001" "3082")
+   hx2 ("3001" "3082" "3381" "3001" "3082" "3401" "3401" "3001" "3082" "2902" "3481" "3501" "3581" "3001" "3082" "3401")
+   hx2 ("3601" "3682" "3701" "3781" "3001" "3082" "2902" "2902" "3701" "3801" "2902" "3881" "3A85" "3A85" "3A85" "3A85")
+   hx2 ("3B81" "3C03" "3C82" "3B81" "3C03" "3C82" "3B81" "3C03" "3C82" "3001" "3082" "3001" "3082" "3001" "3082" "3001")
+   hx2 ("3082" "3001" "3082" "3001" "3082" "3001" "3082" "3001" "3082" "3D02" "3001" "3082" "501C" "4606" "4606" "4606")
+   hx2 ("4606" "3E80" "5087" "5087" "3E80" "3E80" "3001" "3082" "3001" "3082" "3001" "3082" "3001" "3082" "3001" "3082")
+   hx2 ("3001" "3082" "3001" "3082" "3001" "3082" "3001" "3082" "3001" "3082" "3001" "3082" "3001" "3082" "3201" "3001")
+   hx2 ("3082" "3001" "3082" "3001" "3082" "3282" "3001" "3082" "3001" "3082" "3001" "3082" "3901" "3001" "3082" "3901")
+   hx2 ("2902" "2902" "3001" "3082" "3901" "3001" "3082" "3981" "3981" "3001" "3082" "3001" "3082" "3A01" "3001" "3082")
+   hx2 ("2902" "3A85" "3001" "3082" "2902" "3B02" "4D01" "3001" "3082" "3001" "3082" "3E80" "3E80" "3001" "3082" "3E80")
+   hx2 ("3E80" "3001" "3082" "3E80" "3E80" "3E80" "3001" "3082" "3001" "3082" "3001" "3082" "3001" "3082" "3001" "3082")
+   hx2 ("3001" "3082" "3001" "3082" "3001" "3082" "3001" "3082" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80")
+   hx2 ("3E80" "3E80" "3E80" "3E80" "598" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80")
+   hx2 ("3E80" "3E80" "3E80" "5398" "3E80" "3E80" "3E80" "5398" "5398" "5398" "5398" "5398" "5398" "5398" "5398" "5398")
+   hx2 ("5398" "5398" "5398" "5398" "5398" "3E80" "5B10" "5405" "4606" "5405" "5405" "5405" "5405" "5405" "5405" "5405")
+   hx2 ("5405" "5405" "5405" "5405" "5405" "5405" "5405" "5405" "5405" "5405" "5405" "5405" "5405" "5405" "5405" "5405")
+   hx2 ("5405" "5405" "5405" "5405" "5405" "5405" "3E80" "3E80" "5B10" "4D01" "4D01" "4D01" "4D01" "4D01" "4D01" "4D01")
+   hx2 ("4D01" "4D01" "4D01" "4D01" "4D01" "4D01" "4D01" "4D01" "4D01" "4D01" "4D01" "4D01" "4D01" "4D01" "4D01" "4D01")
+   hx2 ("4D01" "4D01" "4D01" "4D01" "4D01" "4D01" "4D01" "4D01" "4D01" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80")
+   hx2 ("3E80" "3E80" "3E80" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85")
+   hx2 ("3A85" "3A85" "3A85" "3A85" "3A85" "3E80" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3E80")
+   hx2 ("3A85" "3E80" "3E80" "3E80" "3E80" "3E80" "5C09" "5C89" "5D09" "5D89" "5E09" "5E89" "5F09" "5F89" "6009" "6089")
+   hx2 ("3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80")
+   hx2 ("3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "2902" "2902" "2902" "3F02" "3F82" "2902" "4002" "4002" "2902" "4082")
+   hx2 ("2902" "4102" "2902" "2902" "2902" "2902" "4002" "2902" "2902" "4182" "2902" "2902" "2902" "2902" "4202" "4282")
+   hx2 ("2902" "2902" "2902" "2902" "2902" "4282" "2902" "2902" "4302" "2902" "2902" "4382" "2902" "2902" "2902" "2902")
+   hx2 ("2902" "2902" "2902" "2902" "2902" "2902" "4402" "2902" "2902" "4402" "2902" "2902" "2902" "2902" "4402" "2902")
+   hx2 ("4482" "4482" "2902" "2902" "2902" "2902" "2902" "2902" "4502" "2902" "2902" "2902" "2902" "2902" "2902" "2902")
+   hx2 ("2902" "2902" "2902" "2902" "2902" "2902" "2902" "3E80" "3E80" "4584" "4584" "4584" "4584" "4584" "4584" "4584")
+   hx2 ("4584" "4584" "1A1B" "1A1B" "4584" "4584" "4584" "4584" "4584" "1A1B" "1A1B" "1A1B" "1A1B" "1A1B" "1A1B" "1A1B")
+   hx2 ("1A1B" "1A1B" "4584" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80")
+   hx2 ("3E80" "3E80" "3E80" "3E80" "5101" "5101" "5101" "5101" "5101" "5101" "5101" "5101" "5101" "5101" "5101" "5101")
+   hx2 ("5101" "5101" "5101" "5101" "5101" "5101" "5101" "5101" "5101" "5101" "5101" "3E80" "3E80" "4584" "5198" "5198")
+   hx2 ("5198" "5198" "5198" "5198" "2E01" "2E01" "3E80" "2E01" "2E01" "2E01" "2E01" "2E01" "2E01" "2E01" "2E01" "2E01")
+   hx2 ("4982" "4A02" "4A02" "4A02" "4902" "2F02" "2F02" "2F02" "2F02" "2F02" "2F02" "2F02" "2F02" "2F02" "2F02" "2F02")
+   hx2 ("2F02" "2F02" "2F02" "2F02" "2F02" "4F02" "4F02" "4F02" "4F02" "4F02" "4F02" "4F02" "4F02" "4F02" "4F02" "4F02")
+   hx2 ("4F02" "4F02" "4F02" "4F02" "4F02" "4606" "4606" "4606" "4606" "4606" "5198" "4606" "4606" "3A85" "3A85" "3A85")
+   hx2 ("3A85" "3E80" "3E80" "3E80" "3E80" "4606" "4606" "4606" "4606" "4606" "4606" "4606" "4606" "3E80" "4606" "4606")
+   hx2 ("4606" "4606" "4606" "4606" "4606" "4606" "4606" "4606" "4606" "4606" "4606" "4606" "4606" "4606" "4606" "4606")
+   hx2 ("4606" "4606" "4606" "4606" "4606" "3E80" "4606" "4606" "4606" "5298" "4606" "4606" "5298" "4606" "3E80" "3E80")
+   hx2 ("3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "5305" "5305" "5305" "5305" "5305" "5305" "5305")
+   hx2 ("5305" "5305" "5305" "5305" "5305" "5305" "5305" "5305" "5305" "3E80" "3E80" "3E80" "3E80" "3E80" "5305" "5305")
+   hx2 ("5305" "5298" "5298" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "5C89" "5D09")
+   hx2 ("5D89" "5E09" "5E89" "5F09" "5F89" "6009" "6089" "640B" "648B" "650B" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80")
+   hx2 ("3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "4606" "5B88" "3E80" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85")
+   hx2 ("3E80" "3E80" "3E80" "3A85" "3A85" "3A85" "3E80" "3A85" "3A85" "3A85" "3A85" "3E80" "3E80" "3E80" "3A85" "3A85")
+   hx2 ("3E80" "3A85" "3E80" "3A85" "3A85" "3A85" "3A85" "3E80" "3E80" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85")
+   hx2 ("3E80" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3E80" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85")
+   hx2 ("3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3E80" "3E80" "3E80" "3E80")
+   hx2 ("3E80" "3E80" "4606" "4606" "4606" "4606" "4606" "4606" "4606" "4606" "4606" "4606" "4606" "4606" "4606" "4606")
+   hx2 ("5B88" "5B88" "5B88" "5B88" "3E80" "4606" "4606" "4606" "3E80" "4606" "4606" "4606" "4606" "3E80" "3E80" "3E80")
+   hx2 ("3E80" "3E80" "3E80" "3E80" "4606" "4606" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "4606")
+   hx2 ("5B88" "5B88" "3E80" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3E80" "3E80" "3A85" "3A85" "3E80")
+   hx2 ("3E80" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3E80" "3E80")
+   hx2 ("3E80" "3E80" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85")
+   hx2 ("3A85" "3E80" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85")
+   hx2 ("3A85" "3A85" "3E80" "3E80" "3E80" "3E80" "5B88" "5B88" "3E80" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85")
+   hx2 ("3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3E80" "3E80" "3E80" "3A85" "3A85")
+   hx2 ("3A85" "3A85" "3A85" "3A85" "3E80" "3E80" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3E80" "3E80" "3A85" "3A85")
+   hx2 ("3A85" "3A85" "3A85" "3A85" "3E80" "3E80" "3A85" "3A85" "3A85" "3E80" "3E80" "3E80" "3E80" "5C09" "5C89" "5D09")
+   hx2 ("5D89" "5E09" "5E89" "5F09" "5F89" "6009" "6089" "501C" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80")
+   hx2 ("3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "5509" "5589" "5609" "5689" "5709" "5789" "5809" "5889" "5909")
+   hx2 ("5989" "318" "5A18" "5A18" "5398" "3E80" "3E80" "4606" "5405" "5405" "5405" "5405" "5405" "5405" "5405" "5405")
+   hx2 ("5405" "5405" "5405" "5405" "5405" "5405" "5405" "5405" "3E80" "3E80" "5405" "5405" "5405" "5405" "5405" "5405")
+   hx2 ("5405" "5405" "5405" "5405" "5405" "5405" "5405" "5405" "5405" "5405" "5405" "5405" "5405" "5405" "5405" "5405")
+   hx2 ("5405" "5405" "5405" "5405" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80")
+   hx2 ("3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "5405" "5405" "5405" "5405")
+   hx2 ("5405" "5405" "5405" "5405" "5405" "5405" "5405" "5405" "5405" "5405" "5405" "5405" "5405" "5405" "5405" "5405")
+   hx2 ("5405" "5405" "5405" "5405" "5405" "5405" "5405" "5405" "5405" "5405" "5405" "5405" "6615" "6696" "5484" "5405")
+   hx2 ("5405" "5405" "5405" "5405" "5405" "5405" "5405" "5405" "5405" "4606" "4606" "4606" "4606" "4606" "4606" "4606")
+   hx2 ("4606" "4606" "4606" "4606" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80")
+   hx2 ("3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "5B88" "5B88" "5198" "3E80" "3E80" "3E80" "3E80")
+   hx2 ("3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "4606" "4606" "5B88" "3E80" "3A85" "3A85" "3A85" "3A85" "3A85")
+   hx2 ("3A85" "3A85" "3E80" "3A85" "3E80" "3A85" "3A85" "3A85" "3E80" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85")
+   hx2 ("3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "5198" "5198" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85")
+   hx2 ("3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "4606" "4606" "4606" "4606" "4606" "5484" "5484")
+   hx2 ("4606" "4606" "289C" "4606" "4606" "4606" "4606" "3E80" "3E80" "709" "789" "809" "889" "909" "989" "A09")
+   hx2 ("A89" "B09" "B89" "5405" "5405" "5405" "5A9C" "5A9C" "3E80" "3A85" "3A85" "3A85" "3E80" "3A85" "3E80" "3A85")
+   hx2 ("3E80" "3E80" "3A85" "3A85" "3E80" "3A85" "3A85" "3A85" "3A85" "4606" "3A85" "3A85" "4606" "4606" "4606" "4606")
+   hx2 ("4606" "4606" "3E80" "4606" "4606" "3A85" "3E80" "3E80" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85")
+   hx2 ("3A85" "3E80" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3E80" "3A85" "3A85" "3A85")
+   hx2 ("3A85" "3A85" "3E80" "3E80" "3E80" "3E80" "4606" "4606" "5B88" "3E80" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85")
+   hx2 ("3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85")
+   hx2 ("3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3E80" "3E80" "4606" "3A85" "5B88" "5B88")
+   hx2 ("5B88" "5B88" "5B88" "3E80" "4606" "5B88" "5B88" "3E80" "5B88" "5B88" "4606" "4606" "3E80" "3E80" "3E80" "3E80")
+   hx2 ("3E80" "3E80" "3E80" "5B88" "5B88" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3A85" "3E80" "5198" "5198")
+   hx2 ("5198" "5198" "5198" "5198" "5198" "5198" "5C89" "5D09" "5D89" "5E09" "5E89" "5F09" "5F89" "6009" "6089" "640B")
+   hx2 ("670B" "678B" "680B" "688B" "690B" "698B" "6A0B" "6A8B" "648B" "6B0B" "3E80" "3E80" "3E80" "3A85" "3A85" "3A85")
+   hx2 ("3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3E80" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3E80" "3A85")
+   hx2 ("3A85" "3E80" "3E80" "3A85" "3A85" "3A85" "3A85" "3E80" "3E80" "4606" "3A85" "5B88" "4606" "4606" "4606" "4606")
+   hx2 ("4606" "4606" "4606" "4606" "5B88" "5B88" "5B88" "5B88" "4606" "3E80" "3E80" "3A85" "4606" "4606" "4606" "4606")
+   hx2 ("3E80" "3E80" "3E80" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3E80" "3A85" "3A85" "3A85")
+   hx2 ("3A85" "3A85" "3A85" "3A85" "3E80" "3A85" "3E80" "3E80" "3E80" "3A85" "3A85" "3A85" "3A85" "3E80" "3E80" "4606")
+   hx2 ("3E80" "5B88" "5B88" "5B88" "3E80" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3E80" "3A85" "3A85")
+   hx2 ("3A85" "3E80" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85")
+   hx2 ("3A85" "3E80" "3A85" "3E80" "3A85" "3A85" "3A85" "3A85" "3E80" "3E80" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85")
+   hx2 ("3A85" "3E80" "3A85" "3E80" "3A85" "3A85" "3A85" "3A85" "3E80" "3E80" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85")
+   hx2 ("3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "4606" "3A85" "3A85" "4606" "4606")
+   hx2 ("4606" "4606" "4606" "4606" "4606" "3E80" "3E80" "3E80" "3E80" "39A" "39A" "39A" "39A" "39A" "39A" "39A")
+   hx2 ("39A" "39A" "39A" "39A" "39A" "39A" "39A" "39A" "39A" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80")
+   hx2 ("3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3A85" "3A85" "4606" "4606" "5198" "5198" "5C09")
+   hx2 ("5C89" "5D09" "5D89" "5E09" "5E89" "5F09" "5F89" "6009" "6089" "5198" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80")
+   hx2 ("3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "298" "298" "318" "39A" "318" "298" "298")
+   hx2 ("6615" "6696" "298" "519" "598" "614" "598" "698" "709" "789" "809" "889" "909" "989" "A09" "A89")
+   hx2 ("B09" "B89" "598" "298" "C99" "C99" "C99" "298" "298" "298" "298" "298" "298" "2A14" "298" "298")
+   hx2 ("298" "298" "5B10" "5B10" "5B10" "5B10" "3E80" "5C09" "5C89" "5D09" "5D89" "5E09" "5E89" "5F09" "5F89" "6009")
+   hx2 ("6089" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85")
+   hx2 ("3E80" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3E80" "3A85" "3A85" "3A85" "3A85")
+   hx2 ("3A85" "3E80" "3E80" "3E80" "3E80" "5B88" "4606" "4606" "4606" "4606" "3E80" "3E80" "5B88" "5B88" "3E80" "3E80")
+   hx2 ("5B88" "5B88" "4606" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "5B88" "3E80" "3E80" "3E80")
+   hx2 ("3E80" "3A85" "3A85" "3E80" "3A85" "3E80" "3E80" "3A85" "3A85" "3E80" "3A85" "3E80" "3E80" "3A85" "3E80" "3E80")
+   hx2 ("3E80" "3E80" "3E80" "3E80" "3A85" "3A85" "3A85" "3A85" "3E80" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85")
+   hx2 ("3A85" "3A85" "3E80" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3E80" "3A85" "3A85" "3E80" "3A85" "3A85")
+   hx2 ("3E80" "3A85" "3A85" "3E80" "3E80" "4606" "3E80" "5B88" "5B88" "4606" "4606" "3E80" "3E80" "3E80" "3E80" "4606")
+   hx2 ("4606" "3E80" "3E80" "4606" "4606" "4606" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80")
+   hx2 ("3E80" "3A85" "3A85" "3A85" "3A85" "3E80" "3A85" "3E80" "3A85" "3A85" "4606" "4606" "3E80" "3E80" "5C09" "5C89")
+   hx2 ("5D09" "5D89" "5E09" "5E89" "5F09" "5F89" "6009" "6089" "3A85" "3A85" "39A" "39A" "610B" "618B" "620B" "628B")
+   hx2 ("630B" "638B" "501C" "3E80" "3E80" "3E80" "3E80" "3E80" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85")
+   hx2 ("3A85" "3E80" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3E80" "3A85" "3A85" "3E80" "3A85" "3A85" "3A85")
+   hx2 ("3A85" "3A85" "3E80" "3E80" "4606" "3A85" "5B88" "5B88" "4606" "4606" "4606" "4606" "4606" "3E80" "4606" "4606")
+   hx2 ("5B88" "3E80" "5B88" "5B88" "4606" "3E80" "3E80" "3A85" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80")
+   hx2 ("3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "5C09" "5C89" "5D09" "5D89" "5E09" "5E89" "5F09" "5F89" "6009")
+   hx2 ("6089" "630B" "630B" "630B" "630B" "630B" "630B" "630B" "630B" "630B" "630B" "501C" "4606" "501C" "4606" "501C")
+   hx2 ("4606" "6615" "6696" "6615" "6696" "5B88" "5B88" "4606" "4606" "4606" "3E80" "3E80" "3E80" "5B88" "5B88" "3E80")
+   hx2 ("3E80" "5B88" "5B88" "4606" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "4606" "5B88" "3E80" "3E80")
+   hx2 ("3E80" "3E80" "3A85" "3A85" "3E80" "3A85" "3A85" "3A85" "3A85" "3A85" "3E80" "3A85" "3A85" "3E80" "5B88" "4606")
+   hx2 ("4606" "4606" "4606" "5B88" "4606" "3E80" "3E80" "3E80" "4606" "4606" "5B88" "4606" "3E80" "3E80" "3E80" "3E80")
+   hx2 ("3E80" "3E80" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85")
+   hx2 ("3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "5B88" "5B88" "5B88" "4606" "4606" "4606" "4606" "4606" "4606" "4606")
+   hx2 ("5B88" "5B88" "3E80" "3E80" "3E80" "5B88" "5B88" "5B88" "3E80" "5B88" "5B88" "5B88" "4606" "3E80" "3E80" "3E80")
+   hx2 ("3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "5B88" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3A85")
+   hx2 ("3A85" "3A85" "3A85" "3A85" "3E80" "4584" "3E80" "4606" "4606" "4606" "4606" "4606" "4606" "3E80" "3E80" "5C09")
+   hx2 ("5C89" "5D09" "5D89" "5E09" "5E89" "5F09" "5F89" "6009" "6089" "3E80" "3E80" "3A85" "3A85" "3E80" "3E80" "3E80")
+   hx2 ("3E80" "5C09" "5C89" "5D09" "5D89" "5E09" "5E89" "5F09" "5F89" "6009" "6089" "3E80" "3E80" "3E80" "3E80" "3E80")
+   hx2 ("3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "4606" "4606" "4606" "4606" "4606")
+   hx2 ("4606" "4606" "4606" "4606" "4606" "4606" "4606" "4606" "5087" "5087" "5087" "5B88" "4606" "4606" "4606" "3E80")
+   hx2 ("3E80" "5B88" "5B88" "5B88" "3E80" "5B88" "5B88" "5B88" "4606" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80")
+   hx2 ("3E80" "3E80" "5B88" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3A85" "3A85" "3A85" "3A85" "3A85")
+   hx2 ("3A85" "3A85" "3E80" "3E80" "3E80" "4606" "3E80" "3E80" "3E80" "3E80" "5B88" "5B88" "5B88" "4606" "4606" "4606")
+   hx2 ("3E80" "4606" "3E80" "5B88" "5B88" "5B88" "5B88" "5B88" "5B88" "5B88" "5B88" "4606" "5B88" "5B88" "4606" "4606")
+   hx2 ("4606" "4606" "4606" "4606" "4606" "4606" "4606" "4606" "4606" "5198" "5198" "5198" "5198" "5198" "5198" "5198")
+   hx2 ("39A" "5198" "3E80" "3E80" "3E80" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "4584" "4606" "4606" "4606" "4606")
+   hx2 ("4606" "4606" "4606" "4606" "5198" "5C09" "5C89" "5D09" "5D89" "5E09" "5E89" "5F09" "5F89" "6009" "6089" "5198")
+   hx2 ("5198" "3E80" "3E80" "3E80" "3E80" "3A85" "501C" "501C" "501C" "5198" "5198" "5198" "5198" "5198" "5198" "5198")
+   hx2 ("5198" "65B8" "5198" "5198" "5198" "5198" "5198" "5198" "501C" "501C" "501C" "501C" "501C" "4606" "4606" "501C")
+   hx2 ("501C" "501C" "501C" "501C" "501C" "4606" "501C" "501C" "501C" "501C" "501C" "501C" "3E80" "3E80" "501C" "3E80")
+   hx2 ("3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "289C")
+   hx2 ("289C" "289C" "289C" "289C" "289C" "289C" "289C" "289C" "289C" "289C" "289C" "3E80" "3E80" "3E80" "3E80" "3A85")
+   hx2 ("3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3E80" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85")
+   hx2 ("3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85")
+   hx2 ("3A85" "3A85" "3E80" "3E80" "3E80" "3E80" "3E80" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85")
+   hx2 ("3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85")
+   hx2 ("3A85" "3A85" "1A97" "4584" "4584" "4584" "3E80" "5C09" "5C89" "5D09" "5D89" "5E09" "5E89" "5F09" "5F89" "6009")
+   hx2 ("6089" "5198" "5198" "5198" "5198" "5198" "5198" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "5B88" "5B88" "4606")
+   hx2 ("4606" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "20C" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85")
+   hx2 ("3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85")
+   hx2 ("3A85" "3A85" "6615" "6696" "3E80" "3E80" "3E80" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85")
+   hx2 ("3A85" "3A85" "5198" "5198" "5198" "6B8B" "6C0B" "6C8B" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80")
+   hx2 ("3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85")
+   hx2 ("4606" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80")
+   hx2 ("3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3001" "3082" "3001" "3082" "3001" "3082" "3001" "3082" "3001")
+   hx2 ("3082" "3001" "3082" "3001" "3082" "3001" "3082" "3001" "3082" "3001" "3082" "3001" "3082" "2E82" "2E82" "2E82")
+   hx2 ("2E82" "2E82" "6D02" "3E80" "3E80" "3E80" "3E80" "6D82" "6D82" "6D82" "6D82" "6D82" "6D82" "6D82" "6D82" "6E01")
+   hx2 ("6E01" "6E01" "6E01" "6E01" "6E01" "6E01" "6E01" "6D82" "6D82" "6D82" "6D82" "6D82" "6D82" "6D82" "6D82" "6E01")
+   hx2 ("6E01" "6E01" "6E01" "6E01" "6E01" "6E01" "6E01" "6D82" "6D82" "6D82" "6D82" "6D82" "6D82" "3E80" "3E80" "6E01")
+   hx2 ("6E01" "6E01" "6E01" "6E01" "6E01" "3E80" "3E80" "2E82" "6D82" "4902" "6D82" "4902" "6D82" "4902" "6D82" "3E80")
+   hx2 ("6E01" "3E80" "6E01" "3E80" "6E01" "3E80" "6E01" "6D82" "6D82" "6D82" "6D82" "6D82" "6D82" "6D82" "6D82" "6E01")
+   hx2 ("6E01" "6E01" "6E01" "6E01" "6E01" "6E01" "6E01" "6E82" "6E82" "6F02" "6F02" "6F02" "6F02" "6F82" "6F82" "7002")
+   hx2 ("7002" "7082" "7082" "7102" "7102" "3E80" "3E80" "7182" "7182" "7182" "7182" "7182" "7182" "7182" "7182" "7203")
+   hx2 ("7203" "7203" "7203" "7203" "7203" "7203" "7203" "7182" "7182" "7182" "7182" "7182" "7182" "7182" "7182" "7203")
+   hx2 ("7203" "7203" "7203" "7203" "7203" "7203" "7203" "6D82" "6D82" "2E82" "7282" "2E82" "3E80" "2E82" "4902" "6E01")
+   hx2 ("6E01" "7301" "7301" "7383" "1A1B" "7402" "1A1B" "1B02" "1B82" "1C02" "1C82" "1D02" "1D82" "1E02" "1E82" "1F02")
+   hx2 ("1F82" "2002" "2082" "2102" "2182" "2202" "2282" "2302" "2382" "2402" "2482" "2502" "2582" "2602" "2682" "2702")
+   hx2 ("2782" "6615" "C99" "6696" "C99" "3E80" "6D82" "6D82" "4902" "4902" "2E82" "7582" "2E82" "4902" "6E01" "6E01")
+   hx2 ("7601" "7601" "7681" "1A1B" "1A1B" "1A1B" "3E80" "3E80" "2E82" "7282" "2E82" "3E80" "2E82" "4902" "7701" "7701")
+   hx2 ("7781" "7781" "7383" "1A1B" "1A1B" "3E80" "20C" "20C" "20C" "20C" "20C" "20C" "20C" "782C" "20C" "20C")
+   hx2 ("20C" "788C" "5B10" "5B10" "7910" "7990" "2A14" "7A34" "2A14" "2A14" "2A14" "2A14" "298" "298" "7A9D" "7B1E")
+   hx2 ("6615" "7A9D" "7A9D" "7B1E" "6615" "7A9D" "298" "298" "298" "298" "298" "298" "298" "298" "7B8D" "7C0E")
+   hx2 ("7C90" "7D10" "7D90" "7E10" "7E90" "782C" "318" "318" "318" "318" "318" "298" "298" "298" "298" "29DD")
+   hx2 ("2D5E" "298" "298" "298" "298" "1A97" "7F0B" "2C8B" "2B0B" "2B8B" "7F8B" "800B" "808B" "810B" "818B" "820B")
+   hx2 ("519" "519" "C99" "455" "4D6" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80")
+   hx2 ("3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85")
+   hx2 ("3A85" "3A85" "3A85" "3E80" "3E80" "3E80" "289C" "289C" "289C" "289C" "289C" "289C" "289C" "289C" "289C" "289C")
+   hx2 ("289C" "289C" "289C" "289C" "289C" "289C" "289C" "289C" "289C" "289C" "3E80" "3E80" "3E80" "3E80" "3E80" "289C")
+   hx2 ("289C" "289C" "289C" "289C" "289C" "289C" "4D01" "289C" "289C" "289C" "289C" "4D01" "289C" "289C" "2902" "4D01")
+   hx2 ("4D01" "4D01" "2902" "2902" "4D01" "4D01" "4D01" "2902" "289C" "4D01" "289C" "289C" "289C" "4D01" "4D01" "4D01")
+   hx2 ("4D01" "4D01" "289C" "289C" "A20A" "A28A" "A30A" "A38A" "A40A" "A48A" "A50A" "A58A" "A60A" "4606" "4606" "4606")
+   hx2 ("4606" "4606" "4606" "2A14" "4584" "4584" "4584" "4584" "4584" "289C" "289C" "A68A" "A70A" "A78A" "3E80" "3E80")
+   hx2 ("3E80" "289C" "289C" "289C" "289C" "3E80" "289C" "289C" "289C" "289C" "3E80" "3E80" "289C" "289C" "289C" "289C")
+   hx2 ("289C" "289C" "289C" "289C" "289C" "289C" "289C" "289C" "289C" "289C" "289C" "289C" "289C" "289C" "289C" "289C")
+   hx2 ("289C" "289C" "289C" "C99" "289C" "289C" "289C" "289C" "289C" "289C" "289C" "289C" "289C" "289C" "289C" "289C")
+   hx2 ("289C" "289C" "C99" "C99" "289C" "289C" "C99" "289C" "C99" "289C" "289C" "289C" "289C" "289C" "289C" "289C")
+   hx2 ("289C" "289C" "289C" "289C" "289C" "289C" "289C" "289C" "C99" "289C" "289C" "3E80" "3E80" "3E80" "3E80" "3E80")
+   hx2 ("3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "948A" "950A" "958A" "960A" "3E80" "3E80" "3E80")
+   hx2 ("3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "C99" "C99" "C99" "C99" "C99" "289C" "289C")
+   hx2 ("289C" "289C" "289C" "C99" "C99" "289C" "289C" "289C" "289C" "4D01" "289C" "8281" "289C" "4D01" "289C" "8301")
+   hx2 ("8381" "4D01" "4D01" "2A9C" "2902" "4D01" "4D01" "289C" "4D01" "2902" "3A85" "3A85" "3A85" "3A85" "2902" "289C")
+   hx2 ("3E80" "3E80" "3E80" "3E80" "3E80" "848A" "850A" "858A" "860A" "868A" "870A" "878A" "880A" "888A" "890A" "898A")
+   hx2 ("8A0A" "8A8A" "8B0A" "8B8A" "8C0A" "8C8A" "8D0A" "8D8A" "8E0A" "8E8A" "8F0A" "8F8A" "900A" "908A" "910A" "918A")
+   hx2 ("920A" "928A" "930A" "938A" "940A" "C99" "C99" "C59" "C59" "C99" "C99" "C59" "C59" "C59" "C59" "C59")
+   hx2 ("C59" "C59" "C59" "C59" "C59" "C59" "C59" "C59" "C59" "C59" "C59" "C59" "C59" "C59" "C99" "C99")
+   hx2 ("C99" "C99" "C99" "C59" "C59" "C59" "C59" "C99" "C99" "C99" "C99" "C99" "C99" "C99" "C99" "C99")
+   hx2 ("C59" "C59" "C59" "C59" "C59" "C99" "C99" "C59" "C59" "C99" "C99" "C99" "C99" "C59" "C59" "C59")
+   hx2 ("C59" "C59" "C59" "C59" "C59" "C59" "C59" "C59" "C59" "C59" "C99" "C99" "C59" "C59" "C59" "C59")
+   hx2 ("C99" "C99" "C99" "C99" "C99" "C59" "C99" "C99" "C99" "C99" "C99" "C99" "C99" "289C" "289C" "C99")
+   hx2 ("289C" "289C" "C99" "289C" "289C" "289C" "289C" "289C" "289C" "289C" "C99" "289C" "289C" "289C" "289C" "289C")
+   hx2 ("289C" "289C" "289C" "289C" "289C" "289C" "289C" "289C" "289C" "289C" "289C" "289C" "289C" "289C" "289C" "289C")
+   hx2 ("289C" "289C" "289C" "289C" "289C" "289C" "289C" "289C" "289C" "289C" "289C" "3E80" "289C" "289C" "289C" "289C")
+   hx2 ("289C" "289C" "289C" "289C" "289C" "289C" "289C" "289C" "289C" "289C" "289C" "289C" "289C" "289C" "289C" "289C")
+   hx2 ("289C" "289C" "289C" "289C" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80")
+   hx2 ("3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "C99" "C59" "C59")
+   hx2 ("C59" "C59" "C99" "C99" "C99" "C59" "C59" "C59" "C59" "C59" "C59" "C99" "C99" "C99" "C59" "519")
+   hx2 ("519" "C99" "C59" "C59" "C99" "C99" "C99" "C59" "C59" "C59" "C59" "C99" "C59" "C99" "C59" "C99")
+   hx2 ("C99" "C99" "C99" "C59" "C59" "C59" "C59" "C59" "C59" "C59" "C59" "C59" "C99" "C99" "C99" "C99")
+   hx2 ("C99" "C59" "C99" "C59" "C59" "C59" "C59" "C59" "289C" "289C" "289C" "289C" "289C" "289C" "289C" "455")
+   hx2 ("4D6" "289C" "289C" "289C" "289C" "289C" "289C" "289C" "289C" "289C" "289C" "289C" "501C" "501C" "501C" "501C")
+   hx2 ("501C" "501C" "501C" "501C" "501C" "501C" "501C" "501C" "501C" "501C" "501C" "501C" "501C" "501C" "501C" "501C")
+   hx2 ("501C" "501C" "501C" "3E80" "3E80" "3E80" "3E80" "501C" "501C" "501C" "501C" "501C" "501C" "501C" "501C" "501C")
+   hx2 ("501C" "501C" "501C" "501C" "501C" "501C" "501C" "501C" "501C" "501C" "501C" "501C" "501C" "9C1C" "9C1C" "9C1C")
+   hx2 ("9C1C" "9C1C" "9C1C" "9C1C" "9C1C" "9C1C" "9C1C" "9C1C" "9C1C" "9C1C" "9C1C" "9C1C" "9C1C" "9C9C" "9C9C" "9C9C")
+   hx2 ("9C9C" "9C9C" "9C9C" "9C9C" "9C9C" "9C9C" "9C9C" "9C9C" "9C9C" "9C9C" "9C9C" "9C9C" "9C9C" "7F0B" "3E80" "3E80")
+   hx2 ("3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80")
+   hx2 ("3E80" "3E80" "3E80" "C59" "C99" "C59" "C99" "C59" "C59" "C59" "C59" "C59" "C59" "C59" "C59" "C99")
+   hx2 ("C99" "C59" "C59" "C59" "C59" "C59" "C59" "C59" "C59" "C59" "C59" "C59" "C59" "C59" "C59" "C59")
+   hx2 ("C59" "C59" "C59" "C99" "C99" "C59" "C59" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80")
+   hx2 ("3E80" "3E80" "3E80" "3E80" "3E80" "39A" "39A" "C99" "1A1B" "289C" "39A" "39A" "3E80" "289C" "C99" "C99")
+   hx2 ("C99" "C99" "289C" "289C" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "5B10" "5B10")
+   hx2 ("5B10" "289C" "289C" "3E80" "3E80" "289C" "289C" "289C" "289C" "289C" "289C" "289C" "289C" "289C" "289C" "289C")
+   hx2 ("289C" "289C" "289C" "289C" "289C" "3E80" "289C" "289C" "289C" "289C" "289C" "289C" "289C" "289C" "289C" "289C")
+   hx2 ("289C" "289C" "289C" "289C" "3E80" "289C" "3E80" "289C" "289C" "289C" "289C" "3E80" "3E80" "3E80" "289C" "3E80")
+   hx2 ("289C" "289C" "289C" "289C" "289C" "289C" "289C" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80")
+   hx2 ("3E80" "3E80" "3E80" "3E80" "3E80" "840B" "9D0B" "9D8B" "9E0B" "9E8B" "9F0B" "9F8B" "A00B" "A08B" "A10B" "840B")
+   hx2 ("9D0B" "9D8B" "9E0B" "9E8B" "9F0B" "9F8B" "A00B" "A08B" "A10B" "289C" "3E80" "3E80" "3E80" "289C" "289C" "289C")
+   hx2 ("289C" "289C" "289C" "289C" "289C" "C59" "C59" "C59" "C59" "289C" "289C" "289C" "289C" "289C" "289C" "289C")
+   hx2 ("289C" "289C" "289C" "289C" "289C" "289C" "289C" "289C" "289C" "289C" "289C" "289C" "289C" "289C" "501C" "289C")
+   hx2 ("289C" "289C" "289C" "289C" "3E80" "3E80" "3E80" "3E80" "3E80" "630B" "630B" "630B" "630B" "630B" "630B" "630B")
+   hx2 ("630B" "630B" "630B" "501C" "501C" "501C" "501C" "501C" "501C" "501C" "501C" "501C" "501C" "501C" "501C" "501C")
+   hx2 ("501C" "501C" "501C" "501C" "501C" "501C" "501C" "501C" "501C" "501C" "501C" "501C" "501C" "501C" "501C" "501C")
+   hx2 ("501C" "501C" "501C" "3E80" "3E80" "3E80" "501C" "610B" "618B" "620B" "628B" "A80B" "A88B" "A90B" "A98B" "AA0B")
+   hx2 ("640B" "501C" "501C" "501C" "501C" "501C" "501C" "501C" "501C" "501C" "501C" "501C" "501C" "501C" "501C" "501C")
+   hx2 ("501C" "501C" "501C" "501C" "501C" "501C" "501C" "501C" "501C" "501C" "501C" "501C" "289C" "3E80" "289C" "289C")
+   hx2 ("289C" "3E80" "289C" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80")
+   hx2 ("3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "2C8B" "2B0B" "2B8B" "7F8B")
+   hx2 ("800B" "808B" "810B" "818B" "820B" "968B" "970B" "978B" "980B" "988B" "990B" "998B" "9A0B" "9A8B" "9B0B" "9B8B")
+   hx2 ("2C8B" "2B0B" "2B8B" "7F8B" "800B" "808B" "810B" "818B" "820B" "968B" "970B" "978B" "980B" "988B" "990B" "998B")
+   hx2 ("9A0B" "9A8B" "9B0B" "9B8B" "501C" "501C" "501C" "501C" "20C" "298" "298" "298" "289C" "4584" "3A85" "A18A")
+   hx2 ("455" "4D6" "455" "4D6" "455" "4D6" "455" "4D6" "455" "4D6" "289C" "289C" "455" "4D6" "455" "4D6")
+   hx2 ("455" "4D6" "455" "4D6" "2A14" "6615" "6696" "6696" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85")
+   hx2 ("3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3E80" "3E80" "3E80")
+   hx2 ("3E80" "4606" "4606" "1A1B" "1A1B" "4584" "4584" "3E80" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85")
+   hx2 ("3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3A85" "3E80" "501C" "501C" "630B" "630B" "630B" "630B" "501C" "501C")
+   hx2 ("501C" "501C" "501C" "501C" "501C" "501C" "501C" "501C" "501C" "501C" "501C" "501C" "501C" "501C" "501C" "3E80")
+   hx2 ("3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80")
+   hx2 ("3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "AA93" "AA93" "AA93" "AA93" "AA93")
+   hx2 ("AA93" "AA93" "AA93" "AA93" "AA93" "AA93" "AA93" "AA93" "AA93" "AA93" "AA93" "AA93" "AA93" "AA93" "AA93" "AA93")
+   hx2 ("AA93" "AA93" "AA93" "AA93" "AA93" "AA93" "AA93" "AA93" "AA93" "AA93" "AA93" "AB12" "AB12" "AB12" "AB12" "AB12")
+   hx2 ("AB12" "AB12" "AB12" "AB12" "AB12" "AB12" "AB12" "AB12" "AB12" "AB12" "AB12" "AB12" "AB12" "AB12" "AB12" "AB12")
+   hx2 ("AB12" "AB12" "AB12" "AB12" "AB12" "AB12" "AB12" "AB12" "AB12" "AB12" "AB12" "5305" "5305" "5305" "5305" "5305")
+   hx2 ("5305" "5305" "5305" "5305" "519" "5305" "5305" "5305" "5305" "5305" "5305" "5305" "5305" "5305" "5305" "5305")
+   hx2 ("5305" "5305" "3E80" "5305" "5305" "5305" "5305" "5305" "3E80" "5305" "3E80" "4606" "4606" "4606" "4606" "3E80")
+   hx2 ("3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "3E80" "298" "2A14" "2A14" "1A97" "1A97")
+   hx2 ("6615" "6696" "6615" "6696" "6615" "6696" "6615" "6696" "6615" "6696" "6615" "6696" "3E80" "3E80" "3E80" "3E80")
+   hx2 ("298" "298" "298" "298" "1A97" "1A97" "1A97" "598" "298" "598" "3E80" "298" "598" "298" "298" "2A14")
+   hx2 ("6615" "6696" "6615" "6696" "6615" "6696" "318" "298" "D01" "D81" "E01" "E81" "F01" "F81" "1001" "1081")
+   hx2 ("1101" "1181" "1201" "1281" "1301" "1381" "1401" "1481" "1501" "1581" "1601" "1681" "1701" "1781" "1801" "1881")
+   hx2 ("1901" "1981" "6615" "298" "6696" "1A1B" "1A97")
+
+: CaseUpper
+   hx2 ("0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0")
+   hx2 ("0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0")
+   hx2 ("0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0")
+   hx2 ("0" "0" "0" "0" "0" "0" "FFE0" "FFE0" "FFE0" "FFE0" "FFE0" "FFE0" "FFE0" "FFE0" "FFE0" "FFE0")
+   hx2 ("FFE0" "FFE0" "FFE0" "FFE0" "FFE0" "FFE0" "FFE0" "FFE0" "FFE0" "FFE0" "FFE0" "FFE0" "FFE0" "FFE0" "FFE0" "FFE0")
+   hx2 ("0" "0" "0" "0" "0" "0" "0" "0" "2E7" "0" "0" "0" "0" "0" "FFE0" "79")
+   hx2 ("0" "FFFF" "0" "FF18" "0" "FED4" "0" "0" "0" "0" "0" "0" "0" "61" "0" "0")
+   hx2 ("0" "0" "0" "0" "0" "0" "38" "0" "FFFF" "FFFE" "FFB1" "0" "0" "0" "FF2E" "FF32")
+   hx2 ("FF33" "FF36" "FF35" "FF31" "FF2F" "FF2D" "FF2B" "FF2A" "FF26" "FF27" "FF25" "0" "0" "54" "0" "0")
+   hx2 ("0" "0" "0" "FFDA" "FFDB" "FFE1" "FFC0" "FFC1" "FFC2" "FFC7" "0" "FFD1" "FFCA" "FFAA" "FFB0" "0")
+   hx2 ("0" "0" "0" "0" "FFD0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0")
+   hx2 ("0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0")
+   hx2 ("0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0")
+   hx2 ("0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "FFC5" "8" "0" "4A" "56" "64")
+   hx2 ("80" "70" "7E" "8" "0" "9" "0" "0" "E3DB" "0" "0" "7" "0" "0" "0" "0")
+   hx2 ("0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0")
+   hx2 ("0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0")
+   hx2 ("0" "0" "0" "0" "0" "0" "0" "0" "0" "FFF0" "FFF0" "FFF0" "FFF0" "FFF0" "FFF0" "FFF0")
+   hx2 ("FFF0" "FFF0" "FFF0" "FFF0" "FFF0" "FFF0" "FFF0" "FFF0" "FFF0" "0" "0" "0" "0" "0" "0" "0")
+   hx2 ("0" "0" "0" "0" "0" "0" "0" "0" "0" "FFE6" "0" "0" "0" "0" "0" "0")
+   hx2 ("0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0")
+   hx2 ("0" "0" "0" "0" "0" "0" "0")
+
+: CaseLower
+   hx2 ("0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0")
+   hx2 ("0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "20" "20" "20" "20" "20" "20")
+   hx2 ("20" "20" "20" "20" "20" "20" "20" "20" "20" "20" "20" "20" "20" "20" "20" "20")
+   hx2 ("20" "20" "20" "20" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0")
+   hx2 ("0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0")
+   hx2 ("0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "20" "0" "0" "0")
+   hx2 ("1" "0" "FF39" "0" "FF87" "0" "D2" "CE" "CD" "4F" "CA" "CB" "CF" "0" "D3" "D1")
+   hx2 ("D5" "D6" "DA" "D9" "DB" "0" "0" "2" "1" "0" "0" "FF9F" "FFC8" "0" "0" "0")
+   hx2 ("0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "26" "25")
+   hx2 ("40" "3F" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "50")
+   hx2 ("0" "0" "30" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0")
+   hx2 ("0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0")
+   hx2 ("0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0")
+   hx2 ("0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "FFF8" "0" "0" "0")
+   hx2 ("0" "0" "0" "0" "FFF8" "0" "FFB6" "FFF7" "0" "FFAA" "FF9C" "0" "FF90" "FFF9" "FF80" "FF82")
+   hx2 ("0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0")
+   hx2 ("0" "0" "0" "0" "0" "E2A3" "DF41" "DFBA" "0" "10" "10" "10" "10" "10" "10" "10")
+   hx2 ("10" "10" "10" "10" "10" "10" "10" "10" "10" "0" "0" "0" "0" "0" "0" "0")
+   hx2 ("0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0")
+   hx2 ("0" "0" "0" "0" "0" "0" "0" "0" "1A" "0" "0" "0" "0" "0" "0" "0")
+   hx2 ("0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0")
+   hx2 ("0" "0" "0" "0" "0" "0" "0")
+
+# vi:et:ts=3:sw=3
diff --git a/src64/ht.l b/src64/ht.l
@@ -0,0 +1,727 @@
+# 01apr10abu
+# (c) Software Lab. Alexander Burger
+
+### Hypertext I/O functions ###
+(data 'HtOK)
+align 8  asciz "<b>"
+align 8  asciz "</b>"
+align 8  asciz "<i>"
+align 8  asciz "</i>"
+align 8  asciz "<u>"
+align 8  asciz "</u>"
+align 8  asciz "<p>"
+align 8  asciz "</p>"
+align 8  asciz "<pre>"
+align 8  asciz "</pre>"
+align 8  asciz "<div "
+align 8  asciz "</div>"
+align 8  asciz "<br>"
+align 8  asciz "<hr>"
+: HtOkEnd
+
+: HtLt asciz "&lt;"
+: HtGt asciz "&gt;"
+: HtAmp asciz "&amp;"
+: HtQuot asciz "&quot;"
+: HtNbsp asciz "&nbsp;"
+
+: HtEsc ascii " \\\"#%&:;<=>?_"
+(equ HTESC 12)
+
+(code 'findHtOkY_FE 0)
+   push X
+   ld X HtOK
+   do
+      push X
+      push Y
+      do
+         ld B (X)  # Compare bytes
+         cmp B (Y)  # Equal?
+      while eq  # Yes
+         add X 1  # End of HtOk string?
+         nul (X)
+         if z  # Yes: Found
+            slen C Y  # Length of the remaining string
+            ld B (char ">")  # Is there a closing tag?
+            memb Y C
+            ldz E Y  # Yes: Return pointer to next char in E
+            pop Y
+            pop X
+            pop X
+            ret  # 'z' or 'nz'
+         end
+         add Y 1  # End of data?
+         nul (Y)
+      until z  # Yes
+      pop Y
+      pop X
+      add X 8  # Try next
+      cmp X HtOkEnd  # Done?
+   until gt  # Yes
+   pop X
+   ret  # 'nz'
+
+# (ht:Prin 'sym ..) -> sym
+(code 'Prin 2)
+   push X
+   push Y
+   push Z
+   ld X (E CDR)  # Args
+   do
+      ld E (X)  # Eval next
+      eval
+      num E  # Number?
+      jnz 20  # Yes
+      atom E  # Cell?
+      jz 20  # Yes
+      sym (E TAIL)  # External symbol?
+      if nz  # Yes
+20       call prinE_E  # Plain print
+      else
+         push E  # Save return value
+         call bufStringE_SZ  # Write to stack buffer
+         ld Y S  # Point to string
+         do
+            nul (Y)  # Null byte?
+         while nz  # No
+            call findHtOkY_FE  # Preserved pattern?
+            if z  # Yes
+               do
+                  ld B (Y)  # Output partial string
+                  call envPutB
+                  add Y 1  # till end pointer in E
+                  cmp Y E
+               until eq
+            else
+               ld B (Y)  # Next byte
+               cmp B (char "<")  # Escape special characters
+               if eq
+                  ld C HtLt  # "&lt;"
+                  call outStringC
+               else
+                  cmp B (char ">")
+                  if eq
+                     ld C HtGt  # "&gt;"
+                     call outStringC
+                  else
+                     cmp B (char "&")
+                     if eq
+                        ld C HtAmp  # "&amp;"
+                        call outStringC
+                     else
+                        cmp B (char "\"")
+                        if eq
+                           ld C HtQuot  # "&quot;"
+                           call outStringC
+                        else
+                           cmp B (hex "FF")
+                           if eq
+                              ld B (hex "EF")
+                              call envPutB
+                              ld B (hex "BF")
+                              call envPutB
+                              ld B (hex "BF")
+                              call envPutB
+                           else
+                              ld C A  # Save char
+                              call envPutB  # Output it
+                              test C (hex "80")  # Double byte?
+                              if nz  # Yes
+                                 add Y 1  # Next
+                                 ld B (Y)  # Output second byte
+                                 call envPutB
+                                 test C (hex "20")  # Triple byte?
+                                 if nz  # Yes
+                                    add Y 1  # Next
+                                    ld B (Y)  # Output third byte
+                                    call envPutB
+                                 end
+                              end
+                           end
+                        end
+                     end
+                  end
+               end
+               add Y 1  # Increment string pointer
+            end
+         loop
+         ld S Z  # Drop buffer
+         pop E
+      end
+      ld X (X CDR)  # X on rest
+      atom X  # More?
+   until nz  # No
+   pop Z
+   pop Y
+   pop X
+   ret
+
+(code 'putHexB 0)  # E
+   ld E A  # Save B
+   ld B (char "%")  # Prefix with "%"
+   call envPutB
+   ld A E  # Get B
+   shr B 4  # Get upper nibble
+   and B 15
+   cmp B 9  # Letter?
+   if gt  # Yes
+      add B 7
+   end
+   add B (char "0")
+   call envPutB  # Output upper nibble
+   ld A E  # Get B again
+   and B 15  # Get lower nibble
+   cmp B 9  # Letter?
+   if gt  # Yes
+      add B 7
+   end
+   add B (char "0")
+   jmp envPutB  # Output lower nibble
+
+(code 'htFmtE 0)
+   cmp E Nil  # NIL?
+   if ne  # No
+      num E  # Number?
+      if nz  # Yes
+         ld B (char "+")  # Prefix with "+"
+         call envPutB
+         jmp prinE  # and print it
+      end
+      push X
+      atom E  # List?
+      if z  # Yes
+         ld X E
+         do
+            ld B (char "_")  # Prefix with "_"
+            call envPutB
+            ld E (X)  # Print next item
+            call htFmtE
+            ld X (X CDR)  # End of list?
+            atom X
+         until nz  # Yes
+      else  # Symbol
+         ld X (E TAIL)
+         call nameX_X  # Get name
+         cmp X ZERO  # Any?
+         if ne  # Yes
+            sym (E TAIL)  # External symbol?
+            if nz  # Yes
+               ld B (char "-")  # Prefix with "-"
+               call envPutB
+               call prExtNmX  # Print external
+            else
+               push Y
+               ld Y Intern
+               call isInternEXY_F  # Internal symbol?
+               ld C 0
+               if eq  # Yes
+                  ld B (char "$")  # Prefix with "$"
+                  call envPutB
+               else
+                  call symByteCX_FACX  # Get first byte
+                  cmp B (char "$")  # Dollar, plus or dot?
+                  jeq 40
+                  cmp B (char "+")
+                  jeq 40
+                  cmp B (char "-")
+                  if eq
+40                   call putHexB  # Encode hexadecimal
+                  else
+                     call envPutB
+                  end
+               end
+               do
+                  call symByteCX_FACX  # Next byte
+               while nz
+                  memb HtEsc HTESC  # Escape?
+                  if eq  # Yes
+                     call putHexB  # Encode hexadecimal
+                  else
+                     ld E A  # Save char
+                     call envPutB  # Output it
+                     test E (hex "80")  # Double byte?
+                     if nz  # Yes
+                        call symByteCX_FACX  # Next byte
+                        call envPutB  # Output second byte
+                        test E (hex "20")  # Triple byte?
+                        if nz  # Yes
+                           call symByteCX_FACX  # Next byte
+                           call envPutB  # Output third byte
+                        end
+                     end
+                  end
+               loop
+               pop Y
+            end
+         end
+      end
+      pop X
+   end
+   ret
+
+# (ht:Fmt 'any ..) -> sym
+(code 'Fmt 2)
+   push X
+   push Y
+   push Z
+   ld X (E CDR)  # X on args
+   link
+   do
+      ld E (X)
+      eval+  # Eval next arg
+      push E
+      ld X (X CDR)
+      atom X  # More args?
+   until nz  # No
+   lea Y (L -I)  # Y on first arg
+   ld Z S  # Z on last arg
+   link
+   call begString  # Start string
+   ld E (Y)
+   call htFmtE  # Format first arg
+   do
+      cmp Y Z  # More args?
+   while ne  # Yes
+      ld B (char "&")
+      call envPutB
+      sub Y I  # Next arg
+      ld E (Y)
+      call htFmtE  # Format it
+   loop
+   call endString_E  # Retrieve result
+   drop
+   pop Z
+   pop Y
+   pop X
+   ret
+
+(code 'getHexX_A 0)
+   ld A ((X) TAIL)  # Get first hex digit
+   call firstByteA_B
+   sub B (char "0")  # Convert
+   cmp B 9
+   if gt
+      and B (hex "DF")
+      sub B 7
+   end
+   ld X (X CDR)  # Next symbol
+   ret
+
+(code 'getUnicodeX_FAX 0)
+   ld E X  # Save X
+   ld C 0  # Init unicode value
+   do
+      ld X (X CDR)
+      ld A ((X) TAIL)  # Get next character symbol
+      call firstByteA_B
+      cmp B (char "0")  # Digit?
+   while ge
+      cmp B (char "9")
+   while le  # Yes
+      sub B (char "0")  # Convert
+      push A  # Save digit
+      ld A C  # Get accu
+      mul 10  # Build decimal number
+      pop C  # Get digit
+      add C A  # New unicode value
+   loop
+   cmp B (char ";")  # Terminator?
+   if eq  # Yes
+      ld X (X CDR)  # Skip ";"
+      ld A C  # Get value
+      null A  # Any?
+      jnz Ret  # Yes
+   end
+   ld X E  # Restore X
+   setz  # 'z'
+   ret
+
+(code 'headCX_FX 0)  # E
+   ld E X  # Save X
+   do
+      add C 1  # Point to next char
+      nul (C)  # Any?
+   while nz  # Yes
+      ld A ((X) TAIL)  # Get next character symbol
+      call firstByteA_B
+      cmp B (C)  # Matched?
+   while eq  # Yes
+      ld X (X CDR)
+   loop
+   ldnz X E  # Restore X when no match
+   ret  # 'z' if match
+
+# (ht:Pack 'lst) -> sym
+(code 'Pack 2)
+   push X
+   ld E ((E CDR))  # Eval arg
+   eval
+   link
+   push E  # Save
+   link
+   ld X E  # List in X
+   call begString  # Start string
+   do
+      atom X  # More items?
+   while z  # Yes
+      ld E (X)  # Get next character symbol
+      ld A (E TAIL)
+      call firstByteA_B
+      cmp B (char "%")  # Hex-escaped?
+      if eq  # Yes
+         ld X (X CDR)  # Skip "%"
+         call getHexX_A  # Get upper nibble
+         shl A 4
+         ld C A  # into C
+         call getHexX_A  # Get lower nibble
+         or A C  # Combine
+         call envPutB  # Output
+      else
+         ld X (X CDR)  # Next symbol
+         cmp B (char "&")  # Ampersand?
+         if ne  # No
+            call outNameE  # Normal output
+         else
+            ld C HtLt  # "&lt;"
+            call headCX_FX
+            if eq
+               ld B (char "<")
+               call envPutB
+            else
+               ld C HtGt  # "&gt;"
+               call headCX_FX
+               if eq
+                  ld B (char ">")
+                  call envPutB
+               else
+                  ld C HtAmp  # "&amp;"
+                  call headCX_FX
+                  if eq
+                     ld B (char "&")
+                     call envPutB
+                  else
+                     ld C HtQuot  # "&quot;"
+                     call headCX_FX
+                     if eq
+                        ld B (char "\"")
+                        call envPutB
+                     else
+                        ld C HtNbsp  # "&nbsp;"
+                        call headCX_FX
+                        if eq
+                           ld B (char " ")
+                           call envPutB
+                        else
+                           ld A ((X) TAIL)  # Get next byte
+                           call firstByteA_B
+                           cmp B (char "#")  # Hash?
+                           jne 40  # No
+                           call getUnicodeX_FAX  # Unicode?
+                           if nz  # Yes
+                              call mkCharA_A  # Make symbol
+                              ld E A
+                              call outNameE  # Output unicode char
+                           else
+40                            ld B (char "&")  # Else ouput an ampersand
+                              call envPutB
+                           end
+                        end
+                     end
+                  end
+               end
+            end
+         end
+      end
+   loop
+   call endString_E  # Retrieve result
+   drop
+   pop X
+   ret
+
+### Read content length bytes ###
+# (ht:Read 'cnt) -> lst
+(code 'Read 2)
+   push X
+   ld X E
+   ld E ((E CDR))  # E on arg
+   call evCntEX_FE  # Eval 'cnt'
+   if nsz  # > 0
+      ld A (Chr)  # Look ahead char?
+      null A
+      if z  # No
+         call envGet_A  # Get next char
+      end
+      null A  # EOF?
+      if ns  # No
+         call getChar_A  # Read first char
+         cmp A 128  # Double byte?
+         if ge  # Yes
+            sub E 1  # Decrement count
+            cmp A 2048  # Triple byte?
+            if ge  # Yes
+               sub E 1  # Decrement count
+            end
+         end
+         sub E 1  # Less than zero?
+         if ns  # No
+            call mkCharA_A  # First character
+            call consA_X  # Build first cell
+            ld (X) A
+            ld (X CDR) Nil
+            link
+            push X  # <L I> Result
+            link
+            do
+               null E  # Count?
+               if z  # No
+                  ld E (L I)  # Return result
+                  break T
+               end
+               call envGet_A  # Get next char
+               null A  # EOF?
+               if s  # Yes
+                  ld E Nil  # Return NIL
+                  break T
+               end
+               call getChar_A
+               cmp A 128  # Double byte?
+               if ge  # Yes
+                  sub E 1  # Decrement count
+                  cmp A 2048  # Triple byte?
+                  if ge  # Yes
+                     sub E 1  # Decrement count
+                  end
+               end
+               sub E 1  # Less than zero?
+               if s  # Yes
+                  ld E Nil  # Return NIL
+                  break T
+               end
+               call mkCharA_A  # Build next character
+               call consA_C  # And next cell
+               ld (C) A
+               ld (C CDR) Nil
+               ld (X CDR) C  # Append to result
+               ld X C
+            loop
+            ld (Chr) 0  # Clear look ahead char
+            drop
+            pop X
+            ret
+         end
+      end
+   end
+   ld E Nil  # Return NIL
+   pop X
+   ret
+
+
+### Chunked Encoding ###
+(equ CHUNK 4000)
+
+(data 'Chunk 0)
+word 0      # <Y> Chunk size count
+word 0      # <Y I> Saved EnvGet_A function
+word 0      # <Y II> Saved EnvPutB function
+skip CHUNK  # <Y III> Chunk buffer
+
+: Newlines asciz "0\\r\\n\\r\\n"
+
+(code 'chrHex_AF 0)
+   ld B (Chr)
+   cmp B (char "0")  # Decimal digit?
+   if ge
+      cmp B (char "9")
+      if le
+         sub B 48  # Yes
+         ret  # 'nc'
+      end
+   end
+   and B (hex "DF")  # Force upper case
+   cmp B (char "A")  # Hex letter?
+   if ge
+      cmp B (char "F")
+      if le
+         sub B 55  # Yes
+         ret  # 'nc'
+      end
+   end
+   ld A 0
+   sub A 1  # -1
+   ret  # 'c'
+
+(code 'chunkSize 0)
+   push X
+   ld X Chunk  # Get Chunk
+   null (Chr)  # 'Chr'?
+   if z  # No
+      ld A (X I)  # Call saved 'get'
+      call (A)
+   end
+   call chrHex_AF  # Read encoded count
+   ld (X) A  # Save in count
+   if ge  # >= 0
+      do
+         ld A (X I)  # Call saved 'get'
+         call (A)
+         call chrHex_AF  # Read encoded count
+      while ge  # >= 0
+         ld C (X)  # Get count
+         shl C 4  # Combine
+         or C A
+         ld (X) C
+      loop
+      do
+         cmp (Chr) 10  # Fine linefeed
+      while ne
+         null (Chr)  # EOF?
+         js 90  # Return
+         ld A (X I)  # Call saved 'get'
+         call (A)
+      loop
+      ld A (X I)  # Call saved 'get'
+      call (A)
+      null (X)  # Count is zero?
+      if z  # Yes
+         ld A (X I)  # Call saved 'get'
+         call (A)  # Skip '\r' of empty line
+         ld (Chr) 0  # Discard '\n'
+      end
+   end
+90 pop X
+   ret
+
+(code 'getChunked_A 0)
+   push Y
+   ld Y Chunk  # Get Chunk
+   null (Y)  # Count <= 0
+   if sz  # Yes
+      ld A -1  # Return EOF
+      ld (Chr) A
+   else
+      ld A (Y I)  # Call saved 'get'
+      call (A)
+      sub (Y) 1  # Decrement count
+      if z
+         ld A (Y I)  # Call saved 'get'
+         call (A)
+         ld A (Y I)  # Skip '\n', '\r'
+         call (A)
+         call chunkSize
+      end
+   end
+   pop Y
+   ret
+
+# (ht:In 'flg . prg) -> any
+(code 'In 2)
+   push X
+   ld X (E CDR)  # Args
+   ld E (X)  # Eval 'flg'
+   eval
+   ld X (X CDR)  # X on 'prg'
+   cmp E Nil  # 'flg?
+   if eq  # No
+      prog X  # Run 'prg'
+   else
+      push Y
+      ld Y Chunk  # Get Chunk
+      ld (Y I) (EnvGet_A)  # Save current 'get'
+      ld (EnvGet_A) getChunked_A  # Set new
+      call chunkSize
+      prog X  # Run 'prg'
+      ld (EnvGet_A) (Y I)  # Restore 'get'
+      ld (Chr) 0  # Clear look ahead char
+      pop Y
+   end
+   pop X
+   ret
+
+
+(code 'outHexA 0)
+   cmp A 15  # Single digit?
+   if gt  # No
+      push A
+      shr A 4  # Divide by 16
+      call outHexA  # Recurse
+      pop A
+      and B 15
+   end
+   cmp B 9  # Digit?
+   if gt  # No
+      add B 39  # Make lower case letter
+   end
+   add B (char "0")  # Make ASCII digit
+   jmp envPutB
+
+(code 'wrChunkY 0)  # X
+   ld (EnvPutB) (Y II)  # Restore 'put'
+   ld A (Y)  # Get count
+   call outHexA  # Print as hex
+   ld B 13  # Output 'return'
+   call envPutB
+   ld B 10  # Output 'newline'
+   call envPutB
+   lea X (Y III)  # X on chunk buffer
+   do
+      ld B (X)  # Next byte from chunk buffer
+      call envPutB  # Output
+      add X 1  # Increment pointer
+      sub (Y) 1  # Decrement 'Cnt'
+   until z
+   ld B 13  # Output 'return'
+   call envPutB
+   ld B 10  # Output 'newline'
+   call envPutB
+   ld (Y II) (EnvPutB)  # Save 'put'
+   ld (EnvPutB) putChunkedB  # Set new
+   ret
+
+(code 'putChunkedB 0)
+   push X
+   push Y
+   ld Y Chunk  # Get Chunk
+   lea X (Y III)  # X on chunk buffer
+   add X (Y)  # Count index
+   ld (X) B  # Store byte
+   add (Y) 1  # Increment count
+   cmp (Y) CHUNK   # Max reached?
+   if eq  # Yes
+      call wrChunkY  # Write buffer
+   end
+   pop Y
+   pop X
+   ret
+
+# (ht:Out 'flg . prg) -> any
+(code 'Out 2)
+   push X
+   ld X (E CDR)  # Args
+   ld E (X)  # Eval 'flg'
+   eval
+   ld X (X CDR)  # X on 'prg'
+   cmp E Nil  # 'flg?
+   if eq  # No
+      prog X  # Run 'prg'
+   else
+      push Y
+      ld Y Chunk  # Get Chunk
+      ld (Y) 0  # Clear count
+      ld (Y II) (EnvPutB)  # Save current 'put'
+      ld (EnvPutB) putChunkedB  # Set new
+      prog X  # Run 'prg'
+      null (Y)  # Count?
+      if nz  # Yes
+         call wrChunkY  # Write rest
+      end
+      ld (EnvPutB) (Y II)  # Restore 'put'
+      ld C Newlines  # Output termination string
+      call outStringC
+      pop Y
+   end
+   ld A (OutFile)  # Flush OutFile
+   call flushA_F  # OK?
+   pop X
+   ret
+
+# vi:et:ts=3:sw=3
diff --git a/src64/io.l b/src64/io.l
@@ -0,0 +1,5001 @@
+# 14apr10abu
+# (c) Software Lab. Alexander Burger
+
+# Close file descriptor
+(code 'closeAX)
+   cc close(A)
+   nul4  # OK?
+   jz Ret  # Yes
+   ld E A  # Get file descriptor
+   shl E 4  # Make short number
+   or E CNT
+   jmp closeErrEX
+
+# Lock/unlock file
+(code 'unLockFileAC)
+   st2 (Flock)  # 'l_type'
+   ld (Flock L_START) 0  # Start position ('l_whence' is SEEK_SET)
+   shr A 16  # Get length
+   ld (Flock L_LEN) A  # Length
+   cc fcntl(C F_SETLK Flock)  # Try to unlock
+   ret
+
+(code 'wrLockFileC)
+   ld A F_WRLCK  # Write lock, length 0
+   jmp lockFileAC
+(code 'rdLockFileC)
+   ld A F_RDLCK  # Read lock, length 0
+(code 'lockFileAC)
+   st2 (Flock)  # 'l_type'
+   ld (Flock L_START) 0  # Start position ('l_whence' is SEEK_SET)
+   shr A 16  # Get length
+   ld (Flock L_LEN) A  # Length
+   do
+      cc fcntl(C F_SETLKW Flock)  # Try to lock
+      nul4  # OK?
+      jns Ret  # Yes
+      call errno_A
+      cmp A EINTR  # Interrupted?
+      jne lockErr  # No
+   loop
+
+# Set the close-on-exec flag
+(code 'closeOnExecAX)
+   cc fcntl(A F_SETFD FD_CLOEXEC)
+   nul4  # OK?
+   jns Ret  # Yes
+   ld Y SetFD
+   jmp errnoEXY
+: SetFD asciz "SETFD %s"
+
+# Set file descriptor to non-blocking / blocking
+(code 'nonblockingA_A)
+   push C
+   ld C A  # Keep fd
+   cc fcntl(C F_GETFL 0)  # Get file status flags
+   push A  # Save flags
+   or A O_NONBLOCK
+   cc fcntl(C F_SETFL A)  # Set file status flags
+   pop A  # Return old flags
+   pop C
+   ret
+
+# Initialize input file
+(code 'initInFileA_A)  # E
+   ld C 0  # No name
+: initInFileAC_A
+   xchg A C
+: initInFileCA_A
+   push A  # Save 'name'
+   push C  # and 'fd'
+   shl C 3  # Vector index
+   cmp C (InFDs)  # 'fd' >= 'InFDs'?
+   if ge  # Yes
+      push X
+      ld X (InFDs)  # Keep old 'InFDs'
+      ld E C  # Get vector index
+      add E I  # Plus 1
+      ld (InFDs) E  # Store new 'InFDs'
+      ld A (InFiles)  # Get vector
+      call allocAE_A  # Extend vector
+      ld (InFiles) A
+      add X A  # X on beg
+      add A E  # A on end
+      do
+         ld (X) 0  # Clear new range
+         add X I
+         cmp X A
+      until eq
+      pop X
+   end
+   add C (InFiles)  # Get vector
+   ld A (C)  # Old inFile (should be NULL!)
+   ld E (+ VII BUFSIZ)  # sizeof(inFile)
+   call allocAE_A
+   ld (C) A  # New inFile
+   pop (A)  # Set 'fd'
+   ld (A I) 0  # Clear 'ix'
+   ld (A II) 0  # Clear 'cnt'
+   ld (A III) 0  # Clear 'next'
+   ld C 1
+   ld (A IV) C  # line = 1
+   ld (A V) C  # src = 1
+   pop (A VI)  # Set filename
+   ret
+
+# Initialize output file
+(code 'initOutFileA_A)
+   ld C A
+   push A  # Save 'fd'
+   cc isatty(A)
+   push A  # Save 'tty' flag
+   shl C 3  # Vector index
+   cmp C (OutFDs)  # 'fd' >= 'OutFDs'?
+   if ge  # Yes
+      push X
+      ld X (OutFDs)  # Keep old 'OutFDs'
+      ld E C  # Get vector index
+      add E I  # Plus 1
+      ld (OutFDs) E  # Store new 'OutFDs'
+      ld A (OutFiles)  # Get vector
+      call allocAE_A  # Extend vector
+      ld (OutFiles) A
+      add X A  # X on beg
+      add A E  # A on end
+      do
+         ld (X) 0  # Clear new range
+         add X I
+         cmp X A
+      until eq
+      pop X
+   end
+   add C (OutFiles)  # Get vector
+   ld A (C)  # Old outFile (should be NULL!)
+   ld E (+ III BUFSIZ)  # sizeof(outFile)
+   call allocAE_A
+   ld (C) A  # New outFile
+   pop (A II)  # Set 'tty'
+   ld (A I) 0  # Clear 'ix'
+   pop (A)  # Set 'fd'
+   ret
+
+# Close input file
+(code 'closeInFileA)
+   shl A 3  # Vector index
+   cmp A (InFDs)  # 'fd' < 'InFDs'?
+   if lt  # Yes
+      push X
+      add A (InFiles)  # Get vector
+      ld X (A)
+      null X  # Any?
+      if nz  # Yes
+         cmp X (InFile)  # Current Infile?
+         if eq  # Yes
+            ld (InFile) 0  # Clear it
+         end
+         ld (A) 0  # Clear slot
+         cc free((X VI))  # Free filename
+         cc free(X)  # And inFile
+      end
+      pop X
+   end
+   ret
+
+# Close output file
+(code 'closeOutFileA)
+   shl A 3  # Vector index
+   cmp A (OutFDs)  # 'fd' < 'OutFDs'?
+   if lt  # Yes
+      push X
+      add A (OutFiles)  # Get vector
+      ld X (A)
+      null X  # Any?
+      if nz  # Yes
+         cmp A (OutFile)  # Current Outfile?
+         if eq  # Yes
+            ld (OutFile) 0  # Clear it
+         end
+         ld (A) 0  # Clear slot
+         cc free(X)  # And inFile
+      end
+      pop X
+   end
+   ret
+
+# Interruptible read
+(code 'slowZ_F)
+   ld (Z I) 0  # Clear 'ix'
+   ld (Z II) 0  # Clear 'cnt'
+   do
+      cc read((Z) &(Z VII) BUFSIZ)  # Read into buffer
+      null A  # OK?
+      if ns  # Yes
+         ld (Z II) A  # Set new 'cnt'
+         ret  # Return 'ge'
+      end
+      call errno_A
+      cmp A EINTR  # Interrupted?
+      if ne  # No
+         setz  # Return 'z'
+         ret
+      end
+      nul (Signal)  # Signal?
+      if nz  # Yes
+         call sighandler0
+      end
+   loop
+
+(code 'slowNbC_FA)
+   ld (C I) 0  # Clear 'ix'
+   ld (C II) 0  # Clear 'cnt'
+   do
+      ld A (C)  # Set non-blocking
+      call nonblockingA_A
+      push A  # Save old file status flags
+      cc read((C) &(C VII) BUFSIZ)  # Read into buffer
+      xchg A (S)
+      cc fcntl((C) F_SETFL A)  # Restore file status flags
+      pop A  # Get 'read' return value
+      null A  # OK?
+      if ns  # Yes
+         ld (C II) A  # Set new 'cnt'
+         ret  # Return 'ge'
+      end
+      call errno_A
+      cmp A EAGAIN  # No data available?
+      if eq  # Yes
+         setc  # Return 'lt'
+         ret
+      end
+      cmp A EINTR  # Interrupted?
+      if ne  # No
+         setz  # Return 'z'
+         ret
+      end
+      nul (Signal)  # Signal?
+      if nz  # Yes
+         call sighandler0
+      end
+   loop
+
+(code 'rdBytesCEX_F)
+   do
+      do
+         cc read(C X E)  # Read into buffer
+         null A  # OK?
+      while sz  # No
+         jz Ret  # EOF
+         call errno_A
+         cmp A EINTR  # Interrupted?
+         jne Retz  # No: Return 'z'
+         nul (Signal)  # Signal?
+         if nz  # Yes
+            call sighandler0
+         end
+      loop
+      add X A  # Increment buffer pointer
+      sub E A  # Decrement count
+   until z
+   null A  # 'nsz'
+   ret
+
+(code 'rdBytesNbCEX_F)
+   do
+      ld A C  # Set non-blocking
+      call nonblockingA_A
+      push A  # Save old file status flags
+      cc read(C X E)  # Read into buffer
+      xchg A (S)
+      cc fcntl(C F_SETFL A)  # Restore file status flags
+      pop A  # Get 'read' return value
+      null A  # OK?
+      if nsz  # Yes
+         do
+            add X A  # Increment buffer pointer
+            sub E A  # Decrement count
+            if z  #  Got all
+               null A  # 'nsz'
+               ret
+            end
+            do
+               cc read(C X E)  # Read into buffer
+               null A  # OK?
+            while sz  # No
+               jz Ret  # EOF
+               call errno_A
+               cmp A EINTR  # Interrupted?
+               jne Retz  # No: Return 'z'
+               nul (Signal)  # Signal?
+               if nz  # Yes
+                  call sighandler0
+               end
+            loop
+         loop
+      end
+      jz Ret  # EOF
+      call errno_A
+      cmp A EAGAIN  # No data available?
+      if eq  # Yes
+         setc  # Return 'lt'
+         ret
+      end
+      cmp A EINTR  # Interrupted?
+      jne Retz  # No: Return 'z'
+      nul (Signal)  # Signal?
+      if nz  # Yes
+         call sighandler0
+      end
+   loop
+
+(code 'wrBytesCEX_F)
+   do
+      cc write(C X E)  # Write buffer
+      null A  # OK?
+      if ns  # Yes
+         sub E A  # Decrement count
+         jz Ret  # Return 'z' if OK
+         add X A  # Increment buffer pointer
+      else
+         call errno_A
+         cmp A EBADF  # Bad file number?
+         jz retnz  # Return 'nz'
+         cmp A EPIPE  # Broken pipe?
+         jz retnz  # Return 'nz'
+         cmp A ECONNRESET  # Connection reset by peer?
+         jz retnz  # Return 'nz'
+         cmp A EINTR  # Interrupted?
+         jne wrBytesErr  # No
+      end
+      nul (Signal)  # Signal?
+      if nz  # Yes
+         call sighandler0
+      end
+   loop
+
+(code 'clsChildY 0)
+   ld (Y) 0  # Clear 'pid'
+   cc close((Y I))  # Close 'hear'
+   cc close((Y II))  # and 'tell'
+   cc free((Y V))  # Free buffer
+   ret
+
+(code 'wrChildCXY)  # E
+   ld E (Y IV)  # Get buffer count
+   null E  # Any?
+   if z  # No
+      do
+         cc write((Y II) X C)  # Write buffer to 'tell' pipe
+         null A  # OK?
+         if ns  # Yes
+            sub C A  # Decrement count
+            jz Ret  # Done
+            add X A  # Increment buffer pointer
+         else
+            call errno_A
+            cmp A EAGAIN  # Would block?
+            break eq  # Yes
+            cmp A EPIPE  # Broken pipe?
+            jeq clsChildY  # Close child
+            cmp A ECONNRESET  # Connection reset by peer?
+            jeq clsChildY  # Close child
+            cmp A EINTR  # Interrupted?
+            jne wrChildErr  # No
+         end
+      loop
+   end
+   ld A (Y V)  # Get buffer
+   add E C  # Increment count
+   add E 2  # plus count size
+   call allocAE_A  # Extend buffer
+   ld (Y V) A  # Store
+   ld E (Y IV)  # Get buffer count again
+   add E (Y IV)  # Point to new count
+   ld A C  # Store new
+   st2 (E)
+   add E 2  # Point to new data
+   movn (E) (X) C  # Copy data
+   add C 2  # Total new size
+   add (Y IV)  # Add to buffer count
+   ret
+
+(code 'flushA_F 0)
+   null A  # Output file?
+   if nz  # Yes
+      push E
+      ld E (A I)  # Get 'ix'
+      null E  # Any?
+      if nz  # Yes
+         push C
+         push X
+         ld (A I) 0  # Clear 'ix'
+         ld C (A)  # Get 'fd'
+         lea X (A III)  # Buffer pointer
+         call wrBytesCEX_F  # Write buffer
+         pop X
+         pop C
+      end
+      pop E
+   end
+   ret  # Return 'z' if OK
+
+(code 'flushAll)  # C
+   ld C 0  # Iterate output files
+   do
+      cmp C (OutFDs)  # 'fd' < 'OutFDs'?
+   while lt
+      ld A C  # Get vector index
+      add A (OutFiles)  # Get OutFile
+      ld A (A)
+      call flushA_F  # Flush it
+      add C I  # Increment vector index
+   loop
+   ret
+
+### Low level I/O ###
+(code 'stdinByte_FA)
+   push Z
+   ld Z ((InFiles))  # Get stdin
+   null Z  # Open?
+   if nz  # Yes
+      call getBinaryZ_FB  # Get byte
+      zxt
+      pop Z
+      ret
+   end
+   setc
+   pop Z
+   ret
+
+(code 'getBinaryZ_FB 0)
+   ld A (Z I)  # Get 'ix'
+   cmp A (Z II)  # Equals 'cnt'?
+   if eq  # Yes
+      call slowZ_F  # Read into buffer
+      jz retc  # EOF (c)
+      ld A 0  # 'ix'
+   end
+   add (Z I) 1  # Increment 'ix'
+   add A Z  # Fetch byte (nc)
+   ld B (A VII)  # from buffer
+   ret  # nc
+
+# Add next byte to a number
+(code 'byteNumBCX_CX 0)
+   zxt
+   big X  # Big number?
+   if z  # No: Direct buffer pointer
+      # xxxxx.xxxxxxx.xxxxxxx.xxxxxxx.xxxxxxx.xxxxxxx.xxxxxxx.xxxxxxS010
+      #    59      51      43      35      27      19      11       3
+      cmp C 59  # Short digit full?
+      if ne  # No
+         shl A C  # Shift byte to character position
+         or (X) A  # Combine with short number
+         add C 8  # Increment position
+         ret
+      end
+      ld C (X)  # Get short number
+      shr C 3  # De-normalize, keep sign bit
+      shl A 56  # Combine byte with digit
+      or C A
+      call boxNum_A  # Box number
+      ld (A DIG) C
+      ld (X) A
+      ld X A
+      ld C 0  # Start new digit
+      ret
+   end
+   null C  # Last bit of big digit?
+   if z  # Yes
+      ld C (X DIG)
+      shr A 1  # Get lowest bit
+      rcr C 1  # into highest bit of big digit
+      ld (X DIG) C
+      rcl A 1  # Get sign bit into A
+      shl A 3  # Normalize with sign
+      or A CNT  # Make short number
+      ld (X BIG) A
+      ld C 11  # Set up for second byte
+      ret
+   end
+   cmp C 59  # Short digit full?
+   if ne  # No
+      shl A C  # Shift byte to character position
+      or (X BIG) A  # Combine with name digit
+      add C 8  # Increment position
+      ret
+   end
+   ld C (X BIG)  # Get short number
+   shr C 3  # De-normalize, keep sign bit
+   shl A 56  # Combine byte with digit
+   or C A
+   call boxNum_A  # Box number
+   ld (A DIG) C
+   ld (X BIG) A
+   ld X A
+   ld C 0  # Start new digit
+   ret
+
+# Read binary expression
+(code 'binReadZ_FE)
+   call (GetBinZ_FB)  # Tag byte?
+   jc ret  # No
+   nul B  # NIX?
+   jz retNil  # Return NIL
+   zxt
+   test B (hex "FC")  # Atomic?
+   if z  # No
+      ld E A
+      cmp B BEG  # Begin a list?
+      jnz retnc  # No: Return DOT or END (also in B)
+      call binReadZ_FE  # Else read list
+      jc ret
+      push X
+      call consE_X  # First cell
+      ld (X) E
+      ld (X CDR) Nil
+      link
+      push X  # <L I> Save it
+      link
+      do
+         call binReadZ_FE  # Next item
+         jc 10  # EOF
+         cmp E END  # Any?
+      while ne  # Yes
+         cmp E DOT  # Dotted pair?
+         if eq
+            cmp B DOT  # Only if B is also DOT (to distinguish from Zero)
+            if eq  # Yes
+               call binReadZ_FE  # Get CDR
+               if c  # EOF
+10                drop
+                  pop X
+                  ret  # Return 'c'
+               end
+               cmp E END  # Circular list?
+               ldz E (L I)  # Yes: Get first cell
+               ld (X CDR) E  # Store in last cell
+               break T
+            end
+         end
+         call consE_C  # Append next cell
+         ld (C) E
+         ld (C CDR) Nil
+         ld (X CDR) C
+         ld X C
+      loop
+      ld E (L I)  # Return list
+      drop  # Return 'nc'
+      pop X
+      ret
+   end
+   push X
+   link
+   push ZERO  # <L I> Result
+   ld X S
+   link
+   ld E A  # Get tag byte
+   shr E 2  # Count
+   and A 3  # Tag
+   if z  # NUMBER
+      ld C 3  # Build signed number
+      cmp E 63  # More than one chunk?
+      if eq  # Yes
+         do
+            do
+               call (GetBinZ_FB)  # Next byte?
+               jc 90  # No
+               call byteNumBCX_CX
+               sub E 1  # Decrement count
+            until z
+            call (GetBinZ_FB)  # Next count?
+            jc 90  # No
+            zxt
+            ld E A
+            cmp B 255  # Another chunk?
+         until ne  # No
+         or B B  # Empty?
+         jz 20  # Yes
+      end
+      do
+         call (GetBinZ_FB)  # Next byte?
+         jc 90  # No
+         call byteNumBCX_CX  # (B is zero (not DOT) if Zero)
+         sub E 1  # Decrement count
+      until z
+20    ld E (L I)  # Get result
+      big X  # Big number?
+      if nz  # Yes
+         ld A (X BIG)  # Get last short
+         and A SIGN  # Sign bit
+         off (X BIG) SIGN
+         or E A  # Set sign bit in result
+      end
+   else  # INTERN, TRANSIENT or EXTERN
+      push A  # Tag
+      ld C 4  # Build name
+      cmp E 63  # More than one chunk?
+      if eq  # Yes
+         do
+            do
+               call (GetBinZ_FB)  # Next byte?
+               jc 90  # No
+               call byteSymBCX_CX
+               sub E 1  # Decrement count
+            until z
+            call (GetBinZ_FB)  # Next count?
+            jc 90  # No
+            zxt
+            ld E A
+            cmp B 255  # Another chunk?
+         until ne  # No
+         or B B  # Empty?
+         jz 30  # Yes
+      end
+      do
+         call (GetBinZ_FB)  # Next byte?
+         jc 90  # No
+         call byteSymBCX_CX
+         sub E 1  # Decrement count
+      until z
+30    ld X (L I)  # Get name
+      pop A  # Get tag
+      cmp A TRANSIENT  # Transient?
+      if eq  # Yes
+         call consSymX_E  # Build symbol
+      else
+         cmp A INTERN  # Internal?
+         if eq  # Yes
+            push Y
+            call findSymX_E  # Find or create it
+            pop Y
+         else  # External
+            null (Extn)  # External symbol offset?
+            if nz  # Yes
+               ld A X  # Get file number
+               shr A 24  # Lower 8 bits
+               ld C A  # into C
+               and C (hex "FF")
+               shr A 12  # Upper 8 bits
+               and A (hex "FF00")
+               or A C
+               add A (Extn)  # Add external symbol offset
+               shl A 24
+               ld C A  # Lower result bits
+               shl A 12
+               or A C
+               and A (hex "000FF000FF000000")  # Mask file number
+               and X (hex "FFF00FFF00FFFFFF")  # Mask object ID
+               or X A  # Combine
+            end
+            call externX_E  # New external symbol
+         end
+      end
+   end
+   clrc
+90 drop
+   pop X
+   ret
+
+# Binary print next byte from a number
+(code 'prByteCEXY 0)
+   null C  # New round?
+   if z  # Yes
+      cnt X  # Short number?
+      if z  # No
+         ld E (X DIG)  # Next digit
+         ld X (X BIG)
+      else
+         ld E X  # Get short
+         shr E 4  # Normalize
+      end
+      shr Y 1  # Get overflow bit
+      rcl E 1  # Shift into digit
+      rcl Y 1  # Keep new overflow bit
+      ld C 8  # Init count
+   end
+   ld A E  # Output next byte
+   call (PutBinBZ)
+   shr E 8  # Shift to next
+   sub C 1  # Decrement count
+   ret
+
+# Binary print short number
+(code 'prCntCE 0)
+   ld A E
+   do
+      shr A 8  # More bytes?
+   while nz  # Yes
+      add C 4  # Increment count
+   loop
+   ld A C  # Output tag byte
+   call (PutBinBZ)
+   shr C 2  # Discard tag bits
+   do
+      ld A E  # Next data byte
+      shr E 8
+      call (PutBinBZ)  # Output data byte
+      sub C 1  # More?
+   until z  # No
+   ret
+
+# Binary print expression
+(code 'prTellEZ 0)
+   ld (PutBinBZ) putTellBZ  # Set binary print function
+   ld (Extn) 0  # Set external symbol offset to zero
+   call binPrintEZ
+   ret
+
+(code 'prE)
+   ld (PutBinBZ) putStdoutB  # Set binary print function
+(code 'binPrintEZ)
+   cnt E  # Short number?
+   if nz  # Yes
+      ld C 4  # Count significant bytes (adjusted to tag)
+      shr E 3  # Normalize
+      jmp prCntCE  # Output 'cnt'
+   end
+   big E  # Big number?
+   if nz  # Yes
+      push X
+      push Y
+      push E  # Save signed number
+      off E SIGN  # Make positive
+      ld X E  # Keep in X
+      ld A 8  # Count 8 significant bytes
+      do
+         ld C (E DIG)  # Keep digit
+         ld E (E BIG)  # More cells?
+         cnt E
+      while z  # Yes
+         add A 8  # Increment count by 8
+      loop
+      shr E 4  # Normalize short
+      shl C 1  # Get most significant bit of last digit
+      addc E E  # Any significant bits in short number?
+      if nz  # Yes
+         do
+            add A 1  # Increment count
+            shr E 8  # More bytes?
+         until z  # No
+      end
+      pop Y  # Get sign
+      shr Y 3  # into lowest bit
+      ld C 0  # Init byte count
+      cmp A 63  # Single chunk?
+      if lt  # Yes
+         push A  # <S> Count
+         shl A 2  # Adjust to tag byte
+         call (PutBinBZ)  # Output tag byte
+         do
+            call prByteCEXY  # Output next data bye
+            sub (S) 1  # More?
+         until z  # No
+      else
+         sub A 63  # Adjust count
+         push A  # <S I> Count
+         ld A (* 4 63)  # Output first tag byte
+         call (PutBinBZ)
+         push 63  # <S> and first 63 data bytes
+         do
+            call prByteCEXY  # Output next data bye
+            sub (S) 1  # More?
+         until z  # No
+         do
+            cmp (S I) 255  # Count greater or equal 255?
+         while ge  # Yes
+            ld A 255  # Next chunk
+            ld (S) A  # and the next 255 data bytes
+            call (PutBinBZ)  # Output count byte
+            do
+               call prByteCEXY  # Output next data bye
+               sub (S) 1  # More?
+            until z  # No
+            sub (S I) 255  # Decrement counter
+         loop
+         pop A  # Drop second count
+         ld A (S)  # Retrieve count
+         call (PutBinBZ)  # Output last count
+         do
+            sub (S) 1  # More?
+         while ge  # Yes
+            call prByteCEXY  # Output next data bye
+         loop
+      end
+      pop A  # Drop count
+      pop Y
+      pop X
+      ret
+   end
+   sym E  # Symbol?
+   if nz  # Yes
+      cmp E Nil  # NIL?
+      if eq  # Yes
+         ld A NIX
+         jmp (PutBinBZ)  # Output NIX
+      end
+      sym (E TAIL)  # External symbol?
+      if nz  # Yes
+         ld E (E TAIL)
+         call nameE_E  # Get name
+         null (Extn)  # External symbol offset?
+         if nz  # Yes
+            ld A E  # Get file number
+            shr A 24  # Lower 8 bits
+            ld C A  # into C
+            and C (hex "FF")
+            shr A 12  # Upper 8 bits
+            and A (hex "FF00")
+            or A C
+            sub A (Extn)  # Subtract external symbol offset
+            shl A 24
+            ld C A  # Lower result bits
+            shl A 12
+            or A C
+            and A (hex "000FF000FF000000")  # Mask file number
+            and E (hex "FFF00FFF00FFFFFF")  # Mask object ID
+            or E A  # Combine
+         end
+         shl E 2  # Strip status bits
+         shr E 6  # Normalize
+         ld C (+ 4 EXTERN)  # Count significant bytes (adjusted to tag)
+         jmp prCntCE  # Output external name
+      end
+      push X
+      push Y
+      ld X (E TAIL)
+      call nameX_X  # Get name
+      zero X  # Any?
+      if eq  # No
+         ld A NIX
+         call (PutBinBZ)  # Output NIX
+      else
+         ld Y Intern
+         call isInternEXY_F  # Internal symbol?
+         ld C INTERN  # Yes
+         ldnz C TRANSIENT  # No
+         cnt X  # Short name?
+         if nz  # Yes
+            add C 4  # Count significant bytes (adjusted to tag)
+            ld E X  # Get name
+            shr E 4  # Normalize
+            call prCntCE  # Output internal or transient name
+         else  # Long name
+            ld E X  # Into E
+            ld A 8  # Count significant bytes
+            do
+               ld E (E BIG)  # More cells?
+               cnt E
+            while z  # Yes
+               add A 8  # Increment count
+            loop
+            shr E 4  # Any significant bits in short name?
+            if nz  # Yes
+               do
+                  add A 1  # Increment count
+                  shr E 8  # More bytes?
+               until z  # No
+            end
+            ld E A  # Keep count in E
+            cmp A 63  # Single chunk?
+            if lt  # Yes
+               shl A 2  # Adjust to tag byte
+               or A C  # Combine with tag
+               call (PutBinBZ)  # Output tag byte
+               ld C 0
+               do
+                  call symByteCX_FACX  # Next data byte
+                  call (PutBinBZ)  # Output it
+                  sub E 1  # More?
+               until z  # No
+            else
+               ld A (* 4 63)  # Output first tag byte
+               or A C  # Combine with tag
+               call (PutBinBZ)
+               sub E 63  # Adjust count
+               push E  # <S> Count
+               ld E 63  # and first 63 data bytes
+               ld C 0
+               do
+                  call symByteCX_FACX  # Next data byte
+                  call (PutBinBZ)  # Output it
+                  sub E 1  # More?
+               until z  # No
+               do
+                  cmp (S) 255  # Count greater or equal 255?
+               while ge  # Yes
+                  ld A 255  # Next chunk
+                  ld E A  # and the next 255 data bytes
+                  call (PutBinBZ)  # Output count byte
+                  do
+                     call symByteCX_FACX  # Next data byte
+                     call (PutBinBZ)  # Output it
+                     sub E 1  # More?
+                  until z  # No
+                  sub (S) 255  # Decrement counter
+               loop
+               pop E  # Retrieve count
+               ld A E
+               call (PutBinBZ)  # Output last count
+               do
+                  sub E 1  # More?
+               while ge  # Yes
+                  call symByteCX_FACX  # Next data byte
+                  call (PutBinBZ)  # Output it
+               loop
+            end
+         end
+      end
+      pop Y
+      pop X
+      ret
+   end
+   push X
+   push Y
+   ld X E  # Get expression
+   ld Y E  # in X and Y
+   ld A BEG  # Begin list
+   call (PutBinBZ)
+   do
+      ld E (X)  # Next item
+      call binPrintEZ
+      ld X (X CDR)  # More?
+      cmp X Nil
+   while ne  # Yes
+      cmp X Y  # Circular?
+      if eq  # Yes
+         ld A DOT  # Output dotted pair
+         call (PutBinBZ)
+         break T
+      end
+      atom X  # End of list?
+      if nz  # Yes
+         ld A DOT  # Output dotted pair
+         call (PutBinBZ)
+         ld E X  # Output atom
+         call binPrintEZ
+         pop Y  # Return
+         pop X
+         ret
+      end
+   loop
+   pop Y
+   pop X
+   ld A END  # End list
+   jmp (PutBinBZ)
+
+# Family IPC
+(code 'putTellBZ 0)
+   ld (Z) B  # Store byte
+   add Z 1  # Increment pointer
+   lea A ((TellBuf) (- PIPE_BUF 1))  # Reached (TellBuf + PIPE_BUF - 1)?
+   cmp Z A
+   jeq tellErr  # Yes
+   ret
+
+(code 'tellBegZ_Z 0)
+   ld (TellBuf) Z  # Set global buffer
+   add Z 2  # 2 bytes space for count
+   set (Z) BEG  # Begin a list
+   add Z 1
+   ret
+
+(code 'tellEndZ)
+   push X
+   push Y
+   set (Z) END  # Close list
+   add Z 1
+   ld X (TellBuf)  # Get buffer
+   ld E Z  # Calculate total size
+   sub E X
+   ld A E  # Size in A
+   sub A 2  # without count
+   st2 (X)  # Store in buffer count
+   push A  # <S> Size
+   ld C (Tell)  # File descriptor
+   null C  # Any?
+   if nz  # Yes
+      call wrBytesCEX_F  # Write buffer to pipe
+      if nz  # Not successful
+         cc close(C)  # Close 'Tell'
+         ld (Tell) 0  # Clear 'Tell'
+      end
+   end
+   ld Y (Child)  # Iterate children
+   ld Z (Children)  # Count
+   do
+      sub Z VI  # More?
+   while ge  # Yes
+      null (Y)  # 'pid'?
+      if nz  # Yes
+         ld C (S)  # Get size
+         lea X ((TellBuf) 2)  # and data
+         call wrChildCXY  # Write to child
+      end
+      add Y VI  # Increment by sizeof(child)
+   loop
+   pop A  # Drop size
+   pop Y
+   pop X
+   ret
+
+(code 'rdHear_FE)
+   push Z
+   ld A (Hear)  # Get 'hear' fd
+   shl A 3  # Vector index
+   add A (InFiles)  # Get vector
+   ld Z (A)  # Input file
+   ld (GetBinZ_FB) getBinaryZ_FB  # Set binary read function
+   ld (Extn) 0  # Set external symbol offset to zero
+   call binReadZ_FE  # Read item
+   pop Z
+   ret
+
+# Return next byte from symbol name
+(code 'symByteCX_FACX 0)
+   null C  # New round?
+   if z  # Yes
+      zero X  # Done?
+      jeq ret  # Yes: Return 'z'
+      cnt X  # Short?
+      if nz  # Yes
+         ld C X  # Get short
+         shr C 4  # Normalize
+         ld X ZERO  # Clear for next round
+      else
+         ld C (X DIG)  # Get next digit
+         ld X (X BIG)
+      end
+   end
+   ld A C  # Get byte
+   shr C 8  # Shift out
+   or B B  # Return B
+   zxt
+   ret
+
+(code 'symCharCX_FACX 0)  # Return next char from symbol name
+   call symByteCX_FACX  # First byte
+   jz ret  # Return 'z' if none
+   cmp B (hex "FF")  # Special?
+   if ne  # No
+      cmp B 128  # Single byte?
+      if ge  # No
+         test B (hex "20")  # Two bytes?
+         if z  # Yes
+            and B (hex "1F")  # First byte 110xxxxx
+            shl A 6  # xxxxx000000
+            push A
+         else  # Three bytes
+            and B (hex "F")  # First byte 1110xxxx
+            shl A 6  # xxxx000000
+            push A
+            call symByteCX_FACX  # Second byte
+            and B (hex "3F")  # 10xxxxxx
+            or A (S)  # Combine
+            shl A 6  # xxxxxxxxxx000000
+            ld (S) A
+         end
+         call symByteCX_FACX  # Last byte
+         and B (hex "3F")  # 10xxxxxx
+         or (S) A  # Combine
+         pop A  # Get result
+      end
+      ret
+   end
+   ld A TOP  # Return special "top" character
+   or A A
+   ret
+
+(code 'bufStringE_SZ 0)
+   ld Z S  # 8-byte-buffer
+   push (Z)  # Save return address
+   push X  # and X
+   cmp E Nil  # Empty?
+   if ne  # No
+      ld X (E TAIL)
+      call nameX_X  # Get name
+      ld C 0
+      do
+         call symByteCX_FACX
+      while nz
+         ld (Z) B  # Store next byte
+         add Z 1
+         test Z 7  # Buffer full?
+         if z  # Yes
+            sub S 8  # Extend buffer
+            movm (S) (S 8) (Z)
+            sub Z 8  # Reset buffer pointer
+         end
+      loop
+   end
+   set (Z) 0  # Null byte
+   add Z 8  # Round up
+   off Z 7
+   pop X
+   ret
+
+(code 'pathStringE_SZ 0)
+   ld Z S  # 8-byte-buffer
+   push (Z)  # Save return address
+   push X  # and X
+   cmp E Nil  # Empty?
+   if ne  # No
+      ld X (E TAIL)
+      call nameX_X  # Get name
+      ld C 0
+      call symByteCX_FACX  # First byte
+      if nz
+         cmp B (char "+")  # Plus?
+         if eq
+            ld (Z) B  # Store "+"
+            add Z 1
+            call symByteCX_FACX  # Second byte
+         end
+         cmp B (char "@")  # Home path?
+         if ne
+            do
+               ld (Z) B  # Store byte
+               add Z 1
+               test Z 7  # Buffer full?
+               if z  # Yes
+                  sub S 8  # Extend buffer
+                  movm (S) (S 8) (Z)
+                  sub Z 8  # Reset buffer pointer
+               end
+               call symByteCX_FACX  # Next byte?
+            until z  # No
+         else
+            push E
+            ld E (Home)  # Home directory?
+            null E
+            if nz  # Yes
+               do
+                  ld B (E)
+                  ld (Z) B  # Store next byte
+                  add Z 1
+                  test Z 7  # Buffer full?
+                  if z  # Yes
+                     sub S 8  # Extend buffer
+                     movm (S) (S 8) (Z)
+                     sub Z 8  # Reset buffer pointer
+                  end
+                  add E 1
+                  nul (E)  # More?
+               until z  # No
+            end
+            pop E
+            do
+               call symByteCX_FACX
+            while nz
+               ld (Z) B  # Store next byte
+               add Z 1
+               test Z 7  # Buffer full?
+               if z  # Yes
+                  sub S 8  # Extend buffer
+                  movm (S) (S 8) (Z)
+                  sub Z 8  # Reset buffer pointer
+               end
+            loop
+         end
+      end
+   end
+   set (Z) 0  # Null byte
+   add Z 8  # Round up
+   off Z 7
+   pop X
+   ret
+
+# (path 'any) -> sym
+(code 'doPath 2)
+   push Z
+   ld E ((E CDR))  # Get arg
+   call evSymE_E  # Evaluate to a symbol
+   call pathStringE_SZ  # Write to stack buffer
+   ld E S  # Make transient symbol
+   call mkStrE_E
+   ld S Z  # Drop buffer
+   pop Z
+   ret
+
+# Add next char to symbol name
+(code 'charSymACX_CX 0)
+   cmp A (hex "80")  # ASCII??
+   jlt byteSymBCX_CX  # Yes: 0xxxxxxx
+   cmp A (hex "800")  # Double-byte?
+   if lt  # Yes
+      push A  # 110xxxxx 10xxxxxx
+      shr A 6  # Upper five bits
+      and B (hex "1F")
+      or B (hex "C0")
+      call byteSymBCX_CX  # Add first byte
+      pop A
+      and B (hex "3F")  # Lower 6 bits
+      or B (hex "80")
+      jmp byteSymBCX_CX  # Add second byte
+   end
+   cmp A TOP  # Special "top" character?
+   if eq  # Yes
+      ld B (hex "FF")
+      jmp byteSymBCX_CX
+   end
+   push A  # 1110xxxx 10xxxxxx 10xxxxxx
+   shr A 12  # Hightest four bits
+   and B (hex "0F")
+   or B (hex "E0")
+   call byteSymBCX_CX  # Add first byte
+   ld A (S)
+   shr A 6  # Middle six bits
+   and B (hex "3F")
+   or B (hex "80")
+   call byteSymBCX_CX  # Add second byte
+   pop A
+   and B (hex "3F")  # Lowest 6 bits
+   or B (hex "80")  # Add third byte
+
+# Add next byte to symbol name
+(code 'byteSymBCX_CX 0)
+   zxt
+   big X  # Long name?
+   if z  # No: Direct buffer pointer
+      # 0000.xxxxxxx.xxxxxxx.xxxxxxx.xxxxxxx.xxxxxxx.xxxxxxx.xxxxxxx0010
+      #   60      52      44      36      28      20      12       4
+      cmp C 60  # Short digit full?
+      if ne  # No
+         shl A C  # Shift byte to character position
+         or (X) A  # Combine with name digit
+         add C 8  # Increment position
+         ret
+      end
+      ld C (X)  # Get short number
+      shr C 4  # De-normalize
+      shl A 56  # Combine byte with digit
+      or C A
+      call boxNum_A  # Box number
+      ld (A DIG) C
+      ld (X) A
+      ld X A
+      ld C 4  # Start new digit
+      ret
+   end
+   cmp C 60  # Short digit full?
+   if ne  # No
+      shl A C  # Shift byte to character position
+      or (X BIG) A  # Combine with name digit
+      add C 8  # Increment position
+      ret
+   end
+   ld C (X BIG)  # Get short number
+   shr C 4  # De-normalize
+   shl A 56  # Combine byte with digit
+   or C A
+   call boxNum_A  # Box number
+   ld (A DIG) C
+   ld (X BIG) A
+   ld X A
+   ld C 4  # Start new digit
+   ret
+
+(code 'currFdX_C 0)
+   ld C (EnvInFrames)  # InFrames or OutFrames?
+   or C (EnvOutFrames)
+   jz noFdErrX  # No
+(code 'currFd_C)
+   ld C (EnvOutFrames)  # OutFrames?
+   null C
+   if z  # No
+      ld C (EnvInFrames)  # Use InFrames
+   else
+      null (EnvInFrames)  # InFrames?
+      if nz  # Both
+         cmp C (EnvInFrames)  # OutFrames > InFrames?
+         if gt  # Yes
+            ld C (EnvInFrames)  # Take InFrames
+         end
+      end
+   end
+   ld C (C I)  # Get 'fd'
+   ret
+
+(code 'rdOpenEXY)
+   cmp E Nil  # Standard input?
+   if eq  # Yes
+      ld (Y I) 0  # fd = stdin
+      ld (Y II) 0  # pid = 0
+   else
+      num E  # Descriptor?
+      if nz  # Yes
+         cnt E  # Need short
+         jz cntErrEX
+         ld (Y II) 0  # pid = 0
+         ld A E  # Get fd
+         shr A 4  # Normalize
+         if c  # Negative
+            ld C (EnvInFrames)  # Fetch from input frames
+            do
+               ld C (C)  # Next frame
+               null C  # Any?
+               jz badFdErrEX  # No
+               sub A 1  # Found frame?
+            until z  # Yes
+            ld A (C I)  # Get fd from frame
+         end
+         ld (Y I) A  # Store 'fd'
+         shl A 3  # Vector index
+         cmp A (InFDs)  # 'fd' >= 'InFDs'?
+         jge badFdErrEX  # Yes
+         add A (InFiles)  # Get vector
+         ld A (A)  # Input file
+         null A  # Any?
+         jz badFdErrEX  # No
+      else
+         push Z
+         sym E  # File name?
+         if nz  # Yes
+            ld (Y II) 1  # pid = 1
+            call pathStringE_SZ
+            do
+               ld B (S)  # First char
+               cmp B (char "+")  # Plus?
+               if eq  # Yes
+                  cc open(&(S 1) (| O_APPEND O_CREAT O_RDWR) (oct "0666"))
+               else
+                  cc open(S O_RDONLY)
+               end
+               nul4  # OK?
+            while s  # No
+               call errno_A
+               cmp A EINTR  # Interrupted?
+               jne openErrEX  # No
+               nul (Signal)  # Signal?
+               if nz  # Yes
+                  call sighandlerX
+               end
+            loop
+            ld (Y I) A  # Save 'fd'
+            ld B (S)  # First char
+            cmp B (char "+")  # Plus?
+            if eq  # Yes
+               cc strdup(&(S 1))  # Duplicate name
+            else
+               cc strdup(S)  # Duplicate name
+            end
+            ld C (Y I)  # Get 'fd'
+            call initInFileCA_A
+            ld A (Y I)  # Get fd
+            call closeOnExecAX
+            ld S Z  # Drop buffer
+         else  # Else pipe
+            push X
+            push 0  # End-of-buffers marker
+            ld X E  # Get list
+            ld E (X)  # Pathname
+            call xSymE_E  # Make symbol
+            call pathStringE_SZ  # Write to stack buffer
+            do
+               ld X (X CDR)  # Arguments?
+               atom X
+            while z  # Yes
+               push Z  # Buffer chain
+               ld E (X)  # Next argument
+               call xSymE_E  # Make symbol
+               call bufStringE_SZ  # Write to stack buffer
+            loop
+            push Z
+            ld Z S  # Point to chain
+            ld X Z
+            push 0  # NULL terminator
+            do
+               lea A (X I)  # Buffer pointer
+               push A  # Push to vector
+               ld X (X)  # Follow chain
+               null (X)  # Done?
+            until z  # Yes
+            ld X (X I)  # Retrieve X
+            push A  # Create 'pipe' structure
+            cc pipe(S)  # Open pipe
+            nul4  # OK?
+            jnz pipeErrX
+            ld4 (S)  # Get pfd[0]
+            call closeOnExecAX
+            ld4 (S 4)  # Get pfd[1]
+            call closeOnExecAX
+            cc fork()  # Fork child process
+            ld (Y II) A  # Set 'pid'
+            nul4  # In child?
+            js forkErrX
+            if z  # Yes
+               cc setpgid(0 0)  # Set process group
+               ld4 (S)  # Close read pipe
+               call closeAX
+               ld4 (S 4)  # Get write pipe
+               cmp A 1  # STDOUT_FILENO?
+               if ne  # No
+                  cc dup2(A 1)  # Dup to STDOUT_FILENO
+                  ld4 (S 4)  # Close write pipe
+                  call closeAX
+               end
+               cc execvp((S 8) &(S 8))  # Execute program
+               jmp execErrS  # Error if failed
+            end
+            cc setpgid(A 0)  # Set process group
+            ld4 (S 4)  # Close write pipe
+            call closeAX
+            ld4 (S)  # Get read pipe
+            ld (Y I) A  # Set 'fd'
+            call initInFileA_A
+            pop A  # Drop 'pipe' structure
+            do
+               ld S Z  # Clean up buffers
+               pop Z  # Chain
+               null Z  # End?
+            until z  # Yes
+            pop X
+         end
+         pop Z
+      end
+   end
+   ret
+
+(code 'wrOpenEXY)
+   cmp E Nil  # Standard output?
+   if eq  # Yes
+      ld (Y I) 1  # fd = stdout
+      ld (Y II) 0  # pid = 0
+   else
+      num E  # Descriptor?
+      if nz  # Yes
+         cnt E  # Need short
+         jz cntErrEX
+         ld (Y II) 0  # pid = 0
+         ld A E  # Get fd
+         shr A 4  # Normalize
+         if c  # Negative
+            ld C (EnvOutFrames)  # Fetch from output frames
+            do
+               ld C (C)  # Next frame
+               null C  # Any?
+               jz badFdErrEX  # No
+               sub A 1  # Found frame?
+            until z  # Yes
+            ld A (C I)  # Get fd from frame
+         end
+         ld (Y I) A  # Store 'fd'
+         shl A 3  # Vector index
+         cmp A (OutFDs)  # 'fd' >= 'OutFDs'?
+         jnc badFdErrEX  # Yes
+         add A (OutFiles)  # Get vector
+         ld A (A)  # Slot?
+         null A  # Any?
+         jz badFdErrEX  # No
+      else
+         push Z
+         sym E  # File name?
+         if nz  # Yes
+            ld (Y II) 1  # pid = 1
+            call pathStringE_SZ
+            do
+               ld B (S)  # First char
+               cmp B (char "+")  # Plus?
+               if eq  # Yes
+                  cc open(&(S 1) (| O_APPEND O_CREAT O_WRONLY) (oct "0666"))
+               else
+                  cc open(S (| O_CREAT O_TRUNC O_WRONLY) (oct "0666"))
+               end
+               nul4  # OK?
+            while s  # No
+               call errno_A
+               cmp A EINTR  # Interrupted?
+               jne openErrEX  # No
+               nul (Signal)  # Signal?
+               if nz  # Yes
+                  call sighandlerX
+               end
+            loop
+            ld (Y I) A  # Save 'fd'
+            call initOutFileA_A
+            ld A (Y I)  # Get fd
+            call closeOnExecAX
+            ld S Z  # Drop buffer
+         else  # Else pipe
+            push X
+            push 0  # End-of-buffers marker
+            ld X E  # Get list
+            ld E (X)  # Pathname
+            call xSymE_E  # Make symbol
+            call pathStringE_SZ  # Write to stack buffer
+            do
+               ld X (X CDR)  # Arguments?
+               atom X
+            while z  # Yes
+               push Z  # Buffer chain
+               ld E (X)  # Next argument
+               call xSymE_E  # Make symbol
+               call bufStringE_SZ  # Write to stack buffer
+            loop
+            push Z
+            ld Z S  # Point to chain
+            ld X Z
+            push 0  # NULL terminator
+            do
+               lea A (X I)  # Buffer pointer
+               push A  # Push to vector
+               ld X (X)  # Follow chain
+               null (X)  # Done?
+            until z  # Yes
+            ld X (X I)  # Retrieve X
+            push A  # Create 'pipe' structure
+            cc pipe(S)  # Open pipe
+            nul4  # OK?
+            jnz pipeErrX
+            ld4 (S)  # Get pfd[0]
+            call closeOnExecAX
+            ld4 (S 4)  # Get pfd[1]
+            call closeOnExecAX
+            cc fork()  # Fork child process
+            ld (Y II) A  # Set 'pid'
+            nul4  # In child?
+            js forkErrX
+            if z  # Yes
+               cc setpgid(0 0)  # Set process group
+               ld4 (S 4)  # Close write pipe
+               call closeAX
+               ld4 (S)  # Get read pipe
+               cmp A 0  # STDIN_FILENO?
+               if ne  # No
+                  cc dup2(A 0)  # Dup to STDIN_FILENO
+                  ld4 (S)  # Close read pipe
+                  call closeAX
+               end
+               cc execvp((S 8) &(S 8))  # Execute program
+               jmp execErrS  # Error if failed
+            end
+            cc setpgid(A 0)  # Set process group
+            ld4 (S)  # Close read pipe
+            call closeAX
+            ld4 (S 4)  # Get write pipe
+            ld (Y I) A  # Set 'fd'
+            call initOutFileA_A
+            pop C  # Drop 'pipe' structure
+            do
+               ld S Z  # Clean up buffers
+               pop Z  # Chain
+               null Z  # End?
+            until z  # Yes
+            pop X
+         end
+         pop Z
+      end
+   end
+   ret
+
+(code 'ctOpenEXY)
+   num E  # Need symbol
+   jnz symErrEX
+   sym E
+   jz symErrEX
+   cmp E Nil  # Shared lock on current I/O channel?
+   if eq  # Yes
+      ld (Y I) -1  # 'fd'
+      call currFdX_C  # Get current fd
+      call rdLockFileC
+   else
+      cmp E TSym  # Exclusive lock on current I/O channel?
+      if eq  # Yes
+         ld (Y I) -1  # 'fd'
+         call currFdX_C  # Get current fd
+         call wrLockFileC
+      else
+         push Z
+         call pathStringE_SZ  # File name
+         do
+            ld B (S)  # First char
+            cmp B (char "+")  # Plus?
+            if eq  # Yes
+               cc open(&(S 1) (| O_CREAT O_RDWR) (oct "0666"))
+            else
+               cc open(S (| O_CREAT O_RDWR) (oct "0666"))
+            end
+            nul4  # OK?
+         while s  # No
+            call errno_A
+            cmp A EINTR  # Interrupted?
+            jne openErrEX  # No
+            nul (Signal)  # Signal?
+            if nz  # Yes
+               call sighandlerX
+            end
+         loop
+         ld S Z  # Drop buffer
+         pop Z
+         ld (Y I) A  # Save 'fd'
+         ld C A  # Keep in C
+         ld B (S)  # First char
+         cmp B (char "+")  # Plus?
+         if eq  # Yes
+            call rdLockFileC  # Read lock
+         else
+            call wrLockFileC  # Write lock
+         end
+         ld A (Y I)  # Get fd
+         call closeOnExecAX
+      end
+   end
+   ret
+
+(code 'getStdin_A 0)
+   push Z
+   ld Z (InFile)  # Current InFile
+   null Z  # Any?
+   if nz  # Yes
+      cmp Z ((InFiles))  # On stdin?
+      if ne  # No
+         ld A (Z I)  # Get 'ix'
+         cmp A (Z II)  # Equals 'cnt'?
+         if eq  # Yes
+            call slowZ_F  # Read into buffer
+            jz 90  # Return -1
+            ld A 0  # 'ix'
+         end
+         add (Z I) 1  # Increment 'ix'
+         add A Z  # Fetch byte
+         ld B (A VII)  # from buffer
+         cmp B 10  # Newline?
+         if z  # Yes
+            add (Z IV) 1  # Increment line
+         end
+         zxt  # Extend into A
+      else
+         push C
+         push E
+         push X
+         atom (Led)  # Line editor?
+         if nz  # No
+            ld C 0  # Standard input
+            ld E -1  # No timeout
+            ld X 0  # Runtime expression
+            call waitFdCEX_A  # Wait for events
+            call stdinByte_FA  # Get byte?
+            if c  # No
+               ld A -1  # Return -1
+            end
+         else
+            ld C (LineC)
+            null C  # First call?
+            if ns  # No
+               ld X (LineX)  # Get line status
+            else
+               ld E (Led)  # Run line editor
+               call runE_E
+               cmp E Nil  # NIL
+               if eq  # Yes
+                  ld X ZERO  # Empty
+               else
+                  ld X (E TAIL)
+                  call nameX_X  # Get name
+               end
+               ld C 0
+            end
+            call symByteCX_FACX  # Extract next byte
+            if z  # None
+               ld A 10  # Default to linefeed
+               ld C -1
+            end
+            ld (LineX) X  # Save line status
+            ld (LineC) C
+         end
+         pop X
+         pop E
+         pop C
+      end
+   else
+90    ld A -1  # Return EOF
+   end
+   ld (Chr) A
+   pop Z
+   ret
+
+(code 'getParse_A 0)
+   push C
+   push X
+   ld X (EnvParseX)  # Get parser status
+   ld C (EnvParseC)
+   call symByteCX_FACX  # Extract next byte
+   if z  # Done
+      ld A (EnvParseEOF)  # Yes
+      ld B (hex "FF")  # Fill upper bits
+      ror A 8  # Get next eof byte in B
+      ld (EnvParseEOF) A
+      sxt  # Extend B
+   end
+   ld (Chr) A
+   ld (EnvParseX) X  # Save status
+   ld (EnvParseC) C
+   pop X
+   pop C
+   ret
+
+(code 'pushInFilesY)
+   ld A (InFile)  # Current InFile?
+   null A
+   if nz  # Yes
+      ld (A III) (Chr)  # Save Chr in next
+   end
+   ld A (Y I)  # Get 'fd'
+   shl A 3  # Vector index
+   add A (InFiles)  # Get InFile
+   ld A (A)
+   ld (InFile) A  # Store new
+   null A  # Any?
+   if nz  # Yes
+      ld A (A III)  # Get 'next'
+   else
+      ld A -1
+   end
+   ld (Chr) A  # Save in 'Chr'
+   ld (Y III) (EnvGet_A)  # Save 'get'
+   ld (EnvGet_A) getStdin_A  # Set new
+   ld (Y) (EnvInFrames)  # Set link
+   ld (EnvInFrames) Y  # Link frame
+   ret
+
+(code 'pushOutFilesY)
+   ld A (Y I)  # Get 'fd'
+   shl A 3  # Vector index
+   add A (OutFiles)  # Get OutFile
+   ld (OutFile) (A)  # Store new
+   ld (Y III) (EnvPutB)  # Save 'put'
+   ld (EnvPutB) putStdoutB  # Set new
+   ld (Y) (EnvOutFrames)  # Set link
+   ld (EnvOutFrames) Y  # Link frame
+   ret
+
+(code 'pushCtlFilesY)
+   ld (Y) (EnvCtlFrames)  # Set link
+   ld (EnvCtlFrames) Y  # Link frame
+   ret
+
+(code 'popInFiles)  # C
+   ld C (EnvInFrames)  # Get InFrames
+   null (C II)  # 'pid'?
+   if nz  # Yes
+      cc close((C I))  # Close 'fd'
+      ld A (C I)  # Close input file
+      call closeInFileA
+      cmp (C II) 1  # 'pid' > 1?
+      if gt  # Yes
+         do
+            cc waitpid((C II) 0 0)  # Wait for pipe process
+            nul4  # OK?
+         while s  # No
+            call errno_A
+            cmp A EINTR  # Interrupted?
+            jne closeErrX
+            nul (Signal)  # Signal?
+            if nz  # Yes
+               call sighandler0
+            end
+         loop
+      end
+   end
+   ld (EnvGet_A) (C III)  # Retrieve 'get'
+   ld C (C)  # Get link
+   ld (EnvInFrames) C  # Restore InFrames
+   null C  # Any?
+   if z  # No
+      ld A ((InFiles))  # InFiles[0] (stdin)
+   else
+      ld A (C I)  # Get 'fd'
+      shl A 3  # Vector index
+      add A (InFiles)
+      ld A (A)  # Get previous InFile
+   end
+   ld (InFile) A  # Set InFile
+   null A  # Any?
+   if nz  # Yes
+      ld A (A III)  # Get 'next'
+   else
+      ld A -1
+   end
+   ld (Chr) A  # Save in 'Chr'
+   ret
+
+(code 'popOutFiles)  # C
+   ld A (OutFile)  # Flush OutFile
+   call flushA_F
+   ld C (EnvOutFrames)  # Get OutFrames
+   null (C II)  # 'pid'?
+   if nz  # Yes
+      cc close((C I))  # Close 'fd'
+      ld A (C I)  # Close input file
+      call closeOutFileA
+      cmp (C II) 1  # 'pid' > 1?
+      if gt  # Yes
+         do
+            cc waitpid((C II) 0 0)  # Wait for pipe process
+            nul4  # OK?
+         while s  # No
+            call errno_A
+            cmp A EINTR  # Interrupted?
+            jne closeErrX
+            nul (Signal)  # Signal?
+            if nz  # Yes
+               call sighandler0
+            end
+         loop
+      end
+   end
+   ld (EnvPutB) (C III)  # Retrieve 'put'
+   ld C (C)  # Get link
+   ld (EnvOutFrames) C  # Restore OutFrames
+   null C  # Any?
+   if z  # No
+      ld A ((OutFiles) I)  # OutFiles[1] (stdout)
+   else
+      ld A (C I)  # Get 'fd'
+      shl A 3  # Vector index
+      add A (OutFiles)
+      ld A (A)  # Get previous OutFile
+   end
+   ld (OutFile) A  # Set OutFile
+   ret
+
+(code 'popCtlFiles)  # C
+   ld C (EnvCtlFrames)  # Get CtlFrames
+   null (C I)  # 'fd' >= 0?
+   if ns  # Yes
+      cc close((C I))  # Close 'fd'
+   else
+      call currFd_C  # Get current fd
+      ld A (| F_UNLCK (hex "00000"))  # Unlock, length 0
+      call unLockFileAC  # Unlock
+   end
+   ld (EnvCtlFrames) ((EnvCtlFrames))  # Restore CtlFrames
+   ret
+
+# Get full char from input channel
+(code 'getChar_A 0)
+   ld A (Chr)  # Get look ahead
+   cmp B (hex "FF")  # Special "top" character?
+   if ne  # No
+      cmp B 128  # Single byte?
+      if ge  # No
+         test B (hex "20")  # Two bytes?
+         if z  # Yes
+            and B (hex "1F")  # First byte 110xxxxx
+            shl A 6  # xxxxx000000
+            push A
+         else  # Three bytes
+            and B (hex "F")  # First byte 1110xxxx
+            shl A 6  # xxxx000000
+            push A
+            call (EnvGet_A)  # Get second byte
+            and B (hex "3F")  # 10xxxxxx
+            or A (S)  # Combine
+            shl A 6  # xxxxxxxxxx000000
+            ld (S) A
+         end
+         call (EnvGet_A)  # Get last byte
+         and B (hex "3F")  # 10xxxxxx
+         or (S) A  # Combine
+         pop A  # Get result
+      end
+      ret
+   end
+   ld A TOP
+   ret
+
+# Skip White Space and Comments
+(code 'skipC_A 0)
+   ld A (Chr)
+   do
+      null A  # EOF?
+   while ns  # No
+      do
+         cmp B 32  # White space?
+      while le  # Yes
+         call (EnvGet_A)  # Get next
+         null A  # EOF?
+         js ret  # Yes
+      loop
+      cmp A C  # Comment char?
+   while eq  # Yes
+      call (EnvGet_A)
+      cmp C (char "#")  # Block comment?
+      jne 10  # No
+      cmp B (char "{")
+      if ne  # No
+10       do
+            cmp B 10  # Linefeed?
+         while ne  #No
+            null A  # EOF?
+            js ret  # Yes
+            call (EnvGet_A)
+         loop
+      else  # Block comment
+         do
+            call (EnvGet_A)
+            null A  # EOF?
+            js ret  # Yes
+            cmp B (char "}")  # End of block comment?
+            if eq
+               call (EnvGet_A)
+               cmp B (char "#")
+               break eq  # Yes
+            end
+         loop
+      end
+      call (EnvGet_A)
+   loop
+   ret
+
+(code 'testEscA_F 0)
+   do
+      null A  # EOF?
+      if s  # Yes
+         clrc  # Return NO
+         ret
+      end
+      cmp B (char "\^")  # Caret?
+      if eq  # Yes
+         call (EnvGet_A)  # Skip '^'
+         cmp B (char "?")  # Question-mark?
+         if eq  # Yes
+            ld B 127  # DEL
+         else
+            and B 31  # Control-character
+         end
+10       setc  # Return YES
+         ret
+      end
+      cmp B (char "\\")  # Backslash?
+      jnz 10  # No
+      call (EnvGet_A)  # Skip '\'
+      cmp B 10  # Newline?
+      jnz 10  # No
+      do
+         call (EnvGet_A)  # Skip white space
+         cmp B 32
+         continue eq
+         cmp B 9
+      until ne
+   loop
+
+(code 'anonymousX_FE 0)
+   ld C 0
+   call symByteCX_FACX  # First byte
+   cmp B (char "$")  # Starting with '$'?
+   jne Ret  # No
+   call symByteCX_FACX  # Second byte
+   cmp B (char "1")  # >= '1'?
+   if ge  # Yes
+      cmp B (char "7")  # <= '7'?
+      if le  # Yes
+         sub B (char "0")  # Digit
+         ld E A  # Calculate number
+         call symByteCX_FACX  # Third byte
+         do
+            cmp B (char "0")  # >= '0'?
+         while ge  # Yes
+            cmp B (char "7")  # <= '7'?
+         while le  # Yes
+            shl E 3  # Times 8
+            sub B (char "0")  # Digit
+            add E A  # Add to result
+            call symByteCX_FACX  # Next byte?
+            if z  # No
+               shl E 4  # Make symbol pointer
+               or E SYM
+               setz
+               ret
+            end
+         loop
+      end
+   end
+   ret
+
+(code 'rdAtomBYL_E)  # X
+   ld C 4  # Build name
+   lea X (L I)  # Safe
+   call byteSymBCX_CX  # Pack first char
+   ld A Y  # Get second
+   do
+      null A  # EOF?
+   while ns  # No
+      memb Delim "(DelimEnd-Delim)"  # Delimiter?
+      jeq 10  # Yes
+      cmp B (char "\\")  # Backslash?
+      if eq  # Yes
+         call (EnvGet_A)  # Get next char
+      end
+      call byteSymBCX_CX  # Pack char
+      call (EnvGet_A)  # Get next
+   loop
+10 ld X (L I)  # Get name
+   ld A (Scl)  # Scale
+   shr A 4  # Normalize
+   ld (Sep3) 0  # Thousand separator
+   ld (Sep0) (char ".")  # Decimal separator
+   call symToNumXA_FE  # Legal number?
+   if nc  # No
+      ld X (L I)  # Get name
+      call anonymousX_FE  # Anonymous symbol?
+      if ne  # No
+         ld X (L I)  # Get name
+         call findSymX_E  # Find or create symbol
+      end
+   end
+   ret
+: Delim ascii " \\t\\n\\r\\\"'(),[]`~{}"
+: DelimEnd
+
+(code 'rdList_E)
+   call (EnvGet_A)  # Skip paren
+   do
+      ld C (char "#")
+      call skipC_A  # and white space
+      cmp B (char ")")  # Empty list?
+      if eq  # Yes
+         call (EnvGet_A)  # Skip paren
+         ld E Nil  # Return NIL
+         ret
+      end
+      cmp B (char "]")  # Empty list?
+      jz retNil  # Yes
+      cmp B (char "~")  # Tilde?
+      if ne  # No
+         ld A 0
+         call readA_E  # Read expression
+         call consE_A  # Make a pair
+         ld (A) E
+         ld (A CDR) Nil
+         link
+         push A  # <L I> Save it
+         link
+         ld E A  # Keep last cell in E
+         jmp 10  # Exit
+      end
+      call (EnvGet_A)  # Skip tilde
+      ld A 0
+      call readA_E  # Read expression
+      link
+      push E  # <L I> Save it
+      link
+      eval  # Evaluate
+      ld (L I) E  # Save again
+      atom E  # Pair?
+      if z  # Yes
+         do
+            atom (E CDR)  # Find last cell
+         while z
+            ld E (E CDR)
+         loop
+         jmp 10  # Exit
+      end
+      drop  # Continue
+   loop
+10 do
+      ld C (char "#")
+      call skipC_A  # Skip white space
+      cmp B (char ")")  # Done?
+      if eq  # Yes
+         call (EnvGet_A)  # Skip paren
+         jmp 90  # Done
+      end
+      cmp B (char "]")  # Done?
+      jz 90  # Yes
+      cmp B (char ".")  # Dotted pair?
+      if eq  # Yes
+         call (EnvGet_A)  # Skip dot
+         memb Delim "(DelimEnd-Delim)"  # Delimiter?
+         if eq  # Yes
+            ld C (char "#")
+            call skipC_A  # and white space
+            cmp B (char ")")  # Circular list?
+            jz 20  # Yes
+            cmp B (char "]")
+            if eq  # Yes
+20             ld (E CDR) (L I)  # Store list in CDR
+            else
+               push E
+               ld A 0
+               call readA_E  # Read expression
+               ld A E
+               pop E
+               ld (E CDR) A  # Store in CDR
+            end
+            ld C (char "#")
+            call skipC_A  # Skip white space
+            cmp B (char ")")  # Done?
+            if eq  # Yes
+               call (EnvGet_A)  # Skip paren
+               jmp 90  # Done
+            end
+            cmp B (char "]")
+            jz 90  # Done
+            ld E (L I)  # Else bad dottet pair
+            jmp badDotErrE
+         end
+         push X
+         push Y
+         link
+         push ZERO  # <L I> Safe
+         link
+         push E
+         ld Y A  # Save first char
+         ld B (char ".")  # Restore dot
+         call rdAtomBYL_E  # Read atom
+         call consE_A  # Make a pair
+         ld (A) E
+         ld (A CDR) Nil
+         pop E
+         ld (E CDR) A  # Store in last cell
+         ld E A
+         drop
+         pop Y
+         pop X
+      else
+         cmp B (char "~")  # Tilde?
+         if ne  # No
+            push E
+            ld A 0
+            call readA_E  # Read expression
+            call consE_A  # Make a pair
+            ld (A) E
+            ld (A CDR) Nil
+            pop E
+            ld (E CDR) A  # Store in last cell
+            ld E A
+         else
+            call (EnvGet_A)  # Skip tilde
+            push E
+            ld A 0
+            call readA_E  # Read expression
+            ld A (S)
+            ld (A CDR) E  # Save in last cell
+            eval  # Evaluate
+            pop A
+            ld (A CDR) E  # Store in last cell
+            ld E A
+            do
+               atom (E CDR)  # Pair?
+            while z  # Yes
+               ld E (E CDR)  # Find last cell
+            loop
+         end
+      end
+   loop
+90 ld E (L I)  # Return list
+   drop
+   ret
+
+(code 'readA_E)
+   push X
+   push Y
+   link
+   push ZERO  # <L I> Safe
+   link
+   push A  # <L -I> Top flag
+   ld C (char "#")
+   call skipC_A
+   null A  # EOF?
+   if s  # Yes
+      null (L -I)  # Top?
+      jz eofErr  # No: Error
+      ld E Nil  # Yes: Return NIL
+      jmp 99
+   end
+   null (L -I)  # Top?
+   if nz  # Yes
+      ld C (InFile)  # And reading file?
+      null C
+      if nz  # Yes
+         ld (C V) (C IV)  # src = line
+      end
+   end
+   cmp B (char "(")  # Opening a list?
+   if eq  # Yes
+      call rdList_E  # Read it
+      null (L -I)  # Top?
+      if nz  # Yes
+         cmp (Chr) (char "]")  # And super-parentheses?
+         if eq  # Yes
+            call (EnvGet_A)  # Skip ']'
+         end
+      end
+      jmp 99  # Return list
+   end
+   cmp B (char "[")  # Opening super-list?
+   if eq  # Yes
+      call rdList_E  # Read it
+      cmp (Chr) (char "]")  # Matching super-parentheses?
+      jnz suparErrE  # Yes: Error
+      call (EnvGet_A)  # Else skip ']'
+      jmp 99
+   end
+   cmp B (char "'")  # Quote?
+   if eq  # Yes
+      call (EnvGet_A)  # Skip "'"
+      ld A 0
+      call readA_E  # Read expression
+      ld C E
+      call consC_E  # Cons with 'quote'
+      ld (E) Quote
+      ld (E CDR) C
+      jmp 99
+   end
+   cmp B (char ",")  # Comma?
+   if eq  # Yes
+      call (EnvGet_A)  # Skip ','
+      ld A 0
+      call readA_E  # Read expression
+      ld (L I) E  # Save it
+      ld X Uni  # Maintain '*Uni' index
+      ld Y E
+      call idxPutXY_E
+      atom E  # Pair?
+      if z  # Yes
+         ld E (E)  # Return index entry
+      else
+         ld E Y  # 'read' value
+      end
+      jmp 99
+   end
+   cmp B (char "`")  # Backquote?
+   if eq  # Yes
+      call (EnvGet_A)  # Skip '`'
+      ld A 0
+      call readA_E  # Read expression
+      ld (L I) E  # Save it
+      eval  # Evaluate
+      jmp 99
+   end
+   cmp B (char "\"")  # String?
+   if eq  # Yes
+      call (EnvGet_A)  # Skip '"'
+      cmp B (char "\"")  # Empty string?
+      if eq  # Yes
+         call (EnvGet_A)  # Skip '"'
+         ld E Nil  # Return NIL
+         jmp 99
+      end
+      call testEscA_F
+      jnc eofErr
+      ld C 4  # Build name
+      lea X (L I)  # Safe
+      do
+         call byteSymBCX_CX  # Pack char
+         call (EnvGet_A)  # Get next
+         cmp B (char "\"")  # Done?
+      while ne
+         call testEscA_F
+         jnc eofErr
+      loop
+      call (EnvGet_A)  # Skip '"'
+      ld X (L I)  # Get name
+      ld Y Transient
+      ld E 0  # No symbol yet
+      call internEXY_FE  # Check transient symbol
+      jmp 99
+   end
+   cmp B (char "{")  # External symbol?
+   if eq  # Yes
+      call (EnvGet_A)  # Skip '{'
+      cmp B (char "}")  # Empty?
+      if eq  # Yes
+         call (EnvGet_A)  # Skip '}'
+         call cons_E  # New symbol
+         ld (E) ZERO  # anonymous
+         or E SYM
+         ld (E) Nil  # Set to NIL
+         jmp 99
+      end
+      ld E 0  # Init file number
+      do
+         cmp B (char "@")  # File done?
+      while ge  # No
+         cmp B (char "O")  # In A-O range?
+         jgt badInputErrB  # Yes
+         sub B (char "@")
+         shl E 4  # Add to file number
+         add E A
+         call (EnvGet_A)  # Get next char
+      loop
+      cmp B (char "0")  # Octal digit?
+      jlt badInputErrB
+      cmp B (char "7")
+      jgt badInputErrB  # No
+      sub B (char "0")
+      zxt
+      ld C A  # Init object ID
+      do
+         call (EnvGet_A)  # Get next char
+         cmp B (char "}")  # Done?
+      while ne  # No
+         cmp B (char "0")  # Octal digit?
+         jlt badInputErrB
+         cmp B (char "7")
+         jgt badInputErrB  # No
+         sub B (char "0")
+         shl C 3  # Add to object ID
+         add C A
+      loop
+      call (EnvGet_A)  # Skip '}'
+      call extNmCE_X  # Build external symbol name
+      call externX_E  # New external symbol
+      jmp 99
+   end
+   cmp B (char ")")  # Closing paren?
+   jeq badInputErrB  # Yes
+   cmp B (char "]")
+   jeq badInputErrB
+   cmp B (char "~")  # Tilde?
+   jeq badInputErrB  # Yes
+   cmp B (char "\\")  # Backslash?
+   if eq  # Yes
+      call (EnvGet_A)  # Get next char
+   end
+   ld Y A  # Save in Y
+   call (EnvGet_A)  # Next char
+   xchg A Y  # Get first char
+   call rdAtomBYL_E  # Read atom
+99 drop
+   pop Y
+   pop X
+   ret
+
+(code 'readC_E)
+   null (Chr)  # Empty channel?
+   if z  # Yes
+      call (EnvGet_A)  # Fill 'Chr'
+   end
+   cmp C (Chr)  # Terminator?
+   if eq  # Yes
+      ld E Nil  # Return 'NIL'
+   else
+      ld A 1  # Top level
+      call readA_E  # Read expression
+      push E
+      ld A (Chr)
+      do
+         null A  # EOF?
+      while nsz  # No
+         cmp B 32  # Space?
+         jz 10
+         cmp B 9  # Tab?
+         jz 10
+         cmp B (char ")")  # or closing parens?
+         jz 10
+         cmp B (char "]")
+      while eq  # Yes
+10       call (EnvGet_A)
+      loop
+      pop E
+   end
+   ret
+
+(code 'tokenCE_E)  # X
+   null (Chr)  # Look ahead char?
+   if z  # No
+      call (EnvGet_A)  # Get next
+   end
+   call skipC_A  # Skip white space and comments
+   null A  # EOF?
+   js retNull  # Yes
+   cmp B (char "\"")  # String?
+   if eq  # Yes
+      call (EnvGet_A)  # Skip '"'
+      cmp B (char "\"")  # Empty string?
+      if eq  # Yes
+         call (EnvGet_A)  # Skip '"'
+         ld E Nil  # Return NIL
+         ret
+      end
+      call testEscA_F
+      jnc retNil
+      link
+      push ZERO  # <L I> Result
+      ld C 4  # Build name
+      ld X S
+      link
+      do
+         call byteSymBCX_CX  # Pack char
+         call (EnvGet_A)  # Get next
+         cmp B (char "\"")  # Done?
+         if eq  # Yes
+            call (EnvGet_A)  # Skip '"'
+            break T
+         end
+         call testEscA_F
+      until nc
+      ld X (L I)  # Get name
+      drop
+      jmp consSymX_E  # Make transient symbol
+   end
+   cmp B (char "0")  # Digit?
+   if ge
+      cmp B (char "9")
+      if le  # Yes
+         link
+         push ZERO  # <L I> Result
+         ld C 4  # Build digit string
+         ld X S
+         link
+         do
+            call byteSymBCX_CX  # Pack char
+            call (EnvGet_A)  # Get next
+            cmp B (char ".")  # Dot?
+            continue eq  # Yes
+            cmp B (char "0")  # Or digit?
+         while ge
+            cmp B (char "9")
+         until gt  # No
+         ld X (L I)  # Get name
+         ld A (Scl)  # Scale
+         shr A 4  # Normalize
+         drop
+         ld (Sep3) 0  # Thousand separator
+         ld (Sep0) (char ".")  # Decimal separator
+         jmp symToNumXA_FE  # Convert to number
+      end
+   end
+   push Y
+   push Z
+   ld Y A  # Keep char in Y
+   call bufStringE_SZ  # <S I/IV> Stack buffer
+   push A  # <S /III> String length
+   slen (S) (S I)
+   ld A Y  # Restore char
+   cmp B (char "a")  # Lower case letter?
+   if ge
+      cmp B (char "z")
+      jle 10  # Yes
+   end
+   cmp B (char "A")  # Upper case letter?
+   if ge
+      cmp B (char "Z")
+      jle 10  # Yes
+   end
+   cmp B (char "\\")  # Backslash?
+   if eq  # Yes
+      call (EnvGet_A)  # Use next char
+      jmp 10
+   end
+   memb (S I) (S)  # Member of character set?
+   if eq  # Yes
+10    link
+      push ZERO  # <L I> Result
+      ld C 4  # Build name
+      ld X S
+      link
+      do
+         call byteSymBCX_CX  # Pack char
+         call (EnvGet_A)  # Get next
+         cmp B (char "a")  # Lower case letter?
+         if ge
+            cmp B (char "z")
+            continue le  # Yes
+         end
+         cmp B (char "A")  # Upper case letter?
+         if ge
+            cmp B (char "Z")
+            continue le  # Yes
+         end
+         cmp B (char "0")  # Digit?
+         if ge
+            cmp B (char "9")
+            continue le  # Yes
+         end
+         cmp B (char "\\")  # Backslash?
+         if eq  # Yes
+            call (EnvGet_A)  # Use next char
+            continue T
+         end
+         memb (S IV) (S III)  # Member of character set?
+      until ne  # No
+      ld X (L I)  # Get name
+      call findSymX_E  # Find or create symbol
+      drop
+   else
+      call getChar_A
+      call mkCharA_A  # Return char
+      ld E A
+      call (EnvGet_A)  # Skip it
+   end
+   ld S Z  # Drop buffer
+   pop Z
+   pop Y
+   ret
+
+# (read ['sym1 ['sym2]]) -> any
+(code 'doRead 2)
+   atom (E CDR)  # Arg?
+   if nz  # No
+      ld C 0  # No terminator
+      call readC_E  # Read item
+   else
+      push X
+      ld X (E CDR)  # Args
+      ld E (X)  # Eval 'sym1'
+      eval
+      sym E  # Need symbol
+      jz symErrEX
+      link
+      push E  # <L I> Safe
+      link
+      ld E ((X CDR))  # Eval 'sym2'
+      eval
+      sym E  # Need symbol
+      jz symErrEX
+      call firstCharE_A  # Get first character
+      ld C A  # as comment char
+      ld E (L I)  # Get Set of characters
+      call tokenCE_E  # Read token
+      null E  # Any?
+      ldz E Nil  # No
+      drop
+      pop X
+   end
+   cmp (Chr) 10  # Hit linefeed?
+   if eq  # Yes
+      cmp (InFile) ((InFiles))  # Current InFile on stdin?
+      if eq  # Yes
+         ld (Chr) 0  # Clear it
+      end
+   end
+   ret
+
+# Check if input channel has data
+(code 'inFilesA_FC 0)
+   ld C A
+   shl C 3  # Vector index
+   add C (InFiles)  # Get vector
+   ld C (C)  # Slot?
+   null C  # Any?
+   ret
+
+(code 'inReadyC_F 0)
+   cmp (C I) (C II)  # 'ix' < 'cnt'?
+   ret  # Yes: 'nz'
+
+(code 'inReadyA_FC 0)
+   ld C A
+   shl C 3  # Vector index
+   cmp C (InFDs)  # 'fd' >= 'InFDs'?
+   jge ret  # No
+   add C (InFiles)  # Get vector
+   ld C (C)  # Slot?
+   null C  # Any?
+   jz retnc  # No
+   cmp (C I) (C II)  # 'ix' < 'cnt'?
+   ret  # Yes: Return 'c'
+
+(code 'rdSetRdyASL_F 0)  # Z
+   ld C A
+   shl C 3  # Vector index
+   cmp C (InFDs)  # 'fd' >= 'InFDs'?
+   jge rdSetASL_F  # Yes
+   add C (InFiles)  # Get vector
+   ld C (C)  # Slot?
+   null C  # Any?
+   jz rdSetASL_F  # No
+   call inReadyC_F  # Data in buffer?
+   if z  # No
+      lea Z (L -III)  # Beyond last 'poll' structure
+      do
+         sub Z POLLFD  # Next structure
+         cmp Z S  # More structures?
+         jle retz  # No: 'z'
+         cmp4 (Z)  # Found 'fd'?
+      until eq  # Yes
+      ld2 (Z POLL_REVENTS)  # 'revents'
+      test A (| POLLIN POLLHUP)  # Ready?
+      if nz  # Yes
+         call slowNbC_FA  # Try non-blocking read
+         jge retnz
+         setz
+      end
+   end
+   ret
+
+(code 'rdSetASL_F 0)  # Z
+   lea Z (L -III)  # Beyond last 'poll' structure
+   do
+      sub Z POLLFD  # Next structure
+      cmp Z S  # More structures?
+      jle retz  # No: 'z'
+      cmp4 (Z)  # Found 'fd'?
+   until eq  # Yes
+   ld2 (Z POLL_REVENTS)  # 'revents'
+   test A (| POLLIN POLLHUP)  # Ready?
+   ret  # Return 'nz'
+
+(code 'wrSetASL_F 0)  # Z
+   lea Z (L -III)  # Beyond last 'poll' structure
+   do
+      sub Z POLLFD  # Next structure
+      cmp Z S  # More structures?
+      jle retz  # No: 'z'
+      cmp4 (Z)  # Found 'fd'?
+   until eq  # Yes
+   ld2 (Z POLL_REVENTS)  # 'revents'
+   test A POLLOUT  # Ready?
+   ret  # Return 'nz'
+
+(code 'waitFdCEX_A)
+   push Y
+   push Z
+   push (EnvTask)  # <L IV> Save task list
+   link
+   push (At)  # <L II> '@'
+   push ZERO  # <L I> '*Run'
+   link
+   push C  # <L -I> File descriptor
+   push E  # <L -II> Milliseconds
+   push E  # <L -III> Timeout
+   do
+      ld Z 0  # Structure count
+      ld A (L -I)  # File descriptor
+      null A  # Positive?
+      if ns  # Yes
+         call inReadyA_FC  # Ready?
+         if c  # Yes
+            ld (L -III) 0  # Timeout = 0
+         else
+            sub S POLLFD  # Create 'poll' structure
+            st4 (S)  # Store 'fd'
+            ld A POLLIN  # Poll input
+            st2 (S POLL_EVENTS)  # Store 'events'
+            add Z 1  # Increment count
+         end
+      end
+      ld Y (Run)  # Get '*Run'
+      ld (L I) Y  # Save it
+      ld (EnvTask) Y
+      do
+         atom Y  # '*Run' elements?
+      while z  # Yes
+         ld E (Y)  # Next element
+         ld A (L IV)  # memq in saved tasklist?
+         do
+            atom A  # End of tasklist?
+         while z  # No
+            cmp E (A)  # Member?
+            jeq 10  # Yes: Skip
+            ld A (A CDR)
+         loop
+         ld A (E)  # Get fd or timeout value
+         shr A 4  # Negative?
+         if c  # Yes
+            ld A ((E CDR))  # Get CADR
+            shr A 4  # Normalize
+            cmp A (L -III)  # Less than current timeout?
+            if lt  # Yes
+               ld (L -III) A  # Set new timeout
+            end
+         else
+            cmp A (L -I)  # Different from argument-fd?
+            if ne  # Yes
+               call inReadyA_FC  # Ready?
+               if c  # Yes
+                  ld (L -III) 0  # Timeout = 0
+               else
+                  sub S POLLFD  # Create 'poll' structure
+                  st4 (S)  # Store 'fd'
+                  ld A POLLIN  # Poll input
+                  st2 (S POLL_EVENTS)  # Store 'events'
+                  add Z 1  # Increment count
+               end
+            end
+         end
+10       ld Y (Y CDR)
+      loop
+      ld A (Hear)  # RPC listener?
+      null A
+      if nz  # Yes
+         cmp A (L -I)  # Different from argument-fd?
+         if ne  # Yes
+            call inFilesA_FC  # Still open?
+            if nz  # Yes
+               call inReadyC_F  # Data in buffer?
+               if nz  # Yes
+                  ld (L -III) 0  # Timeout = 0
+               else
+                  sub S POLLFD  # Create 'poll' structure
+                  st4 (S)  # Store 'Hear'
+                  ld A POLLIN  # Poll input
+                  st2 (S POLL_EVENTS)  # Store 'events'
+                  add Z 1  # Increment count
+               end
+            end
+         end
+      end
+      ld A (Spkr)  # Speaker open?
+      null A
+      if nz  # Yes
+         sub S POLLFD  # Create 'poll' structure
+         st4 (S)  # Store 'Spkr'
+         ld A POLLIN  # Poll input
+         st2 (S POLL_EVENTS)  # Store 'events'
+         add Z 1  # Increment count
+      end
+      ld Y (Child)  # Iterate children
+      ld E (Children)  # Count
+      do
+         sub E VI  # More?
+      while ge  # Yes
+         null (Y)  # 'pid'?
+         if nz  # Yes
+            sub S POLLFD  # Create 'poll' structure
+            ld A (Y I)  # Store child's 'hear' fd
+            st4 (S)
+            ld A POLLIN  # Poll input
+            st2 (S POLL_EVENTS)  # Store 'events'
+            add Z 1  # Increment count
+            null (Y IV)  # Child's buffer count?
+            if nz  # Yes
+               sub S POLLFD  # Create 'poll' structure
+               ld A (Y II)  # Store child's 'tell' fd
+               st4 (S)
+               ld A POLLOUT  # Poll output
+               st2 (S POLL_EVENTS)  # Store 'events'
+               add Z 1  # Increment count
+            end
+         end
+         add Y VI  # Increment by sizeof(child)
+      loop
+      call msec_A  # Get milliseconds
+      ld E A  # into E
+      do
+         cc poll(S Z (L -III))  # Wait for event or timeout
+         nul4  # OK?
+      while s  # No
+         call errno_A
+         cmp A EINTR  # Interrupted?
+         if ne  # No
+            ld (Run) Nil  # Clear '*Run'
+            jmp selectErrX
+         end
+         nul (Signal)  # Signal?
+         if nz  # Yes
+            call sighandlerX
+         end
+      loop
+      call msec_A  # Get milliseconds
+      sub A E  # Time difference
+      ld (L -III) A  # Save it
+      set (Flg) 0  # Guarantee flushed pipes
+      ld Y (Child)  # Iterate children
+      ld Z (Children)  # Count
+      push X  # Save context
+      do
+         sub Z VI  # More?
+      while ge  # Yes
+         null (Y)  # 'pid'?
+         if nz  # Yes
+            push Z  # Outer loop count
+            ld A (Y I)  # Get child's 'hear' fd
+            call rdSetASL_F  # Ready?
+            if nz  # Yes
+               ld C (Y I)  # Get 'hear' fd again
+               ld E 2  # Size of count
+               ld X Buf  # Buffer pointer
+               call rdBytesNbCEX_F  # Read count
+               if ns  # Greater or equal zero
+                  if z
+                     call clsChildY  # Close child
+                     pop Z
+                     continue T
+                  end
+                  sub S PIPE_BUF  # <S II> Pipe buffer
+                  push Y  # <S> Outer child index
+                  ld C (Y I)  # Get 'hear' fd again
+                  ld2 (Buf)  # Get size
+                  ld E A
+                  lea X (S II)  # Buffer pointer
+                  call rdBytesCEX_F  # Read data?
+                  if nz  # Yes
+                     set (Flg) 1  # Still got data from pipe
+                     ld Y (Child)  # Iterate children
+                     ld Z (Children)  # Count
+                     do
+                        cmp Y (S)  # Same as outer loop child?
+                        if ne  # No
+                           null (Y)  # 'pid'?
+                           if nz  # Yes
+                              ld2 (Buf)  # Get size
+                              ld C A
+                              lea X (S II)  # and data
+                              call wrChildCXY  # Write to child
+                           end
+                        end
+                        add Y VI  # Increment by sizeof(child)
+                        sub Z VI  # More?
+                     until z  # No
+                  else
+                     call clsChildY  # Close child
+                     pop Y
+                     add S PIPE_BUF  # Drop 'tell' buffer
+                     pop Z
+                     continue T
+                  end
+                  pop Y
+                  add S PIPE_BUF  # Drop 'tell' buffer
+               end
+            end
+            ld A (Y II)  # Get child's 'tell' fd
+            call wrSetASL_F  # Ready?
+            if nz  # Yes
+               ld C (Y II)  # Get 'tell' fd again
+               ld X (Y V)  # Get buffer pointer
+               add X (Y III)  # plus buffer offset
+               ld2 (X)  # Get size
+               ld E A
+               add X 2  # Point to data (beyond size)
+               push E  # Keep size
+               call wrBytesCEX_F  # Write data?
+               pop E
+               if z  # Yes
+                  add E (Y III)  # Add size to buffer offset
+                  add E 2  # plus size of size
+                  ld (Y III) E  # New buffer offset
+                  add E E  # Twice the offset
+                  cmp E (Y IV)  # greater or equal to buffer count?
+                  if ge  # Yes
+                     sub (Y IV) (Y III)  # Decrement count by offset
+                     if nz
+                        ld X (Y V)  # Get buffer pointer
+                        add X (Y III)  # Add buffer offset
+                        movn ((Y V)) (X) (Y IV)  # Copy data
+                        ld A (Y V)  # Get buffer pointer
+                        ld E (Y IV)  # and new count
+                        call allocAE_A  # Shrink buffer
+                        ld (Y V) A  # Store
+                     end
+                  end
+                  ld (Y III) 0  # Clear buffer offset
+               else
+                  call clsChildY  # Close child
+               end
+            end
+            pop Z
+         end
+         add Y VI  # Increment by sizeof(child)
+      loop
+      nul (Flg)  # All pipes flushed?
+      if z  # Yes
+         ld A (Spkr)  # Speaker open?
+         null A
+         if nz  # Yes
+            call rdSetASL_F  # Ready?
+            if nz  # Yes
+               ld C (Spkr)  # Get fd
+               ld E I  # Size of slot
+               ld X Buf  # Buffer pointer
+               call rdBytesNbCEX_F  # Read slot?
+               if nsz  # Yes
+                  ld Y (Child)  # Get child
+                  add Y (Buf)  # in slot
+                  null (Y)  # 'pid'?
+                  if nz  # Yes
+                     ld C 2  # Size of 'TBuf'
+                     ld X TBuf  # Buffer pointer
+                     call wrChildCXY  # Write to child
+                  end
+               end
+            end
+         end
+      end
+      ld A (Hear)  # RPC listener?
+      null A
+      if nz  # Yes
+         cmp A (L -I)  # Different from argument-fd?
+         if ne  # Yes
+            call rdSetRdyASL_F  # Ready?
+            if nz  # Yes
+               call rdHear_FE  # Read expression?
+               if nc  # Yes
+                  cmp E TSym  # Read 'T'?
+                  if eq  # Yes
+                     set (Sync) 1  # Set sync flag
+                  else
+                     link
+                     push E  # Save expression
+                     link
+                     call evListE_E  # Execute it
+                     drop
+                  end
+               else
+                  call closeAX  # Close 'Hear'
+                  ld A (Hear)
+                  call closeInFileA
+                  ld A (Hear)
+                  call closeOutFileA
+                  ld (Hear) 0  # Clear value
+               end
+            end
+         end
+      end
+      ld Y (L I)  # Get '*Run'
+      do
+         atom Y  # More elements?
+      while z  # Yes
+         ld E (Y)  # Next element
+         ld A (L IV)  # memq in saved tasklist?
+         do
+            atom A  # End of tasklist?
+         while z  # No
+            cmp E (A)  # Member?
+            jeq 20  # Yes: Skip
+            ld A (A CDR)
+         loop
+         ld A (E)  # Get fd or timeout value
+         shr A 4  # Negative?
+         if c  # Yes
+            ld C (E CDR)  # Get CDR
+            ld A (C)  # and CADR
+            shr A 4  # Normalize
+            sub A (L -III)  # Subtract time difference
+            if nc  # Not yet timed out
+               shl A 4  # Make short number
+               or A CNT
+               ld (C) A  # Store in '*Run'
+            else  # Timed out
+               ld A (E)  # Timeout value
+               ld (C) A  # Store in '*Run'
+               ld (At) (E)  # Set to CAR
+               ld Z (C CDR)  # Run body
+               prog Z
+            end
+         else
+            cmp A (L -I)  # Different from argument-fd?
+            if ne  # Yes
+               call rdSetRdyASL_F  # Ready?
+               if nz  # Yes
+                  ld (At) (E)  # Set to fd
+                  ld Z (E CDR)  # Run body
+                  prog Z
+               end
+            end
+         end
+20       ld Y (Y CDR)
+      loop
+      pop X  # Restore context
+      nul (Signal)  # Signal?
+      if nz  # Yes
+         call sighandlerX
+      end
+      ld A (L -II)  # Milliseconds
+      or A A
+      if nsz  # Greater zero
+         sub A (L -III)  # Subtract time difference
+         if s  # < 0
+            xor A A  # Set to zero, 'z'
+         end
+         ld (L -II) A
+      end
+   while nz  # Milliseconds non-zero
+      ld (L -III) A  # Set timeout
+      ld A (L -I)  # File descriptor
+      null A  # Positive?
+   while ns  # Yes
+      call rdSetRdyASL_F  # Ready?
+   while z  # No
+      lea S (L -III)  # Drop 'poll' structures
+   loop
+   ld (At) (L II)  # Restore '@'
+   ld A (L -II)  # Return milliseconds
+   drop
+   pop (EnvTask)
+   pop Z
+   pop Y
+   ret
+
+# (wait ['cnt] . prg) -> any
+(code 'doWait 2)
+   push X
+   push Y
+   push Z
+   ld X E
+   ld Y (E CDR)  # Y on args
+   ld E (Y)  # Eval 'cnt'
+   eval
+   cmp E Nil  # None?
+   if eq  # Yes
+      push -1  # Wait infinite
+   else
+      call xCntEX_FE  # Get 'cnt'
+      push E  # <S> Milliseconds
+   end
+   ld Y (Y CDR)  # Y on 'prg'
+   do
+      ld Z Y  # Run 'prg'
+      prog Z
+      cmp E Nil  # NIL?
+   while eq  # Yes
+      ld C -1  # No file descriptor
+      ld E (S)  # Milliseconds
+      call waitFdCEX_A  # Wait for events
+      null A  # Timeout?
+      if z  # Yes
+         prog Y  # Run 'prg'
+         break T
+      end
+      ld (S) A  # New milliseconds
+   loop
+   pop A  # Drop milliseconds
+   pop Z
+   pop Y
+   pop X
+   ret
+
+# (sync) -> flg
+(code 'doSync 2)
+   null (Mic)  # No 'mic' channel?
+   jz retNil  # Yes
+   null (Hear)  # No 'hear' channel?
+   jz retNil  # Yes
+   push X
+   ld X E
+   ld E Slot  # Buffer pointer
+   ld C I  # Count
+   do
+      cc write((Mic) E C)  # Write 'Slot' to 'Mic'
+      nul4  # OK?
+      if ns  # Yes
+         sub C A  # Decrement count
+         break z  # Done
+         add E A  # Increment buffer pointer
+      else
+         call errno_A
+         cmp A EINTR  # Interrupted?
+         jne wrSyncErrX  # No
+      end
+      nul (Signal)  # Signal?
+      if nz  # Yes
+         call sighandlerX
+      end
+   loop
+   set (Sync) 0  # Clear sync flag
+   do
+      ld C -1  # No fd
+      ld E C  # Wait infinite
+      call waitFdCEX_A  # Wait for events
+      nul (Sync)  # Synchronized?
+   until nz  # Yes
+   ld E TSym  # Return T
+   pop X
+   ret
+
+# (hear 'cnt) -> cnt
+(code 'doHear 2)
+   push X
+   ld X E
+   ld E ((E CDR))  # E on arg
+   eval  # Eval it
+   cnt E  #  # Short number?
+   jz cntErrEX  # No
+   ld C E  # Get fd
+   shr C 4  # Normalize
+   jc badFdErrEX  # Negative
+   ld A C  # Keep 'fd' in C
+   shl A 3  # Vector index
+   cmp A (InFDs)  # 'fd' >= 'InFDs'?
+   jge badFdErrEX  # Yes
+   add A (InFiles)  # Get vector
+   ld A (A)  # Slot?
+   null A  # Any?
+   jz badFdErrEX  # No
+   ld A (Hear)  # Current value?
+   null A
+   if nz  # Yes
+      call closeAX  # Close 'Hear'
+      ld A (Hear)
+      call closeInFileA
+      ld A (Hear)
+      call closeOutFileA
+   end
+   ld (Hear) C  # Set new value
+   pop X
+   ret
+
+# (tell 'sym ['any ..]) -> any
+(code 'doTell 2)
+   ld A (Tell)  # RPC?
+   or A (Children)
+   jz retNil  # No
+   push X
+   push Y
+   push Z
+   push (TellBuf)  # Save current 'tell' env
+   sub S PIPE_BUF  # New 'tell' buffer
+   ld Z S  # Buffer pointer
+   call tellBegZ_Z  # Start 'tell' message
+   ld X (E CDR)  # Args
+   do
+      ld E (X)  # Eval next
+      eval
+      ld Y E  # Keep result
+      call prTellEZ  # Print to 'tell'
+      ld X (X CDR)  # More args?
+      atom X
+   until nz  # No
+   call tellEndZ  # Close 'tell'
+   ld E Y  # Get result
+   add S PIPE_BUF  # Drop 'tell' buffer
+   pop (TellBuf)
+   pop Z
+   pop Y
+   pop X
+   ret
+
+# (poll 'cnt) -> cnt | NIL
+(code 'doPoll 2)
+   push X
+   ld X E
+   ld E ((E CDR))  # E on arg
+   eval  # Eval it
+   ld A E  # Keep
+   call xCntEX_FE  # Get fd
+   xchg A E
+   null A  # fd < 0?
+   js badFdErrEX  # Yes
+   ld C A
+   shl C 3  # Vector index
+   cmp C (InFDs)  # 'fd' >= 'InFDs'?
+   jge badFdErrEX  # Yes
+   call inFilesA_FC  # Readable input file?
+   ldz E Nil  # No: Return NIL
+   if nz
+      do
+         call inReadyC_F  # Data in buffer?
+      while z  # No
+         sub S POLLFD  # Create 'poll' structure
+         st4 (S)  # Store 'fd'
+         ld A POLLIN  # Poll input
+         st2 (S POLL_EVENTS)  # Store 'events'
+         do
+            cc poll(S 1 0)  # Check
+            nul4  # OK?
+         while s  # No
+            call errno_A
+            cmp A EINTR  # Interrupted?
+            if ne  # No
+               ld (Run) Nil  # Clear '*Run'
+               jmp selectErrX
+            end
+         loop
+         ld2 (S POLL_REVENTS)  # 'revents'
+         add S POLLFD  # Drop 'poll' structure
+         test A (| POLLIN POLLHUP)  # Ready?
+         ldz E Nil  # No: Return NIL
+      while nz
+         call slowNbC_FA  # Try non-blocking read
+      until ge
+   end
+   pop X
+   ret
+
+# (key ['cnt]) -> sym
+(code 'doKey 2)
+   push X
+   ld X E
+   ld E ((E CDR))  # E on arg
+   eval  # Eval it
+   cmp E Nil  # None?
+   if eq  # Yes
+      ld E -1  # Wait infinite
+   else
+      call xCntEX_FE  # Get milliseconds
+   end
+   call flushAll  # Flush all output channels
+   call setRaw  # Set terminal to raw mode
+   ld C 0  # Standard input
+   call waitFdCEX_A  # Wait for events
+   null A  # Timeout?
+   if nz  # No
+      call stdinByte_FA  # First byte?
+      if nc  # Yes
+         cmp B (hex "FF")  # Special "top" character?
+         if ne  # No
+            cmp B 128  # Single byte?
+            if ge  # No
+               test B (hex "20")  # Two bytes?
+               if z  # Yes
+                  and B (hex "1F")  # First byte 110xxxxx
+                  shl A 6  # xxxxx000000
+                  push A
+               else  # Three bytes
+                  and B (hex "F")  # First byte 1110xxxx
+                  shl A 6  # xxxx000000
+                  push A
+                  call stdinByte_FA  # Read second byte
+                  and B (hex "3F")  # 10xxxxxx
+                  or A (S)  # Combine
+                  shl A 6  # xxxxxxxxxx000000
+                  ld (S) A
+               end
+               call stdinByte_FA  # Read last byte
+               and B (hex "3F")  # 10xxxxxx
+               or (S) A  # Combine
+               pop A  # Get result
+            end
+         else
+            ld A TOP
+         end
+         call mkCharA_A  # Return char
+         ld E A
+         pop X
+         ret
+      end
+   end
+   ld E Nil
+   pop X
+   ret
+
+# (peek) -> sym
+(code 'doPeek 2)
+   ld A (Chr)  # Look ahead char?
+   null A
+   if z  # No
+      call (EnvGet_A)  # Get next
+   end
+   null A  # EOF?
+   js retNil  # Yes
+   call mkCharA_A  # Return char
+   ld E A
+   ret
+
+# (char) -> sym
+# (char 'cnt) -> sym
+# (char T) -> sym
+# (char 'sym) -> cnt
+(code 'doChar 2)
+   push X
+   ld X E
+   ld E (E CDR)  # Any args?
+   atom E
+   if nz  # No
+      ld A (Chr)  # Look ahead char?
+      null A
+      if z  # No
+         call (EnvGet_A)  # Get next
+      end
+      null A  # EOF?
+      if ns  # No
+         call getChar_A
+         call mkCharA_A  # Make char
+         ld E A
+         call (EnvGet_A)  # Get next
+      else
+         ld E Nil
+      end
+      pop X
+      ret
+   end
+   ld E (E)
+   eval  # Eval arg
+   cnt E  # 'cnt'?
+   if nz  # Yes
+      ld A E  # Get 'cnt'
+      shr A 4  # Normalize
+      if nz
+         call mkCharA_A  # Make char
+         ld E A
+      else
+         ld E Nil
+      end
+      pop X
+      ret
+   end
+   sym E  # 'sym'?
+   jz atomErrEX  # No
+   cmp E TSym  # T?
+   if ne
+      call firstCharE_A
+      shl A 4  # Make short number
+      or A CNT
+   else
+      ld A TOP  # Special "top" character
+      call mkCharA_A
+   end
+   ld E A
+   pop X
+   ret
+
+# (skip ['any]) -> sym
+(code 'doSkip 2)
+   ld E ((E CDR))  # Get arg
+   call evSymE_E  # Evaluate to a symbol
+   call firstCharE_A  # Get first character
+   ld C A  # Use as comment char
+   call skipC_A  # Skip white space and comments
+   null A  # EOF?
+   js retNil  # Yes
+   ld A (Chr)  # Return 'Chr'
+   call mkCharA_A  # Return char
+   ld E A
+   ret
+
+# (eol) -> flg
+(code 'doEol 2)
+   cmp (Chr) 10  # Linefeed?
+   jeq retT  # Yes
+   null (Chr)  # Chr <= 0?
+   jsz retT  # Yes
+   ld E Nil  # Return NIL
+   ret
+
+# (eof ['flg]) -> flg
+(code 'doEof 2)
+   ld E ((E CDR))  # Get arg
+   eval  # Eval it
+   cmp E Nil  # NIL?
+   if eq  # Yes
+      ld A (Chr)  # Look ahead char?
+      null A
+      if z  # No
+         call (EnvGet_A)  # Get next
+      end
+      null A  # EOF?
+      jns RetNil  # No
+   else
+      ld (Chr) -1  # Set EOF
+   end
+   ld E TSym  # Return T
+   ret
+
+# (from 'any ..) -> sym
+(code 'doFrom 2)
+   push X
+   push Z
+   ld X (E CDR)  # X on args
+   push 0  # End-of-buffers marker
+   do
+      call evSymX_E  # Next argument
+      call bufStringE_SZ  # <S V> Stack buffer
+      push 0  # <S IV> Index
+      link
+      push E  # <S II> Symbol
+      link
+      push Z  # <S> Buffer chain
+      ld X (X CDR)  # More arguments?
+      atom X
+   until nz  # No
+   ld A (Chr)  # Look ahead char?
+   null A
+   if z  # No
+      call (EnvGet_A)  # Get next
+   end
+   do
+      null A  # EOF?
+   while ns  # No
+      ld Z S  # Buffer chain
+      do
+         do
+            lea C (Z V)  # Stack buffer
+            add C (Z IV)  # Index
+            cmp B (C)  # Bytes match?
+            if eq  # Yes
+               add (Z IV) 1  # Increment index
+               nul (C 1)  # End of string?
+               break nz  # No
+               call (EnvGet_A)  # Skip next input byte
+               ld E (Z II)  # Return matched symbol
+               jmp 90
+            end
+            null (Z IV)  # Still at beginning of string?
+            break z  # Yes
+            lea C (Z (+ V 1))  # Offset pointer to second byte
+            do
+               sub (Z IV) 1  # Decrement index
+            while nz
+               cmpn (Z V) (C) (Z IV)  # Compare stack buffer
+            while nz
+               add C 1  # Increment offset
+            loop
+         loop
+         ld Z (Z)  # Next in chain
+         null (Z)  # Any?
+      until z  # No
+      call (EnvGet_A)  # Get next input byte
+   loop
+   ld E Nil  # Return NIL
+90 pop Z  # Clean up buffers
+   do
+      drop
+      ld S Z
+      pop Z
+      null Z  # End?
+   until z  # Yes
+   pop Z
+   pop X
+   ret
+
+# (till 'any ['flg]) -> lst|sym
+(code 'doTill 2)
+   push X
+   push Z
+   ld X (E CDR)  # Args
+   call evSymX_E  # Evaluate to a symbol
+   call bufStringE_SZ  # <S I/IV> Stack buffer
+   push A  # <S /III> String length
+   slen (S) (S I)
+   ld A (Chr)  # Look ahead char?
+   null A
+   if z  # No
+      call (EnvGet_A)  # Get next
+   end
+   null A  # EOF?
+   if ns  # No
+      memb (S I) (S)  # Matched first char?
+      if ne  # No
+         ld E ((X CDR))  # Eval 'flg'
+         eval
+         cmp E Nil  # NIL?
+         if eq  # Yes
+            call getChar_A  # Get first character
+            call mkCharA_A  # Make char
+            call consA_X  # Build first cell
+            ld (X) A
+            ld (X CDR) Nil
+            link
+            push X  # <L I> Result list
+            link
+            do
+               call (EnvGet_A)  # Get next
+               null A  # EOF?
+            while nsz  # No
+               memb (S IV) (S III)  # Matched char?
+            while ne  # No
+               call getChar_A  # Get next character
+               call mkCharA_A
+               call consA_C  # Build next cell
+               ld (C) A
+               ld (C CDR) Nil
+               ld (X CDR) C  # Append to sublist
+               ld X C
+            loop
+            ld E (L I)  # Get result list
+         else
+            link
+            push ZERO  # <L I> Result
+            ld X S
+            link
+            ld C 4  # Build name
+            do
+               call getChar_A  # Get next character
+               call charSymACX_CX  # Insert
+               call (EnvGet_A)  # Get next
+               null A  # EOF?
+            while nsz  # No
+               memb (S IV) (S III)  # Matched char?
+            until eq  # Yes
+            ld X (L I)  # Get result name
+            call consSymX_E
+         end
+         drop
+         ld S Z  # Drop buffer
+         pop Z
+         pop X
+         ret
+      end
+   end
+   ld E Nil  # Return NIL
+   ld S Z  # Drop buffer
+   pop Z
+   pop X
+   ret
+
+(code 'eolA_F 0)
+   null A  # EOF?
+   js retz  # Yes
+   cmp A 10  # Linefeed?
+   if ne  # No
+      cmp A 13  # Return?
+      jne Ret  # No
+      call (EnvGet_A)  # Get next
+      cmp A 10  # Linefeed?
+      jnz retz
+   end
+   ld (Chr) 0  # Clear look ahead
+   ret  # 'z'
+
+# (line 'flg ['cnt ..]) -> lst|sym
+(code 'doLine 2)
+   ld A (Chr)  # Look ahead char?
+   null A
+   if z  # No
+      call (EnvGet_A)  # Get next
+   end
+   call eolA_F  # End of line?
+   jeq retNil  # Yes
+   push X
+   push Y
+   push Z
+   ld Y (E CDR)  # Y on args
+   ld E (Y)  # Eval 'flg'
+   eval
+   cmp E Nil  # 'flg' was non-NIL?
+   if ne  # Yes: Pack
+      ld Y (Y CDR)  # More args?
+      atom Y
+      if nz  # No
+         link
+         push ZERO  # <L I> Result
+         ld X S
+         link
+         ld C 4  # Build name
+         do
+            call getChar_A  # Get next character
+            call charSymACX_CX  # Insert
+            call (EnvGet_A)  # Get next
+            call eolA_F  # End of line?
+         until eq  # Yes
+         ld X (L I)  # Get result name
+         call consSymX_E
+      else
+         call cons_Z  # First cell of top list
+         ld (Z) ZERO
+         ld (Z CDR) Nil
+         link
+         push Z  # <L I> Result
+         link
+         do
+            ld C 4  # Build name
+            ld X Z
+            call getChar_A  # Get next character
+            call charSymACX_CX  # Insert first char
+            push C
+            ld E (Y)
+            eval  # Eval next arg
+            pop C
+            shr E 4  # Normalize
+            do
+               sub E 1  # Decrement count
+            while nz
+               call (EnvGet_A)  # Get next
+               call eolA_F  # End of line?
+               if eq  # Yes
+                  ld X (Z)  # Get last sub-result
+                  call consSymX_E
+                  ld (Z) E
+                  jmp 20
+               end
+               call getChar_A  # Get next character
+               call charSymACX_CX  # Insert
+            loop
+            ld X (Z)  # Get last sub-result
+            call consSymX_E
+            ld (Z) E
+            ld Y (Y CDR)  # More args?
+            atom Y
+            jnz 10  # No
+            call (EnvGet_A)  # Get next
+            call eolA_F  # End of line?
+            jeq 20  # Yes
+            call cons_A  # New cell to top list
+            ld (A) ZERO
+            ld (A CDR) Nil
+            ld (Z CDR) A
+            ld Z A
+         loop
+      end
+   else
+      call getChar_A  # Get first character
+      call mkCharA_A  # Make char
+      call consA_Z  # Build first cell
+      ld (Z) A
+      ld (Z CDR) Nil
+      link
+      push Z  # <L I> Result
+      link
+      ld Y (Y CDR)  # More args?
+      atom Y
+      if z  # Yes
+         ld X Z  # Current sublist
+         call cons_Z  # First cell of top list
+         ld (Z) X
+         ld (Z CDR) Nil
+         ld (L I) Z  # New result
+         do
+            ld E (Y)
+            eval  # Eval next arg
+            shr E 4  # Normalize
+            do
+               sub E 1  # Decrement count
+            while nz
+               call (EnvGet_A)  # Get next
+               call eolA_F  # End of line?
+               jeq 20  # Yes
+               call getChar_A  # Get next character
+               call mkCharA_A
+               call consA_C  # Build next cell
+               ld (C) A
+               ld (C CDR) Nil
+               ld (X CDR) C  # Append to sublist
+               ld X C
+            loop
+            ld Y (Y CDR)  # More args?
+            atom Y
+         while z  # Yes
+            call (EnvGet_A)  # Get next
+            call eolA_F  # End of line?
+            jeq 20  # Yes
+            call getChar_A  # Get next character
+            call mkCharA_A
+            call consA_X  # Build new sublist
+            ld (X) A
+            ld (X CDR) Nil
+            call consX_A  # Append to top list
+            ld (A) X
+            ld (A CDR) Nil
+            ld (Z CDR) A
+            ld Z A
+         loop
+      end
+10    do
+         call (EnvGet_A)  # Get next
+         call eolA_F  # End of line?
+      while ne  # No
+         call getChar_A  # Get next character
+         call mkCharA_A
+         call consA_C  # Build next cell
+         ld (C) A
+         ld (C CDR) Nil
+         ld (Z CDR) C  # Append
+         ld Z C
+      loop
+20    ld E (L I)  # Get result
+   end
+   drop
+   pop Z
+   pop Y
+   pop X
+   ret
+
+# (lines 'any ..) -> cnt
+(code 'doLines 2)
+   push X
+   push Y
+   push Z
+   ld X (E CDR)  # Args
+   ld Y 0  # Result
+   do
+      atom X  # More args?
+   while z  # Yes
+      call evSymX_E  # Evaluate next file name
+      call pathStringE_SZ  # Write to stack buffer
+      cc fopen(S _r_)  # Open file
+      ld S Z  # Drop buffer
+      null A  # OK?
+      if nz  # Yes
+         ld E A  # File pointer
+         null Y  # First hit?
+         if z  # Yes
+            ld Y ZERO  # Init short number
+         end
+         do
+            cc getc_unlocked(E)  # Next char
+            nul4  # EOF?
+         while ns  # No
+            cmp A 10  # Linefeed?
+            if eq  # Yes
+               add Y (hex "10")  # Increment count
+            end
+         loop
+         cc fclose(E)  # Close file pointer
+      end
+      ld X (X CDR)
+   loop
+   null Y  # Result?
+   ld E Y  # Yes
+   ldz E Nil  # No
+   pop Z
+   pop Y
+   pop X
+   ret
+
+(code 'parseBCE_E)
+   push (EnvParseX)  # Save old parser status
+   push (EnvParseC)
+   push (EnvParseEOF)
+   push (EnvGet_A)  # Save 'get' status
+   push (Chr)
+   ld E (E TAIL)
+   call nameE_E  # Get name
+   link
+   push E  # Save it
+   link
+   ld (EnvParseX) E  # Set new parser status
+   ld (EnvParseC) 0
+   null C  # Token?
+   if z  # No
+      ld E (hex "FFFFFFFFFF5D0A00")  # linefeed, ']', EOF
+   else
+      ld E -1
+   end
+   ld (EnvParseEOF) E
+   ld (EnvGet_A) getParse_A  # Set 'get' status
+   ld (Chr) 0
+   or B B  # Skip?
+   if nz  # Yes
+      call getParse_A  # Skip first char
+   end
+   null C  # Token?
+   if z  # No
+      call rdList_E  # Read a list
+   else
+      push X
+      push C  # <S III> Set of characters
+      ld E C  # in E
+      ld C 0  # No comment char
+      call tokenCE_E  # Read token
+      null E  # Any?
+      ldz E Nil
+      if nz  # Yes
+         call consE_X  # Build first result cell
+         ld (X) E
+         ld (X CDR) Nil
+         link
+         push X  # <L I> Result
+         link
+         do
+            ld C 0  # No comment char
+            ld E (S III)  # Get set of characters
+            push X
+            call tokenCE_E  # Next token?
+            pop X
+            null E
+         while nz  # Yes
+            call consE_A  # Build next result cell
+            ld (A) E
+            ld (A CDR) Nil
+            ld (X CDR) A
+            ld X A
+         loop
+         ld E (L I)  # Get result
+         drop
+      end
+      pop A  # Drop set
+      pop X
+   end
+   drop
+   pop (Chr)  # Retrieve 'get' status
+   pop (EnvGet_A)
+   pop (EnvParseEOF)  # Restore old parser status
+   pop (EnvParseC)
+   pop (EnvParseX)
+   ret
+
+# (any 'sym) -> any
+(code 'doAny 2)
+   push X
+   ld X E
+   ld E ((E CDR))  # E on arg
+   eval  # Eval it
+   num E  # Need symbol
+   jnz symErrEX
+   sym E
+   jz symErrEX
+   cmp E Nil  # NIL?
+   if ne  # No
+      push (EnvParseX)  # Save old parser status
+      push (EnvParseC)
+      push (EnvParseEOF)
+      push (EnvGet_A)  # Save 'get' status
+      push (Chr)
+      ld E (E TAIL)
+      call nameE_E  # Get name
+      link
+      push E  # Save it
+      link
+      ld (EnvParseX) E  # Set new parser status
+      ld (EnvParseC) 0
+      ld (EnvParseEOF) (hex "FFFFFFFFFFFF2000")  # Blank, EOF
+      ld (EnvGet_A) getParse_A  # Set 'get' status
+      ld (Chr) 0
+      call getParse_A  # Skip first char
+      ld A 1  # Top level
+      call readA_E  # Read expression
+      drop
+      pop (Chr)  # Retrieve 'get' status
+      pop (EnvGet_A)
+      pop (EnvParseEOF)  # Restore old parser status
+      pop (EnvParseC)
+      pop (EnvParseX)
+   end
+   pop X
+   ret
+
+# (sym 'any) -> sym
+(code 'doSym 2)
+   ld E ((E CDR))  # Eval arg
+   eval
+   link
+   push E  # Save
+   link
+   call begString  # Start string
+   call printE  # Print to string
+   call endString_E  # Retrieve result
+   drop
+   ret
+
+# (str 'sym ['sym1]) -> lst
+# (str 'lst) -> sym
+(code 'doStr 2)
+   push X
+   push Y
+   ld X E
+   ld Y (E CDR)  # Y on args
+   ld E (Y)  # Eval first
+   eval
+   cmp E Nil  # NIL?
+   if ne  # No
+      num E  # Number?
+      jnz argErrEX  # Yes
+      sym E  # Symbol?
+      if nz  # Yes
+         link
+         push E  # <L II> 'sym'
+         link
+         ld X (Y CDR)  # Second arg?
+         atom X
+         if nz  # No
+            ld C 0  # No token
+         else
+            call evSymX_E  # Eval 'sym1'
+            tuck E  # Save
+            link
+            ld C E  # Get token
+            ld E (L II)  # and 'sym'
+         end
+         ld B 0  # Don't skip
+         call parseBCE_E  # Parse
+         drop
+      else
+         link
+         push E  # Save 'lst'
+         link
+         call begString  # Start string
+         ld X E  # 'lst'
+         do
+            ld E (X)  # Get CAR
+            call printE  # Print to string
+            ld X (X CDR)  # More items?
+            atom X
+         while z  # Yes
+            call space
+         loop
+         call endString_E  # Retrieve result
+         drop
+      end
+   end
+   pop Y
+   pop X
+   ret
+
+# Read-Eval-Print loop
+(code 'loadBEX_E)
+   ld C A  # Save prompt in C
+   sym E  # Symbolic argument?
+   if nz  # Yes
+      ld A (E TAIL)
+      call firstByteA_B  # starting with "-"?
+      cmp B (char "-")
+      if eq  # Yes
+         ld C 0  # No token
+         call parseBCE_E  # Parse executable list
+         link
+         push E  # Save expression
+         link
+         call evListE_E  # Execute it
+         drop
+         ret
+      end
+   end
+   push Y
+   link
+   push ZERO  # <L II>
+   push ZERO  # <L I>
+   link
+   push C  # <L -I> Prompt
+   sub S IV  # InFrame
+   ld Y S
+   call rdOpenEXY
+   ld E Nil  # Close transient scope
+   call doHide
+   call pushInFilesY
+   do
+      ld A ((InFiles))  # Get stdin
+      cmp A (InFile)  # Reading from file?
+      if ne  # Yes
+         ld C 0  # No terminator
+         call readC_E  # Read expression
+      else
+         ld A (L -I)
+         or B B  # Prompt?
+         if nz  # Yes
+            null (Chr)
+            if z
+               call (EnvPutB)  # Output prompt
+               call space
+               call flushAll
+            end
+         end
+         ld C 10  # Linefeed terminator
+         cc isatty(0)  # STDIN
+         nul4  # on a tty?
+         ldz C 0  # No
+         call readC_E  # Read expression
+         cmp (Chr) 10  # Hit linefeed?
+         if eq  # Yes
+            ld (Chr) 0  # Clear it
+         end
+      end
+      cmp E Nil
+   while ne
+      ld (L I) E  # Save read expression
+      ld A ((InFiles))  # Get stdin
+      cmp A (InFile)  # Reading from file?
+      if nz  # Yes
+10       eval  # Evaluate
+      else
+         null (Chr)  # Line?
+         jnz 10  # Yes
+         ld A (L -I)
+         or B B  # Prompt?
+         jz 10  # No
+         call flushAll
+         ld (L II) (At)  # Save '@'
+         eval  # Evaluate
+         ld (At) E  # Save result
+         ld (At3) (At2)
+         ld (At2) (L II)  # Retrieve previous '@'
+         ld C Arrow
+         call outStringC
+         call flushAll
+         call printE_E
+         call newline
+      end
+      ld (L I) E  # Save result
+   loop
+   call popInFiles
+   ld E Nil  # Close transient scope
+   call doHide
+   ld E (L I)
+   drop
+   pop Y
+   ret
+: Arrow asciz "-> "
+
+# (load 'any ..) -> any
+(code 'doLoad 2)
+   push X
+   push Y
+   ld X E
+   ld Y (E CDR)  # Y on args
+   do
+      ld E (Y)  # Eval arg
+      eval
+      cmp E TSym  # Load remaining command line args?
+      if ne  # No
+         ld B (char ">")  # Prompt
+         call loadBEX_E
+      else
+         call loadAllX_E
+      end
+      ld Y (Y CDR)  # More args?
+      atom Y
+   until nz  # No
+   pop Y
+   pop X
+   ret
+
+# (in 'any . prg) -> any
+(code 'doIn 2)
+   push X
+   push Y
+   ld X E  # Expression in X
+   ld E (E CDR)
+   ld E (E)  # Eval 'any'
+   eval
+   sub S IV  # InFrame
+   ld Y S
+   call rdOpenEXY
+   call pushInFilesY
+   ld X ((X CDR) CDR)  # Get 'prg'
+   prog X
+   call popInFiles
+   add S IV  # Drop InFrame
+   pop Y
+   pop X
+   ret
+
+# (out 'any . prg) -> any
+(code 'doOut 2)
+   push X
+   push Y
+   ld X E  # Expression in X
+   ld E (E CDR)
+   ld E (E)  # Eval 'any'
+   eval
+   sub S IV  # OutFrame
+   ld Y S
+   call wrOpenEXY
+   call pushOutFilesY
+   ld X ((X CDR) CDR)  # Get 'prg'
+   prog X
+   call popOutFiles
+   add S IV  # Drop InFrame
+   pop Y
+   pop X
+   ret
+
+# (pipe exe) -> cnt
+# (pipe exe . prg) -> any
+(code 'doPipe 2)
+   push X
+   push Y
+   ld X E  # Expression in X
+   sub S IV  # In/OutFrame
+   ld Y S
+   push A  # Create 'pipe' structure
+   cc pipe(S)  # Open pipe
+   nul4  # OK?
+   jnz pipeErrX
+   ld4 (S)  # Get pfd[0]
+   call closeOnExecAX
+   ld4 (S 4)  # Get pfd[1]
+   call closeOnExecAX
+   call forkLispX_FE  # Fork child process
+   if c  # In child
+      atom ((X CDR) CDR)  # 'prg'?
+      if z  # Yes
+         cc setpgid(0 0)  # Set process group
+      end
+      ld4 (S)  # Close read pipe
+      call closeAX
+      ld4 (S 4)  # Get write pipe
+      cmp A 1  # STDOUT_FILENO?
+      if ne  # No
+         cc dup2(A 1)  # Dup to STDOUT_FILENO
+         ld4 (S 4)  # Close write pipe
+         call closeAX
+      end
+      ld E Nil  # Standard output
+      call wrOpenEXY
+      call pushOutFilesY
+      ld (Run) Nil  # Switch off all tasks
+      ld E ((X CDR))  # Get 'exe'
+      eval  # Evaluate it
+      ld E 0  # Exit OK
+      jmp byeE
+   end
+   ld (Y II) E  # Set 'pid'
+   ld4 (S 4)  # Close write pipe
+   call closeAX
+   ld4 (S)  # Get read pipe
+   call initInFileA_A
+   ld E (A)  # Get file descriptor
+   ld X ((X CDR) CDR)  # Get 'prg'
+   atom X  # Any?
+   if nz  # No
+      shl E 4  # In parent
+      or E CNT  # Return PID
+   else
+      ld (Y I) E  # Save 'fd'
+      cc setpgid((Y II) 0)  # Set process group
+      call pushInFilesY
+      prog X
+      call popInFiles
+   end
+   add S (+ 8 IV)  # Drop 'pipe' structure and In/OutFrame
+   pop Y
+   pop X
+   ret
+
+# (ctl 'sym . prg) -> any
+(code 'doCtl 2)
+   push X
+   push Y
+   ld X E  # Expression in X
+   ld E (E CDR)
+   ld E (E)  # Eval 'any'
+   eval
+   push A  # CtlFrame
+   push A
+   ld Y S
+   call ctOpenEXY
+   call pushCtlFilesY
+   ld X ((X CDR) CDR)  # Get 'prg'
+   prog X
+   call popCtlFiles
+   pop A  # Drop CtlFrame
+   pop A
+   pop Y
+   pop X
+   ret
+
+# (open 'sym) -> cnt | NIL
+(code 'doOpen 2)
+   push X
+   push Z
+   ld X E
+   ld E ((E CDR))  # Get arg
+   call evSymE_E  # Evaluate to a symbol
+   call pathStringE_SZ  # Write to stack buffer
+   do
+      cc open(S (| O_CREAT O_RDWR) (oct "0666"))  # Try to open
+      nul4  # OK?
+   while s  # No
+      call errno_A
+      cmp A EINTR  # Interrupted?
+      if nz  # No
+         ld E Nil  # Return NIL
+         jmp 90
+      end
+      nul (Signal)  # Signal?
+      if nz  # Yes
+         call sighandlerX
+      end
+   loop
+   ld X A  # Keep 'fd'
+   call closeOnExecAX
+   ld C X  # 'fd'
+   cc strdup(S)  # Duplicate name
+   call initInFileCA_A  # Init input file structure
+   ld A X  # 'fd' again
+   call initOutFileA_A  # Init output file structure
+   ld E X  # Return 'fd'
+   shl E 4  # Make short number
+   or E CNT
+90 ld S Z  # Drop buffer
+   pop Z
+   pop X
+   ret
+
+# (close 'cnt) -> cnt | NIL
+(code 'doClose 2)
+   push X
+   ld X E
+   ld E ((E CDR))  # Eval 'cnt'
+   eval
+   ld C E  # Keep in E
+   call xCntCX_FC  # Get fd
+   cc close(C)  # Close it
+   nul4  # OK?
+   ldnz E Nil
+   if z  # Yes
+      ld A C  # Close InFile
+      call closeInFileA
+      ld A C  # Close OutFile
+      call closeOutFileA
+   end
+   pop X
+   ret
+
+# (echo ['cnt ['cnt]] | ['sym ..]) -> sym
+(code 'doEcho 2)
+   push X
+   push Y
+   ld X E
+   ld Y (E CDR)  # Y on args
+   ld E (Y)  # Eval first
+   eval
+   ld Y (Y CDR)  # Next arg
+   ld A (Chr)  # Look ahead char?
+   null A
+   if z  # No
+      call (EnvGet_A)  # Get next
+   end
+   cmp E Nil  # Empty arg?
+   if eq  # Yes
+      atom Y  # No further args?
+      if nz  # Yes
+         do
+            null A  # EOF?
+         while ns  # No
+            call (EnvPutB)  # Output byte
+            call (EnvGet_A)  # Get next
+         loop
+         ld E TSym  # Return T
+         pop Y
+         pop X
+         ret
+      end
+   end
+   num E  # Number?
+   if nz  # Yes
+      call xCntEX_FE  # Get 'cnt'
+      atom Y  # Second 'cnt' arg?
+      if z  # Yes
+         ld Y (Y)  # Get second 'cnt'
+         xchg Y E  # First 'cnt' in Y
+         call evCntEX_FE  # Evaluate second
+         ld A (Chr)  # Get Chr again
+         do
+            sub Y 1  # Decrement first 'cnt'
+         while ns
+            null A  # EOF?
+            if s  # Yes
+               ld E Nil  # Return NIL
+               pop Y
+               pop X
+               ret
+            end
+            call (EnvGet_A)  # Get next
+         loop
+      end
+      do
+         sub E 1  # Decrement second 'cnt'
+      while ns
+         null A  # EOF?
+         if s  # Yes
+            ld E Nil  # Return NIL
+            pop Y
+            pop X
+            ret
+         end
+         call (EnvPutB)  # Output byte
+         call (EnvGet_A)  # Get next
+      loop
+      ld E TSym  # Return T
+      pop Y
+      pop X
+      ret
+   end
+   sym E  # Need symbol
+   jz argErrEX
+   push Z
+   push 0  # End-of-buffers marker
+   do
+      call bufStringE_SZ  # <S V> Stack buffer
+      push 0  # <S IV> Index
+      link
+      push E  # <S II> Symbol
+      link
+      push Z  # <S> Buffer chain
+      atom Y  # More arguments?
+   while z  # Yes
+      call evSymY_E  # Next argument
+      ld Y (Y CDR)
+   loop
+   ld X 0  # Clear current max
+   ld A (Chr)  # Look ahead char
+   do
+      null A  # EOF?
+   while ns  # No
+      ld Y X  # Output max
+      null Y  # Any?
+      if nz  # Yes
+         ld E (Y IV)  # Set output index
+      end
+      ld Z S  # Buffer chain
+      do
+         do
+            lea C (Z V)  # Stack buffer
+            add C (Z IV)  # Index
+            cmp B (C)  # Bytes match?
+            if eq  # Yes
+               add (Z IV) 1  # Increment index
+               nul (C 1)  # End of string?
+               if nz  # No
+                  null X  # Current max?
+                  if z  # No
+                     ld X Z
+                  else
+                     cmp (X IV) (Z IV)  # Smaller than index?
+                     ldc X Z  # Yes
+                  end
+                  break T
+               end
+               null Y  # Output max?
+               if nz  # Yes
+                  lea C (Y V)  # Buffer of output max
+                  sub E (Z IV)  # Diff to current index
+                  do  # Done?
+                  while ge  # No
+                     ld B (C)
+                     call (EnvPutB)  # Output bytes
+                     add C 1
+                     sub E 1
+                  loop
+               end
+               call (EnvGet_A)  # Skip next input byte
+               ld E (Z II)  # Return matched symbol
+               jmp 90
+            end
+            null (Z IV)  # Still at beginning of string?
+            break z  # Yes
+            lea C (Z (+ V 1))  # Offset pointer to second byte
+            do
+               sub (Z IV) 1  # Decrement index
+            while nz
+               cmpn (Z V) (C) (Z IV)  # Compare stack buffer
+            while nz
+               add C 1  # Increment offset
+            loop
+            cmp X Z  # On current max?
+            if eq  # Yes
+               ld X 0  # Clear current max
+               ld C S  # Buffer chain
+               do
+                  null (C IV)  # Index?
+                  if nz  # Yes
+                     null X  # Current max?
+                     if z  # No
+                        ld X C
+                     else
+                        cmp (X IV) (C IV)  # Smaller than index?
+                        ldc X C  # Yes
+                     end
+                  end
+                  ld C (C)  # Next in chain
+                  null (C)  # Any?
+               until z  # No
+            end
+         loop
+         ld Z (Z)  # Next in chain
+         null (Z)  # Any?
+      until z  # No
+      null X  # Current max?
+      if z  # No
+         null Y  # Output max?
+         if nz
+            push A  # Save current byte
+            push E  # and output index
+            lea C (Y V)  # Buffer of output max
+            do
+               ld B (C)
+               call (EnvPutB)  # Output bytes
+               add C 1
+               sub E 1  # Done?
+            until z  # Yes
+            pop E
+            pop A
+         end
+         call (EnvPutB)  # Output current byte
+      else
+         null Y  # Output max?
+         if nz
+            lea C (Y V)  # Buffer of output max
+            sub E (X IV)  # Diff to current max index
+            do  # Done?
+               while ge  # No
+               ld B (C)
+               call (EnvPutB)  # Output bytes
+               add C 1
+               sub E 1
+            loop
+         end
+      end
+      call (EnvGet_A)  # Get next input byte
+   loop
+   ld E Nil  # Return NIL
+90 pop Z  # Clean up buffers
+   do
+      drop
+      ld S Z
+      pop Z
+      null Z  # End?
+   until z  # Yes
+   pop Z
+   pop Y
+   pop X
+   ret
+
+(code 'putStdoutB 0)
+   push Y
+   ld Y (OutFile)  # OutFile?
+   null Y
+   if nz  # Yes
+      push E
+      push X
+      ld E (Y I)  # Get 'ix'
+      lea X (Y III)  # Buffer pointer
+      cmp E BUFSIZ  # Reached end of buffer?
+      if eq  # Yes
+         push A
+         push C
+         ld (Y I) 0  # Clear 'ix'
+         ld C (Y)  # Get 'fd'
+         call wrBytesCEX_F  # Write buffer
+         ld E 0  # Get 'ix'
+         lea X (Y III)  # Buffer pointer
+         pop C
+         pop A
+      end
+      add X E  # Buffer index
+      ld (X) B  # Store byte
+      add E 1  # Increment ix
+      ld (Y I) E  # Store 'ix'
+      cmp B 10  # Linefeed?
+      if eq  # Yes
+         null (Y II)  # and 'tty'?
+         if nz  # Yes
+            push C
+            ld (Y I) 0  # Clear 'ix'
+            ld C (Y)  # Get 'fd'
+            lea X (Y III)  # Buffer pointer
+            call wrBytesCEX_F  # Write buffer
+            pop C
+         end
+      end
+      pop X
+      pop E
+   end
+   pop Y
+   ret
+
+(code 'newline)
+   ld B 10
+   jmp (EnvPutB)
+
+(code 'space)
+   ld B 32
+(code 'envPutB)  # DLL hook
+   jmp (EnvPutB)
+
+(code 'envGet_A)  # DLL hook
+   jmp (EnvGet_A)
+
+# Output decimal number
+(code 'outNumE)
+   shr E 4  # Normalize
+   if c  # Sign
+      ld B (char "-")  # Output sign
+      call (EnvPutB)
+   end
+   ld A E
+(code 'outWordA)
+   cmp A 9  # Single digit?
+   if gt  # No
+      ld C 0  # Divide by 10
+      div 10
+      push C  # Save remainder
+      call outWordA  # Recurse
+      pop A
+   end
+   add B (char "0")  # Make ASCII digit
+   jmp (EnvPutB)
+
+(code 'prExtNmX)
+   call fileObjX_AC  # Get file and object ID
+   null A  # File?
+   if nz  # Yes
+      call outAoA  # Output file number
+   end
+   ld A C  # Get object ID
+# Output octal number
+(code 'outOctA 0)
+   cmp A 7  # Single digit?
+   if gt  # No
+      push A  # Save
+      shr A 3  # Divide by 8
+      call outOctA  # Recurse
+      pop A
+      and B 7  # Get remainder
+   end
+   add B (char "0")  # Make ASCII digit
+   jmp (EnvPutB)
+
+# Output A-O encoding
+(code 'outAoA 0)
+   cmp A 15  # Single digit?
+   if gt  # No
+      push A  # Save
+      shr A 4  # Divide by 16
+      call outAoA  # Recurse
+      pop A
+      and B 15  # Get remainder
+   end
+   add B (char "@")  # Make ASCII letter
+   jmp (EnvPutB)
+
+(code 'outStringS)  # C
+   lea C (S I)  # Buffer above return address
+(code 'outStringC)
+   do
+      ld B (C)  # Next char
+      add C 1
+      or B B  # Null?
+   while ne  # No
+      call (EnvPutB)
+   loop
+   ret
+
+(code 'outNameE)
+   push X
+   ld X (E TAIL)
+   call nameX_X  # Get name
+   call prNameX  # Print it
+   pop X
+   ret
+
+(code 'prNameX)
+   ld C 0
+   do
+      call symByteCX_FACX  # Next byte
+   while nz
+      call (EnvPutB)  # Output byte
+   loop
+   ret
+
+# Print one expression
+(code 'printE_E)
+   push E  # Save expression
+   call printE  # Print it
+   pop E  # Restore
+   ret
+
+(code 'printE 0)
+   nul (Signal)  # Signal?
+   if nz  # Yes
+      call sighandler0
+   end
+   cnt E  # Short number?
+   jnz outNumE  # Yes
+   big E  # Bignum?
+   if nz  # Yes
+      ld A -1  # Scale
+      jmp fmtNum0AE_E  # Print it
+   end
+   push X
+   sym E  # Symbol?
+   if nz  # Yes
+      ld X (E TAIL)
+      call nameX_X  # Get name
+      zero X  # Any?
+      if eq  # No
+         ld B (char "$")  # $xxxxxx
+         call (EnvPutB)
+         shr E 4  # Normalize symbol pointer
+         ld A E
+         call outOctA
+         pop X
+         ret
+      end
+      sym (E TAIL)  # External symbol?
+      if nz  # Yes
+         ld B (char "{")  # {AB123}
+         call (EnvPutB)
+         call prExtNmX  # Print it
+         ld B (char "}")
+         call (EnvPutB)
+         pop X
+         ret
+      end
+      push Y
+      ld Y Intern
+      call isInternEXY_F  # Internal symbol?
+      if eq  # Yes
+         ld C 0
+         call symByteCX_FACX  # Get first byte
+         do
+            memb Delim "(DelimEnd-Delim)"  # Delimiter?
+            if eq  # Yes
+               push A  # Save char
+               ld B (char "\\")  # Print backslash
+               call (EnvPutB)
+               pop A
+            else
+               cmp B (char ".")  # Dot?
+               if eq  # Yes
+                  call symByteCX_FACX  # Next byte?
+                  if z  # No
+                     ld B (char "\\")  # Print backslash
+                     call (EnvPutB)
+                     ld B (char ".")  # Print dot
+                     call (EnvPutB)
+                     break T  # Done
+                  end
+                  push A  # Save char
+                  ld B (char ".")  # Print dot
+                  call (EnvPutB)
+                  pop A
+               end
+            end
+            call (EnvPutB)  # Put byte
+            call symByteCX_FACX  # Next byte
+         until z  # Done
+      else  # Else transient symbol
+         ld Y 0  # 'tsm' flag in Y
+         atom (Tsm)  # Transient symbol markup?
+         if z  # Yes
+            cmp (EnvPutB) putStdoutB  # to stdout?
+            if eq  # No
+               ld Y ((OutFile) II)  # and 'tty'? -> Y
+            end
+         end
+         null Y  # Transient symbol markup?
+         if z  # No
+            ld B (char "\"")
+            call (EnvPutB)
+         else
+            ld E ((Tsm))  # Get CAR
+            call outNameE  # Write transient symbol markup
+         end
+         ld C 0
+         call symByteCX_FACX  # Get first byte
+         do
+            cmp B (char "\\")  # Backslash?
+            jz 20
+            cmp B (char "\^")  # Caret?
+            jz 20
+            null Y  # Transient symbol markup?
+            jnz 30  # Yes
+            cmp B (char "\"")  # Double quote?
+            if eq  # Yes
+20             push A  # Save char
+               ld B (char "\\")  # Escape with backslash
+               call (EnvPutB)
+               pop A
+            else
+30             cmp B 127  # DEL?
+               if eq  # Yes
+                  ld B (char "\^")  # Print ^?
+                  call (EnvPutB)
+                  ld B (char "?")
+               else
+                  cmp B 32  # White space?
+                  if lt  # Yes
+                     push A  # Save char
+                     ld B (char "\^")  # Escape with caret
+                     call (EnvPutB)
+                     pop A
+                     or A 64  # Make printable
+                  end
+               end
+            end
+            call (EnvPutB)  # Put byte
+            call symByteCX_FACX  # Next byte
+         until z  # Done
+         null Y  # Transient symbol markup?
+         if z  # No
+            ld B (char "\"")  # Final double quote
+            call (EnvPutB)
+         else
+            ld E ((Tsm) CDR)  # Get CDR
+            call outNameE  # Write transient symbol markup
+         end
+      end
+      pop Y
+      pop X
+      ret
+   end
+   # Print list
+   cmp (E) Quote  # CAR 'quote'?
+   if eq  # Yes
+      cmp E (E CDR)  # Circular?
+      if ne  # No
+         ld B (char "'")  # Print single quote
+         call (EnvPutB)
+         ld E (E CDR)  # And CDR
+         call printE
+         pop X
+         ret
+      end
+   end
+   ld X E  # Keep list head
+   ld B (char "(")  # Open paren
+   call (EnvPutB)
+   do
+      push (E CDR)  # Save rest
+      ld E (E)  # Print CAR
+      call printE
+      pop E
+      cmp E Nil  # NIL-terminated?
+   while ne  # No
+      cmp E X  # Circular?
+      if eq  # Yes
+         call space  # Print " ."
+         ld B (char ".")
+         call (EnvPutB)
+         break T
+      end
+      atom E  # Atomic tail?
+      if nz  # Yes
+         call space  # Print " . "
+         ld B (char ".")
+         call (EnvPutB)
+         call space
+         call printE  # and the atom
+         break T
+      end
+      call space  # Print space
+   loop
+   ld B (char ")")  # Closing paren
+   call (EnvPutB)
+   pop X
+   ret
+
+# Print string representation
+(code 'prinE_E 0)
+   push E  # Save expression
+   call prinE  # Print it
+   pop E  # Restore
+   ret
+
+(code 'prinE 0)
+   nul (Signal)  # Signal?
+   if nz  # Yes
+      call sighandler0
+   end
+   cmp E Nil  # NIL?
+   if ne  # No
+      cnt E  # Short number?
+      jnz outNumE  # Yes
+      big E  # Bignum?
+      if nz  # Yes
+         ld A -1  # Scale
+         jmp fmtNum0AE_E  # Print it
+      end
+      push X
+      sym E  # Symbol?
+      if nz  # Yes
+         ld X (E TAIL)
+         call nameX_X  # Get name
+         zero X  # Any?
+         if ne  # Yes
+            sym (E TAIL)  # External symbol?
+            if z  # No
+               call prNameX
+            else
+               ld B (char "{")  # {AB123}
+               call (EnvPutB)
+               call prExtNmX  # Print it
+               ld B (char "}")
+               call (EnvPutB)
+            end
+         end
+      else
+         ld X E  # Get list in X
+         do
+            ld E (X)  # Prin CAR
+            call prinE
+            ld X (X CDR)  # Next
+            cmp X Nil  # NIL-terminated?
+         while ne  # No
+            atom X  # Done?
+            if nz  # Yes
+               ld E X  # Print atomic rest
+               call prinE
+               break T
+            end
+         loop
+      end
+      pop X
+   end
+   ret
+
+# (prin 'any ..) -> any
+(code 'doPrin 2)
+   push X
+   ld X (E CDR)  # Get arguments
+   do
+      ld E (X)
+      eval  # Eval next arg
+      call prinE_E  # Print string representation
+      ld X (X CDR)  # More arguments?
+      atom X
+   until nz  # No
+   pop X
+   ret
+
+# (prinl 'any ..) -> any
+(code 'doPrinl 2)
+   call doPrin  # Print arguments
+   jmp newline
+
+(code 'doSpace 2)
+   push X
+   ld X E
+   ld E ((E CDR))  # Eval 'cnt'
+   eval
+   cmp E Nil  # NIL?
+   if eq  # Yes
+      call space  # Output single space
+      ld E ONE  # Return 1
+   else
+      ld C E  # Keep in E
+      call xCntCX_FC  # Get cnt
+      do
+         sub C 1  # 'cnt' times
+      while ns
+         call space  # Output spaces
+      loop
+   end
+   pop X
+   ret
+
+# (print 'any ..) -> any
+(code 'doPrint 2)
+   push X
+   ld X (E CDR)  # Get arguments
+   do
+      ld E (X)
+      eval  # Eval next arg
+      call printE_E  # Print it
+      ld X (X CDR)  # More arguments?
+      atom X
+   while z  # Yes
+      call space  # Print space
+   loop
+   pop X
+   ret
+
+# (printsp 'any ..) -> any
+(code 'doPrintsp 2)
+   push X
+   ld X (E CDR)  # Get arguments
+   do
+      ld E (X)
+      eval  # Eval next arg
+      call printE_E  # Print it
+      call space  # Print space
+      ld X (X CDR)  # More arguments?
+      atom X
+   until nz  # No
+   pop X
+   ret
+
+# (println 'any ..) -> any
+(code 'doPrintln 2)
+   call doPrint  # Print arguments
+   jmp newline
+
+# (flush) -> flg
+(code 'doFlush 2)
+   ld A (OutFile)  # Flush OutFile
+   call flushA_F  # OK?
+   ld E TSym  # Yes
+   ldnz E Nil
+   ret
+
+# (rewind) -> flg
+(code 'doRewind 2)
+   ld E Nil  # Preload return value
+   ld C (OutFile)  # OutFile?
+   null C
+   if nz  # Yes
+      ld (C I) 0  # Clear 'ix'
+      cc lseek((C) 0 SEEK_SET)  # Seek to beginning of file
+      null A  # OK?
+      if z  # Yes
+         cc ftruncate((C) 0)  # Truncate file
+         nul4  # OK?
+         ldz E TSym  # Return T
+      end
+   end
+   ret
+
+# (ext 'cnt . prg) -> any
+(code 'doExt 2)
+   push X
+   push Y
+   ld X E
+   ld Y (E CDR)  # Y on args
+   call evCntXY_FE  # Eval 'cnt'
+   push (ExtN)  # Save external symbol offset
+   ld (ExtN) E  # Set new
+   ld X (Y CDR)  # Run 'prg'
+   prog X
+   pop (ExtN)  # Restore external symbol offset
+   pop Y
+   pop X
+   ret
+
+# (rd ['sym]) -> any
+# (rd 'cnt) -> num | NIL
+(code 'doRd 2)
+   ld E ((E CDR))  # Get arg
+   eval  # Eval it
+   cnt E  # Read raw bytes?
+   if z  # No
+      push Z
+      ld Z (InFile)  # Current InFile
+      null Z  # Any?
+      if nz  # Yes
+         link
+         push E  # <L I> EOF
+         link
+         ld (GetBinZ_FB) getBinaryZ_FB  # Set binary read function
+         ld (Extn) (ExtN)  # Set external symbol offset
+         call binReadZ_FE  # Read item?
+         ldc E (L I)  # No: Return EOF
+         drop
+      end
+      pop Z
+      ret
+   end
+   ld C (InFile)  # Current InFile?
+   null C
+   jz retNil  # No
+   push X
+   push Y
+   push Z
+   link
+   push ZERO  # <L I> Result
+   link
+   shr E 4  # Normalize
+   jz 80  # Zero
+   if c  # Little endian
+      sub S E  # Buffer
+      ld Y S  # Buffer pointer
+      ld Z 1  # Forward direction
+   else
+      ld Y S  # Buffer pointer
+      ld Z -1  # Backward direction
+      add Y Z  # Point to last byte
+      sub S E  # Buffer
+   end
+   ld C (C)  # Get 'fd' of InFile
+   ld X S  # Buffer pointer
+   push E  # <S> Count
+   call rdBytesCEX_F  # OK?
+   if z  # No
+80    ld E Nil  # Return NIL
+      jmp 90
+   end
+   lea X (L I)  # X on result
+   ld C 4  # Build unsigned number
+   do
+      ld B (Y)  # Next byte from buffer
+      call byteNumBCX_CX
+      add Y Z  # Add direction offset
+      sub (S) 1  # Decrement count
+   until z
+   ld E (L I)  # Get result
+   big E  # Bignum?
+   if nz  # Yes
+      ld A E
+      call zapZeroA_A  # Remove leading zeroes
+      ld E A
+   end
+90 drop
+   pop Z
+   pop Y
+   pop X
+   ret
+
+# (pr 'any ..) -> any
+(code 'doPr 2)
+   push X
+   ld X (E CDR)  # Get arguments
+   do
+      ld E (X)
+      eval  # Eval next arg
+      push E  # Keep
+      ld (Extn) (ExtN)  # Set external symbol offset
+      call prE  # Print binary
+      pop E
+      ld X (X CDR)  # More arguments?
+      atom X
+   until nz  # No
+   pop X
+   ret
+
+# (wr 'cnt ..) -> cnt
+(code 'doWr 2)
+   push X
+   ld X (E CDR)  # Args
+   do
+      ld E (X)  # Eval next
+      eval
+      ld A E  # Get byte
+      shr A 4  # Normalize
+      call putStdoutB  # Output
+      ld X (X CDR)  # X on rest
+      atom X  # Done?
+   until nz  # Yes
+   pop X
+   ret
+
+# (rpc 'sym ['any ..]) -> flg
+(code 'doRpc 2)
+   push X
+   ld X (E CDR)  # Args
+   ld A BEG  # Begin list
+   call putCharA
+   do
+      ld E (X)  # Eval next arg
+      eval
+      ld (PutBinBZ) putCharA  # Set binary print function
+      ld (Extn) (ExtN)  # Set external symbol offset
+      call binPrintEZ
+      ld X (X CDR)  # X on rest
+      atom X  # Any
+   until nz  # No
+   ld A END  # End list
+   call putCharA
+   cc fflush((stdout))  # Flush
+   nul4  # OK?
+   ld E Nil
+   ldz E TSym  # Yes
+   pop X
+   ret
+
+(code 'putCharA 0)
+   cc putchar_unlocked(A)
+   ret
+
+# vi:et:ts=3:sw=3
diff --git a/src64/lib/asm.l b/src64/lib/asm.l
@@ -0,0 +1,546 @@
+# 08mar10abu
+# (c) Software Lab. Alexander Burger
+
+# *LittleEndian *Registers optimize
+
+# *FPic *Section *Label *Tags *Program *Statement
+# *Instructions *IfStack *DoStack
+# "*Mode" "*Modes"
+
+(de *Transfers
+   call
+   jmp
+   jz jeq
+   jnz jne
+   js
+   jns
+   jsz
+   jnsz
+   jc jlt
+   jnc jge
+   jcz jle
+   jncz jgt )
+
+(de *Conditions
+   (T jmp . jmp)
+   (z jz . jnz)
+   (nz jnz . jz)
+   (s js . jns)
+   (ns jns . js)
+   (sz jsz . jnsz)
+   (nsz jnsz . jsz)
+   (c jc . jnc)
+   (nc jnc . jc)
+   (cz jcz . jncz)
+   (ncz jncz . jcz)
+   (eq jz . jnz)
+   (ne jnz . jz)
+   (lt jc . jnc)
+   (le jcz . jncz)
+   (gt jncz . jcz)
+   (ge jnc . jc) )
+
+(de build ("File" "Tags" . "Prg")
+   (off *Section *Tags *IfStack *DoStack)
+   (out "File"
+      (prinl "/* " (datSym (date)) " */")
+      (run "Prg") )
+   (when "Tags"
+      (out "Tags"
+         (for Sym (idx '*Tags)
+            (and
+               (sym? (val Sym))
+               (; Sym 0 src)
+               (prinl Sym " (" (cdr @) " . \"@src64/" (car @) "\")") ) ) ) ) )
+
+(de asm Args
+   (put (car Args) 'asm (cdr Args)) )
+
+(de fpic ()
+   (on *FPic) )
+
+# Sections
+(de section (Fun @Sym)
+   (def Fun
+      (curry (@Sym) (Lbl Align)
+         (put Lbl 'src (cdr (file)))
+         (unless (== *Section '@Sym)
+            (prinl)
+            (prinl "   ." '@Sym)
+            (setq *Section '@Sym) )
+         (prinl)
+         (when Align
+            (prinl "   .balign  16")
+            (do Align
+               ((get 'nop 'asm)) ) )
+         (when (reg Lbl)
+            (quit "Register" Lbl) )
+         (when Lbl
+            (label (setq *Label Lbl)) )
+         (setq *Program
+            (make
+               (while (and (skip "#") (<> "(" (peek)))
+                  (let Atom (read)
+                     (cond
+                        ((== ': Atom)
+                           (link (cons ': (read))) )
+                        ((num? Atom)
+                           (link (cons ': (pack *Label "_" Atom))) )
+                        ((lup *FlowControl Atom)
+                           ((get Atom 'asm) (eval (cadr @))) )
+                        ((lup *Instructions Atom)
+                           (link (cons Atom (mapcar eval (cdr @)))) )
+                        (T (quit "Bad instruction" Atom)) ) ) ) ) )
+         (when (or *IfStack *DoStack)
+            (quit "Unbalanced flow") )
+         (cleanUp)
+         (setq *Program
+            (make
+               (for (L *Program L)
+                  (ifn (optimize L)
+                     (link (pop 'L))
+                     (setq L (nth L (inc (car @))))
+                     (chain (cdr @)) ) ) ) )
+         (for *Statement *Program
+            (if (== ': (car *Statement))
+               (prinl (cdr *Statement) ':)
+               (apply (get (car *Statement) 'asm) (cdr *Statement)) ) ) ) ) )
+
+(section 'data 'data)
+(section 'code 'text)
+
+(de cleanUp ()
+   (use (L1 L2)
+      (while  # Remove duplicate labels
+         (seek
+            '((L)
+               (and
+                  (== ': (caar L))
+                  (== ': (caadr L))
+                  (cond
+                     ((= `(char ".") (char (setq L1 (cdar L))))
+                        (setq L2 (cdadr L)) )
+                     ((= `(char ".") (char (setq L1 (cdadr L))))
+                        (setq L2 (cdar L)) ) ) ) )
+            *Program )
+         (setq *Program
+            (mapcan
+               '((L)
+                  (cond
+                     ((<> L1 ((if (atom (cdr L)) cdr cadr) L))
+                        (cons L) )
+                     ((memq (car L) *Transfers)
+                        (cons (list (car L) L2)) ) ) )
+               *Program ) ) )
+      (while  # Remove jmp-only labels
+         (seek
+            '((L)
+               (and
+                  (== ': (car (setq L1 (car L))))
+                  (= `(char ".") (char (cdr L1)))
+                  (== 'jmp (car (setq L2 (cadr L)))) ) )
+            *Program )
+         (setq *Program
+            (mapcan
+               '((L)
+                  (unless (== L L1)
+                     (cons
+                        (if
+                           (and
+                              (memq (car L) *Transfers)
+                              (= (cdr L1) (cadr L)) )
+                           (list (car L) (cadr L2))
+                           L ) ) ) )
+               *Program ) ) ) )
+      (setq *Program  # Remove unreachable statements
+         (make
+            (while *Program
+               (when (memq (car (link (pop '*Program))) '(jmp ret eval/ret))
+                  (while (and *Program (n== ': (caar *Program)))
+                     (pop '*Program) ) ) ) ) )
+   (setq *Program  # Remove zero jumps
+      (make
+         (while *Program
+            (let P (pop '*Program)
+               (unless
+                  (and
+                     (memq (car P) (cdr *Transfers))
+                     (== ': (caar *Program))
+                     (= (cadr P) (cdar *Program)) )
+                  (link P) ) ) ) ) )
+   (setq *Program  # Toggle inverted jumps
+      (make
+         (while *Program
+            (let P (pop '*Program)
+               (ifn
+                  (and
+                     (memq (car P) (cddr *Transfers))
+                     (== 'jmp (caar *Program))
+                     (== ': (caadr *Program))
+                     (= (cadr P) (cadr (cadr *Program))) )
+                  (link P)
+                  (link
+                     (list
+                        (cddr
+                           (find
+                              '((C) (== (car P) (cadr C)))
+                              (cdr *Conditions) ) )
+                        (cadr (pop '*Program)) ) ) ) ) ) ) ) )
+
+
+# Print instruction
+(de prinst (Name . @)
+   (if (rest)
+      (tab (3 -9 0) NIL Name (glue ", " @))
+      (tab (3 -9) NIL Name) ) )
+
+# Registers
+(de reg (X)
+   (cdr (asoq X *Registers)) )
+
+# Operand evaluation
+(de operand (X)
+   (cond
+      ((num? X) X)
+      ((sym? X)
+         (cond
+            ((asoq X *Registers) X)
+            ((get X 'equ) @)
+            (T X) ) )
+      ((asoq (car X) *Registers)
+         (cons (car X) (operand (cadr X))) )
+      ((memq (car X) '(+ - * */ / % >> & | short char hex oct))
+         (apply (car X) (mapcar operand (cdr X))) )
+      (T (cons (car X) (operand (cadr X)))) ) )
+
+# Constants
+(de short (N)
+   (| 2 (>> -4 N)) )
+
+(de equ Args
+   (def (car Args)
+      (put (car Args) 'equ (run (cdr Args) 1)) ) )
+
+
+# Source/Destination addressing mode:
+#  0    -> Immediate
+#  NIL  -> Register
+#  T    -> Direct
+(de "source" (X F)
+   (setq X (operand X))
+   (cond
+      ((num? X)                                 # Immediate
+         (zero "*Mode")
+         (pack '$ (and F "~") X) )
+      ((reg X) (off "*Mode") @)                 # Register
+      ((atom X) (on "*Mode") X)                 # Direct
+      ((or (num? (cdr X)) (get (cdr X) 'equ))
+         (prog1 (cons ("source" (car X) F) @)
+            (setq "*Mode" (cons "*Mode" 0)) ) )
+      ((cdr X)
+         (and (reg (cdr X)) (quit "Bad source" X))
+         (prog1 (cons ("source" (car X) F) @)
+            (setq "*Mode" (cons "*Mode" T)) ) )
+      (T
+         (prog1 (cons ("source" (car X) F))
+            (setq "*Mode" (cons "*Mode")) ) ) ) )
+
+(de source (F)
+   ("source" (read) F) )
+
+(de sources ()
+   (off "*Modes")
+   (let Arg (read)
+      (if (lst? Arg)
+         (mapcar
+            '((X)
+               (prog1 ("source" X)
+                  (queue '"*Modes" "*Mode") ) )
+            Arg )
+         ("source" Arg) ) ) )
+
+(de "destination" (X F)
+   (setq X (operand X))
+   (cond
+      ((num? X) (quit "Bad destination" X))     # Immediate
+      ((reg X) (off "*Mode") @)                 # Register
+      ((atom X)                                 # Direct
+         (or F (quit "Bad destination" X))
+         (on "*Mode")
+         X )
+      ((or (num? (cdr X)) (get (cdr X) 'equ))
+         (prog1 (cons ("destination" (car X) T) @)
+            (setq "*Mode" (cons "*Mode" 0)) ) )
+      ((cdr X)
+         (and (reg (cdr X)) (quit "Bad destination" X))
+         (prog1 (cons ("destination" (car X) T) (cdr X))
+            (setq "*Mode" (cons "*Mode" T)) ) )
+      (T
+         (prog1 (cons ("destination" (car X) T))
+            (setq "*Mode" (cons "*Mode")) ) ) ) )
+
+(de destination ()
+   ("destination" (read)) )
+
+(de destinations ()
+   (off "*Modes")
+   (mapcar
+      '((X)
+         (prog1 ("destination" X)
+            (queue '"*Modes" "*Mode") ) )
+      (read) ) )
+
+
+# Target addressing mode:
+#  NIL -> Absolute
+#  0   -> Indexed
+#  T   -> Indirect
+(de address ()
+   (let X (read)
+      (off "*Mode")
+      (cond
+         ((num? X) (pack *Label "_" X))            # Label
+         ((reg X) (quit "Bad address" X))          # Register
+         ((atom X) X)                              # Absolute
+         ((cdr X) (quit "Bad address" X))
+         ((reg (car X)) (zero "*Mode") @)          # Register indirect
+         (T (on "*Mode") (car X)) ) ) )            # Indirect
+
+
+# Flow control
+(balance '*FlowControl
+   (quote
+      (break (read))
+      (continue (read))
+      (do)
+      (else)
+      (end)
+      (if (read))
+      (loop)
+      (until (read))
+      (while (read)) ) )
+
+(de flowCondition (Sym Lbl Neg)
+   (if ((if Neg cddr cadr) (asoq Sym *Conditions))
+      (link (list @ Lbl))
+      (quit "Bad condition" Sym) ) )
+
+(de flowLabel ()
+   (pack "." (inc (0))) )
+
+(asm if (Sym)
+   (flowCondition Sym (push '*IfStack (flowLabel)) T) )
+
+(asm else ()
+   (let Lbl (car *IfStack)
+      (link
+         (list 'jmp (set *IfStack (flowLabel)))
+         (cons ': Lbl) ) ) )
+
+(asm end ()
+   (link (cons ': (pop '*IfStack))) )
+
+(asm do ()
+   (link (cons ': (push '*DoStack (flowLabel)))) )
+
+(asm while (Sym)
+   (flowCondition Sym
+      (if (pair (car *DoStack))
+         (car @)
+         (push *DoStack (flowLabel)) )
+      T ) )
+
+(asm until (Sym)
+   (let X (pop '*DoStack)
+      (flowCondition Sym (fin X) T)
+      (and (pair X) (link (cons ': (car X)))) ) )
+
+(asm break (Sym)
+   (flowCondition Sym
+      (if (pair (car *DoStack))
+         (car @)
+         (push *DoStack (flowLabel)) ) ) )
+
+(asm continue (Sym)
+   (flowCondition Sym (fin (car *DoStack))) )
+
+(asm loop ()
+   (let X (pop '*DoStack)
+      (link (list 'jmp (fin X)))
+      (and (pair X) (link (cons ': (car X)))) ) )
+
+
+# Instruction set
+(balance '*Instructions
+   (quote
+      (add (destination) "*Mode" (source) "*Mode")
+      (addc (destination) "*Mode" (source) "*Mode")
+      (align (operand (read)))
+      (and (destination) "*Mode" (source) "*Mode")
+      (ascii (operand (read)))
+      (asciz (operand (read)))
+      (atom (source) "*Mode")
+      (begin (operand (read)))
+      (big (source) "*Mode")
+      (byte (operand (read)))
+      (bytes (mapcar operand (read)))
+      (cc (address) "*Mode" (sources) "*Modes")
+      (call (address) "*Mode")
+      (clrc)
+      (clrz)
+      (cmp (destination) "*Mode" (source) "*Mode")
+      (cmp4 (source) "*Mode")
+      (cmpm (destination) "*Mode" (source) "*Mode" (source) "*Mode")
+      (cmpn (destination) "*Mode" (source) "*Mode" (source) "*Mode")
+      (cnt (source) "*Mode")
+      (dbg)
+      (div (source) "*Mode")
+      (drop)
+      (eval)
+      (eval+)
+      (eval/ret)
+      (exec (reg (read)))
+      (hx2 (read))
+      (init)
+      (initSym (read) (read) (operand (read)))
+      (int)
+      (jc (address) "*Mode")
+      (jcz (address) "*Mode")
+      (jeq (address) "*Mode")
+      (jge (address) "*Mode")
+      (jgt (address) "*Mode")
+      (jle (address) "*Mode")
+      (jlt (address) "*Mode")
+      (jmp (address) "*Mode")
+      (jnc (address) "*Mode")
+      (jncz (address) "*Mode")
+      (jne (address) "*Mode")
+      (jns (address) "*Mode")
+      (jnsz (address) "*Mode")
+      (jnz (address) "*Mode")
+      (js (address) "*Mode")
+      (jsz (address) "*Mode")
+      (jz (address) "*Mode")
+      (:: (read))
+      (ld (destination) "*Mode" (source) "*Mode")
+      (ld2 (source) "*Mode")
+      (ld4 (source) "*Mode")
+      (ldc (destination) "*Mode" (source) "*Mode")
+      (ldnc (destination) "*Mode" (source) "*Mode")
+      (ldnz (destination) "*Mode" (source) "*Mode")
+      (ldz (destination) "*Mode" (source) "*Mode")
+      (lea (destination) "*Mode" (source) "*Mode")
+      (link)
+      (memb (source) "*Mode" (source) "*Mode")
+      (movm (destination) "*Mode" (source) "*Mode" (source) "*Mode")
+      (movn (destination) "*Mode" (source) "*Mode" (source) "*Mode")
+      (mset (destination) "*Mode" (source) "*Mode")
+      (mul (source) "*Mode")
+      (neg (destination) "*Mode")
+      (nop)
+      (not (destination) "*Mode")
+      (nul (source) "*Mode")
+      (nul4)
+      (null (source) "*Mode")
+      (num (source) "*Mode")
+      (off (destination) "*Mode" (source T) "*Mode")
+      (or (destination) "*Mode" (source) "*Mode")
+      (pop (destination) "*Mode")
+      (prog (reg (read)))
+      (push (source) "*Mode")
+      (rcl (destination) "*Mode" (source) "*Mode")
+      (rcr (destination) "*Mode" (source) "*Mode")
+      (ret)
+      (return (operand (read)))
+      (rol (destination) "*Mode" (source) "*Mode")
+      (ror (destination) "*Mode" (source) "*Mode")
+      (set (destination) "*Mode" (source) "*Mode")
+      (setc)
+      (setz)
+      (shl (destination) "*Mode" (source) "*Mode")
+      (shr (destination) "*Mode" (source) "*Mode")
+      (skip (operand (read)))
+      (slen (destination) "*Mode" (source) "*Mode")
+      (st2 (destination) "*Mode")
+      (st4 (destination) "*Mode")
+      (sub (destination) "*Mode" (source) "*Mode")
+      (subc (destination) "*Mode" (source) "*Mode")
+      (sxt)
+      (sym (source) "*Mode")
+      (test (destination) "*Mode" (source) "*Mode")
+      (tuck (source) "*Mode")
+      (word (operand (read)))
+      (xchg (destination) "*Mode" (destination) "*Mode")
+      (xor (destination) "*Mode" (source) "*Mode")
+      (zero (source) "*Mode")
+      (zxt) ) )
+
+
+# Directives
+(de label (Lbl)
+   (prinl "   .globl  " Lbl)
+   (prinl Lbl ':) )
+
+(asm :: (Lbl)
+   (label Lbl) )
+
+(asm align (N)
+   (prinst ".balign" N) )
+
+(asm word (N)
+   (prinst ".quad" N) )
+
+(asm byte (N)
+   (prinst ".byte" N) )
+
+(asm bytes (Lst)
+   (prinst ".byte" (glue ", " Lst)) )
+
+(asm hx2 (Lst)
+   (prinst ".short" (glue ", " (mapcar hex Lst))) )
+
+(asm ascii (Str)
+   (prinst ".ascii " (pack "\"" Str "\"")) )
+
+(asm asciz (Str)
+   (prinst ".asciz " (pack "\"" Str "\"")) )
+
+(asm skip (N)
+   (prinst ".space" N) )
+
+(asm initSym (Lbl Name Val)
+   (idx '*Tags (def Name Val) T)
+   (setq Name
+      (let (N 2  Lst (chop Name)  C)
+         (make
+            (while (nth Lst 8)
+               (let L (mapcar char (cut 8 'Lst))
+                  (unless *LittleEndian
+                     (setq L (flip L)) )
+                  (chain L) ) )
+            (let L
+               (make
+                  (do 7
+                     (setq C (char (pop 'Lst)))
+                     (link (| N (>> -4 (& 15 C))))
+                     (setq N (& 15 (>> 4 C))) )
+                  (link N) )
+               (unless *LittleEndian
+                  (setq L (flip L)) )
+               (chain L) ) ) ) )
+   (if (nth Name 9)
+      (prinst ".quad" ".+20")
+      (prinl "   .byte    " (glue ", " Name))
+      (off Name) )
+   (when Lbl
+      (label Lbl) )
+   (prinst ".quad" Val)
+   (while Name
+      (prinl "   .byte    " (glue ", " (cut 8 'Name))) ) )
+
+(de warn (Msg)
+   (out 2
+      (printsp *Label *Statement)
+      (prinl Msg) ) )
+
+# vi:et:ts=3:sw=3
diff --git a/src64/main.l b/src64/main.l
@@ -0,0 +1,2605 @@
+# 17mar10abu
+# (c) Software Lab. Alexander Burger
+
+### Global return labels ###
+(code 'Ret 0)
+   ret
+(code 'Retc 0)
+   setc
+   ret
+(code 'Retnc 0)
+   clrc
+   ret
+(code 'Retz 0)
+   setz
+   ret
+(code 'Retnz 0)
+   clrz
+   ret
+(code 'RetNil 0)
+   ld E Nil
+   ret
+(code 'RetT 0)
+   ld E TSym
+   ret
+(code 'RetE_E 0)
+   ld E (E)  # Get value or CAR
+   ret
+
+### Main entry point ###
+(code 'main)
+   init
+   # Locate home directory
+   ld X (AV)  # Command line vector
+   do
+      ld Y (X)  # Next command
+      null Y  # Any?
+   while nz  # Yes
+      ld B (Y)  # First byte
+      cmp B (char "-")  # Dash?
+      if ne  # No
+         ld Z Y  # Keep in Y
+         ld B (char "/")  # Contains a slash?
+         slen C Y  # String length in C
+         memb Z C
+         if eq  # Yes
+            do
+               memb Z C  # Find last one
+            until ne
+            ld A Z
+            sub A 2  # "./lib.l"?
+            cmp A Y  # Last slash is second byte?
+            jne 10  # No
+            ld B (Y)  # First byte is "."?
+            cmp B (char ".")
+            if ne  # No
+10             sub Z Y  # Length
+               ld C Z  # Keep in Z
+               add C 1  # Space for null byte
+               cc malloc(C)
+               ld (Home) A  # Set 'Home'
+               movn (A) (Y) Z  # Copy path including "/"
+               add Z (Home)  # Pointer to null byte
+               set (Z) 0  # Clear it
+            end
+         end
+         break T
+      end
+      add X I
+   loop
+   # Initialize globals
+   cc getpid()  # PID in A
+   shl A 4  # Make short number
+   or A CNT
+   ld (Pid) A
+   ld (Stack0) S  # Save top level stack pointer
+   ld L 0  # Init link register
+   call heapAlloc  # Allocate initial heap
+   ld E Nil  # Init internal symbols
+   lea Z (E IV)  # Skip padding
+   do
+      ld X (E TAIL)  # Get name
+      ld Y Intern
+      call internEXY_FE  # Store to internals
+      ld E Z
+      cnt (Z TAIL)  # Short name?
+      if nz  # Yes
+         add Z II  # Next symbol
+      else
+         add Z IV
+      end
+      cmp E SymTabEnd
+   until gt
+   ld (EnvGet_A) getStdin_A
+   ld A 0  # Standard input
+   call initInFileA_A  # Create input file
+   ld (InFile) A  # Set to default InFile
+   ld (EnvPutB) putStdoutB
+   ld A 2  # Standard error
+   call initOutFileA_A  # Create output file
+   ld A 1  # Standard output
+   call initOutFileA_A  # Create output file
+   ld (OutFile) A  # Set to default OutFile
+   cc tcgetattr(0 OrgTermio)  # Save terminal I/O
+   not B
+   ld (Tio) B  # and flag
+   sub S SIGSET_T  # Create signal mask structure
+   cc sigfillset(S)  # Set all signals to unblocked
+   cc sigprocmask(SIG_UNBLOCK S 0)
+   add S SIGSET_T  # Drop mask structure
+   ld E sig  # Install standard signal handler
+   ld C SIGHUP
+   call iSignalCE  # for SIGHUP
+   ld C SIGUSR1
+   call iSignalCE  # for SIGUSR1
+   ld C SIGUSR2
+   call iSignalCE  # for SIGUSR2
+   ld C SIGALRM
+   call iSignalCE  # for SIGALRM
+   ld C SIGTERM
+   call iSignalCE  # for SIGTERM
+   ld E sigTerm  # Install terminating signal handler for SIGINT
+   ld C SIGINT
+   call iSignalCE
+   ld E sigChld  # Install child signal handler for SIGCHLD
+   ld C SIGCHLD
+   call iSignalCE
+   cc signal(SIGCHLD sigChld)
+   cc signal(SIGPIPE SIG_IGN)  # Ignore signals
+   cc signal(SIGTTIN SIG_IGN)
+   cc signal(SIGTTOU SIG_IGN)
+   cc gettimeofday(Buf 0)  # Get time
+   ld A (Buf)  # tv_sec
+   mul 1000000  # Convert to microseconds
+   add A (Buf I)  # tv_usec
+   ld (USec) A  # Store
+   ld X 0  # Runtime expression
+   call loadAllX_E  # Load arguments
+   ld E sig  # Install standard signal handler for SIGINT
+   ld C SIGINT
+   set (Repl) 1  # Set REPL flag
+   call iSignalCE
+(code 'restart)
+   ld B (char ":")  # Prompt
+   ld E Nil  # REPL
+   ld X 0  # Runtime expression
+   call loadBEX_E
+   ld E 0
+# Exit
+(code 'byeE)
+   nul (InBye)  # Re-entered?
+   if z  # No
+      set (InBye) 1
+      push E  # Save exit code
+      ld C 0  # Top frame
+      call unwindC_Z  # Unwind
+      ld E (Bye)  # Run exit expression(s)
+      call execE
+      pop E  # Restore exit code
+   end
+   call flushAll  # Flush all output channels
+(code 'finishE)
+   call setCooked  # Set terminal to cooked mode
+   cc exit(E)
+
+# Load all remaining arguments
+(code 'loadAllX_E)
+   do
+      ld E ((AV))  # Command line vector
+      null E  # Next string pointer?
+      jz retNil  # No
+      ld B (E)  # Single-dash argument?
+      cmp B (char "-")
+      if eq
+         nul (E 1)
+         jz retNil  # Yes
+      end
+      add (AV) I  # Increment vector pointer
+      call mkStrE_E  # Make transient symbol
+      ld B 0  # Prompt
+      call loadBEX_E
+   loop
+
+# Give up
+(code 'giveupX)
+   ld A (Pid)  # Get PID
+   shr A 4
+   cc fprintf((stderr) Giveup A X)
+   ld E 1
+   jmp finishE
+: Giveup asciz "%d %s\\n"
+
+(code 'execErrS)
+   cc fprintf((stderr) ExecErr (S))
+   ld E 127
+   jmp finishE
+: ExecErr asciz "%s: can't exec\\n"
+
+# Install interrupting signal
+(code 'iSignalCE)
+   sub S (* 2 SIGACTION)  # 'sigaction' and 'oldact'
+   ld (S SA_HANDLER) E  # Function pointer
+   cc sigemptyset(&(S SA_MASK))
+   ld (S SA_FLAGS) 0
+   cc sigaction(C S &(S SIGACTION))  # Install handler
+   add S (* 2 SIGACTION)
+   ret
+
+# Allocate memory
+(code 'allocAE_A 0)
+   cc realloc(A E)  # Reallocate pointer in A to size E
+   null A  # OK?
+   jnz Ret  # Return
+   ld X Alloc  # Else no memory
+   jmp giveupX
+: Alloc asciz "No memory"
+
+
+# Allocate cell heap
+(code 'heapAlloc 0)  # AEX
+   ld A 0  # NULL pointer
+   ld E (+ HEAP I)  # Heap allocation size
+   call allocAE_A
+   ld E A  # Heap pointer
+   ld (A HEAP) (Heaps)  # Set heap link
+   ld (Heaps) A
+   add A (- HEAP 16)  # A on last cell in chunk
+   ld X (Avail)  # Initialize free list
+   do
+      ld (A) X  # Link avail
+      ld X A
+      sub A 16
+      cmp A E  # Done?
+   until lt  # Yes
+   ld (Avail) X  # Set new Avail
+   ret
+
+# Signal handler
+(code 'sighandler0)
+   push E
+   ld E 0
+   call sighandlerE
+   pop E
+   ret
+
+(code 'sighandlerX)
+   push E
+   ld E X
+   call sighandlerE
+   pop E
+   ret
+
+(code 'sighandlerE)
+   null (EnvProtect)  # Protected?
+   if z  # No
+      ld (EnvProtect) 1
+      push A
+      push C
+      ld B (Signal)  # Which signal?
+      cmp B SIGHUP
+      if eq
+         set (Signal) 0  # Clear signal
+         ld E (Hup)  # Run 'Hup'
+         call execE
+      else
+         cmp B SIGINT
+         if eq
+            set (Signal) 0  # Clear signal
+            nul (PRepl)  # Child of REPL process?
+            if z  # No
+               null E  # Runtime expression?
+               ldz E Nil  # No: Default to NIL
+               call brkLoadE_E  # Enter debug breakpoint
+            end
+         else
+            cmp B SIGUSR1
+            if eq
+               set (Signal) 0  # Clear signal
+               ld E (Sig1)  # Run 'Sig1'
+               call execE
+            else
+               cmp B SIGUSR2
+               if eq
+                  set (Signal) 0  # Clear signal
+                  ld E (Sig2)  # Run 'Sig2'
+                  call execE
+               else
+                  cmp B SIGALRM
+                  if eq
+                     set (Signal) 0  # Clear signal
+                     ld E (Alarm)  # Run 'Alarm'
+                     call execE
+                  else
+                     cmp B SIGTERM
+                     if eq
+                        push X
+                        ld X (Child)  # Iterate children
+                        ld C (Children)  # Count
+                        ld E 0  # Flag
+                        do
+                           sub C VI  # More?
+                        while ge  # Yes
+                           null (X)  # 'pid'?
+                           if nz  # Yes
+                              cc kill((X) SIGTERM)  # Try to terminate
+                              nul4  # OK?
+                              ldz E 1  # Yes: Set flag
+                           end
+                           add X VI  # Increment by sizeof(child)
+                        loop
+                        pop X
+                        null E  # Still terminated any child?
+                        if z  # No
+                           set (Signal) 0
+                           ld E 0  # Exit OK
+                           jmp byeE
+                        end
+                     end
+                  end
+               end
+            end
+         end
+      end
+      pop C
+      pop A
+      ld (EnvProtect) 0
+   end
+   ret
+
+(code 'sig)
+   begin 1  # Signal number in A
+   null (TtyPid)  # Kill terminal process?
+   if nz  # Yes
+      cc kill((TtyPid) A)
+   else
+      ld (Signal) B
+   end
+   return 1
+
+(code 'sigTerm)
+   begin 0  # Ignore signal number
+   null (TtyPid)  # Kill terminal process?
+   if nz  # Yes
+      cc kill((TtyPid) SIGTERM)
+   else
+      set (Signal) SIGTERM
+   end
+   return 0
+
+(code 'sigChld)
+   begin 0  # Ignore signal number
+   call errno_A  # Save 'errno'
+   push A
+   sub S I  # 'stat'
+   do
+      cc waitpid(0 S WNOHANG)  # Wait for child
+      nul4  # Pid greater zero?
+   while nsz  # Yes
+      ld C A  # Keep Pid
+      call wifsignaledS_F  # WIFSIGNALED(S)?
+      if nz  # Yes
+         call wtermsigS_A  # Get signal number WTERMSIG(S)
+         cc fprintf((stderr) PidSigMsg C A)
+      end
+   loop
+   add S I  # Drop 'stat'
+   pop C  # Restore 'errno'
+   call errnoC
+   return 0
+: PidSigMsg asciz "%d SIG-%d\\n"
+
+(code 'tcSetC)
+   null (Termio)  # In raw mode?
+   if nz  # Yes
+      do
+         cc tcsetattr(0 TCSADRAIN C)  # Set terminal I/O
+         nul4  # OK?
+      while nz  # No
+         call errno_A
+         cmp A EINTR  # Interrupted?
+      until ne  # No
+   end
+   ret
+
+(code 'sigTermStop)
+   begin 0  # Ignore signal number
+   ld C OrgTermio  # Set original terminal I/O
+   call tcSetC
+   sub S SIGSET_T  # Create mask structure
+   cc sigemptyset(S)  # Init to empty signal set
+   cc sigaddset(S SIGTSTP)  # Add stop signal
+   cc sigprocmask(SIG_UNBLOCK S 0)  # Remove blocked signals
+   add S SIGSET_T  # Drop mask structure
+   cc signal(SIGTSTP SIG_DFL)
+   cc raise(SIGTSTP)
+   cc signal(SIGTSTP sigTermStop)
+   ld C (Termio)
+   call tcSetC
+   return 0
+
+(code 'setRaw 0)
+   nul (Tio)  # Terminal I/O?
+   if nz  # Yes
+      null (Termio)  # Already in raw mode?
+      if z  # No
+         cc malloc(TERMIOS)  # Allocate space for termio structure
+         ld (Termio) A  # Save it
+         ld C A  # Pointer in C
+         movn (C) (OrgTermio) TERMIOS  # Copy original termio structure
+         ld A 0  # Clear c_iflag
+         st4 (C C_IFLAG)
+         ld A ISIG  # ISIG in c_lflag
+         st4 (C C_LFLAG)
+         set (C (+ C_CC VMIN)) 1
+         set (C (+ C_CC VTIME)) 0
+         call tcSetC  # Set terminal I/O
+         cc signal(SIGTSTP SIG_IGN)  # Ignore stop signals
+         cmp A SIG_DFL  # Not set yet?
+         if eq  # Yes
+            cc signal(SIGTSTP sigTermStop)  # Handle stop signals
+         end
+      end
+   end
+   ret
+
+(code 'setCooked 0)
+   ld C OrgTermio  # Set original terminal I/O
+   call tcSetC
+   cc free((Termio))  # Clear Termio
+   ld (Termio) 0
+   ret
+
+#  (raw ['flg]) -> flg
+(code 'doRaw 2)
+   ld E (E CDR)  # Arg?
+   atom E
+   if nz  # No
+      null (Termio)  # Return termio flag
+      jnz retT
+      ld E Nil
+      ret
+   end
+   ld E (E)  # Evaluate arg
+   eval
+   cmp E Nil  # NIL?
+   if eq  # Yes
+      call setCooked  # Set terminal to cooked mode
+      ld E Nil
+      ret
+   end
+   call setRaw  # Set terminal to raw mode
+   ld E TSym
+   ret
+
+# (alarm 'cnt . prg) -> cnt
+(code 'doAlarm 2)
+   push X
+   push Y
+   ld X E
+   ld Y (E CDR)  # Y on args
+   call evCntXY_FE  # Get 'cnt'
+   cc alarm(E)  # Set alarm
+   ld (Alarm) (Y CDR)
+   ld E A  # Get old alarm
+   shl E 4  # Make short number
+   or E CNT
+   pop Y
+   pop X
+   ret
+
+# (protect . prg) -> any
+(code 'doProtect 2)
+   push X
+   ld X (E CDR)  # Get 'prg'
+   add (EnvProtect) 1
+   prog X  # Run 'prg'
+   sub (EnvProtect) 1
+   pop X
+   ret
+
+# (heap 'flg) -> cnt
+(code 'doHeap 2)
+   ld E ((E CDR))  # Get arg
+   eval  # Eval it
+   cmp E Nil  # NIL?
+   if eq  # Yes
+      ld E ZERO  # Init count
+      ld A (Heaps)  # Get heap list
+      do
+         add E (hex "10")  # Increment count
+         ld A (A HEAP)  # Get link
+         null A  # Done?
+      until z  # Yes
+      ret
+   end
+   ld A 0  # Init count
+   ld C (Avail)  # Get avail list
+   do
+      null C  # Any?
+   while nz  # Yes
+      add A 1  # Increment count
+      ld C (C)  # Follow link
+   loop
+   div CELLS  # (C is zero)
+   ld E A
+   shl E 4  # Make short number
+   or E CNT
+   ret
+
+# (env ['lst] | ['sym 'val] ..) -> lst
+(code 'doEnv 2)
+   push X
+   ld X (E CDR)
+   link
+   push Nil  # <L II> Safe
+   push Nil  # <L I> Result
+   link
+   atom X  # Args?
+   if nz  # No
+      push Y
+      ld Y (EnvBind)  # Bindings
+      do
+         null Y  # Bindings?
+      while nz  # Yes
+         ld C (Y)  # End of bindings
+         null (Y -I)  # Env swap zero?
+         if z  # Yes
+            add Y I  # Y on bindings
+            do
+               ld E (Y)  # Next symbol
+               ld X (L I)  # Get result
+               do
+                  atom X  # More result items?
+                  if nz  # No
+                     call cons_A  # Cons symbol and its value
+                     ld (A) E
+                     ld (A CDR) (E)
+                     call consA_X  # Cons to result
+                     ld (X) A
+                     ld (X CDR) (L I)
+                     ld (L I) X
+                     break T
+                  end
+                  cmp E ((X))  # Symbol already in result?
+               while ne  # No
+                  ld X (X CDR)  # Next result item
+               loop
+               add Y II  # Skip value
+               cmp Y C  # More?
+            until eq  # No
+         end
+         ld Y (C I)  # Bind link
+      loop
+      pop Y
+   else
+      do
+         ld E (X)  # Eval 'lst' or 'sym'
+         eval
+         ld (L II) E  # Save
+         atom E  # 'lst'?
+         if z  # Yes
+            do
+               call cons_A  # Cons symbol and its value
+               ld (A) (E)
+               ld (A CDR) ((E))
+               call consA_C  # Cons to result
+               ld (C) A
+               ld (C CDR) (L I)
+               ld (L I) C
+               ld E (E CDR)  # Next item in 'lst'
+               atom E  # Any?
+            until nz  # No
+         else
+            cmp E Nil  # NIL?
+            if ne  # No
+               ld X (X CDR)  # Next arg
+               ld E (X)  # Eval
+               eval
+               call consE_A  # Cons symbol and value
+               ld (A) (L II)  # Safe
+               ld (A CDR) E
+               call consA_C  # Cons to result
+               ld (C) A
+               ld (C CDR) (L I)
+               ld (L I) C
+            end
+         end
+         ld X (X CDR)  # More args?
+         atom X
+      until nz  # No
+   end
+   ld E (L I)  # Get result
+   drop
+   pop X
+   ret
+
+# (up [cnt] sym ['val]) -> any
+(code 'doUp 2)
+   push X
+   push Y
+   push Z
+   ld C 1  # Count
+   ld E (E CDR)  # First arg
+   ld X (E)  # Get 'sym'
+   cnt X  # 'cnt'?
+   if nz  # Yes
+      ld C X  # Count
+      shr C 4  # Normalize
+      ld E (E CDR)  # Skip arg
+      ld X (E)  # 'sym'
+   end
+   ld E (E CDR)  # Last arg
+   ld Y (EnvBind)  # Bindings
+   ld Z X  # Value pointer
+   do
+      null Y  # Bindings?
+   while nz  # Yes
+      ld A (Y)  # End of bindings in A
+      add Y I
+      do
+         cmp X (Y)  # Found symbol?
+         if eq  # Yes
+            lea Z (Y I)  # Point to saved value
+            sub C 1  # Decrement count
+            jz 10  # Done
+         end
+         add Y II
+         cmp Y A  # More?
+      until eq  # No
+      ld Y (A I)  # Bind link
+   loop
+10 atom E  # 'val' arg?
+   if nz  # No
+      ld E (Z)  # Get value
+   else
+      ld E (E)  # Eval last arg
+      eval
+      ld (Z) E  # Store value
+   end
+   pop Z
+   pop Y
+   pop X
+   ret
+
+### Comparisons ###
+(code 'equalAE_F 0)
+   cmp A E  # Pointer-equal?
+   jz ret  # Yes: 'eq'
+   cnt A  # A short?
+   jnz ret  # Yes: 'ne'
+   big A  # A big?
+   if nz  # Yes
+      big E  # E also big?
+      jz Retnz  # No: 'ne'
+      test A SIGN  # A negative?
+      if nz  # Yes
+         test E SIGN  # E also negative?
+         jz Retnz  # No: 'ne'
+         off A SIGN  # Make both positive
+         off E SIGN
+      end
+      do
+         cmp (A DIG) (E DIG)  # Digits equal?
+      while eq  # Yes
+         ld A (A BIG)  # Else next digits
+         ld E (E BIG)
+         cmp A E  # Pointer-equal?
+      while ne  # No
+         cnt A  # A short?
+      while z  # No
+         cnt E  # E short?
+      until nz  # Yes
+      ret
+   end
+   sym A  # A symbolic?
+   if nz  # Yes
+      num E  # E also symbolic?
+      jnz Retnz
+      sym E
+      jz Retnz  # No: 'ne'
+      ld A (A TAIL)
+      call nameA_A  # Get name of A
+      zero A  # Any?
+      jeq retnz  # No: 'ne'
+      ld E (E TAIL)
+      call nameE_E  # Get name of E
+      zero E  # Any?
+      jeq retnz  # No: 'ne'
+      jmp equalAE_F
+   end
+   atom E  # E atomic?
+   jnz ret  # Yes: 'ne'
+   do
+      cmp (A) Quote  # A quoted?
+   while eq  # Yes
+      cmp (E) Quote  # E also quoted?
+      jnz ret  # No: 'ne'
+      cmp A (A CDR)  # A circular?
+      if eq  # Yes
+         cmp E (E CDR)  # Check if E also circular
+         ret
+      end
+      cmp E (E CDR)  # E circular?
+      jz retnz  # Yes: 'ne'
+      ld A (A CDR)  # Next cells
+      ld E (E CDR)
+      atom A  # Any?
+      jnz equalAE_F  # No: Compare with E's CDR
+      atom E
+      jnz ret  # No: 'ne'
+   loop
+   push A  # Save list heads
+   push E
+   do
+      push (A CDR)  # Save CDRs
+      push (E CDR)
+      ld A (A)  # Recurse on CARs
+      ld E (E)
+      call equalAE_F  # Equal?
+      pop E  # Retrieve CDRs
+      pop A
+      break ne  # No: 'ne'
+      atom A  # A's CDR atomic?
+      if nz  # Yes
+         call equalAE_F  # Compare with E's CDR
+         break T
+      end
+      atom E  # E's CDR atomic?
+      break nz  # Yes: 'ne'
+      cmp A (S I)  # A circular?
+      break eq  # Yes: 'eq'
+      cmp E (S)  # E circular?
+      break eq  # Yes: 'eq'
+   loop
+   pop A  # Drop list heads
+   pop A
+   ret
+
+(code 'compareAE_F 0)  # C
+   cmp A E  # Pointer-equal?
+   jz ret  # Yes
+   cmp A Nil
+   if eq  # [NIL E]
+10    or B B  # nz
+20    setc  # lt
+      ret
+   end
+   cmp A TSym
+   if eq  # [T E]
+30    or B B  # nz
+40    clrc  # gt
+      ret
+   end
+   num A  # Number?
+   if nz  # Yes
+      num E  # Both?
+      jnz cmpNumAE_F  # [<num> <num>]
+      cmp E Nil
+      jz 30  # [<num> NIL]
+      setc  # lt
+      ret
+   end
+   sym A
+   if nz  # [<sym> ..]
+      num E
+      jnz 40  # [<sym> <num>]
+      cmp E Nil
+      jz 30  # [<sym> NIL]
+      atom E
+      jz 10  # [<sym> <cell>]
+      cmp E TSym
+      jz 10  # [<sym> T]
+      push X  # [<sym> <sym>]
+      ld X (A TAIL)
+      call nameX_X  # Get A's name in X
+      zero X  # Any?
+      if eq  # No
+         ld E (E TAIL)
+         call nameE_E  # Second name in E
+         zero E  # Any?
+         if eq  # No
+            rol B 4  # Random bit from A (...x1000) into carry (non-zero)
+         else
+            setc  # lt
+         end
+         pop X
+         ret
+      end
+      ld E (E TAIL)
+      call nameE_E  # Get E's name in E
+      zero E  # Any?
+      if eq  # No
+50       or B B  # nz
+60       clrc  # gt
+70       pop X
+         ret
+      end
+      do
+         cnt X  # Get next digit from X into A
+         if nz
+            ld A X  # Short
+            shr A 4  # Normalize
+            ld X 0
+         else
+            ld A (X DIG)  # Get next digit
+            ld X (X BIG)
+         end
+         cnt E  # Get next digit from E into C
+         if nz
+            ld C E  # Short
+            shr C 4  # Normalize
+            ld E 0
+         else
+            ld C (E DIG)  # Get next digit
+            ld E (E BIG)
+         end
+         do
+            cmp B C  # Bytes equal?
+            jnz 70  # No: lt or gt
+            shr A 8  # Next byte in A?
+            if z  # No
+               shr C 8  # Next byte in C?
+               if nz  # Yes
+                  setc  # lt
+                  pop X
+                  ret
+               end
+               null X  # X done?
+               if z  # Yes
+                  null E  # E also done?
+                  jz 70  # Yes: eq
+                  setc  # lt
+                  pop X
+                  ret
+               end
+               null E  # E done?
+               jz 50  # Yes: gt
+               break T
+            end
+            shr C 8  # Next byte in C?
+            jz 50  # No: gt
+         loop
+      loop
+   end
+   atom E
+   if nz  # [<cell> <sym>]
+      cmp E TSym
+      if eq  # [<cell> T]
+         or B B  # nz
+         setc  # lt
+         ret
+      end
+      clrc  # gt
+      ret
+   end
+   push X  # [<cell> <cell>]
+   push Y
+   ld X A  # Keep originals
+   ld Y E
+   do
+      push A  # Recurse on CAR
+      push E
+      ld A (A)
+      ld E (E)
+      call compareAE_F  # Same?
+      pop E
+      pop A
+   while eq  # Yes
+      ld A (A CDR)  # Next elements
+      ld E (E CDR)
+      atom A  # End of A?
+      if nz  # Yes
+         call compareAE_F  # Compare CDRs
+         break T
+      end
+      atom E  # End of E?
+      if nz  # Yes
+         cmp E TSym
+         if ne
+            clrc  # gt [<cell> <atom>]
+            break T
+         end
+         or B B  # nz [<cell> T]
+         setc  # lt
+         break T
+      end
+      cmp A X  # Circular list?
+      if eq
+         cmp E Y
+         break eq  # Yes
+      end
+   loop
+   pop Y
+   pop X
+   ret  # F
+
+(code 'memberXY_FY 0)
+   ld C Y  # Keep head in C
+   do
+      atom Y  # List?
+   while z  # Yes
+      ld A X
+      ld E (Y)
+      call equalAE_F  # Member?
+      jeq ret  # Return list
+      ld Y (Y CDR)  # Next item
+      cmp C Y  # Hit head?
+      jeq retnz  # Yes
+   loop
+   ld A X
+   ld E Y
+   jmp equalAE_F  # Same atoms?
+
+# (quit ['any ['any]])
+(code 'doQuit 2)
+   ld X (E CDR)  # Args
+   call evSymX_E  # Evaluate to a symbol
+   call bufStringE_SZ  # Write to stack buffer
+   ld X (X CDR)  # Next arg?
+   atom X
+   ldnz E 0  # No
+   if z  # Yes
+      ld E (X)
+      eval  # Eval
+   end
+   ld X 0  # No context
+   ld Y QuitMsg  # Format string
+   ld Z S  # Buffer pointer
+   jmp errEXYZ  # Jump to error handler
+: QuitMsg asciz "%s"
+
+### Evaluation ###
+# Apply EXPR in C to CDR of E
+(code 'evExprCE_E 0)
+   push X
+   push Y
+   push Z
+   ld X (E CDR)  # Get CDR
+   ld Y (C)  # Parameter list in Y
+   ld Z (C CDR)  # Body in Z
+   push (EnvBind)  # Build bind frame
+   link
+   push (At)  # Bind At
+   push At
+   do
+      atom Y  # More evaluating parameters?
+   while z  # Yes
+      ld E (X)  # Get next argument
+      ld X (X CDR)
+      eval+  # Evaluate and save
+      push E
+      push (Y)  # Save symbol
+      ld Y (Y CDR)
+   loop
+   cmp Y Nil  # NIL-terminated parameter list?
+   if eq  # Yes: Bind parameter symbols
+      ld Y S  # Y on bindings
+      do
+         ld X (Y)  # Symbol in X
+         add Y I
+         ld A (X)  # Old value in A
+         ld (X) (Y)  # Set new value
+         ld (Y) A  # Save old value
+         add Y I
+         cmp Y L  # End?
+      until eq  # Yes
+      link
+      ld (EnvBind) L  # Close bind frame
+      push 0  # Init env swap
+      prog Z  # Run body
+      pop A  # Drop env swap
+      pop L  # Get link
+      do  # Unbind symbols
+         pop X  # Next symbol
+         pop (X)  # Restore value
+         cmp S L  # More?
+      until eq  # No
+      pop L  # Restore link
+      pop (EnvBind)  # Restore bind link
+      pop Z
+      pop Y
+      pop X
+      ret
+   end
+   # Non-NIL parameter
+   cmp Y At  # '@'?
+   if ne  # No
+      push (Y)  # Save last parameter's old value
+      push Y  # and the last parameter
+      ld (Y) X  # Set to unevaluated argument list
+      lea Y (S II)  # Y on evaluated bindings
+      do
+         ld X (Y)  # Symbol in X
+         add Y I
+         ld A (X)  # Old value in A
+         ld (X) (Y)  # Set new value
+         ld (Y) A  # Save old value
+         add Y I
+         cmp Y L  # End?
+      until eq  # Yes
+      link
+      ld (EnvBind) L  # Close bind frame
+      push 0  # Init env swap
+      prog Z  # Run body
+      pop A  # Drop env swap
+      pop L  # Get link
+      do  # Unbind symbols
+         pop X  # Next symbol
+         pop (X)  # Restore value
+         cmp S L  # More?
+      until eq  # No
+      pop L  # Restore link
+      pop (EnvBind)  # Restore bind link
+      pop Z
+      pop Y
+      pop X
+      ret
+   end
+   # Evaluated argument list
+   link  # Close bind frame
+   ld Y L  # Y on frame
+   push 0  # Init env swap
+   push (EnvNext)   # Save current 'next'
+   push (EnvArgs)  # and varArgs base
+   atom X  # Any args?
+   if nz  # No
+      ld (EnvArgs) 0
+      ld (EnvNext) 0
+   else
+      link  # Build varArgs frame
+      do
+         ld E (X)  # Get next argument
+         eval+  # Evaluate and save
+         push E
+         ld X (X CDR)
+         atom X  # More args?
+      until nz  # No
+      ld (EnvArgs) S  # Set new varArgs base
+      ld (EnvNext) L  # Set new 'next'
+      link  # Close varArgs frame
+   end
+   ld (EnvBind) Y  # Close bind frame
+   ld C (Y)  # End of bindings in C
+   add Y I
+   do
+      ld X (Y)  # Symbol in X
+      add Y I
+      ld A (X)  # Old value in A
+      ld (X) (Y)  # Set new value
+      ld (Y) A  # Save old value
+      add Y I
+      cmp Y C  # End?
+   until eq  # Yes
+   prog Z  # Run body
+   null (EnvNext)  # VarArgs?
+   if nz  # Yes
+      drop  # Drop varArgs
+   end
+   pop (EnvArgs)  # Restore varArgs base
+   pop (EnvNext)   # and 'next'
+   pop A  # Drop env swap
+   pop L  # Get link
+   do  # Unbind symbols
+      pop X  # Next symbol
+      pop (X)  # Restore value
+      cmp S L  # More?
+   until eq  # No
+   pop L  # Restore link
+   pop (EnvBind)  # Restore bind link
+   pop Z
+   pop Y
+   pop X
+   ret
+
+# Evaluate a list
+(code 'evListE_E 0)
+   ld C (E)  # Get CAR in C
+   num C  # Number?
+   jnz ret  # Yes: Return list
+   sym C  # Symbol?
+   if nz  # Yes
+10    do  # C is a symbol
+         nul (Signal)  # Signal?
+         if nz  # Yes
+            push E
+            call sighandlerE
+            pop E
+         end
+         ld A (C)  # Get VAL
+         cnt A  # Short number?
+         jnz (A)  # Yes: Eval SUBR
+         big A  # Undefined if bignum
+         jnz undefinedCE
+         cmp A (A)  # Auto-symbol?
+         if ne  # No
+            ld C A
+            atom C  # Symbol?
+            jz evExprCE_E  # No: Apply EXPR
+         else
+            call sharedLibC_FA  # Try dynamic load
+            jnz (A)  # Eval SUBR
+            jmp undefinedCE
+         end
+      loop
+   end
+   push E
+   ld E C
+   call evListE_E
+   ld C E
+   pop E
+   cnt C  # Short number?
+   jnz (C)  # Yes: Eval SUBR
+   big C  # Undefined if bignum
+   jnz undefinedCE
+   link
+   push C  # Save function
+   link
+   atom C  # Symbol?
+   if z
+      call evExprCE_E  # No: Apply EXPR
+   else
+      call 10
+   end
+   drop
+   ret
+
+(code 'sharedLibC_FA)
+   push C
+   push E
+   push Y
+   push Z
+   ld E C  # Get symbol in E
+   call bufStringE_SZ  # Write to stack buffer
+   ld C 0
+   ld Y S  # Search for colon and slash
+   do
+      ld B (Y)  # Next byte
+      or B B  # End of string?
+      jz 90  # Yes
+      cmp B (char ":")  # Colon?
+   while ne  # No
+      cmp B (char "/")  # Slash?
+      if eq  # Yes
+         ld C Y  # Keep pointer to slash
+      end
+      add Y 1  # Increment buffer pointer
+   loop
+   cmp Y Z  # At start of buffer?
+   jz 90  # Yes
+   nul (Y 1)  # At end of buffer?
+   jz 90  # Yes
+   set (Y) 0  # Replace colon with null byte
+   add Y 1  # Point to token
+   null C  # Contained '/'?
+   ld C S  # Pointer to lib name
+   if z  # No
+      sub S 8  # Extend buffer
+      sub C 4  # Prepend "lib/"
+      set (C 3) (char "/")
+      set (C 2) (char "b")
+      set (C 1) (char "i")
+      set (C) (char "l")
+      ld A (Home)  # Home directory?
+      null A
+      if nz  # Yes
+         do
+            add A 1  # Find end
+            nul (A)
+         until z
+         sub A (Home)  # Calculate length
+         sub C A  # Adjust buffer
+         ld S C
+         off S 7
+         movn (C) ((Home)) A  # Insert home path
+      end
+   end
+   cc dlopen(C (| RTLD_LAZY RTLD_GLOBAL))  # Open dynamic library
+   null A  # OK?
+   if nz  # Yes
+      cc dlsym(A Y)  # Find dynamic symbol
+      null A  # OK?
+      if nz  # Yes
+         ld (E) A  # 'nz' - Set function definition
+      end
+   end
+90 ld S Z  # Drop buffer
+   pop Z
+   pop Y
+   pop E
+   pop C
+   ret
+
+# (errno) -> cnt
+(code 'doErrno 2)
+   call errno_A  # Get 'errno'
+   ld E A
+   shl E 4  # Make short number
+   or E CNT
+   ret
+
+# (native 'cnt1|sym1 'cnt2|sym2 'sym|lst 'any ..) -> any
+(code 'doNative 2)
+   push X
+   push Y
+   push Z
+   ld X E
+   ld Y (E CDR)  # Y on args
+   ld E (Y)  # Eval library 'cnt1|sym1'
+   eval
+   cnt E  # Library handle?
+   if nz  # Yes
+      shr E 4  # Normalize
+      push E  # <S> Library handle
+   else
+      big E  # Library handle?
+      if nz  # Yes
+         push (E DIG)  # <S> Library handle
+      else
+         call needSymEX  # Check symbol
+         call bufStringE_SZ  # Write to stack buffer
+         ld C S  # Preload name pointer
+         ld B (S)  # Check for main program library
+         cmp B (char "@")  # "@"?
+         if eq
+            nul (S 1)
+            ldz C 0  # Yes: Use NULL pointer
+         end
+         cc dlopen(C (| RTLD_LAZY RTLD_GLOBAL))  # Open dynamic library
+         null A  # OK?
+         jz dlErrX  # No
+         ld S Z  # Drop buffer
+         push A  # <S> Library handle
+         test A (hex "F000000000000000")  # Fit in short number?
+         if z  # Yes
+            shl A 4  # Make short number
+            or A CNT
+         else
+            call boxNumA_A  # Make bignum
+         end
+         ld (E) A  # Set value of 'sym1'
+      end
+   end
+   ld Y (Y CDR)  # Second arg
+   ld E (Y)  # Eval function 'cnt2|sym2'
+   eval
+   ld Z S  # Stack marker in Z
+   cnt E  # Function pointer?
+   if nz  # Yes
+      shr E 4  # Normalize
+      ld (S) E  # <Z> Function pointer
+   else
+      big E  # Function pointer??
+      if nz  # Yes
+         ld (S) (E DIG)  # <Z> Function pointer
+      else
+         call needSymEX  # Check symbol
+         call bufStringE_SZ  # Write to stack buffer
+         cc dlsym((Z) S)  # Find dynamic symbol
+         null A  # OK?
+         jz dlErrX  # No
+         ld S Z  # Drop buffer
+         ld (S) A  # <Z> Function pointer
+         test A (hex "F000000000000000")  # Fit in short number?
+         if z  # Yes
+            shl A 4  # Make short number
+            or A CNT
+         else
+            call boxNumA_A  # Make bignum
+         end
+         ld (E) A  # Set value
+      end
+   end
+   ld Y (Y CDR)  # Third arg
+   ld E (Y)  # Eval result specification
+   eval
+   link
+   push E  # <Z -II> Result specification
+   do
+      ld Y (Y CDR)  # Arguments?
+      atom Y
+   while z  # Yes
+      ld E (Y)  # Eval argument specification
+      eval+
+      push E
+   loop
+   ld X S  # X on last argument
+   link
+   lea Y (Z -II)  # Limit
+   do
+      cmp X Y  # More args?
+   while ne  # Yes
+      ld E (X)  # Argument specification
+      num E  # Number?
+      if nz  # Yes
+         cnt E  # Short?
+         if nz  # Yes
+            shr E 4  # Normalize
+            if c  # Sign?
+               neg E  # Yes
+            end
+         else
+            test E SIGN  # Get sign
+            push F  # Save
+            off E (| SIGN BIG)  # Get cell pointer
+            ld A (E CDR)  # High word
+            ld E (E)  # Low word
+            shr A 5  # Get highest four bits
+            rcr E 1
+            shr A 1
+            rcr E 1
+            shr A 1
+            rcr E 1
+            shr A 1
+            rcr E 1
+            pop F  # Negative
+            if nz  # Yes
+               neg E  # Negate
+            end
+         end
+      else
+         push Z
+         sym E  # String?
+         if nz  # Yes
+            call bufStringE_SZ  # Write to stack buffer
+            cc strdup(S)  # Make new string
+            ld E A  # Get string pointer
+            ld S Z  # Drop buffer
+         else
+            ld E (E CDR)  # Ignore variable
+            ld C ((E))  # Get buffer size
+            shr C 4  # Normalize
+            cc malloc(C)  # Allocate buffer
+            push A  # Save it
+            ld Z A  # Buffer pointer in Z
+            do
+               ld E (E CDR)
+               cnt E  # Fill rest?
+               if nz  # Yes
+                  ld A E  # Byte value
+                  shr A 4  # in B
+                  do
+                     sub C 1  # Done?
+                  while ns  # No
+                     ld (Z) B  # Store byte in buffer
+                     add Z 1  # Increment buffer pointer
+                  loop
+                  break T
+               end
+               atom E  # Fill bytes?
+            while z  # Yes
+               ld A (E)  # Next byte value
+               shr A 4  # in B
+               ld (Z) B  # Store in buffer
+               add Z 1  # Increment buffer pointer
+               sub C 1  # Buffer full?
+            until z  # Yes
+            pop E  # Get allocated memory
+         end
+         pop Z
+      end
+      push E  # Push argument
+      add X I  # Next arg
+   loop
+   ld X S  # Start of args
+   ld C L  # Top of args
+   sub C X  # Bytes
+   sub S C  # Duplicate
+   movn (S) (X) C
+   ld Y (Z)  # Get function pointer
+   cc (Y) X  # Call C-function
+   ld E (Z -II)  # Get result specification
+   ld C 0  # No pointer yet
+   call natRetACE_CE  # Extract return value
+   ld (Z -II) E  # Save result
+   lea Y (Z -III)  # Clean up allocated C args
+   do
+      cmp Y L  # Args?
+   while ne  # Yes
+      pop X  # Next C arg
+      ld E (Y)  # Next Lisp arg
+      num E  # Number?
+      if z  # No
+         sym E  # String?
+         if z  # No
+            cmp (E) Nil  # Variable?
+            if ne  # Yes
+               ld C X  # Structure pointer
+               ld E (((E CDR)) CDR)  # Result specification
+               call natRetACE_CE  # Extract value
+               ld (((Y))) E  # Store in variable
+            end
+         end
+         cc free(X)  # Free string or buffer
+      end
+      sub Y I
+   loop
+   ld E (Z -II)  # Get result
+   drop
+   pop A  # Drop library handle
+   pop Z
+   pop Y
+   pop X
+   ret
+
+(code 'natRetACE_CE 0)
+   cmp E Nil  # NIL?
+   if ne
+      cmp E ISym  # 'I'?
+      if eq  # Yes
+         null C  # Pointer?
+         if nz  # Yes
+            ld4 (C)
+            add C 4  # Size of int
+         end
+         int  # Integer
+         ld E A
+         null E  # Negative?
+         if ns  # No
+            shl E 4  # Make short number
+            or E CNT
+         else
+            neg E  # Negate
+            shl E 4  # Make negative short number
+            or E (| SIGN CNT)
+         end
+      else
+         cmp E NSym  # 'N'?
+         if eq  # Yes
+            null C  # Pointer?
+            if nz  # Yes
+               ld A (C)
+               add C 8  # Size of long/pointer
+            end
+            ld E A  # Number
+            null E  # Negative?
+            if ns  # No
+               test E (hex "F000000000000000")  # Fit in short?
+               if z  # Yes
+                  shl E 4  # Make short number
+                  or E CNT
+               else
+                  call boxNumE_E  # Make bignum
+               end
+            else
+               neg E  # Negate
+               test E (hex "F000000000000000")  # Fit in short?
+               if z  # Yes
+                  shl E 4  # Make negative short number
+                  or E (| SIGN CNT)
+               else
+                  call boxNumE_E  # Make bignum
+                  or E SIGN  # Set negative
+               end
+            end
+         else
+            cmp E SSym  # 'S'?
+            if eq  # Yes
+               null C  # Pointer?
+               if nz  # Yes
+                  ld A (C)
+                  add C 8  # Size of pointer
+               end
+               ld E A  # Make transient symbol
+               call mkStrE_E
+            else
+               cmp E CSym  # 'C'?
+               if eq  # Yes
+                  null C  # Pointer?
+                  if nz  # Yes
+                     call fetchCharC_AC  # Fetch char
+                  end
+                  ld E Nil  # Preload
+                  null A  # Char?
+                  if nz  # Yes
+                     call mkCharA_A  # Make char
+                     ld E A
+                  end
+               else
+                  cmp E BSym  # 'B'?
+                  if eq  # Yes
+                     null C  # Pointer?
+                     if nz  # Yes
+                        ld B (C)
+                        add C 1  # Size of byte
+                     end
+                     zxt  # Byte
+                     ld E A
+                     shl E 4  # Make short number
+                     or E CNT
+                  else
+                     atom E  # Atomic?
+                     if z  # No: Arrary or structure
+                        null C  # Pointer?
+                        ldz C A  # Yes: Load into C
+                        push X
+                        push Y
+                        push Z
+                        ld X E  # Get specification in X
+                        ld E (X)
+                        call natRetACE_CE  # First item
+                        call cons_Y  # Make cell
+                        ld (Y) E
+                        ld (Y CDR) Nil
+                        link
+                        push Y  # <L I> Result
+                        link
+                        do
+                           ld Z (X CDR)
+                           cnt Z  # (sym . cnt)
+                           if nz
+                              shr Z 4  # Normalize
+                              do
+                                 sub Z 1  # Decrement count
+                              while nz
+                                 ld E (X)  # Repeat last type
+                                 call natRetACE_CE  # Next item
+                                 call cons_A  # Cons into cell
+                                 ld (A) E
+                                 ld (A CDR) Nil
+                                 ld (Y CDR) A  # Append to result
+                                 ld Y A
+                              loop
+                              break T
+                           end
+                           atom Z  # End of specification?
+                        while z  # No
+                           ld X Z
+                           ld E (X)  # Next type
+                           call natRetACE_CE  # Next item
+                           call cons_A  # Cons into cell
+                           ld (A) E
+                           ld (A CDR) Nil
+                           ld (Y CDR) A  # Append to result
+                           ld Y A
+                        loop
+                        ld E (L I)  # Get result
+                        drop
+                        pop Z
+                        pop Y
+                        pop X
+                     end
+                  end
+               end
+            end
+         end
+      end
+   end
+   ret
+
+(code 'fetchCharC_AC 0)
+   ld B (C)  # Fetch first byte
+   zxt
+   or B B  # Any?
+   if nz  # Yes
+      add C 1
+      cmp B 128  # Single byte?
+      if ge  # No
+         test B (hex "20")  # Two bytes?
+         if z  # Yes
+            and B (hex "1F")  # First byte 110xxxxx
+            shl A 6  # xxxxx000000
+            push A
+         else  # Three bytes
+            and B (hex "F")  # First byte 1110xxxx
+            shl A 6  # xxxx000000
+            push A
+            ld B (C)  # Fetch second byte
+            zxt
+            add C 1
+            and B (hex "3F")  # 10xxxxxx
+            or A (S)  # Combine
+            shl A 6  # xxxxxxxxxx000000
+            ld (S) A
+         end
+         ld B (C)  # Fetch last byte
+         zxt
+         add C 1
+         and B (hex "3F")  # 10xxxxxx
+         or (S) A  # Combine
+         pop A  # Get result
+      end
+   end
+   ret
+
+(code 'lisp 0)
+   begin 6  # Function name in A, arguments in C, E, X, Y and Z
+   link  # Apply args
+   push ZERO  # Space for 'fun'
+   xchg C E  # First arg
+   call boxCntE_E  # Make number
+   push E
+   ld E C  # Second arg
+   call boxCntE_E  # Make number
+   push E
+   ld E X  # Third arg
+   call boxCntE_E  # Make number
+   push E
+   ld E Y  # Fourth arg
+   call boxCntE_E  # Make number
+   push E
+   ld E Z  # Fifth arg
+   call boxCntE_E  # Make number
+   push E
+   ld Z S  # Z on last argument
+   link  # Close frame
+   ld C 4  # Build name
+   ld E A  # Function name argument
+   lea X (S VI)  # Pointer to 'fun' entry
+   do
+      ld B (E)
+      call byteSymBCX_CX  # Pack byte
+      add E 1  # Next byte
+      nul (E)  # Any?
+   until z
+   ld X (S VI)  # Get name
+   call findSymX_E  # Find or create symbol
+   lea Y (S VI)  # Pointer to 'fun' in Y
+   ld (Y) E  #  Store 'fun'
+   call applyXYZ_E  # Apply
+   ld A E  # Return value
+   shr A 4  # Normalize
+   if c  # Sign?
+      neg A  # Yes
+   end
+   drop
+   return 6
+
+(code 'execE 0)
+   push X
+   ld X E
+   link
+   push (At)  # <L I> Preserve '@'
+   link
+   exec X  # Execute body
+   ld (At) (L I)
+   drop
+   pop X
+   ret
+
+(code 'runE_E 0)
+   push X
+   ld X E
+   link
+   push (At)  # <L I> Preserve '@'
+   link
+   prog X  # Run body
+   ld (At) (L I)
+   drop
+   pop X
+   ret
+
+(code 'funqE_FE 0)
+   cnt E  # Short number?
+   jnz retz  # Yes
+   big E  # Big number?
+   jnz ret  # No
+   sym E  # Symbol?
+   jnz ret  # Yes
+   ld C (E CDR)  # Check function body
+   do
+      atom C  # More?
+   while z  # Yes
+      cmp C E  # Circular?
+      jeq retnz  # Yes
+      ld A (C)  # Next item
+      atom A  # Cell?
+      if z  # Yes
+         num (A)  # CAR a number?
+         if nz  # Yes
+            atom (C CDR)  # Must be the last
+            jz retnz
+         else
+            cmp (A) Nil  # CAR is NIL?
+            jeq retnz  # Yes
+            cmp (A) TSym  # CAR is T?
+            jeq retnz  # Yes
+         end
+      else
+         cmp (C CDR) Nil  # Atomic item must be the last
+         jne ret
+      end
+      ld C (C CDR)
+   loop
+   cmp C Nil  # Must be NIL-terminated
+   jne ret
+   ld E (E)  # Get parameter(s)
+   cmp E Nil  # Any?
+   ldz E TSym  # No: Return T
+   if ne  # Yes
+      ld C E
+      do
+         atom C  # Atomic parameter?
+      while z  # No
+         ld A (C)  # Next parameter
+         num A  # Number?
+         jnz ret  # Yes
+         atom A  # List?
+         jz retnz  # Yes
+         cmp A Nil  # NIL?
+         jeq retnz  # Yes
+         cmp A TSym  # T?
+         jeq retnz  # Yes
+         ld C (C CDR)  # Rest
+         cmp C E  # Circular?
+         jeq retnz  # Yes
+      loop
+      cmp C TSym  # T?
+      jeq retnz  # Yes
+      num C  # Number?
+      jnz ret  # Yes
+   end
+   ret
+
+(code 'evSymX_E 0)
+   ld E (X)  # Get CAR
+   jmp evSymE_E
+(code 'evSymY_E 0)
+   ld E (Y)  # Get CAR
+(code 'evSymE_E)
+   eval  # Evaluate
+(code 'xSymE_E)
+   num E  # Number?
+   if z  # No
+      sym E  # Symbol?
+      jnz ret  # Yes
+   end
+   push X
+   link
+   push E  # Save 'any'
+   push ZERO  # <L II> Number safe
+   push ZERO  # <L I> Result
+   ld C 4  # Build name
+   ld X S
+   link
+   call packECX_CX
+   ld X (L I)  # Get result
+   call consSymX_E  # Make transient symbol
+   drop
+   pop X
+   ret
+
+(code 'evCntXY_FE 0)
+   ld E (Y)  # Get CAR
+(code 'evCntEX_FE)
+   eval  # Evaluate
+(code 'xCntEX_FE 0)
+   cnt E  #  # Short number?
+   jz cntErrEX  # No
+   shr E 4  # Normalize
+   if c  # Sign?
+      neg E  # Yes
+   end
+   ret  # 'z' if null, 's' if negative
+
+(code 'xCntCX_FC 0)
+   cnt C  #  # Short number?
+   jz cntErrCX  # No
+   shr C 4  # Normalize
+   if c  # Sign?
+      neg C  # Yes
+   end
+   ret  # 'z' if null, 's' if negative
+
+(code 'xCntAX_FA 0)
+   cnt A  #  # Short number?
+   jz cntErrAX  # No
+   shr A 4  # Normalize
+   if c  # Sign?
+      neg A  # Yes
+   end
+   ret  # 'z' if null, 's' if negative
+
+(code 'boxCntE_E 0)
+   null E  # Positive?
+   if ns  # Yes
+      shl E 4  # Make short number
+      or E CNT
+      ret
+   end
+   neg E  # Else negate
+   shl E 4  # Make short number
+   or E 10  # with SIGN
+   ret
+
+(code 'putStringB 0)
+   push X
+   push C
+   ld X (StrX)  # Get string status
+   ld C (StrC)
+   call byteSymBCX_CX  # Add byte to result
+   ld (StrC) C  # Save string status
+   ld (StrX) X
+   pop C
+   pop X
+   ret
+
+(code 'begString 0)
+   pop A  # Get return address
+   link
+   push ZERO  # <L I> Result
+   ld (StrC) 4  # Build name
+   ld (StrX) S
+   link
+   push (EnvPutB)  # Save 'put'
+   ld (EnvPutB) putStringB  # Set new
+   jmp (A)  # Return
+
+(code 'endString_E 0)
+   pop A  # Get return address
+   pop (EnvPutB)  # Restore 'put'
+   ld E Nil  # Preload NIL
+   cmp (L I) ZERO  # Name?
+   if ne  # Yes
+      call cons_E  # Cons symbol
+      ld (E) (L I)  # Set name
+      or E SYM  # Make symbol
+      ld (E) E  # Set value to itself
+   end
+   drop
+   jmp (A)  # Return
+
+(code 'msec_A)
+   push C
+   cc gettimeofday(Buf 0)  # Get time
+   ld A (Buf)  # tv_sec
+   mul 1000  # Convert to milliseconds
+   ld (Buf) A  # Save
+   ld A (Buf I)  # tv_usec
+   div 1000  # Convert to milliseconds (C is zero)
+   add A (Buf)
+   pop C
+   ret
+
+# (args) -> flg
+(code 'doArgs 2)
+   cmp (EnvNext) (EnvArgs)  # VarArgs?
+   ld E Nil
+   ldnz E TSym  # Yes
+   ret
+
+# (next) -> any
+(code 'doNext 2)
+   ld C (EnvNext)  # VarArgs
+   cmp C (EnvArgs)  # Any?
+   if ne  # Yes
+      sub C I  # Get next
+      ld E (C)
+      ld (EnvNext) C
+      ret
+   end
+   ld E Nil  # No (more) arguments
+   null C  # Any previous arg?
+   if nz  # Yes
+      ld (C) E  # Set to NIL
+   end
+   ret
+
+# (arg ['cnt]) -> any
+(code 'doArg 2)
+   null (EnvArgs)  # Any args?
+   jz retNil  # No
+   ld E (E CDR)  # 'cnt' arg?
+   atom E
+   if nz  # No
+      ld E ((EnvNext))  # Return arg from last call to 'next'
+      ret
+   end
+   ld E (E)
+   eval  # Eval 'cnt'
+   test E SIGN  # Negative?
+   if z  # No
+      shr E 1  # Normalize to word index
+      off E 1  # Clear 'cnt' tag
+      if nz  # Greater zero
+         ld C (EnvNext)  # VarArgs
+         sub C E  # Subtract from VarArgs pointer
+         cmp C (EnvArgs)  # Out of range?
+         if ge  # No
+            ld E (C)  # Get value
+            ret
+         end
+      end
+   end
+   ld E Nil
+   ret
+
+# (rest) -> lst
+(code 'doRest 2)
+   ld E Nil  # Return value
+   ld C (EnvArgs)  # VarArgs
+   do
+      cmp C (EnvNext)  # Any?
+   while ne  # Yes
+      call consE_A  # New cell
+      ld (A) (C)
+      ld (A CDR) E
+      ld E A
+      add C I  # Next
+   loop
+   ret
+
+(code 'tmDateC_E 0)
+   ld4 (C TM_MDAY)  # Get day
+   ld X A
+   ld4 (C TM_MON)  # month
+   add A 1
+   ld Y A
+   ld4 (C TM_YEAR)  # and year
+   add A 1900
+   ld Z A
+# Date function
+(code 'dateXYZ_E 0)
+   cmp Y 0  # Month <= 0?
+   jle retNil
+   cmp Y 12  # Month > 12?
+   jgt retNil
+   cmp X 0  # Day <= 0?
+   jle retNil
+   ld B (Y Month)  # Max monthly days
+   cmp X B  # Day > max?
+   if gt  # Yes
+      cmp Y 2  # February?
+      jne retNil
+      cmp X 29  # 29th?
+      jne retNil
+      test Z 3  # year a multiple of 4?
+      jnz retNil
+      ld A Z  # Year
+      ld C 0
+      div 100
+      null C  # Multiple of 100?
+      if z  # Yes
+         ld A Z  # Year
+         div 400
+         null C  # Multiple of 400?
+         jnz retNil
+      end
+   end
+   ld A Z  # Get year
+   mul 12  # times 12
+   add A Y  # plus month
+   sub A 3  # minus 3
+   ld C 0
+   div 12  # divide by 12
+   ld E A  # n =  (12 * year + month - 3) / 12
+   ld C 0
+   div 100  # divide by 100
+   ld C E
+   shr E 2  # n/4
+   add C C  # n*2
+   sub E C  # n/4 - n*2
+   sub E A  # n/4 - n*2 - n/100
+   shr A 2  # n/400
+   add E A  # E = n/4 - n*2 - n/100 + n/400
+   ld A Z  # Year
+   mul 4404  # times 4404
+   ld Z A
+   ld A Y  # Month
+   mul 367  # times 367
+   add A Z  # plus year*4404
+   sub A 1094  # minus 1094
+   div 12  # A = (4404*year + 367*month - 1094) / 12
+   add E A  # Add up
+   add E X  # plus days
+   shl E 4  # Make short number
+   or E CNT
+   ret
+: Month bytes (31 31 28 31 30 31 30 31 31 30 31 30 31)
+
+# (date ['T]) -> dat
+# (date 'dat) -> (y m d)
+# (date 'y 'm 'd) -> dat | NIL
+# (date '(y m d)) -> dat | NIL
+(code 'doDate 2)
+   push X
+   push Y
+   push Z
+   ld X E
+   ld Y (E CDR)  # Y on args
+   atom Y  # Any?
+   if nz  # No
+      cc time(Buf)  # Get current time
+      cc localtime(Buf)  # Convert to local time
+      ld (Time) A  # Keep in 'Time'
+      ld C A
+      call tmDateC_E  # Extract date
+   else
+      ld E (Y)  # Eval first
+      eval
+      cmp E TSym  # T?
+      if eq  # Yes
+         cc time(Buf)  # Get current time
+         cc gmtime(Buf)  # Convert to Greenwich Mean Time
+         ld (Time) A  # Keep in 'Time'
+         ld C A
+         call tmDateC_E  # Extract date
+      else
+         cmp E Nil  # NIL?
+         if ne  # No
+            atom E  # List?
+            if z  # Yes
+               ld C (E)  # Extract year
+               call xCntCX_FC
+               ld Z C
+               ld E (E CDR)
+               ld C (E)  # month
+               call xCntCX_FC
+               ld Y C
+               ld C ((E CDR))  # and day
+               call xCntCX_FC
+               ld X C
+               call dateXYZ_E
+            else
+               ld Y (Y CDR)  # More args?
+               atom Y
+               if nz  # No
+                  call xCntEX_FE  # Get date
+                  ld A E  # 100 * n
+                  mul 100
+                  sub A 20  # minus 20
+                  ld C 0  # divide by 3652425
+                  div 3652425
+                  ld Z A  # year = (100*n - 20) / 3652425
+                  add E A  # n += (year - year/4)
+                  shr A 2
+                  sub E A
+                  ld A E  # n
+                  mul 100  # 100 * n
+                  sub A 20  # minus 20
+                  div 36525  # divide by 36525
+                  ld Z A  # year = (100*n - 20) / 36525
+                  mul 36525  # times 36525
+                  div 100  # divide by 100
+                  sub E A  # n -= 36525*y / 100
+                  ld A E  # n
+                  mul 10  # times 10
+                  sub A 5  # minus 5
+                  div 306  # divide by 306
+                  ld Y A  # month = (10*n - 5) / 306
+                  mul 306  # times 306
+                  ld X A
+                  ld A E  # n
+                  mul 10  # times 10
+                  sub A X  # minus 306*month
+                  add A 5  # push 5
+                  div 10  # divide by 10
+                  ld X A  # day = (10*n - 306*month + 5) / 10
+                  cmp Y 10  # month < 10?
+                  if lt  # Yes
+                     add Y 3  # month += 3
+                  else
+                     add Z 1  # Increment year
+                     sub Y 9  # month -= 9
+                  end
+                  shl X 4  # Make short day
+                  or X CNT
+                  call cons_E  # into cell
+                  ld (E) X
+                  ld (E CDR) Nil
+                  shl Y 4  # Make short month
+                  or Y CNT
+                  call consE_C  # Cons
+                  ld (C) Y
+                  ld (C CDR) E
+                  shl Z 4  # Make short year
+                  or Z CNT
+                  call consC_E  # Cons
+                  ld (E) Z
+                  ld (E CDR) C
+               else
+                  call xCntEX_FE  # Extract year
+                  ld Z E  # into Z
+                  call evCntXY_FE  # Eval month
+                  push E  # Save
+                  ld Y (Y CDR)  # Eval day
+                  call evCntXY_FE
+                  ld X E  # Get day
+                  pop Y  # and month
+                  call dateXYZ_E
+               end
+            end
+         end
+      end
+   end
+   pop Z
+   pop Y
+   pop X
+   ret
+
+(code 'tmTimeY_E 0)
+   ld4 (Y TM_HOUR)  # Get hour
+   mul 3600
+   ld E A
+   ld4 (Y TM_MIN)  # Get minute
+   mul 60
+   add E A
+   ld4 (Y TM_SEC)  # Get second
+   add E A
+   shl E 4  # Make short number
+   or E CNT
+   ret
+
+# (time ['T]) -> tim
+# (time 'tim) -> (h m s)
+# (time 'h 'm ['s]) -> tim | NIL
+# (time '(h m [s])) -> tim | NIL
+(code 'doTime 2)
+   push X
+   push Y
+   ld Y (E CDR)  # Y on args
+   atom Y  # Any?
+   if nz  # No
+      cc time(Buf)  # Get current time
+      cc localtime(Buf)  # Convert to local time
+      ld Y A
+      call tmTimeY_E  # Extract time
+   else
+      ld E (Y)  # Eval first
+      eval
+      cmp E TSym  # T?
+      if eq  # Yes
+         ld Y (Time)  # Get time from last call to 'date'
+         null Y  # Any?
+         if nz  # Yes
+            call tmTimeY_E  # Extract time
+         else
+            ld E Nil
+         end
+      else
+         cmp E Nil  # NIL?
+         if ne  # No
+            atom E  # List?
+            if z  # Yes
+               ld A (E)  # Extract hour
+               call xCntAX_FA
+               mul 3600
+               ld Y A
+               ld E (E CDR)
+               ld A (E)  # minute
+               call xCntAX_FA
+               mul 60
+               add Y A
+               ld E (E CDR)  # and second
+               atom E  # Any?
+               ldnz E Y  # No
+               if z  # Yes
+                  ld E (E)
+                  call xCntEX_FE
+                  add E Y  # add minutes and hours
+               end
+               shl E 4  # Make short number
+               or E CNT
+            else
+               ld Y (Y CDR)  # More args?
+               atom Y
+               if nz  # No
+                  call xCntEX_FE  # Get time in total seconds
+                  ld A E
+                  ld C 0
+                  div 60  # Seconds in C
+                  shl C 4  # Make short number
+                  or C CNT
+                  call cons_Y  # into cell
+                  ld (Y) C
+                  ld (Y CDR) Nil
+                  ld A E
+                  ld C 0
+                  div 60  # Total minutes in A
+                  ld C 0
+                  div 60  # Minutes in C
+                  shl C 4  # Make short number
+                  or C CNT
+                  call consY_X
+                  ld (X) C
+                  ld (X CDR) Y
+                  xchg A E  # Get total seconds again
+                  ld C 0
+                  div 3600  # Hours in A
+                  shl A 4  # Make short number
+                  or A CNT
+                  call consX_E
+                  ld (E) A
+                  ld (E CDR) X
+               else
+                  call xCntEX_FE  # Extract hour
+                  ld A E
+                  mul 3600
+                  push A  # Save hour
+                  call evCntXY_FE  # Eval minute
+                  ld A E
+                  mul 60
+                  add (S) A  # Add to hour
+                  ld Y (Y CDR)  # Eval second
+                  atom Y  # Any?
+                  if z  # Yes
+                     call evCntXY_FE
+                     add (S) E
+                  end
+                  pop E  # Get result
+                  shl E 4  # Make short number
+                  or E CNT
+               end
+            end
+         end
+      end
+   end
+   pop Y
+   pop X
+   ret
+
+# (usec) -> num
+(code 'doUsec 2)
+   cc gettimeofday(Buf 0)  # Get time
+   ld A (Buf)  # tv_sec
+   mul 1000000  # Convert to microseconds
+   add A (Buf I)  # tv_usec
+   sub A (USec)  # Diff to startup time
+   ld E A
+   shl E 4  # Make short number
+   or E CNT
+   ret
+
+# (pwd) -> sym
+(code 'doPwd 2)
+   cc getcwd(0 0)  # Get current working directory
+   null A  # OK?
+   jz retNil  # No
+   push A  # Save buffer pointer
+   ld E A  # Make transient symbol
+   call mkStrE_E
+   cc free(pop)  # Free buffer
+   ret
+
+# (cd 'any) -> sym
+(code 'doCd 2)
+   push Z
+   ld E ((E CDR))  # Get arg
+   call evSymE_E  # Evaluate to a symbol
+   call pathStringE_SZ  # Write to stack buffer
+   ld E Nil  # Preload return value
+   cc getcwd(0 0)  # Get current working directory
+   null A  # OK?
+   if nz  # Yes
+      push A  # Save buffer pointer
+      nul (S I)  # CWD empty?
+      jz 10  # Yes
+      cc chdir(&(S I))  # Stack buffer
+      nul4  # OK?
+      if z  # Yes
+10       ld E (S)  # Make transient symbol
+         call mkStrE_E
+      end
+      cc free(pop)  # Free buffer
+   end
+   ld S Z  # Drop buffer
+   pop Z
+   ret
+
+# (ctty 'sym|pid) -> flg
+(code 'doCtty 2)
+   push X
+   ld X E
+   ld E ((E CDR))  # E on arg
+   eval  # Eval it
+   cnt E  # 'pid'?
+   if nz  # Yes
+      shr E 4  # Normalize
+      ld (TtyPid) E  # Keep in global
+      ld E TSym  # Return T
+   else
+      sym E  # Need symbol
+      jz argErrEX
+      push Z
+      call bufStringE_SZ  # Write to stack buffer
+      ld E Nil  # Preload return value
+      cc freopen(S _r_ (stdin))  # Re-open standard input
+      null A  # OK?
+      if nz  # Yes
+         cc freopen(S _w_ (stdout))  # Re-open standard output
+         null A  # OK?
+         if nz  # Yes
+            cc freopen(S _w_ (stderr))  # Re-open standard error
+            null A  # OK?
+            if nz  # Yes
+               ld (((OutFiles) I) II) 1  # (stdout) OutFiles[1]->tty
+               ld E TSym  # Return T
+            end
+         end
+      end
+      ld S Z  # Drop buffer
+      pop Z
+   end
+   pop X
+   ret
+
+# (info 'any) -> (cnt|T dat . tim)
+(code 'doInfo 2)
+   push X
+   push Y
+   push Z
+   ld E ((E CDR))  # Get arg
+   call evSymE_E  # Evaluate to a symbol
+   call pathStringE_SZ  # Write to stack buffer
+   ld E S  # path name pointer
+   sub S STAT  # 'stat' structure
+   cc stat(E S)  # Get status
+   ld E Nil  # Preload return value
+   nul4  # 'stat' OK?
+   if ns
+      cc gmtime(&(S ST_MTIME))  # Get modification time
+      ld Y A  # Keep time pointer in Y
+      call tmTimeY_E  # Extract time
+      push E  # Save time
+      push Z
+      ld C Y  # Extract date
+      call tmDateC_E
+      pop Z
+      call cons_X  # New cell
+      ld (X) E  # Set date
+      pop (X CDR)  # and time
+      call consX_E  # New cell
+      call s_isdirS_F  # Directory?
+      if eq  # Yes
+         ld (E) TSym  # CAR is T
+      else
+         ld A (S ST_SIZE)  # Get size
+         shl A 4  # Make short number
+         or A CNT
+         ld (E) A
+      end
+      ld (E CDR) X
+   end
+   ld S Z  # Drop buffers
+   pop Z
+   pop Y
+   pop X
+   ret
+
+# (file) -> (sym1 sym2 . num) | NIL
+(code 'doFile 2)
+   ld C (InFile)  # Current InFile?
+   null C
+   jz retNil  # No
+   ld E (C VI)  # Filename?
+   null E
+   jz retNil  # No
+   ld B (char "/")  # Contains a slash?
+   slen C E  # String length in C
+   memb E C
+   if eq  # Yes
+      do
+         memb E C  # Find last one
+      until ne
+      push Z
+      ld Z E  # Pointer to rest
+      sub Z 1  # without slash in Z
+      call mkStrE_E  # Make string
+      call consE_C  # Cons
+      ld (C) E
+      ld A ((InFile) V)  # with 'src'
+      shl A 4  # Make short number
+      or A CNT
+      ld (C CDR) A
+      link
+      push C  # Save
+      link
+      ld E ((InFile) VI)  # Filename again
+      call mkStrEZ_A  # Make string up to Z
+      call consA_E  # Cons into list
+      ld (E) A
+      ld (E CDR) (L I)
+      drop
+      pop Z
+   else
+      call mkStrE_E  # Make string
+      call consE_C  # Cons
+      ld (C) E
+      ld A ((InFile) V)  # with 'src'
+      shl A 4  # Make short number
+      or A CNT
+      ld (C CDR) A
+      call consC_A  # Cons symbol
+      ld (A) (hex "2F2E2")  # "./"
+      or A SYM  # Make symbol
+      ld (A) A  # Set value to itself
+      call consAC_E  # Cons into list
+      ld (E) A
+      ld (E CDR) C
+   end
+   ret
+
+# (dir ['any]) -> lst
+(code 'doDir 2)
+   push Z
+   ld E ((E CDR))  # Get arg
+   call evSymE_E  # Evaluate to a symbol
+   cmp E Nil  # NIL?
+   if eq  # Yes
+      cc opendir(_dot_)  # Open "." directory
+   else
+      call pathStringE_SZ  # Write to stack buffer
+      cc opendir(S)  # Open directory
+      ld S Z  # Drop buffer
+   end
+   null A  # OK?
+   jz 10  # No
+   ld Z A  # Get directory pointer
+   do
+      cc readdir(Z)  # Find first directory entry
+      null A  # OK?
+      if z  # No
+10       ld E Nil  # Return NIL
+         pop Z
+         ret
+      end
+      lea E (A D_NAME)  # Pointer to name entry
+      ld B (E)  # First char
+      cmp B (char ".")  # Skip dot names
+   until ne
+   call mkStrE_E  # Make transient symbol
+   call consE_C  # Cons first cell
+   ld (C) E
+   ld (C CDR) Nil
+   link
+   push C  # <L I> Result
+   link
+   do
+      cc readdir(Z)  # Read next directory entry
+      null A  # OK?
+   while nz  # Yes
+      lea E (A D_NAME)  # Pointer to name entry
+      ld B (E)  # First char
+      cmp B (char ".")  # Ignore dot names
+      if ne
+         call mkStrE_E  # Make transient symbol
+         call consE_A  # Cons next cell
+         ld (A) E
+         ld (A CDR) Nil
+         ld (C CDR) A  # Concat to result
+         ld C A
+      end
+   loop
+   ld E (L I)  # Get result
+   drop
+   cc closedir(Z)  # Close directory
+   pop Z
+   ret
+
+# (cmd ['any]) -> sym
+(code 'doCmd 2)
+   ld E ((E CDR))  # Get arg
+   call evSymE_E  # Evaluate to a symbol
+   cmp E Nil  # NIL?
+   if eq
+      ld E (AV0)  # Return invocation command
+      jmp mkStrE_E  # Return transient symbol
+   end
+   push Z
+   call bufStringE_SZ  # Write to stack buffer
+   slen C S  # String length in C
+   add C 1  # plus null byte
+   movn ((AV0)) (S) C  # Copy to system buffer
+   ld S Z  # Drop buffer
+   pop Z
+   ret
+
+# (argv [var ..] [. sym]) -> lst|sym
+(code 'doArgv 2)
+   push X
+   push Y
+   push Z
+   ld X E
+   ld Y (E CDR)  # Y on args
+   ld Z (AV)  # Command line vector
+   ld E (Z)
+   null E  # Empty?
+   if nz  # No
+      ld B (E)  # Single-dash argument?
+      cmp B (char "-")
+      if eq
+         nul (E 1)
+         if z  # Yes
+            add Z I  # Skip "-"
+         end
+      end
+   end
+   cmp Y Nil  # Any args?
+   if eq  # No
+      ld E Nil  # Preload return value
+      null (Z)  # More command line arguments?
+      if nz  # Yes
+         ld E (Z)  # Next
+         call mkStrE_E  # Make transient symbol
+         call consE_C  # First result cell
+         ld (C) E
+         ld (C CDR) Nil
+         link
+         push C  # <L I> Result
+         link
+         do
+            add Z I  # Next command line argument
+            null (Z)  # Any?
+         while nz  # Yes
+            ld E (Z)  # Get it
+            call mkStrE_E  # Make transient symbol
+            call consE_A  # Next result cell
+            ld (A) E
+            ld (A CDR) Nil
+            ld (C CDR) A  # Concat to result
+            ld C A
+         loop
+         ld E (L I)  # Get result
+         drop
+      end
+   else
+      do
+         atom Y  # Atomic tail?
+      while z  # No
+         ld E (Y)  # Next 'var'
+         call needVarEX
+         ld E (Z)  # Next command line argument
+         null E  # Any?
+         if nz  # No
+            add Z I  # Increment command line index
+         end
+         call mkStrE_E  # Make transient symbol
+         ld ((Y)) E  # Set value
+         ld Y (Y CDR)  # Next arg
+         cmp Y Nil  # End of list?
+         jeq 90  # Yes
+      loop
+      num Y  # Need symbol
+      jnz symErrYX
+      call checkVarYX  # Check variable
+      ld E (Z)  # Next command line argument
+      null E  # Any?
+      if z  # No
+         ld E Nil  # Set and return NIL
+         ld (Y) E
+      else
+         call mkStrE_E  # Make transient symbol
+         call consE_C  # First result cell
+         ld (C) E
+         ld (C CDR) Nil
+         link
+         push C  # <L I> Result
+         link
+         do
+            add Z I  # Next command line argument
+            null (Z)  # Any?
+         while nz  # Yes
+            ld E (Z)  # Get it
+            call mkStrE_E  # Make transient symbol
+            call consE_A  # Next result cell
+            ld (A) E
+            ld (A CDR) Nil
+            ld (C CDR) A  # Concat to result
+            ld C A
+         loop
+         ld E (L I)  # Get and set result
+         ld (Y) E
+         drop
+      end
+   end
+90 pop Z
+   pop Y
+   pop X
+   ret
+
+# (opt) -> sym
+(code 'doOpt 2)
+   ld E ((AV))  # Command line vector
+   null E  # Next string pointer?
+   jz retNil  # No
+   ld B (E)  # Single-dash argument?
+   cmp B (char "-")
+   if eq
+      nul (E 1)
+      jz retNil  # Yes
+   end
+   add (AV) I  # Increment vector pointer
+   jmp mkStrE_E  # Return transient symbol
+
+# (version ['flg]) -> lst
+(code 'doVersion 2)
+   ld E ((E CDR))  # Eval flg
+   eval
+   cmp E Nil  # Suppress output?
+   if eq  # No
+      ld E Version  # Print version
+      do
+         ld A (E)  # Next number
+         shr A 4  # Normalize
+         call outWordA  # Print it
+         ld E (E CDR)  # More numbers?
+         atom E
+      while z  # Yes
+         ld B `(char ".")  # Output dot
+         call (EnvPutB)
+      loop
+      call newline
+   end
+   ld E Version  # Return version
+   ret
+
+# vi:et:ts=3:sw=3
diff --git a/src64/mkAsm b/src64/mkAsm
@@ -0,0 +1,14 @@
+#!../bin/picolisp ../lib.l
+# 16feb10abu
+
+(load "@lib/misc.l")
+(setq *Architecture (opt)  *System (opt)  *TargetOS (opt)  *Module (opt))
+
+(load "lib/asm.l" (pack "arch/" *Architecture ".l"))
+
+(build (pack *Architecture "." *System "." *Module ".s") (opt)
+   (load "defs.l" (pack "sys/" *System ".defs.l") T) )
+
+(bye)
+
+# vi:et:ts=3:sw=3
diff --git a/src64/net.l b/src64/net.l
@@ -0,0 +1,336 @@
+# 30sep09abu
+# (c) Software Lab. Alexander Burger
+
+# (port ['T] 'cnt|(cnt . cnt) ['var]) -> cnt
+(code 'doPort 2)
+   push X
+   push Y
+   push Z
+   ld X E
+   ld Y (E CDR)  # Y on args
+   ld Z SOCK_STREAM  # Type defaults to TCP
+   ld E (Y)  # Eval first arg
+   eval
+   cmp E TSym  # 'T'?
+   if eq  # Yes
+      ld Z SOCK_DGRAM  # Type UDP
+      ld Y (Y CDR)  # Eval next arg
+      ld E (Y)
+      eval
+   end
+   cc socket(AF_INET Z 0)  # Create socket
+   nul4  # OK?
+   js ipSocketErrX  # No
+   ld C A  # Keep socket in C
+   call closeOnExecAX
+   ld B 0  # Clear socket structure
+   mset (Addr) SOCKADDR_IN
+   ld A AF_INET
+   st2 (Addr SIN_FAMILY)
+   cc htonl(INADDR_ANY)
+   st4 (Addr SIN_ADDR.S_ADDR)
+   cnt E  # Single port-argument?
+   if nz  # Yes
+      shr E 4  # Port zero?
+      if nz  # No
+         ld A 1  # Socket option value
+         st4 (Buf)  # Store into 'optval'
+         cc setsockopt(C SOL_SOCKET SO_REUSEADDR Buf 4)  # "Reuse socket" option
+         nul4  # OK?
+         js ipSetsockoptErrX  # No
+      end
+      push 0  # <S> No range limit
+   else
+      atom E  # Port range?
+      jnz argErrEX  # No
+      ld A (E CDR)  # Get second port
+      ld E (E)  # First port
+      shr E 4  # Range start
+      shr A 4  # Normalize second port
+      push A  # <S> Range limit
+   end
+   do
+      cc htons(E)  # Convert port to network order
+      st2 (Addr SIN_PORT)  # Store as port
+      cc bind(C Addr SOCKADDR_IN)  # Try to bind socket
+      nul4  # OK?
+   while s  # No
+      add E 1  # Next port in range
+      cmp E (S)  # Exceeded limit?
+      if gt  # Yes
+         cc close(C)  # Close socket
+         jmp ipBindErrX
+      end
+   loop
+   pop A  # Drop range limit
+   cmp Z SOCK_STREAM  # TCP socket?
+   if eq  # Yes
+      cc listen(C 5)  # Mark as server socket
+      nul4  # OK?
+      if s  # No
+         cc close(C)  # Close socket
+         jmp ipListenErrX
+      end
+   end
+   ld Z C  # Keep socket in Z
+   ld Y (Y CDR)  # Eval 'var'
+   ld E (Y)
+   eval
+   cmp E Nil  # Any?
+   if ne  # Yes
+      ld A SOCKADDR_IN  # Structure size
+      st4 (Buf)  # Store into 'namelen'
+      cc getsockname(Z Addr Buf)  # Get socket name
+      nul4  # OK?
+      if s  # No
+         cc close(Z)  # Close socket
+         jmp ipGetsocknameErrX
+      end
+      call needVarEX  # Need variable
+      ld2 (Addr SIN_PORT)  # Get port
+      and A (hex "FFFF")  # Unsigned
+      cc ntohs(A)  # Convert to host byte order
+      shl A 4  # Make short number
+      or A CNT
+      ld (E) A  # Store in variable
+   end
+   ld E Z  # Get socket
+   shl E 4  # Make short number
+   or E CNT
+   pop Z
+   pop Y
+   pop X
+   ret
+
+(code 'tcpAcceptA_FE)
+   ld E A  # Save socket in E
+   call nonblockingA_A  # Set socket to non-blocking
+   push A  # Save old socket status flags
+   ld A SOCKADDR_IN  # Structure size
+   st4 (Buf)  # Store into 'addrlen'
+   ld C 200  # Maximally 20 seconds
+   do
+      cc accept(E Addr Buf)  # Accept connection
+      nul4  # OK?
+      if nz  # Yes
+         xchg A (S)  # Save new socket, retrieve flags
+         cc fcntl(E F_SETFL A)  # Restore socket status flags
+         ld4 (Addr SIN_ADDR.S_ADDR)  # Get address
+         cc inet_ntoa(A)  # Convert to IPv4 dotted-decimal string
+         ld E A
+         call mkStrE_E  # Make transient symbol
+         ld (Adr) E  # Store in '*Adr'
+         ld A (S)  # Get socket
+         call initInFileA_A  # Init input file
+         ld A (S)
+         call initOutFileA_A  # and output file
+         pop E  # Get new socket
+         shl E 4  # Make short number
+         or E CNT  # Return 'nz'
+         ret
+      end
+      cc usleep(100000)  # Sleep 100 milliseconds
+      sub C 1  # Done?
+   until z  # Yes
+   cc fcntl(E F_SETFL pop)  # Restore socket status flags
+   setz  # Return 'z'
+   ret
+
+# (accept 'cnt) -> cnt | NIL
+(code 'doAccept 2)
+   push X
+   ld X E
+   ld E ((E CDR))  # Eval socket descriptor
+   call evCntEX_FE
+   ld A E  # Accept connection
+   call tcpAcceptA_FE  # OK?
+   ldz E Nil  # No
+   pop X
+   ret
+
+# (listen 'cnt1 ['cnt2]) -> cnt | NIL
+(code 'doListen 2)
+   push X
+   push Y
+   push Z
+   ld X E
+   ld Y (E CDR)  # Y on args
+   call evCntXY_FE  # Eval 'cnt1'
+   ld Z E  # Keep socket descriptor in Z
+   ld Y (Y CDR)  # Next arg
+   ld E (Y)
+   eval  # Eval 'cnt2'
+   cmp E Nil  # Given?
+   ldz Y -1  # No timeout
+   if ne  # Yes
+      call xCntEX_FE  # Milliseconds
+      ld Y E
+   end
+   do
+      ld C Z  # Socket descriptor
+      ld E Y  # Milliseconds
+      call waitFdCEX_A  # Wait for events
+      ld E Nil  # Preload NIL
+      null A  # Timeout?
+   while nz  # No
+      ld A Z  # Accept connection
+      call tcpAcceptA_FE  # OK?
+   until nz  # Yes
+   pop Z
+   pop Y
+   pop X
+   ret
+
+# (host 'any) -> sym
+(code 'doHost 2)
+   push Z
+   ld E ((E CDR))  # Eval IP address
+   call evSymE_E
+   call bufStringE_SZ  # Write to stack buffer
+   cc inet_aton(S Buf)  # Convert to binary form
+   ld S Z  # Drop buffer
+   pop Z
+   nul4  # Valid?
+   jz retNil  # No
+   cc gethostbyaddr(Buf IN_ADDR AF_INET)  # Get hostent
+   null A  # Any?
+   jz retNil  # No
+   ld E (A H_NAME)
+   jmp mkStrE_E  # Make transient symbol
+
+# (connect 'any 'cnt) -> cnt | NIL
+(code 'doConnect 2)
+   push X
+   push Y
+   push Z
+   ld X E
+   ld Y (E CDR)  # Y on args
+   call evSymY_E  # Eval host
+   ld Y (Y CDR)  # Next arg
+   call serverEY_F  # Found server?
+   jz 80  # No: Return NIL
+   cc socket(AF_INET SOCK_STREAM 0)  # Create socket
+   nul4  # OK?
+   js ipSocketErrX  # No
+   ld Y A  # Keep socket in Y
+   call closeOnExecAX
+   cc connect(Y Addr SOCKADDR_IN)  # Try to connect
+   nul4  # OK?
+   if ns  # Yes
+      ld A Y  # Get socket
+      call initInFileA_A  # Init input file
+      ld A Y
+      call initOutFileA_A  # and output file
+      ld E Y  # Return socket
+      shl E 4  # Make short number
+      or E CNT
+   else
+      cc close(Y)  # Close socket
+80    ld E Nil  # Return NIL
+   end
+   pop Z
+   pop Y
+   pop X
+   ret
+
+(code 'serverEY_F)
+   link
+   push E  # <L I> Host
+   link
+   ld B 0  # Clear socket structure
+   mset (Addr) SOCKADDR_IN
+   call evCntXY_FE  # Eval port
+   cc htons(E)  # Convert to network order
+   st2 (Addr SIN_PORT)  # Store as port
+   ld A AF_INET
+   st2 (Addr SIN_FAMILY)
+   ld E (L I)  # Get host
+   call bufStringE_SZ  # Write host to stack buffer
+   cc inet_aton(S &(Addr SIN_ADDR))  # Convert numbers/dots to binary address
+   nul4  # Valid?
+   if z  # No
+      cc gethostbyname(S)  # Find hostent for given hostname
+      null A  # Found?
+      jz 90  # No
+      ld E A  # Keep hostent pointer in E
+      ld4 (E H_LENGTH)  # Length of address?
+      nul4
+      jz 90  # No
+      ld4 (((E H_ADDR_LIST)))  # Take first address
+      st4 (Addr SIN_ADDR.S_ADDR)
+   end
+   clrz  # Return 'nz'
+90 ld S Z  # Drop buffer
+   drop
+   ret
+
+# (udp 'any1 'cnt 'any2) -> any
+# (udp 'cnt) -> any
+(code 'doUdp 2)
+   push X
+   push Y
+   push Z
+   sub S UDPMAX  # Allocate udp buffer
+   ld X E
+   ld Y (E CDR)  # Y on args
+   ld E (Y)  # Eval first
+   eval  # 'any1' or 'cnt'
+   ld Y (Y CDR)  # Next arg?
+   atom Y
+   if nz  # No
+      call xCntEX_FE  # 'cnt'
+      cc recv(E S UDPMAX 0)  # Receive message
+      null A  # OK?
+      js 10  # No
+      ld Z S  # Buffer pointer
+      lea (BufEnd) (Z UDPMAX)  # Calculate buffer end
+      ld (GetBinZ_FB) getUdpZ_FB  # Set binary read function
+      ld (Extn) (ExtN)  # Set external symbol offset
+      call binReadZ_FE  # Read item?
+      if c  # No
+10       ld E Nil  # Return NIL
+      end
+   else
+      call serverEY_F  # Found server?
+      ldz E Nil  # No
+      if nz  # Yes
+         ld Y (Y CDR)  # Next arg
+         ld E (Y)  # Eval 'any2'
+         eval
+         ld Y E  # Keep return value in Y
+         ld Z S  # Buffer pointer
+         lea (BufEnd) (Z UDPMAX)  # Calculate buffer end
+         ld (PutBinBZ) putUdpBZ  # Set binary print function
+         ld (Extn) (ExtN)  # Set external symbol offset
+         call binPrintEZ  # Print item
+         cc socket(AF_INET SOCK_DGRAM 0)  # Create socket
+         nul4  # OK?
+         js ipSocketErrX  # No
+         ld C A  # Keep socket in C
+         sub Z S  # Data length
+         cc sendto(C S Z 0 Addr SOCKADDR_IN)  # Transmit message
+         cc close(C)  # Close socket
+         ld E Y  # Get return value
+      end
+   end
+   add S UDPMAX  # Drop buffer
+   pop Z
+   pop Y
+   pop X
+   ret
+
+(code 'getUdpZ_FB 0)
+   cmp Z (BufEnd)  # End of buffer data?
+   jeq retc  # Yes: Return 'c'
+   ld B (Z)  # Next byte
+   add Z 1  # (nc)
+   ret
+
+(code 'putUdpBZ 0)
+   cmp Z (BufEnd)  # End of buffer data?
+   jeq udpOvflErr  # Yes
+   ld (Z) B  # Store byte
+   add Z 1  # Increment pointer
+   ret
+
+# vi:et:ts=3:sw=3
diff --git a/src64/subr.l b/src64/subr.l
@@ -0,0 +1,4013 @@
+# 15feb10abu
+# (c) Software Lab. Alexander Burger
+
+# (car 'var) -> any
+(code 'doCar 2)
+   push X
+   ld X E
+   ld E ((E CDR))  # Get arg
+   eval
+   num E  # Need variable
+   jnz varErrEX
+   ld E (E)  # Take CAR
+   pop X
+   ret
+
+# (cdr 'lst) -> any
+(code 'doCdr 2)
+   push X
+   ld X E
+   ld E ((E CDR))  # Get arg
+   eval
+   cmp E Nil  # Need list
+   if ne
+      atom E
+      jnz lstErrEX
+   end
+   ld E (E CDR)  # Take CDR
+   pop X
+   ret
+
+(code 'doCaar 2)
+   push X
+   ld X E
+   ld E ((E CDR))  # Get arg
+   eval
+   num E  # Need variable
+   jnz varErrEX
+   ld E (E)  # Take CAR
+   num E  # Need variable
+   jnz varErrEX
+   ld E (E)  # Take CAR
+   pop X
+   ret
+
+(code 'doCadr 2)
+   push X
+   ld X E
+   ld E ((E CDR))  # Get arg
+   eval
+   cmp E Nil  # Need list
+   if ne
+      atom E
+      jnz lstErrEX
+   end
+   ld E (E CDR)  # Take CDR
+   num E  # Need variable
+   jnz varErrEX
+   ld E (E)  # Take CAR
+   pop X
+   ret
+
+(code 'doCdar 2)
+   push X
+   ld X E
+   ld E ((E CDR))  # Get arg
+   eval
+   num E  # Need variable
+   jnz varErrEX
+   ld E (E)  # Take CAR
+   cmp E Nil  # Need list
+   if ne
+      atom E
+      jnz lstErrEX
+   end
+   ld E (E CDR)  # Take CDR
+   pop X
+   ret
+
+(code 'doCddr 2)
+   push X
+   ld X E
+   ld E ((E CDR))  # Get arg
+   eval
+   cmp E Nil  # Need list
+   if ne
+      atom E
+      jnz lstErrEX
+   end
+   ld E (E CDR)  # Take CDR
+   cmp E Nil  # Need list
+   if ne
+      atom E
+      jnz lstErrEX
+   end
+   ld E (E CDR)  # Take CDR
+   pop X
+   ret
+
+(code 'doCaaar 2)
+   push X
+   ld X E
+   ld E ((E CDR))  # Get arg
+   eval
+   num E  # Need variable
+   jnz varErrEX
+   ld E (E)  # Take CAR
+   num E  # Need variable
+   jnz varErrEX
+   ld E (E)  # Take CAR
+   num E  # Need variable
+   jnz varErrEX
+   ld E (E)  # Take CAR
+   pop X
+   ret
+
+(code 'doCaadr 2)
+   push X
+   ld X E
+   ld E ((E CDR))  # Get arg
+   eval
+   cmp E Nil  # Need list
+   if ne
+      atom E
+      jnz lstErrEX
+   end
+   ld E (E CDR)  # Take CDR
+   num E  # Need variable
+   jnz varErrEX
+   ld E (E)  # Take CAR
+   num E  # Need variable
+   jnz varErrEX
+   ld E (E)  # Take CAR
+   pop X
+   ret
+
+(code 'doCadar 2)
+   push X
+   ld X E
+   ld E ((E CDR))  # Get arg
+   eval
+   num E  # Need variable
+   jnz varErrEX
+   ld E (E)  # Take CAR
+   cmp E Nil  # Need list
+   if ne
+      atom E
+      jnz lstErrEX
+   end
+   ld E (E CDR)  # Take CDR
+   num E  # Need variable
+   jnz varErrEX
+   ld E (E)  # Take CAR
+   pop X
+   ret
+
+(code 'doCaddr 2)
+   push X
+   ld X E
+   ld E ((E CDR))  # Get arg
+   eval
+   cmp E Nil  # Need list
+   if ne
+      atom E
+      jnz lstErrEX
+   end
+   ld E (E CDR)  # Take CDR
+   cmp E Nil  # Need list
+   if ne
+      atom E
+      jnz lstErrEX
+   end
+   ld E (E CDR)  # Take CDR
+   num E  # Need variable
+   jnz varErrEX
+   ld E (E)  # Take CAR
+   pop X
+   ret
+
+(code 'doCdaar 2)
+   push X
+   ld X E
+   ld E ((E CDR))  # Get arg
+   eval
+   num E  # Need variable
+   jnz varErrEX
+   ld E (E)  # Take CAR
+   num E  # Need variable
+   jnz varErrEX
+   ld E (E)  # Take CAR
+   cmp E Nil  # Need list
+   if ne
+      atom E
+      jnz lstErrEX
+   end
+   ld E (E CDR)  # Take CDR
+   pop X
+   ret
+
+(code 'doCdadr 2)
+   push X
+   ld X E
+   ld E ((E CDR))  # Get arg
+   eval
+   cmp E Nil  # Need list
+   if ne
+      atom E
+      jnz lstErrEX
+   end
+   ld E (E CDR)  # Take CDR
+   num E  # Need variable
+   jnz varErrEX
+   ld E (E)  # Take CAR
+   cmp E Nil  # Need list
+   if ne
+      atom E
+      jnz lstErrEX
+   end
+   ld E (E CDR)  # Take CDR
+   pop X
+   ret
+
+(code 'doCddar 2)
+   push X
+   ld X E
+   ld E ((E CDR))  # Get arg
+   eval
+   num E  # Need variable
+   jnz varErrEX
+   ld E (E)  # Take CAR
+   cmp E Nil  # Need list
+   if ne
+      atom E
+      jnz lstErrEX
+   end
+   ld E (E CDR)  # Take CDR
+   cmp E Nil  # Need list
+   if ne
+      atom E
+      jnz lstErrEX
+   end
+   ld E (E CDR)  # Take CDR
+   pop X
+   ret
+
+(code 'doCdddr 2)
+   push X
+   ld X E
+   ld E ((E CDR))  # Get arg
+   eval
+   cmp E Nil  # Need list
+   if ne
+      atom E
+      jnz lstErrEX
+   end
+   ld E (E CDR)  # Take CDR
+   cmp E Nil  # Need list
+   if ne
+      atom E
+      jnz lstErrEX
+   end
+   ld E (E CDR)  # Take CDR
+   cmp E Nil  # Need list
+   if ne
+      atom E
+      jnz lstErrEX
+   end
+   ld E (E CDR)  # Take CDR
+   pop X
+   ret
+
+(code 'doCaaaar 2)
+   push X
+   ld X E
+   ld E ((E CDR))  # Get arg
+   eval
+   num E  # Need variable
+   jnz varErrEX
+   ld E (E)  # Take CAR
+   num E  # Need variable
+   jnz varErrEX
+   ld E (E)  # Take CAR
+   num E  # Need variable
+   jnz varErrEX
+   ld E (E)  # Take CAR
+   pop X
+   ret
+
+(code 'doCaaadr 2)
+   push X
+   ld X E
+   ld E ((E CDR))  # Get arg
+   eval
+   cmp E Nil  # Need list
+   if ne
+      atom E
+      jnz lstErrEX
+   end
+   ld E (E CDR)  # Take CDR
+   num E  # Need variable
+   jnz varErrEX
+   ld E (E)  # Take CAR
+   num E  # Need variable
+   jnz varErrEX
+   ld E (E)  # Take CAR
+   num E  # Need variable
+   jnz varErrEX
+   ld E (E)  # Take CAR
+   pop X
+   ret
+
+(code 'doCaadar 2)
+   push X
+   ld X E
+   ld E ((E CDR))  # Get arg
+   eval
+   num E  # Need variable
+   jnz varErrEX
+   ld E (E)  # Take CAR
+   cmp E Nil  # Need list
+   if ne
+      atom E
+      jnz lstErrEX
+   end
+   ld E (E CDR)  # Take CDR
+   num E  # Need variable
+   jnz varErrEX
+   ld E (E)  # Take CAR
+   num E  # Need variable
+   jnz varErrEX
+   ld E (E)  # Take CAR
+   pop X
+   ret
+
+(code 'doCaaddr 2)
+   push X
+   ld X E
+   ld E ((E CDR))  # Get arg
+   eval
+   cmp E Nil  # Need list
+   if ne
+      atom E
+      jnz lstErrEX
+   end
+   ld E (E CDR)  # Take CDR
+   cmp E Nil  # Need list
+   if ne
+      atom E
+      jnz lstErrEX
+   end
+   ld E (E CDR)  # Take CDR
+   num E  # Need variable
+   jnz varErrEX
+   ld E (E)  # Take CAR
+   num E  # Need variable
+   jnz varErrEX
+   ld E (E)  # Take CAR
+   pop X
+   ret
+
+(code 'doCadaar 2)
+   push X
+   ld X E
+   ld E ((E CDR))  # Get arg
+   eval
+   num E  # Need variable
+   jnz varErrEX
+   ld E (E)  # Take CAR
+   num E  # Need variable
+   jnz varErrEX
+   ld E (E)  # Take CAR
+   cmp E Nil  # Need list
+   if ne
+      atom E
+      jnz lstErrEX
+   end
+   ld E (E CDR)  # Take CDR
+   num E  # Need variable
+   jnz varErrEX
+   ld E (E)  # Take CAR
+   pop X
+   ret
+
+(code 'doCadadr 2)
+   push X
+   ld X E
+   ld E ((E CDR))  # Get arg
+   eval
+   cmp E Nil  # Need list
+   if ne
+      atom E
+      jnz lstErrEX
+   end
+   ld E (E CDR)  # Take CDR
+   num E  # Need variable
+   jnz varErrEX
+   ld E (E)  # Take CAR
+   cmp E Nil  # Need list
+   if ne
+      atom E
+      jnz lstErrEX
+   end
+   ld E (E CDR)  # Take CDR
+   num E  # Need variable
+   jnz varErrEX
+   ld E (E)  # Take CAR
+   pop X
+   ret
+
+(code 'doCaddar 2)
+   push X
+   ld X E
+   ld E ((E CDR))  # Get arg
+   eval
+   num E  # Need variable
+   jnz varErrEX
+   ld E (E)  # Take CAR
+   cmp E Nil  # Need list
+   if ne
+      atom E
+      jnz lstErrEX
+   end
+   ld E (E CDR)  # Take CDR
+   cmp E Nil  # Need list
+   if ne
+      atom E
+      jnz lstErrEX
+   end
+   ld E (E CDR)  # Take CDR
+   num E  # Need variable
+   jnz varErrEX
+   ld E (E)  # Take CAR
+   pop X
+   ret
+
+(code 'doCadddr 2)
+   push X
+   ld X E
+   ld E ((E CDR))  # Get arg
+   eval
+   cmp E Nil  # Need list
+   if ne
+      atom E
+      jnz lstErrEX
+   end
+   ld E (E CDR)  # Take CDR
+   cmp E Nil  # Need list
+   if ne
+      atom E
+      jnz lstErrEX
+   end
+   ld E (E CDR)  # Take CDR
+   cmp E Nil  # Need list
+   if ne
+      atom E
+      jnz lstErrEX
+   end
+   ld E (E CDR)  # Take CDR
+   num E  # Need variable
+   jnz varErrEX
+   ld E (E)  # Take CAR
+   pop X
+   ret
+
+(code 'doCdaaar 2)
+   push X
+   ld X E
+   ld E ((E CDR))  # Get arg
+   eval
+   num E  # Need variable
+   jnz varErrEX
+   ld E (E)  # Take CAR
+   num E  # Need variable
+   jnz varErrEX
+   ld E (E)  # Take CAR
+   num E  # Need variable
+   jnz varErrEX
+   ld E (E)  # Take CAR
+   cmp E Nil  # Need list
+   if ne
+      atom E
+      jnz lstErrEX
+   end
+   ld E (E CDR)  # Take CDR
+   pop X
+   ret
+
+(code 'doCdaadr 2)
+   push X
+   ld X E
+   ld E ((E CDR))  # Get arg
+   eval
+   cmp E Nil  # Need list
+   if ne
+      atom E
+      jnz lstErrEX
+   end
+   ld E (E CDR)  # Take CDR
+   num E  # Need variable
+   jnz varErrEX
+   ld E (E)  # Take CAR
+   num E  # Need variable
+   jnz varErrEX
+   ld E (E)  # Take CAR
+   cmp E Nil  # Need list
+   if ne
+      atom E
+      jnz lstErrEX
+   end
+   ld E (E CDR)  # Take CDR
+   pop X
+   ret
+
+(code 'doCdadar 2)
+   push X
+   ld X E
+   ld E ((E CDR))  # Get arg
+   eval
+   num E  # Need variable
+   jnz varErrEX
+   ld E (E)  # Take CAR
+   cmp E Nil  # Need list
+   if ne
+      atom E
+      jnz lstErrEX
+   end
+   ld E (E CDR)  # Take CDR
+   num E  # Need variable
+   jnz varErrEX
+   ld E (E)  # Take CAR
+   cmp E Nil  # Need list
+   if ne
+      atom E
+      jnz lstErrEX
+   end
+   ld E (E CDR)  # Take CDR
+   pop X
+   ret
+
+(code 'doCdaddr 2)
+   push X
+   ld X E
+   ld E ((E CDR))  # Get arg
+   eval
+   cmp E Nil  # Need list
+   if ne
+      atom E
+      jnz lstErrEX
+   end
+   ld E (E CDR)  # Take CDR
+   cmp E Nil  # Need list
+   if ne
+      atom E
+      jnz lstErrEX
+   end
+   ld E (E CDR)  # Take CDR
+   num E  # Need variable
+   jnz varErrEX
+   ld E (E)  # Take CAR
+   cmp E Nil  # Need list
+   if ne
+      atom E
+      jnz lstErrEX
+   end
+   ld E (E CDR)  # Take CDR
+   pop X
+   ret
+
+(code 'doCddaar 2)
+   push X
+   ld X E
+   ld E ((E CDR))  # Get arg
+   eval
+   num E  # Need variable
+   jnz varErrEX
+   ld E (E)  # Take CAR
+   num E  # Need variable
+   jnz varErrEX
+   ld E (E)  # Take CAR
+   cmp E Nil  # Need list
+   if ne
+      atom E
+      jnz lstErrEX
+   end
+   ld E (E CDR)  # Take CDR
+   cmp E Nil  # Need list
+   if ne
+      atom E
+      jnz lstErrEX
+   end
+   ld E (E CDR)  # Take CDR
+   pop X
+   ret
+
+(code 'doCddadr 2)
+   push X
+   ld X E
+   ld E ((E CDR))  # Get arg
+   eval
+   cmp E Nil  # Need list
+   if ne
+      atom E
+      jnz lstErrEX
+   end
+   ld E (E CDR)  # Take CDR
+   num E  # Need variable
+   jnz varErrEX
+   ld E (E)  # Take CAR
+   cmp E Nil  # Need list
+   if ne
+      atom E
+      jnz lstErrEX
+   end
+   ld E (E CDR)  # Take CDR
+   cmp E Nil  # Need list
+   if ne
+      atom E
+      jnz lstErrEX
+   end
+   ld E (E CDR)  # Take CDR
+   pop X
+   ret
+
+(code 'doCdddar 2)
+   push X
+   ld X E
+   ld E ((E CDR))  # Get arg
+   eval
+   num E  # Need variable
+   jnz varErrEX
+   ld E (E)  # Take CAR
+   cmp E Nil  # Need list
+   if ne
+      atom E
+      jnz lstErrEX
+   end
+   ld E (E CDR)  # Take CDR
+   cmp E Nil  # Need list
+   if ne
+      atom E
+      jnz lstErrEX
+   end
+   ld E (E CDR)  # Take CDR
+   cmp E Nil  # Need list
+   if ne
+      atom E
+      jnz lstErrEX
+   end
+   ld E (E CDR)  # Take CDR
+   pop X
+   ret
+
+(code 'doCddddr 2)
+   push X
+   ld X E
+   ld E ((E CDR))  # Get arg
+   eval
+   cmp E Nil  # Need list
+   if ne
+      atom E
+      jnz lstErrEX
+   end
+   ld E (E CDR)  # Take CDR
+   cmp E Nil  # Need list
+   if ne
+      atom E
+      jnz lstErrEX
+   end
+   ld E (E CDR)  # Take CDR
+   cmp E Nil  # Need list
+   if ne
+      atom E
+      jnz lstErrEX
+   end
+   ld E (E CDR)  # Take CDR
+   cmp E Nil  # Need list
+   if ne
+      atom E
+      jnz lstErrEX
+   end
+   ld E (E CDR)  # Take CDR
+   pop X
+   ret
+
+# (nth 'lst 'cnt ..) -> lst
+(code 'doNth 2)
+   push X
+   push Y
+   ld X E
+   ld Y (E CDR)  # Y on args
+   ld E (Y)  # Eval 'lst'
+   eval
+   link
+   push E  # <L I> Safe
+   link
+   ld Y (Y CDR)
+   do
+      atom E  # End of 'lst'?
+   while z  # No
+      call evCntXY_FE  # Next 'cnt'
+      ld C E  # into C
+      sub C 1  # 'cnt' greater zero?
+      if ns  # Yes
+         ld E (L I)  # Get result
+         do
+            sub C 1  # Iterate
+         while ns
+            ld E (E CDR)
+         loop
+      else
+         ld E Nil  # Return NIL
+         break T
+      end
+      ld Y (Y CDR)  # Next arg?
+      atom Y
+   while z  # Yes
+      ld E (E)  # Take CAR
+      ld (L I) E  # Save
+   loop
+   drop
+   pop Y
+   pop X
+   ret
+
+# (con 'lst 'any) -> any
+(code 'doCon 2)
+   push X
+   push Y
+   ld X E
+   ld Y (E CDR)  # Y on args
+   ld E (Y)  # Eval 'lst'
+   eval
+   atom E  # Need cell
+   jnz cellErrEX
+   link
+   push E  # <L I> Safe
+   link
+   ld Y (Y CDR)  # Next arg
+   ld E (Y)  # Eval 'any'
+   eval
+   ld ((L I) CDR) E  # Concatenate
+   drop
+   pop Y
+   pop X
+   ret
+
+# (cons 'any ['any ..]) -> lst
+(code 'doCons 2)
+   push X
+   push Y
+   ld X (E CDR)  # Args
+   ld E (X)  # Eval first
+   eval
+   call consE_C  # Cons with NIL
+   ld (C) E
+   ld (C CDR) Nil
+   link
+   push C  # <L I> Safe
+   link
+   do
+      ld Y C  # Y on last cell
+      ld X (X CDR)  # Args
+      atom (X CDR)  # more than one left?
+   while z  # Yes
+      ld E (X)
+      eval  # Eval next arg
+      call consE_C  # Cons with NIL
+      ld (C) E
+      ld (C CDR) Nil
+      ld (Y CDR) C  # Store in CDR of last cell
+   loop
+   ld E (X)  # Last arg
+   eval  # Eval it
+   ld (Y CDR) E  # Store in CDR of last cell
+   ld E (L I)  # Return pair(s)
+   drop
+   pop Y
+   pop X
+   ret
+
+# (conc 'lst ..) -> lst
+(code 'doConc 2)
+   push X
+   push Y
+   ld X (E CDR)  # Args
+   ld E (X)  # Eval first
+   eval
+   link
+   push E  # <L I> Safe
+   link
+   do
+      ld Y E  # Keep in Y
+      ld X (X CDR)  # Next arg?
+      atom X
+   while z  # Yes
+      ld E (X)
+      eval  # Eval next arg
+      atom Y  # Result list?
+      if nz  # No
+         ld (L I) E  # Init result
+      else
+         do
+            atom (Y CDR)  # Find end of result list
+         while z
+            ld Y (Y CDR)
+         loop
+         ld (Y CDR) E
+      end
+   loop
+   ld E (L I)  # Return list
+   drop
+   pop Y
+   pop X
+   ret
+
+# (circ 'any ..) -> lst
+(code 'doCirc 2)
+   push X
+   push Y
+   ld X (E CDR)  # Args
+   ld E (X)  # Eval first
+   eval
+   call consE_C  # Cons with NIL
+   ld (C) E
+   ld (C CDR) Nil
+   link
+   push C  # <L I> Safe
+   link
+   do
+      ld Y C  # Keep in Y
+      ld X (X CDR)  # Next arg?
+      atom X
+   while z  # Yes
+      ld E (X)
+      eval  # Eval next arg
+      call consE_C  # Cons with NIL
+      ld (C) E
+      ld (C CDR) Nil
+      ld (Y CDR) C  # Store in CDR of last cell
+   loop
+   ld E (L I)  # Return list
+   ld (Y CDR) E  # Make circular
+   drop
+   pop Y
+   pop X
+   ret
+
+# (rot 'lst ['cnt]) -> lst
+(code 'doRot 2)
+   push X
+   push Y
+   ld X E
+   ld Y (E CDR)  # Y on args
+   ld E (Y)  # Eval 'lst'
+   eval
+   atom E  # Cell?
+   if z  # Yes
+      link
+      push E  # <L I> Safe
+      link
+      ld Y (Y CDR)
+      atom Y  # Second arg?
+      ldnz E 0  # Yes
+      if z  # No
+         call evCntXY_FE  # Eval 'cnt'
+      end
+      ld Y (L I)  # Retrieve 'lst'
+      ld X (Y)  # Keep CAR
+      do
+         sub E 1  # Decrement count
+      while nz
+         ld Y (Y CDR)  # Next cell?
+         atom Y
+      while z  # Yes
+         cmp Y (L I)  # Circular?
+      while ne  # No
+         xchg X (Y)  # Swap
+      loop
+      ld ((L I)) X  # Store new CAR
+      ld E (L I)
+      drop
+   end
+   pop Y
+   pop X
+   ret
+
+# (list 'any ['any ..]) -> lst
+(code 'doList 2)
+   push X
+   push Y
+   ld X (E CDR)  # Args
+   ld E (X)  # Eval first
+   eval
+   call consE_C  # Cons with NIL
+   ld (C) E
+   ld (C CDR) Nil
+   link
+   push C  # <L I> Safe
+   link
+   do
+      ld Y C  # Keep in Y
+      ld X (X CDR)  # Next arg?
+      atom X
+   while z  # Yes
+      ld E (X)
+      eval  # Eval next arg
+      call consE_C  # Cons with NIL
+      ld (C) E
+      ld (C CDR) Nil
+      ld (Y CDR) C  # Store in CDR of last cell
+   loop
+   ld E (L I)  # Return list
+   drop
+   pop Y
+   pop X
+   ret
+
+# (need 'cnt ['lst ['any]]) -> lst
+(code 'doNeed 2)
+   push X
+   push Y
+   ld X E
+   ld Y (E CDR)  # Y on args
+   call evCntXY_FE  # Eval 'cnt'
+   ld X E  # Keep in X
+   ld Y (Y CDR)
+   ld E (Y)  # Eval next
+   eval
+   link
+   push E  # <L II> 'lst'
+   ld Y (Y CDR)
+   ld E (Y)  # Eval 'any'
+   eval+
+   push E  # <L I> 'any'
+   link
+   ld E (L II)  # Get 'lst'
+   or X X  # 'cnt'?
+   if nz  # Yes
+      if ns  # > 0
+         ld Y E  # 'lst' in Y
+         do
+            atom Y  # Find end of 'lst'
+         while z
+            ld Y (Y CDR)
+            sub X 1  # Decrement 'cnt'
+         loop
+         do
+            sub X 1  # 'cnt' > 0?
+         while ns  # Yes
+            ld C E
+            call consC_E  # Cons 'any' with 'lst'
+            ld (E) (L I)
+            ld (E CDR) C
+         loop
+      else
+         atom E  # 'lst' atomic?
+         if nz
+            call cons_E  # Cons 'any' with NIL
+            ld (E) (L I)
+            ld (E CDR) Nil
+            ld (L II) E  # Save
+         else
+            do
+               ld Y (E CDR)  # Find last cell
+               atom Y
+            while z
+               add X 1  # Increment 'cnt'
+               ld E Y
+            loop
+         end
+         do
+            add X 1  # Increment 'cnt'
+         while s
+            call cons_A  # Cons 'any' with NIL
+            ld (A) (L I)
+            ld (A CDR) Nil
+            ld (E CDR) A  # Append
+            ld E (E CDR)
+         loop
+         ld E (L II)  # Get result
+      end
+   end
+   drop
+   pop Y
+   pop X
+   ret
+
+# (range 'num1 'num2 ['num3]) -> lst
+(code 'doRange 2)
+   push X
+   push Y
+   ld X E
+   ld Y (E CDR)  # Y on args
+   ld E (Y)  # Eval 'num1'
+   eval
+   num E  # Number?
+   jz numErrEX  # No
+   link
+   push E  # <L IV> Start value
+   ld Y (Y CDR)
+   ld E (Y)  # Eval 'num2'
+   eval+
+   num E  # Number?
+   jz numErrEX  # No
+   push E  # <L III> End value
+   push ONE  # <L II> Increment
+   ld E ((Y CDR))  # Eval 'num3'
+   eval+
+   cmp E Nil  # NIL?
+   if ne  # No
+      num E  # Number?
+      jz numErrEX  # No
+      zero E  # Zero?
+      jeq argErrEX  # Yes
+      test E SIGN  # Negative?
+      jnz argErrEX  # Yes
+      ld (S) E  # Else set increment
+   end
+   link
+   call cons_X  # Build first cell
+   tuck X  # <L I> Result
+   link
+   ld (X) (L IV)  # Start value
+   ld (X CDR) Nil
+   ld A (L IV)  # Get start value
+   ld E (L III)  # and end value
+   call cmpNumAE_F  # Start <= end?
+   ld A (L IV)  # Get start value again
+   if le  # Yes
+      do
+         ld E (L II)  # Increment start value
+         call addAE_A
+         push A
+         ld E (L III)  # Start <= end?
+         call cmpNumAE_F
+      while le  # Yes
+         pop A
+         call consA_Y  # Append to result
+         ld (Y) A
+         ld (Y CDR) Nil
+         ld (X CDR) Y
+         ld X Y
+      loop
+   else
+      do
+         ld E (L II)  # Decrement start value
+         call subAE_A
+         push A
+         ld E (L III)  # Start >= end?
+         call cmpNumAE_F
+      while ge  # Yes
+         pop A
+         call consA_Y  # Append to result
+         ld (Y) A
+         ld (Y CDR) Nil
+         ld (X CDR) Y
+         ld X Y
+      loop
+   end
+   ld E (L I)
+   drop
+   pop Y
+   pop X
+   ret
+
+# (full 'any) -> bool
+(code 'doFull 2)
+   ld E (E CDR)  # Get arg
+   ld E (E)  # Eval it
+   eval
+   do
+      atom E  # Cell?
+      jnz retT  # Yes
+      cmp (E) Nil  # Found NIL?
+      jz retNil  # Yes
+      ld E (E CDR)
+   loop
+
+# (make .. [(made 'lst ..)] .. [(link 'any ..)] ..) -> any
+(code 'doMake 2)
+   push X
+   ld X (E CDR)  # Body
+   push (EnvMake)  # Save current 'make' env
+   push (EnvYoke)
+   link
+   push Nil  # <L I> Result
+   ld (EnvMake) S  # Tail address
+   ld (EnvYoke) S  # Head address
+   link
+   exec X
+   ld E (L I)  # Get result
+   drop
+   pop (EnvYoke)  # Restore 'make' env
+   pop (EnvMake)
+   pop X
+   ret
+
+# (made ['lst1 ['lst2]]) -> lst
+(code 'doMade 2)
+   push X
+   ld X E
+   null (EnvMake)  # In 'make'?
+   jz makeErrEX  # No
+   push Y
+   ld Y (E CDR)  # Y on args
+   atom Y  # Any?
+   if z  # Yes
+      ld E (Y)  # Eval 'lst1'
+      eval
+      ld ((EnvYoke)) E  # Set new list
+      ld Y (Y CDR)
+      ld E (Y)  # Eval 'lst2'
+      eval
+      atom E  # Cell?
+      if nz  # No
+         ld E ((EnvYoke))  # Retrieve new 'lst1'
+         do
+            ld A (E CDR)  # Find last cell
+            atom A
+         while z
+            ld E A
+         loop
+      end
+      lea E (E CDR)  # Set new tail address
+      ld (EnvMake) E
+   end
+   ld E ((EnvYoke))  # Return list
+   pop Y
+   pop X
+   ret
+
+# (chain 'lst ..) -> lst
+(code 'doChain 2)
+   push X
+   ld X E
+   null (EnvMake)  # In 'make'?
+   jz makeErrEX  # No
+   push Y
+   ld Y (E CDR)  # Y on args
+   do
+      ld E (Y)  # Eval arg
+      eval
+      ld ((EnvMake)) E  # Store new list
+      atom E  # Got a list?
+      if z  # Yes
+         ld C E
+         do
+            ld A (C CDR)  # Find last cell
+            atom A
+         while z
+            ld C A
+         loop
+         lea C (C CDR)  # Set new tail address
+         ld (EnvMake) C
+      end
+      ld Y (Y CDR)  # More args?
+      atom Y
+   until nz
+   pop Y
+   pop X
+   ret
+
+# (link 'any ..) -> any
+(code 'doLink 2)
+   push X
+   ld X E
+   null (EnvMake)  # In 'make'?
+   jz makeErrEX  # No
+   push Y
+   ld Y (E CDR)  # Y on args
+   do
+      ld E (Y)  # Eval arg
+      eval
+      call consE_C  # Make new cell
+      ld (C) E
+      ld (C CDR) Nil
+      ld ((EnvMake)) C  # Store new tail
+      lea C (C CDR)  # Set new tail address
+      ld (EnvMake) C
+      ld Y (Y CDR)  # More args?
+      atom Y
+   until nz
+   pop Y
+   pop X
+   ret
+
+# (yoke 'any ..) -> any
+(code 'doYoke 2)
+   push X
+   ld X E
+   null (EnvMake)  # In 'make'?
+   jz makeErrEX  # No
+   push Y
+   ld Y (E CDR)  # Y on args
+   do
+      ld E (Y)  # Eval arg
+      eval
+      call consE_A  # Make new cell
+      ld (A) E
+      ld (A CDR) ((EnvYoke))  # Set head
+      ld ((EnvYoke)) A
+      ld Y (Y CDR)  # More args?
+      atom Y
+   until nz
+   do
+      ld C ((EnvMake))  # Adjust tail address?
+      atom C
+   while z  # Yes
+      lea C (C CDR)  # Set new tail address
+      ld (EnvMake) C
+   loop
+   pop Y
+   pop X
+   ret
+
+# (copy 'any) -> any
+(code 'doCopy 2)
+   ld E ((E CDR))  # Eval arg
+   eval
+   atom E  # List?
+   if z  # Yes
+      push Z
+      ld Z E  # Keep head in Z
+      call consE_C  # Copy first cell
+      ld (C) (E)
+      ld (C CDR) (E CDR)
+      link
+      push C  # <L I> Result
+      link
+      do
+         ld E (E CDR)
+         atom E  # More cells?
+      while z  # Yes
+         cmp E Z  # Circular?
+         if eq  # Yes
+            ld (C CDR) (L I)  # Concat head
+            break T
+         end
+         call consE_A  # Copy next cell
+         ld (A) (E)
+         ld (A CDR) (E CDR)
+         ld (C CDR) A  # Concat to result
+         ld C A
+      loop
+      ld E (L I)  # Get result
+      drop
+      pop Z
+   end
+   ret
+
+# (mix 'lst cnt|'any ..) -> lst
+(code 'doMix 2)
+   push X
+   ld X (E CDR)  # X on args
+   ld E (X)  # Eval first
+   eval
+   cmp E Nil  # Empty list?
+   jz 10  # Yes
+   atom E  # Atomic?
+   if z  # No
+10    push Y
+      ld X (X CDR)  # Next arg?
+      atom X
+      if z  # Yes
+         link
+         push E  # <L II> List
+         link
+         ld C (X)
+         cnt C  # Literal second arg?
+         if z  # No
+            ld E C  # Eval second arg
+            eval
+         else
+            shr C 4  # Normalize
+            if le  # Negative
+               ld E Nil
+            else
+               do
+                  sub C 1  # nth
+               while nz
+                  ld E (E CDR)
+               loop
+               ld E (E)
+            end
+         end
+         call consE_C  # Cons first result cell
+         ld (C) E
+         ld (C CDR) Nil
+         tuck C  # <L I> Result
+         link
+         do
+            ld Y C  # Keep in Y
+            ld X (X CDR)  # Next arg?
+            atom X
+         while z  # Yes
+            ld E (X)
+            cnt E  # Literal next arg?
+            if z  # No
+               eval  # Eval next arg
+            else
+               shr E 4  # Normalize
+               if le  # Negative
+                  ld E Nil
+               else
+                  ld C (L II)  # Get list
+                  do
+                     sub E 1  # nth
+                  while nz
+                     ld C (C CDR)
+                  loop
+                  ld E (C)
+               end
+            end
+            call consE_C  # Cons first result cell
+            ld (C) E
+            ld (C CDR) Nil
+            ld (Y CDR) C  # Store in CDR of last cell
+         loop
+         ld E (L I)  # Get result
+         drop
+      else
+         ld E Nil  # Return NIL
+      end
+      pop Y
+   end
+   pop X
+   ret
+
+# (append 'lst ..) -> lst
+(code 'doAppend 2)
+   push X
+   ld X (E CDR)  # Args
+   do
+      atom (X CDR)  # More than one left?
+   while z  # Yes
+      ld E (X)  # Eval first
+      eval
+      atom E  # Found a list?
+      if z  # Yes
+         ld A E
+         call consE_E  # Copy first cell
+         ld (E) (A)
+         ld C (A CDR)
+         ld (E CDR) C
+         link
+         push E  # <L I> Result
+         link
+         do
+            atom C  # More cells?
+         while z  # Yes
+            call consC_A  # Copy next cell
+            ld (A) (C)
+            ld C (C CDR)
+            ld (A CDR) C
+            ld (E CDR) A  # Concat to result
+            ld E A
+         loop
+         push E  # Save last cell
+         do
+            ld X (X CDR)  # More than one left?
+            atom (X CDR)
+         while z  # Yes
+            ld E (X)  # Eval next argument
+            eval
+            do
+               atom E  # Found a list?
+            while z  # Yes
+               call consE_A  # Copy cells
+               ld (A) (E)
+               ld E (E CDR)
+               ld (A CDR) E
+               ld ((S) CDR) A  # Concat with last cell
+               ld (S) A  # New last cell
+            loop
+         loop
+         ld E (X)  # Eval last argument
+         eval
+         pop A  # Get last cell
+         ld (A CDR) E  # Concat last list
+         ld E (L I)  # Get result
+         drop
+         pop X
+         ret
+      end
+      ld X (X CDR)  # Next arg
+   loop
+   ld E (X)  # Eval last arg
+   eval
+   pop X
+   ret
+
+# (delete 'any 'lst) -> lst
+(code 'doDelete 2)
+   push X
+   ld X (E CDR)  # Args
+   ld E (X)  # Eval 'any'
+   eval
+   link
+   push E  # <L II/III> 'any'
+   ld E ((X CDR))  # Eval 'lst'
+   eval+
+   push E  # <L I/II> 'lst'
+   link
+   atom E  # Atomic?
+   if z  # No
+      ld X E  # Keep in X
+      ld A (L II)  # 'any'
+      ld E (X)  #  Equal to CAR?
+      call equalAE_F
+      if eq  # Yes
+         ld E (X CDR)  # Return CDR
+      else
+         call cons_C  # Cons first item into C
+         ld (C) (X)
+         ld (C CDR) Nil
+         tuck C  # <L I> Result
+         link
+         do
+            ld X (X CDR)  # Next item
+            atom X  # More cells?
+         while z  # Yes
+            ld A (L III)  # 'any'
+            ld E (X)  #  Equal to CAR?
+            call equalAE_F
+            if eq  # Yes
+               ld X (X CDR)  # Skip this item
+               break T
+            end
+            call cons_A  # Cons next item
+            ld (A) (X)
+            ld (A CDR) Nil
+            ld (C CDR) A  # Append
+            ld C A
+         loop
+         ld (C CDR) X  # Set tail
+         ld E (L I)  # Get result
+      end
+   end
+   drop
+   pop X
+   ret
+
+# (delq 'any 'lst) -> lst
+(code 'doDelq 2)
+   push X
+   ld X (E CDR)  # Args
+   ld E (X)  # Eval 'any'
+   eval
+   link
+   push E  # <L II/III> 'any'
+   ld E ((X CDR))  # Eval 'lst'
+   eval+
+   push E  # <L I/II> 'lst'
+   link
+   atom E  # Atomic?
+   if z  # No
+      ld X (L II)  # 'any'
+      cmp X (E)  #  Equal to CAR?
+      if eq  # Yes
+         ld E (E CDR)  # Return CDR
+      else
+         call cons_C  # Cons first item into C
+         ld (C) (E)
+         ld (C CDR) Nil
+         tuck C  # <L I> Result
+         link
+         do
+            ld E (E CDR)  # Next item
+            atom E  # More cells?
+         while z  # Yes
+            cmp X (E)  #  'any' equal to CAR?
+            if eq  # Yes
+               ld E (E CDR)  # Skip this item
+               break T
+            end
+            call cons_A  # Cons next item
+            ld (A) (E)
+            ld (A CDR) Nil
+            ld (C CDR) A  # Append
+            ld C A
+         loop
+         ld (C CDR) E  # Set tail
+         ld E (L I)  # Get result
+      end
+   end
+   drop
+   pop X
+   ret
+
+# (replace 'lst 'any1 'any2 ..) -> lst
+(code 'doReplace 2)
+   push X
+   ld X (E CDR)  # X on args
+   ld E (X)  # Eval 'lst'
+   eval
+   atom E  # Atomic?
+   if z  # No
+      push Y
+      push Z
+      link
+      push E  # Save 'lst'
+      ld Y E  # Keep in Y
+      do
+         ld X (X CDR)  # 'anyN' args?
+         atom X
+      while z  # Yes
+         ld E (X)  # Eval next arg
+         eval+
+         push E  # and save it
+      loop
+      ld X L  # X above 'any1'
+      lea C (S -I)  # C on end of 'any' items
+      link
+      call cons_Z  # Build first result cell
+      do
+         sub X II  # Try next 'any' pair
+         cmp X C  # Reached last 'any' item?
+      while ne  # No
+         ld A (X)  # Next item
+         ld E (Y)  # Equal to CAR of 'lst'?
+         call equalAE_F
+         if eq  # Yes
+            ld (Z) (X -I)  # First result item is 'any2'
+            jmp 10
+         end
+      loop
+      ld (Z) (Y)  # First result item is CAR of 'lst'
+10    ld (Z CDR) Nil
+      tuck Z  # <L I> Result
+      link
+      do
+         ld Y (Y CDR)  # More in 'lst'?
+         atom Y
+      while z  # Yes
+         ld X (L)  # X above 'any1'
+         do
+            sub X II  # Try next 'any' pair
+            cmp X C  # Reached top?
+         while ne  # No
+            ld A (X)  # Next item
+            ld E (Y)  # Equal to next item in 'lst'?
+            call equalAE_F
+            if eq  # Yes
+               call cons_E  # Build next result cell
+               ld (E) (X -I)  # Next result item
+               jmp 20
+            end
+         loop
+         call cons_E  # Build next result cell
+         ld (E) (Y)  # Next result item from 'lst'
+20       ld (E CDR) Nil
+         ld (Z CDR) E  # Concat to result
+         ld Z E
+      loop
+      ld E (L I)  # Get result
+      drop
+      pop Z
+      pop Y
+   end
+   pop X
+   ret
+
+# (strip 'any) -> any
+(code 'doStrip 2)
+   ld E ((E CDR))  # Get arg
+   eval  # Eval it
+   do
+      atom E  # List?
+   while z  # Yes
+      cmp (E) Quote  # CAR is 'quote'?
+   while eq  # Yes
+      ld A (E CDR)  # Get CDR
+      cmp A E  # Circular?
+   while ne  # No
+      ld E A  # Go to CDR
+   loop
+   ret
+
+# (split 'lst 'any ..) -> lst
+(code 'doSplit 2)
+   push X
+   ld X (E CDR)  # Args
+   ld E (X)  # Eval 'lst'
+   eval
+   atom E  # List?
+   if z  # Yes
+      push Y
+      push Z
+      link
+      push E  # Save 'lst'
+      do
+         ld X (X CDR)  # Next 'any' arg?
+         atom X
+      while z  # Yes
+         ld E (X)  # Eval next arg
+         eval+
+         push E  # and save it
+      loop  # <L III/..> 'any' items
+      lea C (L -I)  # C is top of 'any' items, and adr of 'lst'
+      ld Y Nil
+      push Y  # <L II> Result in Y
+      ld Z Y
+      push Z  # <L I> Sublist in Z
+      link
+      do
+         lea X (L III)  # X on 'any' items
+         do
+            cmp X C  # Reached top?
+         while ne  # No
+            ld A (X)  # Next item
+            ld E ((C))  # Equal to CAR of 'lst'?
+            call equalAE_F
+            if eq  # Yes
+               atom Y  # Result?
+               if nz  # No
+                  call cons_Y  # Initial result cell
+                  ld (Y) (L I)  # with sublist
+                  ld (Y CDR) Nil
+                  ld (L II) Y  # Store in result
+               else
+                  call cons_A  # New cell
+                  ld (A) (L I)  # with sublist
+                  ld (A CDR) Nil
+                  ld (Y CDR) A  # Concat to result
+                  ld Y A
+               end
+               ld Z Nil  # Clear sublist
+               ld (L I) Z
+               jmp 10
+            end
+            add X I  # Next 'any' item
+         loop
+         atom Z  # Sublist?
+         if nz  # No
+            call cons_Z  # Initial sublist cell
+            ld (Z) ((C))
+            ld (Z CDR) Nil
+            ld (L I) Z  # Store in sublist
+         else
+            call cons_A  # New cell
+            ld (A) ((C))
+            ld (A CDR) Nil
+            ld (Z CDR) A  # Concat to sublist
+            ld Z A
+         end
+10       ld A ((C) CDR)  # Next element of 'lst'
+         ld (C) A
+         atom A  # Any?
+      until nz  # No
+      call cons_E  # Cons final sublist
+      ld (E) (L I)
+      ld (E CDR) Nil
+      atom Y  # Result so far?
+      if z  # Yes
+         ld (Y CDR) E  # Concat final sublist
+         ld E (L II)  # Get result
+      end
+      drop
+      pop Z
+      pop Y
+   end
+   pop X
+   ret
+
+# (reverse 'lst) -> lst
+(code 'doReverse 2)
+   ld E ((E CDR))  # Get arg
+   eval  # Eval it
+   link
+   push E  # <L II> Safe
+   link
+   ld A Nil  # Result
+   do
+      atom E  # Cells?
+   while z  # Yes
+      call consA_C  # Cons next CAR
+      ld (C) (E)
+      ld (C CDR) A
+      ld A C
+      ld E (E CDR)
+   loop
+   ld E A  # Return list
+   drop
+   ret
+
+# (flip 'lst ['cnt]) -> lst
+(code 'doFlip 2)
+   push X
+   push Y
+   ld X E
+   ld Y (E CDR)  # Y on args
+   ld E (Y)  # Eval 'lst'
+   eval
+   atom E  # Cell?
+   if z  # Yes
+      ld Y (Y CDR)
+      atom Y  # Second arg?
+      if nz  # No
+         ld C (E CDR)  # More than one element?
+         atom C
+         if z  # Yes
+            ld (E CDR) Nil  # Make it the last cell
+            do
+               ld A (C CDR)  # Get next cell
+               ld (C CDR) E  # Concat previous
+               ld E C  # Set to first
+               atom A  # Done?
+            while z  # No
+               ld C A
+            loop
+         end
+      else
+         link
+         push E  # <L I> 'lst'
+         link
+         call evCntXY_FE  # Eval 'cnt'
+         ld C (L I)  # Retrieve 'lst'
+         drop
+         ld X (C CDR)  # More than one element?
+         atom X
+         if z  # Yes
+            sub E 1  # 'cnt' > 1?
+            if nsz  # Yes
+               ld (C CDR) (X CDR)  # Swap first two cells
+               ld (X CDR) C
+               do
+                  sub E 1  # Done?
+               while nz  # No
+                  ld A (C CDR)  # More cells?
+                  atom A
+               while z  # Yes
+                  ld (C CDR) (A CDR)  # Swap next two cells
+                  ld (A CDR) X
+                  ld X A
+               loop
+               ld C X  # Return 'lst'
+            end
+         end
+         ld E C  # Return 'lst'
+      end
+   end
+   pop Y
+   pop X
+   ret
+
+# (trim 'lst) -> lst
+(code 'doTrim 2)
+   ld E ((E CDR))  # Get arg
+   eval  # Eval it
+   link
+   push E  # Save
+   link
+   call trimE_E  # Trim
+   drop
+   ret
+
+(code 'trimE_E 0)
+   atom E  # List?
+   if z  # Yes
+      push (E)  # Save CAR
+      ld E (E CDR)  # Trim CDR
+      call trimE_E
+      cmp E Nil  # All trimmed?
+      if eq  # Yes
+         ld E (S)  # Get CAR
+         call isBlankE_F  # Blank?
+         if eq  # Yes
+            pop A  # Drop CAR
+            ld E Nil  # Return NIL
+            ret
+         end
+         call cons_E  # New tail cell
+         pop (E)  # Copy CAR
+         ld (E CDR) Nil
+         ret
+      end
+      ld A E
+      call consE_E  # New cell
+      pop (E)  # Copy CAR
+      ld (E CDR) A
+   end
+   ret
+
+# (clip 'lst) -> lst
+(code 'doClip 2)
+   ld E ((E CDR))  # Get arg
+   eval  # Eval it
+   do
+      atom E  # List?
+      jnz ret  # No
+      push E
+      ld E (E)  # CAR blank?
+      call isBlankE_F
+      pop E
+   while z  # Yes
+      ld E (E CDR)  # Try next
+   loop
+   link
+   push E  # Save
+   link
+   call trimE_E  # Trim
+   drop
+   ret
+
+# (head 'cnt|lst 'lst) -> lst
+(code 'doHead 2)
+   push X
+   push Y
+   ld X E
+   ld Y (E CDR)  # Y on args
+   ld E (Y)  # Eval first
+   ld Y (Y CDR)  # Y on rest
+   eval
+   cmp E Nil  # NIL?
+   if ne  # No
+      atom E  # 'lst' arg?
+      if z  # Yes
+         link
+         push E  # <L I> First 'lst'
+         link
+         ld E (Y)  # Eval second
+         eval
+         atom E  # 'lst'?
+         if z  # Yes
+            ld X E  # 'lst'
+            ld Y (L I)  # Head list
+            do
+               ld A (X)
+               ld E (Y)  # Compare elements
+               call equalAE_F  # Equal?
+            while eq  # Yes
+               ld Y (Y CDR)  # Head done?
+               atom Y
+               if nz  # Yes
+                  ld E (L I)  # Return head
+                  drop
+                  pop Y
+                  pop X
+                  ret
+               end
+               ld X (X CDR)
+            loop
+         end
+         drop
+         jmp 10
+      end
+      call xCntEX_FE  # 'cnt' zero?
+      if nz  # No
+         ld X E  # 'cnt' in X
+         ld E (Y)  # Eval second
+         eval
+         atom E  # List?
+         if z  # Yes
+            null X  # 'cnt' negative?
+            if s  # Yes
+               ld Y E
+               do
+                  add X 1  # Increment 'cnt' by length
+                  ld Y (Y CDR)
+                  atom Y
+               until nz
+               null X  # 'cnt' still negative or zero?
+               jsz 10  # Yes
+            end
+            link
+            push E  # Save 'lst'
+            link
+            call cons_Y  # Build first cell
+            ld (Y) (E)  # From CAR of 'lst'
+            ld (Y CDR) Nil
+            tuck Y  # <L I> Result
+            link
+            do
+               sub X 1  # Counted down?
+            while nz  # No
+               ld E (E CDR)  # List done?
+               atom E
+            while z  # No
+               call cons_A  # Build next cell
+               ld (A) (E)  # From next list item
+               ld (A CDR) Nil
+               ld (Y CDR) A  # Concat to result
+               ld Y A
+            loop
+            ld E (L I)  # Get result
+            drop
+         end
+      else
+10       ld E Nil  # Return NIL
+      end
+   end
+   pop Y
+   pop X
+   ret
+
+# (tail 'cnt|lst 'lst) -> lst
+(code 'doTail 2)
+   push X
+   push Y
+   ld X E
+   ld Y (E CDR)  # Y on args
+   ld E (Y)  # Eval first
+   ld Y (Y CDR)  # Y on rest
+   eval
+   cmp E Nil  # NIL?
+   if ne  # No
+      atom E  # 'lst' arg?
+      if z  # Yes
+         link
+         push E  # <L I> First 'lst'
+         link
+         ld E (Y)  # Eval second
+         eval
+         atom E  # 'lst'?
+         if z  # Yes
+            ld X E  # 'lst'
+            ld Y (L I)  # Tail list
+            do
+               ld A X
+               ld E Y  # Compare lists
+               call equalAE_F  # Equal?
+               if eq  # Yes
+                  ld E (L I)  # Return tail
+                  drop
+                  pop Y
+                  pop X
+                  ret
+               end
+               ld X (X CDR)  # List done?
+               atom X
+            until nz  # Yes
+         end
+         drop
+         jmp 10
+      end
+      call xCntEX_FE  # 'cnt' zero?
+      if nz  # No
+         ld X E  # 'cnt' in X
+         ld E (Y)  # Eval second
+         eval
+         atom E  # List?
+         if z  # Yes
+            null X  # 'cnt' negative?
+            if s  # Yes
+               do
+                  ld E (E CDR)
+                  add X 1  # Take -nth
+               until z
+            else
+               ld Y (E CDR)  # Traverse CDR
+               do
+                  sub X 1  # Decrement 'cnt'
+               while nz
+                  atom Y  # End of list?
+               while z  # No
+                  ld Y (Y CDR)
+               loop
+               do
+                  atom Y  # Traverse rest
+               while z
+                  ld E (E CDR)  # Step result
+                  ld Y (Y CDR)  # and rest
+               loop
+            end
+         end
+      else
+10       ld E Nil  # Return NIL
+      end
+   end
+   pop Y
+   pop X
+   ret
+
+# (stem 'lst 'any ..) -> lst
+(code 'doStem 2)
+   push X
+   push Y
+   ld X (E CDR)  # Args
+   ld E (X)  # Eval 'lst'
+   eval
+   link
+   push E  # Save 'lst'
+   do
+      ld X (X CDR)  # Next 'any' arg?
+      atom X
+   while z  # Yes
+      ld E (X)  # Eval next arg
+      eval+
+      push E  # and save it
+   loop  # <L I/..> 'any' items
+   lea C (L -I)  # C is top of 'any' items, and adr of 'lst'
+   link
+   ld Y (C)  # Get 'lst'
+   do
+      atom Y  # End of 'lst'?
+   while z  # No
+      lea X (L I)  # X on 'any' items
+      do
+         cmp X C  # Reached top?
+      while ne  # No
+         ld A (X)  # Next item
+         ld E (Y)  # Found in 'lst'?
+         call equalAE_F
+         if eq  # Yes
+            ld (C) (Y CDR)  # Set result
+            break T
+         end
+         add X I  # Next 'any' item
+      loop
+      ld Y (Y CDR)  # Next in 'lst'
+   loop
+   ld E (C)  # Get Result
+   drop
+   pop Y
+   pop X
+   ret
+
+# (fin 'any) -> num|sym
+(code 'doFin 2)
+   ld E ((E CDR))  # Get arg
+   eval  # Eval it
+   do
+      atom E  # Final atom?
+   while z  # No
+      ld E (E CDR)  # Try next
+   loop
+   ret
+
+# (last 'lst) -> any
+(code 'doLast 2)
+   ld E ((E CDR))  # Get arg
+   eval  # Eval it
+   atom E  # List?
+   if z  # Yes
+      do
+         atom (E CDR)  # Last cell?
+      while z  # No
+         ld E (E CDR)  # Try next
+      loop
+      ld E (E)  # Get CAR
+   end
+   ret
+
+# (== 'any ..) -> flg
+(code 'doEq 2)
+   push X
+   ld X (E CDR)  # X on args
+   ld E (X)
+   eval  # Eval first arg
+   link
+   push E  # <L I> Safe
+   link
+   do
+      ld X (X CDR)  # More args?
+      atom X
+   while z  # Yes
+      ld E (X)
+      eval  # Eval next arg
+      cmp E (L I)  # Eq to first arg?
+      if ne  # No
+         drop
+         ld E Nil  # Return NIL
+         pop X
+         ret
+      end
+   loop
+   drop
+   ld E TSym  # Return T
+   pop X
+   ret
+
+# (n== 'any ..) -> flg
+(code 'doNEq 2)
+   push X
+   ld X (E CDR)  # X on args
+   ld E (X)
+   eval  # Eval first arg
+   link
+   push E  # <L I> Safe
+   link
+   do
+      ld X (X CDR)  # More args?
+      atom X
+   while z  # Yes
+      ld E (X)
+      eval  # Eval next arg
+      cmp E (L I)  # Eq to first arg?
+      if ne  # No
+         drop
+         ld E TSym  # Return T
+         pop X
+         ret
+      end
+   loop
+   drop
+   ld E Nil  # Return NIL
+   pop X
+   ret
+
+# (= 'any ..) -> flg
+(code 'doEqual 2)
+   push X
+   ld X (E CDR)  # X on args
+   ld E (X)
+   eval  # Eval first arg
+   link
+   push E  # <L I> Safe
+   link
+   do
+      ld X (X CDR)  # More args?
+      atom X
+   while z  # Yes
+      ld E (X)
+      eval  # Eval next arg
+      ld A (L I)  # Get first arg
+      call equalAE_F  # Equal to previous?
+      if ne  # No
+         drop
+         ld E Nil  # Return NIL
+         pop X
+         ret
+      end
+   loop
+   drop
+   ld E TSym  # Return T
+   pop X
+   ret
+
+# (<> 'any ..) -> flg
+(code 'doNEqual 2)
+   push X
+   ld X (E CDR)  # X on args
+   ld E (X)
+   eval  # Eval first arg
+   link
+   push E  # <L I> Safe
+   link
+   do
+      ld X (X CDR)  # More args?
+      atom X
+   while z  # Yes
+      ld E (X)
+      eval  # Eval next arg
+      ld A (L I)  # Get first arg
+      call equalAE_F  # Equal to previous?
+      if ne  # No
+         drop
+         ld E TSym  # Return T
+         pop X
+         ret
+      end
+   loop
+   drop
+   ld E Nil  # Return NIL
+   pop X
+   ret
+
+# (=0 'any) -> 0 | NIL
+(code 'doEq0 2)
+   ld E ((E CDR))  # Get arg
+   eval  # Eval it
+   cmp E ZERO  # Zero?
+   jne retNil  # No
+   ret
+
+# (=T 'any) -> flg
+(code 'doEqT 2)
+   ld E ((E CDR))  # Get arg
+   eval  # Eval it
+   cmp E TSym  # T?
+   jne retNil  # No
+   ret
+
+# (n0 'any) -> flg
+(code 'doNEq0 2)
+   ld E ((E CDR))  # Get arg
+   eval  # Eval it
+   cmp E ZERO  # Zero?
+   jne retT  # No
+   ld E Nil
+   ret
+
+# (nT 'any) -> flg
+(code 'doNEqT 2)
+   ld E ((E CDR))  # Get arg
+   eval  # Eval it
+   cmp E TSym  # T?
+   jne retT  # No
+   ld E Nil
+   ret
+
+# (< 'any ..) -> flg
+(code 'doLt 2)
+   push X
+   ld X (E CDR)  # X on args
+   ld E (X)
+   eval  # Eval first arg
+   link
+   push E  # <L I> Safe
+   link
+   do
+      ld X (X CDR)  # More args?
+      atom X
+   while z  # Yes
+      ld E (X)
+      eval  # Eval next arg
+      ld A (L I)  # Get previous arg
+      ld (L I) E  # Store current
+      call compareAE_F  # Compare current with previous
+      if ge  # Not greater or equal
+         drop
+         ld E Nil  # Return NIL
+         pop X
+         ret
+      end
+   loop
+   drop
+   ld E TSym  # Return T
+   pop X
+   ret
+
+# (<= 'any ..) -> flg
+(code 'doLe 2)
+   push X
+   ld X (E CDR)  # X on args
+   ld E (X)
+   eval  # Eval first arg
+   link
+   push E  # <L I> Safe
+   link
+   do
+      ld X (X CDR)  # More args?
+      atom X
+   while z  # Yes
+      ld E (X)
+      eval  # Eval next arg
+      ld A (L I)  # Get previous arg
+      ld (L I) E  # Store current
+      call compareAE_F  # Compare current with previous
+      if gt  # Not greater or equal
+         drop
+         ld E Nil  # Return NIL
+         pop X
+         ret
+      end
+   loop
+   drop
+   ld E TSym  # Return T
+   pop X
+   ret
+
+# (> 'any ..) -> flg
+(code 'doGt 2)
+   push X
+   ld X (E CDR)  # X on args
+   ld E (X)
+   eval  # Eval first arg
+   link
+   push E  # <L I> Safe
+   link
+   do
+      ld X (X CDR)  # More args?
+      atom X
+   while z  # Yes
+      ld E (X)
+      eval  # Eval next arg
+      ld A (L I)  # Get previous arg
+      ld (L I) E  # Store current
+      call compareAE_F  # Compare current with previous
+      if le  # Not greater or equal
+         drop
+         ld E Nil  # Return NIL
+         pop X
+         ret
+      end
+   loop
+   drop
+   ld E TSym  # Return T
+   pop X
+   ret
+
+# (>= 'any ..) -> flg
+(code 'doGe 2)
+   push X
+   ld X (E CDR)  # X on args
+   ld E (X)
+   eval  # Eval first arg
+   link
+   push E  # <L I> Safe
+   link
+   do
+      ld X (X CDR)  # More args?
+      atom X
+   while z  # Yes
+      ld E (X)
+      eval  # Eval next arg
+      ld A (L I)  # Get previous arg
+      ld (L I) E  # Store current
+      call compareAE_F  # Compare current with previous
+      if lt  # Not greater or equal
+         drop
+         ld E Nil  # Return NIL
+         pop X
+         ret
+      end
+   loop
+   drop
+   ld E TSym  # Return T
+   pop X
+   ret
+
+# (max 'any ..) -> any
+(code 'doMax 2)
+   push X
+   push Y
+   ld X (E CDR)  # X on args
+   ld E (X)
+   eval  # Eval first arg
+   link
+   push E  # <L I> Result
+   link
+   do
+      ld X (X CDR)  # More args?
+      atom X
+   while z  # Yes
+      ld E (X)
+      eval  # Eval next arg
+      ld A (L I)  # Get result
+      ld Y E  # Save next arg
+      call compareAE_F  # Compare arg with result
+      if lt  # Result is less than
+         ld (L I) Y  # Set new result
+      end
+   loop
+   ld E (L I)  # Result
+   drop
+   pop Y
+   pop X
+   ret
+
+# (min 'any ..) -> any
+(code 'doMin 2)
+   push X
+   push Y
+   ld X (E CDR)  # X on args
+   ld E (X)
+   eval  # Eval first arg
+   link
+   push E  # <L I> Result
+   link
+   do
+      ld X (X CDR)  # More args?
+      atom X
+   while z  # Yes
+      ld E (X)
+      eval  # Eval next arg
+      ld A (L I)  # Get result
+      ld Y E  # Save next arg
+      call compareAE_F  # Compare arg with result
+      if gt  # Result is greater
+         ld (L I) Y  # Set new result
+      end
+   loop
+   ld E (L I)  # Result
+   drop
+   pop Y
+   pop X
+   ret
+
+# (atom 'any) -> flg
+(code 'doAtom 2)
+   ld E ((E CDR))  # Get arg
+   eval  # Eval it
+   atom E  # Atom?
+   jnz retT  # Yes
+   ld E Nil
+   ret
+
+# (pair 'any) -> any
+(code 'doPair 2)
+   ld E ((E CDR))  # Get arg
+   eval  # Eval it
+   atom E  # Atom?
+   jnz retNil  # Yes
+   ret
+
+# (lst? 'any) -> flg
+(code 'doLstQ 2)
+   ld E ((E CDR))  # Get arg
+   eval  # Eval it
+   atom E  # Pair?
+   jz retT  # Yes
+   cmp E Nil  # NIL?
+   jeq retT  # Yes
+   ld E Nil
+   ret
+
+# (num? 'any) -> num | NIL
+(code 'doNumQ 2)
+   ld E ((E CDR))  # Get arg
+   eval  # Eval it
+   num E  # Number?
+   jz retNil  # No
+   ret
+
+# (sym? 'any) -> flg
+(code 'doSymQ 2)
+   ld E ((E CDR))  # Get arg
+   eval  # Eval it
+   num E  # Number?
+   jnz retNil  # Yes
+   sym E  # Symbol?
+   jnz retT  # Yes
+   ld E Nil
+   ret
+
+# (flg? 'any) -> flg
+(code 'doFlgQ 2)
+   ld E ((E CDR))  # Get arg
+   eval  # Eval it
+   cmp E Nil  # NIL?
+   jeq retT  # Yes
+   cmp E TSym  # T?
+   jne retNil  # No
+   ret
+
+# (member 'any 'lst) -> any
+(code 'doMember 2)
+   push X
+   push Y
+   ld X (E CDR)  # Args
+   ld E (X)  # Eval 'any'
+   eval
+   link
+   push E  # <L I> 'any'
+   link
+   ld E ((X CDR))  # Eval 'lst'
+   eval
+   ld X (L I)  # Retrieve 'any'
+   ld Y E  # Get 'lst
+   call memberXY_FY  # Member?
+   ld E Y
+   ldnz E Nil  # No
+   drop
+   pop Y
+   pop X
+   ret
+
+# (memq 'any 'lst) -> any
+(code 'doMemq 2)
+   push X
+   ld X (E CDR)  # Args
+   ld E (X)  # Eval 'any'
+   eval
+   link
+   push E  # <L I> 'any'
+   link
+   ld E ((X CDR))  # Eval 'lst'
+   eval
+   ld A (L I)  # Retrieve 'any'
+   drop  # Clean up
+   pop X
+   ld C E  # Keep head in C
+   do
+      atom E  # List?
+   while z  # Yes
+      cmp A (E)  # Member?
+      jeq ret  # Return list
+      ld E (E CDR)  # Next item
+      cmp C E  # Hit head?
+      jeq retNil  # Yes
+   loop
+   cmp A E  # Same atoms?
+   jne retNil  # No
+   ret
+
+# (mmeq 'lst 'lst) -> any
+(code 'doMmeq 2)
+   push X
+   ld X (E CDR)  # Args
+   ld E (X)  # Eval first
+   eval
+   link
+   push E  # <L I> 'lst'
+   link
+   ld E ((X CDR))  # Eval second
+   eval
+   ld X (L I)  # Retrieve first list
+   ld C E  # Keep second in C
+   do
+      atom X  # Done?
+   while z  # No
+      ld A (X)  # Next item from first
+      do
+         atom E  # List?
+      while z  # Yes
+         cmp A (E)  # Member?
+         jeq 20  # Return list
+         ld E (E CDR)  # Next item
+         cmp C E  # Hit head?
+         jz 10  # Yes
+      loop
+      cmp A E  # Same atoms?
+      jeq 20  # Yes
+      ld X (X CDR)  # Get CDR of first
+      ld E C  # Get second arg again
+   loop
+10 ld E Nil  # Return NIL
+20 drop
+   pop X
+   ret
+
+# (sect 'lst 'lst) -> lst
+(code 'doSect 2)
+   push X
+   push Y
+   push Z
+   ld X (E CDR)  # Args
+   ld E (X)  # Eval first
+   eval
+   link
+   push E  # <L III> First 'lst'
+   ld E ((X CDR))  # Eval second arg
+   eval+
+   push E  # <L II> Second 'lst'
+   push Nil  # <L I> Result
+   link
+   ld Z 0  # Empty result cell
+   ld X (L III)  # Get first list
+   do
+      atom X  # Done?
+   while z  # No
+      ld X (X)  # CAR of first
+      ld Y (L II)  # Second
+      call memberXY_FY  # Member?
+      if eq  # Yes
+         null Z  # Result still empty?
+         if z  # Yes
+            call cons_Z  # Build first cell
+            ld (Z) X
+            ld (Z CDR) Nil
+            ld (L I) Z  # Store in result
+         else
+            call cons_A  # Build next cell
+            ld (A) X
+            ld (A CDR) Nil
+            ld (Z CDR) A  # Concat to result
+            ld Z A
+         end
+      end
+      ld X ((L III) CDR)  # Next item in first
+      ld (L III) X
+   loop
+   ld E (L I)  # Get result
+   drop
+   pop Z
+   pop Y
+   pop X
+   ret
+
+# (diff 'lst 'lst) -> lst
+(code 'doDiff 2)
+   push X
+   push Y
+   push Z
+   ld X (E CDR)  # Args
+   ld E (X)  # Eval first
+   eval
+   link
+   push E  # <L III> First 'lst'
+   ld E ((X CDR))  # Eval second arg
+   eval+
+   push E  # <L II> Second 'lst'
+   push Nil  # <L I> Result
+   link
+   ld Z 0  # Empty result cell
+   ld X (L III)  # Get first list
+   do
+      atom X  # Done?
+   while z  # No
+      ld X (X)  # CAR of first
+      ld Y (L II)  # Second
+      call memberXY_FY  # Member?
+      if ne  # No
+         null Z  # Result still empty?
+         if z  # Yes
+            call cons_Z  # Build first cell
+            ld (Z) X
+            ld (Z CDR) Nil
+            ld (L I) Z  # Store in result
+         else
+            call cons_A  # Build next cell
+            ld (A) X
+            ld (A CDR) Nil
+            ld (Z CDR) A  # Concat to result
+            ld Z A
+         end
+      end
+      ld X ((L III) CDR)  # Next item in first
+      ld (L III) X
+   loop
+   ld E (L I)  # Get result
+   drop
+   pop Z
+   pop Y
+   pop X
+   ret
+
+# (index 'any 'lst) -> cnt | NIL
+(code 'doIndex 2)
+   push X
+   push Y
+   push Z
+   ld X (E CDR)  # Args
+   ld E (X)  # Eval first
+   eval
+   link
+   push E  # <L I> 'any'
+   link
+   ld E ((X CDR))  # Eval second
+   eval
+   ld X (L I)  # Get 'any'
+   ld Y E  # and 'lst'
+   ld Z Y  # Keep head in Z
+   ld C 1  # Count in C
+   do
+      atom Y  # List?
+   while z  # Yes
+      ld A X
+      ld E (Y)
+      call equalAE_F  # Found item?
+      if eq  # Yes
+         ld E C  # Get result
+         shl E 4  # Make short number
+         or E CNT
+         jmp 90  # Found
+      end
+      add C 1  # Increment result
+      ld Y (Y CDR)  # Next item
+      cmp Z Y  # Hit head?
+   until eq  # Yes
+   ld E Nil  # Not found
+90 drop
+   pop Z
+   pop Y
+   pop X
+   ret
+
+# (offset 'lst1 'lst2) -> cnt | NIL
+(code 'doOffset 2)
+   push X
+   ld X (E CDR)  # Args
+   ld E (X)  # Eval first
+   eval
+   link
+   push E  # <L I> 'any'
+   link
+   ld E ((X CDR))  # Eval second
+   eval
+   ld C 0  # Init result
+   ld X (L I)  # Get 'lst1'
+   do
+      atom E  # Any?
+   while z  # Yes
+      add C 1  # Increment result
+      ld A X  # Get 'lst1'
+      push E
+      call equalAE_F  # Same rest?
+      if eq  # Yes
+         ld E C  # Get result
+         shl E 4  # Make short number
+         or E CNT
+         drop
+         pop X
+         ret
+      end
+      pop E
+      ld E (E CDR)
+   loop
+   ld E Nil
+   drop
+   pop X
+   ret
+
+# (length 'any) -> cnt | T
+(code 'doLength 2)
+   ld E (E CDR)  # Get arg
+   ld E (E)
+   eval  # Eval it
+   num E  # Number?
+   if nz  # Yes
+      ld A -2  # Scale
+      jmp fmtNum0AE_E  # Calculate length
+   end
+   sym E  # Symbol?
+   if z  # No (list)
+      push X
+      push Y
+      ld X E  # List in X
+      ld E ONE  # Counter
+      do
+         cmp X Quote
+      while eq
+         ld Y (X CDR)  # Next cell
+         cmp Y X  # Circular?
+         jz lengthT  # Yes
+         ld X Y
+         atom X  # Done?
+         jnz 10  # Yes
+         add E (hex "10")  # Increment counter
+      loop
+      ld Y X  # Keep list head
+      do
+         ld X (X CDR)  # Next cell
+         atom X  # Any?
+      while z  # Yes
+         cmp X Y  # Hit head?
+         jz lengthT  # Yes
+         add E (hex "10")  # Increment counter
+      loop
+10    pop Y
+      pop X
+      ret
+   end
+   # Symbol
+   cmp E Nil  # NIL?
+   if eq  # Yes
+      ld E ZERO
+      ret
+   end
+   push X
+   ld X (E TAIL)
+   call nameX_X  # Get name
+   ld C 0
+   ld E ZERO  # Counter
+   do
+      call symCharCX_FACX  # Next char
+   while nz
+      add E (hex "10")  # Increment counter
+   loop
+   pop X
+   ret
+
+: lengthT
+   ld E TSym  # Return T
+   pop Y
+   pop X
+   ret
+
+# (size 'any) -> cnt
+(code 'doSize 2)
+   push X
+   ld X E
+   ld E ((E CDR))  # E on arg
+   eval  # Eval 'any'
+   num E  # Number?
+   if nz  # Yes
+      cnt E  # Short number?
+      if nz  # Yes
+         ld C ONE  # Init counter
+         shr E 3  # Normalize short, keep sign bit
+         do
+            shr E 8  # More bytes?
+         while nz  # Yes
+            add C (hex "10")  # Increment count
+         loop
+      else  # Big number
+         ld C (hex "82")  # Count '8' significant bytes
+         do
+            ld A (E DIG)  # Keep digit
+            ld E (E BIG)  # More cells?
+            cnt E
+         while z  # Yes
+            add C (hex "80")  # Increment count by '8'
+         loop
+         shr E 4  # Normalize short
+         shl A 1  # Get most significant bit of last digit
+         addc E E  # Any significant bits in short number?
+         if nz  # Yes
+            do
+               add C (hex "10")  # Increment count
+               shr E 8  # More bytes?
+            until z  # No
+         end
+      end
+   else
+      sym E  # List?
+      if z  # Yes
+         ld C ZERO  # Init count
+         call sizeCE_C  # Count cell structures
+      else  # Symbol
+         cmp E Nil  # NIL?
+         if eq  # Yes
+            ld C ZERO  # Return zero
+         else
+            sym (E TAIL)  # External symbol?
+            if nz  # Yes
+               push Z
+               call dbFetchEX
+               ld X (E)  # Get value
+               call dbSizeX_A  # Calculate size
+               add A (+ BLK 1)  # plus block overhead
+               ld Z A  # Count in Z
+               ld E (E TAIL)  # Get properties
+               off E SYM  # Clear 'extern' tag
+               do
+                  atom E  # More properties?
+               while z  # Yes
+                  ld X (E)  # Next property
+                  ld E (E CDR)
+                  atom X  # Flag?
+                  if nz  # Yes
+                     call dbSizeX_A  # Flag's size
+                     add Z A  # Add to count
+                     add Z 2  # Plus 2
+                  else
+                     push (X)  # Save value
+                     ld X (X CDR)  # Get key
+                     call dbSizeX_A  # Calculate size
+                     add Z A  # Add to count
+                     pop X  # Retrieve value
+                     call dbSizeX_A  # Calculate size
+                     add Z A  # Add to count
+                  end
+               loop
+               ld C Z  # Get count
+               shl C 4  # Make short number
+               or C CNT
+               pop Z
+            else
+               ld E (E TAIL)
+               call nameE_E  # Get name
+               zero E  # Any?
+               if eq  # No
+                  ld C ZERO  # Return zero
+               else
+                  cnt E  # Short name?
+                  if nz  # Yes
+                     ld C ONE  # Init counter
+                     shr E 4  # Normalize
+                     do
+                        shr E 8  # More bytes?
+                     while nz  # Yes
+                        add C (hex "10")  # Increment count
+                     loop
+                  else  # Long name
+                     ld C (hex "82")  # Count '8' significant bytes
+                     do
+                        ld E (E BIG)  # More cells?
+                        cnt E
+                     while z  # Yes
+                        add C (hex "80")  # Increment count
+                     loop
+                     shr E 4  # Any significant bits in short name?
+                     if nz  # Yes
+                        do
+                           add C (hex "10")  # Increment count
+                           shr E 8  # More bytes?
+                        until z  # No
+                     end
+                  end
+               end
+            end
+         end
+      end
+   end
+   ld E C  # Get count
+   pop X
+   ret
+
+(code 'sizeCE_C 0)
+   add C (hex "10")  # Increment count
+   do
+      cmp (E) Quote  # CAR is 'quote'?
+   while eq  # Yes
+      cmp E (E CDR)  # Circular?
+      jeq ret  # Yes
+      ld E (E CDR)  # More cells?
+      atom E
+      jnz ret  # No
+      add C (hex "10")  # Increment count
+   loop
+   push X
+   ld X E  # Keep head in X
+   do
+      atom (E)  # Is CAR a cell?
+      if z  # Yes
+         push E
+         ld E (E)  # Count CAR
+         call sizeCE_C
+         pop E
+      end
+      ld E (E CDR)  # More cells?
+      atom E
+   while z  # Yes
+      cmp E X  # Circular?
+   while ne  # No
+      add C (hex "10")  # Increment count
+   loop
+   pop X
+   ret
+
+# (assoc 'any 'lst) -> lst
+(code 'doAssoc 2)
+   push X
+   ld X (E CDR)  # Args
+   ld E (X)  # Eval 'any'
+   eval
+   link
+   push E  # <L I> 'any'
+   link
+   ld E ((X CDR))  # Eval 'lst'
+   eval
+   ld X E  # into X
+   do  # assoc
+      atom X  # Done?
+      if z  # No
+         atom (X)  # CAR atomic?
+         if z  # No
+            ld A (L I)  # Retrieve 'any'
+            ld E ((X))  # and CAAR
+            call equalAE_F  # Found?
+            break eq  # Yes
+         end
+         ld X (X CDR)  # Next
+      else
+         ld E Nil  # Return NIL
+         drop
+         pop X
+         ret
+      end
+   loop
+   ld E (X)  # Return CAR
+   drop
+   pop X
+   ret
+
+# (asoq 'any 'lst) -> lst
+(code 'doAsoq 2)
+   push X
+   ld X (E CDR)  # Args
+   ld E (X)  # Eval 'any'
+   eval
+   link
+   push E  # <L I> 'any'
+   link
+   ld E ((X CDR))  # Eval 'lst'
+   eval
+   ld A (L I)  # Retrieve 'any'
+   drop  # Clean up
+   pop X
+   do  # asoq
+      atom E  # Done?
+      jnz retNil  # Yes
+      ld C (E)  # Get CAR
+      atom C  # Atomic?
+      if z  # No
+         cmp A (C)  # Found?
+         break eq  # Yes
+      end
+      ld E (E CDR)  # Next
+   loop
+   ld E C  # Return CAR
+   ret
+
+# (rank 'any 'lst ['flg]) -> lst
+(code 'doRank 2)
+   push X
+   push Y
+   push Z
+   ld X (E CDR)  # Args
+   ld E (X)  # Eval first
+   eval
+   link
+   push E  # <L II> 'any'
+   ld X (X CDR)
+   ld E (X)  # Eval next
+   eval+
+   push E  # <L I> 'lst'
+   link
+   ld E ((X CDR))  # Eval 'flg'
+   eval
+   ld X (L I)  # Get 'lst' in X
+   atom X  # Empty?
+   if z  # No
+      ld Z 0  # Calculate length in Z
+      ld Y X
+      do
+         add Z 1  # Increment length
+         ld Y (Y CDR)  # Next cell?
+         atom Y
+      until nz  # No
+      ld A ((X))  # First CAAR
+      cmp E Nil  # 'flg'?
+      if eq  # No
+         ld E (L II)  # Compare CAAR with 'any'
+         call compareAE_F
+         jgt 10  # Return NIL if too big
+         do
+            ld C Z  # Length
+            shr C 1  # One?
+         while nz  # No
+            ld Y X  # Offset Y
+            do
+               ld Y (Y CDR)
+               sub C 1
+            until z
+            ld A ((Y))  # Compare CAAR
+            ld E (L II)  # with 'any'
+            call compareAE_F  # Greater?
+            if gt  # Search left half
+               ld Y X  # Move right pointer back
+               shr Z 1  # Half length
+            else  # Search right half
+               ld X Y  # Move left pointer to offset
+               ld C Z
+               shr C 1  # Set length to remainder
+               sub Z C
+            end
+         loop
+      else
+         ld E (L II)  # Compare CAAR with 'any'
+         call compareAE_F
+         jlt 10  # Return NIL if too small
+         do
+            ld C Z  # Length
+            shr C 1  # One?
+         while nz  # No
+            ld Y X  # Offset Y
+            do
+               ld Y (Y CDR)
+               sub C 1
+            until z
+            ld A ((Y))  # Compare CAAR
+            ld E (L II)  # with 'any'
+            call compareAE_F  # Smaller?
+            if lt  # Search left half
+               ld Y X  # Move right pointer back
+               shr Z 1  # Half length
+            else  # Search right half
+               ld X Y  # Move left pointer to offset
+               ld C Z
+               shr C 1  # Set length to remainder
+               sub Z C
+            end
+         loop
+      end
+      ld E (X)  # Return CAR
+   else
+10    ld E Nil
+   end
+   drop
+   pop Z
+   pop Y
+   pop X
+   ret
+
+# (match 'lst1 'lst2) -> flg
+(code 'doMatch 2)
+   push X
+   ld X (E CDR)  # Args
+   ld E (X)  # Eval 'lst1'
+   eval
+   link
+   push E  # <L II> Pattern
+   ld E ((X CDR))  # Eval 'lst2'
+   eval+
+   push E  # <L I> Data
+   link
+   ld C (L II)  # Pattern
+   call matchCE_F  # Match with data?
+   ld E TSym  # Yes
+   ldnz E Nil  # No
+   drop
+   pop X
+   ret
+
+: matchCE_F
+   do
+      atom C  # Pattern atomic?
+      if nz  # Yes
+         num C  # Symbol?
+         if z  # Yes
+            ld A (C TAIL)
+            call firstByteA_B  # starting with "@"?
+            cmp B (char "@")
+            if eq  # Yes
+               ld (C) E  # Set value to matched data
+               ret  # Return 'z'
+            end
+         end
+         ld A C  # Check if equal
+         jmp equalAE_F
+      end
+      ld X (C)  # CAR of pattern
+      num X
+      if z
+         sym X  # Symbolic?
+         if nz  # Yes
+            ld A (X TAIL)
+            call firstByteA_B  # starting with "@"?
+            cmp B (char "@")
+            if eq  # Yes
+               atom E  # Data atomic?
+               if nz  # Yes
+                  ld A (C CDR)  # CDR of pattern equal to data?
+                  call equalAE_F
+                  jnz ret  # No
+                  ld (X) Nil  # Else clear value
+                  ret  # Return 'z'
+               end
+               push C  # Save pattern
+               push E  # and Data
+               ld C (C CDR)  # Get CDRs
+               ld E (E CDR)
+               call matchCE_F  # Match?
+               pop E
+               pop C
+               if eq  # Yes
+                  call cons_A  # Cons CAR of data with NIL
+                  ld (A) (E)
+                  ld (A CDR) Nil
+                  ld ((C)) A  # Set value
+                  jmp retz
+               end
+               push C  # Save pattern
+               push E  # and Data
+               ld C (C CDR)  # CDR of pattern
+               call matchCE_F  # Match with data?
+               pop E
+               pop C
+               if eq  # Yes
+                  ld ((C)) Nil  # Set value to NIL
+                  ret  # Return 'z'
+               end
+               push C  # Save pattern
+               push E  # and Data
+               ld E (E CDR)  # CDR of data
+               call matchCE_F  # Match with pattern?
+               pop E
+               pop C
+               if eq  # Yes
+                  ld X (C)  # Pattern symbol
+                  call cons_A  # Cons CAR of data into value
+                  ld (A) (E)
+                  ld (A CDR) (X)
+                  ld (X) A  # Set value
+                  jmp retz
+               end
+            end
+         end
+      end
+      atom E  # Data atomic?
+      jnz ret  # Yes
+      push (C CDR)  # Save rests
+      push (E CDR)
+      ld C (C)  # Get CARs
+      ld E (E)
+      call matchCE_F  # Match?
+      pop E
+      pop C
+      jnz ret  # No
+   loop
+
+# (fill 'any ['sym|lst]) -> any
+(code 'doFill 2)
+   push X
+   ld X (E CDR)  # Args
+   ld E (X)  # Eval 'any'
+   eval
+   link
+   push E  # <L II> Pattern
+   ld E ((X CDR))  # Eval 'sym|lst'
+   eval+
+   push E  # <L I> 'sym|lst'
+   link
+   ld X E  # in X
+   ld E (L II)  # Fill pattern
+   call fillE_FE
+   drop
+   pop X
+   ret
+
+: fillE_FE
+   num E  # Data numeric?
+   jnz ret  # Return 'nz'
+   sym E  # Data symbolic?
+   if nz  # Yes
+      cmp X Nil  # 'sym|lst'?
+      if eq  # No
+         cmp E At  # '@'?
+         jeq retnz  # Return 'nz'
+         ld A (E TAIL)
+         call firstByteA_B  # starting with "@"?
+         cmp B (char "@")
+         if eq  # Yes
+            ld E (E)  # Return 'z'
+         end
+         ret  # Else 'nz'
+      end
+      ld C X  # 'memq'
+      do
+         atom C  # List?
+      while z  # Yes
+         cmp E (C)  # Member?
+         if eq  # Yes
+            ld E (E)  # Return 'z'
+            ret
+         end
+         ld C (C CDR)  # Next element
+      loop
+      cmp E C  # Same?
+      if eq  # Yes
+         ld E (E)  # Return 'z'
+      end
+      ret  # Else 'nz'
+   end
+   push E  # <S> Save
+   ld E (E)  # Recurse on CAR
+   call fillE_FE  # Modified?
+   if z  # Yes
+      pop C  # Get pattern
+      link
+      push E  # <L I> Modified CAR
+      link
+      ld E (C CDR)  # Recurse on CDR
+      call fillE_FE
+      call consE_A  # Cons result
+      ld (A) (L I)
+      ld (A CDR) E
+      ld E A
+      drop
+      setz  # Modified
+      ret
+   end
+   ld E ((S) CDR)  # Recurse on CDR
+   call fillE_FE  # Modified?
+   if z  # Yes
+      call consE_A  # Cons result
+      pop C
+      ld (A) (C)  # Unmodified CAR
+      ld (A CDR) E  # Modified CDR
+      ld E A
+      setz  # Modified
+      ret
+   end
+   pop E  # Return 'nz'
+   ret
+
+### Declarative Programming ###
+(code 'unifyCEYZ_F 0)
+10 num Y  # x1 symbolic?
+   if z
+      sym Y
+      if nz  # Yes
+         ld A (Y TAIL)  # x1
+         call firstByteA_B  # starting with "@"?
+         cmp B (char "@")
+         if eq  # Yes
+            ld X ((Penv))  # Get pilog environment
+            do
+               ld A (X)  # car(x)
+               atom A  # List?
+            while z  # Yes
+               ld A (A)  # caar(x)
+               cmp C (A)  # n1 == caaar(x)?
+               if eq  # Yes
+                  cmp Y (A CDR)  # x1 == cdaar(x)?
+                  if eq  # Yes
+                     ld A ((X) CDR)
+                     ld C (A)  # n1 = cadar(x)
+                     ld Y (A CDR)  # x1 = cddar(x)
+                     jmp 10
+                  end
+               end
+               ld X (X CDR)
+            loop
+         end
+      end
+   end
+20 num Z  # x2 symbolic?
+   if z
+      sym Z
+      if nz  # Yes
+         ld A (Z TAIL)  # x2
+         call firstByteA_B  # starting with "@"?
+         cmp B (char "@")
+         if eq  # Yes
+            ld X ((Penv))  # Get pilog environment
+            do
+               ld A (X)  # car(x)
+               atom A  # List?
+            while z  # Yes
+               ld A (A)  # caar(x)
+               cmp E (A)  # n2 == caaar(x)?
+               if eq  # Yes
+                  cmp Z (A CDR)  # x2 == cdaar(x)?
+                  if eq  # Yes
+                     ld A ((X) CDR)
+                     ld E (A)  # n2 = cadar(x)
+                     ld Z (A CDR)  # x2 = cddar(x)
+                     jmp 20
+                  end
+               end
+               ld X (X CDR)
+            loop
+         end
+      end
+   end
+   cmp C E  # n1 == n2?
+   if eq  # Yes
+      ld A Y  # x1
+      push E
+      ld E Z  # x2
+      call equalAE_F  # Equal?
+      pop E
+      jeq ret  # Yes
+   end
+   num Y  # x1 symbolic?
+   if z
+      sym Y
+      if nz  # Yes
+         ld A (Y TAIL)  # x1
+         call firstByteA_B  # starting with "@"?
+         cmp B (char "@")
+         if eq  # Yes
+            cmp Y At  # x1 == @?
+            if ne  # No
+               call cons_A  # (n1 . x1)
+               ld (A) C
+               ld (A CDR) Y
+               call consA_C  # (n2 . x2)
+               ld (C) E
+               ld (C CDR) Z
+               call consAC_E  # ((n1 . x1) . (n2 . x2))
+               ld (E) A
+               ld (E CDR) C
+               ld X (Penv)  # Concat to pilog environment
+               call consE_A
+               ld (A) E
+               ld (A CDR) (X)
+               ld (X) A  # Store in environment
+            end
+            setz
+            ret
+         end
+      end
+   end
+   num Z  # x2 symbolic?
+   if z
+      sym Z
+      if nz  # Yes
+         ld A (Z TAIL)  # x2
+         call firstByteA_B  # starting with "@"?
+         cmp B (char "@")
+         if eq  # Yes
+            cmp Z At  # x2 == @?
+            if ne  # No
+               call cons_A  # (n1 . x1)
+               ld (A) C
+               ld (A CDR) Y
+               call consA_C  # (n2 . x2)
+               ld (C) E
+               ld (C CDR) Z
+               call consAC_E  # ((n2 . x2) . (n1 . x1))
+               ld (E CDR) A
+               ld (E) C
+               ld X (Penv)  # Concat to pilog environment
+               call consE_A
+               ld (A) E
+               ld (A CDR) (X)
+               ld (X) A  # Store in environment
+            end
+            setz
+            ret
+         end
+      end
+   end
+   atom Y  # x1 atomic?
+   if z  # No
+      atom Z  # x2 atomic?
+      if z  # No
+         push ((Penv))  # Save pilog environment
+         push C  # and parameters
+         push E
+         push Y
+         push Z
+         ld Y (Y)  # car(x1)
+         ld Z (Z)  # car(x2)
+         call unifyCEYZ_F  # Match?
+         pop Z
+         pop Y
+         pop E
+         pop C
+         if eq  # Yes
+            ld Y (Y CDR)  # cdr(x1)
+            ld Z (Z CDR)  # cdr(x2)
+            call unifyCEYZ_F  # Match?
+            if eq  # Yes
+               pop A  # Drop pilog environment
+               ret  # 'z'
+            end
+         end
+         pop ((Penv))  # Restore pilog environment
+         ret  # nz
+      end
+   end
+   ld A Y  # Compare x1 and x2
+   ld E Z
+   jmp equalAE_F
+
+# (prove 'lst ['lst]) -> lst
+(code 'doProve 2)
+   push X
+   ld X (E CDR)  # Args
+   ld E (X)  # Eval first
+   eval
+   atom E  # Atomic?
+   if nz  # Yes
+      pop X
+      ld E Nil  # Return NIL
+      ret
+   end
+   push Y
+   push Z
+   push (Penv)  # Save pilog environment pointers
+   push (Pnl)
+   link
+   push (At)  # <L (+ IX I)> @
+   push E  # <L IX> q
+   ld Z E  # Keep in Z
+   ld X (X CDR)  # Second arg
+   ld E (X)  # Eval debug list
+   eval+
+   push E  # <L VIII> dbg
+   ld Y ((Z))  # env = caar(q)
+   push Y  # <L VII> env
+   ld (Penv) S  # Set pilog environment pointer
+   ld (Z) ((Z) CDR)  # car(q) = cdar(q)
+   push (Y)  # <L VI> n
+   ld Y (Y CDR)
+   push (Y)  # <L V> nl
+   ld (Pnl) S  # Set pointer
+   ld Y (Y CDR)
+   push (Y)  # <L IV> alt
+   ld Y (Y CDR)
+   push (Y)  # <L III> tp1
+   ld Y (Y CDR)
+   push (Y)  # <L II> tp2
+   ld Y (Y CDR)
+   push Nil  # <L I> e
+   link
+   ld (L VII) Y  # Set env
+   do
+      atom (L III)  # tp1?
+      jz 10  # Yes
+      atom (L II)  # or tp2?
+   while z  # Yes
+10    atom (L IV)  # alt?
+      if z  # Yes
+         ld (L I) (L VII)  # e = env
+         ld C ((L V))  # car(nl)
+         ld Y (((L III)) CDR)  # cdar(tp1)
+         ld E (L VI)  # n
+         ld Z (((L IV)))  # caar(alt)
+         call unifyCEYZ_F  # Match?
+         if ne  # No
+            ld X ((L IV) CDR)  # alt = cdr(alt)
+            ld (L IV) X
+            atom X  # Atomic?
+            if nz  # Yes
+               ld X (((L IX)))  # env = caar(q)
+               ld ((L IX)) (((L IX)) CDR)  # car(q) = cdar(q)
+               ld (L VI) (X)  # n = car(env)
+               ld X (X CDR)  # env = cdr(env)
+               ld (L V) (X)  # nl = car(env)
+               ld X (X CDR)  # env = cdr(env)
+               ld (L IV) (X)  # alt = car(env)
+               ld X (X CDR)  # env = cdr(env)
+               ld (L III) (X)  # tp1 = car(env)
+               ld X (X CDR)  # env = cdr(env)
+               ld (L II) (X)  # tp2 = car(env)
+               ld X (X CDR)  # env = cdr(env)
+               ld (L VII) X  # Set env
+            end
+         else
+            atom (L VIII)  # dbg?
+            if z  # Yes
+               ld A (((L III)))  # memq(caar(tp1), dbg)
+               ld E (L VIII)
+               do
+                  cmp A (E)  # memq?
+                  if eq  # Yes
+                     ld C TSym  # get(caar(tp1), T)
+                     ld E (((L III)))
+                     call getEC_E
+                     ld X E
+                     ld C 0  # Index count
+                     do
+                        add C 1  # Increment
+                        ld A ((L IV))  # Found car(alt)?
+                        ld E (X)
+                        ld X (X CDR)
+                        call equalAE_F
+                     until eq  # Yes
+                     ld A C
+                     call outWordA  # Print level number
+                     call space
+                     ld E ((L III))  # car(tp1)
+                     call uniFillE_E  # Fill with values
+                     call printE  # and print
+                     call newline
+                     break T
+                  end
+                  ld E (E CDR)  # Next debug symbol
+                  atom E  # Any?
+               until nz  # No
+            end
+            atom ((L IV) CDR)  # cdr(alt)?
+            if z  # Yes
+               call cons_A  # cons(tp2, e)
+               ld (A) (L II)
+               ld (A CDR) (L I)
+               call consA_C  # cons(tp1, @)
+               ld (C) (L III)
+               ld (C CDR) A
+               call consC_A  # cons(cdr(alt), @)
+               ld (A) ((L IV) CDR)
+               ld (A CDR) C
+               call consA_C  # cons(nl, @)
+               ld (C) (L V)
+               ld (C CDR) A
+               call consC_A  # cons(n, @)
+               ld (A) (L VI)
+               ld (A CDR) C
+               call consA_C  # cons(@, car(q))
+               ld (C) A
+               ld (C CDR) ((L IX))
+               ld ((L IX)) C  # -> car(q)
+            end
+            ld C (L VI)  # n
+            call cons_A  # cons(n, nl)
+            ld (A) C
+            ld (A CDR) (L V)
+            ld (L V) A  # -> nl
+            add C (hex "10")  # Increment
+            ld (L VI) C  # -> n
+            call cons_A  # cons(cdr(tp1), tp2)
+            ld (A) ((L III) CDR)
+            ld (A CDR) (L II)
+            ld (L II) A  # -> tp2
+            ld (L III) (((L IV)) CDR)  # cdar(alt) -> tp1
+            ld (L IV) Nil  # alt = NIL
+         end
+         continue T
+      end
+      ld X (L III)  # tp1?
+      atom X
+      if nz  # No
+         ld C (L II)  # tp2
+         ld (L III) (C)  # tp1 = car(tp2)
+         ld (L II) (C CDR)  # tp2 = cdr(tp2)
+         ld (L V) ((L V) CDR)  # nl = cdr(nl)
+         continue T
+      end
+      cmp (X) TSym  # car(tp1) == T?
+      if eq
+         do
+            ld C ((L IX))  # car(q)
+            atom C  # Any?
+         while z  # Yes
+            cmp ((C)) ((L V))  # caaar(q) >= car(nl)?
+         while ge  # Yes
+            ld ((L IX)) (C CDR)  # car(q) = cdar(q)
+         loop
+         ld (L III) (X CDR)  # tp1 = cdr(tp1)
+         continue T
+      end
+      num ((X))  # caar(tp1) numeric?
+      if nz  # Yes
+         ld E ((X) CDR)  # Eval cdar(tp1)
+         eval
+         ld (L I) E  # -> e
+         ld C ((X))  # Get count
+         shr C 4  # Normalize short
+         ld A (L V)  # nl
+         do
+            sub C 1  # Decrement
+         while nsz
+            ld A (A CDR)  # Skip
+         loop
+         call cons_C  # cons(car(A), nl)
+         ld (C) (A)
+         ld (C CDR) (L V)
+         ld (L V) C  # -> nl
+         call cons_C  # cons(cdr(tp1), tp2)
+         ld (C) (X CDR)
+         ld (C CDR) (L II)
+         ld (L II) C  # -> tp2
+         ld (L III) (L I)  # tp1 = e
+         continue T
+      end
+      ld E ((X))  # caar(tp1)
+      sym E  # Symbolic?
+      if nz  # Yes
+         ld A (E TAIL)
+         call firstByteA_B  # starting with "@"?
+         cmp B (char "@")
+         if eq  # Yes
+            ld E ((X) CDR)  # Eval cdar(tp1)
+            eval
+            ld (L I) E  # -> e
+            cmp E Nil  # Any?
+            if ne  # Yes
+               ld C ((L V))  # car(nl)
+               ld Y ((X))  # caar(tp1)
+               ld E C  # car(nl)
+               ld Z (L I)  # e
+               call unifyCEYZ_F  # Match?
+               if eq  # Yes
+                  ld (L III) ((L III) CDR)  # tp1 = cdr(tp1)
+                  continue T
+               end
+            end
+            ld X (((L IX)))  # env = caar(q)
+            ld ((L IX)) (((L IX)) CDR)  # car(q) = cdar(q)
+            ld (L VI) (X)  # n = car(env)
+            ld X (X CDR)  # env = cdr(env)
+            ld (L V) (X)  # nl = car(env)
+            ld X (X CDR)  # env = cdr(env)
+            ld (L IV) (X)  # alt = car(env)
+            ld X (X CDR)  # env = cdr(env)
+            ld (L III) (X)  # tp1 = car(env)
+            ld X (X CDR)  # env = cdr(env)
+            ld (L II) (X)  # tp2 = car(env)
+            ld X (X CDR)  # env = cdr(env)
+            ld (L VII) X  # Set env
+            continue T
+         end
+      end
+      ld C TSym  # get(caar(tp1), T)
+      call getEC_E
+      ld (L IV) E  # -> alt
+      atom E  # Atomic?
+      if nz  # Yes
+         ld X (((L IX)))  # env = caar(q)
+         ld ((L IX)) (((L IX)) CDR)  # car(q) = cdar(q)
+         ld (L VI) (X)  # n = car(env)
+         ld X (X CDR)  # env = cdr(env)
+         ld (L V) (X)  # nl = car(env)
+         ld X (X CDR)  # env = cdr(env)
+         ld (L IV) (X)  # alt = car(env)
+         ld X (X CDR)  # env = cdr(env)
+         ld (L III) (X)  # tp1 = car(env)
+         ld X (X CDR)  # env = cdr(env)
+         ld (L II) (X)  # tp2 = car(env)
+         ld X (X CDR)  # env = cdr(env)
+         ld (L VII) X  # Set env
+      end
+   loop
+   ld (L I) Nil  # e = NIL
+   ld X (L VII)  # env
+   do
+      atom (X CDR)
+   while z
+      ld Y ((X))  # Next binding
+      cmp (Y) ZERO  # Top?
+      if eq  # Yes
+         ld C ZERO  # Look up
+         ld E (Y CDR)
+         call lookupCE_E
+         call consE_A  # Cons with variable
+         ld (A) (Y CDR)
+         ld (A CDR) E
+         call consA_E  # and e
+         ld (E) A
+         ld (E CDR) (L I)
+         ld (L I) E  # -> e
+      end
+      ld X (X CDR)
+   loop
+   ld (At) (L (+ IX I))  # Restore '@'
+   ld E (L I)  # Get e
+   atom E  # Atomic?
+   if nz  # Yes
+      atom (L VII)  # 'env' atomic?
+      ld E Nil
+      ldz E TSym  # No
+   end
+   drop
+   pop (Pnl)  # Restore pilog environment pointers
+   pop (Penv)
+   pop Z
+   pop Y
+   pop X
+   ret
+
+(code 'lupCE_E 0)  # Z
+   num E  # x symbolic?
+   if z
+      sym E
+      if nz  # Yes
+         ld A (E TAIL)  # x
+         call firstByteA_B  # starting with "@"?
+         cmp B (char "@")
+         if eq  # Yes
+            ld Z ((Penv))  # Get pilog environment
+            do
+               ld A (Z)  # car(y)
+               atom A  # List?
+            while z  # Yes
+               ld A (A)  # caar(y)
+               cmp C (A)  # n == caaar(y)?
+               if eq  # Yes
+                  cmp E (A CDR)  # x == cdaar(y)?
+                  if eq  # Yes
+                     ld A ((Z) CDR)
+                     ld C (A)  # n = cadar(y)
+                     ld E (A CDR)  # x = cddar(y)
+                     jmp lupCE_E
+                  end
+               end
+               ld Z (Z CDR)
+            loop
+         end
+      end
+   end
+   atom E  # Atomic?
+   if z  # No
+      push C  # Save parameters
+      push E
+      ld E (E)  # lup(n, car(x))
+      call lupCE_E
+      pop A
+      pop C
+      link
+      push E  # Save
+      link
+      ld E (A CDR)  # lup(n, cdr(x))
+      call lupCE_E
+      call consE_A  # Cons
+      ld (A) (L I)
+      ld (A CDR) E
+      ld E A
+      drop
+   end
+   ret
+
+(code 'lookupCE_E 0)  # Z
+   call lupCE_E
+   num E  # Symbolic?
+   if z
+      sym E
+      if nz  # Yes
+         ld A (E TAIL)
+         call firstByteA_B  # starting with "@"?
+         cmp B (char "@")
+         jeq  retNil # Yes
+      end
+   end
+   ret
+
+(code 'uniFillE_E 0)
+   num E  # Number?
+   if z  # No
+      sym E  # Symbol?
+      if nz  # Yes
+         ld C (((Pnl)))  # Get Env
+         jmp lupCE_E  # Look up
+      end
+      push E  # Save list
+      ld E (E)  # Recurse on CAR
+      call uniFillE_E
+      pop A  # Get list
+      link
+      push E  # Save result
+      link
+      ld E (A CDR)  # Recurse on CDR
+      call uniFillE_E
+      call consE_A  # Return cell
+      ld (A) (L I)
+      ld (A CDR) E
+      ld E A
+      drop
+   end
+   ret
+
+# (-> sym [num]) -> any
+(code 'doArrow 2)
+   push Z
+   ld E (E CDR)  # E on args
+   ld C ((Pnl))  # Environments
+   ld A (E CDR)
+   num (A)  # 'num' arg?
+   if nz  # Yes
+      ld A (A)  # Get count
+      shr A 4  # Normalize short
+      do
+         sub A 1  # Decrement
+      while nsz
+         ld C (C CDR)  # Skip
+      loop
+   end
+   ld C (C)  # Get env
+   ld E (E)  # 'sym'
+   call lookupCE_E
+   pop Z
+   ret
+
+# (unify 'any) -> lst
+(code 'doUnify 2)
+   push X
+   push Y
+   push Z
+   ld E ((E CDR))  # Get arg
+   eval  # Eval it
+   link
+   push E  # Save 'any'
+   link
+   ld A ((Pnl))  # Environments
+   ld C ((A CDR))  # Second environment
+   ld E (A)  # First environment
+   ld Y (L I)  # 'any'
+   ld Z Y  # 'any'
+   call unifyCEYZ_F  # Match?
+   ld E Nil
+   if eq  # Yes
+      ld E ((Penv))
+   end
+   drop
+   pop Z
+   pop Y
+   pop X
+   ret
+
+## List Merge Sort: Bill McDaniel, DDJ Jun99 ###
+# (sort 'lst ['fun]) -> lst
+(code 'doSort 2)
+   push X
+   push Y
+   ld X E
+   ld Y (E CDR)  # Y on args
+   ld E (Y)  # Eval 'lst'
+   eval
+   atom E  # List?
+   if z  # Yes
+      push Z
+      push (EnvSort)  # Save sort function
+      link
+      push E  # Save 'lst'
+      ld E ((Y CDR))  # Eval 'fun'
+      eval+
+      ld A Nil  # Init local elements
+      cmp E Nil  # User function?
+      if eq  # No
+         ld (EnvSort) cmpDfltA_F  # Use default sort function
+         xchg E (S)  # <L VII> out[1]
+      else
+         ld (EnvSort) cmpUserAX_F  # Use user supplied sort function
+         xchg E (S)  # 'fun'
+         push A
+         push A  # <L VIII> Apply args
+         push A  # <L VII>  out[1]
+      end
+      push E  # <L VI>  out[0] 'lst'
+      push A  # <L V>   in[1]
+      push A  # <L IV>  in[0]
+      push A  # <L III> last[1]
+      push A  # <L II>  last[0]
+      push A  # <L I>   p
+      link
+      push A  # <L -I> tail[1]
+      push A  # <L -II> tail[0]
+      do
+         ld (L IV) (L VI)  # in[0] = out[0]
+         ld (L V) (L VII)  # in[1] = out[1]
+         lea Y (L IV)  # &in[0]
+         atom (L V)  # in[1] list?
+         if z  # Yes
+            ld A Y  # in
+            call (EnvSort)  # Less?
+            if ge  # No
+               lea Y (L V)  # &in[1]
+            end
+         end
+         ld A (Y)  # p = in[i]
+         ld (L I) A
+         atom A  # List?
+         if z  # Yes
+            ld (Y) (A CDR)  # in[i] = cdr(in[i])
+         end
+         ld (L VI) A  # out[0] = p
+         lea (L -II) (A CDR)  # tail[0] = &cdr(p)
+         ld (L III) (L VI)  # last[1] = out[0]
+         ld (A CDR) Nil  # cdr(p) = Nil
+         ld (L VII) Nil  # out[1] = Nil
+         lea (L -I) (L VII)  # tail[1] = &out[1]
+         do
+            atom (L V)  # in[1] atomic?
+            if nz  # Yes
+               atom (L IV)  # in[0] also atomic?
+               break nz  # Yes
+               ld Y (L IV)  # p = in[0]
+               ld (L I) Y
+               atom Y  # List?
+               if z  # Yes
+                  ld (L IV) (Y CDR)  # in[0] = cdr(in[0])
+               end
+               ld (L II) Y  # last[0] = p
+               lea A (L II)  # last
+               call (EnvSort)  # Less?
+               if lt  # Yes
+                  xchg (L -I) (L -II)  # Exchange tail[0] and tail[1]
+               end
+            else
+               atom (L IV)  # in[0] atomic?
+               if nz  # Yes
+                  atom (L V)  # in[1] also atomic?
+                  break nz  # Yes
+                  ld Y (L V)  # p = in[1]
+                  ld (L I) Y
+                  ld (L II) Y  # last[0] = p
+                  ld (L V) (Y CDR)  # in[1] = cdr(in[1])
+                  lea A (L II)  # last
+                  call (EnvSort)  # Less?
+                  if lt  # Yes
+                     xchg (L -I) (L -II)  # Exchange tail[0] and tail[1]
+                  end
+               else  # Both in[0] and in[1] are lists
+                  lea A (L II)  # last
+                  ld (A) (L IV)  # last[0] = in[0]
+                  call (EnvSort)  # Less?
+                  if lt  # Yes
+                     lea A (L II)  # last
+                     ld (A) (L V)  # last[0] = in[1]
+                     call (EnvSort)  # Less?
+                     if ge  # No
+                        ld Y (L V)  # p = in[1]
+                        ld (L I) Y
+                        ld (L V) (Y CDR)  # in[1] = cdr(in[1])
+                     else
+                        lea A (L IV)  # in
+                        call (EnvSort)  # Less?
+                        if lt  # Yes
+                           ld Y (L IV)  # p = in[0]
+                           ld (L I) Y
+                           ld (L IV) (Y CDR)  # in[0] = cdr(in[0])
+                        else
+                           ld Y (L V)  # p = in[1]
+                           ld (L I) Y
+                           ld (L V) (Y CDR)  # in[1] = cdr(in[1])
+                        end
+                        xchg (L -I) (L -II)  # Exchange tail[0] and tail[1]
+                     end
+                  else
+                     lea A (L II)  # last
+                     ld (A) (L V)  # last[0] = in[1]
+                     call (EnvSort)  # Less?
+                     if lt  # Yes
+                        ld Y (L IV)  # p = in[0]
+                        ld (L I) Y
+                        ld (L IV) (Y CDR)  # in[0] = cdr(in[0])
+                     else
+                        lea A (L IV)  # in
+                        call (EnvSort)  # Less?
+                        if lt  # Yes
+                           ld Y (L IV)  # p = in[0]
+                           ld (L I) Y
+                           ld (L IV) (Y CDR)  # in[0] = cdr(in[0])
+                        else
+                           ld Y (L V)  # p = in[1]
+                           ld (L I) Y
+                           ld (L V) (Y CDR)  # in[1] = cdr(in[1])
+                        end
+                     end
+                  end
+               end
+            end
+            ld ((L -II)) Y  # *tail[0] = p
+            lea (L -II) (Y CDR)  # tail[0] = &cdr(p)
+            ld (Y CDR) Nil  # cdr(p) = Nil
+            ld (L III) Y  # last[1] = p
+         loop
+         atom (L VII)  # out[1]
+      until nz
+      ld E (L VI)  # Return out[0]
+      drop
+      pop (EnvSort)
+      pop Z
+   end
+   pop Y
+   pop X
+   ret
+
+(code 'cmpDfltA_F 0)
+   ld E ((A I))  # Get CAR of second item
+   ld A ((A))  # and CAR of first item
+   jmp compareAE_F  # Build-in compare function
+
+(code 'cmpUserAX_F 0)
+   push Y
+   lea Z (L VIII)  # Point Z to apply args
+   ld (Z) ((A I))  # Copy CAR of second item
+   ld (Z I) ((A))  # and CAR of first item
+   lea Y (Z II)  # Point Y to 'fun'
+   call applyXYZ_E  # Apply
+   cmp E Nil  # Check result
+   if ne
+      setc  # Set carry if "less"
+   end
+   pop Y
+   ret
+
+# vi:et:ts=3:sw=3
diff --git a/src64/sym.l b/src64/sym.l
@@ -0,0 +1,3417 @@
+# 23feb10abu
+# (c) Software Lab. Alexander Burger
+
+### Compare long names ###
+(code 'cmpLongAX_F 0)
+   push X  # Keep X
+   do
+      cmp (A DIG) (X DIG)  # Equal?
+      if ne  # No
+         pop X
+         ret
+      end
+      ld A (A BIG)
+      ld X (X BIG)
+      big A  # A on last digit?
+      if z  # Yes
+         big X  # X also on last digit?
+         if nz  # No
+            setc  # A is smaller
+            pop X
+            ret
+         end
+         cmp A X  # Equal?
+         pop X
+         ret
+      end
+      cnt X  # A not on last digit. X on last digit?
+   until nz  # Yes
+   clrc  # A is greater
+   pop X
+   ret
+
+### Is symbol interned? ###
+# E symbol
+# X name
+# Y tree
+(code 'isInternEXY_F 0)
+   cnt X  # Short name?
+   if nz  # Yes
+      ld Y (Y)  # Y on first tree
+      do
+         atom Y  # Empty?
+         jnz ret  # Return NO
+         ld A ((Y) TAIL)  # Next symbol
+         call nameA_A  # Get name
+         cmp A X  # Equal?
+      while ne  # No
+         ld Y (Y CDR)
+         ldc Y (Y CDR)  # Symbol is smaller
+         ldnc Y (Y)  # Symbol is greater
+      loop
+      cmp E (Y)  # Same Symbol?
+      ret  # Return YES or NO
+   end
+   # Long name
+   ld Y (Y CDR)  # Y on second tree
+   do
+      atom Y  # Empty?
+      jnz ret  # Return NO
+      ld A ((Y) TAIL)  # Next symbol
+      call nameA_A  # Get name
+      call cmpLongAX_F  # Equal?
+   while ne  # No
+      ld Y (Y CDR)
+      ldc Y (Y CDR)  # Symbol is smaller
+      ldnc Y (Y)  # Symbol is greater
+   loop
+   cmp E (Y)  # Same Symbol?
+   ret   # Return YES or NO
+
+### Intern a symbol/name ###
+# E symbol
+# X name
+# Y tree
+(code 'internEXY_FE 0)
+   cnt X  # Short name?
+   if nz  # Yes
+      ld C (Y)  # C on first tree
+      atom C  # Empty?
+      if nz  # Yes
+         null E  # New symbol?
+         if z
+            call consSymX_E  # Yes
+         end
+         call consE_X  # Cons into a new node
+         ld (X) E
+         ld (X CDR) Nil
+         ld (Y) X  # Store in first tree
+         setc  # Return new symbol
+         ret
+      end
+      do
+         ld A ((C) TAIL)  # Next symbol
+         call nameA_A  # Get name
+         cmp A X  # Equal?
+         if eq  # Yes
+            ld E (C)  # Found symbol
+            clrc
+            ret
+         end
+         if lt  # Symbol is smaller
+            atom (C CDR)  # Already has link?
+            if nz  # No
+               null E  # New symbol?
+               if z
+                  call consSymX_E  # Yes
+               end
+               call consE_A  # Cons into a new node
+               ld (A) E
+               ld (A CDR) Nil
+               call consA_X  # Cons into a new link
+               ld (X) Nil
+               ld (X CDR) A
+               ld (C CDR) X
+               setc  # Return new symbol
+               ret
+            end
+            ld C (C CDR)
+            atom (C CDR)  # CDR of link?
+            ldz C (C CDR)  # Yes: Get CDR of link in C
+            if nz  # No
+               null E  # New symbol?
+               if z
+                  call consSymX_E  # Yes
+               end
+               call consE_A  # Cons into a new node
+               ld (A) E
+               ld (A CDR) Nil
+               ld (C CDR) A  # Store in CDR of link
+               setc  # Return new symbol
+               ret
+            end
+         else  # Symbol is greater
+            atom (C CDR)  # Already has link?
+            if nz  # No
+               null E  # New symbol?
+               if z
+                  call consSymX_E  # Yes
+               end
+               call consE_A  # Cons into a new node
+               ld (A) E
+               ld (A CDR) Nil
+               call consA_X  # Cons into a new link
+               ld (X) A
+               ld (X CDR) Nil
+               ld (C CDR) X
+               setc  # Return new symbol
+               ret
+            end
+            ld C (C CDR)
+            atom (C)  # CAR of link?
+            ldz C (C)  # Yes: Get CAR of link in C
+            if nz  # No
+               null E  # New symbol?
+               if z
+                  call consSymX_E  # Yes
+               end
+               call consE_A  # Cons into a new node
+               ld (A) E
+               ld (A CDR) Nil
+               ld (C) A  # Store in CAR of link
+               setc  # Return new symbol
+               ret
+            end
+         end
+      loop
+   end
+   # Long name
+   ld C (Y CDR)  # C on second tree
+   atom C  # Empty?
+   if nz  # Yes
+      null E  # New symbol?
+      if z
+         call consSymX_E  # Yes
+      end
+      call consE_X  # Cons into a new node
+      ld (X) E
+      ld (X CDR) Nil
+      ld (Y CDR) X  # Store in second tree
+      setc  # Return new symbol
+      ret
+   end
+   do
+      ld A ((C) TAIL)  # Next symbol
+      call nameA_A  # Get name
+      call cmpLongAX_F  # Equal?
+      if eq  # Yes
+         ld E (C)  # Found symbol
+         clrc
+         ret
+      end
+      if lt  # Symbol is smaller
+         atom (C CDR)  # Already has link?
+         if nz  # No
+            null E  # New symbol?
+            if z
+               call consSymX_E  # Yes
+            end
+            call consE_A  # Cons into a new node
+            ld (A) E
+            ld (A CDR) Nil
+            call consA_X  # Cons into a new link
+            ld (X) Nil
+            ld (X CDR) A
+            ld (C CDR) X
+            setc  # Return new symbol
+            ret
+         end
+         ld C (C CDR)
+         atom (C CDR)  # CDR of link?
+         ldz C (C CDR)  # Yes: Get CDR of link in C
+         if nz  # No
+            null E  # New symbol?
+            if z
+               call consSymX_E  # Yes
+            end
+            call consE_A  # Cons into a new node
+            ld (A) E
+            ld (A CDR) Nil
+            ld (C CDR) A  # Store in CDR of link
+            setc  # Return new symbol
+            ret
+         end
+      else  # Symbol is greater
+         atom (C CDR)  # Already has link?
+         if nz  # No
+            null E  # New symbol?
+            if z
+               call consSymX_E  # Yes
+            end
+            call consE_A  # Cons into a new node
+            ld (A) E
+            ld (A CDR) Nil
+            call consA_X  # Cons into a new link
+            ld (X) A
+            ld (X CDR) Nil
+            ld (C CDR) X
+            setc  # Return new symbol
+            ret
+         end
+         ld C (C CDR)
+         atom (C)  # CAR of link?
+         ldz C (C)  # Yes: Get CAR of link in C
+         if nz  # No
+            null E  # New symbol?
+            if z
+               call consSymX_E  # Yes
+            end
+            call consE_A  # Cons into a new node
+            ld (A) E
+            ld (A CDR) Nil
+            ld (C) A  # Store in CAR of link
+            setc  # Return new symbol
+            ret
+         end
+      end
+   loop
+
+(code 'findSymX_E 0)  # Y
+   ld E 0  # No symbol yet
+   ld Y Intern
+   call internEXY_FE  # New internal symbol?
+   jnc Ret  # No
+   ld (E) Nil  # Init to 'NIL'
+   ret
+
+# X name
+(code 'externX_E 0)  # C
+   ld C 3  # Reserve three cells
+   call needC
+   push X  # <S> Save name
+   ld A 6364136223846793005  # Randomize
+   mul X
+   ld E A  # Key in E
+   ld X Extern  # X on external symbol tree root node
+   do
+      ld A ((X) TAIL)  # Next symbol
+      call nameA_A  # Get name
+      and A (hex "3FFFFFFFFFFFFFF7")  # Mask status and extern bits
+      mul 6364136223846793005  # Randomize
+      cmp A E  # Equal to key?
+      if eq  # Yes
+         pop A  # Drop name
+         ld E (X)  # Found symbol
+         ret
+      end
+      if lt  # Symbol is smaller
+         atom (X CDR)  # Already has link?
+         if nz  # No
+            call cons_E  # New symbol
+            pop (E)  # Retrieve name
+            or (E) SYM  # Set 'extern' tag
+            or E SYM  # Make symbol
+            ld (E) Nil  # Init to 'NIL'
+            call consE_A  # Cons into a new node
+            ld (A) E
+            ld (A CDR) Nil
+            call consA_C  # Cons into a new link
+            ld (C) Nil
+            ld (C CDR) A
+            ld (X CDR) C
+            ret
+         end
+         ld X (X CDR)
+         atom (X CDR)  # CDR of link?
+         ldz X (X CDR)  # Yes: Get CDR of link in X
+         if nz  # No
+            call cons_E  # New symbol
+            pop (E)  # Retrieve name
+            or (E) SYM  # Set 'extern' tag
+            or E SYM  # Make symbol
+            ld (E) Nil  # Init to 'NIL'
+            call consE_A  # Cons into a new node
+            ld (A) E
+            ld (A CDR) Nil
+            ld (X CDR) A  # Store in CDR of link
+            ret
+         end
+      else  # Symbol is greater
+         atom (X CDR)  # Already has link?
+         if nz  # No
+            call cons_E  # New symbol
+            pop (E)  # Retrieve name
+            or (E) SYM  # Set 'extern' tag
+            or E SYM  # Make symbol
+            ld (E) Nil  # Init to 'NIL'
+            call consE_A  # Cons into a new node
+            ld (A) E
+            ld (A CDR) Nil
+            call consA_C  # Cons into a new link
+            ld (C) A
+            ld (C CDR) Nil
+            ld (X CDR) C
+            ret
+         end
+         ld X (X CDR)
+         atom (X)  # CAR of link?
+         ldz X (X)  # Yes: Get CAR of link in X
+         if nz  # No
+            call cons_E  # New symbol
+            pop (E)  # Retrieve name
+            or (E) SYM  # Set 'extern' tag
+            or E SYM  # Make symbol
+            ld (E) Nil  # Init to 'NIL'
+            call consE_A  # Cons into a new node
+            ld (A) E
+            ld (A CDR) Nil
+            ld (X) A  # Store in CAR of link
+            ret
+         end
+      end
+   loop
+
+### Unintern a symbol ###
+# X name
+# Y tree
+(code 'uninternXY 0)
+   cmp X ZERO  # Name?
+   jeq ret  # No
+   cnt X  # Short name?
+   if nz  # Yes
+      do  # Y on first tree
+         ld C (Y)  # Next node
+         atom C  # Empty?
+         jnz ret  # Yes
+         ld A ((C) TAIL)  # Next symbol
+         call nameA_A  # Get name
+         cmp A X  # Equal?
+         if eq  # Yes
+            ld A (C CDR)  # Get subtrees
+            atom (A)  # Left branch?
+            if nz  # No
+               ld (Y) (A CDR)  # Use right branch
+               ret
+            end
+            atom (A CDR)  # Right branch?
+            if nz  # No
+               ld (Y) (A)  # Use left branch
+               ret
+            end
+            ld A (A CDR)  # A on right branch
+            ld Y (A CDR)  # Y on sub-branches
+            atom (Y)  # Left?
+            if nz  # No
+               ld (C) (A)  # Insert right sub-branch
+               ld ((C CDR) CDR) (Y CDR)
+               ret
+            end
+            ld Y (Y)  # Left sub-branch
+            do
+               ld X (Y CDR)  # More left branches?
+               atom (X)
+            while z  # Yes
+               ld A Y  # Go down left
+               ld Y (X)
+            loop
+            ld (C) (Y)  # Insert left sub-branch
+            ld ((A CDR)) (X CDR)
+            ret
+         end
+         ld C (C CDR)
+         if lt  # Symbol is smaller
+            atom C  # Link?
+            jnz ret  # No
+            lea Y (C CDR)  # Go right
+         else  # Symbol is greater
+            atom C  # Link?
+            jnz ret  # No
+            ld Y C  # Go left
+         end
+      loop
+   end
+   # Long name
+   lea Y (Y CDR)
+   do  # Y on second tree
+      ld C (Y)  # Get next node
+      atom C  # Empty?
+      jnz ret  # Yes
+      ld A ((C) TAIL)  # Next symbol
+      call nameA_A  # Get name
+      call cmpLongAX_F  # Equal?
+      if eq  # Yes
+         ld A (C CDR)  # Get subtrees
+         atom (A)  # Left branch?
+         if nz  # No
+            ld (Y) (A CDR)  # Use right branch
+            ret
+         end
+         atom (A CDR)  # Right branch?
+         if nz  # No
+            ld (Y) (A)  # Use left branch
+            ret
+         end
+         ld A (A CDR)  # A on right branch
+         ld Y (A CDR)  # Y on sub-branches
+         atom (Y)  # Left?
+         if nz  # No
+            ld (C) (A)  # Insert right sub-branch
+            ld ((C CDR) CDR) (Y CDR)
+            ret
+         end
+         ld Y (Y)  # Left sub-branch
+         do
+            ld X (Y CDR)  # More left branches?
+            atom (X)
+         while nz  # Yes
+            ld A Y  # Go down left
+            ld Y (X)
+         loop
+         ld (C) (Y)  # Insert left sub-branch
+         ld ((A CDR)) (X CDR)
+         ret
+      end
+      ld C (C CDR)
+      if lt  # Symbol is smaller
+         atom C  # Link?
+         jnz ret  # No
+         lea Y (C CDR)  # Go right
+      else  # Symbol is greater
+         atom C  # Link?
+         jnz ret  # No
+         ld Y C  # Go left
+      end
+   loop
+
+(code 'nameA_A 0)
+   off A SYM  # Clear 'extern' tag
+   do
+      num A  # Find name
+      jnz ret
+      ld A (A CDR)  # Skip property
+   loop
+
+(code 'nameE_E 0)
+   off E SYM  # Clear 'extern' tag
+   do
+      num E  # Find name
+      jnz ret
+      ld E (E CDR)  # Skip property
+   loop
+
+(code 'nameX_X 0)
+   off X SYM  # Clear 'extern' tag
+   do
+      num X  # Find name
+      jnz ret
+      ld X (X CDR)  # Skip property
+   loop
+
+(code 'nameY_Y 0)
+   off Y SYM  # Clear 'extern' tag
+   do
+      num Y  # Find name
+      jnz ret
+      ld Y (Y CDR)  # Skip property
+   loop
+
+# (name 'sym ['sym2]) -> sym
+(code 'doName 2)
+   push X
+   push Y
+   ld X E
+   ld Y (E CDR)  # Y on args
+   ld E (Y)  # Eval 'sym'
+   eval
+   num E  # Need symbol
+   jnz symErrEX
+   sym E
+   jz symErrEX
+   ld Y (Y CDR)  # Second arg?
+   atom Y
+   if nz  # No
+      cmp E Nil  # NIL?
+      if ne  # No
+         ld X (E TAIL)
+         sym X  # External symbol?
+         if z  # No
+            call nameX_X  # Get name
+            call consSymX_E  # Make new transient symbol
+         else
+            call nameX_X  # Get name
+            call packExtNmX_E  # Pack it
+         end
+      end
+   else
+      cmp E Nil  # NIL?
+      jeq renErrEX  # Yes
+      sym (E TAIL)  # External symbol?
+      jnz renErrEX  # Yes
+      push X  # Save expression
+      push Y
+      ld X (E TAIL)
+      call nameX_X  # Get name
+      ld Y Intern  # Internal symbol?
+      call isInternEXY_F
+      pop Y
+      pop X
+      jz renErrEX  # Yes
+      link
+      push E  # <L I> First (transient) symbol
+      link
+      ld E (Y)
+      eval  # Eval second arg
+      num E  # Need symbol
+      jnz symErrEX
+      sym E
+      jz symErrEX
+      ld X (E TAIL)
+      call nameX_X  # Get name
+      ld E (L I)  # Get first symbol
+      lea Y (E TAIL)
+      do
+         num (Y)  # Find name
+      while z
+         lea Y ((Y) CDR)
+      loop
+      ld (Y) X  # Store name of second
+      drop
+   end
+   pop Y
+   pop X
+   ret
+
+# Make single-char symbol
+(code 'mkCharA_A 0)
+   cmp A (hex "80")  # ASCII?
+   if ge  # No
+      cmp A (hex "800")  # Double-byte?
+      if lt  # Yes
+         ld (Buf) B  # 110xxxxx 10xxxxxx
+         shr A 6  # Upper five bits
+         and B (hex "1F")
+         or B (hex "C0")
+         xchg B (Buf)  # Save first byte
+         and A (hex "3F")  # Lower 6 bits
+         or B (hex "80")
+         shl A 8  # into second byte
+         ld B (Buf)  # Get first byte
+      else
+         cmp A TOP  # Special "top" character?
+         if eq  # Yes
+            ld B (hex "FF")  # Above legal UTF-8
+            zxt
+         else
+            push C
+            ld C A  # 1110xxxx 10xxxxxx 10xxxxxx
+            shr A 12  # Hightest four bits
+            and B (hex "0F")
+            or B (hex "E0")
+            ld (Buf) B  # Save first byte
+            ld A C
+            shr A 6  # Middle six bits
+            and A (hex "3F")
+            or B (hex "80")
+            shl A 8  # into second byte
+            xchg A C
+            and A (hex "3F")  # Lowest 6 bits
+            or B (hex "80")  # Add third byte
+            shl A 16  # into third byte
+            or A C  # Combine with second byte
+            ld B (Buf)  # and first byte
+            pop C
+         end
+      end
+   end
+   shl A 4  # Make short name
+   or A CNT
+   push A  # Save character
+   call cons_A  # New cell
+   pop (A)  # Set name
+   or A SYM  # Make symbol
+   ld (A) A  # Set value to itself
+   ret
+
+(code 'mkStrE_E 0)
+   null E  # NULL pointer?
+   jz retNil
+   nul (E)  # Empty string?
+   jz retNil
+   push C
+   push X
+   link
+   push ZERO  # <L I> Name
+   ld C 4  # Build name
+   ld X S
+   link
+   do
+      ld B (E)
+      call byteSymBCX_CX  # Pack byte
+      add E 1  # Next byte
+      nul (E)  # Any?
+   until z
+   call cons_E  # Cons symbol
+   ld (E) (L I)  # Set name
+   or E SYM  # Make symbol
+   ld (E) E  # Set value to itself
+   drop
+   pop X
+   pop C
+   ret
+
+(code 'mkStrEZ_A 0)
+   push X
+   link
+   push ZERO  # <L I> Name
+   ld C 4  # Build name
+   ld X S
+   link
+   do
+      ld B (E)
+      call byteSymBCX_CX  # Pack byte
+      cmp E Z  # Reached Z?
+   while ne  # No
+      add E 1  # Next byte
+      nul (E)  # Any?
+   until z
+   call cons_A  # Cons symbol
+   ld (A) (L I)  # Set name
+   or A SYM  # Make symbol
+   ld (A) A  # Set value to itself
+   drop
+   pop X
+   ret
+
+(code 'firstByteA_B 0)
+   call nameA_A  # Get name
+   cnt A  # Short?
+   if nz  # Yes
+      shr A 4  # Normalize
+   else
+      ld A (A DIG)  # Get first digit
+   end
+   ret
+
+(code 'firstCharE_A 0)
+   ld A 0
+   cmp E Nil  # NIL?
+   if ne  # No
+      push X
+      ld X (E TAIL)
+      call nameX_X  # Get name
+      ld C 0
+      call symCharCX_FACX  # Get first character
+      pop X
+   end
+   ret
+
+(code 'isBlankE_F 0)
+   num E  # Symbol?
+   jnz ret  # No
+   sym E
+   jz retnz  # No
+   cmp E Nil  # NIL?
+   jz ret  # Yes
+   sym (E TAIL)  # External symbol?
+   jnz ret  # Yes
+   push X
+   ld X (E TAIL)
+   call nameX_X  # Get name
+   ld C 0
+   do
+      call symByteCX_FACX  # Next byte
+   while nz
+      cmp B 32  # Larger than blank?
+      break gt  # Yes
+   loop
+   pop X
+   ret
+
+# (sp? 'any) -> flg
+(code 'doSpQ 2)
+   ld E ((E CDR))  # Get arg
+   eval  # Eval it
+   call isBlankE_F  # Blank?
+   ld E TSym  # Yes
+   ldnz E Nil
+   ret
+
+# (pat? 'any) -> sym | NIL
+(code 'doPatQ 2)
+   ld E ((E CDR))  # Get arg
+   eval  # Eval it
+   num E  # Number?
+   jnz retNil  # Yes
+   sym E  # Symbol?
+   jz retNil  # No
+   ld A (E TAIL)
+   call firstByteA_B  # starting with "@"?
+   cmp B (char "@")
+   ldnz E Nil  # No
+   ret
+
+# (fun? 'any) -> any
+(code 'doFunQ 2)
+   ld E ((E CDR))  # Get arg
+   eval  # Eval it
+   call funqE_FE  # Function definition?
+   ldnz E Nil  # No
+   ret
+
+# (getd 'any) -> fun | NIL
+(code 'doGetd 2)
+   ld E ((E CDR))  # E on arg
+   eval  # Eval it
+   num E  # No number?
+   if z  # Yes
+      sym E  # Symbol?
+      if nz  # Yes
+         push E
+         ld E (E)  # Get value
+         call funqE_FE  # Function definition?
+         pop E
+         if eq  # Yes
+            ld E (E)  # Return value
+            ret
+         end
+         cmp (E) Nil  # Value NIL?
+         if eq  # Yes
+            ld C E
+            call sharedLibC_FA  # Dynamically loaded?
+            if nz  # Yes
+               ld E A  # Return function pointer
+               ret
+            end
+         end
+      end
+   end
+   ld E Nil
+   ret
+
+# (all ['NIL | 'T | '0 | '(NIL . flg) | '(T . flg) | '(0)]) -> lst
+(code 'doAll 2)
+   push X
+   ld E ((E CDR))  # Eval arg
+   eval
+   atom E  # Direct tree?
+   if z  # Yes
+      cmp (E) Nil  # Internal trees?
+      if eq  # Yes
+         cmp (E CDR) Nil  # Short names?
+         ldz E (Intern)  # Yes
+         ldnz E (Intern I)
+      else
+         cmp (E) TSym  # Transient trees?
+         ldnz E Extern  # No: External symbols
+         if eq  # Yes
+            cmp (E CDR) Nil  # Short names?
+            ldz E (Transient)  # Yes
+            ldnz E (Transient I)
+         end
+      end
+   else
+      cmp E Nil  # Nil?
+      if eq  # Yes
+         ld X (Intern I)  # Internal symbols
+         call consTreeXE_E
+         ld X (Intern)
+      else
+         cmp E TSym  # T?
+         if eq  # Yes
+            ld E Nil
+            ld X (Transient I)  # Transient symbols
+            call consTreeXE_E
+            ld X (Transient)
+         else
+            ld E Nil
+            ld X Extern  # External symbols
+         end
+      end
+      call consTreeXE_E
+   end
+   pop X
+   ret
+
+(code 'consTreeXE_E 0)
+   atom X  # Tree empty?
+   jnz ret  # Yes
+   link
+   push X  # <L II> Tree
+   push Nil  # <L I> TOS
+   link
+   do
+      do
+         ld A (X CDR)  # Get subtrees
+         atom (A CDR)  # Right subtree?
+      while z  # Yes
+         ld C X  # Go right
+         ld X (A CDR)  # Invert tree
+         ld (A CDR) (L I)  # TOS
+         ld (L I) C
+      loop
+      ld (L II) X  # Save tree
+      do
+         call consE_A  # Cons value
+         ld (A) (X)
+         ld (A CDR) E
+         ld E A  # into E
+         ld A (X CDR)  # Left subtree?
+         atom (A)
+         if z  # Yes
+            ld C X  # Go left
+            ld X (A)  # Invert tree
+            ld (A) (L I)  # TOS
+            or C SYM  # First visit
+            ld (L I) C
+            ld (L II) X  # Save tree
+            break T
+         end
+         do
+            ld A (L I)  # TOS
+            cmp A Nil  # Empty?
+            jeq 90  # Done
+            sym A  # Second visit?
+            if z  # Yes
+               ld C (A CDR)  # Nodes
+               ld (L I) (C CDR)  # TOS on up link
+               ld (C CDR) X
+               ld X A
+               ld (L II) X  # Save tree
+               break T
+            end
+            off A SYM  # Set second visit
+            ld C (A CDR)  # Nodes
+            ld (L I) (C)
+            ld (C) X
+            ld X A
+            ld (L II) X  # Save tree
+         loop
+      loop
+   loop
+90 drop  # Return E
+   ret
+
+# (intern 'sym) -> sym
+(code 'doIntern 2)
+   push X
+   ld X E
+   ld E ((E CDR))  # E on arg
+   eval  # Eval it
+   num E  # Need symbol
+   jnz symErrEX
+   sym E
+   jz symErrEX
+   ld X (E TAIL)
+   call nameX_X  # Get name
+   zero X  # Any?
+   if ne  # Yes
+      push Y
+      ld Y Intern  # Insert internal
+      call internEXY_FE
+      pop Y
+      pop X
+      ret
+   end
+   ld E Nil
+   pop X
+   ret
+
+# (extern 'sym) -> sym | NIL
+(code 'doExtern 2)
+   push X
+   push Y
+   ld X E
+   ld E ((E CDR))  # E on arg
+   eval  # Eval it
+   num E  # Need symbol
+   jnz symErrEX
+   sym E
+   jz symErrEX
+   ld X (E TAIL)
+   call nameX_X  # Get name
+   zero X  # Any?
+   if ne  # Yes
+      ld C 0  # Character index
+      call symCharCX_FACX  # First char
+      cmp B (char "{")  # Open brace?
+      if eq  # Yes
+         call symCharCX_FACX  # Skip it
+      end
+      ld E 0  # Init file number
+      do
+         cmp B (char "@")  # File done?
+      while ge  # No
+         cmp B (char "O")  # In A-O range?
+         jgt 90  # Yes
+         sub B (char "@")
+         shl E 4  # Add to file number
+         add E A
+         call symCharCX_FACX  # Next char?
+         jz 90  # No
+      loop
+      cmp B (char "0")  # Octal digit?
+      jlt 90
+      cmp B (char "7")
+      jgt 90  # No
+      sub B (char "0")
+      zxt
+      ld Y A  # Init object ID
+      do
+         call symCharCX_FACX  # Next char?
+      while nz  # Yes
+         cmp B (char "}")  # Closing brace?
+      while ne  # No
+         cmp B (char "0")  # Octal digit?
+         jlt 90
+         cmp B (char "7")
+         jgt 90  # No
+         sub B (char "0")
+         shl Y 3  # Add to object ID
+         add Y A
+      loop
+      ld C Y  # Object ID
+      call extNmCE_X  # Build external symbol name
+      call externX_E  # New external symbol
+      call isLifeE_F  # Alive?
+      ldnz E Nil  # No
+      pop Y
+      pop X
+      ret
+   end
+90 ld E Nil
+   pop Y
+   pop X
+   ret
+
+# (==== ['sym ..]) -> NIL
+(code 'doHide 2)
+   ld A Nil  # Clear transient index trees
+   ld (Transient) A
+   ld (Transient I) A
+   push X
+   push Y
+   push Z
+   ld X E
+   ld Z (E CDR)  # Args
+   do
+      atom Z  # More?
+   while z  # Yes
+      ld E (Z)  # Eval next
+      eval
+      num E  # Need symbol
+      jnz symErrEX
+      sym E
+      jz symErrEX
+      push X
+      ld X (E TAIL)
+      call nameX_X  # Get name
+      ld Y Transient  # Insert transient
+      call internEXY_FE
+      pop X
+      ld Z (Z CDR)  # Z on rest
+   loop
+   pop Z
+   pop Y
+   pop X
+   ret
+
+# (box? 'any) -> sym | NIL
+(code 'doBoxQ 2)
+   ld E ((E CDR))  # Get arg
+   eval  # Eval it
+   num E  # Number?
+   jnz retNil  # Yes
+   sym E  # Symbol?
+   jz retNil  # No
+   ld A (E TAIL)
+   call nameA_A  # Get name
+   cmp A ZERO  # Any?
+   jne retNil
+   ret
+
+# (str? 'any) -> sym | NIL
+(code 'doStrQ 2)
+   ld E ((E CDR))  # Get arg
+   eval  # Eval it
+   num E  # Number?
+   jnz retNil  # Yes
+   sym E  # Symbol?
+   jz retNil  # No
+   sym (E TAIL)  # External symbol?
+   jnz retNil  # Yes
+   push X
+   push Y
+   ld X (E TAIL)  # Get name
+   call nameX_X
+   ld Y Intern  # Internal symbol?
+   call isInternEXY_F
+   ldz E Nil  # Return NIL
+   pop Y
+   pop X
+   ret
+
+# (ext? 'any) -> sym | NIL
+(code 'doExtQ 2)
+   ld E ((E CDR))  # Get arg
+   eval  # Eval it
+   num E  # Number?
+   jnz retNil  # Yes
+   sym E  # Symbol?
+   jz retNil  # No
+   ld A (E TAIL)
+   sym A  # External symbol?
+   jz retNil  # No
+   call isLifeE_F  # Alive?
+   ldnz E Nil  # No
+   ret
+
+# (touch 'sym) -> sym
+(code 'doTouch 2)
+   ld E ((E CDR))  # Get arg
+   eval  # Eval it
+   num E  # Need symbol
+   jnz symErrEX
+   sym E
+   jz symErrEX
+   sym (E TAIL)  # External symbol?
+   if nz  # Yes
+      call dbTouchEX  # Touch it
+   end
+   ret
+
+# (zap 'sym) -> sym
+(code 'doZap 2)
+   push X
+   ld X E
+   ld E ((E CDR))  # E on arg
+   eval  # Eval it
+   num E  # Need symbol
+   jnz symErrEX
+   sym E
+   jz symErrEX
+   ld A (E TAIL)
+   sym A  # External symbol?
+   if nz  # Yes
+      call dbZapE  # Mark as "deleted"
+   else
+      cmp E Nil  # Between 'NIL' and '*Bye'?
+      if ge
+         cmp E Bye
+         jle protErrEX  # Yes
+      end
+      push Y
+      ld X (E TAIL)
+      call nameX_X  # Get name
+      ld Y Intern
+      call uninternXY  # Unintern symbol
+      pop Y
+   end
+   pop X
+   ret
+
+# (chop 'any) -> lst
+(code 'doChop 2)
+   ld E ((E CDR))  # Get arg
+   eval  # Eval it
+   atom E  # Atomic?
+   if nz  # Yes
+      cmp E Nil  # NIL?
+      if ne  # No
+         push X
+         call xSymE_E  # Extract symbol
+         ld X (E TAIL)
+         call nameX_X  # Get name
+         sym (E TAIL)  # External symbol?
+         if z  # No
+            ld C 0
+            call symCharCX_FACX  # First char?
+            if nz  # Yes
+               push Y
+               link
+               push X  # Save name
+               link
+               call mkCharA_A  # Make single character
+               call consA_Y  # Cons it
+               ld (Y) A
+               ld (Y CDR) Nil  # with NIL
+               tuck Y  # <L I> Result
+               link
+               do
+                  call symCharCX_FACX  # Next char
+               while nz
+                  call mkCharA_A  # Make char
+                  call consA_E  # Cons it
+                  ld (E) A
+                  ld (E CDR) Nil
+                  ld (Y CDR) E  # Append to result
+                  ld Y E
+               loop
+               ld E (L I)  # Get result
+               drop
+               pop Y
+            else
+               ld E Nil  # Else return NIL
+            end
+         else  # External symbol
+            call chopExtNmX_E
+         end
+         pop X
+      end
+   end
+   ret
+
+# (pack 'any ..) -> sym
+(code 'doPack 2)
+   push X
+   push Y
+   push Z
+   ld Y (E CDR)  # Y on args
+   ld E (Y)  # Eval first
+   eval
+   link
+   push E  # <L III> 'any'
+   push ZERO  # <L II> Safe
+   push ZERO  # <L I> Result
+   ld C 4  # Build name
+   ld X S
+   link
+   do
+      call packECX_CX
+      ld Y (Y CDR)  # More args?
+      atom Y
+   while z  # Yes
+      ld Z C  # Save C
+      ld E (Y)  # Eval next arg
+      eval
+      ld (L III) E  # Save
+      ld C Z
+   loop
+   ld X (L I)  # Get result
+   call consSymX_E  # Make transient symbol
+   drop
+   pop Z
+   pop Y
+   pop X
+   ret
+
+(code 'packECX_CX 0)
+   atom E  # Atomic?
+   if z  # No
+      do  # List
+         push (E CDR)  # Save rest
+         ld E (E)  # Recurse on CAR
+         call packECX_CX
+         pop E  # Done?
+         atom E
+      until nz  # Yes
+   end
+   cmp E Nil  # NIL?
+   jeq ret  # Yes
+   num E  # Number?
+   if z  # No
+      sym (E TAIL)  # External symbol?
+      if nz  # Yes
+         ld B (char "{")
+         call byteSymBCX_CX  # Pack "{"
+         push C  # Save status
+         push X
+         ld X (E TAIL)  # Get name
+         call nameX_X
+         call packExtNmX_E  # Pack name
+         ld (L II) E  # Save
+         pop X  # Restore status
+         pop C
+         call 10  # Pack external symbol
+         ld B (char "}")
+         jmp byteSymBCX_CX  # Pack "}"
+      end
+   else
+      ld A 0  # Scale
+      call fmtNum0AE_E  # Convert to symbol
+      ld (L II) E  # Save
+   end
+10 push C  # Save status
+   push X
+   ld X (E TAIL)
+   call nameX_X  # Get name
+   ld C 0
+   do
+      call symByteCX_FACX  # Next char
+   while nz
+      xchg C (S I)  # Swap status
+      xchg X (S)
+      call byteSymBCX_CX  # Pack byte
+      xchg X (S)  # Swap status
+      xchg C (S I)
+   loop
+   pop X  # Restore status
+   pop C
+   ret
+
+# (glue 'any 'lst) -> sym
+(code 'doGlue 2)
+   push X
+   push Y
+   ld X (E CDR)  # Args
+   ld E (X)  # Eval first
+   eval
+   link
+   push E  # <L IV> 'any'
+   ld X (X CDR)  # X on rest
+   ld E (X)  # Eval second
+   eval+
+   push E  # <L III> 'lst'
+   push ZERO  # <L II> Number safe
+   push ZERO  # <L I> Result
+   ld C 4  # Build name
+   ld X S
+   link
+   atom E  # Any items?
+   if z  # Yes
+      ld Y E  # 'lst'
+      do
+         ld E (Y)  # Get next item
+         call packECX_CX  # Pack it
+         ld Y (Y CDR)  # More?
+         atom Y
+      while z  # Yes
+         ld E (L IV)  # Get 'any'
+         call packECX_CX  # Pack it
+      loop
+      ld X (L I)  # Get result
+      call consSymX_E  # Make transient symbol
+   end
+   drop
+   pop Y
+   pop X
+   ret
+
+# (text 'any1 'any ..) -> sym
+(code 'doText 2)
+   push X
+   push Y
+   ld X (E CDR)  # Args
+   call evSymX_E  # Eval first
+   cmp E Nil  # NIL?
+   if nz
+      ld E (E TAIL)
+      call nameE_E  # Get name
+      link
+      push E  # <(L) -I> Name of 'any1'
+      do
+         ld X (X CDR)  # Next arg
+         atom X  # Any?
+      while z  # Yes
+         ld E (X)  # Eval next arg
+         eval+
+         push E  # and save it
+      loop
+      push ZERO  # <L II> Number safe
+      push ZERO  # <L I> Result
+      ld X S
+      link
+      push 4  # <S I> Build name
+      push X  # <S> Pack status
+      ld X ((L) -I) # Get name of 'any1'
+      ld C 0  # Index
+      do
+         call symByteCX_FACX  # Next char?
+      while nz
+         cmp B (char "@")  # Pattern?
+         if ne  # No
+10          xchg C (S I)  # Swap status
+            xchg X (S)
+            call byteSymBCX_CX  # Pack byte
+            xchg X (S)  # Swap status
+            xchg C (S I)
+            continue T
+         end
+         call symByteCX_FACX  # Next char after "@"?
+      while nz
+         cmp B (char "@")  # "@@"?
+         jeq 10  # Yes
+         sub B (char "0")  # >= "1"?
+         if gt  # Yes
+            cmp B 8  # > 8?
+            if gt
+               sub B 7  # Adjust for letter
+            end
+            shl A 3  # Vector index
+            lea E ((L) -I)  # Point above first 'any' arg
+            sub E A  # Get arg address
+            lea A (L II)  # Address of number save
+            cmp E A  # Arg address too low?
+            if gt  # No
+               ld E (E)
+               xchg C (S I)  # Swap status
+               xchg X (S)
+               call packECX_CX  # Pack it
+               xchg X (S)  # Swap status
+               xchg C (S I)
+            end
+         end
+      loop
+      ld X (L I)  # Get result
+      call consSymX_E  # Make transient symbol
+      drop
+   end
+   pop Y
+   pop X
+   ret
+
+(code 'preCEXY_F 0)
+   do
+      call symByteCX_FACX  # First string done?
+      jz ret  # Yes
+      ld (Buf) B  # Keep
+      xchg C E  # Second string
+      xchg X Y
+      call symByteCX_FACX  # Next byte?
+      jz retnz  # No
+      cmp (Buf) B  # Equal?
+      jne ret  # No
+      xchg C E  # First string
+      xchg X Y
+   loop
+
+(code 'subStrAE_F 0)
+   cmp A Nil  # NIL?
+   jeq ret  # Yes
+   ld A (A TAIL)  # First symbol
+   call nameA_A  # Get name
+   zero A  # None?
+   jeq ret  # Yes
+   ld E (E TAIL)  # Second symbol
+   call nameE_E  # Get name
+   zero E  # Any?
+   jeq retnz  # No
+   push X
+   push Y
+   push Z
+   push A  # <S I> First name
+   ld Z E  # Second name
+   push 0  # <S> Second index
+   do
+      ld X (S I)  # First name
+      ld C 0  # First index
+      ld Y Z  # Second name
+      ld E (S)  # Second index
+      call preCEXY_F  # Prefix?
+   while ne  # No
+      ld A (S)
+      shr A 8  # New round in second index?
+      if z  # Yes
+         zero Z  # Second done?
+         if eq  # Yes
+            clrz  # 'nz'
+            break T
+         end
+         cnt Z  # Short?
+         if nz  # Yes
+            ld A Z  # Get short
+            shr A 4  # Normalize
+            ld Z ZERO  # Clear for next round
+         else
+            ld A (Z DIG)  # Get next digit
+            ld Z (Z BIG)
+         end
+      end
+      ld (S) A
+   loop
+   pop A  # Drop locals
+   pop A
+   pop Z
+   pop Y
+   pop X
+   ret
+
+# (pre? 'any1 'any2) -> any2 | NIL
+(code 'doPreQ 2)
+   push X
+   push Y
+   push Z
+   ld X (E CDR)  # X on args
+   call evSymX_E  # Eval first
+   link
+   push E  # <L I> 'any1'
+   link
+   ld X (X CDR)  # Next arg
+   call evSymX_E  # Eval second
+   ld X (L I)  # 'any1'
+   cmp X Nil  # NIL?
+   if ne  # No
+      ld Z E  # Keep second in Z
+      ld X (X TAIL)  # 'any1'
+      call nameX_X  # First name
+      ld C 0
+      ld E (E TAIL)  # 'any2'
+      call nameE_E  # Second name
+      ld Y E
+      ld E 0
+      call preCEXY_F  # Prefix?
+      ld E Nil
+      ldz E Z  # Yes
+   end
+   drop
+   pop Z
+   pop Y
+   pop X
+   ret
+
+# (sub? 'any1 'any2) -> any2 | NIL
+(code 'doSubQ 2)
+   push X
+   ld X (E CDR)  # X on args
+   call evSymX_E  # Eval first
+   link
+   push E  # <L I> 'any1'
+   link
+   ld X (X CDR)  # Next arg
+   call evSymX_E  # Eval second
+   ld A (L I)  # 'any1'
+   ld X E  # Keep second in X
+   call subStrAE_F  # Substring?
+   ld E Nil
+   ldz E X  # Yes
+   drop
+   pop X
+   ret
+
+# (val 'var) -> any
+(code 'doVal 2)
+   push X
+   ld X E
+   ld E ((E CDR))  # E on arg
+   eval  # Eval it
+   num E  # Need variable
+   jnz varErrEX
+   sym E  # Symbol?
+   if nz  # Yes
+      sym (E TAIL)  # External symbol?
+      if nz  # Yes
+         call dbFetchEX  # Fetch it
+      end
+   end
+   ld E (E)  # Return value
+   pop X
+   ret
+
+# (set 'var 'any ..) -> any
+(code 'doSet 2)
+   push X
+   push Y
+   ld X E
+   ld Y (E CDR)  # Y on args
+   link
+   push ZERO  # <L I> Safe
+   link
+   do
+      ld E (Y)  # Eval next
+      eval
+      call needVarEX  # Need variable
+      sym E  # Symbol?
+      if nz  # Yes
+         sym (E TAIL)  # External symbol?
+         if nz  # Yes
+            call dbTouchEX  # Touch it
+         end
+      end
+      ld (L I) E  # Save it
+      ld Y (Y CDR)  # Next arg
+      ld E (Y)
+      eval  # Eval 'any'
+      ld ((L I)) E  # Set value
+      ld Y (Y CDR)  # Next arg
+      atom Y  # Any?
+   until nz  # No
+   drop
+   pop Y
+   pop X
+   ret
+
+# (setq var 'any ..) -> any
+(code 'doSetq 2)
+   push X
+   push Y
+   push Z
+   ld X E
+   ld Y (E CDR)  # Y on args
+   do
+      ld E (Y)  # Next var
+      call needVarEX  # Need variable
+      ld Z E  # Keep in Z
+      ld Y (Y CDR)  # Eval next arg
+      ld E (Y)
+      eval
+      ld (Z) E  # Store value
+      ld Y (Y CDR)  # More args?
+      atom Y
+   until nz  # No
+   pop Z
+   pop Y
+   pop X
+   ret
+
+# (xchg 'var 'var ..) -> any
+(code 'doXchg 2)
+   push X
+   push Y
+   ld X E
+   ld Y (E CDR)  # Y on args
+   link
+   push ZERO  # <L I> Safe
+   link
+   do
+      ld E (Y)  # Eval next
+      eval
+      call needVarEX  # Need variable
+      sym E  # Symbol?
+      if nz  # Yes
+         sym (E TAIL)  # External symbol?
+         if nz  # Yes
+            call dbTouchEX  # Touch it
+         end
+      end
+      ld (L I) E  # Save it
+      ld Y (Y CDR)  # Next arg
+      ld E (Y)
+      eval  # Eval next arg
+      call needVarEX  # Need variable
+      sym E  # Symbol?
+      if nz  # Yes
+         sym (E TAIL)  # External symbol?
+         if nz  # Yes
+            call dbTouchEX  # Touch it
+         end
+      end
+      ld C (L I)  # Get first 'var'
+      ld A (C)  # Get value
+      ld (C) (E)  # Set new
+      ld (E) A
+      ld Y (Y CDR)  # Next arg
+      atom Y  # Any?
+   until nz  # No
+   ld E A  # Return last
+   drop
+   pop Y
+   pop X
+   ret
+
+# (on var ..) -> T
+(code 'doOn 2)
+   push X
+   ld X (E CDR)
+   do
+      ld E (X)  # Get next arg
+      call needVarEX  # Need variable
+      ld (E) TSym  # Set to 'T'
+      ld X (X CDR)  # More?
+      atom X
+   until nz  # No
+   ld E TSym
+   pop X
+   ret
+
+# (off var ..) -> NIL
+(code 'doOff 2)
+   push X
+   ld X (E CDR)
+   do
+      ld E (X)  # Get next arg
+      call needVarEX  # Need variable
+      ld (E) Nil  # Set to 'NIL'
+      ld X (X CDR)  # More?
+      atom X
+   until nz  # No
+   ld E Nil
+   pop X
+   ret
+
+# (onOff var ..) -> flg
+(code 'doOnOff 2)
+   push X
+   ld X (E CDR)
+   do
+      ld E (X)  # Get next arg
+      call needVarEX  # Need variable
+      cmp (E) Nil  # Value NIL?
+      ld A TSym  # Negate
+      ldnz A Nil
+      ld (E) A  # Set new value
+      ld X (X CDR)  # More?
+      atom X
+   until nz  # No
+   ld E A  # Return last
+   pop X
+   ret
+
+# (zero var ..) -> 0
+(code 'doZero 2)
+   push X
+   ld X (E CDR)
+   do
+      ld E (X)  # Get next arg
+      call needVarEX  # Need variable
+      ld (E) ZERO  # Set to '0'
+      ld X (X CDR)  # More?
+      atom X
+   until nz  # No
+   ld E ZERO
+   pop X
+   ret
+
+# (one var ..) -> 1
+(code 'doOne 2)
+   push X
+   ld X (E CDR)
+   do
+      ld E (X)  # Get next arg
+      call needVarEX  # Need variable
+      ld (E) ONE  # Set to '1'
+      ld X (X CDR)  # More?
+      atom X
+   until nz  # No
+   ld E ONE
+   pop X
+   ret
+
+# (default sym 'any ..) -> any
+(code 'doDefault 2)
+   push X
+   push Y
+   push Z
+   ld X E
+   ld Y (E CDR)  # Y on args
+   do
+      ld E (Y)  # Next var
+      ld Y (Y CDR)
+      call needVarEX  # Need variable
+      ld Z E  # Keep in Z
+      cmp (Z) Nil  # Value 'NIL'?
+      if eq  # Yes
+         ld E (Y)  # Eval next arg
+         eval
+         ld (Z) E  # Store value
+      end
+      ld Y (Y CDR)  # More args?
+      atom Y
+   until nz  # No
+   ld E (Z)  # Return value
+   pop Z
+   pop Y
+   pop X
+   ret
+
+# (push 'var 'any ..) -> any
+(code 'doPush 2)
+   push X
+   push Y
+   ld X E
+   ld Y (E CDR)  # Y on args
+   ld E (Y)  # Eval first
+   eval
+   call needVarEX  # Need variable
+   sym E  # Symbol?
+   if nz  # Yes
+      sym (E TAIL)  # External symbol?
+      if nz  # Yes
+         call dbTouchEX  # Touch it
+      end
+   end
+   link
+   push E  # <L I> 'var'
+   link
+   ld Y (Y CDR)  # Second arg
+   do
+      ld E (Y)
+      eval  # Eval next arg
+      call consE_A  # Cons into value
+      ld (A) E
+      ld C (L I)  # 'var'
+      ld (A CDR) (C)
+      ld (C) A
+      ld Y (Y CDR)  # Next arg
+      atom Y  # Any?
+   until nz  # No
+   drop
+   pop Y
+   pop X
+   ret
+
+# (push1 'var 'any ..) -> any
+(code 'doPush1 2)
+   push X
+   push Y
+   push Z
+   ld X E
+   ld Y (E CDR)  # Y on args
+   ld E (Y)  # Eval first
+   eval
+   call needVarEX  # Need variable
+   sym E  # Symbol?
+   if nz  # Yes
+      sym (E TAIL)  # External symbol?
+      if nz  # Yes
+         call dbTouchEX  # Touch it
+      end
+   end
+   link
+   push E  # <L I> 'var'
+   link
+   ld Y (Y CDR)  # Second arg
+   do
+      ld E (Y)
+      eval  # Eval next arg
+      ld C ((L I))  # Value of 'var'
+      do  # 'member'
+         atom C  # List?
+      while z  # Yes
+         ld A (C)
+         ld Z E  # Preserve E
+         call equalAE_F  # Member?
+         ld E Z
+         jeq 10  # Yes
+         ld C (C CDR)
+      loop
+      call consE_A  # Cons into value
+      ld (A) E
+      ld C (L I)  # 'var'
+      ld (A CDR) (C)
+      ld (C) A
+10    ld Y (Y CDR)  # Next arg
+      atom Y  # Any?
+   until nz  # No
+   drop
+   pop Z
+   pop Y
+   pop X
+   ret
+
+# (pop 'var) -> any
+(code 'doPop 2)
+   push X
+   ld X E
+   ld E ((E CDR))  # E on arg
+   eval  # Eval it
+   call needVarEX  # Need variable
+   sym E  # Symbol?
+   if nz  # Yes
+      sym (E TAIL)  # External symbol?
+      if nz  # Yes
+         call dbTouchEX  # Touch it
+      end
+   end
+   ld A E  # 'var' in A
+   ld E (A)  # Get value
+   atom E  # List?
+   if z  # Yes
+      ld (A) (E CDR)  # Set to CDR
+      ld E (E)  # Return CAR
+   end
+   pop X
+   ret
+
+# (cut 'cnt 'var) -> lst
+(code 'doCut 2)
+   push X
+   push Y
+   ld X E
+   ld Y (E CDR)  # Y on args
+   call evCntXY_FE  # Eval 'cnt'
+   if nsz  # Yes
+      ld Y ((Y CDR))  # Second arg
+      xchg E Y  # 'cnt' in Y
+      eval  # Eval 'var'
+      call needVarEX  # Need variable
+      sym E  # Symbol?
+      if nz  # Yes
+         sym (E TAIL)  # External symbol?
+         if nz  # Yes
+            call dbTouchEX  # Touch it
+         end
+      end
+      atom (E)  # List value?
+      ldnz E (E)
+      if z  # Yes
+         call consE_X  # Cons first cell
+         ld C (E)  # Get value
+         ld (X) (C)  # CAR
+         ld (X CDR) Nil
+         link
+         push E  # <L II> 'var'
+         push X  # <L I> 'lst'
+         link
+         do
+            ld C (C CDR)  # More elements?
+            atom C
+         while z  # Yes
+            sub Y 1  # Count?
+         while nz  # Yes
+            call cons_A  # Copy next cell
+            ld (A) (C)
+            ld (A CDR) Nil
+            ld (X CDR) A  # Append to result
+            ld X (X CDR)
+         loop
+         ld ((L II)) C  # Set new value
+         ld E (L I)  # Get result
+         drop
+      end
+      pop Y
+      pop X
+      ret
+   end
+   ld E Nil
+   pop Y
+   pop X
+   ret
+
+# (del 'any 'var) -> lst
+(code 'doDel 2)
+   push X
+   push Y
+   push Z
+   ld X E
+   ld Y (E CDR)  # Y on args
+   ld E (Y)  # Eval first
+   eval
+   link
+   push E  # <L II/III> 'any'
+   ld Y (Y CDR)
+   ld E (Y)  # Eval second
+   eval+
+   push E  # <L I/II> 'var'
+   link
+   call needVarEX  # Need variable
+   sym E  # Symbol?
+   if nz  # Yes
+      sym (E TAIL)  # External symbol?
+      if nz  # Yes
+         call dbTouchEX  # Touch it
+      end
+   end
+   ld E ((L I))  # Get value of 'var'
+   atom E  # List?
+   if z  # Yes
+      ld Y E  # Keep value in Y
+      ld E (Y)  # First element
+      ld A (L II)  # 'any'
+      call equalAE_F  # Equal?
+      if eq  # Yes
+         ld E (Y CDR)  # Get value's CDR
+         ld ((L I)) E  # Set 'var'
+      else
+         call cons_Z  # Copy first cell
+         ld (Z) (Y)
+         ld (Z CDR) Nil
+         tuck Z  # <L I> Save it
+         link
+         do
+            ld Y (Y CDR)  # More cells?
+            atom Y
+         while z  # Yes
+            ld E (Y)  # Next element
+            ld A (L III)  # 'any'
+            call equalAE_F  # Equal?
+            if eq  # Yes
+               ld (Z CDR) (Y CDR)  # Skip found element
+               ld E (L I)  # Result
+               ld ((L II)) E  # Set 'var'
+               jmp 90
+            end
+            call cons_A  # Copy next cell
+            ld (A) (Y)
+            ld (A CDR) Nil
+            ld (Z CDR) A   # Append to result
+            ld Z (Z CDR)
+         loop
+         ld E ((L II))  # Not found: Return old value of 'var'
+      end
+   end
+90 drop
+   pop Z
+   pop Y
+   pop X
+   ret
+
+# (queue 'var 'any) -> any
+(code 'doQueue 2)
+   push X
+   push Y
+   ld X E
+   ld Y (E CDR)  # Y on args
+   ld E (Y)  # Eval first
+   eval
+   call needVarEX  # Need variable
+   sym E  # Symbol?
+   if nz  # Yes
+      sym (E TAIL)  # External symbol?
+      if nz  # Yes
+         call dbTouchEX  # Touch it
+      end
+   end
+   link
+   push E  # <L I> 'var'
+   link
+   ld Y (Y CDR)  # Next arg
+   ld E (Y)
+   eval  # Eval next arg
+   call consE_C  # Build cell
+   ld (C) E
+   ld (C CDR) Nil
+   ld X (L I)  # Get 'var'
+   ld Y (X)  # Value
+   atom Y  # Atomic?
+   if nz  # Yes
+      ld (X) C  # Store first cell
+   else
+      do
+         atom (Y CDR)  # Find last cell
+      while z
+         ld Y (Y CDR)
+      loop
+      ld (Y CDR) C
+   end
+   drop
+   pop Y
+   pop X
+   ret
+
+# (fifo 'var ['any ..]) -> any
+(code 'doFifo 2)
+   push X
+   push Y
+   ld X E
+   ld Y (E CDR)  # Y on args
+   ld E (Y)  # Eval first
+   eval
+   call needVarEX  # Need variable
+   sym E  # Symbol?
+   if nz  # Yes
+      sym (E TAIL)  # External symbol?
+      if nz  # Yes
+         call dbTouchEX  # Touch it
+      end
+   end
+   link
+   push E  # <L I> 'var'
+   link
+   ld Y (Y CDR)  # More args?
+   atom Y
+   if z  # Yes
+      ld E (Y)  # Eval 'any'
+      eval
+      call consE_A  # Cons into new cell
+      ld (A) E
+      ld C (L I)  # Get 'var'
+      ld X (C)  # Value in X
+      atom X  # List?
+      if z  # Yes
+         ld (A CDR) (X CDR)  # Concat to value
+         ld (X CDR) A
+      else
+         ld (A CDR) A  # Circular cell
+         ld (C) X  # Set new value
+      end
+      ld X A
+      do
+         ld Y (Y CDR)  # More args?
+         atom Y
+      while z  # Yes
+         ld E (Y)  # Eval next 'any'
+         eval
+         call consE_A  # Cons into new cell
+         ld (A) E
+         ld (A CDR) (X CDR)  # Concat to value
+         ld (X CDR) A
+         ld X A
+      loop
+      ld ((L I)) X  # Set new value
+   else
+      ld C (L I)  # Get 'var'
+      ld X (C)  # Value in X
+      atom X  # Any?
+      if nz  # No
+         ld E Nil
+      else
+         cmp X (X CDR)  # Single cell?
+         if eq  # Yes
+            ld E (X)  # Return CAR
+            ld (C) Nil  # Clear value
+         else
+            ld E ((X CDR))  # Return CADR
+            ld (X CDR) ((X CDR) CDR)  # Cut cell
+         end
+      end
+   end
+   drop
+   pop Y
+   pop X
+   ret
+
+# (idx 'var 'any 'flg) -> lst
+# (idx 'var 'any) -> lst
+# (idx 'var) -> lst
+(code 'doIdx 2)
+   push X
+   ld X E
+   ld E ((E CDR))  # Eval first arg
+   eval
+   call needVarEX  # Need variable
+   ld X ((X CDR) CDR)  # Second arg?
+   atom X
+   if nz  # No
+      ld X (E)  # Get tree
+      ld E Nil  # Cons a list
+      call consTreeXE_E
+   else
+      push Y
+      link
+      push E  # <L II> 'var'
+      ld E (X)
+      eval+  # Eval second arg
+      push E  # <L I> 'any'
+      link  # Save it
+      ld Y E  # Keep in Y
+      ld X (X CDR)  # Third arg?
+      atom X
+      if nz  # No
+         ld X (L II)  # Get 'var'
+         call idxGetXY_E  # Find
+      else
+         ld E (X)  # Eval last arg
+         eval
+         ld X (L II)  # Get 'var'
+         cmp E Nil  # Delete?
+         if ne  # No
+            call idxPutXY_E  # Insert
+         else
+            call idxDelXY_E  # Delete
+         end
+      end
+      drop
+      pop Y
+   end
+   pop X
+   ret
+
+(code 'idxGetXY_E 0)
+   ld X (X)  # Get value of 'var'
+   do
+      atom X  # More nodes?
+      ld E Nil
+   while z  # Yes
+      ld A Y  # Get key
+      ld E (X)  # Compare with node value
+      call compareAE_F  # Found?
+      ld E X
+   while ne  # No
+      ld X (X CDR)
+      ldc X (X)  # Smaller
+      ldnc X (X CDR)  # Greater
+   loop
+   ret
+
+(code 'idxPutXY_E 0)
+   atom (X)  # First insert?
+   if nz  # Yes
+      call cons_A  # Cons new node
+      ld (A) Y  # 'any'
+      ld (A CDR) Nil
+      ld (X) A  # Set 'var'
+      ld E Nil  # return NIL
+   else
+      ld X (X)  # Get value of 'var'
+      do
+         ld A Y  # Get key
+         ld E (X)  # Compare with node value
+         call compareAE_F  # Equal?
+         ld E X
+      while ne  # No
+         ld A (X CDR)
+         if ge  # Greater
+            atom A  # Already has link?
+            if nz  # No
+               call cons_A  # Cons into a new node
+               ld (A) Y  # key
+               ld (A CDR) Nil
+               call consA_C  # Cons a new link
+               ld (C) Nil
+               ld (C CDR) A
+               ld (X CDR) C
+               ld E Nil  # Return NIL
+               break T
+            end
+            ld X A
+            atom (X CDR)  # CDR of link?
+            ldz X (X CDR)  # Yes: Get CDR of link in X
+            if nz  # No
+               call cons_A  # Else cons into a new node
+               ld (A) Y  # key
+               ld (A CDR) Nil
+               ld (X CDR) A  # Store in CDR of link
+               ld E Nil  # Return NIL
+               break T
+            end
+         else  # Smaller
+            atom A  # Already has link?
+            if nz  # No
+               call cons_A  # Cons into a new node
+               ld (A) Y  # key
+               ld (A CDR) Nil
+               call consA_C  # Cons a new link
+               ld (C) A
+               ld (C CDR) Nil
+               ld (X CDR) C
+               ld E Nil  # Return NIL
+               break T
+            end
+            ld X A
+            atom (X)  # CAR of link?
+            ldz X (X)  # Yes: Get CAR of link in X
+            if nz  # No
+               call cons_A  # Else cons into a new node
+               ld (A) Y  # key
+               ld (A CDR) Nil
+               ld (X) A  # Store in CAR of link
+               ld E Nil  # Return NIL
+               break T
+            end
+         end
+      loop
+   end
+   ret
+
+(code 'idxDelXY_E 0)
+   do
+      atom (X)  # Next node?
+      ld E Nil
+   while z  # Yes
+      ld A Y  # Get key
+      ld E ((X))  # Compare with node value
+      call compareAE_F  # Equal?
+      if eq  # Yes
+         ld C (X)  # Found subtree
+         ld E C  # Preset return value
+         ld A (C CDR)  # Get subtrees
+         atom (A)  # Left branch?
+         if nz  # No
+            ld (X) (A CDR)  # Use right branch
+            ret
+         end
+         atom (A CDR)  # Right branch?
+         if nz  # No
+            ld (X) (A)  # Use left branch
+            ret
+         end
+         ld A (A CDR)  # A on right branch
+         ld X (A CDR)  # X on sub-branches
+         atom (X)  # Left?
+         if nz  # No
+            ld (C) (A)  # Insert right sub-branch
+            ld ((C CDR) CDR) (X CDR)
+            ret
+         end
+         push E  # Save return value
+         ld X (X)  # Left sub-branch
+         do
+            ld E (X CDR)  # More left branches?
+            atom (E)
+         while z  # Yes
+            ld A X  # Go down left
+            ld X (E)
+         loop
+         ld (C) (X)  # Insert left sub-branch
+         ld ((A CDR)) (E CDR)
+         pop E
+         ret
+      end
+      ld E Nil
+      ld X ((X) CDR)
+      if ge  # Node value is greater
+         atom X  # Link?
+         break nz  # No
+         lea X (X CDR)  # Go right
+      else  # Node value is smaller
+         atom X  # Link?
+         break nz  # No
+      end
+   loop
+   ret
+
+# (lup 'lst 'any) -> lst
+# (lup 'lst 'any 'any2) -> lst
+(code 'doLup 2)
+   push X
+   ld X (E CDR)  # Args
+   ld E (X)  # Eval first
+   eval
+   atom E  # List?
+   if z  # Yes
+      link
+      push E  # <L V> 'lst'
+      ld X (X CDR)  # Eval second
+      ld E (X)
+      eval+  # 'any'
+      ld X (X CDR)  # Next arg?
+      atom X
+      if nz  # No
+         pop X  # Get 'lst' in X
+         pop L  # Discard partial stack frame
+         push Y
+         ld Y E  # Get 'any' in Y
+         do
+            ld E (X)  # CAR of 'lst'
+            cmp E TSym  # Is it T?
+            if eq  # Yes
+               ld X ((X CDR))  # Go to CADR
+            else
+               atom E  # Atomic?
+               if nz  # Yes
+                  ld X ((X CDR) CDR)  # Go to CDDR
+               else
+                  ld A Y  # Key 'any'
+                  ld E (E)  # CAAR of 'lst'
+                  call compareAE_F  # Equal?
+                  if eq  # Yes
+                     ld E (X)  # Return CAR of 'lst'
+                     pop Y
+                     pop X
+                     ret
+                  end
+                  ld X (X CDR)
+                  ldc X (X)  # Smaller
+                  ldnc X (X CDR)  # Greater
+               end
+            end
+            atom X  # Reached leaf?
+         until nz  # Yes
+         ld E Nil  # Return NIL
+         pop Y
+      else
+         push E  # <L IV> "from" key
+         ld E (X)  # Eval next
+         eval+
+         push E  # <L III> "to" key
+         push Nil  # <L II> TOS
+         push Nil  # <L I> Result
+         link
+         ld X (L V)  # Get 'lst' in X
+         do
+            do
+               ld A (X CDR)
+               atom (A CDR)  # Right subtree?
+            while z  # Yes
+               ld E (X)  # CAR of 'lst'
+               cmp E TSym  # Is it T?
+            while ne  # No
+               atom E  # Atomic?
+               jnz 10  # Yes
+               ld A (L III)  #  "to" key
+               ld E (E)  # CAAR of 'lst'
+               call compareAE_F  # Greater or equal?
+            while ge  # Yes
+10             ld C X  # Go right
+               ld A (X CDR)
+               ld X (A CDR)  # Invert tree
+               ld (A CDR) (L II)  # TOS
+               ld (L II) C
+            loop
+            ld (L V) X  # Save tree
+            do
+               ld E (X)  # CAR of 'lst'
+               atom E  # Atomic?
+               if z  # No
+                  ld A (L IV)  #  "from" key
+                  ld E (E)  # CAAR of 'lst'
+                  call compareAE_F  # Less or equal?
+                  if le  # Yes
+                     ld A (L III)  #  "to" key
+                     ld E ((X))  # CAAR of 'lst'
+                     call compareAE_F  # Greater or equal?
+                     if ge  # Yes
+                        call cons_A  # Cons value
+                        ld (A) (X)
+                        ld (A CDR) (L I)  # Into result
+                        ld (L I) A
+                     end
+                     ld A (X CDR)  # Left subtree?
+                     atom (A)
+                     if z  # Yes
+                        ld C X  # Go left
+                        ld X (A)  # Invert tree
+                        ld (A) (L II)  # TOS
+                        or C SYM  # First visit
+                        ld (L II) C
+                        ld (L V) X  # Save tree
+                        break T
+                     end
+                  end
+               end
+               do
+                  ld A (L II)  # TOS
+                  cmp A Nil  # Empty?
+                  if eq  # Yes
+                     ld E (L I)  # Return result
+                     drop
+                     pop X
+                     ret
+                  end
+                  sym A  # Second visit?
+                  if z  # Yes
+                     ld C (A CDR)  # Nodes
+                     ld (L II) (C CDR)  # TOS on up link
+                     ld (C CDR) X
+                     ld X A
+                     ld (L V) X  # Save tree
+                     break T
+                  end
+                  off A SYM  # Set second visit
+                  ld C (A CDR)  # Nodes
+                  ld (L II) (C)
+                  ld (C) X
+                  ld X A
+                  ld (L V) X  # Save tree
+               loop
+            loop
+         loop
+      end
+   end
+   pop X
+   ret
+
+### Property access ###
+(code 'setAE 0)
+   ld (A) E  # Set value
+   ret
+
+(code 'putACE 0)
+   zero C  # Key is zero?
+   jeq setAE  # Yes
+   push X
+   ld X (A TAIL)  # Properties
+   num X  # Any?
+   if z  # Yes
+      off X SYM  # Clear 'extern' tag
+      atom (X)  # First property atomic?
+      if nz  # Yes
+         cmp C (X)  # Found flag?
+         if eq  # Yes
+            cmp E Nil  # Value NIL?
+            if eq  # Yes
+10             ld X (X CDR)  # Remove property
+               sym (A TAIL)  # Extern?
+               if nz  # Yes
+                  or X SYM  # Set 'extern' tag
+               end
+               ld (A TAIL) X
+20             pop X
+               ret
+            end
+            cmp E TSym  # Value T?
+            jeq 20  # No change
+            push C
+            call consE_C  # New property cell
+            ld (C) E
+            pop (C CDR)
+            ld (X) C
+            pop X
+            ret
+         end
+      else
+         cmp C ((X) CDR)  # Found property?
+         if eq  # Yes
+            cmp E Nil  # Value NIL?
+            jeq 10  # Yes
+            cmp E TSym  # Value T?
+            if ne  # No
+               ld ((X)) E  # Set new value
+            else
+               ld (X) C  # Change to flag
+            end
+            pop X
+            ret
+         end
+      end
+      push Y
+      do
+         ld Y (X CDR)  # Next property
+         atom Y  # Any?
+      while z  # Yes
+         atom (Y)  # Atomic?
+         if nz  # Yes
+            cmp C (Y)  # Found flag?
+            if eq  # Yes
+               cmp E Nil  # Value NIL?
+               if eq  # Yes
+                  ld (X CDR) (Y CDR)  # Remove cell
+               else
+                  cmp E TSym  # Value T?
+                  if ne  # No
+                     push C
+                     call consE_C  # New property cell
+                     ld (C) E
+                     pop (C CDR)
+                     ld (Y) C  # Store
+                  end
+                  ld (X CDR) (Y CDR)  # Unlink cell
+                  ld X (A TAIL)  # Get tail
+                  sym X  # Extern?
+                  if z  # No
+                     ld (Y CDR) X  # Insert cell in front
+                  else
+                     off X SYM  # Clear 'extern' tag
+                     ld (Y CDR) X  # Insert cell in front
+                     or Y SYM  # Set 'extern' tag
+                  end
+                  ld (A TAIL) Y
+                  pop Y
+                  pop X
+                  ret
+               end
+            end
+         else
+            cmp C ((Y) CDR)  # Found property?
+            if eq  # Yes
+               cmp E Nil  # Value NIL?
+               if eq  # Yes
+                  ld (X CDR) (Y CDR)  # Remove cell
+               else
+                  cmp E TSym  # Value T?
+                  if ne  # No
+                     ld ((Y)) E  # Set new value
+                  else
+                     ld (Y) C  # Change to flag
+                  end
+                  ld (X CDR) (Y CDR)  # Unlink cell
+                  ld X (A TAIL)  # Get tail
+                  sym X  # Extern?
+                  if z  # No
+                     ld (Y CDR) X  # Insert cell in front
+                  else
+                     off X SYM  # Clear 'extern' tag
+                     ld (Y CDR) X  # Insert cell in front
+                     or Y SYM  # Set 'extern' tag
+                  end
+                  ld (A TAIL) Y
+                  pop Y
+                  pop X
+                  ret
+               end
+            end
+         end
+         ld X Y
+      loop
+      pop Y
+      ld X (A TAIL)  # Get properties again
+   end
+   cmp E Nil  # Value Non-NIL?
+   if ne  # Yes
+      cmp E TSym  # Flag?
+      if ne  # No
+         push C
+         call consE_C  # New property cell
+         ld (C) E
+         pop (C CDR)
+      end
+      push C
+      call consC_C  # New first property
+      pop (C)
+      sym X  # Extern?
+      if z  # No
+         ld (C CDR) X
+      else
+         off X SYM  # Clear 'extern' tag
+         ld (C CDR) X
+         or C SYM  # Set 'extern' tag
+      end
+      ld (A TAIL) C  # Set new tail
+   end
+   pop X
+   ret
+
+(code 'getnECX_E 0)
+   num E  # Need symbol or cell
+   jnz argErrEX
+   atom E  # List?
+   if z  # Yes
+      num C  # Numeric key?
+      if nz  # Yes
+         shr C 4  # Positive?
+         if nc  # Yes
+            jz retNil  # Return NIL if zero
+            do
+               sub C 1  # nth
+               jz retE_E
+               ld E (E CDR)
+            loop
+         end
+         # Key is negative
+         do
+            ld E (E CDR)
+            sub C 1  # nth
+         until z
+         ret
+      end
+      do  # asoq
+         atom (E)  # CAR atomic?
+         if z  # No
+            cmp C ((E))  # Found?
+            break eq  # Yes
+         end
+         ld E (E CDR)  # Next
+         atom E  # Done?
+         jnz retNil  # Return NIL
+      loop
+      ld E ((E) CDR)  # Return CDAR
+      ret
+   end
+   # E is symbolic
+   sym (E TAIL)  # External symbol?
+   if nz  # Yes
+      call dbFetchEX  # Fetch it
+   end
+(code 'getEC_E 0)
+   zero C  # Key is zero?
+   jeq retE_E  # Get value
+   ld A (E TAIL)  # Get tail
+   num A  # No properties?
+   jnz retNil  # Return NIL
+   off A SYM  # Clear 'extern' tag
+   atom (A)  # First property atomic?
+   if nz  # Yes
+      cmp C (A)  # Found flag?
+      jeq retT  # Return T
+   else
+      cmp C ((A) CDR)  # Found property?
+      if eq  # Yes
+         ld E ((A))  # Return value
+         ret
+      end
+   end
+   push X
+   do
+      ld X (A CDR)  # Next property
+      atom X  # Any?
+   while z  # Yes
+      atom (X)  # Atomic?
+      if nz  # Yes
+         cmp C (X)  # Found flag?
+         if eq  # Yes
+            ld (A CDR) (X CDR)  # Unlink cell
+            ld A (E TAIL)  # Get tail
+            sym A  # Extern?
+            if z  # No
+               ld (X CDR) A  # Insert cell in front
+            else
+               off A SYM  # Clear 'extern' tag
+               ld (X CDR) A  # Insert cell in front
+               or X SYM  # Set 'extern' tag
+            end
+            ld (E TAIL) X
+            ld E TSym  # Return T
+            pop X
+            ret
+         end
+      else
+         cmp C ((X) CDR)  # Found property?
+         if eq  # Yes
+            ld (A CDR) (X CDR)  # Unlink cell
+            ld A (E TAIL)  # Get tail
+            sym A  # Extern?
+            if z  # No
+               ld (X CDR) A  # Insert cell in front
+               ld (E TAIL) X
+               ld E ((X))  # Return value
+            else
+               off A SYM  # Clear 'extern' tag
+               ld (X CDR) A  # Insert cell in front
+               ld A ((X))  # Return value
+               or X SYM  # Set 'extern' tag
+               ld (E TAIL) X
+               ld E A
+            end
+            pop X
+            ret
+         end
+      end
+      ld A X
+   loop
+   ld E Nil  # Return NIL
+   pop X
+   ret
+
+(code 'propEC_E 0)
+   ld A (E TAIL)  # Get tail
+   num A  # No properties?
+   jnz retNil  # Return NIL
+   off A SYM  # Clear 'extern' tag
+   atom (A)  # First property atomic?
+   if nz  # Yes
+      cmp C (A)  # Found flag?
+      if eq  # Yes
+         ld E C  # Return key
+         ret
+      end
+   else
+      cmp C ((A) CDR)  # Found property?
+      if eq  # Yes
+         ld E (A)  # Return property
+         ret
+      end
+   end
+   push X
+   do
+      ld X (A CDR)  # Next property
+      atom X  # Any?
+   while z  # Yes
+      atom (X)  # Atomic?
+      if nz  # Yes
+         cmp C (X)  # Found flag?
+         if eq  # Yes
+            ld (A CDR) (X CDR)  # Unlink cell
+            ld A (E TAIL)  # Get tail
+            sym A  # Extern?
+            if z  # No
+               ld (X CDR) A  # Insert cell in front
+            else
+               off A SYM  # Clear 'extern' tag
+               ld (X CDR) A  # Insert cell in front
+               or X SYM  # Set 'extern' tag
+            end
+            ld (E TAIL) X
+            ld E C  # Return key
+            pop X
+            ret
+         end
+      else
+         cmp C ((X) CDR)  # Found property?
+         if eq  # Yes
+            ld (A CDR) (X CDR)  # Unlink cell
+            ld A (E TAIL)  # Get tail
+            sym A  # Extern?
+            if z  # No
+               ld (X CDR) A  # Insert cell in front
+               ld (E TAIL) X
+               ld E (X)  # Return property
+            else
+               off A SYM  # Clear 'extern' tag
+               ld (X CDR) A  # Insert cell in front
+               ld A (X)  # Return property
+               or X SYM  # Set 'extern' tag
+               ld (E TAIL) X
+               ld E A
+            end
+            pop X
+            ret
+         end
+      end
+      ld A X
+   loop
+   ld E Nil  # Return NIL
+   pop X
+   ret
+
+# (put 'sym1|lst ['sym2|cnt ..] 'sym|0 'any) -> any
+(code 'doPut 2)
+   push X
+   push Y
+   ld X E
+   ld Y (E CDR)  # Y on args
+   ld E (Y)  # Eval first
+   eval
+   link
+   push E  # <L II> 'sym1|lst' item
+   ld Y (Y CDR)
+   ld E (Y)  # Eval second
+   eval+
+   push E  # <L I> 'sym2|cnt' key
+   link
+   do
+      ld Y (Y CDR)  # Args
+      atom (Y CDR)  # More than one?
+   while z  # Yes
+      ld C E  # Key
+      ld E (L II)  # Current item
+      call getnECX_E
+      ld (L II) E  # Store item
+      ld E (Y)
+      eval  # Eval next arg
+      ld (L I) E  # Save it
+   loop
+   ld E (L II)  # Get item
+   num E  # Need symbol
+   jnz symErrEX
+   sym E
+   jz symErrEX
+   cmp E Nil  # Can't be NIL
+   jeq protErrEX
+   ld E (Y)  # Eval 'any'
+   eval
+   ld A (L II)  # Get symbol
+   sym (A TAIL)  # External symbol?
+   if nz  # Yes
+      push E  # Save 'any'
+      ld E A  # Get symbol
+      call dbTouchEX  # Touch it
+      ld A E
+      pop E
+   end
+   ld C (L I)  # Get key
+   call putACE  # Put value or propery
+   drop
+   pop Y
+   pop X
+   ret
+
+# (get 'sym1|lst ['sym2|cnt ..]) -> any
+(code 'doGet 2)
+   push X
+   push Y
+   ld X E
+   ld Y (E CDR)  # Y on args
+   ld E (Y)  # Eval first
+   eval
+   ld Y (Y CDR)  # Next arg?
+   atom Y
+   if z  # Yes
+      link
+      push E  # <L I> 'sym|lst' item
+      link
+      do
+         ld E (Y)
+         eval  # Eval next arg
+         ld C E  # Key
+         ld E (L I)  # Current item
+         call getnECX_E
+         ld Y (Y CDR)  # More args?
+         atom Y
+      while z  # Yes
+         ld (L I) E  # Save item
+      loop
+      drop
+   end
+   pop Y
+   pop X
+   ret
+
+# (prop 'sym1|lst ['sym2|cnt ..] 'sym) -> lst|sym
+(code 'doProp 2)
+   push X
+   push Y
+   ld X E
+   ld Y (E CDR)  # Y on args
+   ld E (Y)  # Eval first
+   eval
+   link
+   push E  # <L II> 'sym|lst' item
+   ld Y (Y CDR)  # Next arg
+   ld E (Y)
+   eval+  # Eval next arg
+   push E  # <L I> 'sym2|cnt' key
+   link
+   do
+      ld Y (Y CDR)  # More args?
+      atom Y
+   while z  # Yes
+      ld C E  # Key
+      ld E (L II)  # Current item
+      call getnECX_E
+      ld (L II) E  # Store item
+      ld E (Y)
+      eval  # Eval next arg
+      ld (L I) E  # Save it
+   loop
+   ld E (L II)  # Get item
+   num E  # Need symbol
+   jnz symErrEX
+   sym E
+   jz symErrEX
+   sym (E TAIL)  # External symbol?
+   if nz  # Yes
+      call dbFetchEX  # Fetch it
+   end
+   ld C (L I)  # Get key
+   call propEC_E
+   drop
+   pop Y
+   pop X
+   ret
+
+# (; 'sym1|lst [sym2|cnt ..]) -> any
+(code 'doSemicol 2)
+   push X
+   push Y
+   ld X E
+   ld Y (E CDR)  # Y on args
+   ld E (Y)  # Eval first
+   eval
+   ld Y (Y CDR)  # Next arg?
+   atom Y
+   if z  # Yes
+      link
+      push E  # <L I> 'sym|lst' item
+      link
+      do
+         ld C (Y)  # Key
+         ld E (L I)  # Current item
+         call getnECX_E
+         ld Y (Y CDR)  # More args?
+         atom Y
+      while z  # Yes
+         ld (L I) E  # Save item
+      loop
+      drop
+   end
+   pop Y
+   pop X
+   ret
+
+# (=: sym|0 [sym1|cnt .. sym2|0] 'any) -> any
+(code 'doSetCol 2)
+   push X
+   push Y
+   ld X E
+   ld Y (E CDR)  # Y on args
+   ld E (This)  # Get value of This
+   sym (E TAIL)  # External symbol?
+   if nz  # Yes
+      call dbFetchEX  # Fetch it
+   end
+   ld C (Y)  # sym1|cnt
+   ld Y (Y CDR)  # Args
+   atom (Y CDR)  # More than one?
+   if z  # Yes
+      call getEC_E
+      do
+         ld C (Y)  # sym2|cnt
+         ld Y (Y CDR)  # Args
+         atom (Y CDR)  # More than one?
+      while z  # Yes
+         call getnECX_E
+      loop
+   end
+   num E  # Need symbol
+   jnz symErrEX
+   sym E
+   jz symErrEX
+   cmp E Nil  # Can't be NIL
+   jeq protErrEX
+   sym (E TAIL)  # External symbol?
+   if nz  # Yes
+      call dbTouchEX  # Touch it
+   end
+   push C  # Save key
+   push E  # Save symbol
+   ld E (Y)  # Eval 'any'
+   eval
+   pop A  # Retrieve symbol
+   pop C  # and key
+   call putACE  # Put value or propery
+   pop Y
+   pop X
+   ret
+
+# (: sym|0 [sym1|cnt ..]) -> any
+(code 'doCol 2)
+   push X
+   push Y
+   ld X E
+   ld Y (E CDR)  # Y on args
+   ld E (This)  # Get value of This
+   sym (E TAIL)  # External symbol?
+   if nz  # Yes
+      call dbFetchEX  # Fetch it
+   end
+   ld C (Y)  # Next key
+   call getEC_E
+   do
+      ld Y (Y CDR)  # More args?
+      atom Y
+   while z  # Yes
+      ld C (Y)  # Next key
+      call getnECX_E
+   loop
+   pop Y
+   pop X
+   ret
+
+# (:: sym|0 [sym1|cnt .. sym2]) -> lst|sym
+(code 'doPropCol 2)
+   push X
+   push Y
+   ld X E
+   ld Y (E CDR)  # Y on args
+   ld E (This)  # Get value of This
+   sym (E TAIL)  # External symbol?
+   if nz  # Yes
+      call dbFetchEX  # Fetch it
+   end
+   ld C (Y)  # Next key
+   atom (Y CDR)  # More than one arg?
+   if z  # Yes
+      call getEC_E
+      do
+         ld Y (Y CDR)
+         ld C (Y)  # Next key
+         atom (Y CDR)  # More than one arg?
+      while z  # Yes
+         call getnECX_E
+      loop
+   end
+   call propEC_E
+   pop Y
+   pop X
+   ret
+
+# (putl 'sym1|lst1 ['sym2|cnt ..] 'lst) -> lst
+(code 'doPutl 2)
+   push X
+   push Y
+   ld X E
+   ld Y (E CDR)  # Y on args
+   ld E (Y)  # Eval first
+   eval
+   link
+   push E  # <L II> 'sym|lst' item
+   ld Y (Y CDR)  # Next arg
+   ld E (Y)
+   eval+  # Eval next arg
+   push E  # <L I> 'sym2|cnt' key
+   link
+   do
+      ld Y (Y CDR)  # More args?
+      atom Y
+   while z  # Yes
+      ld C E  # Key
+      ld E (L II)  # Current item
+      call getnECX_E
+      ld (L II) E  # Store item
+      ld E (Y)
+      eval  # Eval next arg
+      ld (L I) E  # Save it
+   loop
+   ld E (L II)  # Get item
+   num E  # Need symbol
+   jnz symErrEX
+   sym E
+   jz symErrEX
+   cmp E Nil  # Can't be NIL
+   jeq protErrEX
+   sym (E TAIL)  # External symbol?
+   if nz  # Yes
+      call dbTouchEX  # Touch it
+   end
+   ld X (E TAIL)  # Skip old properties
+   off X SYM  # Clear 'extern' tag
+   do
+      num X  # More properties?
+   while z  # Yes
+      ld X (X CDR)
+   loop
+   ld Y (L I)  # New property list
+   do
+      atom Y  # Any?
+   while z  # Yes
+      ld C (Y)
+      atom C  # Flag?
+      if nz  # Yes
+         ld A X
+         call consA_X  # New property cell
+         ld (X) C
+         ld (X CDR) A
+      else
+         cmp (C) Nil  # Value Nil?
+         if ne  # No
+            cmp (C) TSym  # Flag?
+            if eq  # Yes
+               ld C (C CDR)  # Get key
+            end
+            ld A X
+            call consA_X  # New property cell
+            ld (X) C
+            ld (X CDR) A
+         end
+      end
+      ld Y (Y CDR)
+   loop
+   sym (E TAIL)  # Extern?
+   if nz  # Yes
+      or X SYM  # Set 'extern' tag
+   end
+   ld (E TAIL) X
+   ld E (L I)  # Return new property list
+   drop
+   pop Y
+   pop X
+   ret
+
+# (getl 'sym1|lst1 ['sym2|cnt ..]) -> lst
+(code 'doGetl 2)
+   push X
+   push Y
+   ld X E
+   ld Y (E CDR)  # Y on args
+   ld E (Y)  # Eval first
+   eval
+   link
+   push E  # <L I> 'sym|lst' item
+   link
+   do
+      ld Y (Y CDR)  # More args?
+      atom Y
+   while z
+      ld E (Y)
+      eval  # Eval next arg
+      ld C E  # Key
+      ld E (L I)  # Current item
+      call getnECX_E
+      ld (L I) E  # Save item
+   loop
+   num E  # Need symbol
+   jnz symErrEX
+   sym E
+   jz symErrEX
+   sym (E TAIL)  # External symbol?
+   if nz  # Yes
+      call dbFetchEX  # Fetch it
+   end
+   ld X (E TAIL)  # Get tail
+   num X  # No properties?
+   if nz  # Yes
+      ld E Nil
+   else
+      off X SYM  # Clear 'extern' tag
+      call cons_C  # Copy first cell
+      ld (C) (X)
+      ld (C CDR) Nil
+      tuck C  # Save it
+      link
+      do
+         ld X (X CDR)  # More properties?
+         atom X
+      while z  # Yes
+         call cons_A  # Copy next cell
+         ld (A) (X)
+         ld (A CDR) Nil
+         ld (C CDR) A  # Append
+         ld C A
+      loop
+      ld E (L I)  # Get result
+   end
+   drop
+   pop Y
+   pop X
+   ret
+
+# (wipe 'sym|lst) -> sym
+(code 'doWipe 2)
+   ld E ((E CDR))  # Get arg
+   eval  # Eval it
+   cmp E Nil  # NIL?
+   if ne  # No
+      atom E  # List?
+      if nz  # No
+         call wipeE  # Wipe it
+      else
+         push E  # Save
+         ld C E  # Get list
+         do
+            ld E (C)  # Next symbol
+            call wipeE  # Wipe it
+            ld C (C CDR)
+            atom C  # More?
+         until nz  # No
+         pop E
+      end
+   end
+   ret
+
+(code 'wipeE 0)
+   ld A (E TAIL)  # Get tail
+   sym A  # Extern?
+   if z  # No
+      call nameA_A  # Get name
+      ld (E) Nil  # Clear value
+      ld (E TAIL) A  # And properties
+      ret
+   end
+   call nameA_A  # Get name
+   shl A 1  # Dirty?
+   if nc  # No
+      shl A 1  # Loaded?
+      if c  # Yes
+         clrc  # Set "not loaded"
+         rcr A 1
+         rcr A 1
+         ld (E) Nil  # Clear value
+         or A SYM  # Set 'extern' tag
+         ld (E TAIL) A
+      end
+   end
+   ret
+
+# (meta 'obj|typ 'sym ['sym2|cnt ..]) -> any
+(code 'doMeta 2)
+   push X
+   push Y
+   ld X E
+   ld Y (E CDR)  # Y on args
+   ld E (Y)  # Eval first
+   eval
+   link
+   push E  # <L I> 'obj|typ'
+   link
+   num E  # Need symbol or cell
+   jnz argErrEX
+   sym E  # Symbol?
+   if nz  # Yes
+      sym (E TAIL)  # External symbol?
+      if nz  # Yes
+         call dbFetchEX  # Fetch it
+      end
+      ld (L I) (E)  # Get value
+   end
+   ld Y (Y CDR)  # Next arg
+   ld E (Y)
+   eval  # Eval next arg
+   ld C E  # Key
+   ld X (L I)  # 'obj|typ'
+   call metaCX_E  # Fetch
+   do
+      ld Y (Y CDR)  # More args?
+      atom Y
+   while z  # Yes
+      ld (L I) E  # Save item
+      ld E (Y)
+      eval  # Eval next arg
+      ld C E  # Key
+      ld E (L I)  # Current item
+      call getnECX_E
+   loop
+   drop
+   pop Y
+   pop X
+   ret
+
+(code 'metaCX_E 0)
+   do
+      atom X  # List?
+      jnz retNil  # No
+      ld E (X)  # Next item
+      num E  # Symbol?
+      if z
+         sym E
+         if nz  # Yes
+            call getEC_E  # Propery
+            cmp E Nil  # found?
+            jne Ret  # No
+            push X
+            ld X ((X))  # Try in superclass(es)
+            call metaCX_E
+            pop X
+            cmp E Nil  # found?
+            jne Ret  # No
+         end
+      end
+      ld X (X CDR)
+   loop
+
+### Case mappings from the GNU Kaffe Project ###
+(code 'caseDataA_AC 0)
+   ld C A  # Keep character in C
+   shr A 4  # Make index
+   off A 1
+   ld2 (A CaseBlocks)  # Get blocks entry
+   add A C  # Add character
+   and A (hex "FFFF")  # Limit to 16 bits
+   shl A 1  # Adjust index
+   ld2 (A CaseData)  # Get case data
+   ret
+
+# (low? 'any) -> sym | NIL
+(code 'doLowQ 2)
+   ld E ((E CDR))  # Get arg
+   eval  # Eval it
+   num E  # Number?
+   jnz retNil  # Yes
+   sym E  # Symbol?
+   jz retNil  # No
+   call firstCharE_A  # Get first character
+   call caseDataA_AC  # Get case info
+   and B (hex "1F")  # Character type
+   cmp B CHAR_LOWERCASE  # Lower case?
+   ldnz E Nil  # No
+   ret
+
+# (upp? 'any) -> sym | NIL
+(code 'doUppQ 2)
+   ld E ((E CDR))  # Get arg
+   eval  # Eval it
+   num E  # Number?
+   jnz retNil  # Yes
+   sym E  # Symbol?
+   jz retNil  # No
+   call firstCharE_A  # Get first character
+   call caseDataA_AC  # Get case info
+   and B (hex "1F")  # Character type
+   cmp B CHAR_UPPERCASE  # Lower case?
+   ldnz E Nil  # No
+   ret
+
+# (lowc 'any) -> any
+(code 'doLowc 2)
+   push X
+   ld E ((E CDR))  # Get arg
+   eval  # Eval it
+   num E  # Number?
+   if z  # No
+      sym E  # Symbol?
+      if nz  # Yes
+         cmp E Nil  # NIL?
+         if ne  # No
+            ld E (E TAIL)
+            call nameE_E  # Get name
+            link
+            push E  # <L II> Name
+            push ZERO  # <L I> Result
+            ld X S
+            link
+            push 4  # <S I> Build name
+            push X  # <S> Pack status
+            ld X (L II) # Get name
+            ld C 0  # Index
+            do
+               call symCharCX_FACX  # Next char?
+            while nz
+               ld E C  # Save C
+               call caseDataA_AC  # Get case info
+               and A (hex "FFFF")
+               shr A 6  # Make index
+               off A 1
+               ld2 (A CaseLower)  # Get lower case entry
+               add A C  # plus character
+               and A (hex "FFFF")
+               ld C (S I)  # Swap status
+               xchg X (S)
+               call charSymACX_CX  # Pack char
+               xchg X (S)  # Swap status
+               ld (S I) C
+               ld C E  # Restore C
+            loop
+            ld X (L I)  # Get result
+            call consSymX_E  # Make transient symbol
+            drop
+         end
+      end
+   end
+   pop X
+   ret
+
+# (uppc 'any) -> any
+(code 'doUppc 2)
+   push X
+   ld E ((E CDR))  # Get arg
+   eval  # Eval it
+   num E  # Number?
+   if z  # No
+      sym E  # Symbol?
+      if nz  # Yes
+         cmp E Nil  # NIL?
+         if ne  # No
+            ld E (E TAIL)
+            call nameE_E  # Get name
+            link
+            push E  # <L II> Name
+            push ZERO  # <L I> Result
+            ld X S
+            link
+            push 4  # <S I> Build name
+            push X  # <S> Pack status
+            ld X (L II) # Get name
+            ld C 0  # Index
+            do
+               call symCharCX_FACX  # Next char?
+            while nz
+               ld E C  # Save C
+               call caseDataA_AC  # Get case info
+               and A (hex "FFFF")
+               shr A 6  # Make index
+               off A 1
+               ld2 (A CaseUpper)  # Get upper case entry
+               add A C  # plus character
+               and A (hex "FFFF")
+               ld C (S I)  # Swap status
+               xchg X (S)
+               call charSymACX_CX  # Pack char
+               xchg X (S)  # Swap status
+               ld (S I) C
+               ld C E  # Restore C
+            loop
+            ld X (L I)  # Get result
+            call consSymX_E  # Make transient symbol
+            drop
+         end
+      end
+   end
+   pop X
+   ret
+
+# (fold 'any ['cnt]) -> sym
+(code 'doFold 2)
+   push X
+   push Y
+   ld X E
+   ld Y (E CDR)  # Y on args
+   ld E (Y)  # Eval first
+   eval
+   num E  # Number?
+   if z  # No
+      sym E  # Symbol?
+      if nz  # Yes
+         cmp E Nil  # NIL?
+         if ne
+            ld E (E TAIL)
+            call nameE_E  # Get name
+            link
+            push E  # <L II> Name
+            push ZERO  # <L I> Result
+            link
+            ld Y (Y CDR)  # Next arg?
+            atom Y
+            if nz  # No
+               push 24  # <S II> Default 'cnt' 24
+            else
+               call evCntXY_FE  # Eval 'cnt'
+               push E  # <S II> 'cnt'
+            end
+            push 4  # <S I> Build name
+            lea X (L I)
+            push X  # <S> Pack status
+            ld X (L II) # Get name
+            ld C 0  # Index
+            do
+               call symCharCX_FACX  # Next char?
+            while nz
+               ld E C  # Save C
+               call isLetterOrDigitA_F  # Letter or digit?
+               if nz  # Yes
+                  sub (S II) 1  # Decrement 'cnt'
+                  break s
+                  call caseDataA_AC  # Get case info
+                  and A (hex "FFFF")
+                  shr A 6  # Make index
+                  off A 1
+                  ld2 (A CaseLower)  # Get lower case entry
+                  add A C  # plus character
+                  and A (hex "FFFF")
+                  ld C (S I)  # Swap status
+                  xchg X (S)
+                  call charSymACX_CX  # Pack char
+                  xchg X (S)  # Swap status
+                  ld (S I) C
+               end
+               ld C E  # Restore C
+            loop
+            ld X (L I)  # Get result
+            call consSymX_E  # Make transient symbol
+            drop
+         end
+      end
+   end
+   pop Y
+   pop X
+   ret
+
+(code 'isLetterOrDigitA_F 0)  # C
+   push A
+   call caseDataA_AC  # Get case info
+   and B (hex "1F")  # Character type
+   ld C 1
+   zxt
+   shl C A
+   test C (| CHAR_DIGIT CHAR_LETTER)
+   pop A
+   ret
+
+# vi:et:ts=3:sw=3
diff --git a/src64/sys/linux.code.l b/src64/sys/linux.code.l
@@ -0,0 +1,39 @@
+# 02oct09abu
+# (c) Software Lab. Alexander Burger
+
+# System macros
+(code 'errno_A 0)
+   call __errno_location  # Get address of 'errno'
+   ld A (A)  # Load value
+   ret
+
+(code 'errnoC 0)
+   call __errno_location  # Get address of 'errno'
+   ld (A) C  # Store new value
+   ret
+
+(code 's_isdirS_F 0)  # S_ISDIR
+   ld4 (S `(+ I ST_MODE))  # Get 'st_mode' from 'stat'
+   and A `S_IFMT
+   cmp A `S_IFDIR
+   ret
+
+(code 'wifstoppedS_F 0)  # WIFSTOPPED
+   ld A (S I)  # Get status
+   cmp B `(hex "7F")  # (((status) & 0xff) == 0x7f)
+   ret
+
+(code 'wifsignaledS_F 0)  # WIFSIGNALED
+   ld A (S I)  # Get status
+   and B `(hex "7F")  # (((status) & 0x7f) + 1) >> 1) > 0)
+   add B 1
+   shr B 1
+   ret
+
+(code 'wtermsigS_A 0)  # WTERMSIG
+   ld A (S I)  # Get status
+   and B `(hex "7F")  # ((status) & 0x7f)
+   zxt
+   ret
+
+# vi:et:ts=3:sw=3
diff --git a/src64/sys/linux.defs.l b/src64/sys/linux.defs.l
@@ -0,0 +1,145 @@
+# 09sep09abu
+# (c) Software Lab. Alexander Burger
+
+# errno
+(equ ENOENT 2)       # No such file or directory
+(equ EINTR 4)        # Interrupted system call
+(equ EBADF 9)        # Bad file number
+(equ EAGAIN 11)      # Try again
+(equ EACCES 13)      # Permission denied
+(equ EPIPE 32)       # Broken pipe
+(equ ECONNRESET 104) # Connection reset by peer
+
+# open/fcntl
+(equ O_RDONLY 0)
+(equ O_WRONLY 1)
+(equ O_RDWR 2)
+(equ O_CREAT 64)
+(equ O_EXCL 128)
+(equ O_TRUNC 512)
+(equ O_APPEND 1024)
+(equ F_GETFD 1)
+(equ F_SETFD 2)
+(equ FD_CLOEXEC 1)
+
+# stdio
+(equ BUFSIZ 8192)
+(equ PIPE_BUF 4096)
+
+# dlfcn
+(equ RTLD_LAZY 1)
+(equ RTLD_GLOBAL 256)
+
+# fcntl
+(equ FLOCK 32)    # File lock structure
+(equ L_TYPE 0)  # 2
+(equ L_WHENCE 2)  # 2
+(equ L_START 8)
+(equ L_LEN 16)
+(equ L_PID 24)
+(equ SEEK_SET 0)
+(equ SEEK_CUR 1)
+(equ F_RDLCK 0)
+(equ F_WRLCK 1)
+(equ F_UNLCK 2)
+(equ F_GETFL 3)
+(equ F_SETFL 4)
+(equ F_GETLK 5)
+(equ F_SETLK 6)
+(equ F_SETLKW 7)
+(equ O_NONBLOCK 2048)
+
+# stat
+(equ STAT 144)    # File status structure
+(equ ST_MODE 24)  # 4
+(equ ST_SIZE 48)
+(equ ST_MTIME 88)
+(equ S_IFMT (hex "F000"))
+(equ S_IFDIR (hex "4000"))
+
+# times
+(equ TMS 32)  # 'times' structure
+(equ TMS_UTIME 0)
+(equ TMS_STIME 8)
+
+# termios
+(equ TERMIOS (+ 60 4))  # Terminal I/O structure (+ Padding)
+(equ C_IFLAG 0)
+(equ C_LFLAG 12)
+(equ C_CC 17)
+(equ ISIG 1)
+(equ VMIN 6)
+(equ VTIME 5)
+(equ TCSADRAIN 1)
+
+# signal
+(equ SIGACTION 152)  # Sigaction structure
+(equ SIGSET_T 128)
+(equ SA_HANDLER 0)
+(equ SA_MASK 8)
+(equ SA_FLAGS 136)
+
+(equ SIG_DFL 0)
+(equ SIG_IGN 1)
+(equ SIG_UNBLOCK 1)
+
+(equ SIGHUP 1)  # Signals
+(equ SIGINT 2)
+(equ SIGUSR1 10)
+(equ SIGUSR2 12)
+(equ SIGPIPE 13)
+(equ SIGALRM 14)
+(equ SIGTERM 15)
+(equ SIGCHLD 17)
+(equ SIGCONT 18)
+(equ SIGSTOP 19)
+(equ SIGTSTP 20)
+(equ SIGTTIN 21)
+(equ SIGTTOU 22)
+
+# wait
+(equ WNOHANG 1)
+(equ WUNTRACED 2)
+
+# poll
+(equ POLLFD 8)
+(equ POLL_EVENTS 4)  # 2
+(equ POLL_REVENTS 6)  # 2
+(equ POLLIN 1)
+(equ POLLOUT 4)
+(equ POLLHUP 16)
+(equ POLLNVAL 32)
+
+# time
+(equ TM_SEC 0)
+(equ TM_MIN 4)
+(equ TM_HOUR 8)
+(equ TM_MDAY 12)
+(equ TM_MON 16)
+(equ TM_YEAR 20)
+
+# dir
+(equ D_NAME 19)
+
+# Sockets
+(equ HOSTENT 32)
+(equ H_NAME 0)
+(equ H_LENGTH 20)
+(equ H_ADDR_LIST 24)
+
+(equ IN_ADDR 4)
+(equ S_ADDR 0)
+
+(equ SOCKADDR_IN 16)
+(equ SIN_ADDR 4)
+(equ SIN_ADDR.S_ADDR 4)
+(equ SIN_PORT 2)
+(equ SIN_FAMILY 0)
+(equ AF_INET 2)
+(equ SOCK_STREAM 1)
+(equ SOCK_DGRAM 2)
+(equ INADDR_ANY 0)
+(equ SOL_SOCKET 1)
+(equ SO_REUSEADDR 2)
+
+# vi:et:ts=3:sw=3
diff --git a/src64/version.l b/src64/version.l
@@ -0,0 +1,6 @@
+# 22apr10abu
+# (c) Software Lab. Alexander Burger
+
+(de *Version 3 0 2 13)
+
+# vi:et:ts=3:sw=3
diff --git a/test/lib.l b/test/lib.l
@@ -0,0 +1,201 @@
+# 18mar10abu
+# (c) Software Lab. Alexander Burger
+
+### task ###
+(test (3 . 4)
+   (let (*Run NIL  *A NIL  *B NIL)
+      (task -10 0 (setq *A 3))
+      (task (port T 4444) (eval (udp @)))
+      (udp "localhost" 4444 '(setq *B 4))
+      (wait NIL (and *A *B))
+      (cons *A *B) ) )
+
+
+### timeout ###
+(test '((-1 3600000 (bye)))
+   (let *Run NIL
+      (timeout 3600000)
+      *Run ) )
+
+
+### abort ###
+(test 6 (abort 2 (+ 1 2 3)))
+(test NIL (abort 2 (wait 4000)))
+
+
+### macro ###
+(test 6
+   (let (@A 1  @B 2  @C 3)
+      (macro (* @A @B @C)) ) )
+
+
+### later ###
+(test '((@ . 1) (@ . 4) (@ . 9) (@ . 16) (@ . 25) (@ . 36))
+   (prog1
+      (mapcan
+         '((N) (later (cons) (cons *Pid (* N N))))
+         (1 2 3 4 5 6) )
+      (wait NIL (full @)) ) )
+
+
+### recur recurse ###
+(test 720
+   (let N 6
+      (recur (N)
+         (if (=0 N)
+            1
+            (* N (recurse (dec N))) ) ) ) )
+
+
+### curry ###
+(test '((N) (* 7 N))
+   ((quote (@X) (curry (@X) (N) (* @X N))) 7) )
+(test 21
+   (((quote (@X) (curry (@X) (N) (* @X N))) 7) 3) )
+(test '((N) (job '((A . 1)) (+ A 7 N)))
+   (let (A 1 @X 7) (curry (A @X) (N) (+ A @X N))) )
+
+
+### getd ###
+(test car (getd 'car))
+(test '((File . @) (load File))
+   (getd 'script) )
+(test NIL (getd 1))
+
+
+### expr subr undef ###
+(let foo car
+   (test 7 (foo (7)))
+   (test T (== 'pass (caadr (expr 'foo))))
+   (test car (subr 'foo))
+   (test car (undef 'foo))
+   (test NIL (val 'foo)) )
+
+
+### redef ###
+(let foo inc
+   (redef foo (N) (inc (foo N)))
+   (test 3 (foo 1)) )
+
+
+### daemon patch ###
+(let foo car
+   (daemon 'foo (msg 'daemon))
+   (test T (= '(msg 'daemon) (cadr (getd 'foo))))
+   (patch foo 'daemon 'patch)
+   (test T (= '(msg 'patch) (cadr (getd 'foo)))) )
+
+
+### scl ###
+(scl 0)
+(test 123 (any "123.45")))
+(scl 1)
+(test 1235 (any "123.45")))
+(scl 3)
+(test 123450 (any "123.45")))
+
+
+### script ###
+(out (tmp "script")
+   (println '(pass * 7)) )
+(test 42 (script (tmp "script") 2 3))
+
+
+### once ###
+(let N 0
+   (test 1
+      (once (inc 'N))
+      (once (inc 'N))
+      N ) )
+
+
+### rc ###
+(let F (tmp "rc")
+   (rc F 'a 123)
+   (rc F 'b "test")
+   (rc F 'c (1 2 3))
+   (test '((c 1 2 3) (b . "test") (a . 123))
+      (in F (read)) )
+   (test 123 (rc F 'a))
+   (test "test" (rc F 'b))
+   (test (1 2 3) (rc F 'c)) )
+
+
+### acquire release ###
+(let F (tmp "sema")
+   (test *Pid (acquire F))
+   (test T (acquire F))
+   (test *Pid (in F (rd)))
+   (test NIL (release F))
+   (test NIL (in F (rd))) )
+
+
+### insert ###
+(test '(a b 777 c d e) (insert 3 '(a b c d e) 777))
+(test (777 a b c d e) (insert 1 '(a b c d e) 777))
+(test '(a b c d e 777) (insert 9 '(a b c d e) 777))
+
+
+### remove ###
+(test '(a b d e) (remove 3 '(a b c d e)))
+(test '(b c d e) (remove 1 '(a b c d e)))
+(test '(a b c d e) (remove 9 '(a b c d e)))
+
+
+### place ###
+(test '(a b 777 d e) (place 3 '(a b c d e) 777))
+(test (777 b c d e) (place 1 '(a b c d e) 777))
+(test '(a b c d e 777) (place 9 '(a b c d e) 777))
+
+
+### uniq ###
+(test (2 4 6 1 3 5) (uniq (2 4 6 1 2 3 4 5 6 1 3 5)))
+
+
+### group ###
+(test '((1 a b c) (2 d e f))
+   (group '((1 . a) (1 . b) (1 . c) (2 . d) (2 . e) (2 . f))) )
+
+
+### qsym ###
+(let "A" 1234
+   (put '"A" 'a 1)
+   (put '"A" 'b 2)
+   (put '"A" 'f T)
+   (test (1234 f (2 . b) (1 . a))
+      (qsym . "A") ) )
+
+### loc ###
+(let (X 'foo  bar '((A B) (foo B A)))
+   (test "foo" (zap 'foo))
+   (test "foo" (str? "foo"))
+   (test T (== X (loc "foo" bar))) )
+
+
+### class ###
+(off "+A" "+B" "+C")
+(test '"+A" (class "+A" "+B" "+C"))
+(test '"+A" *Class)
+(test '("+B" "+C") "+A")
+
+
+### object ###
+(off "Obj")
+(test '"Obj"
+   (object '"Obj" '("+A" "+B" "+C")  'a 1 'b 2 'c 3) )
+(test '((3 . c) (2 . b) (1 . a)) (getl '"Obj"))
+
+
+### extend var var: ###
+(test '"+B" (extend "+B"))
+(test T (== *Class '"+B"))
+
+(test 1 (var a . 1))
+(test 2 (var b . 2))
+(test '((2 . b) (1 . a)) (getl '"+B"))
+
+(with '"Obj"
+   (test 1 (var: a))
+   (test 2 (var: b)) )
+
+# vi:et:ts=3:sw=3
diff --git a/test/lib/lint.l b/test/lib/lint.l
@@ -0,0 +1,21 @@
+# 26mar09abu
+# (c) Software Lab. Alexander Burger
+
+### noLint ###
+(let foo '(() (bar FreeVariable))
+   (use *NoLint
+      (noLint 'bar)
+      (noLint 'foo 'FreeVariable)
+      (test NIL (lint 'foo)) ) )
+
+
+### lint ###
+(let foo '((R S T R) (let N 7 (bar X Y)))
+    (test '((var T) (dup R) (def bar) (bnd Y X) (use N))
+       (lint 'foo) ) )
+
+(let foo '(() (task -6000 0 X 7 (println N)))
+   (test '((bnd N) (use X))
+       (lint 'foo) ) )
+
+# vi:et:ts=3:sw=3
diff --git a/test/lib/misc.l b/test/lib/misc.l
@@ -0,0 +1,213 @@
+# 04sep08abu
+# (c) Software Lab. Alexander Burger
+
+### locale ###
+(locale "DE" "de")
+(test "Ja" (val ,"Yes"))
+(locale)
+
+
+### ** ###
+(test 32768 (** 2 15))
+
+
+### accu ###
+(off Sum)
+
+(test '(a . 1) (accu 'Sum 'a 1))
+(test 6 (accu 'Sum 'a 5))
+(test (22 . 100) (accu 'Sum 22 100))
+(test '((22 . 100) (a . 6)) Sum)
+
+(test '((b . 2) (a . 3))
+   (let L NIL (accu 'L 'a 2) (accu 'L 'b 2) (accu 'L 'a 1) L) )
+
+
+### align ###
+(test "   a" (align 4 'a))
+(test "   a" (align 4 "a"))
+(test "12  " (align -4 12))
+(test "   a  12   b" (align (4 4 4) "a" 12 "b"))
+
+
+### center ###
+(test " 12" (center 4 12))
+(test " a" (center 4 "a"))
+(test "   a" (center 7 'a))
+(test " a  b  c" (center (3 3 3) "a" "b" "c"))
+
+
+### wrap ###
+(test "The quick brown fox^Jjumps over the lazy^Jdog"
+   (wrap 20 (chop "The quick brown fox jumps over the lazy dog")) )
+(test "The^Jquick^Jbrown^Jfox^Jjumps^Jover the^Jlazy dog"
+   (wrap 8 (chop "The quick brown fox jumps over the lazy dog")) )
+
+
+### pad ###
+(test "00001" (pad 5 1))
+(test "123456789" (pad 5 123456789))
+
+
+### oct ###
+(test "111" (oct (+ 64 8 1)))
+(test (+ 64 8 1) (oct "111"))
+
+
+### hex ###
+(test "111" (hex (+ 256 16 1)))
+(test (+ 256 16 1) (hex "111"))
+(test "-FFFF" (hex -65535))
+
+
+### money ###
+(test "1,234,567.89" (money 123456789))
+(test "1,234,567.89 EUR" (money 123456789 "EUR"))
+
+(locale "DE" "de")
+(test "1.234.567,89 EUR" (money 123456789 "EUR"))
+(locale)
+
+
+### balance ###
+(test (5 (2 (1) 3 NIL 4) 7 (6) 8 NIL 9)
+   (let I NIL (balance 'I (sort (1 4 2 5 3 6 7 9 8))) I) )
+
+
+### *Allow allowed allow ###
+(allowed ("app/" "img/")
+   "start" "stop" "favicon.ico" "lib.css" "psh" )
+(allow "myFoo")
+(allow "myDir/" T)
+
+(test '(("psh" ("favicon.ico" NIL "lib.css" NIL "myFoo") "start" NIL "stop") "app/" "img/" "myDir/")
+   *Allow )
+
+(test '("favicon.ico" "lib.css" "myFoo" "psh" "start" "stop")
+   (idx *Allow) )
+
+(test '("app/" "img/" "myDir/")
+   (cdr *Allow) )
+
+
+### telStr ###
+(test "+49 1234 5678-0" (telStr "49 1234 5678-0"))
+
+(locale "DE" "de")
+(test "01234 5678-0" (telStr "49 1234 5678-0"))
+(locale)
+
+
+### expTel ###
+(test "49 1234 5678-0" (expTel "+49 1234 5678-0"))
+(test "49 1234 5678-0" (expTel "0049 1234 5678-0"))
+(test NIL (expTel "01234 5678-0"))
+
+(locale "DE" "de")
+(test "49 1234 5678-0" (expTel "01234 5678-0"))
+(locale)
+
+
+### dat$ ###
+(test "20070601" (dat$ (date 2007 6 1)))
+(test "2007-06-01" (dat$ (date 2007 6 1) "-"))
+
+
+### $dat ###
+(test 733134 ($dat "20070601"))
+(test 733134 ($dat "2007-06-01" "-"))
+
+
+### datSym ###
+(test "01jun07" (datSym (date 2007 6 1)))
+
+
+### datStr ###
+(test "2007-06-01" (datStr (date 2007 6 1)))
+
+(locale "DE" "de")
+(test "01.06.2007" (datStr (date 2007 6 1)))
+(test "01.06.07" (datStr (date 2007 6 1) T))
+(locale)
+
+
+### strDat ###
+(test 733134 (strDat "2007-06-01"))
+(test NIL (strDat "01.06.2007"))
+
+(locale "DE" "de")
+(test 733134 (strDat "01.06.2007"))
+(test 733134 (strDat "1.6.2007"))
+(locale)
+
+
+### expDat ###
+(test 733133 (date 2007 5 31))
+(test 733133 (expDat "31057"))
+(test 733133 (expDat "310507"))
+(test 733133 (expDat "2007-05-31"))
+(test 733133 (expDat "7-5-31"))
+
+(locale "DE" "de")
+(test 733133 (expDat "31.5.7"))
+(locale)
+
+
+### day ###
+(test "Friday" (day (date 2007 6 1)))
+
+(locale "DE" "de")
+(test "Freitag" (day (date 2007 6 1)))
+(test "Fr"
+   (day (date 2007 6 1) '("Mo" "Tu" "We" "Th" "Fr" "Sa" "Su")) )
+(locale)
+
+
+### week ###
+(test 22 (week (date 2007 6 1)))
+
+
+### ultimo ###
+(test (2007 1 31) (date (ultimo 2007 1)))
+(test (2007 2 28) (date (ultimo 2007 2)))
+(test (2004 2 29) (date (ultimo 2004 2)))
+(test (2000 2 29) (date (ultimo 2000 2)))
+(test (1900 2 28) (date (ultimo 1900 2)))
+
+
+### tim$ ###
+(test "10:57" (tim$ (time 10 57 56)))
+(test "10:57:56" (tim$ (time 10 57 56) T))
+
+
+### $tim ###
+(test (10 57 56) (time ($tim "10:57:56")))
+(test (10 57 0) (time ($tim "10:57")))
+(test (10 0 0) (time ($tim "10")))
+
+
+### stamp ###
+(test "2007-06-01 10:57:56"
+   (stamp (date 2007 6 1) (time 10 57 56)) )
+
+
+### chdir ###
+(let P (pwd)
+   (chdir "test"
+      (test (pwd) (pack P "/test")) )
+   (test P (pwd)) )
+
+
+### dirname ###
+(test "a/b/c/" (dirname "a/b/c/d"))
+
+
+### fmt64 ###
+(test "9" (fmt64 9))
+(test ":" (fmt64 10))
+(test ";" (fmt64 11))
+(test "A" (fmt64 12))
+(test 4096 (fmt64 "100"))
+
+
+# vi:et:ts=3:sw=3
diff --git a/test/src/apply.l b/test/src/apply.l
@@ -0,0 +1,107 @@
+# 12jul08abu
+# (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)))
+
+
+### pass ###
+(test 24 ((quote (N . @) (* N (pass + 6))) 2 1 2 3))
+
+
+### maps ###
+(let L '((1 . a) (2 . b) flg)
+   (test L (let X (box) (putl X (reverse L)) (make (maps link X)))) )
+
+
+### map ###
+(test '((1 2 3) (2 3) (3)) (make (map link (1 2 3))))
+
+
+### mapc ###
+(test (1 2 3) (make (mapc link (1 2 3))))
+
+
+### maplist ###
+(test '(((1 2 3) A B C) ((2 3) B C) ((3) C)) (maplist cons (1 2 3) '(A B C)))
+
+
+### mapcar ###
+(test (5 7 9) (mapcar + (1 2 3) (4 5 6)))
+(test (26 38 52 68) (mapcar '((X Y) (+ X (* Y Y))) (1 2 3 4) (5 6 7 8)))
+
+
+### mapcon ###
+(test (1 2 3 4 5 2 3 4 5 3 4 5 4 5 5) (mapcon copy (1 2 3 4 5)))
+
+
+### mapcan ###
+(test '(c b a f e d i h g) (mapcan reverse '((a b c) (d e f) (g h i))))
+
+
+### filter ###
+(test (1 2 3) (filter num? (1 A 2 (B) 3 CDE)))
+
+
+### extract ###
+(let (A NIL  B 1  C NIL  D 2  E NIL  F 3)
+   (test (1 2 3)
+      (extract val '(A B C D E F)) )
+   (test (1 2 3)
+      (extract val '(B D E F)) ) )
+
+
+### seek ###
+(test (12 19 22) (seek '((X) (> (car X) 9)) (1 5 8 12 19 22)))
+
+
+### find ###
+(test '(B) (find pair (1 A 2 (B) 3 CDE)))
+(test 4 (find > (1 2 3 4 5 6) (6 5 4 3 2 1)))
+(test 4 (find '((A B) (> A B)) (1 2 3 4 5 6) (6 5 4 3 2 1)))
+
+
+### pick ###
+(test "Hello"
+   (pick '((X) (get X 'str))
+      (list (box) (prog1 (box) (put @ 'str "Hello")) (box)) ) )
+
+
+### cnt ###
+(test 2 (cnt cdr '((1 . T) (2) (3 4) (5))))
+
+
+### sum ###
+(test 6 (sum val (list (box 1) (box) (box 2) (box 'a) (box 3))))
+
+
+### maxi mini ###
+(let (A 1 B 2 C 3)
+   (test 'C (maxi val '(A B C)))
+   (test 'A (mini val '(A B C)))
+   (test '(A B C) (by val sort '(C A B))) )
+
+
+### fish ###
+(test (1 2 3)
+   (fish gt0 '(a -2 (1 b (-3 c 2)) 3 d -1)) )
+(test '(a b c d)
+   (fish sym? '(a -2 (1 b (-3 c 2)) 3 d -1)) )
+
+
+### by ###
+(test '(A B C)
+   (let (A 1 B 2 C 3)
+      (by val sort '(C A B)) ) )
+(test '((3 11 9 5 7 1) (6 2 4 10 12 8))
+   (by '((N) (bit? 1 N))
+      group
+      (3 11 6 2 9 5 4 10 12 7 8 1) ) )
+(test '(("x" "x" "x") ("y") ("z" "z"))
+   (by name group '("x" "x" "y" "z" "x" "z")) )
+(test '((123 "xyz") ((1 2) "XY") ("abcd" (1 2 3 4)))
+   (by length group '(123 (1 2) "abcd" "xyz" (1 2 3 4) "XY")) )
+
+# vi:et:ts=3:sw=3
diff --git a/test/src/big.l b/test/src/big.l
@@ -0,0 +1,159 @@
+# 09sep09abu
+# (c) Software Lab. Alexander Burger
+
+### format ###
+(test "123456789" (format 123456789))
+(test "12346" (format 12345.6789))
+(test "1234567.89" (format 123456789 2))
+(test "1234567,89" (format 123456789 2 ","))
+(test "1.234.567,89" (format 123456789 2 "," "."))
+(test 123456789 (format "123456789"))
+(test 12345678900 (format "1234567.89" 4))
+(test NIL (format "1.234.567,89"))
+(test 12345678900 (format "1234567,89" 4 ","))
+(test NIL (format "1.234.567,89" 4 ","))
+(test 12345678900 (format "1.234.567,89" 4 "," "."))
+
+
+### + ###
+(test 6 (+ 1 2 3))
+(test 0 (+ 1 2 -3))
+(test NIL (+ NIL 7))
+
+
+### - ###
+(test -7 (- 7))
+(test 7 (- -7))
+(test 6 (- 7 2 -1))
+(test NIL (- NIL 7))
+
+
+### inc ###
+(test 8 (inc 7))
+(test -6 (inc -7))
+(test 0 (inc -1))
+(test 1 (inc 0))
+(test (8 -6 0 1) (let L (7 -7 -1 0) (map inc L) L))
+(test NIL (inc NIL))
+(let N 0
+   (test 1 (inc 'N))
+   (test 1 N)
+   (test 8 (inc 'N 7))
+   (test 8 N) )
+(let L (1 2 3 4)
+   (test 3 (inc (cdr L)))
+   (test (1 3 3 4) L) )
+
+
+### dec ###
+(test 7 (dec 8))
+(test -8 (dec -7))
+(test -1 (dec 0))
+(test (7 -8 -1) (let L (8 -7 0) (map dec L) L))
+(test NIL (dec NIL))
+(let N 7
+   (test 6 (dec 'N))
+   (test 6 N)
+   (test 3 (dec 'N 3))
+   (test 3 N) )
+
+
+### * ###
+(test 6 (* 1 2 3))
+(test -60 (* -5 3 2 2))
+(test NIL (* NIL 7))
+
+
+### */ ###
+(test 6 (*/ 3 4 2))
+(test -247 (*/ 1234 -2 10))
+(test 17 (*/ 100 6))
+(test NIL (*/ 3 4 NIL))
+
+
+### / ###
+(test 4 (/ 12 3))
+(test -5 (/ 60 -3 2 2))
+(test NIL (/ 10 NIL))
+
+
+### % ###
+(test 2 (% 17 5))
+(test -2 (% -17 5))
+(test 1 (% 5 2))
+(test 5 (% 15 10))
+(test 1 (% 15 10 2))
+(test NIL (% NIL 7))
+
+
+### >> ###
+(test 4 (>> 1 8))
+(test 2 (>> 3 16))
+(test 128 (>> -3 16))
+(test -32 (>> -1 -16))
+
+
+### lt0 ###
+(test -2 (lt0 -2))
+(test NIL (lt0 7))
+(test NIL (lt0 0))
+
+
+### ge0 ###
+(test 7 (ge0 7))
+(test NIL (ge0 -2))
+(test 0 (ge0 0))
+
+
+### gt0 ###
+(test 7 (gt0 7))
+(test NIL (gt0 -2))
+(test NIL (gt0 0))
+
+
+### abs ###
+(test 7 (abs -7))
+(test 7 (abs 7))
+(test NIL (abs NIL))
+
+
+### bit? ###
+(test 7 (bit? 7 15 255))
+(test 1 (bit? 1 3))
+(test NIL (bit? 1 2))
+
+
+### & ###
+(test 2 (& 6 3))
+(test 1 (& 7 3 1))
+(test NIL (& 7 NIL))
+
+
+### | ###
+(test 3 (| 1 2))
+(test 15 (| 1 2 4 8))
+(test NIL (| NIL 1))
+
+
+### x| ###
+(test 5 (x| 2 7))
+(test 4 (x| 2 7 1))
+(test NIL (x| NIL 1))
+
+
+### sqrt ###
+(test 8 (sqrt 64))
+(test 31 (sqrt 1000))
+(test 100000000000000000000
+   (sqrt 10000000000000000000000000000000000000000) )
+(test NIL (sqrt NIL))
+
+
+### seed rand ###
+(test (if (== 64 64) 963569716595329593 2015582081) (seed "init string"))
+(test (if (== 64 64) 881495644906500132 -706917003) (rand))
+(test (if (== 64 64) -510782208671386616 1224196082) (rand))
+(test (if (== 64 64) 4 8) (rand 3 9))
+(test (if (== 64 64) 5 5) (rand 3 9))
+
+# vi:et:ts=3:sw=3
diff --git a/test/src/db.l b/test/src/db.l
@@ -0,0 +1,43 @@
+# 08oct09abu
+# (c) Software Lab. Alexander Burger
+
+### id ###
+(test *DB (id 1))
+(test 1 (id *DB))
+(let I (id 3 4)
+   (test (3 . 4) (id I T)) )
+
+
+### lieu ###
+(rollback)
+(test NIL (lieu *DB))
+(test *DB (val *DB) (lieu *DB))
+
+
+### commit rollback ###
+(let (X (new T)  Y (new T))
+   (set X 1  Y 2)
+   (commit)
+   (test 1 (val X))
+   (test 2 (val Y))
+   (set X 111)
+   (set Y 222)
+   (test 111 (val X))
+   (test 222 (val Y))
+   (rollback)
+   (test 1 (val X))
+   (test 2 (val Y)) )
+
+
+### mark ###
+(test NIL (mark *DB))
+(test NIL (mark *DB T))
+(test T (mark *DB))
+(test T (mark *DB 0))
+(test NIL (mark *DB))
+
+
+### dbck ###
+(test NIL (dbck))
+
+# vi:et:ts=3:sw=3
diff --git a/test/src/ext.l b/test/src/ext.l
@@ -0,0 +1,22 @@
+# 12nov09abu
+# (c) Software Lab. Alexander Burger
+
+### ext:Snx ###
+(test "PSLSFSNTSNNLSF"
+   (ext:Snx "PicoLisp is not Common Lisp") )
+(test "PSLSFSNT"
+   (ext:Snx "PicoLisp is not Common Lisp" 8) )
+
+
+### ext:Ulaw ###
+(test (32 47 63 78 255 206 191 175 160)
+   (mapcar 'ext:Ulaw (-8000 -4000 -2000 -1000 0 1000 2000 4000 8000)) )
+
+
+### ext:Base64 ###
+(test "TQ=="
+   (pipe (ext:Base64 77) (line T)) )
+(test "AQID"
+   (pipe (ext:Base64 1 2 3) (line T)) )
+
+# vi:et:ts=3:sw=3
diff --git a/test/src/ext2.l b/test/src/ext2.l
@@ -0,0 +1,31 @@
+# 19feb10abu
+# (c) Software Lab. Alexander Burger
+
+### ext:Sin ###
+(test 0
+   (ext:Sin 0 100000) )
+(test 100000
+   (ext:Sin (/ 314159 2) 100000) )
+
+
+### ext:Cos ###
+(test 100000
+   (ext:Cos 0 100000) )
+(test -10000000
+   (ext:Cos 31415926 10000000) )
+
+
+### ext:Tan ###
+(test 0
+   (ext:Tan 0 10000000) )
+(test -1
+   (ext:Tan 31415926 10000000) )
+
+
+### ext:Atan ###
+(test 0
+   (ext:Atan 0 10000000 10000000) )
+(test 15707963
+   (ext:Atan 10000000 0 10000000) )
+
+# vi:et:ts=3:sw=3
diff --git a/test/src/flow.l b/test/src/flow.l
@@ -0,0 +1,434 @@
+# 22mar10abu
+# (c) Software Lab. Alexander Burger
+
+### quote ###
+(test (1 2 3) (quote 1 2 3))
+
+
+### as ###
+(test NIL (as (= 3 4) A B C))
+(test '(A B C) (as (= 3 3) A B C))
+
+
+### pid ###
+(test NIL (pid 1 '+ 3 4)))
+(test 7 (pid *Pid '+ 3 4))
+(test 7 (pid (list 0 *Pid 1) '+ 3 4))
+
+
+### lit ###
+(test 123 (lit 123))
+(test NIL (lit NIL))
+(test T (lit T))
+(test (1) (lit '(1)))
+(test ''"abc" (lit "abc"))
+(test ''a (lit 'a))
+(test (1 2 3) (lit '(1 2 3)))
+(test ''(a b c) (lit '(a b c)))
+
+
+### eval ###
+(test 6 (eval (list '+ 1 2 3)))
+(let (X 'Y  Y 7)
+   (test 7 (eval X)) )
+(let N 1
+   ((quote (N)
+         ((quote (N)
+               (test 3 N)
+               (test 2 (eval 'N 1))
+               (test 2 (eval 'N 1 '(X)))
+               (test 3 (eval 'N 1 '(N)))
+               (test 1 (eval 'N 2))
+               (test 3 (eval 'N 2 '(N))) )
+            3 ) )
+      2 ) )
+
+
+### run ###
+(test 6 (run (list (list '+ 1 2 3))))
+(test 2
+   (let N 1
+      ((quote (N) (run '((+ N N)) 1)) 2) ) )
+
+
+### def ###
+(test '"a"
+   (def '"a" '((X Y) (* X (+ X Y)))) )
+(test '((X Y) (* X (+ X Y)))
+   "a" )
+
+
+### de ###
+(test '"b"
+   (de "b" (X Y) (* X (+ X Y))) )
+(test '((X Y) (* X (+ X Y)))
+   "b" )
+
+
+### dm ###
+(off "+Cls" "+A")
+(class "+Cls" "+A")
+
+(test '"foo>"
+   (dm "foo>" (X Y)
+      (* X (+ X Y)) ) )
+(test '"foo>"
+   (dm ("foo>" . "+Cls") (X Y)
+      (* X (+ X Y)) ) )
+(test '(("foo>" (X Y) (* X (+ X Y))) "+A")
+   "+Cls" )
+
+
+### box ###
+(let X (box '(A B C))
+   (test X (box? X))
+   (test '(A B C) (val X)) )
+
+
+### new type isa method meth send try ###
+(let X (new '("+Cls"))
+   (test X (box? X))
+   (test 21 ("foo>" X 3 4))
+   (test '("+Cls") (type X))
+   (test X (isa '"+Cls" X))
+   (test NIL (isa '(A B C) X))
+   (test '((X Y) (* X (+ X Y)))
+      (method '"foo>" X) )
+   (test meth "foo>")
+   (test 21 (send '"foo>" X 3 4))
+   (test NIL (try '"bar>" X))
+   (test 21 (try '"foo>" X 3 4)) )
+
+
+### super ###
+(off "+Sub")
+(class "+Sub" "+Cls")
+
+(dm ("foo>" . "+Sub") (X Y)
+   (super X Y) )
+(let X (new '("+Sub"))
+   (test 21 ("foo>" X 3 4)) )
+
+
+### super ###
+(off "+Pref")
+(class "+Pref")
+
+(dm ("foo>" . "+Pref") (X Y)
+   (extra X Y) )
+(let X (new '("+Pref" "+Sub"))
+   (test 21 ("foo>" X 3 4)) )
+
+
+### with ###
+(let X (box)
+   (put X 'a 1)
+   (put X 'b 2)
+   (test (1 2)
+      (with X (list (: a) (: b))) ) )
+
+
+### bind ###
+(let X 123
+   (test "Hello"
+      (bind 'X
+         (setq X "Hello")
+         X ) )
+   (test (3 4 12)
+      (bind '((X . 3) (Y . 4))
+         (list X Y (* X Y)) ) ) )
+
+
+### job ###
+(off "tst")
+
+(de "tst" ()
+   (job '((A . 0) (B . 0))
+      (cons (inc 'A) (inc 'B 2)) ) )
+
+(test (1 . 2) ("tst"))
+(test (2 . 4) ("tst"))
+(test (3 . 6) ("tst"))
+
+
+### let let? use ###
+(let N 1
+   (test NIL (let? N NIL N))
+   (test 7 (let? N 7 N))
+   (use N
+      (setq N 2)
+      (let N 3
+         (test 3 N) )
+      (test 2 N) )
+   (test 1 N) )
+(let N 1
+   (use (N)
+      (setq N 2)
+      (let (N 3)
+         (test 3 N) )
+      (test 2 N) )
+   (test 1 N) )
+
+
+### and ###
+(test 7 (and T 123 7))
+(test NIL (and NIL 123))
+
+
+### or ###
+(test NIL (or NIL))
+(test 7 (or NIL 7 123))
+
+
+### nand ###
+(test NIL (nand T 123 7))
+(test T (nand NIL 123))
+
+
+### nor ###
+(test T (nor NIL))
+(test NIL (nor NIL 7 123))
+
+
+### xor ###
+(test T (xor T NIL))
+(test T (xor NIL T))
+(test NIL (xor NIL NIL))
+(test NIL (xor T T))
+
+
+### bool ###
+(test T (bool 'a))
+(test T (bool 123))
+(test NIL (bool NIL))
+
+
+### not ###
+(test T (not NIL))
+(test NIL (not T))
+(test NIL (not 'a))
+
+
+### nil ###
+(test NIL (nil (+ 1 2 3)))
+
+
+### t ###
+(test T (t (+ 1 2 3)))
+
+
+### prog ###
+(let N 7
+   (test 3
+      (prog (dec 'N) (dec 'N) (dec 'N) (dec 'N) N) ) )
+
+
+### prog1 prog2 ###
+(test 1 (prog1 1 2 3))
+(test 2 (prog2 1 2 3))
+
+
+### if ###
+(test 1 (if (= 3 3) 1 2))
+(test 2 (if (= 3 4) 1 2))
+
+
+### if2 ###
+(test 'both
+   (if2 T T 'both 'first 'second 'none) )
+(test 'first
+   (if2 T NIL 'both 'first 'second 'none) )
+(test 'second
+   (if2 NIL T 'both 'first 'second 'none) )
+(test 'none
+   (if2 NIL NIL 'both 'first 'second 'none) )
+
+
+### ifn ###
+(test 2 (ifn (= 3 3) 1 2))
+(test 1 (ifn (= 3 4) 1 2))
+
+
+### when ###
+(test 7 (when (= 3 3) 7))
+(test NIL (when (= 3 4) 7))
+
+
+### unless ###
+(test NIL (unless (= 3 3) 7))
+(test 7 (unless (= 3 4) 7))
+
+
+### cond ###
+(test 1 (cond ((= 3 3) 1) (T 2)))
+(test 2 (cond ((= 3 4) 1) (T 2)))
+
+
+### nond ###
+(test 2 (nond ((= 3 3) 1) (NIL 2)))
+(test 1 (nond ((= 3 4) 1) (NIL 2)))
+(test (1 . a)
+   (nond ((num? 'a) (cons 1 'a)) (NIL (cons 2 @))) )
+(test (2 . 7)
+   (nond ((num? 7) (cons 1 7)) (NIL (cons 2 @))) )
+
+
+### case ###
+(test 1 (case 'a (a 1) ((b c) 2) (T 3)))
+(test 2 (case 'b (a 1) ((b c) 2) (T 3)))
+(test 2 (case 'c (a 1) ((b c) 2) (T 3)))
+(test 3 (case 'd (a 1) ((b c) 2) (T 3)))
+
+
+### state ###
+(off "tst")
+
+(de "tst" ()
+   (job '((Cnt . 4))
+      (state '(start)
+         (start 'run
+            (link 'start) )
+         (run (and (gt0 (dec 'Cnt)) 'run)
+            (link 'run) )
+         (run 'stop
+            (link 'run) )
+         (stop 'start
+            (setq Cnt 4)
+            (link 'stop) ) ) ) )
+
+(test '(start run run run run stop  start run run run run stop)
+   (make (do 12 ("tst"))) )
+(test '(start run run)
+   (make (do 3 ("tst"))) )
+
+
+### while ###
+(test (1 2 3 4 5 6 7)
+   (make
+      (let N 0
+         (while (>= 7 (inc 'N))
+            (link N) ) ) ) )
+
+
+### until ###
+(test (1 2 3 4 5 6 7)
+   (make
+      (let N 0
+         (until (> (inc 'N) 7)
+            (link N) ) ) ) )
+
+
+### loop ###
+(test (1 2 3 4 5 6 7)
+   (make
+      (let N 1
+         (loop
+            (link N)
+            (T (> (inc 'N) 7)) ) ) ) )
+(test (1 2 3 4 5 6 7)
+   (make
+      (let N 1
+         (loop
+            (link N)
+            (NIL (>= 7 (inc 'N))) ) ) ) )
+
+(test
+   '(a . 3)
+   (loop (T NIL (cons @ 1)) (NIL 'a (cons @ 2)) (NIL NIL (cons @ 3))) )
+
+
+### do ###
+(test (1 2 3 4 5 6 7)
+   (make
+      (let N 0
+         (do 7
+            (link (inc 'N)) ) ) ) )
+(test (1 2 3 4 5 6 7)
+   (make
+      (let N 1
+         (do T
+            (link N)
+            (T (> (inc 'N) 7)) ) ) ) )
+
+
+### at ###
+(test (1 2 3 - 4 5 6 - 7 8 9 -)
+   (make
+      (let N 0
+         (do 9
+            (link (inc 'N))
+            (at (0 . 3) (link '-)) ) ) ) )
+
+
+### for ###
+(test (1 2 3 4 5 6 7)
+   (make
+      (for N (1 2 3 4 5 6 7)
+         (link N) ) ) )
+(test (1 2 3 4 5 6 7)
+   (make
+      (for (N . X) '(a b c d e f g)
+         (link N) ) ) )
+(test (1 2 3 4 5 6 7)
+   (make
+      (for N 7
+         (link N) ) ) )
+(test (1 2 3 4 5 6 7)
+   (make
+      (for (N 1 (>= 7 N) (inc N))
+         (link N) ) ) )
+(test (1 2 3 4 5 6 7)
+   (make
+      (for ((N . X) 7 (gt0 X) (dec X))
+         (link N) ) ) )
+(test (1 2 3 4 5 6 7)
+   (make
+      (for (N 1 T)
+         (link N)
+         (T (> (inc 'N) 7)) ) ) )
+
+
+### catch throw ###
+(test NIL (catch NIL (throw)))
+(test 'b (catch 'a (throw 'a 'b)))
+(test 123 (catch T (throw 'a 123)))
+(test "Undefined"
+   (catch '("Undefined") (mist)) )
+(test "No such file"
+   (catch '("No such file")
+      (in "doesntExist" (foo)) ) )
+(test 6
+   (case
+      (catch '("No such file" "Undefined" "expected")
+         (+ 1 2 3) )
+      ("No such file" (shouldNotComeHere))
+      ("Undefined" (shouldNotComeHere))
+      ("expected" (shouldNotComeHere))
+      (T @) ) )
+
+
+### finally ###
+(test 'B
+   (let X 'A
+      (catch NIL
+         (finally (setq X 'B)
+            (setq X 'C)
+            (throw)
+            (setq X 'D) ) )
+      X ) )
+
+
+### sys ###
+(test "PicoLisp" (sys "TEST" "PicoLisp"))
+(test "PicoLisp" (sys "TEST"))
+
+
+### call ###
+(test T (call 'test "-d" "test"))
+(test NIL (call 'test "-f" "test"))
+
+
+### kill ###
+(test T (kill *Pid 0))
+
+# vi:et:ts=3:sw=3
diff --git a/test/src/ht.l b/test/src/ht.l
@@ -0,0 +1,46 @@
+# 29jan09abu
+# (c) Software Lab. Alexander Burger
+
+### ht:Prin ###
+(test "1&lt;2&gt;3&amp;äöü<i>ÄÖÜß"
+   (pipe (ht:Prin "1<2>3&äöü<i>ÄÖÜß") (line T)) )
+
+
+### ht:Fmt ###
+(test "+123&abc&$def&-123&_+1_xyz_+7"
+   (ht:Fmt 123 "abc" 'def '{123} (1 "xyz" 7)) )
+
+
+### ht:Pack ###
+(test "A+B C"
+   (ht:Pack '("A" "+" "B" "%" "2" "0" "C")) )
+(test "a b>c"
+   (ht:Pack '("a" "%" "2" "0" "b" "&" "g" "t" ";" "c")) )
+(test "a€z"
+   (ht:Pack '("a" "&" "#" "8" "3" "6" "4" ";" "z")) )
+(test "äöü"
+   (ht:Pack '("%" "C" "3" "%" "A" "4" "%" "C" "3" "%" "B" "6" "%" "C" "3" "%" "B" "C")) )
+
+
+### ht:Read ###
+(test NIL
+   (pipe (prin "abcde") (ht:Read 0)) )
+(test NIL
+   (pipe (prin "abcde") (ht:Read 6)) )
+(test NIL
+   (pipe NIL (ht:Read 3)) )
+(test NIL
+   (pipe (prin "äö") (ht:Read 3)) )
+(test '("ä" "ö")
+   (pipe (prin "äö") (ht:Read 4)) )
+(test '("a" "b" "c")
+   (pipe (prin "abcde") (ht:Read 3)) )
+(test '("ä" "ö" "ü")
+   (pipe (prin "äöüxyz") (ht:Read 6)) )
+
+
+### ht:In ht:Out ###
+(test "Hello world"
+   (pipe (ht:Out T (prinl "Hello world")) (ht:In T (line T))) )
+
+# vi:et:ts=3:sw=3
diff --git a/test/src/io.l b/test/src/io.l
@@ -0,0 +1,220 @@
+# 22mar10abu
+# (c) Software Lab. Alexander Burger
+
+### path ###
+(test (path '@) (pack (pwd) '/))
+(test (char "+") (char (path "+@")))
+
+
+### read ###
+(test (1 2 3) (~(1 2) 3))
+(test (1 3) (~(1 . 2) 3))
+(test (1 2 3 4) (1 ~(2 3) 4))
+(test (1 2 4) (1 ~(2 . 3) 4))
+(test (1 abc (d e f))
+   (pipe (prinl "(1 abc (d e f))")
+      (read) ) )
+(test '(abc "=" def_ghi "(" "xyz" "+" "-" 123 ")")
+   (pipe (prinl "abc = def_ghi(\"xyz\"+-123) # Comment")
+      (make
+         (while (read "_" "#")
+            (link @) ) ) ) )
+
+
+### wait ###
+(let (*Run NIL  *Cnt 0)
+   (test (1 2 3 4 5 6 7)
+      (make
+         (task -10 0  (link (inc '*Cnt)))
+         (wait NIL (>= *Cnt 7)) ) ) )
+
+
+### peek char ###
+(pipe (prin "ab")
+   (test "a" (peek))
+   (test "a" (char))
+   (test "b" (peek))
+   (test "b" (char))
+   (test NIL (peek))
+   (test NIL (char)) )
+(test "A" (char 65))
+(test 65 (char "A"))
+
+
+### skip ###
+(test "a"
+   (pipe (prinl "# Comment^Ja")
+      (skip "#") ) )
+(test "#"
+   (pipe (prinl "# Comment^Ja")
+      (skip) ) )
+
+
+### eof ###
+(test T (pipe NIL (eof)))
+(test NIL (pipe (prin "a") (eof)))
+(test T (pipe (prin "a") (eof T) (eof)))
+
+
+### from till ###
+(test "cd"
+   (pipe (prin "ab.cd:ef")
+      (from ".")
+      (till ":" T) ) )
+
+
+### line ###
+(test '("a" "b" "c")
+   (pipe (prin "abc^J") (line)) )
+(test "abc"
+   (pipe (prin "abc") (line T)) )
+(test '("abc" "def")
+   (pipe (prin "abc^Jdef")
+      (list (line T) (line T)) ) )
+(test '("abc" "def")
+   (pipe (prin "abc^Mdef")
+      (list (line T) (line T)) ) )
+(test '("abc" "def")
+   (pipe (prin "abc^M^Jdef")
+      (list (line T) (line T)) ) )
+(test '("a" "bc" "def")
+   (pipe (prin "abcdef")
+      (line T 1 2 3) ) )
+
+
+### lines ###
+(out (tmp "lines")
+   (do 3 (prinl "abc")) )
+
+(test 3 (lines (tmp "lines")))
+
+
+### any ###
+(test '(a b c d) (any "(a b # Comment^Jc d)"))
+(test "A String" (any "\"A String\""))
+
+
+### sym ###
+(test "(abc \"Hello\" 123)"
+   (sym '(abc "Hello" 123)) )
+
+
+### str ###
+(test '(a (1 2) b)
+   (str "a (1 2) b") )
+(test '(a (1 2))
+   (str "a (1 2) # b") )
+(test "a \"Hello\" DEF"
+   (str '(a "Hello" DEF)) )
+
+
+### load ###
+(test 6 (load "-* 1 2 3"))
+
+
+### in out ###
+(out (tmp "file")
+   (println 123)
+   (println 'abc)
+   (println '(d e f)) )
+(in (tmp "file")
+   (test 123 (read))
+   (in (tmp "file")
+      (test 123 (read))
+      (test 'abc (in -1 (read))) )
+   (test '(d e f) (read)) )
+
+
+### pipe ###
+(test 123 (pipe (println 123) (read)))
+
+
+### open close ###
+(let F (open (tmp "file"))
+   (test 123 (in F (read)))
+   (test 'abc (in F (read)))
+   (test '(d e f) (in F (read)))
+   (test F (close F)) )
+
+
+### echo ###
+(out (tmp "echo")
+   (in (tmp "file")
+      (echo) ) )
+(in (tmp "echo")
+   (test 123 (read))
+   (test 'abc (read))
+   (test '(d e f) (read)) )
+
+
+### prin prinl space print printsp println ###
+(out (tmp "prin")
+   (prin 1)
+   (prinl 2)
+   (space)
+   (print 3)
+   (printsp 4)
+   (println 5) )
+(test (12 "^J" " " 34 5)
+   (in (tmp "prin")
+      (list (read) (char) (char) (read) (read)) ) )
+
+
+### flush rewind ###
+(out (tmp "prin")
+   (prinl "abc")
+   (flush)
+   (test "abc" (in (tmp "prin") (line T)))
+   (rewind) )
+(out (tmp "prin") (prinl "def"))
+(test "def" (in (tmp "prin") (line T)))
+
+
+### ext rd pr ###
+(let L (list (id 1 2) (cons (id 3 9) 'a) (cons (id 2 7) 'b))
+   (let L5 (list (id 6 2) (cons (id 8 9) 'a) (cons (id 7 7) 'b))
+      (out (tmp "ext")
+         (ext 5 (pr L5)) )
+      (test L
+         (in (tmp "ext") (rd)) )
+      (test L5
+         (in (tmp "ext") (ext 5 (rd))) ) ) )
+
+(pipe
+   (for N 4096
+      (pr N) )
+   (for N 4096
+      (test N (rd)) ) )
+(pipe
+   (for C 4096
+      (pr (char C)) )
+   (for C 4096
+      (test C (char (rd))) ) )
+(pipe
+   (pr (7 "abc" (1 2 3) 'a))
+   (test (7 "abc" (1 2 3) 'a) (rd)) )
+(test "def"
+   (out (tmp "pr")
+      (pr 'abc "EOF" 123 "def") ) )
+(test '(abc "EOF" 123 "def")
+   (in (tmp "pr")
+      (make
+         (use X
+            (until (== "EOF" (setq X (rd "EOF")))
+               (link X) ) ) ) ) )
+
+
+### wr ###
+(test 3
+   (out (tmp "wr")
+      (wr 1 2 3) ) )
+(test (hex "010203")
+   (in (tmp "wr")
+      (rd 3) ) )
+
+
+### rpc ###
+(test *Pid
+   (pipe (rpc '*Pid) (run (rd))) )
+
+# vi:et:ts=3:sw=3
diff --git a/test/src/main.l b/test/src/main.l
@@ -0,0 +1,150 @@
+# 31jan10abu
+# (c) Software Lab. Alexander Burger
+
+### alarm ###
+(let N 6
+   (alarm 1 (inc 'N))
+   (test 6 N)
+   (wait 2000)
+   (test 7 N)
+   (alarm 0) )
+
+
+### protect ###
+(test NIL (pipe (prog (kill *Pid) (pr 7)) (rd)))
+(test 7 (pipe (protect (kill *Pid) (pr 7)) (rd)))
+
+
+### quit ###
+(test "Quit" (catch '("Quit") (quit "Quit")))
+
+
+### env ###
+(test NIL (env))
+(test '((A . 1) (B . 2))
+   (let (A 1 B 2)
+      (env) ) )
+(test '((B . 2) (A . 1))
+   (let (A 1 B 2)
+      (env '(A B)) ) )
+(test '((Y . 8) (B . 2) (A . 1) (X . 7))
+   (let (A 1 B 2)
+      (env 'X 7 '(A B) 'Y 8) ) )
+
+
+### up ###
+(test 1
+   (let N 1
+      ((quote (N) (up N)) 2) ) )
+(test 7
+   (let N 1
+      ((quote (N) (up N 7)) 2)
+      N ) )
+
+
+### args next arg rest ####
+(test '(T 1 1 3 (2 3 4))
+   (let foo '(@ (list (args) (next) (arg) (arg 2) (rest)))
+      (foo 1 2 3 4) ) )
+
+(test (7 7 NIL NIL)
+   ((quote @ (list (next) (arg) (next) (arg))) 7) )
+
+
+### usec ###
+(let U (usec)
+   (wait 400)
+   (test 4 (*/ (- (usec) U) 100000)) )
+
+
+### pwd ###
+(test (path '@) (pack (pwd) '/))
+
+
+### cd ###
+(cd "test")
+(test (path "@test") (pwd))
+(cd "..")
+
+
+### info ###
+(test '(T . @) (info "test"))
+(test (5 . @)
+   (out (tmp "info") (prinl "info"))
+   (info (tmp "info")) )
+
+
+### file ###
+(test (cons (tmp) "file" 1)
+   (out (tmp "file") (println '(file)))
+   (load (tmp "file")) )
+
+
+### dir ###
+(call 'mkdir "-p" (tmp "dir"))
+(out (tmp "dir/a"))
+(out (tmp "dir/b"))
+(out (tmp "dir/c"))
+
+(test '("a" "b" "c") (sort (dir (tmp "dir"))))
+
+
+### cmd ###
+(cmd "test")
+(test "test" (cmd))
+
+
+### argv ###
+(test '("abc" "123")
+   (pipe
+      (call "bin/picolisp" "-prog (println (argv)) (bye)" "abc" 123)
+      (read) ) )
+(test '("abc" "123")
+   (pipe
+      (call "bin/picolisp" "-prog (argv A B) (println (list A B)) (bye)" "abc" 123)
+      (read) ) )
+
+
+### opt ###
+(test '("abc" "123")
+   (pipe
+      (call "bin/picolisp" "-prog (println (list (opt) (opt))) (bye)" "abc" 123)
+      (read) ) )
+(test "abc"
+   (pipe
+      (call "bin/picolisp" "-de f () (println (opt))" "-f" "abc" "-bye")
+      (read) ) )
+
+
+### date time ###
+(use (Dat1 Tim1 Dat2 Tim2 D1 T1 D2 T2)
+   (until
+      (=
+         (setq Dat1 (date)  Tim1 (time T))
+         (prog
+            (setq
+               Dat2 (date T)
+               Tim2 (time T)
+               D1 (in '(date "+%Y %m %d") (list (read) (read) (read)))
+               T1 (in '(date "+%H %M %S") (list (read) (read) (read)))
+               D2 (in '(date "-u" "+%Y %m %d") (list (read) (read) (read)))
+               T2 (in '(date "-u" "+%H %M %S") (list (read) (read) (read))) )
+            (time) ) ) )
+   (test Tim1 (time T1))
+   (test Tim1 (apply time T1))
+   (test Tim2 (time T2))
+   (test Dat1 (date D1))
+   (test Dat1 (apply date D1))
+   (test Dat2 (date D2)) )
+
+(test (2000 7 15) (date 730622))
+(test 730622 (date 2000 7 15))
+(test 730622 (date (2000 7 15)))
+(test NIL (date NIL))
+
+(test (11 17 23) (time 40643))
+(test 40643 (time 11 17 23))
+(test 40643 (time (11 17 23)))
+(test NIL (time NIL))
+
+# vi:et:ts=3:sw=3
diff --git a/test/src/net.l b/test/src/net.l
@@ -0,0 +1,25 @@
+# 24nov09abu
+# (c) Software Lab. Alexander Burger
+
+### port listen connect ###
+(test '(a b c)
+   (if (fork)
+      (let P (port 4445)
+         (prog1
+            (in (listen P) (rd))
+            (close P) ) )
+      (wait 400)
+      (and (connect "localhost" 4445) (out @ (pr '(a b c))))
+      (bye) ) )
+
+
+### udp ###
+(test '(a b c)
+   (ifn (fork)
+      (prog
+         (wait 400)
+         (udp "localhost" 4446 '(a b c))
+         (bye) )
+      (udp (port T 4446)) ) )
+
+# vi:et:ts=3:sw=3
diff --git a/test/src/subr.l b/test/src/subr.l
@@ -0,0 +1,477 @@
+# 07nov09abu
+# (c) Software Lab. Alexander Burger
+
+### c[ad]*r ###
+(let L '(1 2 3 4 5)
+   (test 1 (car L))
+   (test (2 3 4 5) (cdr L))
+   (test 2 (cadr L))
+   (test (3 4 5) (cddr L))
+   (test 3 (caddr L))
+   (test (4 5) (cdddr L))
+   (test 4 (cadddr L))
+   (test (5) (cddddr L)) )
+(let L '((1 2 3) (4 5))
+   (test 1 (caar L))
+   (test (2 3) (cdar L))
+   (test 2 (cadar L))
+   (test (3) (cddar L))
+   (test 4 (caadr L))
+   (test (5) (cdadr L)) )
+(let L '(((1 2)))
+   (test 1 (caaar L))
+   (test (2) (cdaar L)) )
+
+
+### nth ###
+(test '(b c d) (nth '(a b c d) 2))
+(test '(c) (nth '(a (b c) d) 2 2))
+
+
+### con ###
+(let C (1 . a)
+   (test '(b c d) (con C '(b c d)))
+   (test (1 b c d) C) )
+
+
+### cons ###
+(test (1 . 2) (cons 1 2))
+(test '(a b c d) (cons 'a '(b c d)))
+(test '((a b) c d) (cons '(a b) '(c d)))
+(test '(a b c . d) (cons 'a 'b 'c 'd))
+
+
+### conc ###
+(let (A (1 2 3)  B '(a b c))
+   (test (1 2 3 a b c) (conc A B))
+   (test (1 2 3 a b c) A) )
+
+
+### circ ###
+(let C (circ 'a 'b 'c)
+   (test '(a b c . @) C)
+   (test T (== C (cdddr C))) )
+
+
+### rot ###
+(test (4 1 2 3) (rot (1 2 3 4)))
+(test (3 1 2 4 5 6) (rot (1 2 3 4 5 6) 3))
+(test (3 1 2 . @Z) (rot (1 2 3 .)))
+
+
+### list ###
+(test (1 2 3 4) (list 1 2 3 4))
+(test '(a (2 3) "OK") (list 'a (2 3) "OK"))
+
+
+### need ###
+(test '(NIL NIL NIL NIL NIL) (need 5))
+(test '(NIL NIL a b c) (need 5 '(a b c)))
+(test '(a b c NIL NIL) (need -5 '(a b c)))
+(test '(" " " " a b c) (need 5 '(a b c) " "))
+
+
+### range ###
+(test (1 2 3 4 5 6) (range 1 6))
+(test (1 2 3 4 5 6) (range 1 6))
+(test (6 5 4 3 2 1) (range 6 1))
+(test (-3 -2 -1 0 1 2 3) (range -3 3))
+(test (3 1 -1 -3) (range 3 -3 2))
+(test (-3 -2 -1) (range -3 -1))
+
+
+### full ###
+(test T (full (1 2 3)))
+(test NIL (full (1 NIL 3)))
+(test T (full 123))
+
+
+### make made chain link yoke ###
+(let (A 'a I 'i)
+   (test '(x y z z a)
+      (make
+         (link (for A '(x y z) (link A)))
+         (link A) ) )
+   (test (0 1 x 2 y 3 z i a)
+      (make
+         (for (I . A) '(x y z) (link I A))
+         (test (1 x 2 y 3 z) (made))
+         (made (cons 0 (made)))
+         (link I A) ) )
+   (test (1 2 3 4 5 6 7 8 9)
+      (make (chain (1 2 3)) (chain (4 5 6) (7 8 9))) )
+   (test '(a b c)
+      (make (yoke 'b) (link 'c) (yoke 'a)) )
+   (test '((x y z) (y z) (z) (z) a)
+      (make (link (for (A '(x y z) A (cdr A)) (link A))) (link A)) )
+   (test (1 (x y z) 2 (y z) 3 (z) (z) i a)
+      (make (link (for ((I . A) '(x y z) A (cdr A)) (link I A))) (link I A)) ) )
+
+
+### copy ###
+(test T (=T (copy T)))
+(let L (1 2 3)
+   (test T (== L L))
+   (test NIL (== L (copy L)))
+   (test T (= L (copy L)))
+   (test T (= (1 2 3) (copy L))) )
+
+
+### mix ###
+(test '(c d a b) (mix '(a b c d) 3 4 1 2))
+(test '(a A d D) (mix '(a b c d) 1 'A 4 'D))
+
+
+### append ###
+(test '(a b c 1 2 3) (append '(a b c) (1 2 3)))
+(test (1 2 3 . 4) (append (1) (2) (3) 4))
+
+
+### delete ###
+(test (1 3) (delete 2 (1 2 3)))
+(test '((1 2) (5 6) (3 4)) (delete (3 4) '((1 2) (3 4) (5 6) (3 4))))
+
+
+### delq ###
+(test '(a c) (delq 'b '(a b c)))
+(test (1 (2) 3) (delq (2) (1 (2) 3)))
+
+
+### replace ###
+(test '(A b b A) (replace '(a b b a) 'a 'A))
+(test '(a B B a) (replace '(a b b a) 'b 'B))
+(test '(B A A B) (replace '(a b b a) 'a 'B 'b 'A))
+
+
+### strip ###
+(test 123 (strip 123))
+(test '(a) (strip '''(a)))
+(test '(a b c) (strip (quote quote a b c)))
+
+
+### split ###
+(test '((1) (2 b) (c 4 d 5) (6))
+   (split (1 a 2 b 3 c 4 d 5 e 6) 'e 3 'a) )
+(test '("The" "quick" "brown" "fox")
+   (mapcar pack (split (chop "The quick brown fox") " ")) )
+
+
+### reverse ###
+(test (4 3 2 1) (reverse (1 2 3 4)))
+(test NIL (reverse NIL))
+
+
+### flip ###
+(test (4 3 2 1) (flip (1 2 3 4)))
+(test (3 2 1 4 5 6) (flip (1 2 3 4 5 6) 3))
+(test NIL (flip NIL))
+
+
+### trim ###
+(test (1 NIL 2) (trim (1 NIL 2 NIL NIL)))
+(test '(a b) (trim '(a b " " " ")))
+
+
+### clip ###
+(test (1 NIL 2) (clip '(NIL 1 NIL 2 NIL)))
+(test '(a " " b) (clip '(" " a " " b " ")))
+
+
+### head ###
+(test '(a b c) (head 3 '(a b c d e f)))
+(test NIL (head NIL '(a b c d e f)))
+(test NIL (head 0 '(a b c d e f)))
+(test '(a b c d e f) (head 10 '(a b c d e f)))
+(test '(a b c d) (head -2 '(a b c d e f)))
+(test '(a b c) (head '(a b c) '(a b c d e f)))
+
+
+### tail ###
+(test '(d e f) (tail 3 '(a b c d e f)))
+(test '(c d e f) (tail -2 '(a b c d e f)))
+(test NIL (tail NIL '(a b c d e f)))
+(test NIL (tail 0 '(a b c d e f)))
+(test '(a b c d e f) (tail 10 '(a b c d e f)))
+(test '(d e f) (tail '(d e f) '(a b c d e f)))
+
+
+### stem ###
+(test '("g" "h" "i") (stem (chop "abc/def\\ghi") "/" "\\"))
+(test '("g" "h" "i") (stem (chop "abc/def\\ghi") "\\" "/"))
+
+
+### fin ###
+(test 'a (fin 'a))
+(test 'b (fin '(a . b)))
+(test 'c (fin '(a b . c)))
+(test NIL (fin '(a b c)))
+
+
+### last ###
+(test 4 (last (1 2 3 4)))
+(test '(d e f) (last '((a b) c (d e f))))
+
+
+### == ###
+(test T (== 'a 'a))
+(test T (== 'NIL NIL (val NIL) (car NIL) (cdr NIL)))
+(test NIL (== (1 2 3) (1 2 3)))
+
+
+### n== ###
+(test NIL (n== 'a 'a))
+(test T (n== (1) (1)))
+
+
+### = ###
+(test T (= 6 (* 1 2 3)))
+(test T (= "a" "a"))
+(test T (== "a" "a"))
+(test T (= (1 (2) 3) (1 (2) 3)))
+
+
+### <> ###
+(test T (<> 'a 'b))
+(test T (<> 'a 'b 'b))
+(test NIL (<> 'a 'a 'a))
+
+
+### =0 ###
+(test 0 (=0 (- 6 3 2 1)))
+(test NIL (=0 'a))
+
+
+### =T ###
+(test NIL (=T 0))
+(test NIL (=T "T"))
+(test T (=T T))
+
+
+### n0 ###
+(test NIL (n0 (- 6 3 2 1)))
+(test T (n0 'a))
+
+
+### nT ###
+(test T (nT 0))
+(test T (nT "T"))
+(test NIL (nT T))
+
+
+### < ###
+(test T (< 3 4))
+(test T (< 'a 'b 'c))
+(test T (< 999 'a))
+(test T (< NIL 7 'x (1) T))
+
+
+### <= ###
+(test T (<= 3 3))
+(test T (<= 1 2 3))
+(test T (<= "abc" "abc" "def"))
+
+
+### > ###
+(test T (> 4 3))
+(test T (> 'A 999))
+(test T (> T (1) 'x 7 NIL))
+
+
+### >= ###
+(test T (>= 'A 999))
+(test T (>= 3 2 2 1))
+
+
+### max ###
+(test 'z (max 2 'a 'z 9))
+(test (5) (max (5) (2 3) 'X))
+
+
+### min ###
+(test 2 (min 2 'a 'z 9))
+(test 'X (min (5) (2 3) 'X))
+
+
+### atom ###
+(test T (atom 123))
+(test T (atom 'a))
+(test T (atom NIL))
+(test NIL (atom (123)))
+
+
+### pair ###
+(test NIL (pair NIL))
+(test (1 . 2) (pair (1 . 2)))
+(test (1 2 3) (pair (1 2 3)))
+
+
+### lst? ###
+(test T (lst? NIL))
+(test NIL (lst? T))
+(test T (lst? (1 . 2)))
+(test T (lst? (1 2 3)))
+
+
+### num? ###
+(test 123 (num? 123))
+(test NIL (num? 'abc))
+(test NIL (num? (1 2 3)))
+
+
+### sym? ###
+(test T (sym? 'a))
+(test T (sym? NIL))
+(test NIL (sym? 123))
+(test NIL (sym? '(a b)))
+
+
+### flg? ###
+(test T (flg? T))
+(test T (flg? NIL))
+(test NIL (flg? 0))
+(test T (flg? (= 3 3)))
+(test T (flg? (= 3 4)))
+(test NIL (flg? (+ 3 4)))
+
+
+### member ###
+(test (3 4 5 6) (member 3 (1 2 3 4 5 6)))
+(test NIL (member 9 (1 2 3 4 5 6)))
+(test '((d e f) (g h i))
+   (member '(d e f) '((a b c) (d e f) (g h i))) )
+
+
+### memq ###
+(test '(c d e f) (memq 'c '(a b c d e f)))
+(test NIL (memq (2) '((1) (2) (3))))
+(test 'c (memq 'c '(a b . c)))
+(test '(b c a . @Z) (memq 'b '(a b c .)))
+(test NIL (memq 'd '(a b c .)))
+
+
+### mmeq ###
+(test NIL (mmeq '(a b c) '(d e f)))
+(test '(b x) (mmeq '(a b c) '(d b x)))
+
+
+### sect ###
+(test (3 4) (sect (1 2 3 4) (3 4 5 6)))
+(test (1 2 3) (sect (1 2 3) (1 2 3)))
+(test NIL (sect (1 2 3) (4 5 6)))
+
+
+### diff ###
+(test (1 3 5) (diff (1 2 3 4 5) (2 4)))
+(test (1 2 3) (diff (1 2 3) NIL))
+(test NIL (diff (1 2 3) (1 2 3)))
+
+
+### index ###
+(test 3 (index 'c '(a b c d e f)))
+(test NIL (index 'z '(a b c d e f)))
+(test 3 (index '(5 6) '((1 2) (3 4) (5 6) (7 8))))
+
+
+### offset ###
+(test 3 (offset '(c d e f) '(a b c d e f)))
+(test NIL (offset '(c d e) '(a b c d e f)))
+
+
+### length ###
+(test 3 (length "abc"))
+(test 3 (length "äbc"))
+(test 3 (length 123))
+(test 3 (length (1 (2) 3)))
+(test T (length (1 2 3 .)))
+
+
+### size ###
+(test 3 (size "abc"))
+(test 4 (size "äbc"))
+(test 1 (size 127))
+(test 2 (size 128))
+(test 4 (size (1 (2) 3)))
+(test 3 (size (1 2 3 .)))
+(test 8 (size '((1 2 3) (4 5 6))))
+(test 6 (size '((1 2 .) (4 5 .))))
+
+
+### assoc ###
+(test '("b" . 7)
+   (assoc "b" '((999 1 2 3) ("b" . 7) ("ok" "Hello"))) )
+(test (999 1 2 3)
+   (assoc 999 '((999 1 2 3) ("b" . 7) ("ok" "Hello"))) )
+(test NIL
+   (assoc 'u '((999 1 2 3) ("b" . 7) ("ok" "Hello"))) )
+
+
+### asoq ###
+(test NIL
+   (asoq (9) '(((9) 1 2 3) (b . 7) ("ok" "Hello"))) )
+(test '(b . 7)
+   (asoq 'b '(((9) 1 2 3) (b . 7) ("ok" "Hello"))) )
+
+
+### rank ###
+(test NIL
+   (rank 0 '((1 . a) (100 . b) (1000 . c))) )
+(test (1 . a)
+   (rank 50 '((1 . a) (100 . b) (1000 . c))) )
+(test (100 . b)
+   (rank 100 '((1 . a) (100 . b) (1000 . c))) )
+(test (100 . b)
+   (rank 300 '((1 . a) (100 . b) (1000 . c))) )
+(test (1000 . c)
+   (rank 9999 '((1 . a) (100 . b) (1000 . c))) )
+(test (100 . b)
+   (rank 50 '((1000 . a) (100 . b) (1 . c)) T) )
+
+
+### match ###
+(use (@A @B @X @Y @Z)
+   (test T
+      (match '(@A is @B) '(This is a test)) )
+   (test '(This) @A)
+   (test '(a test) @B)
+   (test T
+      (match '(@X (d @Y) @Z) '((a b c) (d (e f) g) h i)) )
+   (test '((a b c)) @X)
+   (test '((e f) g) @Y)
+   (test '(h i) @Z) )
+
+
+### fill ###
+(let (@X 1234  @Y (1 2 3 4))
+   (test 1234 (fill '@X))
+   (test '(a b (c 1234) (((1 2 3 4) . d) e))
+      (fill '(a b (c @X) ((@Y . d) e))) ) )
+(let X 2 (test (1 2 3) (fill (1 X 3) 'X)))
+(let X 2 (test (1 2 3) (fill (1 X 3) '(X))))
+
+
+### prove ###
+(test T
+   (prove (goal '((equal 3 3)))) )
+(test '((@X . 3))
+   (prove (goal '((equal 3 @X)))) )
+(test NIL
+   (prove (goal '((equal 3 4)))) )
+
+
+### -> ###
+(test '((@A . 3) (@B . 7))
+   (prove (goal '(@A 3  (@B + 4 (-> @A))))) )
+
+
+### unify ###
+(test '((@A ((NIL . @C) 0 . @C) ((NIL . @B) 0 . @B) T))
+   (prove (goal '((@A unify '(@B @C))))) )
+
+
+### sort ###
+(test '(NIL 1 2 3 4 a b c d (1 2 3) (a b c) (x y z) T)
+   (sort '(a 3 1 (1 2 3) d b 4 T NIL (a b c) (x y z) c 2)) )
+(test '(T (x y z) (a b c) (1 2 3) d c b a 4 3 2 1 NIL)
+   (sort '(a 3 1 (1 2 3) d b 4 T NIL (a b c) (x y z) c 2) >) )
+
+# vi:et:ts=3:sw=3
diff --git a/test/src/sym.l b/test/src/sym.l
@@ -0,0 +1,368 @@
+# 09sep09abu
+# (c) Software Lab. Alexander Burger
+
+### name ###
+(test "abc" (name 'abc))
+(test "A123" (name '{A123}))
+(let X (box)
+   (test NIL (name X))
+   (name X "xxx")
+   (test "xxx" (name X)) )
+
+
+### sp? ###
+(test T (sp? " ^I^J"))
+(test NIL (sp? " abc"))
+(test NIL (sp? 123))
+
+
+### pat? ###
+(test `(char '@) (char (pat? '@)))
+(test NIL (pat? "ABC"))
+(test NIL (pat? 123))
+
+
+### fun? ###
+(test 1000000000 (fun? 1000000000))
+(test NIL (fun? 12345678901234567890))
+(test '(A B) (fun? '((A B) (* A B))))
+(test NIL (fun? '((A B) (* A B) . C)))
+(test NIL (fun? (1 2 3 4)))
+(test NIL (fun? '((A 2 B) (* A B))))
+(test T (fun? '(NIL (* 3 4))))
+
+
+### all ###
+(test '(test)
+   (filter '((S) (= S "test")) (all)) )
+
+
+### intern ###
+(test car (val (intern (pack "c" "a" "r"))))
+
+
+### extern ###
+(test NIL (extern (box)))
+(test *DB (extern "1"))
+
+
+### ==== ###
+(setq *Sym "abc")
+(test T (== *Sym "abc"))
+(====)
+(test NIL (== *Sym "abc"))
+
+
+### box? ###
+(let X (box)
+   (test X (box? X)) )
+(test NIL (box? 123))
+(test NIL (box? 'a))
+(test NIL (box? NIL))
+
+
+### str? ###
+(test NIL (str? 123))
+(test NIL (str? '{A123}))
+(test NIL (str? 'abc))
+(test "abc" (str? "abc"))
+
+
+### ext? ###
+(test *DB (ext? *DB))
+(test NIL (ext? 'abc))
+(test NIL (ext? "abc"))
+(test NIL (ext? 123))
+
+
+### touch ###
+(test *DB (touch *DB))
+(rollback)
+
+
+### zap ###
+(test "abc" (str? (zap 'abc)))
+
+
+### chop ###
+(test '("c" "a" "r") (chop 'car)))
+(test '("H" "e" "l" "l" "o") (chop "Hello"))
+(test '("1" "2" "3") (chop 123))
+(test (1 2 3) (chop (1 2 3)))
+(test NIL (chop NIL))
+
+
+### pack ###
+(test "car is 1 symbol name"
+   (pack 'car " is " 1 '(" symbol " name)) )
+
+
+### glue ###
+(test 1 (glue NIL 1))
+(test "a" (glue NIL '(a)))
+(test "ab" (glue NIL '(a b)))
+(test "a,b" (glue "," '(a b)))
+(test "a8b" (glue 8 '(a b)))
+(test "a123b123c" (glue (1 2 3) '(a b c)))
+
+
+### text ###
+(test "abc XYZ def 123" (text "abc @1 def @2" 'XYZ 123))
+(test "aXYZz" (text "a@3z" 1 2 '(X Y Z)))
+(test "a@bc.de" (text "a@@bc.@1" "de"))
+(test "10.11.12" (text "@A.@B.@C" 1 2 3 4 5 6 7 8 9 10 11 12))
+
+
+### pre? ###
+(test "abcdef" (pre? "" "abcdef")))
+(test NIL (pre? "abc" "")))
+(test "abcdef" (pre? "abc" "abcdef")))
+(test NIL (pre? "def" "abcdef"))
+(test "abcdef" (pre? "" "abcdef"))
+(test "7fach" (pre? (+ 3 4) "7fach"))
+
+
+### sub? ###
+(test "abcdef" (sub? "" "abcdef")))
+(test NIL (sub? "abc" "")))
+(test "abcdef" (sub? "cde" "abcdef"))
+(test "abcdef" (sub? "def" "abcdef"))
+(test NIL (sub? "abb" "abcdef"))
+(test "abcdef" (sub? "" "abcdef"))
+
+
+### val ###
+(let L '(a b c)
+   (test '(a b c) (val 'L))
+   (test 'b (val (cdr L))) )
+
+
+### set ###
+(use L
+   (test '(a b c) (set 'L '(a b c)))
+   (test 999 (set (cdr L) '999))
+   (test '(a 999 c) L) )
+
+
+### setq ###
+(use (A B)
+   (test (123 123)
+      (setq  A 123  B (list A A)) )
+   (test 123 A)
+   (test (123 123) B) )
+
+
+### xchg ###
+(let (A 1  B 2  C '(a b c))
+   (test 2 (xchg 'A C  'B (cdr C)))
+   (test 'a A)
+   (test 'b B)
+   (test (1 2 c) C) )
+
+
+### on off onOff zero one ###
+(use (A B)
+   (test T (on A B))
+   (test T A)
+   (test T B)
+   (test NIL (off A))
+   (test NIL A)
+   (test NIL (onOff B))
+   (test NIL B)
+   (test T (onOff A B))
+   (test T A)
+   (test T B)
+   (test 0 (zero A B))
+   (test 0 A)
+   (test 0 B)
+   (test 1 (one A B))
+   (test 1 A)
+   (test 1 B) )
+
+
+### default ###
+(let (A NIL  B NIL)
+   (test 2 (default A 1  B 2))
+   (test A 1)
+   (test B 2)
+   (test 2 (default A 7  B 8))
+   (test A 1)
+   (test B 2) )
+
+
+### push push1 pop cut ###
+(let L NIL
+   (test 1 (push 'L 3 2 1))
+   (test L (1 2 3))
+   (test 0 (push1 'L 0))
+   (test 1 (push1 'L 1))
+   (test L (0 1 2 3))
+   (test 0 (pop 'L))
+   (test (1 2) (cut 2 'L))
+   (test (3) L) )
+
+
+### del ###
+(let (L '((a b c) (d e f))  S (new))
+   (put S 'lst L)
+   (test '((a b c)) (del '(d e f) 'L))
+   (test '(a b c) (del 'x L))
+   (test '(a c) (del 'b L))
+   (with S
+      (test '((a b c)) (del '(d e f) (:: lst)))
+      (test NIL (del '(a b c) (:: lst)))
+      (test NIL (: lst)) ) )
+
+
+### queue ###
+(let A NIL
+   (test 1 (queue 'A 1))
+   (test 2 (queue 'A 2))
+   (test 3 (queue 'A 3))
+   (test (1 2 3) A) )
+
+
+### fifo ###
+(let X NIL
+   (test 1 (fifo 'X 1))
+   (test 3 (fifo 'X 2 3))
+   (test 1 (fifo 'X))
+   (test 2 (fifo 'X))
+   (test 3 (fifo 'X)) )
+
+
+### idx lup ###
+(let X NIL
+   (test NIL (idx 'X 'd T))
+   (test NIL (idx 'X (2 . f) T))
+   (test NIL (idx 'X (3 . g) T))
+   (test NIL (idx 'X '(a b c) T))
+   (test NIL (idx 'X 17 T))
+   (test NIL (idx 'X 'A T))
+   (test '(d . @) (idx 'X 'd T))
+   (test NIL (idx 'X T T))
+   (test '(A) (idx 'X 'A))
+   (test '(17 A d (2 . f) (3 . g) (a b c) T)
+      (idx 'X) )
+   (test (2 . f) (lup X 2))
+   (test '((2 . f) (3 . g)) (lup X 1 4))
+   (test '(17 . @) (idx 'X 17 NIL))
+   (test '(A d (2 . f) (3 . g) (a b c) T)
+      (idx 'X) )
+   (off X)
+   (for N '((4 . D) 3 (2 . B) Y (3 . C) Z (6 . F) 7 (7 . G) X (1 . A) T (5 . E) 5)
+      (idx 'X N T) )
+   (test '(3 5 7 X Y Z (1 . A) (2 . B) (3 . C) (4 . D) (5 . E) (6 . F) (7 . G) T)
+      (idx 'X) )
+   (test '((3 . C) (4 . D) (5 . E))
+      (lup X 3 5) )
+   (test '((1 . A) (2 . B) (3 . C) (4 . D) (5 . E) (6 . F) (7 . G))
+         (lup X 0 9) ) )
+
+
+### put get prop ; =: : :: putl getl ###
+(let (A (box)  B (box A)  C (box (cons A B)))
+   (put B 'a A)
+   (put C 'b B)
+   (put A 'x 1)
+   (put B 'a 'y 2)
+   (put C 0 -1 'a 'z 3)
+   (test 1 (get A 'x))
+   (test 1 (; A x))
+   (test 2 (with A (: y)))
+   (test 2 (get A 'y))
+   (test 2 (; A y))
+   (test 2 (with B (: 0 y)))
+   (test 2 (get B 0 'y))
+   (test 2 (; B 0 y))
+   (test 3 (with C (: b a z)))
+   (test 3 (with C (: 0 1 z)))
+   (test 3 (with C (: 0 -1 a z)))
+   (test 3 (get C 0 1 'z))
+   (test 3 (get C 0 -1 'a 'z))
+   (test 3 (; C 0 -1 a z))
+   (test (3 . z) (prop C 0 -1 'a 'z))
+   (test 9 (with C (=: 0 -1 a z (* 3 3))))
+   (test (9 . z) (with C (:: 0 -1 a z)))
+   (test (putl C 0 -1 'a '((1 . x) (2 . y))) (flip (getl C 'b 0))) )
+
+(test NIL (get (1 2 3) 0))
+(test 1 (get (1 2 3) 1))
+(test 3 (get (1 2 3) 3))
+(test NIL (get (1 2 3) 4))
+(test (3) (get (1 2 3) -2))
+(test 1 (get '((a (b . 1) (c . 2)) (d (e . 3) (f . 4))) 'a 'b))
+(test 4 (get '((a (b . 1) (c . 2)) (d (e . 3) (f . 4))) 'd 'f))
+
+
+### wipe ###
+(let X (box (1 2 3 4))
+   (put X 'a 1)
+   (put X 'b 2)
+   (test (1 2 3 4) (val X))
+   (test '((2 . b) (1 . a)) (getl X))
+   (wipe X)
+   (test NIL (val X))
+   (test NIL (getl X)) )
+
+(setq "W" (1 2 3 4))
+(put '"W" 'a 1)
+(put '"W" 'b 2)
+(test (1 2 3 4) "W")
+(test '((2 . b) (1 . a)) (getl '"W"))
+(wipe '"W")
+(test NIL "W")
+(test NIL (getl '"W"))
+
+(set *DB (1 2 3 4))
+(put *DB 'a 1)
+(put *DB 'b 2)
+(test (1 2 3 4) (val *DB))
+(test '((2 . b) (1 . a)) (getl *DB))
+(wipe *DB)
+(test (1 2 3 4) (val *DB))
+(test '((2 . b) (1 . a)) (getl *DB))
+(rollback)
+(test NIL "W")
+(test NIL (getl '"W"))
+
+
+### meta ###
+(let A '("B")
+   (put '"B" 'a 123)
+   (test 123 (meta 'A 'a)) )
+
+
+### low? ###
+(test "a" (low? "a"))
+(test NIL (low? "A"))
+(test NIL (low? 123))
+(test NIL (low? "."))
+
+
+### upp? ###
+(test "A" (upp? "A"))
+(test NIL (upp? "a"))
+(test NIL (upp? 123))
+(test NIL (upp? "."))
+
+
+### lowc ###
+(test "abc" (lowc "ABC"))
+(test "äöü" (lowc "ÄÖÜ"))
+(test "äöü" (lowc "äöü"))
+(test 123 (lowc 123))
+
+
+### uppc ###
+(test "ABC" (uppc "abc"))
+(test "ÄÖÜ" (uppc "äöü"))
+(test "ÄÖÜ" (uppc "ÄÖÜ"))
+(test 123 (lowc 123))
+
+
+### fold ###
+(test "1a2b3" (fold " 1A 2-b/3"))
+(test "1a2" (fold " 1A 2-B/3" 3))
+
+# vi:et:ts=3:sw=3

	picolisp Unnamed repository; edit this file to name it for gitweb.
	git clone https://logand.com/git/picolisp.git/
	Log \| Files \| Refs \| README \| LICENSE

A	CHANGES	\|	404	+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	COPYING	\|	280	+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	CREDITS	\|	23	+++++++++++++++++++++++
A	INSTALL	\|	103	+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	README	\|	105	+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	ReleaseNotes	\|	18	++++++++++++++++++
A	app/cusu.l	\|	43	+++++++++++++++++++++++++++++++++++++++++++
A	app/er.l	\|	167	+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	app/gui.l	\|	243	+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	app/init.l	\|	81	+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	app/inventory.l	\|	55	+++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	app/item.l	\|	40	++++++++++++++++++++++++++++++++++++++++
A	app/lib.l	\|	62	++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	app/loc/ar	\|	5	+++++
A	app/loc/ch	\|	4	++++
A	app/loc/de	\|	86	+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	app/loc/es	\|	86	+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	app/loc/jp	\|	86	+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	app/loc/no	\|	86	+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	app/loc/ru	\|	86	+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	app/main.l	\|	61	+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	app/ord.l	\|	58	++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	app/role.l	\|	33	+++++++++++++++++++++++++++++++++
A	app/sal.l	\|	21	+++++++++++++++++++++
A	app/sales.l	\|	56	++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	app/user.l	\|	36	++++++++++++++++++++++++++++++++++++
A	bin/pil	\|	2	++
A	bin/psh	\|	14	++++++++++++++
A	bin/replica	\|	31	+++++++++++++++++++++++++++++++
A	bin/scrape	\|	11	+++++++++++
A	bin/watchdog	\|	68	++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	cygwin/README	\|	170	+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	cygwin/tcc.l	\|	22	++++++++++++++++++++++
A	dbg	\|	2	++
A	dbg.l	\|	16	++++++++++++++++
A	doc/app.html	\|	2551	+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	doc/apply	\|	30	++++++++++++++++++++++++++++++
A	doc/db	\|	91	+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	doc/doc.css	\|	12	++++++++++++
A	doc/family.l	\|	242	+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	doc/family/1	\|	0
A	doc/family/2	\|	0
A	doc/family/3	\|	0
A	doc/family/4	\|	0
A	doc/faq.html	\|	664	+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	doc/fun.l	\|	9	+++++++++
A	doc/hello.l	\|	5	+++++
A	doc/index.html	\|	108	+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	doc/model	\|	57	+++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	doc/quine	\|	24	++++++++++++++++++++++++
A	doc/ref.html	\|	2455	+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	doc/refA.html	\|	567	+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	doc/refB.html	\|	319	+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	doc/refC.html	\|	657	+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	doc/refD.html	\|	748	+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	doc/refE.html	\|	486	+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	doc/refF.html	\|	512	+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	doc/refG.html	\|	188	+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	doc/refH.html	\|	216	+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	doc/refI.html	\|	389	+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	doc/refJ.html	\|	81	+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	doc/refK.html	\|	58	++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	doc/refL.html	\|	531	+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	doc/refM.html	\|	621	+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	doc/refN.html	\|	399	+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	doc/refO.html	\|	262	+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	doc/refP.html	\|	816	+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	doc/refQ.html	\|	107	+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	doc/refR.html	\|	713	+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	doc/refS.html	\|	870	+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	doc/refT.html	\|	565	+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	doc/refU.html	\|	356	+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	doc/refV.html	\|	163	+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	doc/refW.html	\|	196	+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	doc/refX.html	\|	57	+++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	doc/refY.html	\|	30	++++++++++++++++++++++++++++++
A	doc/refZ.html	\|	102	+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	doc/ref_.html	\|	546	+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	doc/rlook.html	\|	67	+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	doc/select.html	\|	490	+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	doc/shape.l	\|	59	+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	doc/structures	\|	90	+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	doc/toc.html	\|	41	+++++++++++++++++++++++++++++++++++++++++
A	doc/travel	\|	24	++++++++++++++++++++++++
A	doc/tut.html	\|	2402	+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	doc/utf8	\|	39	+++++++++++++++++++++++++++++++++++++++
A	doc64/README	\|	136	+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	doc64/asm	\|	194	+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	doc64/structures	\|	308	+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	ext.l	\|	6	++++++
A	favicon.ico	\|	0
A	games/README	\|	233	+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	games/chess.l	\|	566	+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	games/mine.l	\|	126	+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	games/nim.l	\|	27	+++++++++++++++++++++++++++
A	games/sudoku.l	\|	73	+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	games/ttt.l	\|	72	++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	games/xchess	\|	49	+++++++++++++++++++++++++++++++++++++++++++++++++
A	img/7fach.eps	\|	474	+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	img/7fach.gif	\|	0
A	img/go.png	\|	0
A	img/no.png	\|	0
A	lib.css	\|	194	+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	lib.l	\|	369	+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	lib/adm.l	\|	71	+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	lib/app.l	\|	34	++++++++++++++++++++++++++++++++++
A	lib/boss.l	\|	16	++++++++++++++++
A	lib/btree.l	\|	438	+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	lib/cal.l	\|	79	+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	lib/conDbgc.l	\|	69	+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	lib/db.l	\|	1125	++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	lib/db32-64.l	\|	73	+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	lib/dbase.l	\|	59	+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	lib/debug.l	\|	362	+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	lib/ed.l	\|	47	+++++++++++++++++++++++++++++++++++++++++++++++
A	lib/edit.l	\|	66	++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	lib/el/inferior-picolisp.el	\|	312	+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	lib/el/paredit.el.diff	\|	89	+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	lib/el/picolisp.el	\|	536	+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	lib/el/tsm.el	\|	130	+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	lib/form.js	\|	352	+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	lib/form.l	\|	2069	+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	lib/gcc.l	\|	40	++++++++++++++++++++++++++++++++++++++++
A	lib/glyphlist.txt	\|	4322	+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	lib/head.ps	\|	28	++++++++++++++++++++++++++++
A	lib/heartbeat.l	\|	19	+++++++++++++++++++
A	lib/http.l	\|	440	+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	lib/import.l	\|	30	++++++++++++++++++++++++++++++
A	lib/led.l	\|	431	+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	lib/led.min.l	\|	23	+++++++++++++++++++++++
A	lib/lint.l	\|	257	+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	lib/math.l	\|	11	+++++++++++
A	lib/math32.l	\|	22	++++++++++++++++++++++
A	lib/math64.l	\|	44	++++++++++++++++++++++++++++++++++++++++++++
A	lib/misc.l	\|	480	+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	lib/native.l	\|	23	+++++++++++++++++++++++
A	lib/pilog.l	\|	550	+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	lib/prof.l	\|	51	+++++++++++++++++++++++++++++++++++++++++++++++++++
A	lib/ps.l	\|	318	+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	lib/readline.l	\|	28	++++++++++++++++++++++++++++
A	lib/rsa.l	\|	109	+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	lib/scrape.l	\|	160	+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	lib/simul.l	\|	154	+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	lib/sq.l	\|	131	+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	lib/tags	\|	346	+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	lib/term.l	\|	47	+++++++++++++++++++++++++++++++++++++++++++++++
A	lib/test.l	\|	31	+++++++++++++++++++++++++++++++
A	lib/tex.l	\|	164	+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	lib/too.l	\|	487	+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	lib/xhtml.l	\|	669	+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	lib/xm.l	\|	115	+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	lib/xml.l	\|	286	+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	lib/xmlrpc.l	\|	63	+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	loc/AR.l	\|	7	+++++++
A	loc/CH.l	\|	7	+++++++
A	loc/DE.l	\|	7	+++++++
A	loc/ES.l	\|	7	+++++++
A	loc/JP.l	\|	7	+++++++
A	loc/NIL.l	\|	7	+++++++
A	loc/NO.l	\|	7	+++++++
A	loc/RU.l	\|	7	+++++++
A	loc/UK.l	\|	7	+++++++
A	loc/US.l	\|	7	+++++++
A	loc/ar	\|	1	+
A	loc/ch	\|	4	++++
A	loc/de	\|	77	+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	loc/es	\|	52	++++++++++++++++++++++++++++++++++++++++++++++++++++
A	loc/jp	\|	77	+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	loc/no	\|	77	+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	loc/ru	\|	77	+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	misc/bigtest	\|	103	+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	misc/calc	\|	12	++++++++++++
A	misc/calc.l	\|	73	+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	misc/chat	\|	32	++++++++++++++++++++++++++++++++
A	misc/crc.l	\|	23	+++++++++++++++++++++++
A	misc/dining.l	\|	42	++++++++++++++++++++++++++++++++++++++++++
A	misc/dirTree.l	\|	19	+++++++++++++++++++
A	misc/fannkuch.l	\|	38	++++++++++++++++++++++++++++++++++++++
A	misc/fibo.l	\|	50	++++++++++++++++++++++++++++++++++++++++++++++++++
A	misc/hanoi.l	\|	24	++++++++++++++++++++++++
A	misc/life.l	\|	54	++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	misc/mailing	\|	93	+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	misc/maze.l	\|	33	+++++++++++++++++++++++++++++++++
A	misc/pi.l	\|	23	+++++++++++++++++++++++
A	misc/pilog.l	\|	125	+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	misc/reverse.l	\|	16	++++++++++++++++
A	misc/setf.l	\|	49	+++++++++++++++++++++++++++++++++++++++++++++++++
A	misc/sieve.l	\|	14	++++++++++++++
A	misc/stress.l	\|	68	++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	misc/travel.l	\|	51	+++++++++++++++++++++++++++++++++++++++++++++++++++
A	misc/trip.l	\|	84	+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	opt/pilog.l	\|	15	+++++++++++++++
A	p	\|	2	++
A	plmod	\|	2	++
A	plmod.l	\|	10	++++++++++
A	rcsim/README	\|	125	+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	rcsim/env.l	\|	103	+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	rcsim/fokker.l	\|	456	+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	rcsim/lib.l	\|	255	+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	rcsim/main.l	\|	124	+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	rcsim/tone	\|	41	+++++++++++++++++++++++++++++++++++++++++
A	simul/lib.l	\|	90	+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	simul/rgb.l	\|	29	+++++++++++++++++++++++++++++
A	src/Makefile	\|	145	+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	src/apply.c	\|	676	+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	src/balance.c	\|	94	+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	src/big.c	\|	1137	+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	src/ext.c	\|	182	+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	src/flow.c	\|	1688	+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	src/gc.c	\|	185	+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	src/ht.c	\|	368	+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	src/httpGate.c	\|	309	+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	src/io.c	\|	3543	+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	src/lat1.c	\|	75	+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	src/main.c	\|	1140	+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	src/net.c	\|	204	+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	src/pico.h	\|	852	+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	src/ssl.c	\|	241	+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	src/start.c	\|	10	++++++++++
A	src/subr.c	\|	1686	+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	src/sym.c	\|	1991	+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	src/tab.c	\|	410	+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	src/utf2.c	\|	68	++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	src/z3d.c	\|	468	+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	src/z3dClient.c	\|	532	+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	src64/Makefile	\|	65	+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	src64/apply.l	\|	1606	+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	src64/arch/x86-64.l	\|	772	+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	src64/big.l	\|	2673	+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	src64/db.l	\|	2249	+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	src64/defs.l	\|	65	+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	src64/err.l	\|	726	+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	src64/ext.l	\|	248	+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	src64/flow.l	\|	3150	+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	src64/gc.l	\|	1002	+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	src64/glob.l	\|	1078	+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	src64/ht.l	\|	727	+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	src64/io.l	\|	5001	+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	src64/lib/asm.l	\|	546	+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	src64/main.l	\|	2605	+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	src64/mkAsm	\|	14	++++++++++++++
A	src64/net.l	\|	336	+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	src64/subr.l	\|	4013	+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	src64/sym.l	\|	3417	+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	src64/sys/linux.code.l	\|	39	+++++++++++++++++++++++++++++++++++++++
A	src64/sys/linux.defs.l	\|	145	+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	src64/version.l	\|	6	++++++
A	test/lib.l	\|	201	+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	test/lib/lint.l	\|	21	+++++++++++++++++++++
A	test/lib/misc.l	\|	213	+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	test/src/apply.l	\|	107	+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	test/src/big.l	\|	159	+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	test/src/db.l	\|	43	+++++++++++++++++++++++++++++++++++++++++++
A	test/src/ext.l	\|	22	++++++++++++++++++++++
A	test/src/ext2.l	\|	31	+++++++++++++++++++++++++++++++
A	test/src/flow.l	\|	434	+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	test/src/ht.l	\|	46	++++++++++++++++++++++++++++++++++++++++++++++
A	test/src/io.l	\|	220	+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	test/src/main.l	\|	150	+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	test/src/net.l	\|	25	+++++++++++++++++++++++++
A	test/src/subr.l	\|	477	+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A	test/src/sym.l	\|	368	+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++