picolisp

commit 691f818fea79d93e15a328bba33920262d98830b
parent dddc96759541ef9b4d2e19641c77fffdbc0d4355
Author: Alexander Burger <abu@software-lab.de>
Date:   Mon,  4 Jul 2011 13:29:16 +0200

Bad tag setting for db extensions
Diffstat:
M
CHANGES
 | 
1
+
M
lib/tags
 | 
10
+++++-----
M
src64/db.l
 | 
13
+++++++------

3 files changed, 13 insertions(+), 11 deletions(-)
diff --git a/CHANGES b/CHANGES
@@ -1,4 +1,5 @@
 * XXsep11 picoLisp-3.0.8
+   Bug in 'dbFetchEX' for db extensions
 
 * 30jun11 picoLisp-3.0.7
    Numbers and strings in 'native' structure arguments
diff --git a/lib/tags b/lib/tags
@@ -91,7 +91,7 @@ close (4338 . "@src64/io.l")
 cmd (2913 . "@src64/main.l")
 cnt (1413 . "@src64/apply.l")
 co (2540 . "@src64/flow.l")
-commit (1494 . "@src64/db.l")
+commit (1495 . "@src64/db.l")
 con (725 . "@src64/subr.l")
 conc (781 . "@src64/subr.l")
 cond (1911 . "@src64/flow.l")
@@ -102,7 +102,7 @@ ctl (4216 . "@src64/io.l")
 ctty (2711 . "@src64/main.l")
 cut (1795 . "@src64/sym.l")
 date (2425 . "@src64/main.l")
-dbck (2103 . "@src64/db.l")
+dbck (2104 . "@src64/db.l")
 de (529 . "@src64/flow.l")
 dec (2323 . "@src64/big.l")
 def (453 . "@src64/flow.l")
@@ -142,7 +142,7 @@ fold (3341 . "@src64/sym.l")
 for (2222 . "@src64/flow.l")
 fork (3256 . "@src64/flow.l")
 format (2089 . "@src64/big.l")
-free (2045 . "@src64/db.l")
+free (2046 . "@src64/db.l")
 from (3511 . "@src64/io.l")
 full (1075 . "@src64/subr.l")
 fun? (732 . "@src64/sym.l")
@@ -203,7 +203,7 @@ mapcar (987 . "@src64/apply.l")
 mapcon (1041 . "@src64/apply.l")
 maplist (933 . "@src64/apply.l")
 maps (790 . "@src64/apply.l")
-mark (1963 . "@src64/db.l")
+mark (1964 . "@src64/db.l")
 match (3125 . "@src64/subr.l")
 max (2327 . "@src64/subr.l")
 maxi (1511 . "@src64/apply.l")
@@ -285,7 +285,7 @@ replace (1499 . "@src64/subr.l")
 rest (2340 . "@src64/main.l")
 reverse (1678 . "@src64/subr.l")
 rewind (5078 . "@src64/io.l")
-rollback (1888 . "@src64/db.l")
+rollback (1889 . "@src64/db.l")
 rot (848 . "@src64/subr.l")
 run (311 . "@src64/flow.l")
 sect (2541 . "@src64/subr.l")
diff --git a/src64/db.l b/src64/db.l
@@ -1,4 +1,4 @@
-# 21apr11abu
+# 04jul11abu
 # (c) Software Lab. Alexander Burger
 
 # 6 bytes in little endian format
@@ -560,7 +560,7 @@
       pop Z
       pop E
    else
-      atom (Ext)  # Remote databases?
+      atom (Ext)  # Extended databases?
    end
    ret  # 'z' if OK
 
@@ -1388,7 +1388,7 @@
       call rwUnlockDbA  # Unlock
    else
       shr A 6  # Revert to file number
-      ld Z (Ext)  # Remote databases?
+      ld Z (Ext)  # Extended databases?
       atom Z
       jnz dbfErrX  # No
       ld C ((Z))  # First offset
@@ -1403,7 +1403,7 @@
          shr C 4  # Normalize
          cmp A C  # Matching entry?
       while ge  # No
-         ld Z E  # Try next remote DB
+         ld Z E  # Try next DB extension
       loop
       push Y  # Save name
       push ((Z) CDR)  # fun ((Obj) ..)
@@ -1418,8 +1418,9 @@
       ld E (E CDR)  # Properties?
       atom E
       if z  # Yes
-         or E SYM  # Set 'extern' tag
-         ld (Z TAIL) E  # Set property list
+         ld A E  # Set 'extern' tag
+         or A SYM
+         ld (Z TAIL) A  # Set property list
          do
             atom (E CDR)  # Find end
          while z