diff -Nru picolisp-17.12/app/er.l picolisp-17.12+20180218/app/er.l --- picolisp-17.12/app/er.l 2014-10-14 06:09:09.000000000 +0000 +++ picolisp-17.12+20180218/app/er.l 2018-01-05 17:35:08.000000000 +0000 @@ -1,4 +1,4 @@ -# 14oct14abu +# 05jan18abu # (c) Software Lab. Alexander Burger ### Entity/Relations ### @@ -92,9 +92,9 @@ (rel cus (+Ref +Link) NIL (+CuSu)) # Customer (rel pos (+List +Joint) ord (+Pos)) # Positions -(dm lose> () +(dm lose> (Lst) (mapc 'lose> (: pos)) - (super) ) + (super Lst) ) (dm url> (Tab) (and (may Order) (list "app/ord.l" '*ID This)) ) diff -Nru picolisp-17.12/app/init.l picolisp-17.12+20180218/app/init.l --- picolisp-17.12/app/init.l 2013-01-21 18:05:32.000000000 +0000 +++ picolisp-17.12+20180218/app/init.l 2018-01-18 07:19:08.000000000 +0000 @@ -1,6 +1,8 @@ -# 21jan13abu +# 18jan18abu # (c) Software Lab. Alexander Burger +`(not (seq *DB)) + ### Role ### (obj ((+Role) nm "Administration") perm `*Perms) (obj ((+Role) nm "Accounting") perm (Customer Item Order Report Delete)) diff -Nru picolisp-17.12/app/main.l picolisp-17.12+20180218/app/main.l --- picolisp-17.12/app/main.l 2017-03-02 18:14:13.000000000 +0000 +++ picolisp-17.12+20180218/app/main.l 2018-01-18 07:32:52.000000000 +0000 @@ -1,4 +1,4 @@ -# 02mar17abu +# 18jan18abu # (c) Software Lab. Alexander Burger (allowed ("app/") @@ -46,8 +46,7 @@ (de main () (call "mkdir" "-p" "db/app/" *Blob) (pool *Pool *Dbs) - (unless (seq *DB) - (load "app/init.l") ) ) + (load "app/init.l") ) (de go (Rpc) (when Rpc diff -Nru picolisp-17.12/bin/psh picolisp-17.12+20180218/bin/psh --- picolisp-17.12/bin/psh 2016-03-11 16:20:29.000000000 +0000 +++ picolisp-17.12+20180218/bin/psh 2018-02-01 13:43:15.000000000 +0000 @@ -1,5 +1,5 @@ #!bin/picolisp lib.l -# 11mar16abu +# 01feb18abu # (c) Software Lab. Alexander Burger (load "@lib/misc.l" "@lib/http.l") @@ -10,7 +10,7 @@ (or (format Arg) (client "localhost" 80 (pack Arg "/!psh") (read)) ) - (pack "!psh?" (pw) "&" (in '("tty") (line T))) + (pack (opt) "!psh?" (pw) "&" (in '("tty") (line T))) (ctty (read)) (line) (line) ) ) diff -Nru picolisp-17.12/CHANGES picolisp-17.12+20180218/CHANGES --- picolisp-17.12/CHANGES 2017-12-26 10:12:14.000000000 +0000 +++ picolisp-17.12+20180218/CHANGES 2018-02-13 07:21:00.000000000 +0000 @@ -1,3 +1,6 @@ +* XXjun18 picoLisp-18.6 + 'blk' function (64-bit) + * 26dec17 picoLisp-17.12 'byte' function Linux/arm64 port diff -Nru picolisp-17.12/debian/changelog picolisp-17.12+20180218/debian/changelog --- picolisp-17.12/debian/changelog 2018-02-05 16:51:49.000000000 +0000 +++ picolisp-17.12+20180218/debian/changelog 2018-02-18 00:19:35.000000000 +0000 @@ -1,8 +1,10 @@ -picolisp (17.12-2build1) bionic; urgency=high +picolisp (17.12+20180218-1) unstable; urgency=medium - * No change rebuild against openssl1.1. + * New upstream version 17.12+20180218 + - Fixed relocation error in ext.l and ht.l. (Closes: 889911) + * Refresh patches - -- Dimitri John Ledkov Mon, 05 Feb 2018 16:51:49 +0000 + -- Kan-Ru Chen (陳侃如) Sun, 18 Feb 2018 09:19:35 +0900 picolisp (17.12-2) unstable; urgency=medium diff -Nru picolisp-17.12/debian/control picolisp-17.12+20180218/debian/control --- picolisp-17.12/debian/control 2018-02-05 16:51:49.000000000 +0000 +++ picolisp-17.12+20180218/debian/control 2018-02-18 00:13:41.000000000 +0000 @@ -1,8 +1,7 @@ Source: picolisp Section: lisp Priority: optional -Maintainer: Ubuntu Developers -XSBC-Original-Maintainer: Kan-Ru Chen (陳侃如) +Maintainer: Kan-Ru Chen (陳侃如) Build-Depends: debhelper (>= 11), dpkg-dev (>= 1.18.11~), libssl-dev, default-jdk Standards-Version: 4.1.3 Homepage: http://picolisp.com/ diff -Nru picolisp-17.12/debian/patches/0002-picolisp_fix_shbang_path.patch picolisp-17.12+20180218/debian/patches/0002-picolisp_fix_shbang_path.patch --- picolisp-17.12/debian/patches/0002-picolisp_fix_shbang_path.patch 2018-01-17 00:34:18.000000000 +0000 +++ picolisp-17.12+20180218/debian/patches/0002-picolisp_fix_shbang_path.patch 2018-02-18 00:16:02.000000000 +0000 @@ -13,13 +13,13 @@ 7 files changed, 7 insertions(+), 7 deletions(-) diff --git a/bin/psh b/bin/psh -index dc30c48..b397b32 100755 +index 4b63d95..a254118 100755 --- a/bin/psh +++ b/bin/psh @@ -1,4 +1,4 @@ -#!bin/picolisp lib.l +#!/usr/bin/picolisp /usr/lib/picolisp/lib.l - # 11mar16abu + # 01feb18abu # (c) Software Lab. Alexander Burger diff --git a/bin/replica b/bin/replica diff -Nru picolisp-17.12/debian/patches/0007-Fix-bash_completion.patch picolisp-17.12+20180218/debian/patches/0007-Fix-bash_completion.patch --- picolisp-17.12/debian/patches/0007-Fix-bash_completion.patch 2018-01-17 00:34:18.000000000 +0000 +++ picolisp-17.12+20180218/debian/patches/0007-Fix-bash_completion.patch 1970-01-01 00:00:00.000000000 +0000 @@ -1,20 +0,0 @@ -From: Kan-Ru Chen -Date: Wed, 17 Jan 2018 09:34:11 +0900 -Subject: Fix bash_completion - ---- - lib/bash_completion | 1 - - 1 file changed, 1 deletion(-) - -diff --git a/lib/bash_completion b/lib/bash_completion -index a0b6214..4d4d97b 100644 ---- a/lib/bash_completion -+++ b/lib/bash_completion -@@ -1,7 +1,6 @@ - # Bash completion for picolisp + pil - # Alexander Burger - --have pil && - _pil() - { - local -a ARGS diff -Nru picolisp-17.12/debian/patches/series picolisp-17.12+20180218/debian/patches/series --- picolisp-17.12/debian/patches/series 2018-01-17 00:34:18.000000000 +0000 +++ picolisp-17.12+20180218/debian/patches/series 2018-02-18 00:16:03.000000000 +0000 @@ -4,4 +4,3 @@ 0004-picolisp_hurd.patch 0005-picolisp_fix_java_bytecode_version.patch 0006-dont_use_system_picolisp_to_bootstrap.patch -0007-Fix-bash_completion.patch diff -Nru picolisp-17.12/doc/ChangeLog picolisp-17.12+20180218/doc/ChangeLog --- picolisp-17.12/doc/ChangeLog 2017-11-29 09:28:17.000000000 +0000 +++ picolisp-17.12+20180218/doc/ChangeLog 2018-02-17 15:08:12.000000000 +0000 @@ -1,3 +1,155 @@ +17feb18 + Relocation errors for 'adrp' in Debian Sid + src64/arch/arm64.l + src64/ht.l + +16feb18 + Print results in 'repl' inside 'catch' body + lib/form.l + +15feb18 + Return 'T' from 'mark' for non-local symbols (instead of error) + src64/db.l + +14feb18 + Optional 'fd2' for locking + No need to set 'DbBlock' + Minor comment fix + src64/db.l + +13feb18 + 'blk' function (64-bit) + src64/glob.l + src64/db.l + doc/ref.html + doc/refB.html + doc/refE.html + +12feb18 + Remove obsolete 'dbfMigrate' function(s) + lib/too.l + +10feb18 + Large font for 'tiny' components + lib/phone.css + +09feb18 + Large font for 'input' fields + lib/phone.css + +07feb18 + Omit 'stepBtn' in 'panel' if 'Cls' is NIL + lib/form.l + +06feb18 + Change "stop" catch tag to 'stop' + lib/form.l + +03feb18 + Pedantics + lib/vip.l + +02feb18 + Remove '*SesAdr' global + lib/http.l + +01feb18 + Optional Session ID for 'psh' + lib/http.l + bin/psh + +29jan18 + 'reload' after "key" + lib/vip.l + +24jan18 + Add note about the meanings of the 'id' numbers + doc/refI.html + +23jan18 + Cosmetics + doc/select.html + +21jan18 + Notifications and Alarm continued + lib/android.l + +20jan18 + Remove 'cancel', change syntax of 'notify' and 'alarm' + lib/android.l + +18jan18 + Initial 'seq' check moved to "init.l" + app/main.l + app/init.l + +17jan18 + bash-completion uses dynamic loader + lib/bash_completion + +15jan18 + 'android~alarm' also at specific date and time + lib/android.l + Minor typo + doc/refB.html + +13jan18 + "~" no delimiter + 'reload' after "kab" + lib/vip.l + +12jan18 + Remove "time" from 'proc', and enable for Android + lib/debug.l + ersatz/lib.l + Missing delimiter characters "`~{}" + lib/vip.l + +11jan18 + Destructive side-effect in 'insMode' + lib/vip.l + +10jan18 + Added coroutine producer function + misc/fibo.l + +09jan18 + Bug in token parser + {src64,pilos/src}/io.l + ersatz/sys.src + Let 'co' and 'yield' preserve '@' + {src64,pilos/src}/flow.l + doc64/structures + Cosmetic 'prog1' -> 'swap' + misc/fibo.l + +08jan18 + 'byte' is 64-bit-only + doc/refB.html + test/src/main.l + +05jan18 + Pedantics + lib/db.l + app/er.l + Added 'yoke' link to 'made' + doc/refM.html + +02jan18 + Clean up *Java, *Lisp etc. in '*Fork' + 'android~cancel' function + lib/android.l + +01jan18 + Separate 'java1' function + lib/android.l + +30dec17 + (java "cls") returns the class + 'android~alarm' function + lib/android.l + +####### 17.12 ####### 29nov17 Handle '\' at EOL in strings lib/vip.l diff -Nru picolisp-17.12/doc/refB.html picolisp-17.12+20180218/doc/refB.html --- picolisp-17.12/doc/refB.html 2017-11-09 13:30:55.000000000 +0000 +++ picolisp-17.12+20180218/doc/refB.html 2018-02-14 16:12:41.000000000 +0000 @@ -233,6 +233,29 @@ -> NIL +
(blk 'fd 'cnt 'siz ['fd2]) -> lst +
Reads raw object data from the cnt'th block in the file opened +on descriptor fd. Returns a cons pair of the value and property +list of that database object. siz is the block size scale factor. +If fd2 is given, a read (shared) lock is set on that file during +the read operation. See also pool, +id, ctl and qsym. + +

