commit 087a1d4d194b375c220a3f7f2c4ffe185c6ac655
parent 940fccd04ada1a55f5ffcdcf1d3b21809c7ca051
Author: Alexander Burger <abu@software-lab.de>
Date: Fri, 28 Dec 2012 10:51:43 +0100
'bytes' function
Diffstat:
21 files changed, 485 insertions(+), 424 deletions(-)
diff --git a/CHANGES b/CHANGES
@@ -1,4 +1,5 @@
* DDmmm13 picoLisp-3.1.2
+ 'bytes' function
Join multiple namespaces with 'symbols'
* 30nov12 picoLisp-3.1.1
@@ -7,7 +8,7 @@
Changed from CTags to ETags format
Backtrace with 'trail' and 'up' (64-bit)
Changed semantics of token 'read'
- -server function
+ '-server' function
64-bit emulator
'*CPU' global variable (64-bit)
Bug in 'collect' for 'fold'ed keys
diff --git a/doc/ref.html b/doc/ref.html
@@ -2137,6 +2137,7 @@ abbreviations:
<a href="refG.html#group">group</a>
<a href="refL.html#length">length</a>
<a href="refS.html#size">size</a>
+ <a href="refB.html#bytes">bytes</a>
<a href="refV.html#val">val</a>
<a href="refS.html#set">set</a>
<a href="refX.html#xchg">xchg</a>
diff --git a/doc/refB.html b/doc/refB.html
@@ -346,6 +346,27 @@ bye
$
</code></pre>
+<dt><a name="bytes"><code>(bytes 'any) -> cnt</code></a>
+<dd>Returns the number of bytes <code>any</code> would occupy in encoded binary
+format (as generated by <code><a href="refP.html#pr">pr</a></code>). See also
+<code><a href="refS.html#size">size</a></code> and <code><a
+href="refL.html#length">length</a></code>.
+
+<pre><code>
+: (bytes "abc")
+-> 4
+: (bytes "äbc")
+-> 5
+: (bytes 127)
+-> 2
+: (bytes 128)
+-> 3
+: (bytes (101 (102) 103))
+-> 10
+: (bytes (101 102 103 .))
+-> 9
+</code></pre>
+
</dl>
</body>
diff --git a/doc/refL.html b/doc/refL.html
@@ -118,7 +118,8 @@ href="refS.html#step">step</a></code>.
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 cells (or
<code>T</code> for circular lists). See also <code><a
-href="refS.html#size">size</a></code>.
+href="refS.html#size">size</a></code> and <code><a
+href="refB.html#bytes">bytes</a></code>.
<pre><code>
: (length "abc")
diff --git a/doc/refP.html b/doc/refP.html
@@ -485,6 +485,7 @@ href="refV.html#vi">vi</a></code>.
<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="refB.html#bytes">bytes</a></code>, <code><a
href="refT.html#tell">tell</a></code>, <code><a
href="refH.html#hear">hear</a></code> and <code><a
href="refW.html#wr">wr</a></code>.
diff --git a/doc/refS.html b/doc/refS.html
@@ -476,7 +476,8 @@ 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 by 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>.
+href="refL.html#length">length</a></code> and <code><a
+href="refB.html#bytes">bytes</a></code>.
<pre><code>
: (size "abc")
diff --git a/ersatz/picolisp.jar b/ersatz/picolisp.jar
Binary files differ.
diff --git a/lib/map b/lib/map
@@ -6,7 +6,7 @@ $ (2967 . "@src64/flow.l")
*/ (2446 . "@src64/big.l")
+ (2171 . "@src64/big.l")
- (2209 . "@src64/big.l")
--> (3916 . "@src64/subr.l")
+-> (3928 . "@src64/subr.l")
/ (2513 . "@src64/big.l")
: (3060 . "@src64/sym.l")
:: (3084 . "@src64/sym.l")
@@ -32,12 +32,12 @@ and (1624 . "@src64/flow.l")
any (3979 . "@src64/io.l")
append (1338 . "@src64/subr.l")
apply (713 . "@src64/apply.l")
-arg (2478 . "@src64/main.l")
-args (2454 . "@src64/main.l")
-argv (3101 . "@src64/main.l")
+arg (2573 . "@src64/main.l")
+args (2549 . "@src64/main.l")
+argv (3196 . "@src64/main.l")
as (139 . "@src64/flow.l")
-asoq (3008 . "@src64/subr.l")
-assoc (2973 . "@src64/subr.l")
+asoq (3020 . "@src64/subr.l")
+assoc (2985 . "@src64/subr.l")
at (2109 . "@src64/flow.l")
atom (2385 . "@src64/subr.l")
bind (1362 . "@src64/flow.l")
@@ -47,6 +47,7 @@ box (828 . "@src64/flow.l")
box? (1131 . "@src64/sym.l")
by (1669 . "@src64/apply.l")
bye (3444 . "@src64/flow.l")
+bytes (2972 . "@src64/subr.l")
caaaar (271 . "@src64/subr.l")
caaadr (288 . "@src64/subr.l")
caaar (99 . "@src64/subr.l")
@@ -65,7 +66,7 @@ call (3096 . "@src64/flow.l")
car (5 . "@src64/subr.l")
case (1965 . "@src64/flow.l")
catch (2467 . "@src64/flow.l")
-cd (2853 . "@src64/main.l")
+cd (2948 . "@src64/main.l")
cdaaar (464 . "@src64/subr.l")
cdaadr (487 . "@src64/subr.l")
cdaar (179 . "@src64/subr.l")
@@ -88,10 +89,10 @@ circ (816 . "@src64/subr.l")
circ? (2402 . "@src64/subr.l")
clip (1799 . "@src64/subr.l")
close (4392 . "@src64/io.l")
-cmd (3083 . "@src64/main.l")
+cmd (3178 . "@src64/main.l")
cnt (1413 . "@src64/apply.l")
co (2548 . "@src64/flow.l")
-commit (1498 . "@src64/db.l")
+commit (1403 . "@src64/db.l")
con (725 . "@src64/subr.l")
conc (781 . "@src64/subr.l")
cond (1919 . "@src64/flow.l")
@@ -99,10 +100,10 @@ connect (224 . "@src64/net.l")
cons (747 . "@src64/subr.l")
copy (1225 . "@src64/subr.l")
ctl (4265 . "@src64/io.l")
-ctty (2878 . "@src64/main.l")
+ctty (2973 . "@src64/main.l")
cut (1931 . "@src64/sym.l")
-date (2592 . "@src64/main.l")
-dbck (2113 . "@src64/db.l")
+date (2687 . "@src64/main.l")
+dbck (2018 . "@src64/db.l")
de (532 . "@src64/flow.l")
dec (2323 . "@src64/big.l")
def (448 . "@src64/flow.l")
@@ -111,7 +112,7 @@ del (1986 . "@src64/sym.l")
delete (1401 . "@src64/subr.l")
delq (1452 . "@src64/subr.l")
diff (2589 . "@src64/subr.l")
-dir (3013 . "@src64/main.l")
+dir (3108 . "@src64/main.l")
dm (545 . "@src64/flow.l")
do (2141 . "@src64/flow.l")
e (2928 . "@src64/flow.l")
@@ -120,7 +121,7 @@ env (599 . "@src64/main.l")
eof (3538 . "@src64/io.l")
eol (3529 . "@src64/io.l")
err (4245 . "@src64/io.l")
-errno (1480 . "@src64/main.l")
+errno (1575 . "@src64/main.l")
eval (175 . "@src64/flow.l")
ext (5157 . "@src64/io.l")
ext? (1166 . "@src64/sym.l")
@@ -128,8 +129,8 @@ extern (1032 . "@src64/sym.l")
extra (1269 . "@src64/flow.l")
extract (1218 . "@src64/apply.l")
fifo (2097 . "@src64/sym.l")
-file (2960 . "@src64/main.l")
-fill (3243 . "@src64/subr.l")
+file (3055 . "@src64/main.l")
+fill (3255 . "@src64/subr.l")
filter (1161 . "@src64/apply.l")
fin (2033 . "@src64/subr.l")
finally (2524 . "@src64/flow.l")
@@ -142,7 +143,7 @@ fold (3521 . "@src64/sym.l")
for (2230 . "@src64/flow.l")
fork (3270 . "@src64/flow.l")
format (2089 . "@src64/big.l")
-free (2055 . "@src64/db.l")
+free (1960 . "@src64/db.l")
from (3557 . "@src64/io.l")
full (1075 . "@src64/subr.l")
fun? (750 . "@src64/sym.l")
@@ -166,7 +167,7 @@ ifn (1865 . "@src64/flow.l")
in (4205 . "@src64/io.l")
inc (2256 . "@src64/big.l")
index (2637 . "@src64/subr.l")
-info (2915 . "@src64/main.l")
+info (3010 . "@src64/main.l")
intern (1007 . "@src64/sym.l")
ipid (3215 . "@src64/flow.l")
isa (967 . "@src64/flow.l")
@@ -183,7 +184,7 @@ lieu (1157 . "@src64/db.l")
line (3713 . "@src64/io.l")
lines (3866 . "@src64/io.l")
link (1172 . "@src64/subr.l")
-lisp (2149 . "@src64/main.l")
+lisp (2244 . "@src64/main.l")
list (887 . "@src64/subr.l")
listen (157 . "@src64/net.l")
lit (150 . "@src64/flow.l")
@@ -204,8 +205,8 @@ mapcar (987 . "@src64/apply.l")
mapcon (1041 . "@src64/apply.l")
maplist (933 . "@src64/apply.l")
maps (790 . "@src64/apply.l")
-mark (1973 . "@src64/db.l")
-match (3128 . "@src64/subr.l")
+mark (1878 . "@src64/db.l")
+match (3140 . "@src64/subr.l")
max (2327 . "@src64/subr.l")
maxi (1511 . "@src64/apply.l")
member (2455 . "@src64/subr.l")
@@ -222,10 +223,10 @@ n== (2087 . "@src64/subr.l")
nT (2198 . "@src64/subr.l")
name (502 . "@src64/sym.l")
nand (1659 . "@src64/flow.l")
-native (1488 . "@src64/main.l")
+native (1583 . "@src64/main.l")
need (919 . "@src64/subr.l")
new (839 . "@src64/flow.l")
-next (2461 . "@src64/main.l")
+next (2556 . "@src64/main.l")
nil (1742 . "@src64/flow.l")
nond (1942 . "@src64/flow.l")
nor (1680 . "@src64/flow.l")
@@ -239,7 +240,7 @@ onOff (1747 . "@src64/sym.l")
one (1780 . "@src64/sym.l")
open (4349 . "@src64/io.l")
opid (3231 . "@src64/flow.l")
-opt (3204 . "@src64/main.l")
+opt (3299 . "@src64/main.l")
or (1640 . "@src64/flow.l")
out (4225 . "@src64/io.l")
pack (1279 . "@src64/sym.l")
@@ -267,26 +268,26 @@ prog1 (1768 . "@src64/flow.l")
prog2 (1785 . "@src64/flow.l")
prop (2934 . "@src64/sym.l")
protect (509 . "@src64/main.l")
-prove (3530 . "@src64/subr.l")
+prove (3542 . "@src64/subr.l")
push (1822 . "@src64/sym.l")
push1 (1858 . "@src64/sym.l")
put (2844 . "@src64/sym.l")
putl (3122 . "@src64/sym.l")
-pwd (2842 . "@src64/main.l")
+pwd (2937 . "@src64/main.l")
queue (2054 . "@src64/sym.l")
-quit (1190 . "@src64/main.l")
+quit (1285 . "@src64/main.l")
quote (134 . "@src64/flow.l")
rand (3003 . "@src64/big.l")
range (997 . "@src64/subr.l")
-rank (3036 . "@src64/subr.l")
+rank (3048 . "@src64/subr.l")
raw (451 . "@src64/main.l")
rd (5174 . "@src64/io.l")
read (2670 . "@src64/io.l")
replace (1499 . "@src64/subr.l")
-rest (2507 . "@src64/main.l")
+rest (2602 . "@src64/main.l")
reverse (1678 . "@src64/subr.l")
rewind (5140 . "@src64/io.l")
-rollback (1898 . "@src64/db.l")
+rollback (1803 . "@src64/db.l")
rot (848 . "@src64/subr.l")
run (306 . "@src64/flow.l")
sect (2541 . "@src64/subr.l")
@@ -297,9 +298,9 @@ seq (1084 . "@src64/db.l")
set (1616 . "@src64/sym.l")
setq (1649 . "@src64/sym.l")
sigio (489 . "@src64/main.l")
-size (2809 . "@src64/subr.l")
+size (2808 . "@src64/subr.l")
skip (3515 . "@src64/io.l")
-sort (3965 . "@src64/subr.l")
+sort (3977 . "@src64/subr.l")
sp? (727 . "@src64/sym.l")
space (5074 . "@src64/io.l")
split (1592 . "@src64/subr.l")
@@ -309,7 +310,7 @@ stem (1989 . "@src64/subr.l")
str (4033 . "@src64/io.l")
str? (1145 . "@src64/sym.l")
strip (1576 . "@src64/subr.l")
-struct (1940 . "@src64/main.l")
+struct (2035 . "@src64/main.l")
sub? (1578 . "@src64/sym.l")
sum (1460 . "@src64/apply.l")
super (1225 . "@src64/flow.l")
@@ -325,23 +326,23 @@ text (1407 . "@src64/sym.l")
throw (2493 . "@src64/flow.l")
tick (3183 . "@src64/flow.l")
till (3624 . "@src64/io.l")
-time (2725 . "@src64/main.l")
+time (2820 . "@src64/main.l")
touch (1181 . "@src64/sym.l")
trail (698 . "@src64/main.l")
trim (1759 . "@src64/subr.l")
try (1177 . "@src64/flow.l")
type (920 . "@src64/flow.l")
udp (301 . "@src64/net.l")
-unify (3938 . "@src64/subr.l")
+unify (3950 . "@src64/subr.l")
unless (1901 . "@src64/flow.l")
until (2085 . "@src64/flow.l")
up (766 . "@src64/main.l")
upp? (3402 . "@src64/sym.l")
uppc (3469 . "@src64/sym.l")
use (1573 . "@src64/flow.l")
-usec (2830 . "@src64/main.l")
+usec (2925 . "@src64/main.l")
val (1597 . "@src64/sym.l")
-version (3218 . "@src64/main.l")
+version (3313 . "@src64/main.l")
wait (3164 . "@src64/io.l")
when (1884 . "@src64/flow.l")
while (2061 . "@src64/flow.l")
diff --git a/src/io.c b/src/io.c
@@ -1,4 +1,4 @@
-/* 22nov12abu
+/* 28dec12abu
* (c) Software Lab. Alexander Burger
*/
@@ -3226,32 +3226,6 @@ any doLock(any ex) {
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;
diff --git a/src/main.c b/src/main.c
@@ -1,4 +1,4 @@
-/* 15dec12abu
+/* 28dec12abu
* (c) Software Lab. Alexander Burger
*/
@@ -496,6 +496,32 @@ int compare(any x, any y) {
}
}
+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;
+ }
+}
+
/*** Error handling ***/
void err(any ex, any x, char *fmt, ...) {
va_list ap;
diff --git a/src/pico.h b/src/pico.h
@@ -1,4 +1,4 @@
-/* 07jun12abu
+/* 28dec12abu
* (c) Software Lab. Alexander Burger
*/
@@ -271,6 +271,7 @@ any bigCopy(any);
void bigSub(any,any);
void binPrint(int,any);
any binRead(int);
+int binSize(any);
adr blk64(any);
any boxChar(int,int*,any*);
any boxWord2(word2);
@@ -434,6 +435,7 @@ any doBoxQ(any);
any doBreak(any);
any doBy(any);
any doBye(any) __attribute__ ((noreturn));
+any doBytes(any);
any doCaaaar(any);
any doCaaadr(any);
any doCaaar(any);
diff --git a/src/subr.c b/src/subr.c
@@ -1,4 +1,4 @@
-/* 07jun12abu
+/* 28dec12abu
* (c) Software Lab. Alexander Burger
*/
@@ -1263,6 +1263,11 @@ any doSize(any ex) {
return isNum(x = name(x))? boxCnt(numBytes(x)) : Zero;
}
+// (bytes 'any) -> cnt
+any doBytes(any x) {
+ return boxCnt(binSize(EVAL(cadr(x))));
+}
+
// (assoc 'any 'lst) -> lst
any doAssoc(any x) {
any y;
diff --git a/src/tab.c b/src/tab.c
@@ -1,4 +1,4 @@
-/* 11oct11abu
+/* 28dec12abu
* (c) Software Lab. Alexander Burger
*/
@@ -37,6 +37,7 @@ static symInit Symbols[] = {
{doBreak, "!"},
{doBy, "by"},
{doBye, "bye"},
+ {doBytes, "bytes"},
{doCaaaar, "caaaar"},
{doCaaadr, "caaadr"},
{doCaaar, "caaar"},
diff --git a/src/vers.h b/src/vers.h
@@ -1 +1 @@
-static byte Version[4] = {3,1,1,2};
+static byte Version[4] = {3,1,1,3};
diff --git a/src64/db.l b/src64/db.l
@@ -1,4 +1,4 @@
-# 04nov12abu
+# 28dec12abu
# (c) Software Lab. Alexander Burger
# 6 bytes in little endian format
@@ -1221,101 +1221,6 @@
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
- cmp X ZERO # 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
- inc A # 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
- inc A # 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
- inc (S) # 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
- add S I # Drop list head
- end
- ret
-
(code 'dbFetchEX 0)
ld A (E TAIL) # Get tail
num A # Any properties?
diff --git a/src64/glob.l b/src64/glob.l
@@ -1,4 +1,4 @@
-# 13nov12abu
+# 28dec12abu
# (c) Software Lab. Alexander Burger
(data 'Data)
@@ -458,6 +458,7 @@
initFun NIL "prior" doPrior
initFun NIL "length" doLength
initFun NIL "size" doSize
+ initFun NIL "bytes" doBytes
initFun NIL "assoc" doAssoc
initFun NIL "asoq" doAsoq
initFun NIL "rank" doRank
diff --git a/src64/main.l b/src64/main.l
@@ -1,4 +1,4 @@
-# 11dec12abu
+# 28dec12abu
# (c) Software Lab. Alexander Burger
(code 'Code)
@@ -1169,6 +1169,101 @@
pop X
ret # F
+(code 'binSizeX_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
+ cmp X ZERO # 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
+ inc A # 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
+ inc A # 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 binSizeX_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
+ inc (S) # Increment count once more
+ break T
+ end
+ atom X # Atomic CDR?
+ if nz # Yes
+ call binSizeX_A # Get size
+ add (S) A # Add result to count
+ break T
+ end
+ loop
+ pop A # Get result
+ add S I # Drop list head
+ end
+ ret
+
(code 'memberXY_FY 0)
ld C Y # Keep head in C
do
diff --git a/src64/subr.l b/src64/subr.l
@@ -1,4 +1,4 @@
-# 07jun12abu
+# 28dec12abu
# (c) Software Lab. Alexander Burger
# (car 'var) -> any
@@ -2739,8 +2739,7 @@
# (length 'any) -> cnt | T
(code 'doLength 2)
- ld E (E CDR) # Get arg
- ld E (E)
+ ld E ((E CDR)) # Get arg
eval # Eval it
num E # Number?
if nz # Yes
@@ -2856,7 +2855,7 @@
push Z
call dbFetchEX
ld X (E) # Get value
- call dbSizeX_A # Calculate size
+ call binSizeX_A # Calculate size
add A (+ BLK 1) # plus block overhead
ld Z A # Count in Z
ld E (E TAIL) # Get properties
@@ -2868,16 +2867,16 @@
ld E (E CDR)
atom X # Flag?
if nz # Yes
- call dbSizeX_A # Flag's size
+ call binSizeX_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
+ call binSizeX_A # Calculate size
add Z A # Add to count
pop X # Retrieve value
- call dbSizeX_A # Calculate size
+ call binSizeX_A # Calculate size
add Z A # Add to count
end
loop
@@ -2969,6 +2968,19 @@
end
loop
+# (bytes 'any) -> cnt
+(code 'doBytes 2)
+ push X
+ ld E ((E CDR)) # Get arg
+ eval # Eval it
+ ld X E
+ call binSizeX_A # Calculate size
+ ld E A
+ shl E 4 # Make short number
+ or E CNT
+ pop X
+ ret
+
# (assoc 'any 'lst) -> lst
(code 'doAssoc 2)
push X
diff --git a/src64/tags b/src64/tags
@@ -270,145 +270,145 @@ sys/x86-64.linux.defs.l,1959
Adr179,6562
Fork180,6599
Bye181,6636
-SymTabEnd559,21157
-TgCPU562,21190
-TgOS563,21232
-Db1567,21323
-Extern569,21350
-GcSymEnd573,21421
-Version576,21450
-EnvCo587,21657
-Chr588,21690
-PutB589,21744
-Get_A590,21805
-InFile591,21865
-OutFile592,21911
-Env593,21958
-EnvBind594,21991
-EnvInFrames595,22064
-EnvOutFrames596,22117
-EnvErrFrames597,22170
-EnvCtlFrames598,22223
-EnvIntern599,22279
-EnvArgs600,22352
-EnvNext601,22401
-EnvCls602,22448
-EnvKey603,22496
-EnvApply604,22542
-EnvMake605,22590
-EnvYoke606,22636
-EnvParseX607,22659
-EnvParseC608,22708
-EnvParseEOF609,22731
-EnvMid610,22755
-EnvCo7611,22783
-EnvTask612,22829
-EnvProtect613,22874
-EnvTrace614,22927
-EnvEnd615,22974
-OrgTermio617,23003
-Flock618,23064
-Tms619,23119
-Addr620,23172
-TBuf622,23232
-CaseBlocks627,23369
-CaseData757,38752
-CaseUpper1094,78633
-CaseLower1118,80459
-Tio1143,82165
-Repl1145,82214
-PRepl1146,82259
-Jam1147,82306
-InBye1148,82351
-Sync1149,82398
-Month1150,82460
-_r_1153,82526
-_w_1154,82543
-_a_1155,82560
-_ap_1156,82577
-_dot_1157,82596
-Giveup1161,82649
-ExecErr1162,82675
-AllocErr1163,82711
-PidSigMsg1164,82740
-QuitMsg1165,82773
-CbErr1166,82794
-HashBlank1168,82838
-Redefined1169,82861
-SuperErr1170,82895
-ExtraErr1171,82924
-ThrowErr1172,82953
-Trc11173,82986
-Trc21174,83004
-SetFD1176,83030
-Delim1177,83055
-DelimEnd1178,83096
-Arrow1179,83107
-RolbLog1181,83134
-IgnLog1182,83195
-CircFree1183,83249
-BadChain1184,83287
-BadCount1185,83316
-ErrTok1187,83353
-Dashes1188,83374
-ProtErr1189,83396
-SymNsErr1190,83431
-StkErr1191,83471
-ArgErr1192,83503
-NumErr1193,83533
-CntErr1194,83566
-SymErr1195,83605
-ExtErr1196,83638
-PairErr1197,83680
-AtomErr1198,83717
-LstErr1199,83749
-VarErr1200,83780
-DivErr1201,83815
-RenErr1202,83838
-MakeErr1203,83868
-ReentErr1204,83897
-YieldErr1205,83936
-MsgErr1206,83968
-BrkErr1207,83997
-OpenErr1208,84023
-CloseErr1209,84056
-PipeErr1210,84091
-ForkErr1211,84124
-WaitPidErr1212,84153
-BadFdErr1213,84183
-NoFdErr1214,84209
-EofErr1215,84241
-SuparErr1216,84270
-BadInput1217,84316
-BadDot1218,84350
-SelectErr1219,84383
-WrBytesErr1220,84420
-WrChildErr1221,84457
-WrSyncErr1222,84494
-WrJnlErr1223,84529
-WrLogErr1224,84566
-TruncErr1225,84599
-DbSyncErr1226,84641
-TrSyncErr1227,84680
-LockErr1228,84728
-DbfErr1229,84760
-JnlErr1230,84789
-IdErr1231,84818
-DbRdErr1232,84841
-DbWrErr1233,84871
-DbSizErr1234,84902
-TellErr1235,84933
-IpSocketErr1236,84965
-IpGetsocknameErr1237,85007
-IpV6onlyErr1238,85059
-IpReuseaddrErr1239,85106
-IpBindErr1240,85157
-IpListenErr1241,85195
-UdpOvflErr1242,85237
-UndefErr1243,85271
-DlErr1244,85300
+SymTabEnd560,21198
+TgCPU563,21231
+TgOS564,21273
+Db1568,21364
+Extern570,21391
+GcSymEnd574,21462
+Version577,21491
+EnvCo588,21698
+Chr589,21731
+PutB590,21785
+Get_A591,21846
+InFile592,21906
+OutFile593,21952
+Env594,21999
+EnvBind595,22032
+EnvInFrames596,22105
+EnvOutFrames597,22158
+EnvErrFrames598,22211
+EnvCtlFrames599,22264
+EnvIntern600,22320
+EnvArgs601,22393
+EnvNext602,22442
+EnvCls603,22489
+EnvKey604,22537
+EnvApply605,22583
+EnvMake606,22631
+EnvYoke607,22677
+EnvParseX608,22700
+EnvParseC609,22749
+EnvParseEOF610,22772
+EnvMid611,22796
+EnvCo7612,22824
+EnvTask613,22870
+EnvProtect614,22915
+EnvTrace615,22968
+EnvEnd616,23015
+OrgTermio618,23044
+Flock619,23105
+Tms620,23160
+Addr621,23213
+TBuf623,23273
+CaseBlocks628,23410
+CaseData758,38793
+CaseUpper1095,78674
+CaseLower1119,80500
+Tio1144,82206
+Repl1146,82255
+PRepl1147,82300
+Jam1148,82347
+InBye1149,82392
+Sync1150,82439
+Month1151,82501
+_r_1154,82567
+_w_1155,82584
+_a_1156,82601
+_ap_1157,82618
+_dot_1158,82637
+Giveup1162,82690
+ExecErr1163,82716
+AllocErr1164,82752
+PidSigMsg1165,82781
+QuitMsg1166,82814
+CbErr1167,82835
+HashBlank1169,82879
+Redefined1170,82902
+SuperErr1171,82936
+ExtraErr1172,82965
+ThrowErr1173,82994
+Trc11174,83027
+Trc21175,83045
+SetFD1177,83071
+Delim1178,83096
+DelimEnd1179,83137
+Arrow1180,83148
+RolbLog1182,83175
+IgnLog1183,83236
+CircFree1184,83290
+BadChain1185,83328
+BadCount1186,83357
+ErrTok1188,83394
+Dashes1189,83415
+ProtErr1190,83437
+SymNsErr1191,83472
+StkErr1192,83512
+ArgErr1193,83544
+NumErr1194,83574
+CntErr1195,83607
+SymErr1196,83646
+ExtErr1197,83679
+PairErr1198,83721
+AtomErr1199,83758
+LstErr1200,83790
+VarErr1201,83821
+DivErr1202,83856
+RenErr1203,83879
+MakeErr1204,83909
+ReentErr1205,83938
+YieldErr1206,83977
+MsgErr1207,84009
+BrkErr1208,84038
+OpenErr1209,84064
+CloseErr1210,84097
+PipeErr1211,84132
+ForkErr1212,84165
+WaitPidErr1213,84194
+BadFdErr1214,84224
+NoFdErr1215,84250
+EofErr1216,84282
+SuparErr1217,84311
+BadInput1218,84357
+BadDot1219,84391
+SelectErr1220,84424
+WrBytesErr1221,84461
+WrChildErr1222,84498
+WrSyncErr1223,84535
+WrJnlErr1224,84570
+WrLogErr1225,84607
+TruncErr1226,84640
+DbSyncErr1227,84682
+TrSyncErr1228,84721
+LockErr1229,84769
+DbfErr1230,84801
+JnlErr1231,84830
+IdErr1232,84859
+DbRdErr1233,84882
+DbWrErr1234,84912
+DbSizErr1235,84943
+TellErr1236,84974
+IpSocketErr1237,85006
+IpGetsocknameErr1238,85048
+IpV6onlyErr1239,85100
+IpReuseaddrErr1240,85147
+IpBindErr1241,85198
+IpListenErr1242,85236
+UdpOvflErr1243,85278
+UndefErr1244,85312
+DlErr1245,85341
-./main.l,2221
+./main.l,2244
Code4,51
Ret8,106
Retc10,127
@@ -451,81 +451,82 @@ sys/x86-64.linux.defs.l,1959
circE_YF845,21008
equalAE_F877,21748
compareAE_F1010,24957
-memberXY_FY1172,28433
-doQuit1190,28784
-evExprCE_E1208,29201
-evListE_E1356,32835
-sharedLibC_FA1409,33971
-doErrno1480,35615
-doNative1488,35779
-natBufACZ_CZ1692,41581
-natRetACE_CE1791,44066
-doStruct1940,49466
-fetchCharC_AC1983,50346
-cbl2018,51215
-cbl12051,51931
-cbl22055,52047
-cbl32059,52093
-cbl42063,52145
-cbl52067,52197
-cbl62071,52249
-cbl72075,52301
-cbl82079,52353
-cbl92083,52405
-cbl102087,52457
-cbl112091,52510
-cbl122095,52564
-cbl132099,52618
-cbl142103,52672
-cbl152107,52726
-cbl162111,52780
-cbl172115,52834
-cbl182119,52888
-cbl192123,52942
-cbl202127,52996
-cbl212131,53050
-cbl222135,53104
-cbl232139,53158
-cbl242143,53212
-doLisp2149,53295
-lisp2193,54321
-execE2239,55435
-runE_E2251,55590
-funqE_FE2263,55742
-evSymX_E2325,57165
-evSymY_E2328,57223
-evSymE_E2330,57265
-xSymE_E2332,57302
-evCntXY_FE2353,57667
-evCntEX_FE2355,57711
-xCntEX_FE2357,57750
-xCntCX_FC2366,57927
-xCntAX_FA2375,58104
-boxE_E2384,58281
-putStringB2404,58738
-begString2416,58952
-endString_E2427,59178
-msec_A2441,59501
-doArgs2454,59775
-doNext2461,59889
-doArg2478,60205
-doRest2507,60847
-tmDateC_E2521,61094
-dateXYZ_E2531,61271
-doDate2592,62632
-tmTimeY_E2708,66227
-doTime2725,66560
-doUsec2830,69539
-doPwd2842,69805
-doCd2853,70060
-doCtty2878,70676
-doInfo2915,71610
-doFile2960,72705
-doDir3013,73941
-doCmd3083,75559
-doArgv3101,76018
-doOpt3204,78564
-doVersion3218,78895
+binSizeX_A1172,28433
+memberXY_FY1267,31043
+doQuit1285,31394
+evExprCE_E1303,31811
+evListE_E1451,35445
+sharedLibC_FA1504,36581
+doErrno1575,38225
+doNative1583,38389
+natBufACZ_CZ1787,44191
+natRetACE_CE1886,46676
+doStruct2035,52076
+fetchCharC_AC2078,52956
+cbl2113,53825
+cbl12146,54541
+cbl22150,54657
+cbl32154,54703
+cbl42158,54755
+cbl52162,54807
+cbl62166,54859
+cbl72170,54911
+cbl82174,54963
+cbl92178,55015
+cbl102182,55067
+cbl112186,55120
+cbl122190,55174
+cbl132194,55228
+cbl142198,55282
+cbl152202,55336
+cbl162206,55390
+cbl172210,55444
+cbl182214,55498
+cbl192218,55552
+cbl202222,55606
+cbl212226,55660
+cbl222230,55714
+cbl232234,55768
+cbl242238,55822
+doLisp2244,55905
+lisp2288,56931
+execE2334,58045
+runE_E2346,58200
+funqE_FE2358,58352
+evSymX_E2420,59775
+evSymY_E2423,59833
+evSymE_E2425,59875
+xSymE_E2427,59912
+evCntXY_FE2448,60277
+evCntEX_FE2450,60321
+xCntEX_FE2452,60360
+xCntCX_FC2461,60537
+xCntAX_FA2470,60714
+boxE_E2479,60891
+putStringB2499,61348
+begString2511,61562
+endString_E2522,61788
+msec_A2536,62111
+doArgs2549,62385
+doNext2556,62499
+doArg2573,62815
+doRest2602,63457
+tmDateC_E2616,63704
+dateXYZ_E2626,63881
+doDate2687,65242
+tmTimeY_E2803,68837
+doTime2820,69170
+doUsec2925,72149
+doPwd2937,72415
+doCd2948,72670
+doCtty2973,73286
+doInfo3010,74220
+doFile3055,75315
+doDir3108,76551
+doCmd3178,78169
+doArgv3196,78628
+doOpt3299,81174
+doVersion3313,81505
./big.l,1059
zapZeroA_A6,106
@@ -933,7 +934,7 @@ sys/x86-64.linux.defs.l,1959
doFold3521,81780
isLetterOrDigitA_F3593,83885
-./db.l,1175
+./db.l,1153
getAdrZ_A6,117
setAdrAZ22,350
setAdrAS36,545
@@ -981,16 +982,15 @@ sys/x86-64.linux.defs.l,1959
doSeq1084,29745
doLieu1157,31621
doLock1185,32219
-dbSizeX_A1224,33169
-dbFetchEX1319,35776
-dbAEX1331,36003
-dbTouchEX1445,39310
-dbZapE1477,39898
-doCommit1498,40333
-doRollback1898,53178
-doMark1973,55028
-doFree2055,57074
-doDbck2113,58540
+dbFetchEX1224,33169
+dbAEX1236,33396
+dbTouchEX1350,36703
+dbZapE1382,37291
+doCommit1403,37726
+doRollback1803,50571
+doMark1878,52421
+doFree1960,54467
+doDbck2018,55933
./gc.l,841
markE5,63
@@ -1125,7 +1125,7 @@ sys/x86-64.linux.defs.l,1959
byeE3456,83467
finishE3468,83778
-./subr.l,2127
+./subr.l,2147
doCar5,71
doCdr17,247
doCaar31,439
@@ -1219,25 +1219,26 @@ sys/x86-64.linux.defs.l,1959
doOffset2677,52325
doPrior2713,52968
doLength2741,53443
-doSize2809,54958
-sizeCE_C2929,58817
-doAssoc2973,59825
-doAsoq3008,60483
-doRank3036,61001
-doMatch3128,63290
-matchCE_F3147,63616
-doFill3243,66451
-fillE_FE3261,66745
-unifyCEYZ_F3364,69014
-doProve3530,73378
-lupCE_E3815,81848
-lookupCE_E3872,83239
-uniFillE_E3886,83492
-doArrow3916,84125
-doUnify3938,84535
-doSort3965,85023
-cmpDfltA_F4120,90204
-cmpUserAX_F4125,90355
+doSize2808,54948
+sizeCE_C2928,58811
+doBytes2972,59814
+doAssoc2985,60035
+doAsoq3020,60693
+doRank3048,61211
+doMatch3140,63500
+matchCE_F3159,63826
+doFill3255,66661
+fillE_FE3273,66955
+unifyCEYZ_F3376,69224
+doProve3542,73588
+lupCE_E3827,82058
+lookupCE_E3884,83449
+uniFillE_E3898,83702
+doArrow3928,84335
+doUnify3950,84745
+doSort3977,85233
+cmpDfltA_F4132,90414
+cmpUserAX_F4137,90565
./net.l,191
doPort5,96
diff --git a/src64/version.l b/src64/version.l
@@ -1,6 +1,6 @@
-# 08dec12abu
+# 28dec12abu
# (c) Software Lab. Alexander Burger
-(de *Version 3 1 1 2)
+(de *Version 3 1 1 3)
# vi:et:ts=3:sw=3
diff --git a/test/src/subr.l b/test/src/subr.l
@@ -1,4 +1,4 @@
-# 25jan11abu
+# 28dec12abu
# (c) Software Lab. Alexander Burger
### c[ad]*r ###
@@ -412,6 +412,18 @@
(test 3 (size (1 . (2 3 .))))
+### bytes ###
+(test 4 (bytes "abc"))
+(test 5 (bytes "äbc"))
+(test 2 (bytes 127))
+(test 3 (bytes 128))
+(test 10 (bytes (101 (102) 103)))
+(test 9 (bytes (101 102 103 .)))
+(let (L (7 "abc" (1 2 3) 'a) F (tmp "bytes"))
+ (out F (pr L))
+ (test (bytes L) (car (info F))) )
+
+
### assoc ###
(test '("b" . 7)
(assoc "b" '((999 1 2 3) ("b" . 7) ("ok" "Hello"))) )
