You can subscribe to this list here.
2007 |
Jan
|
Feb
|
Mar
|
Apr
|
May
|
Jun
|
Jul
|
Aug
|
Sep
|
Oct
(55) |
Nov
(148) |
Dec
(120) |
---|---|---|---|---|---|---|---|---|---|---|---|---|
2008 |
Jan
(87) |
Feb
(207) |
Mar
(282) |
Apr
(224) |
May
(88) |
Jun
(74) |
Jul
(110) |
Aug
(142) |
Sep
(33) |
Oct
(67) |
Nov
(93) |
Dec
(147) |
2009 |
Jan
(59) |
Feb
(58) |
Mar
(66) |
Apr
(48) |
May
(55) |
Jun
(14) |
Jul
(11) |
Aug
(61) |
Sep
(23) |
Oct
(20) |
Nov
(16) |
Dec
(2) |
2010 |
Jan
(3) |
Feb
(9) |
Mar
(19) |
Apr
(17) |
May
(16) |
Jun
(2) |
Jul
(3) |
Aug
(13) |
Sep
(16) |
Oct
(10) |
Nov
(3) |
Dec
(12) |
2011 |
Jan
(18) |
Feb
|
Mar
(14) |
Apr
(23) |
May
(26) |
Jun
(6) |
Jul
(8) |
Aug
(6) |
Sep
(19) |
Oct
(30) |
Nov
(17) |
Dec
(24) |
2012 |
Jan
(5) |
Feb
(22) |
Mar
(57) |
Apr
(16) |
May
(20) |
Jun
(6) |
Jul
|
Aug
(10) |
Sep
(3) |
Oct
(14) |
Nov
(5) |
Dec
(4) |
2013 |
Jan
(10) |
Feb
(4) |
Mar
(2) |
Apr
(8) |
May
(1) |
Jun
(7) |
Jul
(3) |
Aug
|
Sep
(2) |
Oct
(3) |
Nov
(7) |
Dec
(1) |
2014 |
Jan
(2) |
Feb
(3) |
Mar
(1) |
Apr
(7) |
May
(18) |
Jun
|
Jul
|
Aug
(2) |
Sep
(1) |
Oct
|
Nov
(6) |
Dec
(4) |
2015 |
Jan
(1) |
Feb
|
Mar
(1) |
Apr
|
May
(18) |
Jun
(25) |
Jul
|
Aug
(6) |
Sep
(2) |
Oct
(3) |
Nov
|
Dec
(10) |
2016 |
Jan
|
Feb
(2) |
Mar
|
Apr
|
May
|
Jun
(8) |
Jul
|
Aug
|
Sep
|
Oct
(6) |
Nov
|
Dec
|
2017 |
Jan
(2) |
Feb
(1) |
Mar
|
Apr
(1) |
May
|
Jun
|
Jul
|
Aug
(2) |
Sep
(2) |
Oct
|
Nov
(4) |
Dec
|
From: ruvim <ru...@us...> - 2017-11-16 13:49:11
|
Update of /cvsroot/spf/src/compiler In directory sfp-cvs-1.v30.ch3.sourceforge.com:/tmp/cvs-serv23789 Modified Files: spf_translate.f Log Message: FIX src cimpiler translate -- possible infinite loop of exceptions in QUIT Index: spf_translate.f =================================================================== RCS file: /cvsroot/spf/src/compiler/spf_translate.f,v retrieving revision 1.32 retrieving revision 1.33 diff -u -d -r1.32 -r1.33 --- spf_translate.f 8 Feb 2013 17:26:40 -0000 1.32 +++ spf_translate.f 16 Nov 2017 13:49:09 -0000 1.33 @@ -199,10 +199,16 @@ CONSOLE-HANDLES 0 TO SOURCE-ID 0 TO SOURCE-ID-XT - ATIB TO TIB \ íà ñëó÷àé, åñëè QUIT âûçûâàí èç EVALUATE + ATIB 0 SOURCE! \ íà ñëó÷àé, åñëè QUIT âûçûâàí èç EVALUATE + \ SOURCE! óñòàíàâëèâàåò òàê æå #TIB è >IN + \ À èíà÷å, ïðè íåóñïåøíîì ÷òåíèè îíè îñòàíóòñÿ áåç èçìåíåíèé è áóäóò óêàçûâàòü íà ìóñîð [COMPILE] [ - ['] MAIN1 CATCH - ['] ERROR CATCH DROP + ['] MAIN1 CATCH DUP SOURCE NIP 2>R + ['] ERROR CATCH DROP 2R> 0= IF HALT THEN DROP + \ Ïóñòîé âõîäíîé áóôåð çäåñü ãîâîðèò î òîì, ÷òî èñêëþ÷åíèå ïðîèçîøëî + \ ïðè âûïîëåíèè REFILL (à íå INTERPRET). ×òîáû èçáåæàòü áåñêîíå÷íîãî öèêëà, + \ â ýòîé ñèòóàöèè äåëàåòñÿ çàâåðøåíèå ïðîöåññà ñ êîäîì èñêëþ÷åíèÿ. + \ testcase: H-STDIN CLOSE-FILE . CR ( R0 @ RP! \ ñòåê íå ñáðàñûâàåì, ò.ê. ýòî çà íàñ äåëàåò CATCH :) S0 @ SP! \ ñòåê ñáðàñûâàåì, ò.ê. OPTIONS ìîæåò îñòàâèòü çíà÷åíèÿ :( AGAIN |
From: ruvim <ru...@us...> - 2017-11-16 13:42:32
|
Update of /cvsroot/spf/lib/include In directory sfp-cvs-1.v30.ch3.sourceforge.com:/tmp/cvs-serv22711 Modified Files: tools.f Log Message: FIX lib tools -- broken compilation via jpf375c Index: tools.f =================================================================== RCS file: /cvsroot/spf/lib/include/tools.f,v retrieving revision 1.4 retrieving revision 1.5 diff -u -d -r1.4 -r1.5 --- tools.f 23 Apr 2017 02:46:00 -0000 1.4 +++ tools.f 16 Nov 2017 13:42:29 -0000 1.5 @@ -76,6 +76,21 @@ ; + +\ Ruvim Pinka additions: + +: [DEFINED] ( -- f ) \ "name" + NextWord SFIND IF DROP TRUE ELSE 2DROP FALSE THEN +; IMMEDIATE + +: [UNDEFINED] ( -- f ) \ "name" + POSTPONE [DEFINED] 0= +; IMMEDIATE + + + +[DEFINED] SHEADER [IF] \ jpf375c.exe doesn't have SHEADER so skip SYNONYM definition too. + : ENROLL-NAME ( xt d-newname -- ) \ basic factor \ see also: ~pinka/spf/compiler/native-wordlist.f SHEADER LAST-CFA @ ! @@ -88,14 +103,4 @@ PARSE-NAME PARSE-NAME 2SWAP ENROLL-SYNONYM ; - -\ Ruvim Pinka additions: - -: [DEFINED] ( -- f ) \ "name" - NextWord SFIND IF DROP TRUE ELSE 2DROP FALSE THEN -; IMMEDIATE - -: [UNDEFINED] ( -- f ) \ "name" - POSTPONE [DEFINED] 0= -; IMMEDIATE - +[THEN] |
From: ruvim <ru...@us...> - 2017-11-13 23:50:44
|
Update of /cvsroot/spf/devel/~pinka/model/protocol/http/headers-compose In directory sfp-cvs-1.v30.ch3.sourceforge.com:/tmp/cvs-serv21123 Modified Files: storage.f.xml Log Message: FIX http headers-compose storage -- missed clear on cleanup event Index: storage.f.xml =================================================================== RCS file: /cvsroot/spf/devel/~pinka/model/protocol/http/headers-compose/storage.f.xml,v retrieving revision 1.6 retrieving revision 1.7 diff -u -d -r1.6 -r1.7 --- storage.f.xml 9 Sep 2014 11:35:10 -0000 1.6 +++ storage.f.xml 13 Nov 2017 23:50:41 -0000 1.7 @@ -21,6 +21,10 @@ CLEAR-DATASPACE FALSE finalized! </def> +<handler event="cleanup"> clear </handler> +<handler event="shutdown"> clear </handler> + + <def name="add-header-line" ds=" a u --"> S, CRLF S, </def> <def name="add-header" ds=" d-value d-name -- "> |
From: ruvim <ru...@us...> - 2017-11-07 15:02:44
|
Update of /cvsroot/spf/devel/~pinka/samples/2006/core/trans In directory sfp-cvs-1.v30.ch3.sourceforge.com:/tmp/cvs-serv32163 Modified Files: nf-ext.f Log Message: FIX trans nt-ext enqueueNOTFOUND -- case of absence previous NOTFOUND Index: nf-ext.f =================================================================== RCS file: /cvsroot/spf/devel/~pinka/samples/2006/core/trans/nf-ext.f,v retrieving revision 1.6 retrieving revision 1.7 diff -u -d -r1.6 -r1.7 --- nf-ext.f 6 May 2014 20:08:48 -0000 1.6 +++ nf-ext.f 7 Nov 2017 15:02:42 -0000 1.7 @@ -6,14 +6,14 @@ \ òðàíñëÿòîð, çàäàííûé xt \ xt ( a u -- a u false | n*x true ) - S" NOTFOUND" SFIND 0= IF 2DROP ['] NOOP THEN + S" NOTFOUND" SFIND 0= IF 2DROP 0 THEN WARNING @ >R WARNING 0! S" NOTFOUND" CREATED , , R> WARNING ! DOES> ( a u a1 ) DUP 2OVER 2>R >R - @ CATCH DUP 0= IF DROP RDROP RDROP RDROP EXIT THEN - DUP -2003 <> OVER -321 <> AND OVER -2011 <> AND IF THROW THEN DROP + @ DUP IF CATCH DUP 0= IF DROP RDROP RDROP RDROP EXIT THEN ( x x ior ) + DUP -2003 <> OVER -321 <> AND OVER -2011 <> AND IF THROW THEN THEN ( x x ior|0 ) DROP \ see also: src/compiler/spf_translate.f # NOTFOUND ( x x ) 2DROP R> 2R> ROT CELL+ @ EXECUTE IF EXIT THEN |
From: ruvim <ru...@us...> - 2017-09-15 10:32:02
|
Update of /cvsroot/spf/devel/~pinka/model/xml/saxon In directory sfp-cvs-1.v30.ch3.sourceforge.com:/tmp/cvs-serv24513 Modified Files: xslt2-cli.f.xml Log Message: FIX xml saxon xslt2-cli -- workaround for some WineHQ bug Index: xslt2-cli.f.xml =================================================================== RCS file: /cvsroot/spf/devel/~pinka/model/xml/saxon/xslt2-cli.f.xml,v retrieving revision 1.1 retrieving revision 1.2 diff -u -d -r1.1 -r1.2 --- xslt2-cli.f.xml 17 May 2014 00:48:26 -0000 1.1 +++ xslt2-cli.f.xml 15 Sep 2017 10:32:00 -0000 1.2 @@ -17,13 +17,26 @@ </template> +<comment> + When Saxon is called from WineHQ under Linux, it doesn't wait for the input more than 50 ms. + Saxon shows error SXXP0003 "Premature end of file". + It seems that Wine prematurely closes Saxon's input pipe end. -<alias name="put" word="process::put"/> + As temporary workaround, now we start the process when the data are ready only, + i.e. on the first put. +</comment> + +<vect-enum> put </vect-enum> + +<def name="first-put" ds=" addr u -- "> + process::start-simple + 'process::put put! process::put +</def> <def name="assume-transform" ds=" d-txt-filename -- "> process::clear compose-commandline process::assume-commandline - process::start-simple + 'first-put put! </def> <def name="transmit-result-per" ds=" consumer-xt -- "> |
From: ruvim <ru...@us...> - 2017-09-14 12:51:03
|
Update of /cvsroot/spf/devel/~pinka/samples/2007/httpd In directory sfp-cvs-1.v30.ch3.sourceforge.com:/tmp/cvs-serv27765 Modified Files: log.f.xml Log Message: UPD samples httpd log -- variable for max message length, 4096 default Index: log.f.xml =================================================================== RCS file: /cvsroot/spf/devel/~pinka/samples/2007/httpd/log.f.xml,v retrieving revision 1.4 retrieving revision 1.5 diff -u -d -r1.4 -r1.5 --- log.f.xml 14 Aug 2017 11:44:55 -0000 1.4 +++ log.f.xml 14 Sep 2017 12:51:01 -0000 1.5 @@ -6,6 +6,8 @@ <const name="_cs_log"> ALIGN HERE MAKE-CS, </const> +<cell name="_max_log_msg_len">4096</cell> + <def name="log" ds=" a u -- "> _cs_log ENTER-CS THREAD-ID . TYPE CR @@ -17,7 +19,7 @@ _cs_log LEAVE-CS </def> <def name="logS" ds=" a2 u2 a u -- "> - 2 PICK 2048 UGT DUP >R <if> 2NIP `#error-logS-argument-too-long 2SWAP </if> + 2 PICK _max_log_msg_len @ UGT DUP >R <if> 2NIP `#error-logS-argument-too-long 2SWAP </if> <rem> Protection against wrong second argument possibly because it's missing. Rationale: TYPE with too long argument can cause exception and this critical section will remain busy forever in such case. |
From: ruvim <ru...@us...> - 2017-08-14 11:55:37
|
Update of /cvsroot/spf/devel/~pinka/model/protocol/http/headers-parse In directory sfp-cvs-1.v30.ch3.sourceforge.com:/tmp/cvs-serv2742 Modified Files: storage.f.xml Log Message: FIX model protocol http headers-parse -- stack signature violation in 'parse-header?' in case of leading blank Index: storage.f.xml =================================================================== RCS file: /cvsroot/spf/devel/~pinka/model/protocol/http/headers-parse/storage.f.xml,v retrieving revision 1.3 retrieving revision 1.4 diff -u -d -r1.3 -r1.4 --- storage.f.xml 8 Aug 2015 14:33:07 -0000 1.3 +++ storage.f.xml 14 Aug 2017 11:55:34 -0000 1.4 @@ -41,7 +41,8 @@ </rem> <def name="parse-header?" ds=" a u -- a u false | true "> - `: SPLIT <return-false/> FINE-HEAD 2SWAP OVER >R h! R> B@ 0x20 UGT + DUP <return-false/> OVER B@ 0x20 UGT <return-false/> + `: SPLIT <return-false/> FINE-HEAD 2SWAP h! TRUE <rem> Header line must not start with whitespace (namely 0x20 or 0x09 by the spec). Note that multiple lines value (line folding) is deprecated by rfc7230 # 3.2.4 |
From: ruvim <ru...@us...> - 2017-08-14 11:44:57
|
Update of /cvsroot/spf/devel/~pinka/samples/2007/httpd In directory sfp-cvs-1.v30.ch3.sourceforge.com:/tmp/cvs-serv939 Modified Files: log.f.xml Log Message: FIX samples httpd log -- partial protection from hang in logS on wrong arguments Index: log.f.xml =================================================================== RCS file: /cvsroot/spf/devel/~pinka/samples/2007/httpd/log.f.xml,v retrieving revision 1.3 retrieving revision 1.4 diff -u -d -r1.3 -r1.4 --- log.f.xml 2 Sep 2008 11:23:27 -0000 1.3 +++ log.f.xml 14 Aug 2017 11:44:55 -0000 1.4 @@ -17,9 +17,15 @@ _cs_log LEAVE-CS </def> <def name="logS" ds=" a2 u2 a u -- "> + 2 PICK 2048 UGT DUP >R <if> 2NIP `#error-logS-argument-too-long 2SWAP </if> + <rem> Protection against wrong second argument possibly because it's missing. + Rationale: TYPE with too long argument can cause exception + and this critical section will remain busy forever in such case. + </rem> _cs_log ENTER-CS THREAD-ID . TYPE `: TYPE SPACE TYPE CR _cs_log LEAVE-CS + R> <unless-exit/> -6013 THROW <rem> arguments is too long </rem> </def> <also wordlist="forthml-hidden"> |
From: ruvim <ru...@us...> - 2017-04-23 02:46:02
|
Update of /cvsroot/spf/lib/include In directory sfp-cvs-1.v30.ch3.sourceforge.com:/tmp/cvs-serv27688 Modified Files: tools.f Log Message: ADD lib tools -- some missed words from TOOLS-EXT 2012 Index: tools.f =================================================================== RCS file: /cvsroot/spf/lib/include/tools.f,v retrieving revision 1.3 retrieving revision 1.4 diff -u -d -r1.3 -r1.4 --- tools.f 23 May 2008 12:08:41 -0000 1.3 +++ tools.f 23 Apr 2017 02:46:00 -0000 1.4 @@ -66,6 +66,29 @@ \ Íè÷åãî íå äåëàòü. [THEN] - ñëîâî íåìåäëåííîãî èñïîëíåíèÿ. ; IMMEDIATE + +: CS-PICK ( C: destu ... orig0|dest0 -- destu ... orig0|dest0 destu ) ( S: u -- ) \ 94 TOOLS EXT + 2* 1+ DUP >R PICK R> PICK +; + +: CS-ROLL ( C: origu|destu origu-1|destu-1 ... orig0|dest0 -- origu-1|destu-1 ... orig0|dest0 origu|destu ) ( S: u -- ) \ 94 TOOLS EXT + 2* 1+ DUP >R ROLL R> ROLL +; + + +: ENROLL-NAME ( xt d-newname -- ) \ basic factor + \ see also: ~pinka/spf/compiler/native-wordlist.f + SHEADER LAST-CFA @ ! +; +: ENROLL-SYNONYM ( d-oldname d-newname -- ) \ postfix version of SYNONYM + 2>R SFIND DUP 0= IF -321 THROW THEN ( xt -1|1 ) + SWAP 2R> ENROLL-NAME 1 = IF IMMEDIATE THEN +; +: SYNONYM ( "<spaces>newname" "<spaces>oldname" -- ) \ 2012 TOOLS EXT + PARSE-NAME PARSE-NAME 2SWAP ENROLL-SYNONYM +; + + \ Ruvim Pinka additions: : [DEFINED] ( -- f ) \ "name" |
From: Andrey C. <sp...@us...> - 2017-02-02 20:45:34
|
Update of /cvsroot/spf/devel/~ac/lib/ns In directory sfp-cvs-1.v30.ch3.sourceforge.com:/tmp/cvs-serv3791 Modified Files: ns.f Log Message: ~ruv: Ñам опеÑаÑка в опÑеделении NLIST â лиÑнÑÑ ';', коÑоÑÐ°Ñ Ð´ÐµÐ»Ð°ÐµÑ NLIST Ð½ÐµÐ½Ð°Ñ Ð¾Ð´Ð¸Ð¼Ñм. Index: ns.f =================================================================== RCS file: /cvsroot/spf/devel/~ac/lib/ns/ns.f,v retrieving revision 1.26 retrieving revision 1.27 diff -u -d -r1.26 -r1.27 --- ns.f 14 Mar 2012 08:27:45 -0000 1.26 +++ ns.f 2 Feb 2017 20:45:32 -0000 1.27 @@ -252,7 +252,7 @@ WARNING @ WARNING 0! : NLIST ( wid -- ) - DUP IS-CLASS-FORTH IF NLIST EXIT THEN ABORT" Listing unsupported for given wordlist" ; + DUP IS-CLASS-FORTH IF NLIST EXIT THEN ABORT" Listing unsupported for given wordlist" ; : WORDS ( -- ) CONTEXT @ NLIST ; WARNING ! |
From: ruvim <ru...@us...> - 2017-01-24 10:02:47
|
Update of /cvsroot/spf/src/posix In directory sfp-cvs-1.v30.ch3.sourceforge.com:/tmp/cvs-serv12132/posix Modified Files: memory.f Log Message: FIX memory ALLOCATE -- avoid unsigned integer overflow Index: memory.f =================================================================== RCS file: /cvsroot/spf/src/posix/memory.f,v retrieving revision 1.5 retrieving revision 1.6 diff -u -d -r1.5 -r1.6 --- memory.f 26 Apr 2011 15:49:28 -0000 1.5 +++ memory.f 24 Jan 2017 10:02:45 -0000 1.6 @@ -79,6 +79,9 @@ \ äëÿ "ñëóæåáíûõ öåëåé" (íàïðèìåð, õðàíåíèÿ êëàññà ñîçäàííîãî îáúåêòà) \ ïî óìîë÷àíèþ çàïîëíÿåòñÿ àäðåñîì òåëà ïðîöåäóðû, âûçâàâøåé ALLOCATE + \ Ñðàçó âîçâðàòèòü îøèáêó, åñëè äîáàâëåíèå ñëóæåáíîé ÿ÷åéêè äàñò ïåðåïîëíåíèå + DUP [ 1 CELLS 1+ NEGATE ] LITERAL U> IF DROP 0 -300 EXIT THEN + CELL+ 1 SWAP 2 calloc-adr @ C-CALL DUP IF R@ OVER ! CELL+ ( ~~ FIX-MEMTAG ) 0 ELSE -300 THEN ; |
From: ruvim <ru...@us...> - 2017-01-24 09:48:11
|
Update of /cvsroot/spf/src/win In directory sfp-cvs-1.v30.ch3.sourceforge.com:/tmp/cvs-serv11505 Modified Files: spf_win_memory.f Log Message: FIX win memory ALLOCATE -- typo, remove unused code Index: spf_win_memory.f =================================================================== RCS file: /cvsroot/spf/src/win/spf_win_memory.f,v retrieving revision 1.11 retrieving revision 1.12 diff -u -d -r1.11 -r1.12 --- spf_win_memory.f 26 Apr 2011 15:49:28 -0000 1.11 +++ spf_win_memory.f 24 Jan 2017 09:48:08 -0000 1.12 @@ -69,6 +69,10 @@ THREAD-HEAP @ HeapDestroy DROP ; +: (FIX-MEMTAG) ( addr -- addr ) 2R@ DROP OVER CELL- ! ; + +: FIX-MEMTAG ( addr-allocated -- ) (FIX-MEMTAG) DROP ; + : ALLOCATE ( u -- a-addr ior ) \ 94 MEMORY \ Ðàñïðåäåëèòü u áàéò íåïðåðûâíîãî ïðîñòðàíñòâà äàííûõ. Óêàçàòåëü ïðîñòðàíñòâà \ äàííûõ íå èçìåíÿåòñÿ ýòîé îïåðàöèåé. Ïåðâîíà÷àëüíîå ñîäåðæèìîå âûäåëåííîãî @@ -83,15 +87,6 @@ \ ïî óìîë÷àíèþ çàïîëíÿåòñÿ àäðåñîì òåëà ïðîöåäóðû, âûçâàâøåé ALLOCATE CELL+ 8 ( HEAP_ZERO_MEMORY) THREAD-HEAP @ HeapAlloc - DUP IF R@ OVER ! CELL+ 0 ELSE -300 THEN -; - -: (FIX-MEMTAG) ( addr -- addr ) 2R@ DROP OVER CELL- ! ; - -: FIX-MEMTAG ( addr-allocated -- ) (FIX-MEMTAG) DROP ; - -: ALLOCATE ( u -- a-addr ior ) - CELL+ 8 ( HEAP_ZERO_MEMORY) THREAD-HEAP @ HeapAlloc DUP IF R@ OVER ! CELL+ ( ~~ FIX-MEMTAG ) 0 ELSE -300 THEN ; |
From: ruvim <ru...@us...> - 2016-10-10 16:09:31
|
Update of /cvsroot/spf/devel/~pinka/model/dbms In directory sfp-cvs-1.v30.ch3.sourceforge.com:/tmp/cvs-serv20709 Modified Files: mysql.f.xml Log Message: FIX model dbms mysql -- reconnect if connection was lost during query Index: mysql.f.xml =================================================================== RCS file: /cvsroot/spf/devel/~pinka/model/dbms/mysql.f.xml,v retrieving revision 1.27 retrieving revision 1.28 diff -u -d -r1.27 -r1.28 --- mysql.f.xml 11 Dec 2014 01:23:46 -0000 1.27 +++ mysql.f.xml 10 Oct 2016 16:09:28 -0000 1.28 @@ -37,6 +37,9 @@ errno 2006 = <if><rem> MySQL server has gone away (check max_allowed_packet size in my.ini/[mysqld] )</rem> (connect) DROP `#mysql-gone-away STHROW </if> + errno 2013 = <if><rem>Lost connection to MySQL server during query</rem> + (connect) DROP `#mysql-lost-connection STHROW + </if> conn mysql_error ASCIIZ> set-last-err-txt errno 2003 = <if><rem>Can't connect to MySQL server</rem> (close-conn) <rem> it can't reuse the connection object in this case </rem> |
From: ruvim <ru...@us...> - 2016-10-05 08:32:25
|
Update of /cvsroot/spf/devel/~pi/lib In directory sfp-cvs-1.v30.ch3.sourceforge.com:/tmp/cvs-serv20314 Modified Files: console.f Log Message: FIX ~pi lib console -- bugs in some stack comments Index: console.f =================================================================== RCS file: /cvsroot/spf/devel/~pi/lib/console.f,v retrieving revision 1.3 retrieving revision 1.4 diff -u -d -r1.3 -r1.4 --- console.f 5 Oct 2016 08:21:11 -0000 1.3 +++ console.f 5 Oct 2016 08:32:23 -0000 1.4 @@ -31,7 +31,7 @@ EXPORT \ ã¡«¨àã¥â 㪠§ ®¥ ª®«¨ç¥á⢮ ç¨á¥« ¢ á⥪¥ -: DUPS ( n -> ) +: DUPS ( i*x i -> i*x i*x ) DUP 0 ?DO DUP PICK SWAP LOOP DROP ; @@ -174,7 +174,7 @@ GetBackground GetColor SetBackground SetColor ; \ 뢮¤ áâப¨ ¡¥§ á¬¥é¥¨ï ªãàá®à ¨ ¡¥§ ¨§¬¥¥¨ï 梥â -: PrintC ( n addr x y -> ) +: PrintC ( addr n x y -> ) XY->N 0 SWAP 2SWAP SWAP H-STDOUT WriteConsoleOutputCharacterA DROP ; \ 뢮¤ ᨬ¢®« ¡¥§ á¬¥é¥¨ï ªãàá®à ¨ ¡¥§ ¨§¬¥¥¨ï 梥â @@ -240,16 +240,16 @@ \EOF ---¡é¨¥ á«®¢ --- -DUPS ( n -> ) - ¤ã¡«¨àã¥â 㪠§ ®¥ ª®«¨ç¥á⢮ ç¨á¥« ¢ á⥪¥ +DUPS ( i*x i -> i*x i*x ) - ¤ã¡«¨àã¥â 㪠§ ®¥ ª®«¨ç¥á⢮ ç¨á¥« ¢ á⥪¥ XY->N ( x y -> n ) - 㯠ª®¢ âì ª®®à¤¨ âë ¢ ç¨á«® N->XY ( n -> x y ) - à ᯠª®¢ âì ª®®à¤¨ âë ¨§ ç¨á« Color->N ( 梥â ä® -> n ) - 㯠ª®¢ âì 梥⠨ ä® ¢ ç¨á«® N->Color ( n -> 梥â ä® ) - à ᯠª®¢ âì 梥⠨ ä® ¨§ ç¨á« ---뢮¤ ª®á®«ì--- -CharC ( x y char -> ) - ¢ë¢®¤ ᨬ¢®« ¡¥§ á¬¥é¥¨ï ªãàá®à ¨ ¨§¬¥¥¨ï +EmitC ( x y char -> ) - ¢ë¢®¤ ᨬ¢®« ¡¥§ á¬¥é¥¨ï ªãàá®à ¨ ¨§¬¥¥¨ï 梥â -PrintC ( n addr x y -> ) - ¢ë¢®¤ áâப¨ ¡¥§ á¬¥é¥¨ï ªãàá®à ¨ +PrintC ( addr n x y -> ) - ¢ë¢®¤ áâப¨ ¡¥§ á¬¥é¥¨ï ªãàá®à ¨ ¨§¬¥¥¨ï 梥â LineH ( n -> ) - ®¤¨ à ï £®à¨§®â «ì ï «¨¨ï DLineH ( n -> ) - ¤¢®© ï £®à¨§®â «ì ï «¨¨ï |
From: ruvim <ru...@us...> - 2016-10-05 08:21:13
|
Update of /cvsroot/spf/devel/~pi/lib In directory sfp-cvs-1.v30.ch3.sourceforge.com:/tmp/cvs-serv19829 Modified Files: console.f Log Message: FIX ~pi lib console -- typo, replace russian S into english C in the names Index: console.f =================================================================== RCS file: /cvsroot/spf/devel/~pi/lib/console.f,v retrieving revision 1.2 retrieving revision 1.3 diff -u -d -r1.2 -r1.3 --- console.f 10 Sep 2007 07:06:45 -0000 1.2 +++ console.f 5 Oct 2016 08:21:11 -0000 1.3 @@ -174,11 +174,11 @@ GetBackground GetColor SetBackground SetColor ; \ 뢮¤ áâப¨ ¡¥§ á¬¥é¥¨ï ªãàá®à ¨ ¡¥§ ¨§¬¥¥¨ï 梥â -: Print ( n addr x y -> ) +: PrintC ( n addr x y -> ) XY->N 0 SWAP 2SWAP SWAP H-STDOUT WriteConsoleOutputCharacterA DROP ; \ 뢮¤ ᨬ¢®« ¡¥§ á¬¥é¥¨ï ªãàá®à ¨ ¡¥§ ¨§¬¥¥¨ï 梥â -: Emit ( x y char -> ) +: EmitC ( x y char -> ) >R XY->N 0 SWAP 1 RP@ H-STDOUT WriteConsoleOutputCharacterA R> 2DROP ; @@ -247,9 +247,9 @@ N->Color ( n -> 梥â ä® ) - à ᯠª®¢ âì 梥⠨ ä® ¨§ ç¨á« ---뢮¤ ª®á®«ì--- -Char ( x y char -> ) - ¢ë¢®¤ ᨬ¢®« ¡¥§ á¬¥é¥¨ï ªãàá®à ¨ ¨§¬¥¥¨ï +CharC ( x y char -> ) - ¢ë¢®¤ ᨬ¢®« ¡¥§ á¬¥é¥¨ï ªãàá®à ¨ ¨§¬¥¥¨ï 梥â -Print ( n addr x y -> ) - ¢ë¢®¤ áâப¨ ¡¥§ á¬¥é¥¨ï ªãàá®à ¨ +PrintC ( n addr x y -> ) - ¢ë¢®¤ áâப¨ ¡¥§ á¬¥é¥¨ï ªãàá®à ¨ ¨§¬¥¥¨ï 梥â LineH ( n -> ) - ®¤¨ à ï £®à¨§®â «ì ï «¨¨ï DLineH ( n -> ) - ¤¢®© ï £®à¨§®â «ì ï «¨¨ï |
From: ruvim <ru...@us...> - 2016-10-03 23:19:31
|
Update of /cvsroot/spf/lib/include In directory sfp-cvs-1.v30.ch3.sourceforge.com:/tmp/cvs-serv2224 Modified Files: ansi-file.f Log Message: FIX ansi-file.f -- typo Index: ansi-file.f =================================================================== RCS file: /cvsroot/spf/lib/include/ansi-file.f,v retrieving revision 1.5 retrieving revision 1.6 diff -u -d -r1.5 -r1.6 --- ansi-file.f 3 Oct 2016 23:09:20 -0000 1.5 +++ ansi-file.f 3 Oct 2016 23:19:29 -0000 1.6 @@ -61,7 +61,7 @@ : FILE-EXIST ( c-addr u -- ? ) >ZFILENAME FILE-EXIST ; : FILE-EXISTS ( c-addr u -- ? ) >ZFILENAME FILE-EXISTS ; -: INCLUDED ( c-addr u -- ? ) >ZFILENAME INCLUDED ; +: INCLUDED ( i*x c-addr u -- j*x ) >ZFILENAME INCLUDED ; WARNING ! |
From: ruvim <ru...@us...> - 2016-10-03 23:10:05
|
Update of /cvsroot/spf/lib/include In directory sfp-cvs-1.v30.ch3.sourceforge.com:/tmp/cvs-serv1469 Modified Files: ansi.f Log Message: FIX ansi.f -- add INCLUDE word Index: ansi.f =================================================================== RCS file: /cvsroot/spf/lib/include/ansi.f,v retrieving revision 1.4 retrieving revision 1.5 diff -u -d -r1.4 -r1.5 --- ansi.f 30 Apr 2011 20:51:30 -0000 1.4 +++ ansi.f 3 Oct 2016 23:10:03 -0000 1.5 @@ -22,6 +22,12 @@ REQUIRE D0< lib/include/double.f REQUIRE ANSI-FILE lib/include/ansi-file.f +[UNDEFINED] INCLUDE [IF] +: INCLUDE ( i*x "name" -- j*x ) + PARSE-NAME INCLUDED +; +[THEN] + WARNING @ 0 WARNING ! DECIMAL |
From: ruvim <ru...@us...> - 2016-10-03 23:09:22
|
Update of /cvsroot/spf/lib/include In directory sfp-cvs-1.v30.ch3.sourceforge.com:/tmp/cvs-serv1416 Modified Files: ansi-file.f Log Message: FIX ansi-file.f -- add ansifying for INCLUDED Index: ansi-file.f =================================================================== RCS file: /cvsroot/spf/lib/include/ansi-file.f,v retrieving revision 1.4 retrieving revision 1.5 diff -u -d -r1.4 -r1.5 --- ansi-file.f 20 Jul 2008 14:14:38 -0000 1.4 +++ ansi-file.f 3 Oct 2016 23:09:20 -0000 1.5 @@ -61,6 +61,8 @@ : FILE-EXIST ( c-addr u -- ? ) >ZFILENAME FILE-EXIST ; : FILE-EXISTS ( c-addr u -- ? ) >ZFILENAME FILE-EXISTS ; +: INCLUDED ( c-addr u -- ? ) >ZFILENAME INCLUDED ; + WARNING ! ;MODULE |
From: Andrey C. <sp...@us...> - 2016-06-05 22:51:46
|
Update of /cvsroot/spf/devel/~ac/lib/win/crypt In directory sfp-cvs-1.v30.ch3.sourceforge.com:/tmp/cvs-serv28337 Modified Files: cert.f Log Message: "S," äóáëèðóåòñÿ. Index: cert.f =================================================================== RCS file: /cvsroot/spf/devel/~ac/lib/win/crypt/cert.f,v retrieving revision 1.7 retrieving revision 1.8 diff -u -d -r1.7 -r1.8 --- cert.f 11 Aug 2011 23:45:41 -0000 1.7 +++ cert.f 5 Jun 2016 22:51:44 -0000 1.8 @@ -62,9 +62,9 @@ 0 CERT_NAME_EMAIL_TYPE CERT_SIMPLE_NAME_STR GetCertificateString ; -: S, ( addr u -- ) - HERE OVER ALLOT SWAP MOVE -; +\ : S, ( addr u -- ) +\ HERE OVER ALLOT SWAP MOVE +\ ; : L", 0 ?DO DUP I + C@ W, LOOP DROP 0 W, ; |
From: Andrey C. <sp...@us...> - 2016-06-05 22:49:59
|
Update of /cvsroot/spf/devel/~ac/lib/win/process In directory sfp-cvs-1.v30.ch3.sourceforge.com:/tmp/cvs-serv28241 Modified Files: info.f Log Message: Áîëüøå ïðîöåññîâ. Index: info.f =================================================================== RCS file: /cvsroot/spf/devel/~ac/lib/win/process/info.f,v retrieving revision 1.5 retrieving revision 1.6 diff -u -d -r1.5 -r1.6 --- info.f 1 Mar 2009 19:48:33 -0000 1.5 +++ info.f 5 Jun 2016 22:49:56 -0000 1.6 @@ -27,6 +27,7 @@ CONSTANT /SYSTEM_PROCESS_INFORMATION 5 CONSTANT SystemProcessInformation +USER NQSI_ERR : ForEachProcess2 { par xt \ r pi pid a u hc mem fi it h n fn -- pid } \ äëÿ êàæäîãî ïðîöåññà âûïîëíèòü xt ñî ñëåäóþùèìè ïàðàìåòðàìè: @@ -36,7 +37,8 @@ \ a u íà ìîìåíò âûçîâà íàõîäÿòñÿ â PAD ! ( äëÿ óïðîùåíèÿ ðàáîòû ñ GetProcessInfo :) \ âîçâðàò: pid - ïðîöåññ, íà êîòîðîì çàâåðøèëñÿ ïåðåáîð (pid=0 âîçìîæåí), èëè -1, åñëè ïðîéäåíû âñå -1 -> n - ^ r 300 1024 * DUP ALLOCATE THROW DUP -> pi SystemProcessInformation NtQuerySystemInformation 0= r 0 > AND + ^ r 512 1024 * DUP ALLOCATE THROW DUP -> pi SystemProcessInformation NtQuerySystemInformation DUP NQSI_ERR ! + 0= r 0 > AND IF \ 1024 ALLOCATE THROW -> fi PAD 100 + -> fi |
From: Andrey C. <sp...@us...> - 2016-06-05 22:47:41
|
Update of /cvsroot/spf/devel/~ac/lib/win/file In directory sfp-cvs-1.v30.ch3.sourceforge.com:/tmp/cvs-serv28132 Modified Files: utils.f Log Message: Óòå÷êè. Index: utils.f =================================================================== RCS file: /cvsroot/spf/devel/~ac/lib/win/file/utils.f,v retrieving revision 1.7 retrieving revision 1.8 diff -u -d -r1.7 -r1.8 --- utils.f 26 May 2011 10:39:03 -0000 1.7 +++ utils.f 5 Jun 2016 22:47:39 -0000 1.8 @@ -137,6 +137,8 @@ : ModuleDirLevel ( -- addr u ) $ModuleDirLevel @ STR@ ; : SetModuleDirLevel ( addr u -- ) $ModuleDirLevel S! ; +USER MFNR_str + : MakeFullNameRaw ( a u -- a1 u1 ) \ Åñëè [a u] - îòíîñèòåëüíîå èìÿ ôàéëà(êàòàëîãà), \ òî, ñ÷èòàÿ åãî ðàñïîëîæåíèå îòíîñèòåëüíî exe-ôàéëîâ ñåðâåðîâ, @@ -145,13 +147,14 @@ \ ãäå ðàñïîëîæåíû exe-ôàéëû ñåðâåðîâ. \ Èíà÷å âåðíóòü [a u]. + MFNR_str 0! DUP 2 < IF EXIT THEN \ ñëèøêîì êîðîòêèé ïóòü - âåðíóòü êàê åñòü OVER DUP C@ is_path_delimiter SWAP CHAR+ C@ is_path_delimiter AND \ ýòî UNC-ïóòü (\\server\share)? IF EXIT THEN \ äà - âåðíóòü êàê åñòü OVER CHAR+ C@ [CHAR] : = IF EXIT THEN \ ïðèñóòñòâóåò áóêâà äèñêà - ïîëíûé ïóòü ModuleDirName \ ïóòü ê íàøåìó EXE 2OVER DROP C@ is_path_delimiter \ ïóòü íà÷èíàåòñÿ ñ ðàçäåëèòåëÿ? - IF DROP 2 " {s}{s}" STR@ EXIT THEN \ äà - îñòàâèòü îò ïóòè ê EXE òîëüêî áóêâó äèñêà + IF DROP 2 " {s}{s}" DUP MFNR_str ! STR@ EXIT THEN \ äà - îñòàâèòü îò ïóòè ê EXE òîëüêî áóêâó äèñêà " {s}{ModuleDirLevel}{s}" STR@ \ ñîáðàòü ïóòü ; : MakeFullName ( a u -- a1 u1 ) >STR STR@ MakeFullNameRaw NormalizePath ; |
From: Andrey C. <sp...@us...> - 2016-06-05 22:34:00
|
Update of /cvsroot/spf/devel/~ac/lib/win/winsock In directory sfp-cvs-1.v30.ch3.sourceforge.com:/tmp/cvs-serv27154/~ac/lib/win/winsock Modified Files: sockets6.f Log Message: SO_KEEPALIVE Index: sockets6.f =================================================================== RCS file: /cvsroot/spf/devel/~ac/lib/win/winsock/sockets6.f,v retrieving revision 1.8 retrieving revision 1.9 diff -u -d -r1.8 -r1.9 --- sockets6.f 4 Oct 2012 00:15:18 -0000 1.8 +++ sockets6.f 5 Jun 2016 22:33:57 -0000 1.9 @@ -47,6 +47,8 @@ ELSE 0 \ OVER >R 4 NOT_IPV6_V6ONLY IPV6_V6ONLY IPPROTO_IPV6 R> \ setsockopt OR + OVER >R 4 KEEPALIVE SO_KEEPALIVE SOL_SOCKET R> + setsockopt OR THEN ; : CreateSocket6WithTimeout ( -- socket ior ) @@ -58,6 +60,8 @@ setsockopt OR OVER >R 4 TIMEOUT SO_RCVTIMEO SOL_SOCKET R> setsockopt OR + OVER >R 4 KEEPALIVE SO_KEEPALIVE SOL_SOCKET R> + setsockopt OR THEN ; : CreateUdpSocket6 ( -- socket ior ) |
From: Andrey C. <sp...@us...> - 2016-06-05 22:33:21
|
Update of /cvsroot/spf/devel/~ac/lib/win/winsock In directory sfp-cvs-1.v30.ch3.sourceforge.com:/tmp/cvs-serv27101/~ac/lib/win/winsock Modified Files: SOCKETS.F Log Message: SO_KEEPALIVE Index: SOCKETS.F =================================================================== RCS file: /cvsroot/spf/devel/~ac/lib/win/winsock/SOCKETS.F,v retrieving revision 1.24 retrieving revision 1.25 diff -u -d -r1.24 -r1.25 --- SOCKETS.F 10 Jun 2011 22:27:45 -0000 1.24 +++ SOCKETS.F 5 Jun 2016 22:33:18 -0000 1.25 @@ -39,6 +39,7 @@ 1005 CONSTANT SO_SNDTIMEO 1006 CONSTANT SO_RCVTIMEO 0004 CONSTANT SO_REUSEADDR +0008 CONSTANT SO_KEEPALIVE BASE ! SO_LINGER INVERT CONSTANT SO_DONTLINGER @@ -61,6 +62,7 @@ CREATE BROADCAST -1 , CREATE REUSEADDR -1 , +CREATE KEEPALIVE 1 , VECT v>IDN ' NOOP TO v>IDN @@ -71,6 +73,8 @@ ELSE 0 \ OVER >R 4 LINGER SO_LINGER SOL_SOCKET R> \ setsockopt OR + OVER >R 4 KEEPALIVE SO_KEEPALIVE SOL_SOCKET R> + setsockopt OR THEN ; @@ -88,6 +92,8 @@ setsockopt OR OVER >R 4 TIMEOUT SO_RCVTIMEO SOL_SOCKET R> setsockopt OR + OVER >R 4 KEEPALIVE SO_KEEPALIVE SOL_SOCKET R> + setsockopt OR THEN ; : SetSocketTimeout ( timeout socket -- ior ) @@ -267,6 +273,8 @@ ELSE 0 \ OVER >R 4 LINGER SO_LINGER SOL_SOCKET R> \ setsockopt OR + OVER >R 4 KEEPALIVE SO_KEEPALIVE SOL_SOCKET R> + setsockopt OR THEN ; : NtoA ( IP -- addr u ) |
From: Andrey C. <sp...@us...> - 2016-06-05 22:32:20
|
Update of /cvsroot/spf/devel/~ac/lib/win/winsock In directory sfp-cvs-1.v30.ch3.sourceforge.com:/tmp/cvs-serv27032/~ac/lib/win/winsock Modified Files: ssl.f Log Message: SSL_CTX_use_certificate_chain_file Index: ssl.f =================================================================== RCS file: /cvsroot/spf/devel/~ac/lib/win/winsock/ssl.f,v retrieving revision 1.17 retrieving revision 1.18 diff -u -d -r1.17 -r1.18 --- ssl.f 19 Apr 2011 18:57:02 -0000 1.17 +++ ssl.f 5 Jun 2016 22:32:18 -0000 1.18 @@ -87,6 +87,7 @@ SSLAPI: TLSv1_method SSLAPI: TLSv1_client_method SSLAPI: TLSv1_server_method +SSLAPI: TLSv1_1_server_method SSLAPI: SSLv3_method SSLAPI: SSLv23_method SSLAPI: SSL_new @@ -98,6 +99,7 @@ SSLAPI: SSL_shutdown SSLAPI: SSL_get_error SSLAPI: SSL_CTX_use_certificate_file +SSLAPI: SSL_CTX_use_certificate_chain_file SSLAPI: SSL_load_client_CA_file SSLAPI: SSL_CTX_set_client_CA_list SSLAPI: SSL_CTX_load_verify_locations @@ -125,6 +127,7 @@ SSLAPI: SSL_CTX_callback_ctrl \ SSLAPI: SSL_CTX_set_tlsext_servername_arg SSLAPI: SSL_set_SSL_CTX +SSLAPI: SSL_CTX_set_cipher_list SSLAPI: SSL_CTX_Free \ SSLAPI: SSL_CTX_sess_accept_renegotiate @@ -164,6 +167,8 @@ 0 CONSTANT TLSEXT_NAMETYPE_host_name 0x01000000 CONSTANT SSL_OP_NO_SSLv2 +0x02000000 CONSTANT SSL_OP_NO_SSLv3 +0x04000000 CONSTANT SSL_OP_NO_TLSv1 VARIABLE vSSL_INIT @@ -193,8 +198,10 @@ ( ." CB SSL host name=") sna snu vSslSniHostName sna uSslServer ! sna snu vSslServer 2DUP sna snu COMPARE IF DROP -> pema - TLSv1_server_method SSL_CTX_new NIP -> ctx + TLSv1_1_server_method SSL_CTX_new NIP -> ctx + S" HIGH:!aNULL:!MD5:!RC4" DROP ctx SSL_CTX_set_cipher_list NIP NIP 1 <> THROW uCertType @ pema ctx SSL_CTX_use_certificate_file NIP NIP NIP 1 <> THROW + uCertType @ pema ctx SSL_CTX_use_certificate_chain_file NIP NIP NIP 1 <> THROW uCertType @ pema ctx SSL_CTX_use_RSAPrivateKey_file NIP NIP NIP 1 <> THROW ctx ssl SSL_set_SSL_CTX DROP 2DROP \ uSSL_CONTEXT @ SSL_CTX_Free 2DROP @@ -209,6 +216,7 @@ : SslNewServerContext { pema pemu type \ c -- context } SSLv23_server_method SSL_CTX_new DUP 0= THROW NIP +\ TLSv1_1_server_method SSL_CTX_new DUP 0= THROW NIP \ http://www.openssl.org/docs/ssl/SSL_CTX_new.html# -> c type uCertType ! @@ -216,12 +224,14 @@ \ SSL_OP_NO_SSLv2 c SSL_CTX_set_options NIP NIP DROP - 0 SSL_OP_NO_SSLv2 SSL_CTRL_OPTIONS c SSL_CTX_ctrl DROP 2DROP 2DROP + 0 SSL_OP_NO_SSLv2 SSL_OP_NO_SSLv3 OR SSL_CTRL_OPTIONS c SSL_CTX_ctrl DROP 2DROP 2DROP + S" HIGH:!aNULL:!MD5:!RC4" DROP c SSL_CTX_set_cipher_list NIP NIP DROP \ ñåðòèôèêàòû è êëþ÷è, èñïîëüçóåìûå â ñîåäèíåíèè pemu IF type pema c SSL_CTX_use_certificate_file NIP NIP NIP 1 <> THROW + type pema c SSL_CTX_use_certificate_chain_file NIP NIP NIP 1 <> THROW type pema c SSL_CTX_use_RSAPrivateKey_file NIP NIP NIP 1 <> THROW THEN |
From: Andrey C. <sp...@us...> - 2016-06-05 21:41:19
|
Update of /cvsroot/spf/devel/~ac/lib/lin/sql In directory sfp-cvs-1.v30.ch3.sourceforge.com:/tmp/cvs-serv24839 Modified Files: sqlite3.f Log Message: РпоÑÐ»ÐµÐ´Ð½Ð¸Ñ Ð²ÐµÑÑиÑÑ SQLite вÑзов backup-ÑÑнкÑий Ð¼Ð¾Ð¶ÐµÑ Ð·Ð°Ð²ÐµÑÑиÑÑÑÑ Ð¾Ñибкой SQLITE_READONLY, еÑли не ÑовпадаÑÑ ÑазмеÑÑ ÑÑÑÐ°Ð½Ð¸Ñ Ð´Ð²ÑÑ Ð±Ð°Ð·. Ð ÑÑом ÑлÑÑае ÑÑаÑÑй backup Ð¼Ñ Ð±Ñдем не пеÑезапиÑÑваÑÑ, а ÑдалÑÑÑ Ð¸ делаÑÑ Ð¿Ð¾Ð²ÑоÑнÑÑ Ð¿Ð¾Ð¿ÑÑкÑ. Index: sqlite3.f =================================================================== RCS file: /cvsroot/spf/devel/~ac/lib/lin/sql/sqlite3.f,v retrieving revision 1.46 retrieving revision 1.47 diff -u -d -r1.46 -r1.47 --- sqlite3.f 4 Dec 2015 15:39:13 -0000 1.46 +++ sqlite3.f 5 Jun 2016 21:41:17 -0000 1.47 @@ -67,6 +67,7 @@ sqh 1 sqlite3_errmsg ASCIIZ> DB3_DEBUG @ IF 2DUP TYPE CR THEN " {s}" STR@ ER-U ! ER-A ! sqh 1 sqlite3_errcode DUP 1 = IF DROP -2 ELSE 30000 + THEN ( ior ) + DUP 30000 = IF DROP EXIT THEN \ è sqlite3_errmsg ãîâîðèò "not an error" THROW THEN \ ior THROW ( ior ïî÷òè âñåãäà 1 â ñëó÷àå îøèáêè) @@ -424,23 +425,41 @@ : db3_shared_cache ( -- ) 1 1 sqlite3_enable_shared_cache DROP ; -: db3_backup_to { addr u sqh \ sd b -- } +: (db3_backup_to) { addr u sqh \ sd b -- } \ çàïèñàòü êîïèþ ÁÄ èç õýíäëà sqh â db3-ôàéë ñ èìåíåì addr u addr u db3_open -> sd S" main" DROP sqh S" main" DROP sd 4 sqlite3_backup_init -> b b 0= IF 5 S" sqlite3_backup_init" sd db3_error? THEN BEGIN \ æäåì îñâîáîæäåíèÿ äîñòóïà ê ÁÄ - -1 b 2 sqlite3_backup_step DUP SQLITE_BUSY = + -1 b 2 sqlite3_backup_step + DUP SQLITE_BUSY = WHILE DB3_DEBUG @ IF ." DB3_BACKUP_WAIT" b . THEN DROP 100 PAUSE \ ^ waitcnt 1+! REPEAT - 101 ( SQLITE_DONE ) <> IF 5 S" sqlite3_backup_step" sd db3_error? THEN + 101 ( SQLITE_DONE ) <> + IF + b 1 sqlite3_backup_finish DROP + 5 S" sqlite3_backup_step" sd ['] db3_error? CATCH + sd db3_close + THROW + THEN b 1 sqlite3_backup_finish ?DUP IF S" sqlite3_backup_finish" sd db3_error? THEN sd db3_close ; +: db3_backup_to { addr u sqh \ sd b -- } + addr u sqh ['] (db3_backup_to) CATCH ?DUP + IF NIP NIP NIP + ." db3_backup failed: " DUP . addr u TYPE CR + 30008 = \ çàïèñü â read-only ÁÄ èëè íåñîîòâåòñòâèå page_size (â íîâûõ sqlite èçìåíèëè ñ 1Ê íà 4Ê) + IF addr u DELETE-FILE ." deleted: " . CR + addr u sqh ['] (db3_backup_to) CATCH ?DUP + IF ." second attempt failed too: " . CR DROP 2DROP THEN + THEN + THEN +; PREVIOUS PREVIOUS : '>` ( addr u -- ) |