+: (show '{4})
+{4} (+Role)
+   usr ({15} {13} {11})
+   perm (Customer Item Order Report Delete)
+   nm "Accounting"
+-> {4}
+: (open "db/app/@")
+-> 15
+: (blk 15 4 3 15)
+-> ((+Role) (({15} {13} {11}) . usr) ((Customer Item Order Report Delete) . perm) ("Accounting" . nm))
+
+
(blob 'obj 'sym) -> sym
Returns the blob file name for var in obj. See also *Blob, Applies fun1 to each element of lst. When additional lst arguments are given, their elements are also passed to fun1. Each result of fun1 is CONSed with its -corresponding argument form the original lst, and collected into a +corresponding argument from the original lst, and collected into a list which is passed to fun2. For the list returned from fun2, the CAR elements returned by fun1 are (destructively) removed from each element ("decorate-apply-undecorate" idiom). @@ -399,10 +422,10 @@
(byte 'num ['cnt]) -> cnt -
Returns - if the second argument is not given - a byte value (0 .. 255) from -the memory location pointed to by num. Otherwise cnt -is stored in the memory location and returned. See also adr. +
(64-bit version only) Returns - if the second argument is not given - a byte +value (0 .. 255) from the memory location pointed to by num. +Otherwise cnt is stored in the memory location and returned. See +also adr.

 : (hex (byte (>> -4 (adr (1)))))
diff -Nru picolisp-17.12/doc/refE.html picolisp-17.12+20180218/doc/refE.html
--- picolisp-17.12/doc/refE.html	2017-07-30 12:29:55.000000000 +0000
+++ picolisp-17.12+20180218/doc/refE.html	2018-02-13 10:20:12.000000000 +0000
@@ -455,12 +455,13 @@
 
(ext 'cnt . prg) -> any
During the execution of prg, all external symbols processed by rd, pr or -udp are modified by an offset -cnt suitable for mapping via the *Ext mechanism. All external symbol's file -numbers are decremented by cnt during output, and incremented by -cnt during input. +href="refR.html#rd">rd, pr, +blk or udp are modified by an offset cnt +suitable for mapping via the *Ext +mechanism. All external symbol's file numbers are decremented by +cnt during output, and incremented by cnt during +input.

 : (out 'a (ext 5 (pr '({6-2} ({8-9} . a) ({7-7} . b)))))
diff -Nru picolisp-17.12/doc/ref.html picolisp-17.12+20180218/doc/ref.html
--- picolisp-17.12/doc/ref.html	2017-11-13 16:10:53.000000000 +0000
+++ picolisp-17.12+20180218/doc/ref.html	2018-02-14 16:16:30.000000000 +0000
@@ -1949,6 +1949,7 @@
 
  • typ - Type: A list of cls symbols
  • pat - Pattern: A symbol whose name starts with an at-mark "@"
  • pid - Process ID: A number, the ID of a Unix process +
  • fd - File descriptor: The number of an open file
  • tree - Database index tree specification
  • hook - Database hook object @@ -2484,6 +2485,7 @@ pool journal id + blk seq lieu lock diff -Nru picolisp-17.12/doc/refI.html picolisp-17.12+20180218/doc/refI.html --- picolisp-17.12/doc/refI.html 2017-03-08 12:03:10.000000000 +0000 +++ picolisp-17.12+20180218/doc/refI.html 2018-01-24 10:13:07.000000000 +0000 @@ -53,8 +53,8 @@
    (id 'num ['num]) -> sym
    (id 'sym [NIL]) -> num
    (id 'sym T) -> (num . num) -
    Converts one or two numbers to an external symbol, or an external symbol to -a number or a pair of numbers. +
    Converts one (the internal block number) or two (file and block) numbers to +an external symbol, or an external symbol to a number or a pair of numbers.
    
     : (id 7)
    diff -Nru picolisp-17.12/doc/refM.html picolisp-17.12+20180218/doc/refM.html
    --- picolisp-17.12/doc/refM.html	2017-11-17 13:41:29.000000000 +0000
    +++ picolisp-17.12+20180218/doc/refM.html	2018-01-05 11:11:15.000000000 +0000
    @@ -70,8 +70,9 @@
     
    (made ['lst1 ['lst2]]) -> lst
    Initializes a new list value for the current make environment. All list elements already -produced with chain and link are discarded, and lst1 is +produced with chain, link and yoke are discarded, and lst1 is used instead. Optionally, lst2 can be specified as the new linkage cell, otherwise the last cell of lst1 is used. When called without arguments, made does not modify the environment. In any case, the diff -Nru picolisp-17.12/doc/select.html picolisp-17.12+20180218/doc/select.html --- picolisp-17.12/doc/select.html 2015-03-27 13:29:22.000000000 +0000 +++ picolisp-17.12+20180218/doc/select.html 2018-01-23 09:09:25.000000000 +0000 @@ -331,10 +331,7 @@
    
     (select (@Item)
    -   (
    -      (nr +Item @Nr)
    -      (nm +CuSu @Sup (sup +Item))
    -   )
    +   ((nr +Item @Nr) (nm +CuSu @Sup (sup +Item)))
        ...
     
    @@ -342,10 +339,8 @@
    
     (select (@Item)
    -   (
    -      (@A (@Nr) ((db nr +Item @Nr @A)))
    -      (@B (@Sup) ((db nm +CuSu @Sup @B)) (sup +Item))
    -   )
    +   ((@A (@Nr) ((db nr +Item @Nr @A)))
    +      (@B (@Sup) ((db nm +CuSu @Sup @B)) (sup +Item)) )
     

    That is, a query with the db/3 tree diff -Nru picolisp-17.12/doc64/structures picolisp-17.12+20180218/doc64/structures --- picolisp-17.12/doc64/structures 2014-12-19 12:32:14.000000000 +0000 +++ picolisp-17.12+20180218/doc64/structures 2018-01-09 14:30:38.000000000 +0000 @@ -1,4 +1,4 @@ -# 19dec14abu +# 09jan18abu # (c) Software Lab. Alexander Burger @@ -218,6 +218,7 @@ X | Y | Z | + [@] | L | [env] | seg -----|-----------------+ @@ -233,6 +234,7 @@ X | Y | Z | + [@] | L <-----------------------+ diff -Nru picolisp-17.12/ersatz/lib.l picolisp-17.12+20180218/ersatz/lib.l --- picolisp-17.12/ersatz/lib.l 2016-11-24 10:18:31.000000000 +0000 +++ picolisp-17.12+20180218/ersatz/lib.l 2018-01-12 11:39:21.000000000 +0000 @@ -1,4 +1,4 @@ -# 24nov16abu +# 12jan18abu # (c) Software Lab. Alexander Burger (setq @@ -1753,7 +1753,7 @@ (de proc @ (apply call (make (while (args) (link "-C" (next)))) - "ps" "-H" "-o" "pid,ppid,start,size,pcpu,time,cmd" ) ) + "ps" "-H" "-o" "pid,ppid,start,size,pcpu,cmd" ) ) # Benchmarking (de bench Prg Binary files /tmp/tmpeU7W03/ALRdapOx4Y/picolisp-17.12/ersatz/picolisp.jar and /tmp/tmpeU7W03/az3oUAIsCf/picolisp-17.12+20180218/ersatz/picolisp.jar differ diff -Nru picolisp-17.12/ersatz/sys.src picolisp-17.12+20180218/ersatz/sys.src --- picolisp-17.12/ersatz/sys.src 2015-05-27 12:31:39.000000000 +0000 +++ picolisp-17.12+20180218/ersatz/sys.src 2018-01-09 19:27:03.000000000 +0000 @@ -1,4 +1,4 @@ -// 27may15abu +// 09jan18abu // (c) Software Lab. Alexander Burger import java.util.*; @@ -1690,7 +1690,7 @@ while (get() >= '0' && Chr <= '9' || Chr == '.') sb.append((char)Chr); try {return strToNum(sb.toString(), ((Number)Scl.Car).Cnt);} - catch (NumberFormatException e) {} + catch (NumberFormatException e) {return null;} } if (Chr != '+' && Chr != '-') { String s = x.name(); diff -Nru picolisp-17.12/lib/android.l picolisp-17.12+20180218/lib/android.l --- picolisp-17.12/lib/android.l 2017-11-19 15:10:03.000000000 +0000 +++ picolisp-17.12+20180218/lib/android.l 2018-01-21 14:18:49.000000000 +0000 @@ -1,4 +1,4 @@ -# 19nov17abu +# 21jan18abu # (c) Software Lab. Alexander Burger (ifn (info "UUID") @@ -32,24 +32,29 @@ # (java "cls" "fld" ["fld" ..]) -> any Value of class field # (java T "cls" ["cls" ..]) -> obj Define interface # (java 'obj) -> [lst ..] Reflect object -# (java "cls") -> [lst lst ..] Reflect class -(local) [java *Java *Lisp] -(de java @ +# (java "cls") -> cls Get class +(local) [java1 java *Java *Lisp] +(de java1 () (unless *Java (setq *Java (open "JAVA") *Lisp (open "LISP")) - (task (open "RQST") R (open "RPLY") - (in @ - (out R - (ext 65535 - (pr - (with (rd) # Obj - (if (get (rd) This) - (apply @ (rd)) - (rd) - NIL ) ) ) ) ) ) ) - (forked) - (queue '*Ext (cons 65535 java)) - (con java (cddr java)) ) + (let R (open "RPLY") + (task (open "RQST") R R + (in @ + (out R + (ext 65535 + (pr + (with (rd) # Obj + (if (get (rd) This) + (apply @ (rd)) + (rd) + NIL ) ) ) ) ) ) ) + (push '*Fork + '(off *Java *Lisp) + (list 'mapc 'close (list R *Java *Lisp)) ) + (forked) ) + (queue '*Ext (cons 65535 java)) ) ) + +(de java @ (ext 65535 (out *Java (pr (rest))) (let? Val (in *Lisp (rd)) @@ -130,28 +135,34 @@ # Notification (local) [ - notify setSmallIcon setContentTitle setContentText setAutoCancel setLights - setContentIntent getActivity build ] -(de notify (Ttl Msg Id) - (let B (java "android.support.v4.app.NotificationCompat$Builder" T CONTEXT) - (java B 'setSmallIcon (java "de.software_lab.pilbox.R$drawable" "notify")) - (java B 'setContentTitle Ttl) - (java B 'setContentText Msg) - (java B 'setAutoCancel T) - (java B 'setLights `(hex "FFFFFF") 500 500) - (let Intent (java "android.content.Intent" T CONTEXT (; CONTEXT GUI 0 1)) # Activity class - (java Intent 'setFlags `(hex "24000000")) # FLAG_ACTIVITY_SINGLE_TOP | FLAG_ACTIVITY_NEW_TASK - (java B 'setContentIntent - (java "android.app.PendingIntent" 'getActivity CONTEXT 0 Intent `(hex "10000000")) ) ) # FLAG_ACTIVITY_NEW_TASK - (prog1 (java B 'build) # Notification - (java (java CONTEXT 'getSystemService "notification") # NotificationManager - 'notify Id @ ) ) ) ) + notify cancel setSmallIcon setContentTitle setContentText setAutoCancel + setLights setAction putExtra setContentIntent getActivity build ] +(de notify (Id Ttl Msg File) + (let N (java CONTEXT 'getSystemService "notification") # NotificationManager + (ifn Ttl + (java N 'cancel Id) + (let B (java "android.support.v4.app.NotificationCompat$Builder" T CONTEXT) + (java B 'setSmallIcon (java "de.software_lab.pilbox.R$drawable" "notify")) + (java B 'setContentTitle Ttl) + (java B 'setContentText Msg) + (java B 'setAutoCancel T) + (java B 'setLights `(hex "FFFFFF") 500 500) + (let Intent (java "android.content.Intent" T CONTEXT (java "de.software_lab.pilbox.PilBoxActivity")) # Activity class + (java Intent 'setFlags `(hex "24000000")) # FLAG_ACTIVITY_SINGLE_TOP | FLAG_ACTIVITY_NEW_TASK + (when File + (java Intent 'setAction "RPC") + (java Intent 'putExtra "LOAD" File) ) + (java B 'setContentIntent + (java "android.app.PendingIntent" 'getActivity + CONTEXT 0 Intent `(hex "18000000") ) ) ) # FLAG_ACTIVITY_NEW_TASK | FLAG_UPDATE_CURRENT + (prog1 (java B 'build) # Notification + (java N 'notify Id @) ) ) ) ) ) # Service foreground state (local) [startForeground stopForeground] (de startForeground (Ttl Msg) (java CONTEXT 'startForeground 1 - (notify Ttl Msg 1) ) ) + (notify 1 Ttl Msg) ) ) (de stopForeground () (java CONTEXT 'stopForeground T) ) @@ -159,7 +170,7 @@ # Start Activity for a result (local) [ startActivityForResult *ResultProxy *ProxyResults resolveActivity - getPackageManager putExtra setResultProxy good bad ] + getPackageManager setResultProxy good bad ] (de startActivityForResult (Fun Action . @) (let Intent (java "android.content.Intent" T Action) (when (java Intent 'resolveActivity (java CONTEXT 'getPackageManager)) @@ -250,6 +261,34 @@ "com.google.zxing.client.android.SCAN" "SCAN_MODE" "QR_CODE_MODE" ) ) +# Alarm +(local) [alarm elapsedRealtime getInstance getTimeInMillis getBroadcast] +(de alarm (N When File) + (let + (Intent (java "android.content.Intent" T CONTEXT (java "de.software_lab.pilbox.Receiver")) + Alarm (java CONTEXT 'getSystemService "alarm") ) # AlarmManager + (ifn When + (java Alarm 'cancel + (java "android.app.PendingIntent" 'getBroadcast CONTEXT N Intent 0) ) + (java Intent 'putExtra "LOAD" File) + (java Alarm 'set + (if (atom When) 2 0) # ELAPSED_REALTIME_WAKEUP RTC_WAKEUP + (cons 'L + (if (atom When) + (+ + (* 1000 When) + (java "android.os.SystemClock" 'elapsedRealtime) ) + (let + (Dat (date (car When)) + Tim (time (cdr When)) + C (java "android.icu.util.Calendar" 'getInstance) ) + (java C 'set + (car Dat) (dec (cadr Dat)) (caddr Dat) + (car Tim) (cadr Tim) (caddr Tim) ) + (java C 'getTimeInMillis) ) ) ) + (java "android.app.PendingIntent" 'getBroadcast + CONTEXT N Intent 0 ) ) ) ) ) + # Terminate PilBox (local) [terminate finishAndRemoveTask] (de terminate () diff -Nru picolisp-17.12/lib/bash_completion picolisp-17.12+20180218/lib/bash_completion --- picolisp-17.12/lib/bash_completion 2012-04-03 14:28:03.000000000 +0000 +++ picolisp-17.12+20180218/lib/bash_completion 2018-01-17 06:34:37.000000000 +0000 @@ -1,7 +1,6 @@ # Bash completion for picolisp + pil # Alexander Burger -have pil && _pil() { local -a ARGS diff -Nru picolisp-17.12/lib/db.l picolisp-17.12+20180218/lib/db.l --- picolisp-17.12/lib/db.l 2017-08-28 10:50:15.000000000 +0000 +++ picolisp-17.12+20180218/lib/db.l 2018-01-05 17:44:46.000000000 +0000 @@ -1,4 +1,4 @@ -# 28aug17abu +# 05jan18abu # (c) Software Lab. Alexander Burger # *Dbs *Jnl *Blob upd @@ -1218,9 +1218,9 @@ (=: T T) (upd> This) ) ) -(dm lose!> () +(dm lose!> (Lst) (dbSync) - (lose> This) + (lose> This Lst) (commit 'upd) ) (de lose "Prg" @@ -1255,9 +1255,9 @@ (cons (car X) ,"Not unique") ) ) ) (getl This) ) ) -(dm keep!> () +(dm keep!> (Lst) (dbSync) - (keep> This) + (keep> This Lst) (commit 'upd) ) (de keep "Prg" diff -Nru picolisp-17.12/lib/debug.l picolisp-17.12+20180218/lib/debug.l --- picolisp-17.12/lib/debug.l 2017-07-19 09:38:10.000000000 +0000 +++ picolisp-17.12+20180218/lib/debug.l 2018-01-12 11:43:40.000000000 +0000 @@ -1,4 +1,4 @@ -# 19jul17abu +# 12jan18abu # (c) Software Lab. Alexander Burger # Prompt @@ -444,11 +444,11 @@ (trace "X") ) ) ) ) ) ) # Process Listing -(when (= *OS "Linux") +(when (member *OS '("Android" "Linux")) (de proc @ (apply call (make (while (args) (link "-C" (next)))) - "ps" "-H" "-o" "pid,ppid,start,size,pcpu,time,cmd" ) ) ) + "ps" "-H" "-o" "pid,ppid,start,size,pcpu,cmd" ) ) ) # Benchmarking (de bench Prg diff -Nru picolisp-17.12/lib/form.l picolisp-17.12+20180218/lib/form.l --- picolisp-17.12/lib/form.l 2017-08-17 09:06:59.000000000 +0000 +++ picolisp-17.12+20180218/lib/form.l 2018-02-16 08:22:21.000000000 +0000 @@ -1,4 +1,4 @@ -# 17aug17abu +# 16feb18abu # (c) Software Lab. Alexander Burger # *PRG *Top *Gui *Btn *Get *Got *Form *Evt *Lock *Spans @@ -124,7 +124,7 @@ (de action "Prg" (off "*Chart" "*Foc") (or *PRG "*Post2" (off "*Err")) - (catch "stop" + (catch 'stop (nond (*Post (unless (and *PRG (= *Form (car *Got)) (= *Get (cadr *Got))) @@ -171,7 +171,7 @@ '(Prg (off "*Err") (with (postForm) - (catch "stop" + (catch 'stop (postGui) (httpHead "text/plain; charset=utf-8") (if @@ -256,7 +256,7 @@ (when "Fun" (when (and *Allow (not (idx *Allow "Fun"))) (notAllowed "Fun") - (throw "stop") ) + (throw 'stop) ) (apply (intern "Fun") (mapcar '((X) @@ -297,7 +297,7 @@ (link (ht:Fmt (arg))) (NIL (args)) (link "&") ) ) ) ) - (throw "stop") ) ) + (throw 'stop) ) ) # Active elements (de span Args @@ -367,8 +367,8 @@ (up 99 @@@ "@3") (up 99 @@ "@2") (up 99 @ "@1") - (setq "@3" "@2" "@2" "@1" "@1" (run (str Str) 99)) ) ) - (println '-> "@1") ) + (setq "@3" "@2" "@2" "@1" "@1" (run (str Str) 99)) ) + (println '-> "@1") ) ) (when *Msg (prinl @) (off *Msg)) ) ) (push1 '*ReplH Str) (clr> (: home line)) ) ) @@ -2482,7 +2482,8 @@ (list 'with '(: home obj) (car Var)) (list ': 'home 'obj Var) ) ) ) (choButton Dlg) - (stepBtn (fin Var) Cls Hook Msg) ) + (when Cls + (stepBtn (fin Var) Cls Hook Msg) ) ) (--) ) # Standard ID form diff -Nru picolisp-17.12/lib/http.l picolisp-17.12+20180218/lib/http.l --- picolisp-17.12/lib/http.l 2017-09-14 04:33:45.000000000 +0000 +++ picolisp-17.12+20180218/lib/http.l 2018-02-02 07:06:08.000000000 +0000 @@ -1,9 +1,9 @@ -# 14sep17abu +# 02feb18abu # (c) Software Lab. Alexander Burger # *HPorts *Home *Gate *Host *Port *Port1 *Port% *Http1 *Chunked # *Sock *Agent *ContL *ContLen *MPartLim *MPartEnd "*HtSet" -# *Post *Url *Timeout *SesAdr *SesId *ConId +# *Post *Url *Timeout *SesId *ConId # *Referer *Cookies "*Cookies" (default @@ -75,7 +75,7 @@ (nond (Pw (println *Port) (bye)) ((nand (= Pw (pw)) (ctty Tty)) - (off *Run) + (or *SesId (off *Run)) (println *Pid) (load (if *Dbg "@lib/too.l" "@dbg.l")) (off *Err) @@ -144,9 +144,9 @@ (unless *SesId (setq *Port% (not *Gate) - *SesAdr *Adr *SesId (pack (in "/dev/urandom" (rd 7)) "~") *Sock (port *HPorts '*Port) ) + (out 2 (prinl *Pid " = " *Port " " *SesId)) (timeout *Timeout) ) ) # Set a cookie @@ -185,7 +185,7 @@ (task (close *HtSock)) (off *HtSock) (throw 'http) ) ) - (if (or (<> *ConId *SesId) (and *SesAdr (<> @ *Adr))) + (if (<> *ConId *SesId) (prog (task (close *HtSock)) (off *HtSock)) (setq L (split U "?") diff -Nru picolisp-17.12/lib/map picolisp-17.12+20180218/lib/map --- picolisp-17.12/lib/map 2017-12-26 10:17:27.000000000 +0000 +++ picolisp-17.12+20180218/lib/map 2018-02-17 15:09:44.000000000 +0000 @@ -1,5 +1,5 @@ -! (3066 . "@src64/flow.l") -$ (3168 . "@src64/flow.l") +! (3070 . "@src64/flow.l") +$ (3172 . "@src64/flow.l") % (2570 . "@src64/big.l") & (2822 . "@src64/big.l") * (2386 . "@src64/big.l") @@ -31,7 +31,7 @@ alarm (484 . "@src64/main.l") all (947 . "@src64/sym.l") and (1717 . "@src64/flow.l") -any (4075 . "@src64/io.l") +any (4077 . "@src64/io.l") append (1356 . "@src64/subr.l") apply (723 . "@src64/apply.l") arg (2672 . "@src64/main.l") @@ -44,11 +44,12 @@ atom (2585 . "@src64/subr.l") bind (1353 . "@src64/flow.l") bit? (2763 . "@src64/big.l") +blk (1090 . "@src64/db.l") bool (1817 . "@src64/flow.l") box (819 . "@src64/flow.l") box? (1296 . "@src64/sym.l") by (1727 . "@src64/apply.l") -bye (3653 . "@src64/flow.l") +bye (3657 . "@src64/flow.l") byte (639 . "@src64/main.l") bytes (3168 . "@src64/subr.l") caaaar (271 . "@src64/subr.l") @@ -65,7 +66,7 @@ cadddr (438 . "@src64/subr.l") caddr (156 . "@src64/subr.l") cadr (45 . "@src64/subr.l") -call (3301 . "@src64/flow.l") +call (3305 . "@src64/flow.l") car (5 . "@src64/subr.l") case (2058 . "@src64/flow.l") casq (2102 . "@src64/flow.l") @@ -87,27 +88,27 @@ cddr (79 . "@src64/subr.l") cdr (17 . "@src64/subr.l") chain (1157 . "@src64/subr.l") -char (3557 . "@src64/io.l") +char (3559 . "@src64/io.l") chop (1384 . "@src64/sym.l") circ (820 . "@src64/subr.l") circ? (2602 . "@src64/subr.l") clip (1991 . "@src64/subr.l") -close (4520 . "@src64/io.l") +close (4522 . "@src64/io.l") cmd (3340 . "@src64/main.l") cnt (1469 . "@src64/apply.l") co (2691 . "@src64/flow.l") -commit (1415 . "@src64/db.l") +commit (1502 . "@src64/db.l") con (728 . "@src64/subr.l") conc (784 . "@src64/subr.l") cond (2012 . "@src64/flow.l") connect (230 . "@src64/net.l") cons (750 . "@src64/subr.l") copy (1241 . "@src64/subr.l") -ctl (4383 . "@src64/io.l") +ctl (4385 . "@src64/io.l") ctty (3112 . "@src64/main.l") cut (2150 . "@src64/sym.l") date (2788 . "@src64/main.l") -dbck (2038 . "@src64/db.l") +dbck (2125 . "@src64/db.l") de (533 . "@src64/flow.l") dec (2320 . "@src64/big.l") def (447 . "@src64/flow.l") @@ -115,26 +116,26 @@ del (2205 . "@src64/sym.l") delete (1419 . "@src64/subr.l") delq (1471 . "@src64/subr.l") -detach (3472 . "@src64/flow.l") +detach (3476 . "@src64/flow.l") diff (2784 . "@src64/subr.l") dir (3270 . "@src64/main.l") dm (546 . "@src64/flow.l") do (2274 . "@src64/flow.l") -e (3129 . "@src64/flow.l") -echo (4551 . "@src64/io.l") +e (3133 . "@src64/flow.l") +echo (4553 . "@src64/io.l") env (679 . "@src64/main.l") -eof (3634 . "@src64/io.l") -eol (3625 . "@src64/io.l") -err (4364 . "@src64/io.l") +eof (3636 . "@src64/io.l") +eol (3627 . "@src64/io.l") +err (4366 . "@src64/io.l") errno (1654 . "@src64/main.l") eval (174 . "@src64/flow.l") -exec (3295 . "@src64/flow.l") -ext (5300 . "@src64/io.l") +exec (3299 . "@src64/flow.l") +ext (5302 . "@src64/io.l") ext? (1330 . "@src64/sym.l") extern (1194 . "@src64/sym.l") extra (1260 . "@src64/flow.l") extract (1228 . "@src64/apply.l") -fd (4353 . "@src64/io.l") +fd (4355 . "@src64/io.l") fifo (2308 . "@src64/sym.l") file (3217 . "@src64/main.l") fill (3439 . "@src64/subr.l") @@ -145,13 +146,13 @@ fish (1671 . "@src64/apply.l") flg? (2640 . "@src64/subr.l") flip (1891 . "@src64/subr.l") -flush (5275 . "@src64/io.l") +flush (5277 . "@src64/io.l") fold (3764 . "@src64/sym.l") for (2367 . "@src64/flow.l") -fork (3458 . "@src64/flow.l") +fork (3462 . "@src64/flow.l") format (2086 . "@src64/big.l") -free (1980 . "@src64/db.l") -from (3653 . "@src64/io.l") +free (2067 . "@src64/db.l") +from (3655 . "@src64/io.l") full (1092 . "@src64/subr.l") fully (1425 . "@src64/apply.l") fun? (909 . "@src64/sym.l") @@ -166,41 +167,41 @@ hash (3130 . "@src64/big.l") head (2012 . "@src64/subr.l") heap (554 . "@src64/main.l") -hear (3338 . "@src64/io.l") +hear (3340 . "@src64/io.l") host (196 . "@src64/net.l") id (1034 . "@src64/db.l") idx (2382 . "@src64/sym.l") if (1898 . "@src64/flow.l") if2 (1917 . "@src64/flow.l") ifn (1958 . "@src64/flow.l") -in (4315 . "@src64/io.l") +in (4317 . "@src64/io.l") inc (2253 . "@src64/big.l") index (2832 . "@src64/subr.l") info (3158 . "@src64/main.l") insert (1599 . "@src64/subr.l") intern (1150 . "@src64/sym.l") -ipid (3403 . "@src64/flow.l") +ipid (3407 . "@src64/flow.l") isa (958 . "@src64/flow.l") job (1425 . "@src64/flow.l") journal (977 . "@src64/db.l") -key (3486 . "@src64/io.l") +key (3488 . "@src64/io.l") kids (520 . "@src64/main.l") -kill (3435 . "@src64/flow.l") +kill (3439 . "@src64/flow.l") last (2236 . "@src64/subr.l") le0 (2712 . "@src64/big.l") length (2936 . "@src64/subr.l") let (1508 . "@src64/flow.l") let? (1633 . "@src64/flow.l") -lieu (1163 . "@src64/db.l") -line (3809 . "@src64/io.l") -lines (3962 . "@src64/io.l") +lieu (1250 . "@src64/db.l") +line (3811 . "@src64/io.l") +lines (3964 . "@src64/io.l") link (1188 . "@src64/subr.l") lisp (2341 . "@src64/main.l") list (904 . "@src64/subr.l") listen (163 . "@src64/net.l") lit (150 . "@src64/flow.l") -load (4292 . "@src64/io.l") -lock (1195 . "@src64/db.l") +load (4294 . "@src64/io.l") +lock (1282 . "@src64/db.l") loop (2310 . "@src64/flow.l") low? (3620 . "@src64/sym.l") lowc (3654 . "@src64/sym.l") @@ -216,7 +217,7 @@ mapcon (1051 . "@src64/apply.l") maplist (943 . "@src64/apply.l") maps (800 . "@src64/apply.l") -mark (1898 . "@src64/db.l") +mark (1985 . "@src64/db.l") match (3328 . "@src64/subr.l") max (2527 . "@src64/subr.l") maxi (1567 . "@src64/apply.l") @@ -249,31 +250,31 @@ on (1901 . "@src64/sym.l") onOff (1923 . "@src64/sym.l") one (1948 . "@src64/sym.l") -open (4477 . "@src64/io.l") -opid (3419 . "@src64/flow.l") +open (4479 . "@src64/io.l") +opid (3423 . "@src64/flow.l") opt (3461 . "@src64/main.l") or (1733 . "@src64/flow.l") -out (4334 . "@src64/io.l") +out (4336 . "@src64/io.l") pack (1435 . "@src64/sym.l") pair (2594 . "@src64/subr.l") pass (764 . "@src64/apply.l") pat? (895 . "@src64/sym.l") path (1281 . "@src64/io.l") -peek (3541 . "@src64/io.l") +peek (3543 . "@src64/io.l") pick (1381 . "@src64/apply.l") -pipe (4403 . "@src64/io.l") +pipe (4405 . "@src64/io.l") place (1705 . "@src64/subr.l") -poll (3430 . "@src64/io.l") +poll (3432 . "@src64/io.l") pool (657 . "@src64/db.l") pop (2115 . "@src64/sym.l") port (5 . "@src64/net.l") -pr (5388 . "@src64/io.l") +pr (5390 . "@src64/io.l") pre? (1702 . "@src64/sym.l") -prin (5199 . "@src64/io.l") -prinl (5213 . "@src64/io.l") -print (5239 . "@src64/io.l") -println (5270 . "@src64/io.l") -printsp (5255 . "@src64/io.l") +prin (5201 . "@src64/io.l") +prinl (5215 . "@src64/io.l") +print (5241 . "@src64/io.l") +println (5272 . "@src64/io.l") +printsp (5257 . "@src64/io.l") prior (2908 . "@src64/subr.l") prog (1853 . "@src64/flow.l") prog1 (1861 . "@src64/flow.l") @@ -295,35 +296,35 @@ rank (3279 . "@src64/subr.l") rassoc (3216 . "@src64/subr.l") raw (462 . "@src64/main.l") -rd (5317 . "@src64/io.l") -read (2734 . "@src64/io.l") +rd (5319 . "@src64/io.l") +read (2736 . "@src64/io.l") remove (1658 . "@src64/subr.l") replace (1522 . "@src64/subr.l") rest (2701 . "@src64/main.l") reverse (1870 . "@src64/subr.l") -rewind (5283 . "@src64/io.l") -rollback (1815 . "@src64/db.l") +rewind (5285 . "@src64/io.l") +rollback (1902 . "@src64/db.l") rot (852 . "@src64/subr.l") run (305 . "@src64/flow.l") sect (2736 . "@src64/subr.l") seed (3116 . "@src64/big.l") seek (1285 . "@src64/apply.l") send (1125 . "@src64/flow.l") -seq (1090 . "@src64/db.l") +seq (1177 . "@src64/db.l") set (1773 . "@src64/sym.l") setq (1806 . "@src64/sym.l") sigio (500 . "@src64/main.l") size (3003 . "@src64/subr.l") -skip (3611 . "@src64/io.l") +skip (3613 . "@src64/io.l") sort (4207 . "@src64/subr.l") sp? (886 . "@src64/sym.l") -space (5217 . "@src64/io.l") +space (5219 . "@src64/io.l") split (1784 . "@src64/subr.l") sqrt (2942 . "@src64/big.l") stack (582 . "@src64/main.l") state (2142 . "@src64/flow.l") stem (2181 . "@src64/subr.l") -str (4129 . "@src64/io.l") +str (4131 . "@src64/io.l") str? (1310 . "@src64/sym.l") strip (1768 . "@src64/subr.l") struct (2132 . "@src64/main.l") @@ -331,18 +332,18 @@ sum (1516 . "@src64/apply.l") super (1216 . "@src64/flow.l") swap (1829 . "@src64/sym.l") -sym (4115 . "@src64/io.l") +sym (4117 . "@src64/io.l") sym? (2629 . "@src64/subr.l") symbols (1072 . "@src64/sym.l") -sync (3298 . "@src64/io.l") +sync (3300 . "@src64/io.l") sys (906 . "@src64/main.l") t (1844 . "@src64/flow.l") tail (2103 . "@src64/subr.l") -tell (3370 . "@src64/io.l") +tell (3372 . "@src64/io.l") text (1564 . "@src64/sym.l") throw (2630 . "@src64/flow.l") -tick (3371 . "@src64/flow.l") -till (3720 . "@src64/io.l") +tick (3375 . "@src64/flow.l") +till (3722 . "@src64/io.l") time (2925 . "@src64/main.l") touch (1345 . "@src64/sym.l") trail (773 . "@src64/main.l") @@ -361,16 +362,16 @@ usec (3058 . "@src64/main.l") val (1754 . "@src64/sym.l") version (3475 . "@src64/main.l") -wait (3260 . "@src64/io.l") +wait (3262 . "@src64/io.l") when (1977 . "@src64/flow.l") while (2194 . "@src64/flow.l") wipe (3491 . "@src64/sym.l") with (1323 . "@src64/flow.l") -wr (5405 . "@src64/io.l") +wr (5407 . "@src64/io.l") xchg (1856 . "@src64/sym.l") xor (1794 . "@src64/flow.l") x| (2902 . "@src64/big.l") -yield (2897 . "@src64/flow.l") +yield (2903 . "@src64/flow.l") yoke (1212 . "@src64/subr.l") zap (1359 . "@src64/sym.l") zero (1937 . "@src64/sym.l") diff -Nru picolisp-17.12/lib/phone.css picolisp-17.12+20180218/lib/phone.css --- picolisp-17.12/lib/phone.css 2017-08-30 08:36:41.000000000 +0000 +++ picolisp-17.12+20180218/lib/phone.css 2018-02-10 18:05:57.000000000 +0000 @@ -1,4 +1,4 @@ -/* 30aug17abu +/* 10feb18abu * (c) Software Lab. Alexander Burger */ @@ -14,6 +14,10 @@ font-size: 3.0vw; } +input { + font-size: large; +} + caption { margin: 0; } @@ -36,4 +40,5 @@ /* Fonts */ .tiny { padding: 0 1ex; + font-size: large; } diff -Nru picolisp-17.12/lib/too.l picolisp-17.12+20180218/lib/too.l --- picolisp-17.12/lib/too.l 2017-07-27 18:43:42.000000000 +0000 +++ picolisp-17.12+20180218/lib/too.l 2018-02-12 14:59:53.000000000 +0000 @@ -1,4 +1,4 @@ -# 27jul17abu +# 12feb18abu # (c) Software Lab. Alexander Burger (de admin "Prg" @@ -294,153 +294,6 @@ (not (; @ 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 (++ 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) - (or - (get Cls Var 'dbf) - (and - (find - '((B) - (or - (isa '+index B) - (isa '+Swap B) ) ) - (get Cls Var 'bag) ) - (get @ '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 ### (zero *DumpBlob) @@ -537,9 +390,4 @@ (out '("tar" "xfz" "-") (echo)) ) ) ) ) (load (pack "Name" ".l") ) ) -### Debug ### -`*Dbg - -(noLint 'dbfMigrate 'iter) - # vi:et:ts=3:sw=3 diff -Nru picolisp-17.12/lib/vip.l picolisp-17.12+20180218/lib/vip.l --- picolisp-17.12/lib/vip.l 2017-11-29 09:26:09.000000000 +0000 +++ picolisp-17.12+20180218/lib/vip.l 2018-02-03 16:57:20.000000000 +0000 @@ -1,4 +1,4 @@ -# 29nov17abu +# 03feb18abu # (c) Software Lab. Alexander Burger (symbols 'vip 'pico) @@ -30,7 +30,7 @@ (make (until (eof) (link (line)))) ) (de delim? (C) - (member C '`(cons NIL (chop " \t\n\r\"'(),[]"))) ) + (member C '`(cons NIL (chop " \t\n\r\"'(),[]`{}"))) ) (de markup (Lst) (let (S 'text N 1) @@ -737,7 +737,9 @@ (extract '((X) (let? F (and (pre? S X) (pack P X)) - (if (=T (car (info F))) (pack F "/") F) ) ) + (if (=T (car (info F))) + (pack F "/") + F ) ) ) (dir (fName P) T) ) ) ) ) (do (length (car *Complete)) (_bs)) (setq S (chop (car (rot *Complete)))) ) ) @@ -758,7 +760,7 @@ (cond ((=0 Flg) (push 'Chg 0)) ((=1 Flg) (and (> PosX1 1) (dec 'PosX1))) ) - (split (flip Chg) 0) ) ) ) + (split (reverse Chg) 0) ) ) ) (de cmdMode @ (let Win (if (== This *CmdWin) (: next) This) @@ -840,12 +842,12 @@ (unless (caar L) (case (car L) (@ParO (nil (inc 'Par))) - (@ParC (or (not C) (= 0 (dec 'Par) Sup))) + (@ParC (or (not C) (=0 (dec 'Par) Sup))) (@SupO (nil (push 'Sup Par) (zero Par))) (@SupC (or (not C) - (= 0 (setq Par (++ Sup)) Sup) ) ) ) ) ) ) ) + (=0 (setq Par (++ Sup)) Sup) ) ) ) ) ) ) ) (de pipeN (Cnt Line) (evRpt @@ -907,7 +909,9 @@ (shell Line) (pipeN Cnt Line) ) ) ) ("bak" (shFile "mv @1 @1- && cp -p @1- @1")) # Backup to - - ("kab" (shFile "mv @1- @1 && cp -p @1 @1-")) # Restore from - + ("kab" # Restore from - + (shFile "mv @1- @1 && cp -p @1 @1-") + (reload) ) ("ls" # List buffers (let L (make @@ -916,7 +920,7 @@ (with *CmdWin (paste (cons T L) T) (inc (:: posY) (dec (length L))) ) ) ) - ("key" (=: buffer key Line)) + ("key" (=: buffer key Line) (reload)) ("n" (nextBuf)) # Next buffer ("N" (nextBuf T)) # Previous buffer ("e" (reload Line)) # (Edit) Reload buffer diff -Nru picolisp-17.12/misc/fibo.l picolisp-17.12+20180218/misc/fibo.l --- picolisp-17.12/misc/fibo.l 2015-03-25 07:56:35.000000000 +0000 +++ picolisp-17.12+20180218/misc/fibo.l 2018-01-10 07:32:40.000000000 +0000 @@ -1,4 +1,4 @@ -# 25mar15abu +# 10jan18abu # (c) Software Lab. Alexander Burger # Standard version @@ -11,7 +11,7 @@ (de fib (N) (let (A 0 B 1) (do N - (prog1 B (setq B (+ A B) A @)) ) ) ) + (swap 'B (+ (swap 'A B) B)) ) ) ) # Parallelized version (de fibo+ (D N) # Uses 2**D processes @@ -28,7 +28,6 @@ (fibo+ D N) (fibo+ D (dec N)) ) ) ) ) - # Using a cache (fastest) (de cachedFibo (N) (cache '(NIL) N @@ -37,9 +36,17 @@ (+ (cachedFibo (dec N)) (cachedFibo (- N 2))) ) ) ) -# Coded in 'C' `(== 64 64) # Only in the 64-bit version +# Coroutine +(de coFibo () + (co 'fibo + (let (A 0 B 1) + (loop + (yield + (swap 'B (+ (swap 'A B) B)) ) ) ) ) ) + +# Coded in 'C' (load "@lib/native.l") (gcc "fibo" NIL diff -Nru picolisp-17.12/src/vers.h picolisp-17.12+20180218/src/vers.h --- picolisp-17.12/src/vers.h 2017-12-26 10:17:16.000000000 +0000 +++ picolisp-17.12+20180218/src/vers.h 2018-02-17 15:09:32.000000000 +0000 @@ -1 +1 @@ -static byte Version[4] = {17,12,26}; +static byte Version[4] = {18,2,17}; diff -Nru picolisp-17.12/src64/arch/arm64.l picolisp-17.12+20180218/src64/arch/arm64.l --- picolisp-17.12/src64/arch/arm64.l 2017-10-25 07:32:37.000000000 +0000 +++ picolisp-17.12+20180218/src64/arch/arm64.l 2018-02-17 14:58:16.000000000 +0000 @@ -1,4 +1,4 @@ -# 25oct17abu +# 17feb18abu # (c) Software Lab. Alexander Burger # *Globals @@ -35,7 +35,7 @@ # NULL xzr (x31) (redef label (Lbl Flg) - (and Flg (not *FPic) (push '*Globals Lbl)) + (and Flg (push '*Globals Lbl)) (label Lbl Flg) ) (redef code (Lbl Align) @@ -163,13 +163,13 @@ (prinst "ldr" "x10" Val) (prinst "str" "x10" Dst) ) ) ) ) -(de adrp (Sym Reg) +(de adrp (Sym Reg Reg2) (if (memq Sym *Globals) (prog (prinst "adrp" Reg (pack ":got:" Sym)) - (prinst "ldr" Reg (pack "[" Reg ", #:got_lo12:" Sym "]")) ) + (prinst "ldr" (or Reg2 Reg) (pack "[" Reg ", #:got_lo12:" Sym "]")) ) (prinst "adrp" Reg Sym) - (prinst "add" Reg Reg (pack ":lo12:" Sym)) ) ) + (prinst "add" (or Reg2 Reg) Reg (pack ":lo12:" Sym)) ) ) (de src (Src S Imm? Reg C) #> Immediate or register (cond @@ -201,8 +201,7 @@ (pack "[" (car Src) ",x12]") ) ) C ) ) ((sub? "-" Src) # Label difference - (prinst "adrp" Reg (cdr Src)) - (prinst "add" Reg Reg (pack ":lo12:" (cdr Src))) + (adrp (cdr Src) Reg) (mov Reg (pack "[" (car Src) "," Reg "]") C ) ) @@ -220,8 +219,7 @@ (pack "[x11" (and (cdr Src) ",") (cdr Src) "]") C ) ) ((sub? "-" Src) # Label difference - (prinst "adrp" "x12" (cdr Src)) - (prinst "add" "x12" "x12" (pack ":lo12:" (cdr Src))) + (adrp (cdr Src) "x12") (mov Reg "[x12,x11]" C) ) (NIL (mov Reg (pack "[x11," (cdr Src) "]"))) ) ) ) Reg ) ) ) @@ -243,8 +241,7 @@ (cdr Src) (immReg "x11" (cdr Src)) ) ) ) ((sub? "-" (cdr Src)) # Label difference - (prinst "adrp" "x11" (cdr Src)) - (prinst "add" Reg "x11" (pack ":lo12:" (cdr Src))) ) + (adrp (cdr Src) "x11" Reg) ) (NIL (prinst "add" Reg (car Src) (cdr Src))) ) ) ((=T (car S)) # Indirect (adrp (car Src) Reg) @@ -254,8 +251,7 @@ (when (cdr S) (ifn (=T @) (prinst "add" Reg Reg (cdr Src)) - (prinst "adrp" "x12" (cdr Src)) - (prinst "add" Reg "x12" (pack ":lo12:" (cdr Src))) ) ) ) ) ) + (adrp (cdr Src) "x12" Reg) ) ) ) ) ) (de dst (Dst D Reg1 Reg2) #> Register or memory (default Reg1 "x13" Reg2 "x14") @@ -276,8 +272,7 @@ (prinst "mov" Reg1 (cdr Dst)) (pack "[" (car Dst) "," Reg1 "]") ) ) ) ((sub? "-" Dst) # Label difference - (prinst "adrp" Reg1 (cdr Dst)) - (prinst "add" Reg1 Reg1 (pack ":lo12:" (cdr Dst))) + (adrp (cdr Dst) Reg1) (pack "[" (car Dst) "," Reg1 "]") ) (NIL (pack "[" (car Dst) ",#" (cdr Dst) "]")) ) ) ((=T (car D)) # Indirect @@ -287,8 +282,7 @@ (src (car Dst) (car D) NIL Reg1) (ifn (=T (cdr D)) (pack "[" Reg1 (and (cdr Dst) ",") (cdr Dst) "]") - (prinst "adrp" Reg2 (cdr Dst)) - (prinst "add" Reg2 Reg1 (pack ":lo12:" (cdr Dst))) + (adrp (cdr Dst) Reg1 Reg2) (pack "[" Reg2 "," Reg1 "]") ) ) ) ) ### Instruction set ### diff -Nru picolisp-17.12/src64/db.l picolisp-17.12+20180218/src64/db.l --- picolisp-17.12/src64/db.l 2016-05-27 13:51:53.000000000 +0000 +++ picolisp-17.12+20180218/src64/db.l 2018-02-15 07:15:55.000000000 +0000 @@ -1,4 +1,4 @@ -# 27may16abu +# 15feb18abu # (c) Software Lab. Alexander Burger # 6 bytes in little endian format @@ -1086,6 +1086,93 @@ pop X ret +# (blk 'fd 'cnt 'siz ['fd2]) -> lst +(code 'doBlk 2) + push X + push Y + push Z + ld X E + ld Y (E CDR) # Y on args + sub S VIII # Allocate dbFile structure + call evCntXY_FE # Eval 'fd' + ld (S) E # into dbFile + ld (S I) 0 # File number + ld Y (Y CDR) # Next arg + call evCntXY_FE # Eval 'cnt' block number + shl E 6 # Block index + ld (BlkIndex) E # Set block index + ld Y (Y CDR) # Next arg + call evCntXY_FE # Eval 'siz' + ld (S II) E # Block shift + ld C BLKSIZE # Calculate block size + shl C E + ld (S III) C # Block size (64 << sh) + ld (S IV) 0 # Clear 'flgs' + ld (S V) 0 # mark vector size + ld (S VI) 0 # and mark bit vector + ld (S VII) -1 # Init 'fluse' + ld (DbFile) S # Set DB file + ld (BufEnd) S # Same as data end + sub S (S III) # Allocate buffer (block size) + ld Z S # Get block buffer in Z + ld Y (Y CDR) # Next arg + atom Y # Any? + if nz # No + ld Y -1 # No locking + else + call evCntXY_FE # Eval 'fd2' + ld Y E # Keep in Y + ld C E # File descriptor + call rdLockFileC # Read lock + end + 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) (ExtN) # Set external symbol offset + call binReadZ_FE # Read value + call consE_A # Cons with NIL + ld (A) E + ld (A CDR) Nil + link + push A # Safe + link + ld X A # Keep in X + do + call binReadZ_FE # Read property key + cmp E Nil # Any? + while ne # Yes + call consE_A # Build next property cell + ld (A) E # Cons key + ld (A CDR) Nil + ld (X CDR) A # Append to result + ld X A # Point X 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) (X) # With key + ld (X) A # Save in property cell + end + loop + null Y # Locked? + if ns # Yes + ld A (| F_UNLCK (hex "00000")) # Unlock, length 0 + ld C Y # File descriptor + call unLockFileAC + end + ld E (L I) # Return list + drop + add S ((DbFile) III) # Drop buffer + add S VIII # Drop file structure + pop Z + pop Y + pop X + ret + # (seq 'cnt|sym1) -> sym | NIL (code 'doSeq 2) push X @@ -1932,7 +2019,7 @@ call fileObjE_AC # Get file and ID shl A 6 # 'dbFile' index cmp A (DBs) # Local file? - jge dbfErrX # No + jge 90 # No add A (DbFiles) # Get DB file ld X A # into X ld E C # Object ID in E @@ -1969,7 +2056,7 @@ not B and (E) B # Clear mark end - ld E TSym # Return T +90 ld E TSym # Return T end add S I # Drop second arg pop Y diff -Nru picolisp-17.12/src64/flow.l picolisp-17.12+20180218/src64/flow.l --- picolisp-17.12/src64/flow.l 2016-12-09 13:51:20.000000000 +0000 +++ picolisp-17.12+20180218/src64/flow.l 2018-01-09 16:34:33.000000000 +0000 @@ -1,4 +1,4 @@ -# 24nov16abu +# 09jan18abu # (c) Software Lab. Alexander Burger (code 'redefMsgEC) @@ -2698,7 +2698,10 @@ if z # Yes push Y push Z - push L + link + push (At) # Save '@' + link + push L # Save L sub S "EnvMid-EnvCo" # Space for env ld Y (Stack1) # Search through stack segments ld C (Stacks) # Segment count @@ -2796,8 +2799,10 @@ ld Y (A) # Next frame loop ld (Y) (Z (pack III "+(EnvMid-EnvCo)")) # Link to main stack - ld L X end + add S I + pop (At) # Restore '@' + pop L # Restore link pop Z pop Y pop X @@ -2852,8 +2857,9 @@ if z # Yes ld (StkLimit) 0 # Clear stack limit end - add S (pack I "+(EnvMid-EnvCo)") # Clean up - pop L + add S (pack III "+(EnvMid-EnvCo)") # Clean up + pop (At) # Restore '@' + pop L # Restore link pop Z pop Y pop X @@ -2929,7 +2935,7 @@ jz reentErrEX # Yes end ld E (L I) # Get result - drop + ld (L I) (At) # Save '@' ld Z (EnvCo7) # Get main null Z # Any? if z # No @@ -2945,23 +2951,20 @@ save (EnvCo) (EnvMid) (Z III) # Save environment jmp resumeCoroutine # Resume end - null L # Stack? - if nz # Yes - ld C (Z (pack III "+(EnvMid-EnvCo)")) # Main routine's link - cmp L C # Local stack? - ldz L 0 - if ne # Yes - ld X (L) # Pointer to link - do - ld A (X) # Get link - null A # Any? - jz 10 # No - cmp A C # Reached main routine's link? - while ne # No - ld X (A) # Follow link - loop - ld (X) 0 # Clear link - end + ld C (Z (pack III "+(EnvMid-EnvCo)")) # Main routine's link + cmp L C # Local stack? + ldz L 0 + if ne # Yes + ld X (L) # Pointer to link + do + ld A (X) # Get link + null A # Any? + jz 10 # No + cmp A C # Reached main routine's link? + while ne # No + ld X (A) # Follow link + loop + ld (X) 0 # Clear link end 10 push L # End of segment push Y # Save taget coroutine @@ -3039,8 +3042,9 @@ load (Env) (EnvMid) (Z (pack III "+(Env-EnvCo)")) # Restore environment pop (EnvCo7) # Restore coroutine link pop (StkLimit) # 'lim' - add S (pack I "+(EnvMid-EnvCo)") # Clean up - pop L + add S (pack III "+(EnvMid-EnvCo)") # Clean up + pop (At) # Restore '@' + pop L # Restore link pop Z pop Y pop X diff -Nru picolisp-17.12/src64/glob.l picolisp-17.12+20180218/src64/glob.l --- picolisp-17.12/src64/glob.l 2017-11-09 12:53:09.000000000 +0000 +++ picolisp-17.12+20180218/src64/glob.l 2018-02-13 07:14:54.000000000 +0000 @@ -1,4 +1,4 @@ -# 09nov17abu +# 13feb18abu # (c) Software Lab. Alexander Burger (data 'Data) @@ -559,6 +559,7 @@ initFun NIL "pool" doPool initFun NIL "journal" doJournal initFun NIL "id" doId + initFun NIL "blk" doBlk initFun NIL "seq" doSeq initFun NIL "lieu" doLieu initFun NIL "lock" doLock diff -Nru picolisp-17.12/src64/ht.l picolisp-17.12+20180218/src64/ht.l --- picolisp-17.12/src64/ht.l 2017-03-04 09:18:57.000000000 +0000 +++ picolisp-17.12+20180218/src64/ht.l 2018-02-17 15:03:59.000000000 +0000 @@ -1,4 +1,4 @@ -# 04mar17abu +# 17feb18abu # (c) Software Lab. Alexander Burger (data 'HtData) @@ -605,6 +605,22 @@ add B (char "0") # Make ASCII digit jmp (PutB) +(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 + inc (Y) # Increment count + cmp (Y) CHUNK # Max reached? + if eq # Yes + call wrChunkY # Write buffer + end + pop Y + pop X + ret + (code 'wrChunkY 0) # X ld (PutB) (Y II) # Restore 'put' ld A (Y) # Get count @@ -628,22 +644,6 @@ ld (PutB) 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 - inc (Y) # 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 diff -Nru picolisp-17.12/src64/io.l picolisp-17.12+20180218/src64/io.l --- picolisp-17.12/src64/io.l 2017-09-02 07:24:48.000000000 +0000 +++ picolisp-17.12+20180218/src64/io.l 2018-01-09 19:22:12.000000000 +0000 @@ -1,4 +1,4 @@ -# 02sep17abu +# 09jan18abu # (c) Software Lab. Alexander Burger # Close file descriptor @@ -2655,7 +2655,9 @@ drop ld (Sep3) 0 # Thousand separator ld (Sep0) (char ".") # Decimal separator - jmp symToNumXA_FE # Convert to number + call symToNumXA_FE # Convert to number + jge retNull # Failed + ret end end push Y diff -Nru picolisp-17.12/src64/tags picolisp-17.12+20180218/src64/tags --- picolisp-17.12/src64/tags 2017-12-26 10:17:27.000000000 +0000 +++ picolisp-17.12+20180218/src64/tags 2018-02-17 15:09:44.000000000 +0000 @@ -277,150 +277,150 @@ Fork180,6633 Bye181,6670 Dbg182,6707 -SymTabEnd579,21998 -TgCPU582,22031 -TgOS583,22073 -Db1587,22164 -GcSymEnd590,22192 -Version593,22221 -Pico1602,22388 -Cell1607,22439 -ExtCnt611,22472 -ExtSkip612,22529 -Extern613,22583 -EnvCo616,22653 -Chr617,22686 -PutB618,22740 -Get_A619,22801 -InFile620,22861 -OutFile621,22907 -Env622,22954 -EnvBind623,22987 -Catch624,23060 -EnvInFrames625,23108 -EnvOutFrames626,23156 -EnvErrFrames627,23205 -EnvCtlFrames628,23253 -EnvIntern629,23303 -EnvArgs630,23377 -EnvNext631,23426 -EnvCls632,23473 -EnvKey633,23521 -EnvApply634,23567 -EnvMake635,23615 -EnvYoke636,23661 -CLink637,23684 -EnvParseX638,23741 -EnvParseC639,23790 -EnvParseEOF640,23813 -EnvMid641,23837 -EnvCo7642,23865 -EnvTask643,23911 -EnvProtect644,23956 -EnvTrace645,24009 -EnvEnd646,24056 -OrgTermio648,24085 -Flock649,24146 -Tms650,24201 -Addr651,24254 -TBuf653,24314 -CaseBlocks658,24451 -CaseData788,39834 -CaseUpper1125,79715 -CaseLower1149,81541 -Tio1174,83247 -Repl1176,83296 -PRepl1177,83341 -Jam1178,83388 -InBye1179,83433 -Sync1180,83480 -Month1181,83542 -_r_1184,83608 -_w_1185,83625 -_a_1186,83642 -_ap_1187,83659 -_dot_1188,83678 -Giveup1192,83731 -ExecErr1193,83757 -AllocErr1194,83793 -PidSigMsg1195,83822 -QuitMsg1196,83855 -CbErr1197,83876 -HashBlank1199,83920 -Redefined1200,83943 -SuperErr1201,83977 -ExtraErr1202,84006 -ThrowErr1203,84035 -Trc11204,84068 -Trc21205,84086 -SetFD1207,84112 -FdTooHigh1208,84137 -Delim1209,84169 -DelimEnd1210,84210 -Arrow1211,84221 -RolbLog1213,84248 -IgnLog1214,84310 -CircFree1215,84364 -BadChain1216,84402 -BadCount1217,84431 -ErrTok1219,84468 -Dashes1220,84489 -ProtErr1221,84511 -SymNsErr1222,84546 -StkErr1223,84586 -ArgErr1224,84618 -NumErr1225,84648 -CntErr1226,84681 -SymErr1227,84720 -ExtErr1228,84753 -PairErr1229,84795 -AtomErr1230,84832 -LstErr1231,84864 -VarErr1232,84895 -DivErr1233,84930 -RenErr1234,84953 -MakeErr1235,84983 -ReentErr1236,85012 -YieldErr1237,85051 -MsgErr1238,85083 -BrkErr1239,85112 -OpenErr1240,85138 -CloseErr1241,85171 -PipeErr1242,85206 -ForkErr1243,85239 -WaitPidErr1244,85268 -BadFdErr1245,85298 -NoFdErr1246,85324 -EofErr1247,85356 -SuparErr1248,85385 -BadInput1249,85431 -BadDot1250,85465 -SelectErr1251,85498 -WrBytesErr1252,85535 -WrChildErr1253,85572 -WrSyncErr1254,85609 -WrJnlErr1255,85644 -WrLogErr1256,85681 -TruncErr1257,85714 -DbSyncErr1258,85756 -TrSyncErr1259,85795 -LockErr1260,85843 -DbfErr1261,85875 -JnlErr1262,85904 -IdErr1263,85933 -DbRdErr1264,85956 -DbWrErr1265,85986 -DbSizErr1266,86017 -TellErr1267,86048 -IpSocketErr1268,86080 -IpGetsocknameErr1269,86122 -IpV6onlyErr1270,86174 -IpReuseaddrErr1271,86221 -IpBindErr1272,86272 -IpListenErr1273,86310 -UdpOvflErr1274,86352 -UndefErr1275,86386 -DlErr1276,86415 +SymTabEnd580,22037 +TgCPU583,22070 +TgOS584,22112 +Db1588,22203 +GcSymEnd591,22231 +Version594,22260 +Pico1603,22427 +Cell1608,22478 +ExtCnt612,22511 +ExtSkip613,22568 +Extern614,22622 +EnvCo617,22692 +Chr618,22725 +PutB619,22779 +Get_A620,22840 +InFile621,22900 +OutFile622,22946 +Env623,22993 +EnvBind624,23026 +Catch625,23099 +EnvInFrames626,23147 +EnvOutFrames627,23195 +EnvErrFrames628,23244 +EnvCtlFrames629,23292 +EnvIntern630,23342 +EnvArgs631,23416 +EnvNext632,23465 +EnvCls633,23512 +EnvKey634,23560 +EnvApply635,23606 +EnvMake636,23654 +EnvYoke637,23700 +CLink638,23723 +EnvParseX639,23780 +EnvParseC640,23829 +EnvParseEOF641,23852 +EnvMid642,23876 +EnvCo7643,23904 +EnvTask644,23950 +EnvProtect645,23995 +EnvTrace646,24048 +EnvEnd647,24095 +OrgTermio649,24124 +Flock650,24185 +Tms651,24240 +Addr652,24293 +TBuf654,24353 +CaseBlocks659,24490 +CaseData789,39873 +CaseUpper1126,79754 +CaseLower1150,81580 +Tio1175,83286 +Repl1177,83335 +PRepl1178,83380 +Jam1179,83427 +InBye1180,83472 +Sync1181,83519 +Month1182,83581 +_r_1185,83647 +_w_1186,83664 +_a_1187,83681 +_ap_1188,83698 +_dot_1189,83717 +Giveup1193,83770 +ExecErr1194,83796 +AllocErr1195,83832 +PidSigMsg1196,83861 +QuitMsg1197,83894 +CbErr1198,83915 +HashBlank1200,83959 +Redefined1201,83982 +SuperErr1202,84016 +ExtraErr1203,84045 +ThrowErr1204,84074 +Trc11205,84107 +Trc21206,84125 +SetFD1208,84151 +FdTooHigh1209,84176 +Delim1210,84208 +DelimEnd1211,84249 +Arrow1212,84260 +RolbLog1214,84287 +IgnLog1215,84349 +CircFree1216,84403 +BadChain1217,84441 +BadCount1218,84470 +ErrTok1220,84507 +Dashes1221,84528 +ProtErr1222,84550 +SymNsErr1223,84585 +StkErr1224,84625 +ArgErr1225,84657 +NumErr1226,84687 +CntErr1227,84720 +SymErr1228,84759 +ExtErr1229,84792 +PairErr1230,84834 +AtomErr1231,84871 +LstErr1232,84903 +VarErr1233,84934 +DivErr1234,84969 +RenErr1235,84992 +MakeErr1236,85022 +ReentErr1237,85051 +YieldErr1238,85090 +MsgErr1239,85122 +BrkErr1240,85151 +OpenErr1241,85177 +CloseErr1242,85210 +PipeErr1243,85245 +ForkErr1244,85278 +WaitPidErr1245,85307 +BadFdErr1246,85337 +NoFdErr1247,85363 +EofErr1248,85395 +SuparErr1249,85424 +BadInput1250,85470 +BadDot1251,85504 +SelectErr1252,85537 +WrBytesErr1253,85574 +WrChildErr1254,85611 +WrSyncErr1255,85648 +WrJnlErr1256,85683 +WrLogErr1257,85720 +TruncErr1258,85753 +DbSyncErr1259,85795 +TrSyncErr1260,85834 +LockErr1261,85882 +DbfErr1262,85914 +JnlErr1263,85943 +IdErr1264,85972 +DbRdErr1265,85995 +DbWrErr1266,86025 +DbSizErr1267,86056 +TellErr1268,86087 +IpSocketErr1269,86119 +IpGetsocknameErr1270,86161 +IpV6onlyErr1271,86213 +IpReuseaddrErr1272,86260 +IpBindErr1273,86311 +IpListenErr1274,86349 +UdpOvflErr1275,86391 +UndefErr1276,86425 +DlErr1277,86454 main.l,2310 Code4,51 @@ -671,75 +671,75 @@ readC_E2390,62277 readA_E2402,62514 tokenCE_E2588,66882 -doRead2734,70466 -inReadyC_F2775,71344 -fdSetCL_X2787,71626 -fdRdSetCZL2799,71860 -fdWrSetCZL2810,72074 -fdTooHigh2820,72294 -rdSetCL_F2824,72340 -wrSetCL_F2829,72456 -rdSetRdyCL_F2834,72579 -waitFdCEX_A2856,73038 -doWait3260,86494 -doSync3298,87217 -doHear3338,88157 -doTell3370,88851 -fdSetC_Y3419,89939 -doPoll3430,90173 -doKey3486,91544 -doPeek3541,92983 -doChar3557,93261 -doSkip3611,94207 -doEol3625,94554 -doEof3634,94720 -doFrom3653,95077 -doTill3720,96746 -eolA_F3794,98695 -doLine3809,99001 -doLines3962,103044 -parseBCE_E4003,103945 -doAny4075,105599 -doSym4115,106537 -doStr4129,106799 -loadBEX_E4182,107928 -doLoad4292,110650 -doIn4315,111062 -doOut4334,111382 -doFd4353,111694 -doErr4364,111885 -doCtl4383,112210 -doPipe4403,112555 -doOpen4477,114451 -doClose4520,115431 -doEcho4551,116022 -putStdoutB4768,121660 -newline4811,122642 -space4815,122684 -outNumE4820,122748 -outWordA4827,122876 -prExtNmX4839,123114 -outOctA4847,123308 -outAoA4860,123576 -outStringC4872,123824 -outNameE4882,123962 -prNameX4890,124079 -printE_E4900,124234 -printE4909,124370 -prinE_E5135,130386 -prinE5144,130522 -doPrin5199,131784 -doPrinl5213,132054 -doSpace5217,132122 -doPrint5239,132521 -doPrintsp5255,132816 -doPrintln5270,133105 -doFlush5275,133193 -doRewind5283,133330 -doExt5300,133720 -doRd5317,134059 -doPr5388,135958 -doWr5405,136290 +doRead2736,70511 +inReadyC_F2777,71389 +fdSetCL_X2789,71671 +fdRdSetCZL2801,71905 +fdWrSetCZL2812,72119 +fdTooHigh2822,72339 +rdSetCL_F2826,72385 +wrSetCL_F2831,72501 +rdSetRdyCL_F2836,72624 +waitFdCEX_A2858,73083 +doWait3262,86539 +doSync3300,87262 +doHear3340,88202 +doTell3372,88896 +fdSetC_Y3421,89984 +doPoll3432,90218 +doKey3488,91589 +doPeek3543,93028 +doChar3559,93306 +doSkip3613,94252 +doEol3627,94599 +doEof3636,94765 +doFrom3655,95122 +doTill3722,96791 +eolA_F3796,98740 +doLine3811,99046 +doLines3964,103089 +parseBCE_E4005,103990 +doAny4077,105644 +doSym4117,106582 +doStr4131,106844 +loadBEX_E4184,107973 +doLoad4294,110695 +doIn4317,111107 +doOut4336,111427 +doFd4355,111739 +doErr4366,111930 +doCtl4385,112255 +doPipe4405,112600 +doOpen4479,114496 +doClose4522,115476 +doEcho4553,116067 +putStdoutB4770,121705 +newline4813,122687 +space4817,122729 +outNumE4822,122793 +outWordA4829,122921 +prExtNmX4841,123159 +outOctA4849,123353 +outAoA4862,123621 +outStringC4874,123869 +outNameE4884,124007 +prNameX4892,124124 +printE_E4902,124279 +printE4911,124415 +prinE_E5137,130431 +prinE5146,130567 +doPrin5201,131829 +doPrinl5215,132099 +doSpace5219,132167 +doPrint5241,132566 +doPrintsp5257,132861 +doPrintln5272,133150 +doFlush5277,133238 +doRewind5285,133375 +doExt5302,133765 +doRd5319,134104 +doPr5390,136003 +doWr5407,136335 apply.l,465 applyXYZ_E4,51 @@ -863,7 +863,7 @@ retT761,15050 retE_E764,15085 -db.l,1134 +db.l,1152 getAdrZ_A6,117 setAdrAZ22,350 dbfBuf_AF37,589 @@ -907,18 +907,19 @@ bufAoAC_C962,26564 doJournal977,26876 doId1034,28481 -doSeq1090,29807 -doLieu1163,31683 -doLock1195,32351 -dbFetchEX1234,33301 -dbAEX1245,33518 -dbTouchEX1361,36877 -dbZapE1394,37477 -doCommit1415,37912 -doRollback1815,50763 -doMark1898,52773 -doFree1980,54819 -doDbck2038,56285 +doBlk1090,29812 +doSeq1177,32136 +doLieu1250,34012 +doLock1282,34680 +dbFetchEX1321,35630 +dbAEX1332,35847 +dbTouchEX1448,39206 +dbZapE1481,39806 +doCommit1502,40241 +doRollback1902,53092 +doMark1985,55102 +doFree2067,57143 +doDbck2125,58609 gc.l,863 markE5,63 @@ -1034,27 +1035,27 @@ throwErrZX2661,62009 doFinally2667,62100 doCo2691,62640 -resumeCoroutine2721,63560 -doYield2897,69649 -closeCoFilesC3052,74003 -doBreak3066,74266 -brkLoadE_E3074,74418 -doE3129,76018 -doTrace3168,76784 -traceCY3240,78699 -execArgsE_SXZ3267,79163 -doExec3295,79862 -doCall3301,80021 -doTick3371,81776 -doIpid3403,82773 -doOpid3419,83061 -doKill3435,83356 -doFork3458,83791 -doDetach3472,84037 -forkLispX_FE3492,84515 -doBye3653,89069 -byeE3664,89232 -finishE3676,89543 +resumeCoroutine2724,63620 +doYield2903,69831 +closeCoFilesC3056,74166 +doBreak3070,74429 +brkLoadE_E3078,74581 +doE3133,76181 +doTrace3172,76947 +traceCY3244,78862 +execArgsE_SXZ3271,79326 +doExec3299,80025 +doCall3305,80184 +doTick3375,81939 +doIpid3407,82936 +doOpid3423,83224 +doKill3439,83519 +doFork3462,83954 +doDetach3476,84200 +forkLispX_FE3496,84678 +doBye3657,89232 +byeE3668,89395 +finishE3680,89706 sym.l,1880 cmpLongAX_F5,78 diff -Nru picolisp-17.12/src64/version.l picolisp-17.12+20180218/src64/version.l --- picolisp-17.12/src64/version.l 2017-12-26 10:17:03.000000000 +0000 +++ picolisp-17.12+20180218/src64/version.l 2018-02-17 11:02:25.000000000 +0000 @@ -1,6 +1,6 @@ -# 26dec17abu +# 17feb18abu # (c) Software Lab. Alexander Burger -(de *Version 17 12 26) +(de *Version 18 2 17) # vi:et:ts=3:sw=3 diff -Nru picolisp-17.12/test/src/main.l picolisp-17.12+20180218/test/src/main.l --- picolisp-17.12/test/src/main.l 2017-11-09 13:34:21.000000000 +0000 +++ picolisp-17.12+20180218/test/src/main.l 2018-01-08 10:34:17.000000000 +0000 @@ -1,4 +1,4 @@ -# 09nov17abu +# 08jan18abu # (c) Software Lab. Alexander Burger ### Evaluation ### @@ -43,18 +43,19 @@ ### byte ### -(test (hex "12") - (byte (>> -4 (adr (1)))) ) - -(test "ABC" - (let P (native "@" "malloc" 'N 8) - (byte P (char "A")) - (byte (inc P) (char "B")) - (byte (+ P 2) (char "C")) - (byte (+ P 3) 0) - (prog1 - (native "@" "strdup" 'S P) - (native "@" "free" NIL P) ) ) ) +(when (== 64 64) + (test (hex "12") + (byte (>> -4 (adr (1)))) ) + + (test "ABC" + (let P (native "@" "malloc" 'N 8) + (byte P (char "A")) + (byte (inc P) (char "B")) + (byte (+ P 2) (char "C")) + (byte (+ P 3) 0) + (prog1 + (native "@" "strdup" 'S P) + (native "@" "free" NIL P) ) ) ) ) ### adr ###