Update 3rd party libs - clic - Clic is an command line interactive client for gopher written in Common LISP
(HTM) git clone git://bitreich.org/clic/ git://enlrupgkhuxnvlhsf6lc3fziv5h2hhfrinws65d7roiv6bfj7d652fid.onion/clic/
(DIR) Log
(DIR) Files
(DIR) Refs
(DIR) Tags
(DIR) README
(DIR) LICENSE
---
(DIR) commit 69ab9eb1f725de700f5a1b740c488a9692fd10e2
(DIR) parent 38eb1e4a49bd594bd6108c0beec5fb3afa09e8fd
(HTM) Author: Solene Rapenne <solene@perso.pw>
Date: Wed, 3 Jun 2020 10:36:53 +0200
Update 3rd party libs
Diffstat:
M 3rdparties/bundle-info.sexp | 14 +++++++-------
D 3rdparties/software/alexandria-201… | 13 -------------
D 3rdparties/software/alexandria-201… | 4 ----
D 3rdparties/software/alexandria-201… | 10 ----------
D 3rdparties/software/alexandria-201… | 37 -------------------------------
D 3rdparties/software/alexandria-201… | 52 -------------------------------
D 3rdparties/software/alexandria-201… | 11 -----------
D 3rdparties/software/alexandria-201… | 62 -------------------------------
D 3rdparties/software/alexandria-201… | 18 ------------------
D 3rdparties/software/alexandria-201… | 93 -------------------------------
D 3rdparties/software/alexandria-201… | 92 -------------------------------
D 3rdparties/software/alexandria-201… | 106 ------------------------------
D 3rdparties/software/alexandria-201… | 37 -------------------------------
D 3rdparties/software/alexandria-201… | 3 ---
D 3rdparties/software/alexandria-201… | 28 ----------------------------
D 3rdparties/software/alexandria-201… | 277 -------------------------------
D 3rdparties/software/alexandria-201… | 881 ------------------------------
D 3rdparties/software/alexandria-201… | 14 --------------
D 3rdparties/software/alexandria-201… | 161 -------------------------------
D 3rdparties/software/alexandria-201… | 101 -------------------------------
D 3rdparties/software/alexandria-201… | 172 ------------------------------
D 3rdparties/software/alexandria-201… | 367 ------------------------------
D 3rdparties/software/alexandria-201… | 314 -------------------------------
D 3rdparties/software/alexandria-201… | 260 -------------------------------
D 3rdparties/software/alexandria-201… | 244 -------------------------------
D 3rdparties/software/alexandria-201… | 555 -------------------------------
D 3rdparties/software/alexandria-201… | 6 ------
D 3rdparties/software/alexandria-201… | 65 -------------------------------
D 3rdparties/software/alexandria-201… | 2047 -------------------------------
D 3rdparties/software/alexandria-201… | 137 -------------------------------
D 3rdparties/software/babel-20171227… | 31 -------------------------------
D 3rdparties/software/babel-20171227… | 20 --------------------
D 3rdparties/software/babel-20171227… | 27 ---------------------------
D 3rdparties/software/babel-20171227… | 34 -------------------------------
D 3rdparties/software/babel-20171227… | 19 -------------------
D 3rdparties/software/babel-20171227… | 38 -------------------------------
D 3rdparties/software/babel-20171227… | 42 -------------------------------
D 3rdparties/software/babel-20171227… | 59 -------------------------------
D 3rdparties/software/babel-20171227… | 31 -------------------------------
D 3rdparties/software/babel-20171227… | 105 -------------------------------
D 3rdparties/software/babel-20171227… | 20 --------------------
D 3rdparties/software/babel-20171227… | 27 ---------------------------
D 3rdparties/software/babel-20171227… | 250 -------------------------------
D 3rdparties/software/babel-20171227… | 43 ------------------------------
D 3rdparties/software/babel-20171227… | 119 -------------------------------
D 3rdparties/software/babel-20171227… | 81 ------------------------------
D 3rdparties/software/babel-20171227… | 49 -------------------------------
D 3rdparties/software/babel-20171227… | 71 -------------------------------
D 3rdparties/software/babel-20171227… | 184 -------------------------------
D 3rdparties/software/babel-20171227… | 1087 ------------------------------
D 3rdparties/software/babel-20171227… | 767 -------------------------------
D 3rdparties/software/babel-20171227… | 577 -------------------------------
D 3rdparties/software/babel-20171227… | 881 ------------------------------
D 3rdparties/software/babel-20171227… | 503 -------------------------------
D 3rdparties/software/babel-20171227… | 88 -------------------------------
D 3rdparties/software/babel-20171227… | 2226 -------------------------------
D 3rdparties/software/babel-20171227… | 17637 -------------------------------
D 3rdparties/software/babel-20171227… | 115 -------------------------------
D 3rdparties/software/babel-20171227… | 82 -------------------------------
D 3rdparties/software/babel-20171227… | 436 -------------------------------
D 3rdparties/software/babel-20171227… | 353 -------------------------------
D 3rdparties/software/babel-20171227… | 212 ------------------------------
D 3rdparties/software/babel-20171227… | 212 ------------------------------
D 3rdparties/software/babel-20171227… | 43 ------------------------------
D 3rdparties/software/babel-20171227… | 2 --
D 3rdparties/software/babel-20171227… | 212 ------------------------------
D 3rdparties/software/babel-20171227… | 37 -------------------------------
D 3rdparties/software/babel-20171227… | 45 -------------------------------
D 3rdparties/software/babel-20171227… | 911 ------------------------------
D 3rdparties/software/babel-20171227… | 0
D 3rdparties/software/babel-20171227… | 0
D 3rdparties/software/babel-20171227… | 212 ------------------------------
D 3rdparties/software/babel-20171227… | 0
D 3rdparties/software/babel-20171227… | 0
D 3rdparties/software/babel-20171227… | 212 ------------------------------
D 3rdparties/software/babel-20171227… | 212 ------------------------------
D 3rdparties/software/babel-20171227… | 212 ------------------------------
D 3rdparties/software/bordeaux-threa… | 46 -------------------------------
D 3rdparties/software/bordeaux-threa… | 19 -------------------
D 3rdparties/software/bordeaux-threa… | 20 --------------------
D 3rdparties/software/bordeaux-threa… | 2 --
D 3rdparties/software/bordeaux-threa… | 74 -------------------------------
D 3rdparties/software/bordeaux-threa… | 55 -------------------------------
D 3rdparties/software/bordeaux-threa… | 86 ------------------------------
D 3rdparties/software/bordeaux-threa… | 170 -------------------------------
D 3rdparties/software/bordeaux-threa… | 38 -------------------------------
D 3rdparties/software/bordeaux-threa… | 361 -------------------------------
D 3rdparties/software/bordeaux-threa… | 150 -------------------------------
D 3rdparties/software/bordeaux-threa… | 143 -------------------------------
D 3rdparties/software/bordeaux-threa… | 105 -------------------------------
D 3rdparties/software/bordeaux-threa… | 130 -------------------------------
D 3rdparties/software/bordeaux-threa… | 161 -------------------------------
D 3rdparties/software/bordeaux-threa… | 26 --------------------------
D 3rdparties/software/bordeaux-threa… | 111 ------------------------------
D 3rdparties/software/bordeaux-threa… | 136 -------------------------------
D 3rdparties/software/bordeaux-threa… | 144 -------------------------------
D 3rdparties/software/bordeaux-threa… | 143 -------------------------------
D 3rdparties/software/bordeaux-threa… | 68 -------------------------------
D 3rdparties/software/bordeaux-threa… | 109 -------------------------------
D 3rdparties/software/bordeaux-threa… | 3 ---
D 3rdparties/software/bordeaux-threa… | 130 -------------------------------
D 3rdparties/software/bordeaux-threa… | 103 -------------------------------
D 3rdparties/software/bordeaux-threa… | 66 -------------------------------
D 3rdparties/software/bordeaux-threa… | 251 -------------------------------
D 3rdparties/software/bordeaux-threa… | 2 --
D 3rdparties/software/cffi_0.20.0/.g… | 28 ----------------------------
D 3rdparties/software/cffi_0.20.0/.t… | 38 -------------------------------
D 3rdparties/software/cffi_0.20.0/CO… | 21 ---------------------
D 3rdparties/software/cffi_0.20.0/HE… | 28 ----------------------------
D 3rdparties/software/cffi_0.20.0/Ma… | 72 -------------------------------
D 3rdparties/software/cffi_0.20.0/RE… | 19 -------------------
D 3rdparties/software/cffi_0.20.0/TO… | 115 -------------------------------
D 3rdparties/software/cffi_0.20.0/cf… | 37 -------------------------------
D 3rdparties/software/cffi_0.20.0/cf… | 41 -------------------------------
D 3rdparties/software/cffi_0.20.0/cf… | 48 -------------------------------
D 3rdparties/software/cffi_0.20.0/cf… | 91 -------------------------------
D 3rdparties/software/cffi_0.20.0/cf… | 48 -------------------------------
D 3rdparties/software/cffi_0.20.0/cf… | 41 -------------------------------
D 3rdparties/software/cffi_0.20.0/cf… | 101 -------------------------------
D 3rdparties/software/cffi_0.20.0/do… | 46 -------------------------------
D 3rdparties/software/cffi_0.20.0/do… | 132 -------------------------------
D 3rdparties/software/cffi_0.20.0/do… | 7113 -------------------------------
D 3rdparties/software/cffi_0.20.0/do… | 334 -------------------------------
D 3rdparties/software/cffi_0.20.0/do… | 1058 -------------------------------
D 3rdparties/software/cffi_0.20.0/do… | 313 -------------------------------
D 3rdparties/software/cffi_0.20.0/do… | 259 -------------------------------
D 3rdparties/software/cffi_0.20.0/do… | 75 -------------------------------
D 3rdparties/software/cffi_0.20.0/do… | 44 -------------------------------
D 3rdparties/software/cffi_0.20.0/do… | 48 -------------------------------
D 3rdparties/software/cffi_0.20.0/ex… | 78 -------------------------------
D 3rdparties/software/cffi_0.20.0/ex… | 51 -------------------------------
D 3rdparties/software/cffi_0.20.0/ex… | 93 -------------------------------
D 3rdparties/software/cffi_0.20.0/ex… | 20 --------------------
D 3rdparties/software/cffi_0.20.0/ex… | 17 -----------------
D 3rdparties/software/cffi_0.20.0/ex… | 76 -------------------------------
D 3rdparties/software/cffi_0.20.0/ex… | 30 ------------------------------
D 3rdparties/software/cffi_0.20.0/ex… | 39 -------------------------------
D 3rdparties/software/cffi_0.20.0/ex… | 88 -------------------------------
D 3rdparties/software/cffi_0.20.0/ex… | 20 --------------------
D 3rdparties/software/cffi_0.20.0/gr… | 152 -------------------------------
D 3rdparties/software/cffi_0.20.0/gr… | 57 -------------------------------
D 3rdparties/software/cffi_0.20.0/gr… | 913 -------------------------------
D 3rdparties/software/cffi_0.20.0/gr… | 36 -------------------------------
D 3rdparties/software/cffi_0.20.0/li… | 132 -------------------------------
D 3rdparties/software/cffi_0.20.0/li… | 43 ------------------------------
D 3rdparties/software/cffi_0.20.0/li… | 109 -------------------------------
D 3rdparties/software/cffi_0.20.0/li… | 38 -------------------------------
D 3rdparties/software/cffi_0.20.0/li… | 106 ------------------------------
D 3rdparties/software/cffi_0.20.0/sc… | 248 -------------------------------
D 3rdparties/software/cffi_0.20.0/sr… | 211 -------------------------------
D 3rdparties/software/cffi_0.20.0/sr… | 194 ------------------------------
D 3rdparties/software/cffi_0.20.0/sr… | 838 -------------------------------
D 3rdparties/software/cffi_0.20.0/sr… | 54 -------------------------------
D 3rdparties/software/cffi_0.20.0/sr… | 664 -------------------------------
D 3rdparties/software/cffi_0.20.0/sr… | 446 ------------------------------
D 3rdparties/software/cffi_0.20.0/sr… | 201 ------------------------------
D 3rdparties/software/cffi_0.20.0/sr… | 432 -------------------------------
D 3rdparties/software/cffi_0.20.0/sr… | 384 -------------------------------
D 3rdparties/software/cffi_0.20.0/sr… | 331 -------------------------------
D 3rdparties/software/cffi_0.20.0/sr… | 454 -------------------------------
D 3rdparties/software/cffi_0.20.0/sr… | 313 -------------------------------
D 3rdparties/software/cffi_0.20.0/sr… | 417 -------------------------------
D 3rdparties/software/cffi_0.20.0/sr… | 396 -------------------------------
D 3rdparties/software/cffi_0.20.0/sr… | 342 -------------------------------
D 3rdparties/software/cffi_0.20.0/sr… | 314 -------------------------------
D 3rdparties/software/cffi_0.20.0/sr… | 408 -------------------------------
D 3rdparties/software/cffi_0.20.0/sr… | 322 -------------------------------
D 3rdparties/software/cffi_0.20.0/sr… | 713 ------------------------------
D 3rdparties/software/cffi_0.20.0/sr… | 369 ------------------------------
D 3rdparties/software/cffi_0.20.0/sr… | 111 ------------------------------
D 3rdparties/software/cffi_0.20.0/sr… | 90 -------------------------------
D 3rdparties/software/cffi_0.20.0/sr… | 441 -------------------------------
D 3rdparties/software/cffi_0.20.0/sr… | 457 -------------------------------
D 3rdparties/software/cffi_0.20.0/sr… | 181 -------------------------------
D 3rdparties/software/cffi_0.20.0/sr… | 305 -------------------------------
D 3rdparties/software/cffi_0.20.0/sr… | 133 -------------------------------
D 3rdparties/software/cffi_0.20.0/sr… | 1051 -------------------------------
D 3rdparties/software/cffi_0.20.0/sr… | 84 -------------------------------
D 3rdparties/software/cffi_0.20.0/te… | 98 -------------------------------
D 3rdparties/software/cffi_0.20.0/te… | 2 --
D 3rdparties/software/cffi_0.20.0/te… | 71 -------------------------------
D 3rdparties/software/cffi_0.20.0/te… | 148 -------------------------------
D 3rdparties/software/cffi_0.20.0/te… | 526 -------------------------------
D 3rdparties/software/cffi_0.20.0/te… | 9 ---------
D 3rdparties/software/cffi_0.20.0/te… | 536 -------------------------------
D 3rdparties/software/cffi_0.20.0/te… | 231 -------------------------------
D 3rdparties/software/cffi_0.20.0/te… | 309 -------------------------------
D 3rdparties/software/cffi_0.20.0/te… | 199 -------------------------------
D 3rdparties/software/cffi_0.20.0/te… | 245 -------------------------------
D 3rdparties/software/cffi_0.20.0/te… | 96 -------------------------------
D 3rdparties/software/cffi_0.20.0/te… | 179 -------------------------------
D 3rdparties/software/cffi_0.20.0/te… | 985 -------------------------------
D 3rdparties/software/cffi_0.20.0/te… | 50 -------------------------------
D 3rdparties/software/cffi_0.20.0/te… | 657 -------------------------------
D 3rdparties/software/cffi_0.20.0/te… | 296 -------------------------------
D 3rdparties/software/cffi_0.20.0/te… | 132 -------------------------------
D 3rdparties/software/cffi_0.20.0/te… | 33 -------------------------------
D 3rdparties/software/cffi_0.20.0/te… | 246 -------------------------------
D 3rdparties/software/cffi_0.20.0/te… | 44 -------------------------------
D 3rdparties/software/cffi_0.20.0/te… | 150 -------------------------------
D 3rdparties/software/cffi_0.20.0/te… | 705 -------------------------------
D 3rdparties/software/cffi_0.20.0/te… | 42 -------------------------------
D 3rdparties/software/cffi_0.20.0/te… | 9 ---------
D 3rdparties/software/cffi_0.20.0/te… | 52 -------------------------------
D 3rdparties/software/cffi_0.20.0/to… | 565 -------------------------------
D 3rdparties/software/cffi_0.20.0/to… | 392 -------------------------------
D 3rdparties/software/cffi_0.20.0/to… | 46 -------------------------------
D 3rdparties/software/cffi_0.20.0/to… | 95 ------------------------------
D 3rdparties/software/cffi_0.20.0/uf… | 664 -------------------------------
D 3rdparties/software/cffi_0.20.0/uf… | 3 ---
D 3rdparties/software/cl+ssl-2019020… | 4 ----
D 3rdparties/software/cl+ssl-2019020… | 50 -------------------------------
D 3rdparties/software/cl+ssl-2019020… | 31 -------------------------------
D 3rdparties/software/cl+ssl-2019020… | 3 ---
D 3rdparties/software/cl+ssl-2019020… | 4 ----
D 3rdparties/software/cl+ssl-2019020… | 26 --------------------------
D 3rdparties/software/cl+ssl-2019020… | 48 -------------------------------
D 3rdparties/software/cl+ssl-2019020… | 31 -------------------------------
D 3rdparties/software/cl+ssl-2019020… | 110 -------------------------------
D 3rdparties/software/cl+ssl-2019020… | 72 -------------------------------
D 3rdparties/software/cl+ssl-2019020… | 464 ------------------------------
D 3rdparties/software/cl+ssl-2019020… | 140 -------------------------------
D 3rdparties/software/cl+ssl-2019020… | 321 -------------------------------
D 3rdparties/software/cl+ssl-2019020… | 127 -------------------------------
D 3rdparties/software/cl+ssl-2019020… | 22 ----------------------
D 3rdparties/software/cl+ssl-2019020… | 16 ----------------
D 3rdparties/software/cl+ssl-2019020… | 53 ------------------------------
D 3rdparties/software/cl+ssl-2019020… | 26 --------------------------
D 3rdparties/software/cl+ssl-2019020… | 825 -------------------------------
D 3rdparties/software/cl+ssl-2019020… | 66 -------------------------------
D 3rdparties/software/cl+ssl-2019020… | 33 -------------------------------
D 3rdparties/software/cl+ssl-2019020… | 77 -------------------------------
D 3rdparties/software/cl+ssl-2019020… | 480 -------------------------------
D 3rdparties/software/cl+ssl-2019020… | 109 -------------------------------
D 3rdparties/software/cl+ssl-2019020… | 224 -------------------------------
D 3rdparties/software/cl+ssl-2019020… | 166 -------------------------------
D 3rdparties/software/cl+ssl-2019020… | 409 -------------------------------
D 3rdparties/software/cl+ssl-2019020… | 46 -------------------------------
D 3rdparties/software/cl+ssl-2019020… | 0
D 3rdparties/software/cl+ssl-2019020… | 0
D 3rdparties/software/cl+ssl-2019020… | 0
D 3rdparties/software/cl+ssl-2019020… | 0
D 3rdparties/software/cl+ssl-2019020… | 0
D 3rdparties/software/cl+ssl-2019020… | 0
D 3rdparties/software/cl+ssl-2019020… | 0
D 3rdparties/software/cl+ssl-2019020… | 0
D 3rdparties/software/cl+ssl-2019020… | 11 -----------
D 3rdparties/software/cl+ssl-2019020… | 12 ------------
D 3rdparties/software/cl+ssl-2019020… | 18 ------------------
D 3rdparties/software/cl+ssl-2019020… | 13 -------------
D 3rdparties/software/cl+ssl-2019020… | 44 -------------------------------
D 3rdparties/software/cl+ssl-2019020… | 3 ---
D 3rdparties/software/cl+ssl-2019020… | 89 -------------------------------
D 3rdparties/software/cl+ssl-2019020… | 100 -------------------------------
D 3rdparties/software/cl+ssl-2019020… | 3 ---
D 3rdparties/software/cl+ssl-2019020… | 42 -------------------------------
D 3rdparties/software/cl+ssl-2019020… | 89 -------------------------------
D 3rdparties/software/cl+ssl-2019020… | 31 -------------------------------
D 3rdparties/software/flexi-streams-… | 297 -------------------------------
D 3rdparties/software/flexi-streams-… | 13 -------------
D 3rdparties/software/flexi-streams-… | 36 -------------------------------
D 3rdparties/software/flexi-streams-… | 62 -------------------------------
D 3rdparties/software/flexi-streams-… | 108 -------------------------------
D 3rdparties/software/flexi-streams-… | 468 -------------------------------
D 3rdparties/software/flexi-streams-… | 0
D 3rdparties/software/flexi-streams-… | 1119 -------------------------------
D 3rdparties/software/flexi-streams-… | 282 -------------------------------
D 3rdparties/software/flexi-streams-… | 389 -------------------------------
D 3rdparties/software/flexi-streams-… | 79 -------------------------------
D 3rdparties/software/flexi-streams-… | 442 -------------------------------
D 3rdparties/software/flexi-streams-… | 289 -------------------------------
D 3rdparties/software/flexi-streams-… | 111 ------------------------------
D 3rdparties/software/flexi-streams-… | 53 ------------------------------
D 3rdparties/software/flexi-streams-… | 36 -------------------------------
D 3rdparties/software/flexi-streams-… | 469 -------------------------------
D 3rdparties/software/flexi-streams-… | 77 -------------------------------
D 3rdparties/software/flexi-streams-… | 82 -------------------------------
D 3rdparties/software/flexi-streams-… | 162 ------------------------------
D 3rdparties/software/flexi-streams-… | 90 -------------------------------
D 3rdparties/software/flexi-streams-… | 199 -------------------------------
D 3rdparties/software/flexi-streams-… | 241 -------------------------------
D 3rdparties/software/flexi-streams-… | 82 -------------------------------
D 3rdparties/software/flexi-streams-… | 5 -----
D 3rdparties/software/flexi-streams-… | 2 --
D 3rdparties/software/flexi-streams-… | 68 -------------------------------
D 3rdparties/software/flexi-streams-… | 68 -------------------------------
D 3rdparties/software/flexi-streams-… | 2 --
D 3rdparties/software/flexi-streams-… | 68 -------------------------------
D 3rdparties/software/flexi-streams-… | 68 -------------------------------
D 3rdparties/software/flexi-streams-… | 2 --
D 3rdparties/software/flexi-streams-… | 11 -----------
D 3rdparties/software/flexi-streams-… | 11 -----------
D 3rdparties/software/flexi-streams-… | 2 --
D 3rdparties/software/flexi-streams-… | 11 -----------
D 3rdparties/software/flexi-streams-… | 11 -----------
D 3rdparties/software/flexi-streams-… | 2 --
D 3rdparties/software/flexi-streams-… | 11 -----------
D 3rdparties/software/flexi-streams-… | 11 -----------
D 3rdparties/software/flexi-streams-… | 41 -------------------------------
D 3rdparties/software/flexi-streams-… | 2 --
D 3rdparties/software/flexi-streams-… | 6 ------
D 3rdparties/software/flexi-streams-… | 6 ------
D 3rdparties/software/flexi-streams-… | 2 --
D 3rdparties/software/flexi-streams-… | 6 ------
D 3rdparties/software/flexi-streams-… | 6 ------
D 3rdparties/software/flexi-streams-… | 737 ------------------------------
D 3rdparties/software/flexi-streams-… | 2 --
D 3rdparties/software/flexi-streams-… | 96 -------------------------------
D 3rdparties/software/flexi-streams-… | 96 -------------------------------
D 3rdparties/software/flexi-streams-… | 2 --
D 3rdparties/software/flexi-streams-… | 96 -------------------------------
D 3rdparties/software/flexi-streams-… | 96 -------------------------------
D 3rdparties/software/flexi-streams-… | 0
D 3rdparties/software/flexi-streams-… | 0
D 3rdparties/software/flexi-streams-… | 0
D 3rdparties/software/flexi-streams-… | 0
D 3rdparties/software/flexi-streams-… | 0
D 3rdparties/software/flexi-streams-… | 0
D 3rdparties/software/flexi-streams-… | 0
D 3rdparties/software/flexi-streams-… | 0
D 3rdparties/software/flexi-streams-… | 0
D 3rdparties/software/flexi-streams-… | 0
D 3rdparties/software/flexi-streams-… | 0
D 3rdparties/software/flexi-streams-… | 0
D 3rdparties/software/flexi-streams-… | 2 --
D 3rdparties/software/flexi-streams-… | 212 ------------------------------
D 3rdparties/software/flexi-streams-… | 212 ------------------------------
D 3rdparties/software/flexi-streams-… | 206 -------------------------------
D 3rdparties/software/split-sequence… | 21 ---------------------
D 3rdparties/software/split-sequence… | 109 -------------------------------
D 3rdparties/software/split-sequence… | 23 -----------------------
D 3rdparties/software/split-sequence… | 172 ------------------------------
D 3rdparties/software/split-sequence… | 38 -------------------------------
D 3rdparties/software/split-sequence… | 2 --
D 3rdparties/software/trivial-featur… | 30 ------------------------------
D 3rdparties/software/trivial-featur… | 21 ---------------------
D 3rdparties/software/trivial-featur… | 32 -------------------------------
D 3rdparties/software/trivial-featur… | 86 ------------------------------
D 3rdparties/software/trivial-featur… | 247 -------------------------------
D 3rdparties/software/trivial-featur… | 47 -------------------------------
D 3rdparties/software/trivial-featur… | 49 -------------------------------
D 3rdparties/software/trivial-featur… | 36 -------------------------------
D 3rdparties/software/trivial-featur… | 72 -------------------------------
D 3rdparties/software/trivial-featur… | 44 -------------------------------
D 3rdparties/software/trivial-featur… | 39 -------------------------------
D 3rdparties/software/trivial-featur… | 55 -------------------------------
D 3rdparties/software/trivial-featur… | 58 ------------------------------
D 3rdparties/software/trivial-featur… | 41 -------------------------------
D 3rdparties/software/trivial-featur… | 49 -------------------------------
D 3rdparties/software/trivial-featur… | 40 -------------------------------
D 3rdparties/software/trivial-featur… | 47 -------------------------------
D 3rdparties/software/trivial-featur… | 51 -------------------------------
D 3rdparties/software/trivial-featur… | 47 -------------------------------
D 3rdparties/software/trivial-featur… | 39 -------------------------------
D 3rdparties/software/trivial-featur… | 34 -------------------------------
D 3rdparties/software/trivial-featur… | 49 -------------------------------
D 3rdparties/software/trivial-featur… | 130 -------------------------------
D 3rdparties/software/trivial-featur… | 36 -------------------------------
D 3rdparties/software/trivial-featur… | 50 -------------------------------
D 3rdparties/software/trivial-featur… | 57 -------------------------------
D 3rdparties/software/trivial-garbag… | 4 ----
D 3rdparties/software/trivial-garbag… | 26 --------------------------
D 3rdparties/software/trivial-garbag… | 12 ------------
D 3rdparties/software/trivial-garbag… | 1 -
D 3rdparties/software/trivial-garbag… | 178 -------------------------------
D 3rdparties/software/trivial-garbag… | 15 ---------------
D 3rdparties/software/trivial-garbag… | 250 -------------------------------
D 3rdparties/software/trivial-garbag… | 133 -------------------------------
D 3rdparties/software/trivial-garbag… | 29 -----------------------------
D 3rdparties/software/trivial-garbag… | 404 -------------------------------
D 3rdparties/software/uiop-3.3.2/REA… | 217 -------------------------------
D 3rdparties/software/uiop-3.3.2/asd… | 2 --
D 3rdparties/software/uiop-3.3.2/bac… | 68 -------------------------------
D 3rdparties/software/uiop-3.3.2/com… | 219 -------------------------------
D 3rdparties/software/uiop-3.3.2/con… | 413 -------------------------------
D 3rdparties/software/uiop-3.3.2/deb… | 118 -------------------------------
D 3rdparties/software/uiop-3.3.2/dri… | 19 -------------------
D 3rdparties/software/uiop-3.3.2/fil… | 681 ------------------------------
D 3rdparties/software/uiop-3.3.2/ima… | 483 -------------------------------
D 3rdparties/software/uiop-3.3.2/lau… | 682 -------------------------------
D 3rdparties/software/uiop-3.3.2/lis… | 800 -------------------------------
D 3rdparties/software/uiop-3.3.2/os.… | 403 -------------------------------
D 3rdparties/software/uiop-3.3.2/pac… | 742 -------------------------------
D 3rdparties/software/uiop-3.3.2/pat… | 741 -------------------------------
D 3rdparties/software/uiop-3.3.2/run… | 578 -------------------------------
D 3rdparties/software/uiop-3.3.2/str… | 718 -------------------------------
D 3rdparties/software/uiop-3.3.2/uio… | 50 -------------------------------
D 3rdparties/software/uiop-3.3.2/uti… | 652 -------------------------------
D 3rdparties/software/uiop-3.3.2/ver… | 181 -------------------------------
D 3rdparties/software/usocket-0.7.1/… | 1 -
D 3rdparties/software/usocket-0.7.1/… | 187 -------------------------------
D 3rdparties/software/usocket-0.7.1/… | 35 -------------------------------
D 3rdparties/software/usocket-0.7.1/… | 25 -------------------------
D 3rdparties/software/usocket-0.7.1/… | 144 -------------------------------
D 3rdparties/software/usocket-0.7.1/… | 5 -----
D 3rdparties/software/usocket-0.7.1/… | 1 -
D 3rdparties/software/usocket-0.7.1/… | 440 -------------------------------
D 3rdparties/software/usocket-0.7.1/… | 225 -------------------------------
D 3rdparties/software/usocket-0.7.1/… | 716 -------------------------------
D 3rdparties/software/usocket-0.7.1/… | 73 -------------------------------
D 3rdparties/software/usocket-0.7.1/… | 295 ------------------------------
D 3rdparties/software/usocket-0.7.1/… | 152 -------------------------------
D 3rdparties/software/usocket-0.7.1/… | 265 -------------------------------
D 3rdparties/software/usocket-0.7.1/… | 986 -------------------------------
D 3rdparties/software/usocket-0.7.1/… | 269 -------------------------------
D 3rdparties/software/usocket-0.7.1/… | 159 -------------------------------
D 3rdparties/software/usocket-0.7.1/… | 270 -------------------------------
D 3rdparties/software/usocket-0.7.1/… | 876 -------------------------------
D 3rdparties/software/usocket-0.7.1/… | 270 -------------------------------
D 3rdparties/software/usocket-0.7.1/… | 234 -------------------------------
D 3rdparties/software/usocket-0.7.1/… | 18 ------------------
D 3rdparties/software/usocket-0.7.1/… | 75 -------------------------------
D 3rdparties/software/usocket-0.7.1/… | 73 -------------------------------
D 3rdparties/software/usocket-0.7.1/… | 46 -------------------------------
D 3rdparties/software/usocket-0.7.1/… | 60 -------------------------------
D 3rdparties/software/usocket-0.7.1/… | 38 -------------------------------
D 3rdparties/software/usocket-0.7.1/… | 69 ------------------------------
D 3rdparties/software/usocket-0.7.1/… | 136 -------------------------------
D 3rdparties/software/usocket-0.7.1/… | 20 --------------------
D 3rdparties/software/usocket-0.7.1/… | 41 -------------------------------
D 3rdparties/software/usocket-0.7.1/… | 27 ---------------------------
D 3rdparties/software/usocket-0.7.1/… | 114 -------------------------------
D 3rdparties/software/usocket-0.7.1/… | 29 -----------------------------
D 3rdparties/software/usocket-0.7.1/… | 347 -------------------------------
D 3rdparties/software/usocket-0.7.1/… | 103 -------------------------------
D 3rdparties/software/usocket-0.7.1/… | 111 ------------------------------
D 3rdparties/software/usocket-0.7.1/… | 10 ----------
D 3rdparties/software/usocket-0.7.1/… | 27 ---------------------------
D 3rdparties/software/usocket-0.7.1/… | 123 -------------------------------
D 3rdparties/software/usocket-0.7.1/… | 178 -------------------------------
D 3rdparties/software/usocket-0.7.1/… | 139 ------------------------------
D 3rdparties/software/usocket-0.7.1/… | 14 --------------
D 3rdparties/software/usocket-0.7.1/… | 25 -------------------------
D 3rdparties/software/usocket-0.7.1/… | 45 -------------------------------
D 3rdparties/software/usocket-0.7.1/… | 705 -------------------------------
D 3rdparties/software/usocket-0.7.1/… | 146 -------------------------------
D 3rdparties/software/usocket-0.7.1/… | 506 -------------------------------
D 3rdparties/software/usocket-0.7.1/… | 1 -
M 3rdparties/system-index.txt | 50 ++++++++++++++++----------------
439 files changed, 32 insertions(+), 99869 deletions(-)
---
(DIR) diff --git a/3rdparties/bundle-info.sexp b/3rdparties/bundle-info.sexp
@@ -1,10 +1,10 @@
-(:CREATION-TIME "2019-03-01T11:39:38Z" :REQUESTED-SYSTEMS
+(:CREATION-TIME "2020-06-03T07:34:37Z" :REQUESTED-SYSTEMS
("usocket" "cl+ssl" "asdf") :LISP-INFO
- (:MACHINE-INSTANCE "solene.perso.local" :MACHINE-TYPE "amd64" :MACHINE-VERSION
- NIL :LISP-IMPLEMENTATION-TYPE "ECL" :LISP-IMPLEMENTATION-VERSION "16.1.3")
+ (:MACHINE-INSTANCE "t400.lan" :MACHINE-TYPE "amd64" :MACHINE-VERSION NIL
+ :LISP-IMPLEMENTATION-TYPE "ECL" :LISP-IMPLEMENTATION-VERSION "20.4.24")
:QUICKLISP-INFO
- (:HOME "/home/solene/.eclquicklisp/" :LOCAL-PROJECT-DIRECTORIES
- ("/home/solene/.eclquicklisp/local-projects/") :DISTS
+ (:HOME "/home/solene/quicklisp/" :LOCAL-PROJECT-DIRECTORIES
+ ("/home/solene/quicklisp/local-projects/") :DISTS
((:NAME "quicklisp" :DIST-URL
- "http://beta.quicklisp.org/dist/quicklisp/2019-02-02/distinfo.txt" :VERSION
- "2019-02-02"))))
+ "http://beta.quicklisp.org/dist/quicklisp/2020-04-27/distinfo.txt" :VERSION
+ "2020-04-27"))))
(DIR) diff --git a/3rdparties/software/alexandria-20181210-git/.boring b/3rdparties/software/alexandria-20181210-git/.boring
@@ -1,13 +0,0 @@
-# Boring file regexps:
-~$
-^_darcs
-^\{arch\}
-^.arch-ids
-\#
-\.dfsl$
-\.ppcf$
-\.fasl$
-\.x86f$
-\.fas$
-\.lib$
-^public_html
(DIR) diff --git a/3rdparties/software/alexandria-20181210-git/.gitignore b/3rdparties/software/alexandria-20181210-git/.gitignore
@@ -1,4 +0,0 @@
-*.fasl
-*~
-\#*
-*.patch
(DIR) diff --git a/3rdparties/software/alexandria-20181210-git/AUTHORS b/3rdparties/software/alexandria-20181210-git/AUTHORS
@@ -1,9 +0,0 @@
-
-ACTA EST FABULA PLAUDITE
-
-Nikodemus Siivola
-Attila Lendvai
-Marco Baringer
-Robert Strandh
-Luis Oliveira
-Tobias C. Rittweiler
-\ No newline at end of file
(DIR) diff --git a/3rdparties/software/alexandria-20181210-git/LICENCE b/3rdparties/software/alexandria-20181210-git/LICENCE
@@ -1,37 +0,0 @@
-Alexandria software and associated documentation are in the public
-domain:
-
- Authors dedicate this work to public domain, for the benefit of the
- public at large and to the detriment of the authors' heirs and
- successors. Authors intends this dedication to be an overt act of
- relinquishment in perpetuity of all present and future rights under
- copyright law, whether vested or contingent, in the work. Authors
- understands that such relinquishment of all rights includes the
- relinquishment of all rights to enforce (by lawsuit or otherwise)
- those copyrights in the work.
-
- Authors recognize that, once placed in the public domain, the work
- may be freely reproduced, distributed, transmitted, used, modified,
- built upon, or otherwise exploited by anyone for any purpose,
- commercial or non-commercial, and in any way, including by methods
- that have not yet been invented or conceived.
-
-In those legislations where public domain dedications are not
-recognized or possible, Alexandria is distributed under the following
-terms and conditions:
-
- Permission is hereby granted, free of charge, to any person
- obtaining a copy of this software and associated documentation files
- (the "Software"), to deal in the Software without restriction,
- including without limitation the rights to use, copy, modify, merge,
- publish, distribute, sublicense, and/or sell copies of the Software,
- and to permit persons to whom the Software is furnished to do so,
- subject to the following conditions:
-
- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
- EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
- IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
- CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
- TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
- SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
(DIR) diff --git a/3rdparties/software/alexandria-20181210-git/README b/3rdparties/software/alexandria-20181210-git/README
@@ -1,52 +0,0 @@
-Alexandria is a collection of portable public domain utilities that
-meet the following constraints:
-
- * Utilities, not extensions: Alexandria will not contain conceptual
- extensions to Common Lisp, instead limiting itself to tools and
- utilities that fit well within the framework of standard ANSI
- Common Lisp. Test-frameworks, system definitions, logging
- facilities, serialization layers, etc. are all outside the scope of
- Alexandria as a library, though well within the scope of Alexandria
- as a project.
-
- * Conservative: Alexandria limits itself to what project members
- consider conservative utilities. Alexandria does not and will not
- include anaphoric constructs, loop-like binding macros, etc.
-
- * Portable: Alexandria limits itself to portable parts of Common
- Lisp. Even apparently conservative and useful functions remain
- outside the scope of Alexandria if they cannot be implemented
- portably. Portability is here defined as portable within a
- conforming implementation: implementation bugs are not considered
- portability issues.
-
-Homepage:
-
- http://common-lisp.net/project/alexandria/
-
-Mailing lists:
-
- http://lists.common-lisp.net/mailman/listinfo/alexandria-devel
- http://lists.common-lisp.net/mailman/listinfo/alexandria-cvs
-
-Repository:
-
- git://common-lisp.net/projects/alexandria/alexandria.git
-
-Documentation:
-
- http://common-lisp.net/project/alexandria/draft/alexandria.html
-
- (To build docs locally: cd doc && make html pdf info)
-
-Patches:
-
- Patches are always welcome! Please send them to the mailing list as
- attachments, generated by "git format-patch -1".
-
- Patches should include a commit message that explains what's being
- done and /why/, and when fixing a bug or adding a feature you should
- also include a test-case.
-
- Be advised though that right now new features are unlikely to be
- accepted until 1.0 is officially out of the door.
(DIR) diff --git a/3rdparties/software/alexandria-20181210-git/alexandria-tests.asd b/3rdparties/software/alexandria-20181210-git/alexandria-tests.asd
@@ -1,11 +0,0 @@
-(defsystem "alexandria-tests"
- :licence "Public Domain / 0-clause MIT"
- :description "Tests for Alexandria, which is a collection of portable public domain utilities."
- :author "Nikodemus Siivola <nikodemus@sb-studio.net>, and others."
- :depends-on (:alexandria #+sbcl :sb-rt #-sbcl :rt)
- :components ((:file "tests"))
- :perform (test-op (o c)
- (flet ((run-tests (&rest args)
- (apply (intern (string '#:run-tests) '#:alexandria-tests) args)))
- (run-tests :compiled nil)
- (run-tests :compiled t))))
(DIR) diff --git a/3rdparties/software/alexandria-20181210-git/alexandria.asd b/3rdparties/software/alexandria-20181210-git/alexandria.asd
@@ -1,62 +0,0 @@
-(defsystem "alexandria"
- :version "0.0.0"
- :licence "Public Domain / 0-clause MIT"
- :description "Alexandria is a collection of portable public domain utilities."
- :author "Nikodemus Siivola <nikodemus@sb-studio.net>, and others."
- :long-description
- "Alexandria is a project and a library.
-
-As a project Alexandria's goal is to reduce duplication of effort and improve
-portability of Common Lisp code according to its own idiosyncratic and rather
-conservative aesthetic. What this actually means is open to debate, but each
-project member has a veto on all project activities, so a degree of
-conservativism is inevitable.
-
-As a library Alexandria is one of the means by which the project strives for
-its goals.
-
-Alexandria is a collection of portable public domain utilities that meet
-the following constraints:
-
- * Utilities, not extensions: Alexandria will not contain conceptual
- extensions to Common Lisp, instead limiting itself to tools and utilities
- that fit well within the framework of standard ANSI Common Lisp.
- Test-frameworks, system definitions, logging facilities, serialization
- layers, etc. are all outside the scope of Alexandria as a library, though
- well within the scope of Alexandria as a project.
-
- * Conservative: Alexandria limits itself to what project members consider
- conservative utilities. Alexandria does not and will not include anaphoric
- constructs, loop-like binding macros, etc.
-
- * Portable: Alexandria limits itself to portable parts of Common Lisp. Even
- apparently conservative and useful functions remain outside the scope of
- Alexandria if they cannot be implemented portably. Portability is here
- defined as portable within a conforming implementation: implementation bugs
- are not considered portability issues.
-
- * Team player: Alexandria will not (initially, at least) subsume or provide
- functionality for which good-quality special-purpose packages exist, like
- split-sequence. Instead, third party packages such as that may be
- \"blessed\"."
- :components
- ((:static-file "LICENCE")
- (:static-file "tests.lisp")
- (:file "package")
- (:file "definitions" :depends-on ("package"))
- (:file "binding" :depends-on ("package"))
- (:file "strings" :depends-on ("package"))
- (:file "conditions" :depends-on ("package"))
- (:file "io" :depends-on ("package" "macros" "lists" "types"))
- (:file "macros" :depends-on ("package" "strings" "symbols"))
- (:file "hash-tables" :depends-on ("package" "macros"))
- (:file "control-flow" :depends-on ("package" "definitions" "macros"))
- (:file "symbols" :depends-on ("package"))
- (:file "functions" :depends-on ("package" "symbols" "macros"))
- (:file "lists" :depends-on ("package" "functions"))
- (:file "types" :depends-on ("package" "symbols" "lists"))
- (:file "arrays" :depends-on ("package" "types"))
- (:file "sequences" :depends-on ("package" "lists" "types"))
- (:file "numbers" :depends-on ("package" "sequences"))
- (:file "features" :depends-on ("package" "control-flow")))
- :in-order-to ((test-op (test-op "alexandria-tests"))))
(DIR) diff --git a/3rdparties/software/alexandria-20181210-git/arrays.lisp b/3rdparties/software/alexandria-20181210-git/arrays.lisp
@@ -1,18 +0,0 @@
-(in-package :alexandria)
-
-(defun copy-array (array &key (element-type (array-element-type array))
- (fill-pointer (and (array-has-fill-pointer-p array)
- (fill-pointer array)))
- (adjustable (adjustable-array-p array)))
- "Returns an undisplaced copy of ARRAY, with same fill-pointer and
-adjustability (if any) as the original, unless overridden by the keyword
-arguments."
- (let* ((dimensions (array-dimensions array))
- (new-array (make-array dimensions
- :element-type element-type
- :adjustable adjustable
- :fill-pointer fill-pointer)))
- (dotimes (i (array-total-size array))
- (setf (row-major-aref new-array i)
- (row-major-aref array i)))
- new-array))
(DIR) diff --git a/3rdparties/software/alexandria-20181210-git/binding.lisp b/3rdparties/software/alexandria-20181210-git/binding.lisp
@@ -1,93 +0,0 @@
-(in-package :alexandria)
-
-(defmacro if-let (bindings &body (then-form &optional else-form))
- "Creates new variable bindings, and conditionally executes either
-THEN-FORM or ELSE-FORM. ELSE-FORM defaults to NIL.
-
-BINDINGS must be either single binding of the form:
-
- (variable initial-form)
-
-or a list of bindings of the form:
-
- ((variable-1 initial-form-1)
- (variable-2 initial-form-2)
- ...
- (variable-n initial-form-n))
-
-All initial-forms are executed sequentially in the specified order. Then all
-the variables are bound to the corresponding values.
-
-If all variables were bound to true values, the THEN-FORM is executed with the
-bindings in effect, otherwise the ELSE-FORM is executed with the bindings in
-effect."
- (let* ((binding-list (if (and (consp bindings) (symbolp (car bindings)))
- (list bindings)
- bindings))
- (variables (mapcar #'car binding-list)))
- `(let ,binding-list
- (if (and ,@variables)
- ,then-form
- ,else-form))))
-
-(defmacro when-let (bindings &body forms)
- "Creates new variable bindings, and conditionally executes FORMS.
-
-BINDINGS must be either single binding of the form:
-
- (variable initial-form)
-
-or a list of bindings of the form:
-
- ((variable-1 initial-form-1)
- (variable-2 initial-form-2)
- ...
- (variable-n initial-form-n))
-
-All initial-forms are executed sequentially in the specified order. Then all
-the variables are bound to the corresponding values.
-
-If all variables were bound to true values, then FORMS are executed as an
-implicit PROGN."
- (let* ((binding-list (if (and (consp bindings) (symbolp (car bindings)))
- (list bindings)
- bindings))
- (variables (mapcar #'car binding-list)))
- `(let ,binding-list
- (when (and ,@variables)
- ,@forms))))
-
-(defmacro when-let* (bindings &body body)
- "Creates new variable bindings, and conditionally executes BODY.
-
-BINDINGS must be either single binding of the form:
-
- (variable initial-form)
-
-or a list of bindings of the form:
-
- ((variable-1 initial-form-1)
- (variable-2 initial-form-2)
- ...
- (variable-n initial-form-n))
-
-Each INITIAL-FORM is executed in turn, and the variable bound to the
-corresponding value. INITIAL-FORM expressions can refer to variables
-previously bound by the WHEN-LET*.
-
-Execution of WHEN-LET* stops immediately if any INITIAL-FORM evaluates to NIL.
-If all INITIAL-FORMs evaluate to true, then BODY is executed as an implicit
-PROGN."
- (let ((binding-list (if (and (consp bindings) (symbolp (car bindings)))
- (list bindings)
- bindings)))
- (labels ((bind (bindings body)
- (if bindings
- `((let (,(car bindings))
- (when ,(caar bindings)
- ,@(bind (cdr bindings) body))))
- body)))
- `(let (,(car binding-list))
- (when ,(caar binding-list)
- ,@(bind (cdr binding-list) body))))))
-
(DIR) diff --git a/3rdparties/software/alexandria-20181210-git/conditions.lisp b/3rdparties/software/alexandria-20181210-git/conditions.lisp
@@ -1,91 +0,0 @@
-(in-package :alexandria)
-
-(defun required-argument (&optional name)
- "Signals an error for a missing argument of NAME. Intended for
-use as an initialization form for structure and class-slots, and
-a default value for required keyword arguments."
- (error "Required argument ~@[~S ~]missing." name))
-
-(define-condition simple-style-warning (simple-warning style-warning)
- ())
-
-(defun simple-style-warning (message &rest args)
- (warn 'simple-style-warning :format-control message :format-arguments args))
-
-;; We don't specify a :report for simple-reader-error to let the
-;; underlying implementation report the line and column position for
-;; us. Unfortunately this way the message from simple-error is not
-;; displayed, unless there's special support for that in the
-;; implementation. But even then it's still inspectable from the
-;; debugger...
-(define-condition simple-reader-error
- #-sbcl(simple-error reader-error)
- #+sbcl(sb-int:simple-reader-error)
- ())
-
-(defun simple-reader-error (stream message &rest args)
- (error 'simple-reader-error
- :stream stream
- :format-control message
- :format-arguments args))
-
-(define-condition simple-parse-error (simple-error parse-error)
- ())
-
-(defun simple-parse-error (message &rest args)
- (error 'simple-parse-error
- :format-control message
- :format-arguments args))
-
-(define-condition simple-program-error (simple-error program-error)
- ())
-
-(defun simple-program-error (message &rest args)
- (error 'simple-program-error
- :format-control message
- :format-arguments args))
-
-(defmacro ignore-some-conditions ((&rest conditions) &body body)
- "Similar to CL:IGNORE-ERRORS but the (unevaluated) CONDITIONS
-list determines which specific conditions are to be ignored."
- `(handler-case
- (progn ,@body)
- ,@(loop for condition in conditions collect
- `(,condition (c) (values nil c)))))
-
-(defmacro unwind-protect-case ((&optional abort-flag) protected-form &body clauses)
- "Like CL:UNWIND-PROTECT, but you can specify the circumstances that
-the cleanup CLAUSES are run.
-
- clauses ::= (:NORMAL form*)* | (:ABORT form*)* | (:ALWAYS form*)*
-
-Clauses can be given in any order, and more than one clause can be
-given for each circumstance. The clauses whose denoted circumstance
-occured, are executed in the order the clauses appear.
-
-ABORT-FLAG is the name of a variable that will be bound to T in
-CLAUSES if the PROTECTED-FORM aborted preemptively, and to NIL
-otherwise.
-
-Examples:
-
- (unwind-protect-case ()
- (protected-form)
- (:normal (format t \"This is only evaluated if PROTECTED-FORM executed normally.~%\"))
- (:abort (format t \"This is only evaluated if PROTECTED-FORM aborted preemptively.~%\"))
- (:always (format t \"This is evaluated in either case.~%\")))
-
- (unwind-protect-case (aborted-p)
- (protected-form)
- (:always (perform-cleanup-if aborted-p)))
-"
- (check-type abort-flag (or null symbol))
- (let ((gflag (gensym "FLAG+")))
- `(let ((,gflag t))
- (unwind-protect (multiple-value-prog1 ,protected-form (setf ,gflag nil))
- (let ,(and abort-flag `((,abort-flag ,gflag)))
- ,@(loop for (cleanup-kind . forms) in clauses
- collect (ecase cleanup-kind
- (:normal `(when (not ,gflag) ,@forms))
- (:abort `(when ,gflag ,@forms))
- (:always `(progn ,@forms)))))))))
-\ No newline at end of file
(DIR) diff --git a/3rdparties/software/alexandria-20181210-git/control-flow.lisp b/3rdparties/software/alexandria-20181210-git/control-flow.lisp
@@ -1,106 +0,0 @@
-(in-package :alexandria)
-
-(defun extract-function-name (spec)
- "Useful for macros that want to mimic the functional interface for functions
-like #'eq and 'eq."
- (if (and (consp spec)
- (member (first spec) '(quote function)))
- (second spec)
- spec))
-
-(defun generate-switch-body (whole object clauses test key &optional default)
- (with-gensyms (value)
- (setf test (extract-function-name test))
- (setf key (extract-function-name key))
- (when (and (consp default)
- (member (first default) '(error cerror)))
- (setf default `(,@default "No keys match in SWITCH. Testing against ~S with ~S."
- ,value ',test)))
- `(let ((,value (,key ,object)))
- (cond ,@(mapcar (lambda (clause)
- (if (member (first clause) '(t otherwise))
- (progn
- (when default
- (error "Multiple default clauses or illegal use of a default clause in ~S."
- whole))
- (setf default `(progn ,@(rest clause)))
- '(()))
- (destructuring-bind (key-form &body forms) clause
- `((,test ,value ,key-form)
- ,@forms))))
- clauses)
- (t ,default)))))
-
-(defmacro switch (&whole whole (object &key (test 'eql) (key 'identity))
- &body clauses)
- "Evaluates first matching clause, returning its values, or evaluates and
-returns the values of T or OTHERWISE if no keys match."
- (generate-switch-body whole object clauses test key))
-
-(defmacro eswitch (&whole whole (object &key (test 'eql) (key 'identity))
- &body clauses)
- "Like SWITCH, but signals an error if no key matches."
- (generate-switch-body whole object clauses test key '(error)))
-
-(defmacro cswitch (&whole whole (object &key (test 'eql) (key 'identity))
- &body clauses)
- "Like SWITCH, but signals a continuable error if no key matches."
- (generate-switch-body whole object clauses test key '(cerror "Return NIL from CSWITCH.")))
-
-(defmacro whichever (&rest possibilities &environment env)
- "Evaluates exactly one of POSSIBILITIES, chosen at random."
- (setf possibilities (mapcar (lambda (p) (macroexpand p env)) possibilities))
- (if (every (lambda (p) (constantp p)) possibilities)
- `(svref (load-time-value (vector ,@possibilities)) (random ,(length possibilities)))
- (labels ((expand (possibilities position random-number)
- (if (null (cdr possibilities))
- (car possibilities)
- (let* ((length (length possibilities))
- (half (truncate length 2))
- (second-half (nthcdr half possibilities))
- (first-half (butlast possibilities (- length half))))
- `(if (< ,random-number ,(+ position half))
- ,(expand first-half position random-number)
- ,(expand second-half (+ position half) random-number))))))
- (with-gensyms (random-number)
- (let ((length (length possibilities)))
- `(let ((,random-number (random ,length)))
- ,(expand possibilities 0 random-number)))))))
-
-(defmacro xor (&rest datums)
- "Evaluates its arguments one at a time, from left to right. If more than one
-argument evaluates to a true value no further DATUMS are evaluated, and NIL is
-returned as both primary and secondary value. If exactly one argument
-evaluates to true, its value is returned as the primary value after all the
-arguments have been evaluated, and T is returned as the secondary value. If no
-arguments evaluate to true NIL is retuned as primary, and T as secondary
-value."
- (with-gensyms (xor tmp true)
- `(let (,tmp ,true)
- (block ,xor
- ,@(mapcar (lambda (datum)
- `(if (setf ,tmp ,datum)
- (if ,true
- (return-from ,xor (values nil nil))
- (setf ,true ,tmp))))
- datums)
- (return-from ,xor (values ,true t))))))
-
-(defmacro nth-value-or (nth-value &body forms)
- "Evaluates FORM arguments one at a time, until the NTH-VALUE returned by one
-of the forms is true. It then returns all the values returned by evaluating
-that form. If none of the forms return a true nth value, this form returns
-NIL."
- (once-only (nth-value)
- (with-gensyms (values)
- `(let ((,values (multiple-value-list ,(first forms))))
- (if (nth ,nth-value ,values)
- (values-list ,values)
- ,(if (rest forms)
- `(nth-value-or ,nth-value ,@(rest forms))
- nil))))))
-
-(defmacro multiple-value-prog2 (first-form second-form &body forms)
- "Evaluates FIRST-FORM, then SECOND-FORM, and then FORMS. Yields as its value
-all the value returned by SECOND-FORM."
- `(progn ,first-form (multiple-value-prog1 ,second-form ,@forms)))
(DIR) diff --git a/3rdparties/software/alexandria-20181210-git/definitions.lisp b/3rdparties/software/alexandria-20181210-git/definitions.lisp
@@ -1,37 +0,0 @@
-(in-package :alexandria)
-
-(defun %reevaluate-constant (name value test)
- (if (not (boundp name))
- value
- (let ((old (symbol-value name))
- (new value))
- (if (not (constantp name))
- (prog1 new
- (cerror "Try to redefine the variable as a constant."
- "~@<~S is an already bound non-constant variable ~
- whose value is ~S.~:@>" name old))
- (if (funcall test old new)
- old
- (restart-case
- (error "~@<~S is an already defined constant whose value ~
- ~S is not equal to the provided initial value ~S ~
- under ~S.~:@>" name old new test)
- (ignore ()
- :report "Retain the current value."
- old)
- (continue ()
- :report "Try to redefine the constant."
- new)))))))
-
-(defmacro define-constant (name initial-value &key (test ''eql) documentation)
- "Ensures that the global variable named by NAME is a constant with a value
-that is equal under TEST to the result of evaluating INITIAL-VALUE. TEST is a
-/function designator/ that defaults to EQL. If DOCUMENTATION is given, it
-becomes the documentation string of the constant.
-
-Signals an error if NAME is already a bound non-constant variable.
-
-Signals an error if NAME is already a constant variable whose value is not
-equal under TEST to result of evaluating INITIAL-VALUE."
- `(defconstant ,name (%reevaluate-constant ',name ,initial-value ,test)
- ,@(when documentation `(,documentation))))
(DIR) diff --git a/3rdparties/software/alexandria-20181210-git/doc/.gitignore b/3rdparties/software/alexandria-20181210-git/doc/.gitignore
@@ -1,3 +0,0 @@
-alexandria
-include
-
(DIR) diff --git a/3rdparties/software/alexandria-20181210-git/doc/Makefile b/3rdparties/software/alexandria-20181210-git/doc/Makefile
@@ -1,28 +0,0 @@
-.PHONY: clean html pdf include clean-include clean-crap info doc
-
-doc: pdf html info clean-crap
-
-clean-include:
- rm -rf include
-
-clean-crap:
- rm -f *.aux *.cp *.fn *.fns *.ky *.log *.pg *.toc *.tp *.tps *.vr
-
-clean: clean-include
- rm -f *.pdf *.html *.info
-
-include:
- sbcl --no-userinit --eval '(require :asdf)' \
- --eval '(let ((asdf:*central-registry* (list "../"))) (require :alexandria))' \
- --load docstrings.lisp \
- --eval '(sb-texinfo:generate-includes "include/" (list :alexandria) :base-package :alexandria)' \
- --eval '(quit)'
-
-pdf: include
- texi2pdf alexandria.texinfo
-
-html: include
- makeinfo --html --no-split alexandria.texinfo
-
-info: include
- makeinfo alexandria.texinfo
(DIR) diff --git a/3rdparties/software/alexandria-20181210-git/doc/alexandria.texinfo b/3rdparties/software/alexandria-20181210-git/doc/alexandria.texinfo
@@ -1,277 +0,0 @@
-\input texinfo @c -*-texinfo-*-
-@c %**start of header
-@setfilename alexandria.info
-@settitle Alexandria Manual
-@c %**end of header
-
-@settitle Alexandria Manual -- draft version
-
-@c for install-info
-@dircategory Software development
-@direntry
-* alexandria: Common Lisp utilities.
-@end direntry
-
-@copying
-Alexandria software and associated documentation are in the public
-domain:
-
-@quotation
- Authors dedicate this work to public domain, for the benefit of the
- public at large and to the detriment of the authors' heirs and
- successors. Authors intends this dedication to be an overt act of
- relinquishment in perpetuity of all present and future rights under
- copyright law, whether vested or contingent, in the work. Authors
- understands that such relinquishment of all rights includes the
- relinquishment of all rights to enforce (by lawsuit or otherwise)
- those copyrights in the work.
-
- Authors recognize that, once placed in the public domain, the work
- may be freely reproduced, distributed, transmitted, used, modified,
- built upon, or otherwise exploited by anyone for any purpose,
- commercial or non-commercial, and in any way, including by methods
- that have not yet been invented or conceived.
-@end quotation
-
-In those legislations where public domain dedications are not
-recognized or possible, Alexandria is distributed under the following
-terms and conditions:
-
-@quotation
- Permission is hereby granted, free of charge, to any person
- obtaining a copy of this software and associated documentation files
- (the "Software"), to deal in the Software without restriction,
- including without limitation the rights to use, copy, modify, merge,
- publish, distribute, sublicense, and/or sell copies of the Software,
- and to permit persons to whom the Software is furnished to do so,
- subject to the following conditions:
-
- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
- EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
- IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
- CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
- TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
- SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
-@end quotation
-@end copying
-
-@titlepage
-
-@title Alexandria Manual
-@subtitle draft version
-
-@c The following two commands start the copyright page.
-@page
-@vskip 0pt plus 1filll
-@insertcopying
-
-@end titlepage
-
-@contents
-
-@ifnottex
-
-@include include/ifnottex.texinfo
-
-@node Top
-@comment node-name, next, previous, up
-@top Alexandria
-
-@insertcopying
-
-@menu
-* Hash Tables::
-* Data and Control Flow::
-* Conses::
-* Sequences::
-* IO::
-* Macro Writing::
-* Symbols::
-* Arrays::
-* Types::
-* Numbers::
-@end menu
-
-@end ifnottex
-
-@node Hash Tables
-@comment node-name, next, previous, up
-@chapter Hash Tables
-
-@include include/macro-alexandria-ensure-gethash.texinfo
-@include include/fun-alexandria-copy-hash-table.texinfo
-@include include/fun-alexandria-maphash-keys.texinfo
-@include include/fun-alexandria-maphash-values.texinfo
-@include include/fun-alexandria-hash-table-keys.texinfo
-@include include/fun-alexandria-hash-table-values.texinfo
-@include include/fun-alexandria-hash-table-alist.texinfo
-@include include/fun-alexandria-hash-table-plist.texinfo
-@include include/fun-alexandria-alist-hash-table.texinfo
-@include include/fun-alexandria-plist-hash-table.texinfo
-
-@node Data and Control Flow
-@comment node-name, next, previous, up
-@chapter Data and Control Flow
-
-@include include/macro-alexandria-define-constant.texinfo
-@include include/macro-alexandria-destructuring-case.texinfo
-@include include/macro-alexandria-ensure-functionf.texinfo
-@include include/macro-alexandria-multiple-value-prog2.texinfo
-@include include/macro-alexandria-named-lambda.texinfo
-@include include/macro-alexandria-nth-value-or.texinfo
-@include include/macro-alexandria-if-let.texinfo
-@include include/macro-alexandria-when-let.texinfo
-@include include/macro-alexandria-when-let-star.texinfo
-@include include/macro-alexandria-switch.texinfo
-@include include/macro-alexandria-cswitch.texinfo
-@include include/macro-alexandria-eswitch.texinfo
-@include include/macro-alexandria-whichever.texinfo
-@include include/macro-alexandria-xor.texinfo
-
-@include include/fun-alexandria-disjoin.texinfo
-@include include/fun-alexandria-conjoin.texinfo
-@include include/fun-alexandria-compose.texinfo
-@include include/fun-alexandria-ensure-function.texinfo
-@include include/fun-alexandria-multiple-value-compose.texinfo
-@include include/fun-alexandria-curry.texinfo
-@include include/fun-alexandria-rcurry.texinfo
-
-@node Conses
-@comment node-name, next, previous, up
-@chapter Conses
-
-@include include/type-alexandria-proper-list.texinfo
-@include include/type-alexandria-circular-list.texinfo
-
-@include include/macro-alexandria-appendf.texinfo
-@include include/macro-alexandria-nconcf.texinfo
-@include include/macro-alexandria-remove-from-plistf.texinfo
-@include include/macro-alexandria-delete-from-plistf.texinfo
-@include include/macro-alexandria-reversef.texinfo
-@include include/macro-alexandria-nreversef.texinfo
-@include include/macro-alexandria-unionf.texinfo
-@include include/macro-alexandria-nunionf.texinfo
-
-@include include/macro-alexandria-doplist.texinfo
-
-@include include/fun-alexandria-circular-list-p.texinfo
-@include include/fun-alexandria-circular-tree-p.texinfo
-@include include/fun-alexandria-proper-list-p.texinfo
-
-@include include/fun-alexandria-alist-plist.texinfo
-@include include/fun-alexandria-plist-alist.texinfo
-@include include/fun-alexandria-circular-list.texinfo
-@include include/fun-alexandria-make-circular-list.texinfo
-@include include/fun-alexandria-ensure-car.texinfo
-@include include/fun-alexandria-ensure-cons.texinfo
-@include include/fun-alexandria-ensure-list.texinfo
-@include include/fun-alexandria-flatten.texinfo
-@include include/fun-alexandria-lastcar.texinfo
-@include include/fun-alexandria-setf-lastcar.texinfo
-@include include/fun-alexandria-proper-list-length.texinfo
-@include include/fun-alexandria-mappend.texinfo
-@include include/fun-alexandria-map-product.texinfo
-@include include/fun-alexandria-remove-from-plist.texinfo
-@include include/fun-alexandria-delete-from-plist.texinfo
-@include include/fun-alexandria-set-equal.texinfo
-@include include/fun-alexandria-setp.texinfo
-
-@node Sequences
-@comment node-name, next, previous, up
-@chapter Sequences
-
-@include include/type-alexandria-proper-sequence.texinfo
-
-@include include/macro-alexandria-deletef.texinfo
-@include include/macro-alexandria-removef.texinfo
-
-@include include/fun-alexandria-rotate.texinfo
-@include include/fun-alexandria-shuffle.texinfo
-@include include/fun-alexandria-random-elt.texinfo
-@include include/fun-alexandria-emptyp.texinfo
-@include include/fun-alexandria-sequence-of-length-p.texinfo
-@include include/fun-alexandria-length-equals.texinfo
-@include include/fun-alexandria-copy-sequence.texinfo
-@include include/fun-alexandria-first-elt.texinfo
-@include include/fun-alexandria-setf-first-elt.texinfo
-@include include/fun-alexandria-last-elt.texinfo
-@include include/fun-alexandria-setf-last-elt.texinfo
-@include include/fun-alexandria-starts-with.texinfo
-@include include/fun-alexandria-starts-with-subseq.texinfo
-@include include/fun-alexandria-ends-with.texinfo
-@include include/fun-alexandria-ends-with-subseq.texinfo
-@include include/fun-alexandria-map-combinations.texinfo
-@include include/fun-alexandria-map-derangements.texinfo
-@include include/fun-alexandria-map-permutations.texinfo
-
-@node IO
-@comment node-name, next, previous, up
-@chapter IO
-
-@include include/fun-alexandria-read-stream-content-into-string.texinfo
-@include include/fun-alexandria-read-file-into-string.texinfo
-@include include/fun-alexandria-read-stream-content-into-byte-vector.texinfo
-@include include/fun-alexandria-read-file-into-byte-vector.texinfo
-
-@node Macro Writing
-@comment node-name, next, previous, up
-@chapter Macro Writing
-
-@include include/macro-alexandria-once-only.texinfo
-@include include/macro-alexandria-with-gensyms.texinfo
-@include include/macro-alexandria-with-unique-names.texinfo
-@include include/fun-alexandria-featurep.texinfo
-@include include/fun-alexandria-parse-body.texinfo
-@include include/fun-alexandria-parse-ordinary-lambda-list.texinfo
-
-@node Symbols
-@comment node-name, next, previous, up
-@chapter Symbols
-
-@include include/fun-alexandria-ensure-symbol.texinfo
-@include include/fun-alexandria-format-symbol.texinfo
-@include include/fun-alexandria-make-keyword.texinfo
-@include include/fun-alexandria-make-gensym.texinfo
-@include include/fun-alexandria-make-gensym-list.texinfo
-@include include/fun-alexandria-symbolicate.texinfo
-
-@node Arrays
-@comment node-name, next, previous, up
-@chapter Arrays
-
-@include include/type-alexandria-array-index.texinfo
-@include include/type-alexandria-array-length.texinfo
-@include include/fun-alexandria-copy-array.texinfo
-
-@node Types
-@comment node-name, next, previous, up
-@chapter Types
-
-@include include/type-alexandria-string-designator.texinfo
-@include include/macro-alexandria-coercef.texinfo
-@include include/fun-alexandria-of-type.texinfo
-@include include/fun-alexandria-type-equals.texinfo
-
-@node Numbers
-@comment node-name, next, previous, up
-@chapter Numbers
-
-@include include/macro-alexandria-maxf.texinfo
-@include include/macro-alexandria-minf.texinfo
-
-@include include/fun-alexandria-binomial-coefficient.texinfo
-@include include/fun-alexandria-count-permutations.texinfo
-@include include/fun-alexandria-clamp.texinfo
-@include include/fun-alexandria-lerp.texinfo
-@include include/fun-alexandria-factorial.texinfo
-@include include/fun-alexandria-subfactorial.texinfo
-@include include/fun-alexandria-gaussian-random.texinfo
-@include include/fun-alexandria-iota.texinfo
-@include include/fun-alexandria-map-iota.texinfo
-@include include/fun-alexandria-mean.texinfo
-@include include/fun-alexandria-median.texinfo
-@include include/fun-alexandria-variance.texinfo
-@include include/fun-alexandria-standard-deviation.texinfo
-
-@bye
(DIR) diff --git a/3rdparties/software/alexandria-20181210-git/doc/docstrings.lisp b/3rdparties/software/alexandria-20181210-git/doc/docstrings.lisp
@@ -1,881 +0,0 @@
-;;; -*- lisp -*-
-
-;;;; A docstring extractor for the sbcl manual. Creates
-;;;; @include-ready documentation from the docstrings of exported
-;;;; symbols of specified packages.
-
-;;;; This software is part of the SBCL software system. SBCL is in the
-;;;; public domain and is provided with absolutely no warranty. See
-;;;; the COPYING file for more information.
-;;;;
-;;;; Written by Rudi Schlatte <rudi@constantly.at>, mangled
-;;;; by Nikodemus Siivola.
-
-;;;; TODO
-;;;; * Verbatim text
-;;;; * Quotations
-;;;; * Method documentation untested
-;;;; * Method sorting, somehow
-;;;; * Index for macros & constants?
-;;;; * This is getting complicated enough that tests would be good
-;;;; * Nesting (currently only nested itemizations work)
-;;;; * doc -> internal form -> texinfo (so that non-texinfo format are also
-;;;; easily generated)
-
-;;;; FIXME: The description below is no longer complete. This
-;;;; should possibly be turned into a contrib with proper documentation.
-
-;;;; Formatting heuristics (tweaked to format SAVE-LISP-AND-DIE sanely):
-;;;;
-;;;; Formats SYMBOL as @code{symbol}, or @var{symbol} if symbol is in
-;;;; the argument list of the defun / defmacro.
-;;;;
-;;;; Lines starting with * or - that are followed by intented lines
-;;;; are marked up with @itemize.
-;;;;
-;;;; Lines containing only a SYMBOL that are followed by indented
-;;;; lines are marked up as @table @code, with the SYMBOL as the item.
-
-(eval-when (:compile-toplevel :load-toplevel :execute)
- (require 'sb-introspect))
-
-(defpackage :sb-texinfo
- (:use :cl :sb-mop)
- (:shadow #:documentation)
- (:export #:generate-includes #:document-package)
- (:documentation
- "Tools to generate TexInfo documentation from docstrings."))
-
-(in-package :sb-texinfo)
-
-;;;; various specials and parameters
-
-(defvar *texinfo-output*)
-(defvar *texinfo-variables*)
-(defvar *documentation-package*)
-(defvar *base-package*)
-
-(defparameter *undocumented-packages* '(sb-pcl sb-int sb-kernel sb-sys sb-c))
-
-(defparameter *documentation-types*
- '(compiler-macro
- function
- method-combination
- setf
- ;;structure ; also handled by `type'
- type
- variable)
- "A list of symbols accepted as second argument of `documentation'")
-
-(defparameter *character-replacements*
- '((#\* . "star") (#\/ . "slash") (#\+ . "plus")
- (#\< . "lt") (#\> . "gt")
- (#\= . "equals"))
- "Characters and their replacement names that `alphanumize' uses. If
-the replacements contain any of the chars they're supposed to replace,
-you deserve to lose.")
-
-(defparameter *characters-to-drop* '(#\\ #\` #\')
- "Characters that should be removed by `alphanumize'.")
-
-(defparameter *texinfo-escaped-chars* "@{}"
- "Characters that must be escaped with #\@ for Texinfo.")
-
-(defparameter *itemize-start-characters* '(#\* #\-)
- "Characters that might start an itemization in docstrings when
- at the start of a line.")
-
-(defparameter *symbol-characters* "ABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890*:-+&#'"
- "List of characters that make up symbols in a docstring.")
-
-(defparameter *symbol-delimiters* " ,.!?;")
-
-(defparameter *ordered-documentation-kinds*
- '(package type structure condition class macro))
-
-;;;; utilities
-
-(defun flatten (list)
- (cond ((null list)
- nil)
- ((consp (car list))
- (nconc (flatten (car list)) (flatten (cdr list))))
- ((null (cdr list))
- (cons (car list) nil))
- (t
- (cons (car list) (flatten (cdr list))))))
-
-(defun whitespacep (char)
- (find char #(#\tab #\space #\page)))
-
-(defun setf-name-p (name)
- (or (symbolp name)
- (and (listp name) (= 2 (length name)) (eq (car name) 'setf))))
-
-(defgeneric specializer-name (specializer))
-
-(defmethod specializer-name ((specializer eql-specializer))
- (list 'eql (eql-specializer-object specializer)))
-
-(defmethod specializer-name ((specializer class))
- (class-name specializer))
-
-(defun ensure-class-precedence-list (class)
- (unless (class-finalized-p class)
- (finalize-inheritance class))
- (class-precedence-list class))
-
-(defun specialized-lambda-list (method)
- ;; courtecy of AMOP p. 61
- (let* ((specializers (method-specializers method))
- (lambda-list (method-lambda-list method))
- (n-required (length specializers)))
- (append (mapcar (lambda (arg specializer)
- (if (eq specializer (find-class 't))
- arg
- `(,arg ,(specializer-name specializer))))
- (subseq lambda-list 0 n-required)
- specializers)
- (subseq lambda-list n-required))))
-
-(defun string-lines (string)
- "Lines in STRING as a vector."
- (coerce (with-input-from-string (s string)
- (loop for line = (read-line s nil nil)
- while line collect line))
- 'vector))
-
-(defun indentation (line)
- "Position of first non-SPACE character in LINE."
- (position-if-not (lambda (c) (char= c #\Space)) line))
-
-(defun docstring (x doc-type)
- (cl:documentation x doc-type))
-
-(defun flatten-to-string (list)
- (format nil "~{~A~^-~}" (flatten list)))
-
-(defun alphanumize (original)
- "Construct a string without characters like *`' that will f-star-ck
-up filename handling. See `*character-replacements*' and
-`*characters-to-drop*' for customization."
- (let ((name (remove-if (lambda (x) (member x *characters-to-drop*))
- (if (listp original)
- (flatten-to-string original)
- (string original))))
- (chars-to-replace (mapcar #'car *character-replacements*)))
- (flet ((replacement-delimiter (index)
- (cond ((or (< index 0) (>= index (length name))) "")
- ((alphanumericp (char name index)) "-")
- (t ""))))
- (loop for index = (position-if #'(lambda (x) (member x chars-to-replace))
- name)
- while index
- do (setf name (concatenate 'string (subseq name 0 index)
- (replacement-delimiter (1- index))
- (cdr (assoc (aref name index)
- *character-replacements*))
- (replacement-delimiter (1+ index))
- (subseq name (1+ index))))))
- name))
-
-;;;; generating various names
-
-(defgeneric name (thing)
- (:documentation "Name for a documented thing. Names are either
-symbols or lists of symbols."))
-
-(defmethod name ((symbol symbol))
- symbol)
-
-(defmethod name ((cons cons))
- cons)
-
-(defmethod name ((package package))
- (short-package-name package))
-
-(defmethod name ((method method))
- (list
- (generic-function-name (method-generic-function method))
- (method-qualifiers method)
- (specialized-lambda-list method)))
-
-;;; Node names for DOCUMENTATION instances
-
-(defgeneric name-using-kind/name (kind name doc))
-
-(defmethod name-using-kind/name (kind (name string) doc)
- (declare (ignore kind doc))
- name)
-
-(defmethod name-using-kind/name (kind (name symbol) doc)
- (declare (ignore kind))
- (format nil "~@[~A:~]~A" (short-package-name (get-package doc)) name))
-
-(defmethod name-using-kind/name (kind (name list) doc)
- (declare (ignore kind))
- (assert (setf-name-p name))
- (format nil "(setf ~@[~A:~]~A)" (short-package-name (get-package doc)) (second name)))
-
-(defmethod name-using-kind/name ((kind (eql 'method)) name doc)
- (format nil "~A~{ ~A~} ~A"
- (name-using-kind/name nil (first name) doc)
- (second name)
- (third name)))
-
-(defun node-name (doc)
- "Returns TexInfo node name as a string for a DOCUMENTATION instance."
- (let ((kind (get-kind doc)))
- (format nil "~:(~A~) ~(~A~)" kind (name-using-kind/name kind (get-name doc) doc))))
-
-(defun short-package-name (package)
- (unless (eq package *base-package*)
- (car (sort (copy-list (cons (package-name package) (package-nicknames package)))
- #'< :key #'length))))
-
-;;; Definition titles for DOCUMENTATION instances
-
-(defgeneric title-using-kind/name (kind name doc))
-
-(defmethod title-using-kind/name (kind (name string) doc)
- (declare (ignore kind doc))
- name)
-
-(defmethod title-using-kind/name (kind (name symbol) doc)
- (declare (ignore kind))
- (format nil "~@[~A:~]~A" (short-package-name (get-package doc)) name))
-
-(defmethod title-using-kind/name (kind (name list) doc)
- (declare (ignore kind))
- (assert (setf-name-p name))
- (format nil "(setf ~@[~A:~]~A)" (short-package-name (get-package doc)) (second name)))
-
-(defmethod title-using-kind/name ((kind (eql 'method)) name doc)
- (format nil "~{~A ~}~A"
- (second name)
- (title-using-kind/name nil (first name) doc)))
-
-(defun title-name (doc)
- "Returns a string to be used as name of the definition."
- (string-downcase (title-using-kind/name (get-kind doc) (get-name doc) doc)))
-
-(defun include-pathname (doc)
- (let* ((kind (get-kind doc))
- (name (nstring-downcase
- (if (eq 'package kind)
- (format nil "package-~A" (alphanumize (get-name doc)))
- (format nil "~A-~A-~A"
- (case (get-kind doc)
- ((function generic-function) "fun")
- (structure "struct")
- (variable "var")
- (otherwise (symbol-name (get-kind doc))))
- (alphanumize (let ((*base-package* nil))
- (short-package-name (get-package doc))))
- (alphanumize (get-name doc)))))))
- (make-pathname :name name :type "texinfo")))
-
-;;;; documentation class and related methods
-
-(defclass documentation ()
- ((name :initarg :name :reader get-name)
- (kind :initarg :kind :reader get-kind)
- (string :initarg :string :reader get-string)
- (children :initarg :children :initform nil :reader get-children)
- (package :initform *documentation-package* :reader get-package)))
-
-(defmethod print-object ((documentation documentation) stream)
- (print-unreadable-object (documentation stream :type t)
- (princ (list (get-kind documentation) (get-name documentation)) stream)))
-
-(defgeneric make-documentation (x doc-type string))
-
-(defmethod make-documentation ((x package) doc-type string)
- (declare (ignore doc-type))
- (make-instance 'documentation
- :name (name x)
- :kind 'package
- :string string))
-
-(defmethod make-documentation (x (doc-type (eql 'function)) string)
- (declare (ignore doc-type))
- (let* ((fdef (and (fboundp x) (fdefinition x)))
- (name x)
- (kind (cond ((and (symbolp x) (special-operator-p x))
- 'special-operator)
- ((and (symbolp x) (macro-function x))
- 'macro)
- ((typep fdef 'generic-function)
- (assert (or (symbolp name) (setf-name-p name)))
- 'generic-function)
- (fdef
- (assert (or (symbolp name) (setf-name-p name)))
- 'function)))
- (children (when (eq kind 'generic-function)
- (collect-gf-documentation fdef))))
- (make-instance 'documentation
- :name (name x)
- :string string
- :kind kind
- :children children)))
-
-(defmethod make-documentation ((x method) doc-type string)
- (declare (ignore doc-type))
- (make-instance 'documentation
- :name (name x)
- :kind 'method
- :string string))
-
-(defmethod make-documentation (x (doc-type (eql 'type)) string)
- (make-instance 'documentation
- :name (name x)
- :string string
- :kind (etypecase (find-class x nil)
- (structure-class 'structure)
- (standard-class 'class)
- (sb-pcl::condition-class 'condition)
- ((or built-in-class null) 'type))))
-
-(defmethod make-documentation (x (doc-type (eql 'variable)) string)
- (make-instance 'documentation
- :name (name x)
- :string string
- :kind (if (constantp x)
- 'constant
- 'variable)))
-
-(defmethod make-documentation (x (doc-type (eql 'setf)) string)
- (declare (ignore doc-type))
- (make-instance 'documentation
- :name (name x)
- :kind 'setf-expander
- :string string))
-
-(defmethod make-documentation (x doc-type string)
- (make-instance 'documentation
- :name (name x)
- :kind doc-type
- :string string))
-
-(defun maybe-documentation (x doc-type)
- "Returns a DOCUMENTATION instance for X and DOC-TYPE, or NIL if
-there is no corresponding docstring."
- (let ((docstring (docstring x doc-type)))
- (when docstring
- (make-documentation x doc-type docstring))))
-
-(defun lambda-list (doc)
- (case (get-kind doc)
- ((package constant variable type structure class condition nil)
- nil)
- (method
- (third (get-name doc)))
- (t
- ;; KLUDGE: Eugh.
- ;;
- ;; believe it or not, the above comment was written before CSR
- ;; came along and obfuscated this. (2005-07-04)
- (when (symbolp (get-name doc))
- (labels ((clean (x &key optional key)
- (typecase x
- (atom x)
- ((cons (member &optional))
- (cons (car x) (clean (cdr x) :optional t)))
- ((cons (member &key))
- (cons (car x) (clean (cdr x) :key t)))
- ((cons (member &whole &environment))
- ;; Skip these
- (clean (cdr x) :optional optional :key key))
- ((cons cons)
- (cons
- (cond (key (if (consp (caar x))
- (caaar x)
- (caar x)))
- (optional (caar x))
- (t (clean (car x))))
- (clean (cdr x) :key key :optional optional)))
- (cons
- (cons
- (cond ((or key optional) (car x))
- (t (clean (car x))))
- (clean (cdr x) :key key :optional optional))))))
- (clean (sb-introspect:function-lambda-list (get-name doc))))))))
-
-(defun get-string-name (x)
- (let ((name (get-name x)))
- (cond ((symbolp name)
- (symbol-name name))
- ((and (consp name) (eq 'setf (car name)))
- (symbol-name (second name)))
- ((stringp name)
- name)
- (t
- (error "Don't know which symbol to use for name ~S" name)))))
-
-(defun documentation< (x y)
- (let ((p1 (position (get-kind x) *ordered-documentation-kinds*))
- (p2 (position (get-kind y) *ordered-documentation-kinds*)))
- (if (or (not (and p1 p2)) (= p1 p2))
- (string< (get-string-name x) (get-string-name y))
- (< p1 p2))))
-
-;;;; turning text into texinfo
-
-(defun escape-for-texinfo (string &optional downcasep)
- "Return STRING with characters in *TEXINFO-ESCAPED-CHARS* escaped
-with #\@. Optionally downcase the result."
- (let ((result (with-output-to-string (s)
- (loop for char across string
- when (find char *texinfo-escaped-chars*)
- do (write-char #\@ s)
- do (write-char char s)))))
- (if downcasep (nstring-downcase result) result)))
-
-(defun empty-p (line-number lines)
- (and (< -1 line-number (length lines))
- (not (indentation (svref lines line-number)))))
-
-;;; line markups
-
-(defvar *not-symbols* '("ANSI" "CLHS"))
-
-(defun locate-symbols (line)
- "Return a list of index pairs of symbol-like parts of LINE."
- ;; This would be a good application for a regex ...
- (let (result)
- (flet ((grab (start end)
- (unless (member (subseq line start end) '("ANSI" "CLHS"))
- (push (list start end) result))))
- (do ((begin nil)
- (maybe-begin t)
- (i 0 (1+ i)))
- ((= i (length line))
- ;; symbol at end of line
- (when (and begin (or (> i (1+ begin))
- (not (member (char line begin) '(#\A #\I)))))
- (grab begin i))
- (nreverse result))
- (cond
- ((and begin (find (char line i) *symbol-delimiters*))
- ;; symbol end; remember it if it's not "A" or "I"
- (when (or (> i (1+ begin)) (not (member (char line begin) '(#\A #\I))))
- (grab begin i))
- (setf begin nil
- maybe-begin t))
- ((and begin (not (find (char line i) *symbol-characters*)))
- ;; Not a symbol: abort
- (setf begin nil))
- ((and maybe-begin (not begin) (find (char line i) *symbol-characters*))
- ;; potential symbol begin at this position
- (setf begin i
- maybe-begin nil))
- ((find (char line i) *symbol-delimiters*)
- ;; potential symbol begin after this position
- (setf maybe-begin t))
- (t
- ;; Not reading a symbol, not at potential start of symbol
- (setf maybe-begin nil)))))))
-
-(defun texinfo-line (line)
- "Format symbols in LINE texinfo-style: either as code or as
-variables if the symbol in question is contained in symbols
-*TEXINFO-VARIABLES*."
- (with-output-to-string (result)
- (let ((last 0))
- (dolist (symbol/index (locate-symbols line))
- (write-string (subseq line last (first symbol/index)) result)
- (let ((symbol-name (apply #'subseq line symbol/index)))
- (format result (if (member symbol-name *texinfo-variables*
- :test #'string=)
- "@var{~A}"
- "@code{~A}")
- (string-downcase symbol-name)))
- (setf last (second symbol/index)))
- (write-string (subseq line last) result))))
-
-;;; lisp sections
-
-(defun lisp-section-p (line line-number lines)
- "Returns T if the given LINE looks like start of lisp code --
-ie. if it starts with whitespace followed by a paren or
-semicolon, and the previous line is empty"
- (let ((offset (indentation line)))
- (and offset
- (plusp offset)
- (find (find-if-not #'whitespacep line) "(;")
- (empty-p (1- line-number) lines))))
-
-(defun collect-lisp-section (lines line-number)
- (let ((lisp (loop for index = line-number then (1+ index)
- for line = (and (< index (length lines)) (svref lines index))
- while (indentation line)
- collect line)))
- (values (length lisp) `("@lisp" ,@lisp "@end lisp"))))
-
-;;; itemized sections
-
-(defun maybe-itemize-offset (line)
- "Return NIL or the indentation offset if LINE looks like it starts
-an item in an itemization."
- (let* ((offset (indentation line))
- (char (when offset (char line offset))))
- (and offset
- (member char *itemize-start-characters* :test #'char=)
- (char= #\Space (find-if-not (lambda (c) (char= c char))
- line :start offset))
- offset)))
-
-(defun collect-maybe-itemized-section (lines starting-line)
- ;; Return index of next line to be processed outside
- (let ((this-offset (maybe-itemize-offset (svref lines starting-line)))
- (result nil)
- (lines-consumed 0))
- (loop for line-number from starting-line below (length lines)
- for line = (svref lines line-number)
- for indentation = (indentation line)
- for offset = (maybe-itemize-offset line)
- do (cond
- ((not indentation)
- ;; empty line -- inserts paragraph.
- (push "" result)
- (incf lines-consumed))
- ((and offset (> indentation this-offset))
- ;; nested itemization -- handle recursively
- ;; FIXME: tables in itemizations go wrong
- (multiple-value-bind (sub-lines-consumed sub-itemization)
- (collect-maybe-itemized-section lines line-number)
- (when sub-lines-consumed
- (incf line-number (1- sub-lines-consumed)) ; +1 on next loop
- (incf lines-consumed sub-lines-consumed)
- (setf result (nconc (nreverse sub-itemization) result)))))
- ((and offset (= indentation this-offset))
- ;; start of new item
- (push (format nil "@item ~A"
- (texinfo-line (subseq line (1+ offset))))
- result)
- (incf lines-consumed))
- ((and (not offset) (> indentation this-offset))
- ;; continued item from previous line
- (push (texinfo-line line) result)
- (incf lines-consumed))
- (t
- ;; end of itemization
- (loop-finish))))
- ;; a single-line itemization isn't.
- (if (> (count-if (lambda (line) (> (length line) 0)) result) 1)
- (values lines-consumed `("@itemize" ,@(reverse result) "@end itemize"))
- nil)))
-
-;;; table sections
-
-(defun tabulation-body-p (offset line-number lines)
- (when (< line-number (length lines))
- (let ((offset2 (indentation (svref lines line-number))))
- (and offset2 (< offset offset2)))))
-
-(defun tabulation-p (offset line-number lines direction)
- (let ((step (ecase direction
- (:backwards (1- line-number))
- (:forwards (1+ line-number)))))
- (when (and (plusp line-number) (< line-number (length lines)))
- (and (eql offset (indentation (svref lines line-number)))
- (or (when (eq direction :backwards)
- (empty-p step lines))
- (tabulation-p offset step lines direction)
- (tabulation-body-p offset step lines))))))
-
-(defun maybe-table-offset (line-number lines)
- "Return NIL or the indentation offset if LINE looks like it starts
-an item in a tabulation. Ie, if it is (1) indented, (2) preceded by an
-empty line, another tabulation label, or a tabulation body, (3) and
-followed another tabulation label or a tabulation body."
- (let* ((line (svref lines line-number))
- (offset (indentation line))
- (prev (1- line-number))
- (next (1+ line-number)))
- (when (and offset (plusp offset))
- (and (or (empty-p prev lines)
- (tabulation-body-p offset prev lines)
- (tabulation-p offset prev lines :backwards))
- (or (tabulation-body-p offset next lines)
- (tabulation-p offset next lines :forwards))
- offset))))
-
-;;; FIXME: This and itemization are very similar: could they share
-;;; some code, mayhap?
-
-(defun collect-maybe-table-section (lines starting-line)
- ;; Return index of next line to be processed outside
- (let ((this-offset (maybe-table-offset starting-line lines))
- (result nil)
- (lines-consumed 0))
- (loop for line-number from starting-line below (length lines)
- for line = (svref lines line-number)
- for indentation = (indentation line)
- for offset = (maybe-table-offset line-number lines)
- do (cond
- ((not indentation)
- ;; empty line -- inserts paragraph.
- (push "" result)
- (incf lines-consumed))
- ((and offset (= indentation this-offset))
- ;; start of new item, or continuation of previous item
- (if (and result (search "@item" (car result) :test #'char=))
- (push (format nil "@itemx ~A" (texinfo-line line))
- result)
- (progn
- (push "" result)
- (push (format nil "@item ~A" (texinfo-line line))
- result)))
- (incf lines-consumed))
- ((> indentation this-offset)
- ;; continued item from previous line
- (push (texinfo-line line) result)
- (incf lines-consumed))
- (t
- ;; end of itemization
- (loop-finish))))
- ;; a single-line table isn't.
- (if (> (count-if (lambda (line) (> (length line) 0)) result) 1)
- (values lines-consumed
- `("" "@table @emph" ,@(reverse result) "@end table" ""))
- nil)))
-
-;;; section markup
-
-(defmacro with-maybe-section (index &rest forms)
- `(multiple-value-bind (count collected) (progn ,@forms)
- (when count
- (dolist (line collected)
- (write-line line *texinfo-output*))
- (incf ,index (1- count)))))
-
-(defun write-texinfo-string (string &optional lambda-list)
- "Try to guess as much formatting for a raw docstring as possible."
- (let ((*texinfo-variables* (flatten lambda-list))
- (lines (string-lines (escape-for-texinfo string nil))))
- (loop for line-number from 0 below (length lines)
- for line = (svref lines line-number)
- do (cond
- ((with-maybe-section line-number
- (and (lisp-section-p line line-number lines)
- (collect-lisp-section lines line-number))))
- ((with-maybe-section line-number
- (and (maybe-itemize-offset line)
- (collect-maybe-itemized-section lines line-number))))
- ((with-maybe-section line-number
- (and (maybe-table-offset line-number lines)
- (collect-maybe-table-section lines line-number))))
- (t
- (write-line (texinfo-line line) *texinfo-output*))))))
-
-;;;; texinfo formatting tools
-
-(defun hide-superclass-p (class-name super-name)
- (let ((super-package (symbol-package super-name)))
- (or
- ;; KLUDGE: We assume that we don't want to advertise internal
- ;; classes in CP-lists, unless the symbol we're documenting is
- ;; internal as well.
- (and (member super-package #.'(mapcar #'find-package *undocumented-packages*))
- (not (eq super-package (symbol-package class-name))))
- ;; KLUDGE: We don't generally want to advertise SIMPLE-ERROR or
- ;; SIMPLE-CONDITION in the CPLs of conditions that inherit them
- ;; simply as a matter of convenience. The assumption here is that
- ;; the inheritance is incidental unless the name of the condition
- ;; begins with SIMPLE-.
- (and (member super-name '(simple-error simple-condition))
- (let ((prefix "SIMPLE-"))
- (mismatch prefix (string class-name) :end2 (length prefix)))
- t ; don't return number from MISMATCH
- ))))
-
-(defun hide-slot-p (symbol slot)
- ;; FIXME: There is no pricipal reason to avoid the slot docs fo
- ;; structures and conditions, but their DOCUMENTATION T doesn't
- ;; currently work with them the way we'd like.
- (not (and (typep (find-class symbol nil) 'standard-class)
- (docstring slot t))))
-
-(defun texinfo-anchor (doc)
- (format *texinfo-output* "@anchor{~A}~%" (node-name doc)))
-
-;;; KLUDGE: &AUX *PRINT-PRETTY* here means "no linebreaks please"
-(defun texinfo-begin (doc &aux *print-pretty*)
- (let ((kind (get-kind doc)))
- (format *texinfo-output* "@~A {~:(~A~)} ~({~A}~@[ ~{~A~^ ~}~]~)~%"
- (case kind
- ((package constant variable)
- "defvr")
- ((structure class condition type)
- "deftp")
- (t
- "deffn"))
- (map 'string (lambda (char) (if (eql char #\-) #\Space char)) (string kind))
- (title-name doc)
- ;; &foo would be amusingly bold in the pdf thanks to TeX/Texinfo
- ;; interactions,so we escape the ampersand -- amusingly for TeX.
- ;; sbcl.texinfo defines macros that expand @&key and friends to &key.
- (mapcar (lambda (name)
- (if (member name lambda-list-keywords)
- (format nil "@~A" name)
- name))
- (lambda-list doc)))))
-
-(defun texinfo-index (doc)
- (let ((title (title-name doc)))
- (case (get-kind doc)
- ((structure type class condition)
- (format *texinfo-output* "@tindex ~A~%" title))
- ((variable constant)
- (format *texinfo-output* "@vindex ~A~%" title))
- ((compiler-macro function method-combination macro generic-function)
- (format *texinfo-output* "@findex ~A~%" title)))))
-
-(defun texinfo-inferred-body (doc)
- (when (member (get-kind doc) '(class structure condition))
- (let ((name (get-name doc)))
- ;; class precedence list
- (format *texinfo-output* "Class precedence list: @code{~(~{@lw{~A}~^, ~}~)}~%~%"
- (remove-if (lambda (class) (hide-superclass-p name class))
- (mapcar #'class-name (ensure-class-precedence-list (find-class name)))))
- ;; slots
- (let ((slots (remove-if (lambda (slot) (hide-slot-p name slot))
- (class-direct-slots (find-class name)))))
- (when slots
- (format *texinfo-output* "Slots:~%@itemize~%")
- (dolist (slot slots)
- (format *texinfo-output*
- "@item ~(@code{~A}~#[~:; --- ~]~
- ~:{~2*~@[~2:*~A~P: ~{@code{@w{~S}}~^, ~}~]~:^; ~}~)~%~%"
- (slot-definition-name slot)
- (remove
- nil
- (mapcar
- (lambda (name things)
- (if things
- (list name (length things) things)))
- '("initarg" "reader" "writer")
- (list
- (slot-definition-initargs slot)
- (slot-definition-readers slot)
- (slot-definition-writers slot)))))
- ;; FIXME: Would be neater to handler as children
- (write-texinfo-string (docstring slot t)))
- (format *texinfo-output* "@end itemize~%~%"))))))
-
-(defun texinfo-body (doc)
- (write-texinfo-string (get-string doc)))
-
-(defun texinfo-end (doc)
- (write-line (case (get-kind doc)
- ((package variable constant) "@end defvr")
- ((structure type class condition) "@end deftp")
- (t "@end deffn"))
- *texinfo-output*))
-
-(defun write-texinfo (doc)
- "Writes TexInfo for a DOCUMENTATION instance to *TEXINFO-OUTPUT*."
- (texinfo-anchor doc)
- (texinfo-begin doc)
- (texinfo-index doc)
- (texinfo-inferred-body doc)
- (texinfo-body doc)
- (texinfo-end doc)
- ;; FIXME: Children should be sorted one way or another
- (mapc #'write-texinfo (get-children doc)))
-
-;;;; main logic
-
-(defun collect-gf-documentation (gf)
- "Collects method documentation for the generic function GF"
- (loop for method in (generic-function-methods gf)
- for doc = (maybe-documentation method t)
- when doc
- collect doc))
-
-(defun collect-name-documentation (name)
- (loop for type in *documentation-types*
- for doc = (maybe-documentation name type)
- when doc
- collect doc))
-
-(defun collect-symbol-documentation (symbol)
- "Collects all docs for a SYMBOL and (SETF SYMBOL), returns a list of
-the form DOC instances. See `*documentation-types*' for the possible
-values of doc-type."
- (nconc (collect-name-documentation symbol)
- (collect-name-documentation (list 'setf symbol))))
-
-(defun collect-documentation (package)
- "Collects all documentation for all external symbols of the given
-package, as well as for the package itself."
- (let* ((*documentation-package* (find-package package))
- (docs nil))
- (check-type package package)
- (do-external-symbols (symbol package)
- (setf docs (nconc (collect-symbol-documentation symbol) docs)))
- (let ((doc (maybe-documentation *documentation-package* t)))
- (when doc
- (push doc docs)))
- docs))
-
-(defmacro with-texinfo-file (pathname &body forms)
- `(with-open-file (*texinfo-output* ,pathname
- :direction :output
- :if-does-not-exist :create
- :if-exists :supersede)
- ,@forms))
-
-(defun write-ifnottex ()
- ;; We use @&key, etc to escape & from TeX in lambda lists -- so we need to
- ;; define them for info as well.
- (flet ((macro (name)
- (let ((string (string-downcase name)))
- (format *texinfo-output* "@macro ~A~%~A~%@end macro~%" string string))))
- (macro '&allow-other-keys)
- (macro '&optional)
- (macro '&rest)
- (macro '&key)
- (macro '&body)))
-
-(defun generate-includes (directory packages &key (base-package :cl-user))
- "Create files in `directory' containing Texinfo markup of all
-docstrings of each exported symbol in `packages'. `directory' is
-created if necessary. If you supply a namestring that doesn't end in a
-slash, you lose. The generated files are of the form
-\"<doc-type>_<packagename>_<symbol-name>.texinfo\" and can be included
-via @include statements. Texinfo syntax-significant characters are
-escaped in symbol names, but if a docstring contains invalid Texinfo
-markup, you lose."
- (handler-bind ((warning #'muffle-warning))
- (let ((directory (merge-pathnames (pathname directory)))
- (*base-package* (find-package base-package)))
- (ensure-directories-exist directory)
- (dolist (package packages)
- (dolist (doc (collect-documentation (find-package package)))
- (with-texinfo-file (merge-pathnames (include-pathname doc) directory)
- (write-texinfo doc))))
- (with-texinfo-file (merge-pathnames "ifnottex.texinfo" directory)
- (write-ifnottex))
- directory)))
-
-(defun document-package (package &optional filename)
- "Create a file containing all available documentation for the
-exported symbols of `package' in Texinfo format. If `filename' is not
-supplied, a file \"<packagename>.texinfo\" is generated.
-
-The definitions can be referenced using Texinfo statements like
-@ref{<doc-type>_<packagename>_<symbol-name>.texinfo}. Texinfo
-syntax-significant characters are escaped in symbol names, but if a
-docstring contains invalid Texinfo markup, you lose."
- (handler-bind ((warning #'muffle-warning))
- (let* ((package (find-package package))
- (filename (or filename (make-pathname
- :name (string-downcase (short-package-name package))
- :type "texinfo")))
- (docs (sort (collect-documentation package) #'documentation<)))
- (with-texinfo-file filename
- (dolist (doc docs)
- (write-texinfo doc)))
- filename)))
(DIR) diff --git a/3rdparties/software/alexandria-20181210-git/features.lisp b/3rdparties/software/alexandria-20181210-git/features.lisp
@@ -1,14 +0,0 @@
-(in-package :alexandria)
-
-(defun featurep (feature-expression)
- "Returns T if the argument matches the state of the *FEATURES*
-list and NIL if it does not. FEATURE-EXPRESSION can be any atom
-or list acceptable to the reader macros #+ and #-."
- (etypecase feature-expression
- (symbol (not (null (member feature-expression *features*))))
- (cons (check-type (first feature-expression) symbol)
- (eswitch ((first feature-expression) :test 'string=)
- (:and (every #'featurep (rest feature-expression)))
- (:or (some #'featurep (rest feature-expression)))
- (:not (assert (= 2 (length feature-expression)))
- (not (featurep (second feature-expression))))))))
(DIR) diff --git a/3rdparties/software/alexandria-20181210-git/functions.lisp b/3rdparties/software/alexandria-20181210-git/functions.lisp
@@ -1,161 +0,0 @@
-(in-package :alexandria)
-
-;;; To propagate return type and allow the compiler to eliminate the IF when
-;;; it is known if the argument is function or not.
-(declaim (inline ensure-function))
-
-(declaim (ftype (function (t) (values function &optional))
- ensure-function))
-(defun ensure-function (function-designator)
- "Returns the function designated by FUNCTION-DESIGNATOR:
-if FUNCTION-DESIGNATOR is a function, it is returned, otherwise
-it must be a function name and its FDEFINITION is returned."
- (if (functionp function-designator)
- function-designator
- (fdefinition function-designator)))
-
-(define-modify-macro ensure-functionf/1 () ensure-function)
-
-(defmacro ensure-functionf (&rest places)
- "Multiple-place modify macro for ENSURE-FUNCTION: ensures that each of
-PLACES contains a function."
- `(progn ,@(mapcar (lambda (x) `(ensure-functionf/1 ,x)) places)))
-
-(defun disjoin (predicate &rest more-predicates)
- "Returns a function that applies each of PREDICATE and MORE-PREDICATE
-functions in turn to its arguments, returning the primary value of the first
-predicate that returns true, without calling the remaining predicates.
-If none of the predicates returns true, NIL is returned."
- (declare (optimize (speed 3) (safety 1) (debug 1)))
- (let ((predicate (ensure-function predicate))
- (more-predicates (mapcar #'ensure-function more-predicates)))
- (lambda (&rest arguments)
- (or (apply predicate arguments)
- (some (lambda (p)
- (declare (type function p))
- (apply p arguments))
- more-predicates)))))
-
-(defun conjoin (predicate &rest more-predicates)
- "Returns a function that applies each of PREDICATE and MORE-PREDICATE
-functions in turn to its arguments, returning NIL if any of the predicates
-returns false, without calling the remaining predicates. If none of the
-predicates returns false, returns the primary value of the last predicate."
- (if (null more-predicates)
- predicate
- (lambda (&rest arguments)
- (and (apply predicate arguments)
- ;; Cannot simply use CL:EVERY because we want to return the
- ;; non-NIL value of the last predicate if all succeed.
- (do ((tail (cdr more-predicates) (cdr tail))
- (head (car more-predicates) (car tail)))
- ((not tail)
- (apply head arguments))
- (unless (apply head arguments)
- (return nil)))))))
-
-
-(defun compose (function &rest more-functions)
- "Returns a function composed of FUNCTION and MORE-FUNCTIONS that applies its
-arguments to to each in turn, starting from the rightmost of MORE-FUNCTIONS,
-and then calling the next one with the primary value of the last."
- (declare (optimize (speed 3) (safety 1) (debug 1)))
- (reduce (lambda (f g)
- (let ((f (ensure-function f))
- (g (ensure-function g)))
- (lambda (&rest arguments)
- (declare (dynamic-extent arguments))
- (funcall f (apply g arguments)))))
- more-functions
- :initial-value function))
-
-(define-compiler-macro compose (function &rest more-functions)
- (labels ((compose-1 (funs)
- (if (cdr funs)
- `(funcall ,(car funs) ,(compose-1 (cdr funs)))
- `(apply ,(car funs) arguments))))
- (let* ((args (cons function more-functions))
- (funs (make-gensym-list (length args) "COMPOSE")))
- `(let ,(loop for f in funs for arg in args
- collect `(,f (ensure-function ,arg)))
- (declare (optimize (speed 3) (safety 1) (debug 1)))
- (lambda (&rest arguments)
- (declare (dynamic-extent arguments))
- ,(compose-1 funs))))))
-
-(defun multiple-value-compose (function &rest more-functions)
- "Returns a function composed of FUNCTION and MORE-FUNCTIONS that applies
-its arguments to each in turn, starting from the rightmost of
-MORE-FUNCTIONS, and then calling the next one with all the return values of
-the last."
- (declare (optimize (speed 3) (safety 1) (debug 1)))
- (reduce (lambda (f g)
- (let ((f (ensure-function f))
- (g (ensure-function g)))
- (lambda (&rest arguments)
- (declare (dynamic-extent arguments))
- (multiple-value-call f (apply g arguments)))))
- more-functions
- :initial-value function))
-
-(define-compiler-macro multiple-value-compose (function &rest more-functions)
- (labels ((compose-1 (funs)
- (if (cdr funs)
- `(multiple-value-call ,(car funs) ,(compose-1 (cdr funs)))
- `(apply ,(car funs) arguments))))
- (let* ((args (cons function more-functions))
- (funs (make-gensym-list (length args) "MV-COMPOSE")))
- `(let ,(mapcar #'list funs args)
- (declare (optimize (speed 3) (safety 1) (debug 1)))
- (lambda (&rest arguments)
- (declare (dynamic-extent arguments))
- ,(compose-1 funs))))))
-
-(declaim (inline curry rcurry))
-
-(defun curry (function &rest arguments)
- "Returns a function that applies ARGUMENTS and the arguments
-it is called with to FUNCTION."
- (declare (optimize (speed 3) (safety 1)))
- (let ((fn (ensure-function function)))
- (lambda (&rest more)
- (declare (dynamic-extent more))
- ;; Using M-V-C we don't need to append the arguments.
- (multiple-value-call fn (values-list arguments) (values-list more)))))
-
-(define-compiler-macro curry (function &rest arguments)
- (let ((curries (make-gensym-list (length arguments) "CURRY"))
- (fun (gensym "FUN")))
- `(let ((,fun (ensure-function ,function))
- ,@(mapcar #'list curries arguments))
- (declare (optimize (speed 3) (safety 1)))
- (lambda (&rest more)
- (declare (dynamic-extent more))
- (apply ,fun ,@curries more)))))
-
-(defun rcurry (function &rest arguments)
- "Returns a function that applies the arguments it is called
-with and ARGUMENTS to FUNCTION."
- (declare (optimize (speed 3) (safety 1)))
- (let ((fn (ensure-function function)))
- (lambda (&rest more)
- (declare (dynamic-extent more))
- (multiple-value-call fn (values-list more) (values-list arguments)))))
-
-(define-compiler-macro rcurry (function &rest arguments)
- (let ((rcurries (make-gensym-list (length arguments) "RCURRY"))
- (fun (gensym "FUN")))
- `(let ((,fun (ensure-function ,function))
- ,@(mapcar #'list rcurries arguments))
- (declare (optimize (speed 3) (safety 1)))
- (lambda (&rest more)
- (declare (dynamic-extent more))
- (multiple-value-call ,fun (values-list more) ,@rcurries)))))
-
-(declaim (notinline curry rcurry))
-
-(defmacro named-lambda (name lambda-list &body body)
- "Expands into a lambda-expression within whose BODY NAME denotes the
-corresponding function."
- `(labels ((,name ,lambda-list ,@body))
- #',name))
(DIR) diff --git a/3rdparties/software/alexandria-20181210-git/hash-tables.lisp b/3rdparties/software/alexandria-20181210-git/hash-tables.lisp
@@ -1,101 +0,0 @@
-(in-package :alexandria)
-
-(defmacro ensure-gethash (key hash-table &optional default)
- "Like GETHASH, but if KEY is not found in the HASH-TABLE saves the DEFAULT
-under key before returning it. Secondary return value is true if key was
-already in the table."
- (once-only (key hash-table)
- (with-unique-names (value presentp)
- `(multiple-value-bind (,value ,presentp) (gethash ,key ,hash-table)
- (if ,presentp
- (values ,value ,presentp)
- (values (setf (gethash ,key ,hash-table) ,default) nil))))))
-
-(defun copy-hash-table (table &key key test size
- rehash-size rehash-threshold)
- "Returns a copy of hash table TABLE, with the same keys and values
-as the TABLE. The copy has the same properties as the original, unless
-overridden by the keyword arguments.
-
-Before each of the original values is set into the new hash-table, KEY
-is invoked on the value. As KEY defaults to CL:IDENTITY, a shallow
-copy is returned by default."
- (setf key (or key 'identity))
- (setf test (or test (hash-table-test table)))
- (setf size (or size (hash-table-size table)))
- (setf rehash-size (or rehash-size (hash-table-rehash-size table)))
- (setf rehash-threshold (or rehash-threshold (hash-table-rehash-threshold table)))
- (let ((copy (make-hash-table :test test :size size
- :rehash-size rehash-size
- :rehash-threshold rehash-threshold)))
- (maphash (lambda (k v)
- (setf (gethash k copy) (funcall key v)))
- table)
- copy))
-
-(declaim (inline maphash-keys))
-(defun maphash-keys (function table)
- "Like MAPHASH, but calls FUNCTION with each key in the hash table TABLE."
- (maphash (lambda (k v)
- (declare (ignore v))
- (funcall function k))
- table))
-
-(declaim (inline maphash-values))
-(defun maphash-values (function table)
- "Like MAPHASH, but calls FUNCTION with each value in the hash table TABLE."
- (maphash (lambda (k v)
- (declare (ignore k))
- (funcall function v))
- table))
-
-(defun hash-table-keys (table)
- "Returns a list containing the keys of hash table TABLE."
- (let ((keys nil))
- (maphash-keys (lambda (k)
- (push k keys))
- table)
- keys))
-
-(defun hash-table-values (table)
- "Returns a list containing the values of hash table TABLE."
- (let ((values nil))
- (maphash-values (lambda (v)
- (push v values))
- table)
- values))
-
-(defun hash-table-alist (table)
- "Returns an association list containing the keys and values of hash table
-TABLE."
- (let ((alist nil))
- (maphash (lambda (k v)
- (push (cons k v) alist))
- table)
- alist))
-
-(defun hash-table-plist (table)
- "Returns a property list containing the keys and values of hash table
-TABLE."
- (let ((plist nil))
- (maphash (lambda (k v)
- (setf plist (list* k v plist)))
- table)
- plist))
-
-(defun alist-hash-table (alist &rest hash-table-initargs)
- "Returns a hash table containing the keys and values of the association list
-ALIST. Hash table is initialized using the HASH-TABLE-INITARGS."
- (let ((table (apply #'make-hash-table hash-table-initargs)))
- (dolist (cons alist)
- (ensure-gethash (car cons) table (cdr cons)))
- table))
-
-(defun plist-hash-table (plist &rest hash-table-initargs)
- "Returns a hash table containing the keys and values of the property list
-PLIST. Hash table is initialized using the HASH-TABLE-INITARGS."
- (let ((table (apply #'make-hash-table hash-table-initargs)))
- (do ((tail plist (cddr tail)))
- ((not tail))
- (ensure-gethash (car tail) table (cadr tail)))
- table))
(DIR) diff --git a/3rdparties/software/alexandria-20181210-git/io.lisp b/3rdparties/software/alexandria-20181210-git/io.lisp
@@ -1,172 +0,0 @@
-;; Copyright (c) 2002-2006, Edward Marco Baringer
-;; All rights reserved.
-
-(in-package :alexandria)
-
-(defmacro with-open-file* ((stream filespec &key direction element-type
- if-exists if-does-not-exist external-format)
- &body body)
- "Just like WITH-OPEN-FILE, but NIL values in the keyword arguments mean to use
-the default value specified for OPEN."
- (once-only (direction element-type if-exists if-does-not-exist external-format)
- `(with-open-stream
- (,stream (apply #'open ,filespec
- (append
- (when ,direction
- (list :direction ,direction))
- (when ,element-type
- (list :element-type ,element-type))
- (when ,if-exists
- (list :if-exists ,if-exists))
- (when ,if-does-not-exist
- (list :if-does-not-exist ,if-does-not-exist))
- (when ,external-format
- (list :external-format ,external-format)))))
- ,@body)))
-
-(defmacro with-input-from-file ((stream-name file-name &rest args
- &key (direction nil direction-p)
- &allow-other-keys)
- &body body)
- "Evaluate BODY with STREAM-NAME to an input stream on the file
-FILE-NAME. ARGS is sent as is to the call to OPEN except EXTERNAL-FORMAT,
-which is only sent to WITH-OPEN-FILE when it's not NIL."
- (declare (ignore direction))
- (when direction-p
- (error "Can't specify :DIRECTION for WITH-INPUT-FROM-FILE."))
- `(with-open-file* (,stream-name ,file-name :direction :input ,@args)
- ,@body))
-
-(defmacro with-output-to-file ((stream-name file-name &rest args
- &key (direction nil direction-p)
- &allow-other-keys)
- &body body)
- "Evaluate BODY with STREAM-NAME to an output stream on the file
-FILE-NAME. ARGS is sent as is to the call to OPEN except EXTERNAL-FORMAT,
-which is only sent to WITH-OPEN-FILE when it's not NIL."
- (declare (ignore direction))
- (when direction-p
- (error "Can't specify :DIRECTION for WITH-OUTPUT-TO-FILE."))
- `(with-open-file* (,stream-name ,file-name :direction :output ,@args)
- ,@body))
-
-(defun read-stream-content-into-string (stream &key (buffer-size 4096))
- "Return the \"content\" of STREAM as a fresh string."
- (check-type buffer-size positive-integer)
- (let ((*print-pretty* nil))
- (with-output-to-string (datum)
- (let ((buffer (make-array buffer-size :element-type 'character)))
- (loop
- :for bytes-read = (read-sequence buffer stream)
- :do (write-sequence buffer datum :start 0 :end bytes-read)
- :while (= bytes-read buffer-size))))))
-
-(defun read-file-into-string (pathname &key (buffer-size 4096) external-format)
- "Return the contents of the file denoted by PATHNAME as a fresh string.
-
-The EXTERNAL-FORMAT parameter will be passed directly to WITH-OPEN-FILE
-unless it's NIL, which means the system default."
- (with-input-from-file
- (file-stream pathname :external-format external-format)
- (read-stream-content-into-string file-stream :buffer-size buffer-size)))
-
-(defun write-string-into-file (string pathname &key (if-exists :error)
- if-does-not-exist
- external-format)
- "Write STRING to PATHNAME.
-
-The EXTERNAL-FORMAT parameter will be passed directly to WITH-OPEN-FILE
-unless it's NIL, which means the system default."
- (with-output-to-file (file-stream pathname :if-exists if-exists
- :if-does-not-exist if-does-not-exist
- :external-format external-format)
- (write-sequence string file-stream)))
-
-(defun read-stream-content-into-byte-vector (stream &key ((%length length))
- (initial-size 4096))
- "Return \"content\" of STREAM as freshly allocated (unsigned-byte 8) vector."
- (check-type length (or null non-negative-integer))
- (check-type initial-size positive-integer)
- (do ((buffer (make-array (or length initial-size)
- :element-type '(unsigned-byte 8)))
- (offset 0)
- (offset-wanted 0))
- ((or (/= offset-wanted offset)
- (and length (>= offset length)))
- (if (= offset (length buffer))
- buffer
- (subseq buffer 0 offset)))
- (unless (zerop offset)
- (let ((new-buffer (make-array (* 2 (length buffer))
- :element-type '(unsigned-byte 8))))
- (replace new-buffer buffer)
- (setf buffer new-buffer)))
- (setf offset-wanted (length buffer)
- offset (read-sequence buffer stream :start offset))))
-
-(defun read-file-into-byte-vector (pathname)
- "Read PATHNAME into a freshly allocated (unsigned-byte 8) vector."
- (with-input-from-file (stream pathname :element-type '(unsigned-byte 8))
- (read-stream-content-into-byte-vector stream '%length (file-length stream))))
-
-(defun write-byte-vector-into-file (bytes pathname &key (if-exists :error)
- if-does-not-exist)
- "Write BYTES to PATHNAME."
- (check-type bytes (vector (unsigned-byte 8)))
- (with-output-to-file (stream pathname :if-exists if-exists
- :if-does-not-exist if-does-not-exist
- :element-type '(unsigned-byte 8))
- (write-sequence bytes stream)))
-
-(defun copy-file (from to &key (if-to-exists :supersede)
- (element-type '(unsigned-byte 8)) finish-output)
- (with-input-from-file (input from :element-type element-type)
- (with-output-to-file (output to :element-type element-type
- :if-exists if-to-exists)
- (copy-stream input output
- :element-type element-type
- :finish-output finish-output))))
-
-(defun copy-stream (input output &key (element-type (stream-element-type input))
- (buffer-size 4096)
- (buffer (make-array buffer-size :element-type element-type))
- (start 0) end
- finish-output)
- "Reads data from INPUT and writes it to OUTPUT. Both INPUT and OUTPUT must
-be streams, they will be passed to READ-SEQUENCE and WRITE-SEQUENCE and must have
-compatible element-types."
- (check-type start non-negative-integer)
- (check-type end (or null non-negative-integer))
- (check-type buffer-size positive-integer)
- (when (and end
- (< end start))
- (error "END is smaller than START in ~S" 'copy-stream))
- (let ((output-position 0)
- (input-position 0))
- (unless (zerop start)
- ;; FIXME add platform specific optimization to skip seekable streams
- (loop while (< input-position start)
- do (let ((n (read-sequence buffer input
- :end (min (length buffer)
- (- start input-position)))))
- (when (zerop n)
- (error "~@<Could not read enough bytes from the input to fulfill ~
- the :START ~S requirement in ~S.~:@>" 'copy-stream start))
- (incf input-position n))))
- (assert (= input-position start))
- (loop while (or (null end) (< input-position end))
- do (let ((n (read-sequence buffer input
- :end (when end
- (min (length buffer)
- (- end input-position))))))
- (when (zerop n)
- (if end
- (error "~@<Could not read enough bytes from the input to fulfill ~
- the :END ~S requirement in ~S.~:@>" 'copy-stream end)
- (return)))
- (incf input-position n)
- (write-sequence buffer output :end n)
- (incf output-position n)))
- (when finish-output
- (finish-output output))
- output-position))
(DIR) diff --git a/3rdparties/software/alexandria-20181210-git/lists.lisp b/3rdparties/software/alexandria-20181210-git/lists.lisp
@@ -1,367 +0,0 @@
-(in-package :alexandria)
-
-(declaim (inline safe-endp))
-(defun safe-endp (x)
- (declare (optimize safety))
- (endp x))
-
-(defun alist-plist (alist)
- "Returns a property list containing the same keys and values as the
-association list ALIST in the same order."
- (let (plist)
- (dolist (pair alist)
- (push (car pair) plist)
- (push (cdr pair) plist))
- (nreverse plist)))
-
-(defun plist-alist (plist)
- "Returns an association list containing the same keys and values as the
-property list PLIST in the same order."
- (let (alist)
- (do ((tail plist (cddr tail)))
- ((safe-endp tail) (nreverse alist))
- (push (cons (car tail) (cadr tail)) alist))))
-
-(declaim (inline racons))
-(defun racons (key value ralist)
- (acons value key ralist))
-
-(macrolet
- ((define-alist-get (name get-entry get-value-from-entry add doc)
- `(progn
- (declaim (inline ,name))
- (defun ,name (alist key &key (test 'eql))
- ,doc
- (let ((entry (,get-entry key alist :test test)))
- (values (,get-value-from-entry entry) entry)))
- (define-setf-expander ,name (place key &key (test ''eql)
- &environment env)
- (multiple-value-bind
- (temporary-variables initforms newvals setter getter)
- (get-setf-expansion place env)
- (when (cdr newvals)
- (error "~A cannot store multiple values in one place" ',name))
- (with-unique-names (new-value key-val test-val alist entry)
- (values
- (append temporary-variables
- (list alist
- key-val
- test-val
- entry))
- (append initforms
- (list getter
- key
- test
- `(,',get-entry ,key-val ,alist :test ,test-val)))
- `(,new-value)
- `(cond
- (,entry
- (setf (,',get-value-from-entry ,entry) ,new-value))
- (t
- (let ,newvals
- (setf ,(first newvals) (,',add ,key ,new-value ,alist))
- ,setter
- ,new-value)))
- `(,',get-value-from-entry ,entry))))))))
- (define-alist-get assoc-value assoc cdr acons
-"ASSOC-VALUE is an alist accessor very much like ASSOC, but it can
-be used with SETF.")
- (define-alist-get rassoc-value rassoc car racons
-"RASSOC-VALUE is an alist accessor very much like RASSOC, but it can
-be used with SETF."))
-
-(defun malformed-plist (plist)
- (error "Malformed plist: ~S" plist))
-
-(defmacro doplist ((key val plist &optional values) &body body)
- "Iterates over elements of PLIST. BODY can be preceded by
-declarations, and is like a TAGBODY. RETURN may be used to terminate
-the iteration early. If RETURN is not used, returns VALUES."
- (multiple-value-bind (forms declarations) (parse-body body)
- (with-gensyms (tail loop results)
- `(block nil
- (flet ((,results ()
- (let (,key ,val)
- (declare (ignorable ,key ,val))
- (return ,values))))
- (let* ((,tail ,plist)
- (,key (if ,tail
- (pop ,tail)
- (,results)))
- (,val (if ,tail
- (pop ,tail)
- (malformed-plist ',plist))))
- (declare (ignorable ,key ,val))
- ,@declarations
- (tagbody
- ,loop
- ,@forms
- (setf ,key (if ,tail
- (pop ,tail)
- (,results))
- ,val (if ,tail
- (pop ,tail)
- (malformed-plist ',plist)))
- (go ,loop))))))))
-
-(define-modify-macro appendf (&rest lists) append
- "Modify-macro for APPEND. Appends LISTS to the place designated by the first
-argument.")
-
-(define-modify-macro nconcf (&rest lists) nconc
- "Modify-macro for NCONC. Concatenates LISTS to place designated by the first
-argument.")
-
-(define-modify-macro unionf (list &rest args) union
- "Modify-macro for UNION. Saves the union of LIST and the contents of the
-place designated by the first argument to the designated place.")
-
-(define-modify-macro nunionf (list &rest args) nunion
- "Modify-macro for NUNION. Saves the union of LIST and the contents of the
-place designated by the first argument to the designated place. May modify
-either argument.")
-
-(define-modify-macro reversef () reverse
- "Modify-macro for REVERSE. Copies and reverses the list stored in the given
-place and saves back the result into the place.")
-
-(define-modify-macro nreversef () nreverse
- "Modify-macro for NREVERSE. Reverses the list stored in the given place by
-destructively modifying it and saves back the result into the place.")
-
-(defun circular-list (&rest elements)
- "Creates a circular list of ELEMENTS."
- (let ((cycle (copy-list elements)))
- (nconc cycle cycle)))
-
-(defun circular-list-p (object)
- "Returns true if OBJECT is a circular list, NIL otherwise."
- (and (listp object)
- (do ((fast object (cddr fast))
- (slow (cons (car object) (cdr object)) (cdr slow)))
- (nil)
- (unless (and (consp fast) (listp (cdr fast)))
- (return nil))
- (when (eq fast slow)
- (return t)))))
-
-(defun circular-tree-p (object)
- "Returns true if OBJECT is a circular tree, NIL otherwise."
- (labels ((circularp (object seen)
- (and (consp object)
- (do ((fast (cons (car object) (cdr object)) (cddr fast))
- (slow object (cdr slow)))
- (nil)
- (when (or (eq fast slow) (member slow seen))
- (return-from circular-tree-p t))
- (when (or (not (consp fast)) (not (consp (cdr slow))))
- (return
- (do ((tail object (cdr tail)))
- ((not (consp tail))
- nil)
- (let ((elt (car tail)))
- (circularp elt (cons object seen))))))))))
- (circularp object nil)))
-
-(defun proper-list-p (object)
- "Returns true if OBJECT is a proper list."
- (cond ((not object)
- t)
- ((consp object)
- (do ((fast object (cddr fast))
- (slow (cons (car object) (cdr object)) (cdr slow)))
- (nil)
- (unless (and (listp fast) (consp (cdr fast)))
- (return (and (listp fast) (not (cdr fast)))))
- (when (eq fast slow)
- (return nil))))
- (t
- nil)))
-
-(deftype proper-list ()
- "Type designator for proper lists. Implemented as a SATISFIES type, hence
-not recommended for performance intensive use. Main usefullness as a type
-designator of the expected type in a TYPE-ERROR."
- `(and list (satisfies proper-list-p)))
-
-(defun circular-list-error (list)
- (error 'type-error
- :datum list
- :expected-type '(and list (not circular-list))))
-
-(macrolet ((def (name lambda-list doc step declare ret1 ret2)
- (assert (member 'list lambda-list))
- `(defun ,name ,lambda-list
- ,doc
- (do ((last list fast)
- (fast list (cddr fast))
- (slow (cons (car list) (cdr list)) (cdr slow))
- ,@(when step (list step)))
- (nil)
- (declare (dynamic-extent slow) ,@(when declare (list declare))
- (ignorable last))
- (when (safe-endp fast)
- (return ,ret1))
- (when (safe-endp (cdr fast))
- (return ,ret2))
- (when (eq fast slow)
- (circular-list-error list))))))
- (def proper-list-length (list)
- "Returns length of LIST, signalling an error if it is not a proper list."
- (n 1 (+ n 2))
- ;; KLUDGE: Most implementations don't actually support lists with bignum
- ;; elements -- and this is WAY faster on most implementations then declaring
- ;; N to be an UNSIGNED-BYTE.
- (fixnum n)
- (1- n)
- n)
-
- (def lastcar (list)
- "Returns the last element of LIST. Signals a type-error if LIST is not a
-proper list."
- nil
- nil
- (cadr last)
- (car fast))
-
- (def (setf lastcar) (object list)
- "Sets the last element of LIST. Signals a type-error if LIST is not a proper
-list."
- nil
- nil
- (setf (cadr last) object)
- (setf (car fast) object)))
-
-(defun make-circular-list (length &key initial-element)
- "Creates a circular list of LENGTH with the given INITIAL-ELEMENT."
- (let ((cycle (make-list length :initial-element initial-element)))
- (nconc cycle cycle)))
-
-(deftype circular-list ()
- "Type designator for circular lists. Implemented as a SATISFIES type, so not
-recommended for performance intensive use. Main usefullness as the
-expected-type designator of a TYPE-ERROR."
- `(satisfies circular-list-p))
-
-(defun ensure-car (thing)
- "If THING is a CONS, its CAR is returned. Otherwise THING is returned."
- (if (consp thing)
- (car thing)
- thing))
-
-(defun ensure-cons (cons)
- "If CONS is a cons, it is returned. Otherwise returns a fresh cons with CONS
- in the car, and NIL in the cdr."
- (if (consp cons)
- cons
- (cons cons nil)))
-
-(defun ensure-list (list)
- "If LIST is a list, it is returned. Otherwise returns the list designated by LIST."
- (if (listp list)
- list
- (list list)))
-
-(defun remove-from-plist (plist &rest keys)
- "Returns a propery-list with same keys and values as PLIST, except that keys
-in the list designated by KEYS and values corresponding to them are removed.
-The returned property-list may share structure with the PLIST, but PLIST is
-not destructively modified. Keys are compared using EQ."
- (declare (optimize (speed 3)))
- ;; FIXME: possible optimization: (remove-from-plist '(:x 0 :a 1 :b 2) :a)
- ;; could return the tail without consing up a new list.
- (loop for (key . rest) on plist by #'cddr
- do (assert rest () "Expected a proper plist, got ~S" plist)
- unless (member key keys :test #'eq)
- collect key and collect (first rest)))
-
-(defun delete-from-plist (plist &rest keys)
- "Just like REMOVE-FROM-PLIST, but this version may destructively modify the
-provided PLIST."
- (declare (optimize speed))
- (loop with head = plist
- with tail = nil ; a nil tail means an empty result so far
- for (key . rest) on plist by #'cddr
- do (assert rest () "Expected a proper plist, got ~S" plist)
- (if (member key keys :test #'eq)
- ;; skip over this pair
- (let ((next (cdr rest)))
- (if tail
- (setf (cdr tail) next)
- (setf head next)))
- ;; keep this pair
- (setf tail rest))
- finally (return head)))
-
-(define-modify-macro remove-from-plistf (&rest keys) remove-from-plist
- "Modify macro for REMOVE-FROM-PLIST.")
-(define-modify-macro delete-from-plistf (&rest keys) delete-from-plist
- "Modify macro for DELETE-FROM-PLIST.")
-
-(declaim (inline sans))
-(defun sans (plist &rest keys)
- "Alias of REMOVE-FROM-PLIST for backward compatibility."
- (apply #'remove-from-plist plist keys))
-
-(defun mappend (function &rest lists)
- "Applies FUNCTION to respective element(s) of each LIST, appending all the
-all the result list to a single list. FUNCTION must return a list."
- (loop for results in (apply #'mapcar function lists)
- append results))
-
-(defun setp (object &key (test #'eql) (key #'identity))
- "Returns true if OBJECT is a list that denotes a set, NIL otherwise. A list
-denotes a set if each element of the list is unique under KEY and TEST."
- (and (listp object)
- (let (seen)
- (dolist (elt object t)
- (let ((key (funcall key elt)))
- (if (member key seen :test test)
- (return nil)
- (push key seen)))))))
-
-(defun set-equal (list1 list2 &key (test #'eql) (key nil keyp))
- "Returns true if every element of LIST1 matches some element of LIST2 and
-every element of LIST2 matches some element of LIST1. Otherwise returns false."
- (let ((keylist1 (if keyp (mapcar key list1) list1))
- (keylist2 (if keyp (mapcar key list2) list2)))
- (and (dolist (elt keylist1 t)
- (or (member elt keylist2 :test test)
- (return nil)))
- (dolist (elt keylist2 t)
- (or (member elt keylist1 :test test)
- (return nil))))))
-
-(defun map-product (function list &rest more-lists)
- "Returns a list containing the results of calling FUNCTION with one argument
-from LIST, and one from each of MORE-LISTS for each combination of arguments.
-In other words, returns the product of LIST and MORE-LISTS using FUNCTION.
-
-Example:
-
- (map-product 'list '(1 2) '(3 4) '(5 6))
- => ((1 3 5) (1 3 6) (1 4 5) (1 4 6)
- (2 3 5) (2 3 6) (2 4 5) (2 4 6))
-"
- (labels ((%map-product (f lists)
- (let ((more (cdr lists))
- (one (car lists)))
- (if (not more)
- (mapcar f one)
- (mappend (lambda (x)
- (%map-product (curry f x) more))
- one)))))
- (%map-product (ensure-function function) (cons list more-lists))))
-
-(defun flatten (tree)
- "Traverses the tree in order, collecting non-null leaves into a list."
- (let (list)
- (labels ((traverse (subtree)
- (when subtree
- (if (consp subtree)
- (progn
- (traverse (car subtree))
- (traverse (cdr subtree)))
- (push subtree list)))))
- (traverse tree))
- (nreverse list)))
(DIR) diff --git a/3rdparties/software/alexandria-20181210-git/macros.lisp b/3rdparties/software/alexandria-20181210-git/macros.lisp
@@ -1,314 +0,0 @@
-(in-package :alexandria)
-
-(defmacro with-gensyms (names &body forms)
- "Binds each variable named by a symbol in NAMES to a unique symbol around
-FORMS. Each of NAMES must either be either a symbol, or of the form:
-
- (symbol string-designator)
-
-Bare symbols appearing in NAMES are equivalent to:
-
- (symbol symbol)
-
-The string-designator is used as the argument to GENSYM when constructing the
-unique symbol the named variable will be bound to."
- `(let ,(mapcar (lambda (name)
- (multiple-value-bind (symbol string)
- (etypecase name
- (symbol
- (values name (symbol-name name)))
- ((cons symbol (cons string-designator null))
- (values (first name) (string (second name)))))
- `(,symbol (gensym ,string))))
- names)
- ,@forms))
-
-(defmacro with-unique-names (names &body forms)
- "Alias for WITH-GENSYMS."
- `(with-gensyms ,names ,@forms))
-
-(defmacro once-only (specs &body forms)
- "Evaluates FORMS with symbols specified in SPECS rebound to temporary
-variables, ensuring that each initform is evaluated only once.
-
-Each of SPECS must either be a symbol naming the variable to be rebound, or of
-the form:
-
- (symbol initform)
-
-Bare symbols in SPECS are equivalent to
-
- (symbol symbol)
-
-Example:
-
- (defmacro cons1 (x) (once-only (x) `(cons ,x ,x)))
- (let ((y 0)) (cons1 (incf y))) => (1 . 1)
-"
- (let ((gensyms (make-gensym-list (length specs) "ONCE-ONLY"))
- (names-and-forms (mapcar (lambda (spec)
- (etypecase spec
- (list
- (destructuring-bind (name form) spec
- (cons name form)))
- (symbol
- (cons spec spec))))
- specs)))
- ;; bind in user-macro
- `(let ,(mapcar (lambda (g n) (list g `(gensym ,(string (car n)))))
- gensyms names-and-forms)
- ;; bind in final expansion
- `(let (,,@(mapcar (lambda (g n)
- ``(,,g ,,(cdr n)))
- gensyms names-and-forms))
- ;; bind in user-macro
- ,(let ,(mapcar (lambda (n g) (list (car n) g))
- names-and-forms gensyms)
- ,@forms)))))
-
-(defun parse-body (body &key documentation whole)
- "Parses BODY into (values remaining-forms declarations doc-string).
-Documentation strings are recognized only if DOCUMENTATION is true.
-Syntax errors in body are signalled and WHOLE is used in the signal
-arguments when given."
- (let ((doc nil)
- (decls nil)
- (current nil))
- (tagbody
- :declarations
- (setf current (car body))
- (when (and documentation (stringp current) (cdr body))
- (if doc
- (error "Too many documentation strings in ~S." (or whole body))
- (setf doc (pop body)))
- (go :declarations))
- (when (and (listp current) (eql (first current) 'declare))
- (push (pop body) decls)
- (go :declarations)))
- (values body (nreverse decls) doc)))
-
-(defun parse-ordinary-lambda-list (lambda-list &key (normalize t)
- allow-specializers
- (normalize-optional normalize)
- (normalize-keyword normalize)
- (normalize-auxilary normalize))
- "Parses an ordinary lambda-list, returning as multiple values:
-
-1. Required parameters.
-
-2. Optional parameter specifications, normalized into form:
-
- (name init suppliedp)
-
-3. Name of the rest parameter, or NIL.
-
-4. Keyword parameter specifications, normalized into form:
-
- ((keyword-name name) init suppliedp)
-
-5. Boolean indicating &ALLOW-OTHER-KEYS presence.
-
-6. &AUX parameter specifications, normalized into form
-
- (name init).
-
-7. Existence of &KEY in the lambda-list.
-
-Signals a PROGRAM-ERROR is the lambda-list is malformed."
- (let ((state :required)
- (allow-other-keys nil)
- (auxp nil)
- (required nil)
- (optional nil)
- (rest nil)
- (keys nil)
- (keyp nil)
- (aux nil))
- (labels ((fail (elt)
- (simple-program-error "Misplaced ~S in ordinary lambda-list:~% ~S"
- elt lambda-list))
- (check-variable (elt what &optional (allow-specializers allow-specializers))
- (unless (and (or (symbolp elt)
- (and allow-specializers
- (consp elt) (= 2 (length elt)) (symbolp (first elt))))
- (not (constantp elt)))
- (simple-program-error "Invalid ~A ~S in ordinary lambda-list:~% ~S"
- what elt lambda-list)))
- (check-spec (spec what)
- (destructuring-bind (init suppliedp) spec
- (declare (ignore init))
- (check-variable suppliedp what nil))))
- (dolist (elt lambda-list)
- (case elt
- (&optional
- (if (eq state :required)
- (setf state elt)
- (fail elt)))
- (&rest
- (if (member state '(:required &optional))
- (setf state elt)
- (fail elt)))
- (&key
- (if (member state '(:required &optional :after-rest))
- (setf state elt)
- (fail elt))
- (setf keyp t))
- (&allow-other-keys
- (if (eq state '&key)
- (setf allow-other-keys t
- state elt)
- (fail elt)))
- (&aux
- (cond ((eq state '&rest)
- (fail elt))
- (auxp
- (simple-program-error "Multiple ~S in ordinary lambda-list:~% ~S"
- elt lambda-list))
- (t
- (setf auxp t
- state elt))
- ))
- (otherwise
- (when (member elt '#.(set-difference lambda-list-keywords
- '(&optional &rest &key &allow-other-keys &aux)))
- (simple-program-error
- "Bad lambda-list keyword ~S in ordinary lambda-list:~% ~S"
- elt lambda-list))
- (case state
- (:required
- (check-variable elt "required parameter")
- (push elt required))
- (&optional
- (cond ((consp elt)
- (destructuring-bind (name &rest tail) elt
- (check-variable name "optional parameter")
- (cond ((cdr tail)
- (check-spec tail "optional-supplied-p parameter"))
- ((and normalize-optional tail)
- (setf elt (append elt '(nil))))
- (normalize-optional
- (setf elt (append elt '(nil nil)))))))
- (t
- (check-variable elt "optional parameter")
- (when normalize-optional
- (setf elt (cons elt '(nil nil))))))
- (push (ensure-list elt) optional))
- (&rest
- (check-variable elt "rest parameter")
- (setf rest elt
- state :after-rest))
- (&key
- (cond ((consp elt)
- (destructuring-bind (var-or-kv &rest tail) elt
- (cond ((consp var-or-kv)
- (destructuring-bind (keyword var) var-or-kv
- (unless (symbolp keyword)
- (simple-program-error "Invalid keyword name ~S in ordinary ~
- lambda-list:~% ~S"
- keyword lambda-list))
- (check-variable var "keyword parameter")))
- (t
- (check-variable var-or-kv "keyword parameter")
- (when normalize-keyword
- (setf var-or-kv (list (make-keyword var-or-kv) var-or-kv)))))
- (cond ((cdr tail)
- (check-spec tail "keyword-supplied-p parameter"))
- ((and normalize-keyword tail)
- (setf tail (append tail '(nil))))
- (normalize-keyword
- (setf tail '(nil nil))))
- (setf elt (cons var-or-kv tail))))
- (t
- (check-variable elt "keyword parameter")
- (setf elt (if normalize-keyword
- (list (list (make-keyword elt) elt) nil nil)
- elt))))
- (push elt keys))
- (&aux
- (if (consp elt)
- (destructuring-bind (var &optional init) elt
- (declare (ignore init))
- (check-variable var "&aux parameter"))
- (progn
- (check-variable elt "&aux parameter")
- (setf elt (list* elt (when normalize-auxilary
- '(nil))))))
- (push elt aux))
- (t
- (simple-program-error "Invalid ordinary lambda-list:~% ~S" lambda-list)))))))
- (values (nreverse required) (nreverse optional) rest (nreverse keys)
- allow-other-keys (nreverse aux) keyp)))
-
-;;;; DESTRUCTURING-*CASE
-
-(defun expand-destructuring-case (key clauses case)
- (once-only (key)
- `(if (typep ,key 'cons)
- (,case (car ,key)
- ,@(mapcar (lambda (clause)
- (destructuring-bind ((keys . lambda-list) &body body) clause
- `(,keys
- (destructuring-bind ,lambda-list (cdr ,key)
- ,@body))))
- clauses))
- (error "Invalid key to DESTRUCTURING-~S: ~S" ',case ,key))))
-
-(defmacro destructuring-case (keyform &body clauses)
- "DESTRUCTURING-CASE, -CCASE, and -ECASE are a combination of CASE and DESTRUCTURING-BIND.
-KEYFORM must evaluate to a CONS.
-
-Clauses are of the form:
-
- ((CASE-KEYS . DESTRUCTURING-LAMBDA-LIST) FORM*)
-
-The clause whose CASE-KEYS matches CAR of KEY, as if by CASE, CCASE, or ECASE,
-is selected, and FORMs are then executed with CDR of KEY is destructured and
-bound by the DESTRUCTURING-LAMBDA-LIST.
-
-Example:
-
- (defun dcase (x)
- (destructuring-case x
- ((:foo a b)
- (format nil \"foo: ~S, ~S\" a b))
- ((:bar &key a b)
- (format nil \"bar: ~S, ~S\" a b))
- (((:alt1 :alt2) a)
- (format nil \"alt: ~S\" a))
- ((t &rest rest)
- (format nil \"unknown: ~S\" rest))))
-
- (dcase (list :foo 1 2)) ; => \"foo: 1, 2\"
- (dcase (list :bar :a 1 :b 2)) ; => \"bar: 1, 2\"
- (dcase (list :alt1 1)) ; => \"alt: 1\"
- (dcase (list :alt2 2)) ; => \"alt: 2\"
- (dcase (list :quux 1 2 3)) ; => \"unknown: 1, 2, 3\"
-
- (defun decase (x)
- (destructuring-case x
- ((:foo a b)
- (format nil \"foo: ~S, ~S\" a b))
- ((:bar &key a b)
- (format nil \"bar: ~S, ~S\" a b))
- (((:alt1 :alt2) a)
- (format nil \"alt: ~S\" a))))
-
- (decase (list :foo 1 2)) ; => \"foo: 1, 2\"
- (decase (list :bar :a 1 :b 2)) ; => \"bar: 1, 2\"
- (decase (list :alt1 1)) ; => \"alt: 1\"
- (decase (list :alt2 2)) ; => \"alt: 2\"
- (decase (list :quux 1 2 3)) ; =| error
-"
- (expand-destructuring-case keyform clauses 'case))
-
-(defmacro destructuring-ccase (keyform &body clauses)
- (expand-destructuring-case keyform clauses 'ccase))
-
-(defmacro destructuring-ecase (keyform &body clauses)
- (expand-destructuring-case keyform clauses 'ecase))
-
-(dolist (name '(destructuring-ccase destructuring-ecase))
- (setf (documentation name 'function) (documentation 'destructuring-case 'function)))
-
-
-
(DIR) diff --git a/3rdparties/software/alexandria-20181210-git/numbers.lisp b/3rdparties/software/alexandria-20181210-git/numbers.lisp
@@ -1,260 +0,0 @@
-(in-package :alexandria)
-
-(declaim (inline clamp))
-(defun clamp (number min max)
- "Clamps the NUMBER into [min, max] range. Returns MIN if NUMBER is lesser then
-MIN and MAX if NUMBER is greater then MAX, otherwise returns NUMBER."
- (if (< number min)
- min
- (if (> number max)
- max
- number)))
-
-(defun gaussian-random (&optional min max)
- "Returns two gaussian random double floats as the primary and secondary value,
-optionally constrained by MIN and MAX. Gaussian random numbers form a standard
-normal distribution around 0.0d0.
-
-Sufficiently positive MIN or negative MAX will cause the algorithm used to
-take a very long time. If MIN is positive it should be close to zero, and
-similarly if MAX is negative it should be close to zero."
- (macrolet
- ((valid (x)
- `(<= (or min ,x) ,x (or max ,x)) ))
- (labels
- ((gauss ()
- (loop
- for x1 = (- (random 2.0d0) 1.0d0)
- for x2 = (- (random 2.0d0) 1.0d0)
- for w = (+ (expt x1 2) (expt x2 2))
- when (< w 1.0d0)
- do (let ((v (sqrt (/ (* -2.0d0 (log w)) w))))
- (return (values (* x1 v) (* x2 v))))))
- (guard (x)
- (unless (valid x)
- (tagbody
- :retry
- (multiple-value-bind (x1 x2) (gauss)
- (when (valid x1)
- (setf x x1)
- (go :done))
- (when (valid x2)
- (setf x x2)
- (go :done))
- (go :retry))
- :done))
- x))
- (multiple-value-bind
- (g1 g2) (gauss)
- (values (guard g1) (guard g2))))))
-
-(declaim (inline iota))
-(defun iota (n &key (start 0) (step 1))
- "Return a list of n numbers, starting from START (with numeric contagion
-from STEP applied), each consequtive number being the sum of the previous one
-and STEP. START defaults to 0 and STEP to 1.
-
-Examples:
-
- (iota 4) => (0 1 2 3)
- (iota 3 :start 1 :step 1.0) => (1.0 2.0 3.0)
- (iota 3 :start -1 :step -1/2) => (-1 -3/2 -2)
-"
- (declare (type (integer 0) n) (number start step))
- (loop repeat n
- ;; KLUDGE: get numeric contagion right for the first element too
- for i = (+ (- (+ start step) step)) then (+ i step)
- collect i))
-
-(declaim (inline map-iota))
-(defun map-iota (function n &key (start 0) (step 1))
- "Calls FUNCTION with N numbers, starting from START (with numeric contagion
-from STEP applied), each consequtive number being the sum of the previous one
-and STEP. START defaults to 0 and STEP to 1. Returns N.
-
-Examples:
-
- (map-iota #'print 3 :start 1 :step 1.0) => 3
- ;;; 1.0
- ;;; 2.0
- ;;; 3.0
-"
- (declare (type (integer 0) n) (number start step))
- (loop repeat n
- ;; KLUDGE: get numeric contagion right for the first element too
- for i = (+ start (- step step)) then (+ i step)
- do (funcall function i))
- n)
-
-(declaim (inline lerp))
-(defun lerp (v a b)
- "Returns the result of linear interpolation between A and B, using the
-interpolation coefficient V."
- ;; The correct version is numerically stable, at the expense of an
- ;; extra multiply. See (lerp 0.1 4 25) with (+ a (* v (- b a))). The
- ;; unstable version can often be converted to a fast instruction on
- ;; a lot of machines, though this is machine/implementation
- ;; specific. As alexandria is more about correct code, than
- ;; efficiency, and we're only talking about a single extra multiply,
- ;; many would prefer the stable version
- (+ (* (- 1.0 v) a) (* v b)))
-
-(declaim (inline mean))
-(defun mean (sample)
- "Returns the mean of SAMPLE. SAMPLE must be a sequence of numbers."
- (/ (reduce #'+ sample) (length sample)))
-
-(declaim (inline median))
-(defun median (sample)
- "Returns median of SAMPLE. SAMPLE must be a sequence of real numbers."
- (let* ((vector (sort (copy-sequence 'vector sample) #'<))
- (length (length vector))
- (middle (truncate length 2)))
- (if (oddp length)
- (aref vector middle)
- (/ (+ (aref vector middle) (aref vector (1- middle))) 2))))
-
-(declaim (inline variance))
-(defun variance (sample &key (biased t))
- "Variance of SAMPLE. Returns the biased variance if BIASED is true (the default),
-and the unbiased estimator of variance if BIASED is false. SAMPLE must be a
-sequence of numbers."
- (let ((mean (mean sample)))
- (/ (reduce (lambda (a b)
- (+ a (expt (- b mean) 2)))
- sample
- :initial-value 0)
- (- (length sample) (if biased 0 1)))))
-
-(declaim (inline standard-deviation))
-(defun standard-deviation (sample &key (biased t))
- "Standard deviation of SAMPLE. Returns the biased standard deviation if
-BIASED is true (the default), and the square root of the unbiased estimator
-for variance if BIASED is false (which is not the same as the unbiased
-estimator for standard deviation). SAMPLE must be a sequence of numbers."
- (sqrt (variance sample :biased biased)))
-
-(define-modify-macro maxf (&rest numbers) max
- "Modify-macro for MAX. Sets place designated by the first argument to the
-maximum of its original value and NUMBERS.")
-
-(define-modify-macro minf (&rest numbers) min
- "Modify-macro for MIN. Sets place designated by the first argument to the
-minimum of its original value and NUMBERS.")
-
-;;;; Factorial
-
-;;; KLUDGE: This is really dependant on the numbers in question: for
-;;; small numbers this is larger, and vice versa. Ideally instead of a
-;;; constant we would have RANGE-FAST-TO-MULTIPLY-DIRECTLY-P.
-(defconstant +factorial-bisection-range-limit+ 8)
-
-;;; KLUDGE: This is really platform dependant: ideally we would use
-;;; (load-time-value (find-good-direct-multiplication-limit)) instead.
-(defconstant +factorial-direct-multiplication-limit+ 13)
-
-(defun %multiply-range (i j)
- ;; We use a a bit of cleverness here:
- ;;
- ;; 1. For large factorials we bisect in order to avoid expensive bignum
- ;; multiplications: 1 x 2 x 3 x ... runs into bignums pretty soon,
- ;; and once it does that all further multiplications will be with bignums.
- ;;
- ;; By instead doing the multiplication in a tree like
- ;; ((1 x 2) x (3 x 4)) x ((5 x 6) x (7 x 8))
- ;; we manage to get less bignums.
- ;;
- ;; 2. Division isn't exactly free either, however, so we don't bisect
- ;; all the way down, but multiply ranges of integers close to each
- ;; other directly.
- ;;
- ;; For even better results it should be possible to use prime
- ;; factorization magic, but Nikodemus ran out of steam.
- ;;
- ;; KLUDGE: We support factorials of bignums, but it seems quite
- ;; unlikely anyone would ever be able to use them on a modern lisp,
- ;; since the resulting numbers are unlikely to fit in memory... but
- ;; it would be extremely unelegant to define FACTORIAL only on
- ;; fixnums, _and_ on lisps with 16 bit fixnums this can actually be
- ;; needed.
- (labels ((bisect (j k)
- (declare (type (integer 1 #.most-positive-fixnum) j k))
- (if (< (- k j) +factorial-bisection-range-limit+)
- (multiply-range j k)
- (let ((middle (+ j (truncate (- k j) 2))))
- (* (bisect j middle)
- (bisect (+ middle 1) k)))))
- (bisect-big (j k)
- (declare (type (integer 1) j k))
- (if (= j k)
- j
- (let ((middle (+ j (truncate (- k j) 2))))
- (* (if (<= middle most-positive-fixnum)
- (bisect j middle)
- (bisect-big j middle))
- (bisect-big (+ middle 1) k)))))
- (multiply-range (j k)
- (declare (type (integer 1 #.most-positive-fixnum) j k))
- (do ((f k (* f m))
- (m (1- k) (1- m)))
- ((< m j) f)
- (declare (type (integer 0 (#.most-positive-fixnum)) m)
- (type unsigned-byte f)))))
- (if (and (typep i 'fixnum) (typep j 'fixnum))
- (bisect i j)
- (bisect-big i j))))
-
-(declaim (inline factorial))
-(defun %factorial (n)
- (if (< n 2)
- 1
- (%multiply-range 1 n)))
-
-(defun factorial (n)
- "Factorial of non-negative integer N."
- (check-type n (integer 0))
- (%factorial n))
-
-;;;; Combinatorics
-
-(defun binomial-coefficient (n k)
- "Binomial coefficient of N and K, also expressed as N choose K. This is the
-number of K element combinations given N choises. N must be equal to or
-greater then K."
- (check-type n (integer 0))
- (check-type k (integer 0))
- (assert (>= n k))
- (if (or (zerop k) (= n k))
- 1
- (let ((n-k (- n k)))
- ;; Swaps K and N-K if K < N-K because the algorithm
- ;; below is faster for bigger K and smaller N-K
- (when (< k n-k)
- (rotatef k n-k))
- (if (= 1 n-k)
- n
- ;; General case, avoid computing the 1x...xK twice:
- ;;
- ;; N! 1x...xN (K+1)x...xN
- ;; -------- = ---------------- = ------------, N>1
- ;; K!(N-K)! 1x...xK x (N-K)! (N-K)!
- (/ (%multiply-range (+ k 1) n)
- (%factorial n-k))))))
-
-(defun subfactorial (n)
- "Subfactorial of the non-negative integer N."
- (check-type n (integer 0))
- (if (zerop n)
- 1
- (do ((x 1 (1+ x))
- (a 0 (* x (+ a b)))
- (b 1 a))
- ((= n x) a))))
-
-(defun count-permutations (n &optional (k n))
- "Number of K element permutations for a sequence of N objects.
-K defaults to N"
- (check-type n (integer 0))
- (check-type k (integer 0))
- (assert (>= n k))
- (%multiply-range (1+ (- n k)) n))
(DIR) diff --git a/3rdparties/software/alexandria-20181210-git/package.lisp b/3rdparties/software/alexandria-20181210-git/package.lisp
@@ -1,244 +0,0 @@
-(defpackage :alexandria.0.dev
- (:nicknames :alexandria)
- (:use :cl)
- #+sb-package-locks
- (:lock t)
- (:export
- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
- ;; BLESSED
- ;;
- ;; Binding constructs
- #:if-let
- #:when-let
- #:when-let*
- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
- ;; REVIEW IN PROGRESS
- ;;
- ;; Control flow
- ;;
- ;; -- no clear consensus yet --
- #:cswitch
- #:eswitch
- #:switch
- ;; -- problem free? --
- #:multiple-value-prog2
- #:nth-value-or
- #:whichever
- #:xor
- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
- ;; REVIEW PENDING
- ;;
- ;; Definitions
- #:define-constant
- ;; Hash tables
- #:alist-hash-table
- #:copy-hash-table
- #:ensure-gethash
- #:hash-table-alist
- #:hash-table-keys
- #:hash-table-plist
- #:hash-table-values
- #:maphash-keys
- #:maphash-values
- #:plist-hash-table
- ;; Functions
- #:compose
- #:conjoin
- #:curry
- #:disjoin
- #:ensure-function
- #:ensure-functionf
- #:multiple-value-compose
- #:named-lambda
- #:rcurry
- ;; Lists
- #:alist-plist
- #:appendf
- #:nconcf
- #:reversef
- #:nreversef
- #:circular-list
- #:circular-list-p
- #:circular-tree-p
- #:doplist
- #:ensure-car
- #:ensure-cons
- #:ensure-list
- #:flatten
- #:lastcar
- #:make-circular-list
- #:map-product
- #:mappend
- #:nunionf
- #:plist-alist
- #:proper-list
- #:proper-list-length
- #:proper-list-p
- #:remove-from-plist
- #:remove-from-plistf
- #:delete-from-plist
- #:delete-from-plistf
- #:set-equal
- #:setp
- #:unionf
- ;; Numbers
- #:binomial-coefficient
- #:clamp
- #:count-permutations
- #:factorial
- #:gaussian-random
- #:iota
- #:lerp
- #:map-iota
- #:maxf
- #:mean
- #:median
- #:minf
- #:standard-deviation
- #:subfactorial
- #:variance
- ;; Arrays
- #:array-index
- #:array-length
- #:copy-array
- ;; Sequences
- #:copy-sequence
- #:deletef
- #:emptyp
- #:ends-with
- #:ends-with-subseq
- #:extremum
- #:first-elt
- #:last-elt
- #:length=
- #:map-combinations
- #:map-derangements
- #:map-permutations
- #:proper-sequence
- #:random-elt
- #:removef
- #:rotate
- #:sequence-of-length-p
- #:shuffle
- #:starts-with
- #:starts-with-subseq
- ;; Macros
- #:once-only
- #:parse-body
- #:parse-ordinary-lambda-list
- #:with-gensyms
- #:with-unique-names
- ;; Symbols
- #:ensure-symbol
- #:format-symbol
- #:make-gensym
- #:make-gensym-list
- #:make-keyword
- ;; Strings
- #:string-designator
- ;; Types
- #:negative-double-float
- #:negative-fixnum-p
- #:negative-float
- #:negative-float-p
- #:negative-long-float
- #:negative-long-float-p
- #:negative-rational
- #:negative-rational-p
- #:negative-real
- #:negative-single-float-p
- #:non-negative-double-float
- #:non-negative-double-float-p
- #:non-negative-fixnum
- #:non-negative-fixnum-p
- #:non-negative-float
- #:non-negative-float-p
- #:non-negative-integer-p
- #:non-negative-long-float
- #:non-negative-rational
- #:non-negative-real-p
- #:non-negative-short-float-p
- #:non-negative-single-float
- #:non-negative-single-float-p
- #:non-positive-double-float
- #:non-positive-double-float-p
- #:non-positive-fixnum
- #:non-positive-fixnum-p
- #:non-positive-float
- #:non-positive-float-p
- #:non-positive-integer
- #:non-positive-rational
- #:non-positive-real
- #:non-positive-real-p
- #:non-positive-short-float
- #:non-positive-short-float-p
- #:non-positive-single-float-p
- #:ordinary-lambda-list-keywords
- #:positive-double-float
- #:positive-double-float-p
- #:positive-fixnum
- #:positive-fixnum-p
- #:positive-float
- #:positive-float-p
- #:positive-integer
- #:positive-rational
- #:positive-real
- #:positive-real-p
- #:positive-short-float
- #:positive-short-float-p
- #:positive-single-float
- #:positive-single-float-p
- #:coercef
- #:negative-double-float-p
- #:negative-fixnum
- #:negative-integer
- #:negative-integer-p
- #:negative-real-p
- #:negative-short-float
- #:negative-short-float-p
- #:negative-single-float
- #:non-negative-integer
- #:non-negative-long-float-p
- #:non-negative-rational-p
- #:non-negative-real
- #:non-negative-short-float
- #:non-positive-integer-p
- #:non-positive-long-float
- #:non-positive-long-float-p
- #:non-positive-rational-p
- #:non-positive-single-float
- #:of-type
- #:positive-integer-p
- #:positive-long-float
- #:positive-long-float-p
- #:positive-rational-p
- #:type=
- ;; Conditions
- #:required-argument
- #:ignore-some-conditions
- #:simple-style-warning
- #:simple-reader-error
- #:simple-parse-error
- #:simple-program-error
- #:unwind-protect-case
- ;; Features
- #:featurep
- ;; io
- #:with-input-from-file
- #:with-output-to-file
- #:read-stream-content-into-string
- #:read-file-into-string
- #:write-string-into-file
- #:read-stream-content-into-byte-vector
- #:read-file-into-byte-vector
- #:write-byte-vector-into-file
- #:copy-stream
- #:copy-file
- ;; new additions collected at the end (subject to removal or further changes)
- #:symbolicate
- #:assoc-value
- #:rassoc-value
- #:destructuring-case
- #:destructuring-ccase
- #:destructuring-ecase
- ))
(DIR) diff --git a/3rdparties/software/alexandria-20181210-git/sequences.lisp b/3rdparties/software/alexandria-20181210-git/sequences.lisp
@@ -1,555 +0,0 @@
-(in-package :alexandria)
-
-;; Make these inlinable by declaiming them INLINE here and some of them
-;; NOTINLINE at the end of the file. Exclude functions that have a compiler
-;; macro, because NOTINLINE is required to prevent compiler-macro expansion.
-(declaim (inline copy-sequence sequence-of-length-p))
-
-(defun sequence-of-length-p (sequence length)
- "Return true if SEQUENCE is a sequence of length LENGTH. Signals an error if
-SEQUENCE is not a sequence. Returns FALSE for circular lists."
- (declare (type array-index length)
- #-lispworks (inline length)
- (optimize speed))
- (etypecase sequence
- (null
- (zerop length))
- (cons
- (let ((n (1- length)))
- (unless (minusp n)
- (let ((tail (nthcdr n sequence)))
- (and tail
- (null (cdr tail)))))))
- (vector
- (= length (length sequence)))
- (sequence
- (= length (length sequence)))))
-
-(defun rotate-tail-to-head (sequence n)
- (declare (type (integer 1) n))
- (if (listp sequence)
- (let ((m (mod n (proper-list-length sequence))))
- (if (null (cdr sequence))
- sequence
- (let* ((tail (last sequence (+ m 1)))
- (last (cdr tail)))
- (setf (cdr tail) nil)
- (nconc last sequence))))
- (let* ((len (length sequence))
- (m (mod n len))
- (tail (subseq sequence (- len m))))
- (replace sequence sequence :start1 m :start2 0)
- (replace sequence tail)
- sequence)))
-
-(defun rotate-head-to-tail (sequence n)
- (declare (type (integer 1) n))
- (if (listp sequence)
- (let ((m (mod (1- n) (proper-list-length sequence))))
- (if (null (cdr sequence))
- sequence
- (let* ((headtail (nthcdr m sequence))
- (tail (cdr headtail)))
- (setf (cdr headtail) nil)
- (nconc tail sequence))))
- (let* ((len (length sequence))
- (m (mod n len))
- (head (subseq sequence 0 m)))
- (replace sequence sequence :start1 0 :start2 m)
- (replace sequence head :start1 (- len m))
- sequence)))
-
-(defun rotate (sequence &optional (n 1))
- "Returns a sequence of the same type as SEQUENCE, with the elements of
-SEQUENCE rotated by N: N elements are moved from the end of the sequence to
-the front if N is positive, and -N elements moved from the front to the end if
-N is negative. SEQUENCE must be a proper sequence. N must be an integer,
-defaulting to 1.
-
-If absolute value of N is greater then the length of the sequence, the results
-are identical to calling ROTATE with
-
- (* (signum n) (mod n (length sequence))).
-
-Note: the original sequence may be destructively altered, and result sequence may
-share structure with it."
- (if (plusp n)
- (rotate-tail-to-head sequence n)
- (if (minusp n)
- (rotate-head-to-tail sequence (- n))
- sequence)))
-
-(defun shuffle (sequence &key (start 0) end)
- "Returns a random permutation of SEQUENCE bounded by START and END.
-Original sequence may be destructively modified, and (if it contains
-CONS or lists themselv) share storage with the original one.
-Signals an error if SEQUENCE is not a proper sequence."
- (declare (type fixnum start)
- (type (or fixnum null) end))
- (etypecase sequence
- (list
- (let* ((end (or end (proper-list-length sequence)))
- (n (- end start)))
- (do ((tail (nthcdr start sequence) (cdr tail)))
- ((zerop n))
- (rotatef (car tail) (car (nthcdr (random n) tail)))
- (decf n))))
- (vector
- (let ((end (or end (length sequence))))
- (loop for i from start below end
- do (rotatef (aref sequence i)
- (aref sequence (+ i (random (- end i))))))))
- (sequence
- (let ((end (or end (length sequence))))
- (loop for i from (- end 1) downto start
- do (rotatef (elt sequence i)
- (elt sequence (+ i (random (- end i)))))))))
- sequence)
-
-(defun random-elt (sequence &key (start 0) end)
- "Returns a random element from SEQUENCE bounded by START and END. Signals an
-error if the SEQUENCE is not a proper non-empty sequence, or if END and START
-are not proper bounding index designators for SEQUENCE."
- (declare (sequence sequence) (fixnum start) (type (or fixnum null) end))
- (let* ((size (if (listp sequence)
- (proper-list-length sequence)
- (length sequence)))
- (end2 (or end size)))
- (cond ((zerop size)
- (error 'type-error
- :datum sequence
- :expected-type `(and sequence (not (satisfies emptyp)))))
- ((not (and (<= 0 start) (< start end2) (<= end2 size)))
- (error 'simple-type-error
- :datum (cons start end)
- :expected-type `(cons (integer 0 (,end2))
- (or null (integer (,start) ,size)))
- :format-control "~@<~S and ~S are not valid bounding index designators for ~
- a sequence of length ~S.~:@>"
- :format-arguments (list start end size)))
- (t
- (let ((index (+ start (random (- end2 start)))))
- (elt sequence index))))))
-
-(declaim (inline remove/swapped-arguments))
-(defun remove/swapped-arguments (sequence item &rest keyword-arguments)
- (apply #'remove item sequence keyword-arguments))
-
-(define-modify-macro removef (item &rest keyword-arguments)
- remove/swapped-arguments
- "Modify-macro for REMOVE. Sets place designated by the first argument to
-the result of calling REMOVE with ITEM, place, and the KEYWORD-ARGUMENTS.")
-
-(declaim (inline delete/swapped-arguments))
-(defun delete/swapped-arguments (sequence item &rest keyword-arguments)
- (apply #'delete item sequence keyword-arguments))
-
-(define-modify-macro deletef (item &rest keyword-arguments)
- delete/swapped-arguments
- "Modify-macro for DELETE. Sets place designated by the first argument to
-the result of calling DELETE with ITEM, place, and the KEYWORD-ARGUMENTS.")
-
-(deftype proper-sequence ()
- "Type designator for proper sequences, that is proper lists and sequences
-that are not lists."
- `(or proper-list
- (and (not list) sequence)))
-
-(eval-when (:compile-toplevel :load-toplevel :execute)
- (when (and (find-package '#:sequence)
- (find-symbol (string '#:emptyp) '#:sequence))
- (pushnew 'sequence-emptyp *features*)))
-
-#-alexandria::sequence-emptyp
-(defun emptyp (sequence)
- "Returns true if SEQUENCE is an empty sequence. Signals an error if SEQUENCE
-is not a sequence."
- (etypecase sequence
- (list (null sequence))
- (sequence (zerop (length sequence)))))
-
-#+alexandria::sequence-emptyp
-(declaim (ftype (function (sequence) (values boolean &optional)) emptyp))
-#+alexandria::sequence-emptyp
-(setf (symbol-function 'emptyp) (symbol-function 'sequence:emptyp))
-#+alexandria::sequence-emptyp
-(define-compiler-macro emptyp (sequence)
- `(sequence:emptyp ,sequence))
-
-(defun length= (&rest sequences)
- "Takes any number of sequences or integers in any order. Returns true iff
-the length of all the sequences and the integers are equal. Hint: there's a
-compiler macro that expands into more efficient code if the first argument
-is a literal integer."
- (declare (dynamic-extent sequences)
- (inline sequence-of-length-p)
- (optimize speed))
- (unless (cdr sequences)
- (error "You must call LENGTH= with at least two arguments"))
- ;; There's room for optimization here: multiple list arguments could be
- ;; traversed in parallel.
- (let* ((first (pop sequences))
- (current (if (integerp first)
- first
- (length first))))
- (declare (type array-index current))
- (dolist (el sequences)
- (if (integerp el)
- (unless (= el current)
- (return-from length= nil))
- (unless (sequence-of-length-p el current)
- (return-from length= nil)))))
- t)
-
-(define-compiler-macro length= (&whole form length &rest sequences)
- (cond
- ((zerop (length sequences))
- form)
- (t
- (let ((optimizedp (integerp length)))
- (with-unique-names (tmp current)
- (declare (ignorable current))
- `(locally
- (declare (inline sequence-of-length-p))
- (let ((,tmp)
- ,@(unless optimizedp
- `((,current ,length))))
- ,@(unless optimizedp
- `((unless (integerp ,current)
- (setf ,current (length ,current)))))
- (and
- ,@(loop
- :for sequence :in sequences
- :collect `(progn
- (setf ,tmp ,sequence)
- (if (integerp ,tmp)
- (= ,tmp ,(if optimizedp
- length
- current))
- (sequence-of-length-p ,tmp ,(if optimizedp
- length
- current)))))))))))))
-
-(defun copy-sequence (type sequence)
- "Returns a fresh sequence of TYPE, which has the same elements as
-SEQUENCE."
- (if (typep sequence type)
- (copy-seq sequence)
- (coerce sequence type)))
-
-(defun first-elt (sequence)
- "Returns the first element of SEQUENCE. Signals a type-error if SEQUENCE is
-not a sequence, or is an empty sequence."
- ;; Can't just directly use ELT, as it is not guaranteed to signal the
- ;; type-error.
- (cond ((consp sequence)
- (car sequence))
- ((and (typep sequence 'sequence) (not (emptyp sequence)))
- (elt sequence 0))
- (t
- (error 'type-error
- :datum sequence
- :expected-type '(and sequence (not (satisfies emptyp)))))))
-
-(defun (setf first-elt) (object sequence)
- "Sets the first element of SEQUENCE. Signals a type-error if SEQUENCE is
-not a sequence, is an empty sequence, or if OBJECT cannot be stored in SEQUENCE."
- ;; Can't just directly use ELT, as it is not guaranteed to signal the
- ;; type-error.
- (cond ((consp sequence)
- (setf (car sequence) object))
- ((and (typep sequence 'sequence) (not (emptyp sequence)))
- (setf (elt sequence 0) object))
- (t
- (error 'type-error
- :datum sequence
- :expected-type '(and sequence (not (satisfies emptyp)))))))
-
-(defun last-elt (sequence)
- "Returns the last element of SEQUENCE. Signals a type-error if SEQUENCE is
-not a proper sequence, or is an empty sequence."
- ;; Can't just directly use ELT, as it is not guaranteed to signal the
- ;; type-error.
- (let ((len 0))
- (cond ((consp sequence)
- (lastcar sequence))
- ((and (typep sequence '(and sequence (not list))) (plusp (setf len (length sequence))))
- (elt sequence (1- len)))
- (t
- (error 'type-error
- :datum sequence
- :expected-type '(and proper-sequence (not (satisfies emptyp))))))))
-
-(defun (setf last-elt) (object sequence)
- "Sets the last element of SEQUENCE. Signals a type-error if SEQUENCE is not a proper
-sequence, is an empty sequence, or if OBJECT cannot be stored in SEQUENCE."
- (let ((len 0))
- (cond ((consp sequence)
- (setf (lastcar sequence) object))
- ((and (typep sequence '(and sequence (not list))) (plusp (setf len (length sequence))))
- (setf (elt sequence (1- len)) object))
- (t
- (error 'type-error
- :datum sequence
- :expected-type '(and proper-sequence (not (satisfies emptyp))))))))
-
-(defun starts-with-subseq (prefix sequence &rest args
- &key
- (return-suffix nil return-suffix-supplied-p)
- &allow-other-keys)
- "Test whether the first elements of SEQUENCE are the same (as per TEST) as the elements of PREFIX.
-
-If RETURN-SUFFIX is T the function returns, as a second value, a
-sub-sequence or displaced array pointing to the sequence after PREFIX."
- (declare (dynamic-extent args))
- (let ((sequence-length (length sequence))
- (prefix-length (length prefix)))
- (when (< sequence-length prefix-length)
- (return-from starts-with-subseq (values nil nil)))
- (flet ((make-suffix (start)
- (when return-suffix
- (cond
- ((not (arrayp sequence))
- (if start
- (subseq sequence start)
- (subseq sequence 0 0)))
- ((not start)
- (make-array 0
- :element-type (array-element-type sequence)
- :adjustable nil))
- (t
- (make-array (- sequence-length start)
- :element-type (array-element-type sequence)
- :displaced-to sequence
- :displaced-index-offset start
- :adjustable nil))))))
- (let ((mismatch (apply #'mismatch prefix sequence
- (if return-suffix-supplied-p
- (remove-from-plist args :return-suffix)
- args))))
- (cond
- ((not mismatch)
- (values t (make-suffix nil)))
- ((= mismatch prefix-length)
- (values t (make-suffix mismatch)))
- (t
- (values nil nil)))))))
-
-(defun ends-with-subseq (suffix sequence &key (test #'eql))
- "Test whether SEQUENCE ends with SUFFIX. In other words: return true if
-the last (length SUFFIX) elements of SEQUENCE are equal to SUFFIX."
- (let ((sequence-length (length sequence))
- (suffix-length (length suffix)))
- (when (< sequence-length suffix-length)
- ;; if SEQUENCE is shorter than SUFFIX, then SEQUENCE can't end with SUFFIX.
- (return-from ends-with-subseq nil))
- (loop for sequence-index from (- sequence-length suffix-length) below sequence-length
- for suffix-index from 0 below suffix-length
- when (not (funcall test (elt sequence sequence-index) (elt suffix suffix-index)))
- do (return-from ends-with-subseq nil)
- finally (return t))))
-
-(defun starts-with (object sequence &key (test #'eql) (key #'identity))
- "Returns true if SEQUENCE is a sequence whose first element is EQL to OBJECT.
-Returns NIL if the SEQUENCE is not a sequence or is an empty sequence."
- (let ((first-elt (typecase sequence
- (cons (car sequence))
- (sequence
- (if (emptyp sequence)
- (return-from starts-with nil)
- (elt sequence 0)))
- (t
- (return-from starts-with nil)))))
- (funcall test (funcall key first-elt) object)))
-
-(defun ends-with (object sequence &key (test #'eql) (key #'identity))
- "Returns true if SEQUENCE is a sequence whose last element is EQL to OBJECT.
-Returns NIL if the SEQUENCE is not a sequence or is an empty sequence. Signals
-an error if SEQUENCE is an improper list."
- (let ((last-elt (typecase sequence
- (cons
- (lastcar sequence)) ; signals for improper lists
- (sequence
- ;; Can't use last-elt, as that signals an error
- ;; for empty sequences
- (let ((len (length sequence)))
- (if (plusp len)
- (elt sequence (1- len))
- (return-from ends-with nil))))
- (t
- (return-from ends-with nil)))))
- (funcall test (funcall key last-elt) object)))
-
-(defun map-combinations (function sequence &key (start 0) end length (copy t))
- "Calls FUNCTION with each combination of LENGTH constructable from the
-elements of the subsequence of SEQUENCE delimited by START and END. START
-defaults to 0, END to length of SEQUENCE, and LENGTH to the length of the
-delimited subsequence. (So unless LENGTH is specified there is only a single
-combination, which has the same elements as the delimited subsequence.) If
-COPY is true (the default) each combination is freshly allocated. If COPY is
-false all combinations are EQ to each other, in which case consequences are
-unspecified if a combination is modified by FUNCTION."
- (let* ((end (or end (length sequence)))
- (size (- end start))
- (length (or length size))
- (combination (subseq sequence 0 length))
- (function (ensure-function function)))
- (if (= length size)
- (funcall function combination)
- (flet ((call ()
- (funcall function (if copy
- (copy-seq combination)
- combination))))
- (etypecase sequence
- ;; When dealing with lists we prefer walking back and
- ;; forth instead of using indexes.
- (list
- (labels ((combine-list (c-tail o-tail)
- (if (not c-tail)
- (call)
- (do ((tail o-tail (cdr tail)))
- ((not tail))
- (setf (car c-tail) (car tail))
- (combine-list (cdr c-tail) (cdr tail))))))
- (combine-list combination (nthcdr start sequence))))
- (vector
- (labels ((combine (count start)
- (if (zerop count)
- (call)
- (loop for i from start below end
- do (let ((j (- count 1)))
- (setf (aref combination j) (aref sequence i))
- (combine j (+ i 1)))))))
- (combine length start)))
- (sequence
- (labels ((combine (count start)
- (if (zerop count)
- (call)
- (loop for i from start below end
- do (let ((j (- count 1)))
- (setf (elt combination j) (elt sequence i))
- (combine j (+ i 1)))))))
- (combine length start)))))))
- sequence)
-
-(defun map-permutations (function sequence &key (start 0) end length (copy t))
- "Calls function with each permutation of LENGTH constructable
-from the subsequence of SEQUENCE delimited by START and END. START
-defaults to 0, END to length of the sequence, and LENGTH to the
-length of the delimited subsequence."
- (let* ((end (or end (length sequence)))
- (size (- end start))
- (length (or length size)))
- (labels ((permute (seq n)
- (let ((n-1 (- n 1)))
- (if (zerop n-1)
- (funcall function (if copy
- (copy-seq seq)
- seq))
- (loop for i from 0 upto n-1
- do (permute seq n-1)
- (if (evenp n-1)
- (rotatef (elt seq 0) (elt seq n-1))
- (rotatef (elt seq i) (elt seq n-1)))))))
- (permute-sequence (seq)
- (permute seq length)))
- (if (= length size)
- ;; Things are simple if we need to just permute the
- ;; full START-END range.
- (permute-sequence (subseq sequence start end))
- ;; Otherwise we need to generate all the combinations
- ;; of LENGTH in the START-END range, and then permute
- ;; a copy of the result: can't permute the combination
- ;; directly, as they share structure with each other.
- (let ((permutation (subseq sequence 0 length)))
- (flet ((permute-combination (combination)
- (permute-sequence (replace permutation combination))))
- (declare (dynamic-extent #'permute-combination))
- (map-combinations #'permute-combination sequence
- :start start
- :end end
- :length length
- :copy nil)))))))
-
-(defun map-derangements (function sequence &key (start 0) end (copy t))
- "Calls FUNCTION with each derangement of the subsequence of SEQUENCE denoted
-by the bounding index designators START and END. Derangement is a permutation
-of the sequence where no element remains in place. SEQUENCE is not modified,
-but individual derangements are EQ to each other. Consequences are unspecified
-if calling FUNCTION modifies either the derangement or SEQUENCE."
- (let* ((end (or end (length sequence)))
- (size (- end start))
- ;; We don't really care about the elements here.
- (derangement (subseq sequence 0 size))
- ;; Bitvector that has 1 for elements that have been deranged.
- (mask (make-array size :element-type 'bit :initial-element 0)))
- (declare (dynamic-extent mask))
- ;; ad hoc algorith
- (labels ((derange (place n)
- ;; Perform one recursive step in deranging the
- ;; sequence: PLACE is index of the original sequence
- ;; to derange to another index, and N is the number of
- ;; indexes not yet deranged.
- (if (zerop n)
- (funcall function (if copy
- (copy-seq derangement)
- derangement))
- ;; Itarate over the indexes I of the subsequence to
- ;; derange: if I != PLACE and I has not yet been
- ;; deranged by an earlier call put the element from
- ;; PLACE to I, mark I as deranged, and recurse,
- ;; finally removing the mark.
- (loop for i from 0 below size
- do
- (unless (or (= place (+ i start)) (not (zerop (bit mask i))))
- (setf (elt derangement i) (elt sequence place)
- (bit mask i) 1)
- (derange (1+ place) (1- n))
- (setf (bit mask i) 0))))))
- (derange start size)
- sequence)))
-
-(declaim (notinline sequence-of-length-p))
-
-(defun extremum (sequence predicate &key key (start 0) end)
- "Returns the element of SEQUENCE that would appear first if the subsequence
-bounded by START and END was sorted using PREDICATE and KEY.
-
-EXTREMUM determines the relationship between two elements of SEQUENCE by using
-the PREDICATE function. PREDICATE should return true if and only if the first
-argument is strictly less than the second one (in some appropriate sense). Two
-arguments X and Y are considered to be equal if (FUNCALL PREDICATE X Y)
-and (FUNCALL PREDICATE Y X) are both false.
-
-The arguments to the PREDICATE function are computed from elements of SEQUENCE
-using the KEY function, if supplied. If KEY is not supplied or is NIL, the
-sequence element itself is used.
-
-If SEQUENCE is empty, NIL is returned."
- (let* ((pred-fun (ensure-function predicate))
- (key-fun (unless (or (not key) (eq key 'identity) (eq key #'identity))
- (ensure-function key)))
- (real-end (or end (length sequence))))
- (cond ((> real-end start)
- (if key-fun
- (flet ((reduce-keys (a b)
- (if (funcall pred-fun
- (funcall key-fun a)
- (funcall key-fun b))
- a
- b)))
- (declare (dynamic-extent #'reduce-keys))
- (reduce #'reduce-keys sequence :start start :end real-end))
- (flet ((reduce-elts (a b)
- (if (funcall pred-fun a b)
- a
- b)))
- (declare (dynamic-extent #'reduce-elts))
- (reduce #'reduce-elts sequence :start start :end real-end))))
- ((= real-end start)
- nil)
- (t
- (error "Invalid bounding indexes for sequence of length ~S: ~S ~S, ~S ~S"
- (length sequence)
- :start start
- :end end)))))
(DIR) diff --git a/3rdparties/software/alexandria-20181210-git/strings.lisp b/3rdparties/software/alexandria-20181210-git/strings.lisp
@@ -1,6 +0,0 @@
-(in-package :alexandria)
-
-(deftype string-designator ()
- "A string designator type. A string designator is either a string, a symbol,
-or a character."
- `(or symbol string character))
(DIR) diff --git a/3rdparties/software/alexandria-20181210-git/symbols.lisp b/3rdparties/software/alexandria-20181210-git/symbols.lisp
@@ -1,65 +0,0 @@
-(in-package :alexandria)
-
-(declaim (inline ensure-symbol))
-(defun ensure-symbol (name &optional (package *package*))
- "Returns a symbol with name designated by NAME, accessible in package
-designated by PACKAGE. If symbol is not already accessible in PACKAGE, it is
-interned there. Returns a secondary value reflecting the status of the symbol
-in the package, which matches the secondary return value of INTERN.
-
-Example:
-
- (ensure-symbol :cons :cl) => cl:cons, :external
-"
- (intern (string name) package))
-
-(defun maybe-intern (name package)
- (values
- (if package
- (intern name (if (eq t package) *package* package))
- (make-symbol name))))
-
-(declaim (inline format-symbol))
-(defun format-symbol (package control &rest arguments)
- "Constructs a string by applying ARGUMENTS to string designator CONTROL as
-if by FORMAT within WITH-STANDARD-IO-SYNTAX, and then creates a symbol named
-by that string.
-
-If PACKAGE is NIL, returns an uninterned symbol, if package is T, returns a
-symbol interned in the current package, and otherwise returns a symbol
-interned in the package designated by PACKAGE."
- (maybe-intern (with-standard-io-syntax
- (apply #'format nil (string control) arguments))
- package))
-
-(defun make-keyword (name)
- "Interns the string designated by NAME in the KEYWORD package."
- (intern (string name) :keyword))
-
-(defun make-gensym (name)
- "If NAME is a non-negative integer, calls GENSYM using it. Otherwise NAME
-must be a string designator, in which case calls GENSYM using the designated
-string as the argument."
- (gensym (if (typep name '(integer 0))
- name
- (string name))))
-
-(defun make-gensym-list (length &optional (x "G"))
- "Returns a list of LENGTH gensyms, each generated as if with a call to MAKE-GENSYM,
-using the second (optional, defaulting to \"G\") argument."
- (let ((g (if (typep x '(integer 0)) x (string x))))
- (loop repeat length
- collect (gensym g))))
-
-(defun symbolicate (&rest things)
- "Concatenate together the names of some strings and symbols,
-producing a symbol in the current package."
- (let* ((length (reduce #'+ things
- :key (lambda (x) (length (string x)))))
- (name (make-array length :element-type 'character)))
- (let ((index 0))
- (dolist (thing things (values (intern name)))
- (let* ((x (string thing))
- (len (length x)))
- (replace name x :start1 index)
- (incf index len))))))
(DIR) diff --git a/3rdparties/software/alexandria-20181210-git/tests.lisp b/3rdparties/software/alexandria-20181210-git/tests.lisp
@@ -1,2047 +0,0 @@
-(in-package :cl-user)
-
-(defpackage :alexandria-tests
- (:use :cl :alexandria #+sbcl :sb-rt #-sbcl :rtest)
- (:import-from #+sbcl :sb-rt #-sbcl :rtest
- #:*compile-tests* #:*expected-failures*))
-
-(in-package :alexandria-tests)
-
-(defun run-tests (&key ((:compiled *compile-tests*)))
- (do-tests))
-
-(defun hash-table-test-name (name)
- ;; Workaround for Clisp calling EQL in a hash-table FASTHASH-EQL.
- (hash-table-test (make-hash-table :test name)))
-
-;;;; Arrays
-
-(deftest copy-array.1
- (let* ((orig (vector 1 2 3))
- (copy (copy-array orig)))
- (values (eq orig copy) (equalp orig copy)))
- nil t)
-
-(deftest copy-array.2
- (let ((orig (make-array 1024 :fill-pointer 0)))
- (vector-push-extend 1 orig)
- (vector-push-extend 2 orig)
- (vector-push-extend 3 orig)
- (let ((copy (copy-array orig)))
- (values (eq orig copy) (equalp orig copy)
- (array-has-fill-pointer-p copy)
- (eql (fill-pointer orig) (fill-pointer copy)))))
- nil t t t)
-
-(deftest copy-array.3
- (let* ((orig (vector 1 2 3))
- (copy (copy-array orig)))
- (typep copy 'simple-array))
- t)
-
-(deftest copy-array.4
- (let ((orig (make-array 21
- :adjustable t
- :fill-pointer 0)))
- (dotimes (n 42)
- (vector-push-extend n orig))
- (let ((copy (copy-array orig
- :adjustable nil
- :fill-pointer nil)))
- (typep copy 'simple-array)))
- t)
-
-(deftest array-index.1
- (typep 0 'array-index)
- t)
-
-;;;; Conditions
-
-(deftest unwind-protect-case.1
- (let (result)
- (unwind-protect-case ()
- (random 10)
- (:normal (push :normal result))
- (:abort (push :abort result))
- (:always (push :always result)))
- result)
- (:always :normal))
-
-(deftest unwind-protect-case.2
- (let (result)
- (unwind-protect-case ()
- (random 10)
- (:always (push :always result))
- (:normal (push :normal result))
- (:abort (push :abort result)))
- result)
- (:normal :always))
-
-(deftest unwind-protect-case.3
- (let (result1 result2 result3)
- (ignore-errors
- (unwind-protect-case ()
- (error "FOOF!")
- (:normal (push :normal result1))
- (:abort (push :abort result1))
- (:always (push :always result1))))
- (catch 'foof
- (unwind-protect-case ()
- (throw 'foof 42)
- (:normal (push :normal result2))
- (:abort (push :abort result2))
- (:always (push :always result2))))
- (block foof
- (unwind-protect-case ()
- (return-from foof 42)
- (:normal (push :normal result3))
- (:abort (push :abort result3))
- (:always (push :always result3))))
- (values result1 result2 result3))
- (:always :abort)
- (:always :abort)
- (:always :abort))
-
-(deftest unwind-protect-case.4
- (let (result)
- (unwind-protect-case (aborted-p)
- (random 42)
- (:always (setq result aborted-p)))
- result)
- nil)
-
-(deftest unwind-protect-case.5
- (let (result)
- (block foof
- (unwind-protect-case (aborted-p)
- (return-from foof)
- (:always (setq result aborted-p))))
- result)
- t)
-
-;;;; Control flow
-
-(deftest switch.1
- (switch (13 :test =)
- (12 :oops)
- (13.0 :yay))
- :yay)
-
-(deftest switch.2
- (switch (13)
- ((+ 12 2) :oops)
- ((- 13 1) :oops2)
- (t :yay))
- :yay)
-
-(deftest eswitch.1
- (let ((x 13))
- (eswitch (x :test =)
- (12 :oops)
- (13.0 :yay)))
- :yay)
-
-(deftest eswitch.2
- (let ((x 13))
- (eswitch (x :key 1+)
- (11 :oops)
- (14 :yay)))
- :yay)
-
-(deftest cswitch.1
- (cswitch (13 :test =)
- (12 :oops)
- (13.0 :yay))
- :yay)
-
-(deftest cswitch.2
- (cswitch (13 :key 1-)
- (12 :yay)
- (13.0 :oops))
- :yay)
-
-(deftest multiple-value-prog2.1
- (multiple-value-prog2
- (values 1 1 1)
- (values 2 20 200)
- (values 3 3 3))
- 2 20 200)
-
-(deftest nth-value-or.1
- (multiple-value-bind (a b c)
- (nth-value-or 1
- (values 1 nil 1)
- (values 2 2 2))
- (= a b c 2))
- t)
-
-(deftest whichever.1
- (let ((x (whichever 1 2 3)))
- (and (member x '(1 2 3)) t))
- t)
-
-(deftest whichever.2
- (let* ((a 1)
- (b 2)
- (c 3)
- (x (whichever a b c)))
- (and (member x '(1 2 3)) t))
- t)
-
-(deftest xor.1
- (xor nil nil 1 nil)
- 1
- t)
-
-(deftest xor.2
- (xor nil nil 1 2)
- nil
- nil)
-
-(deftest xor.3
- (xor nil nil nil)
- nil
- t)
-
-;;;; Definitions
-
-(deftest define-constant.1
- (let ((name (gensym)))
- (eval `(define-constant ,name "FOO" :test 'equal))
- (eval `(define-constant ,name "FOO" :test 'equal))
- (values (equal "FOO" (symbol-value name))
- (constantp name)))
- t
- t)
-
-(deftest define-constant.2
- (let ((name (gensym)))
- (eval `(define-constant ,name 13))
- (eval `(define-constant ,name 13))
- (values (eql 13 (symbol-value name))
- (constantp name)))
- t
- t)
-
-;;;; Errors
-
-;;; TYPEP is specified to return a generalized boolean and, for
-;;; example, ECL exploits this by returning the superclasses of ERROR
-;;; in this case.
-(defun errorp (x)
- (not (null (typep x 'error))))
-
-(deftest required-argument.1
- (multiple-value-bind (res err)
- (ignore-errors (required-argument))
- (errorp err))
- t)
-
-;;;; Hash tables
-
-(deftest ensure-gethash.1
- (let ((table (make-hash-table))
- (x (list 1)))
- (multiple-value-bind (value already-there)
- (ensure-gethash x table 42)
- (and (= value 42)
- (not already-there)
- (= 42 (gethash x table))
- (multiple-value-bind (value2 already-there2)
- (ensure-gethash x table 13)
- (and (= value2 42)
- already-there2
- (= 42 (gethash x table)))))))
- t)
-
-(deftest ensure-gethash.2
- (let ((table (make-hash-table))
- (count 0))
- (multiple-value-call #'values
- (ensure-gethash (progn (incf count) :foo)
- (progn (incf count) table)
- (progn (incf count) :bar))
- (gethash :foo table)
- count))
- :bar nil :bar t 3)
-
-(deftest copy-hash-table.1
- (let ((orig (make-hash-table :test 'eq :size 123))
- (foo "foo"))
- (setf (gethash orig orig) t
- (gethash foo orig) t)
- (let ((eq-copy (copy-hash-table orig))
- (eql-copy (copy-hash-table orig :test 'eql))
- (equal-copy (copy-hash-table orig :test 'equal))
- (equalp-copy (copy-hash-table orig :test 'equalp)))
- (list (eql (hash-table-size eq-copy) (hash-table-size orig))
- (eql (hash-table-rehash-size eq-copy)
- (hash-table-rehash-size orig))
- (hash-table-count eql-copy)
- (gethash orig eq-copy)
- (gethash (copy-seq foo) eql-copy)
- (gethash foo eql-copy)
- (gethash (copy-seq foo) equal-copy)
- (gethash "FOO" equal-copy)
- (gethash "FOO" equalp-copy))))
- (t t 2 t nil t t nil t))
-
-(deftest copy-hash-table.2
- (let ((ht (make-hash-table))
- (list (list :list (vector :A :B :C))))
- (setf (gethash 'list ht) list)
- (let* ((shallow-copy (copy-hash-table ht))
- (deep1-copy (copy-hash-table ht :key 'copy-list))
- (list (gethash 'list ht))
- (shallow-list (gethash 'list shallow-copy))
- (deep1-list (gethash 'list deep1-copy)))
- (list (eq ht shallow-copy)
- (eq ht deep1-copy)
- (eq list shallow-list)
- (eq list deep1-list) ; outer list was copied.
- (eq (second list) (second shallow-list))
- (eq (second list) (second deep1-list)) ; inner vector wasn't copied.
- )))
- (nil nil t nil t t))
-
-(deftest maphash-keys.1
- (let ((keys nil)
- (table (make-hash-table)))
- (declare (notinline maphash-keys))
- (dotimes (i 10)
- (setf (gethash i table) t))
- (maphash-keys (lambda (k) (push k keys)) table)
- (set-equal keys '(0 1 2 3 4 5 6 7 8 9)))
- t)
-
-(deftest maphash-values.1
- (let ((vals nil)
- (table (make-hash-table)))
- (declare (notinline maphash-values))
- (dotimes (i 10)
- (setf (gethash i table) (- i)))
- (maphash-values (lambda (v) (push v vals)) table)
- (set-equal vals '(0 -1 -2 -3 -4 -5 -6 -7 -8 -9)))
- t)
-
-(deftest hash-table-keys.1
- (let ((table (make-hash-table)))
- (dotimes (i 10)
- (setf (gethash i table) t))
- (set-equal (hash-table-keys table) '(0 1 2 3 4 5 6 7 8 9)))
- t)
-
-(deftest hash-table-values.1
- (let ((table (make-hash-table)))
- (dotimes (i 10)
- (setf (gethash (gensym) table) i))
- (set-equal (hash-table-values table) '(0 1 2 3 4 5 6 7 8 9)))
- t)
-
-(deftest hash-table-alist.1
- (let ((table (make-hash-table)))
- (dotimes (i 10)
- (setf (gethash i table) (- i)))
- (let ((alist (hash-table-alist table)))
- (list (length alist)
- (assoc 0 alist)
- (assoc 3 alist)
- (assoc 9 alist)
- (assoc nil alist))))
- (10 (0 . 0) (3 . -3) (9 . -9) nil))
-
-(deftest hash-table-plist.1
- (let ((table (make-hash-table)))
- (dotimes (i 10)
- (setf (gethash i table) (- i)))
- (let ((plist (hash-table-plist table)))
- (list (length plist)
- (getf plist 0)
- (getf plist 2)
- (getf plist 7)
- (getf plist nil))))
- (20 0 -2 -7 nil))
-
-(deftest alist-hash-table.1
- (let* ((alist '((0 a) (1 b) (2 c)))
- (table (alist-hash-table alist)))
- (list (hash-table-count table)
- (gethash 0 table)
- (gethash 1 table)
- (gethash 2 table)
- (eq (hash-table-test-name 'eql)
- (hash-table-test table))))
- (3 (a) (b) (c) t))
-
-(deftest alist-hash-table.duplicate-keys
- (let* ((alist '((0 a) (1 b) (0 c) (1 d) (2 e)))
- (table (alist-hash-table alist)))
- (list (hash-table-count table)
- (gethash 0 table)
- (gethash 1 table)
- (gethash 2 table)))
- (3 (a) (b) (e)))
-
-(deftest plist-hash-table.1
- (let* ((plist '(:a 1 :b 2 :c 3))
- (table (plist-hash-table plist :test 'eq)))
- (list (hash-table-count table)
- (gethash :a table)
- (gethash :b table)
- (gethash :c table)
- (gethash 2 table)
- (gethash nil table)
- (eq (hash-table-test-name 'eq)
- (hash-table-test table))))
- (3 1 2 3 nil nil t))
-
-(deftest plist-hash-table.duplicate-keys
- (let* ((plist '(:a 1 :b 2 :a 3 :b 4 :c 5))
- (table (plist-hash-table plist)))
- (list (hash-table-count table)
- (gethash :a table)
- (gethash :b table)
- (gethash :c table)))
- (3 1 2 5))
-
-;;;; Functions
-
-(deftest disjoin.1
- (let ((disjunction (disjoin (lambda (x)
- (and (consp x) :cons))
- (lambda (x)
- (and (stringp x) :string)))))
- (list (funcall disjunction 'zot)
- (funcall disjunction '(foo bar))
- (funcall disjunction "test")))
- (nil :cons :string))
-
-(deftest disjoin.2
- (let ((disjunction (disjoin #'zerop)))
- (list (funcall disjunction 0)
- (funcall disjunction 1)))
- (t nil))
-
-(deftest conjoin.1
- (let ((conjunction (conjoin #'consp
- (lambda (x)
- (stringp (car x)))
- (lambda (x)
- (char (car x) 0)))))
- (list (funcall conjunction 'zot)
- (funcall conjunction '(foo))
- (funcall conjunction '("foo"))))
- (nil nil #\f))
-
-(deftest conjoin.2
- (let ((conjunction (conjoin #'zerop)))
- (list (funcall conjunction 0)
- (funcall conjunction 1)))
- (t nil))
-
-(deftest compose.1
- (let ((composite (compose '1+
- (lambda (x)
- (* x 2))
- #'read-from-string)))
- (funcall composite "1"))
- 3)
-
-(deftest compose.2
- (let ((composite
- (locally (declare (notinline compose))
- (compose '1+
- (lambda (x)
- (* x 2))
- #'read-from-string))))
- (funcall composite "2"))
- 5)
-
-(deftest compose.3
- (let ((compose-form (funcall (compiler-macro-function 'compose)
- '(compose '1+
- (lambda (x)
- (* x 2))
- #'read-from-string)
- nil)))
- (let ((fun (funcall (compile nil `(lambda () ,compose-form)))))
- (funcall fun "3")))
- 7)
-
-(deftest compose.4
- (let ((composite (compose #'zerop)))
- (list (funcall composite 0)
- (funcall composite 1)))
- (t nil))
-
-(deftest multiple-value-compose.1
- (let ((composite (multiple-value-compose
- #'truncate
- (lambda (x y)
- (values y x))
- (lambda (x)
- (with-input-from-string (s x)
- (values (read s) (read s)))))))
- (multiple-value-list (funcall composite "2 7")))
- (3 1))
-
-(deftest multiple-value-compose.2
- (let ((composite (locally (declare (notinline multiple-value-compose))
- (multiple-value-compose
- #'truncate
- (lambda (x y)
- (values y x))
- (lambda (x)
- (with-input-from-string (s x)
- (values (read s) (read s))))))))
- (multiple-value-list (funcall composite "2 11")))
- (5 1))
-
-(deftest multiple-value-compose.3
- (let ((compose-form (funcall (compiler-macro-function 'multiple-value-compose)
- '(multiple-value-compose
- #'truncate
- (lambda (x y)
- (values y x))
- (lambda (x)
- (with-input-from-string (s x)
- (values (read s) (read s)))))
- nil)))
- (let ((fun (funcall (compile nil `(lambda () ,compose-form)))))
- (multiple-value-list (funcall fun "2 9"))))
- (4 1))
-
-(deftest multiple-value-compose.4
- (let ((composite (multiple-value-compose #'truncate)))
- (multiple-value-list (funcall composite 9 2)))
- (4 1))
-
-(deftest curry.1
- (let ((curried (curry '+ 3)))
- (funcall curried 1 5))
- 9)
-
-(deftest curry.2
- (let ((curried (locally (declare (notinline curry))
- (curry '* 2 3))))
- (funcall curried 7))
- 42)
-
-(deftest curry.3
- (let ((curried-form (funcall (compiler-macro-function 'curry)
- '(curry '/ 8)
- nil)))
- (let ((fun (funcall (compile nil `(lambda () ,curried-form)))))
- (funcall fun 2)))
- 4)
-
-(deftest curry.4
- (let* ((x 1)
- (curried (curry (progn
- (incf x)
- (lambda (y z) (* x y z)))
- 3)))
- (list (funcall curried 7)
- (funcall curried 7)
- x))
- (42 42 2))
-
-(deftest rcurry.1
- (let ((r (rcurry '/ 2)))
- (funcall r 8))
- 4)
-
-(deftest rcurry.2
- (let* ((x 1)
- (curried (rcurry (progn
- (incf x)
- (lambda (y z) (* x y z)))
- 3)))
- (list (funcall curried 7)
- (funcall curried 7)
- x))
- (42 42 2))
-
-(deftest named-lambda.1
- (let ((fac (named-lambda fac (x)
- (if (> x 1)
- (* x (fac (- x 1)))
- x))))
- (funcall fac 5))
- 120)
-
-(deftest named-lambda.2
- (let ((fac (named-lambda fac (&key x)
- (if (> x 1)
- (* x (fac :x (- x 1)))
- x))))
- (funcall fac :x 5))
- 120)
-
-;;;; Lists
-
-(deftest alist-plist.1
- (alist-plist '((a . 1) (b . 2) (c . 3)))
- (a 1 b 2 c 3))
-
-(deftest plist-alist.1
- (plist-alist '(a 1 b 2 c 3))
- ((a . 1) (b . 2) (c . 3)))
-
-(deftest unionf.1
- (let* ((list (list 1 2 3))
- (orig list))
- (unionf list (list 1 2 4))
- (values (equal orig (list 1 2 3))
- (eql (length list) 4)
- (set-difference list (list 1 2 3 4))
- (set-difference (list 1 2 3 4) list)))
- t
- t
- nil
- nil)
-
-(deftest nunionf.1
- (let ((list (list 1 2 3)))
- (nunionf list (list 1 2 4))
- (values (eql (length list) 4)
- (set-difference (list 1 2 3 4) list)
- (set-difference list (list 1 2 3 4))))
- t
- nil
- nil)
-
-(deftest appendf.1
- (let* ((list (list 1 2 3))
- (orig list))
- (appendf list '(4 5 6) '(7 8))
- (list list (eq list orig)))
- ((1 2 3 4 5 6 7 8) nil))
-
-(deftest nconcf.1
- (let ((list1 (list 1 2 3))
- (list2 (list 4 5 6)))
- (nconcf list1 list2 (list 7 8 9))
- list1)
- (1 2 3 4 5 6 7 8 9))
-
-(deftest circular-list.1
- (let ((circle (circular-list 1 2 3)))
- (list (first circle)
- (second circle)
- (third circle)
- (fourth circle)
- (eq circle (nthcdr 3 circle))))
- (1 2 3 1 t))
-
-(deftest circular-list-p.1
- (let* ((circle (circular-list 1 2 3 4))
- (tree (list circle circle))
- (dotted (cons circle t))
- (proper (list 1 2 3 circle))
- (tailcirc (list* 1 2 3 circle)))
- (list (circular-list-p circle)
- (circular-list-p tree)
- (circular-list-p dotted)
- (circular-list-p proper)
- (circular-list-p tailcirc)))
- (t nil nil nil t))
-
-(deftest circular-list-p.2
- (circular-list-p 'foo)
- nil)
-
-(deftest circular-tree-p.1
- (let* ((circle (circular-list 1 2 3 4))
- (tree1 (list circle circle))
- (tree2 (let* ((level2 (list 1 nil 2))
- (level1 (list level2)))
- (setf (second level2) level1)
- level1))
- (dotted (cons circle t))
- (proper (list 1 2 3 circle))
- (tailcirc (list* 1 2 3 circle))
- (quite-proper (list 1 2 3))
- (quite-dotted (list 1 (cons 2 3))))
- (list (circular-tree-p circle)
- (circular-tree-p tree1)
- (circular-tree-p tree2)
- (circular-tree-p dotted)
- (circular-tree-p proper)
- (circular-tree-p tailcirc)
- (circular-tree-p quite-proper)
- (circular-tree-p quite-dotted)))
- (t t t t t t nil nil))
-
-(deftest circular-tree-p.2
- (alexandria:circular-tree-p '#1=(#1#))
- t)
-
-(deftest proper-list-p.1
- (let ((l1 (list 1))
- (l2 (list 1 2))
- (l3 (cons 1 2))
- (l4 (list (cons 1 2) 3))
- (l5 (circular-list 1 2)))
- (list (proper-list-p l1)
- (proper-list-p l2)
- (proper-list-p l3)
- (proper-list-p l4)
- (proper-list-p l5)))
- (t t nil t nil))
-
-(deftest proper-list-p.2
- (proper-list-p '(1 2 . 3))
- nil)
-
-(deftest proper-list.type.1
- (let ((l1 (list 1))
- (l2 (list 1 2))
- (l3 (cons 1 2))
- (l4 (list (cons 1 2) 3))
- (l5 (circular-list 1 2)))
- (list (typep l1 'proper-list)
- (typep l2 'proper-list)
- (typep l3 'proper-list)
- (typep l4 'proper-list)
- (typep l5 'proper-list)))
- (t t nil t nil))
-
-(deftest proper-list-length.1
- (values
- (proper-list-length nil)
- (proper-list-length (list 1))
- (proper-list-length (list 2 2))
- (proper-list-length (list 3 3 3))
- (proper-list-length (list 4 4 4 4))
- (proper-list-length (list 5 5 5 5 5))
- (proper-list-length (list 6 6 6 6 6 6))
- (proper-list-length (list 7 7 7 7 7 7 7))
- (proper-list-length (list 8 8 8 8 8 8 8 8))
- (proper-list-length (list 9 9 9 9 9 9 9 9 9)))
- 0 1 2 3 4 5 6 7 8 9)
-
-(deftest proper-list-length.2
- (flet ((plength (x)
- (handler-case
- (proper-list-length x)
- (type-error ()
- :ok))))
- (values
- (plength (list* 1))
- (plength (list* 2 2))
- (plength (list* 3 3 3))
- (plength (list* 4 4 4 4))
- (plength (list* 5 5 5 5 5))
- (plength (list* 6 6 6 6 6 6))
- (plength (list* 7 7 7 7 7 7 7))
- (plength (list* 8 8 8 8 8 8 8 8))
- (plength (list* 9 9 9 9 9 9 9 9 9))))
- :ok :ok :ok
- :ok :ok :ok
- :ok :ok :ok)
-
-(deftest lastcar.1
- (let ((l1 (list 1))
- (l2 (list 1 2)))
- (list (lastcar l1)
- (lastcar l2)))
- (1 2))
-
-(deftest lastcar.error.2
- (handler-case
- (progn
- (lastcar (circular-list 1 2 3))
- nil)
- (error ()
- t))
- t)
-
-(deftest setf-lastcar.1
- (let ((l (list 1 2 3 4)))
- (values (lastcar l)
- (progn
- (setf (lastcar l) 42)
- (lastcar l))))
- 4
- 42)
-
-(deftest setf-lastcar.2
- (let ((l (circular-list 1 2 3)))
- (multiple-value-bind (res err)
- (ignore-errors (setf (lastcar l) 4))
- (typep err 'type-error)))
- t)
-
-(deftest make-circular-list.1
- (let ((l (make-circular-list 3 :initial-element :x)))
- (setf (car l) :y)
- (list (eq l (nthcdr 3 l))
- (first l)
- (second l)
- (third l)
- (fourth l)))
- (t :y :x :x :y))
-
-(deftest circular-list.type.1
- (let* ((l1 (list 1 2 3))
- (l2 (circular-list 1 2 3))
- (l3 (list* 1 2 3 l2)))
- (list (typep l1 'circular-list)
- (typep l2 'circular-list)
- (typep l3 'circular-list)))
- (nil t t))
-
-(deftest ensure-list.1
- (let ((x (list 1))
- (y 2))
- (list (ensure-list x)
- (ensure-list y)))
- ((1) (2)))
-
-(deftest ensure-cons.1
- (let ((x (cons 1 2))
- (y nil)
- (z "foo"))
- (values (ensure-cons x)
- (ensure-cons y)
- (ensure-cons z)))
- (1 . 2)
- (nil)
- ("foo"))
-
-(deftest setp.1
- (setp '(1))
- t)
-
-(deftest setp.2
- (setp nil)
- t)
-
-(deftest setp.3
- (setp "foo")
- nil)
-
-(deftest setp.4
- (setp '(1 2 3 1))
- nil)
-
-(deftest setp.5
- (setp '(1 2 3))
- t)
-
-(deftest setp.6
- (setp '(a :a))
- t)
-
-(deftest setp.7
- (setp '(a :a) :key 'character)
- nil)
-
-(deftest setp.8
- (setp '(a :a) :key 'character :test (constantly nil))
- t)
-
-(deftest set-equal.1
- (set-equal '(1 2 3) '(3 1 2))
- t)
-
-(deftest set-equal.2
- (set-equal '("Xa") '("Xb")
- :test (lambda (a b) (eql (char a 0) (char b 0))))
- t)
-
-(deftest set-equal.3
- (set-equal '(1 2) '(4 2))
- nil)
-
-(deftest set-equal.4
- (set-equal '(a b c) '(:a :b :c) :key 'string :test 'equal)
- t)
-
-(deftest set-equal.5
- (set-equal '(a d c) '(:a :b :c) :key 'string :test 'equal)
- nil)
-
-(deftest set-equal.6
- (set-equal '(a b c) '(a b c d))
- nil)
-
-(deftest map-product.1
- (map-product 'cons '(2 3) '(1 4))
- ((2 . 1) (2 . 4) (3 . 1) (3 . 4)))
-
-(deftest map-product.2
- (map-product #'cons '(2 3) '(1 4))
- ((2 . 1) (2 . 4) (3 . 1) (3 . 4)))
-
-(deftest flatten.1
- (flatten '((1) 2 (((3 4))) ((((5)) 6)) 7))
- (1 2 3 4 5 6 7))
-
-(deftest remove-from-plist.1
- (let ((orig '(a 1 b 2 c 3 d 4)))
- (list (remove-from-plist orig 'a 'c)
- (remove-from-plist orig 'b 'd)
- (remove-from-plist orig 'b)
- (remove-from-plist orig 'a)
- (remove-from-plist orig 'd 42 "zot")
- (remove-from-plist orig 'a 'b 'c 'd)
- (remove-from-plist orig 'a 'b 'c 'd 'x)
- (equal orig '(a 1 b 2 c 3 d 4))))
- ((b 2 d 4)
- (a 1 c 3)
- (a 1 c 3 d 4)
- (b 2 c 3 d 4)
- (a 1 b 2 c 3)
- nil
- nil
- t))
-
-(deftest delete-from-plist.1
- (let ((orig '(a 1 b 2 c 3 d 4 d 5)))
- (list (delete-from-plist (copy-list orig) 'a 'c)
- (delete-from-plist (copy-list orig) 'b 'd)
- (delete-from-plist (copy-list orig) 'b)
- (delete-from-plist (copy-list orig) 'a)
- (delete-from-plist (copy-list orig) 'd 42 "zot")
- (delete-from-plist (copy-list orig) 'a 'b 'c 'd)
- (delete-from-plist (copy-list orig) 'a 'b 'c 'd 'x)
- (equal orig (delete-from-plist orig))
- (eq orig (delete-from-plist orig))))
- ((b 2 d 4 d 5)
- (a 1 c 3)
- (a 1 c 3 d 4 d 5)
- (b 2 c 3 d 4 d 5)
- (a 1 b 2 c 3)
- nil
- nil
- t
- t))
-
-(deftest mappend.1
- (mappend (compose 'list '*) '(1 2 3) '(1 2 3))
- (1 4 9))
-
-(deftest assoc-value.1
- (let ((key1 '(complex key))
- (key2 'simple-key)
- (alist '())
- (result '()))
- (push 1 (assoc-value alist key1 :test #'equal))
- (push 2 (assoc-value alist key1 :test 'equal))
- (push 42 (assoc-value alist key2))
- (push 43 (assoc-value alist key2 :test 'eq))
- (push (assoc-value alist key1 :test #'equal) result)
- (push (assoc-value alist key2) result)
-
- (push 'very (rassoc-value alist (list 2 1) :test #'equal))
- (push (cdr (assoc '(very complex key) alist :test #'equal)) result)
- result)
- ((2 1) (43 42) (2 1)))
-
-;;;; Numbers
-
-(deftest clamp.1
- (list (clamp 1.5 1 2)
- (clamp 2.0 1 2)
- (clamp 1.0 1 2)
- (clamp 3 1 2)
- (clamp 0 1 2))
- (1.5 2.0 1.0 2 1))
-
-(deftest gaussian-random.1
- (let ((min -0.2)
- (max +0.2))
- (multiple-value-bind (g1 g2)
- (gaussian-random min max)
- (values (<= min g1 max)
- (<= min g2 max)
- (/= g1 g2) ;uh
- )))
- t
- t
- t)
-
-#+sbcl
-(deftest gaussian-random.2
- (handler-case
- (sb-ext:with-timeout 2
- (progn
- (loop
- :repeat 10000
- :do (gaussian-random 0 nil))
- 'done))
- (sb-ext:timeout ()
- 'timed-out))
- done)
-
-(deftest iota.1
- (iota 3)
- (0 1 2))
-
-(deftest iota.2
- (iota 3 :start 0.0d0)
- (0.0d0 1.0d0 2.0d0))
-
-(deftest iota.3
- (iota 3 :start 2 :step 3.0)
- (2.0 5.0 8.0))
-
-(deftest map-iota.1
- (let (all)
- (declare (notinline map-iota))
- (values (map-iota (lambda (x) (push x all))
- 3
- :start 2
- :step 1.1d0)
- all))
- 3
- (4.2d0 3.1d0 2.0d0))
-
-(deftest lerp.1
- (lerp 0.5 1 2)
- 1.5)
-
-(deftest lerp.2
- (lerp 0.1 1 2)
- 1.1)
-
-(deftest lerp.3
- (lerp 0.1 4 25)
- 6.1)
-
-(deftest mean.1
- (mean '(1 2 3))
- 2)
-
-(deftest mean.2
- (mean '(1 2 3 4))
- 5/2)
-
-(deftest mean.3
- (mean '(1 2 10))
- 13/3)
-
-(deftest median.1
- (median '(100 0 99 1 98 2 97))
- 97)
-
-(deftest median.2
- (median '(100 0 99 1 98 2 97 96))
- 193/2)
-
-(deftest variance.1
- (variance (list 1 2 3))
- 2/3)
-
-(deftest standard-deviation.1
- (< 0 (standard-deviation (list 1 2 3)) 1)
- t)
-
-(deftest maxf.1
- (let ((x 1))
- (maxf x 2)
- x)
- 2)
-
-(deftest maxf.2
- (let ((x 1))
- (maxf x 0)
- x)
- 1)
-
-(deftest maxf.3
- (let ((x 1)
- (c 0))
- (maxf x (incf c))
- (list x c))
- (1 1))
-
-(deftest maxf.4
- (let ((xv (vector 0 0 0))
- (p 0))
- (maxf (svref xv (incf p)) (incf p))
- (list p xv))
- (2 #(0 2 0)))
-
-(deftest minf.1
- (let ((y 1))
- (minf y 0)
- y)
- 0)
-
-(deftest minf.2
- (let ((xv (vector 10 10 10))
- (p 0))
- (minf (svref xv (incf p)) (incf p))
- (list p xv))
- (2 #(10 2 10)))
-
-(deftest subfactorial.1
- (mapcar #'subfactorial (iota 22))
- (1
- 0
- 1
- 2
- 9
- 44
- 265
- 1854
- 14833
- 133496
- 1334961
- 14684570
- 176214841
- 2290792932
- 32071101049
- 481066515734
- 7697064251745
- 130850092279664
- 2355301661033953
- 44750731559645106
- 895014631192902121
- 18795307255050944540))
-
-;;;; Arrays
-
-#+nil
-(deftest array-index.type)
-
-#+nil
-(deftest copy-array)
-
-;;;; Sequences
-
-(deftest rotate.1
- (list (rotate (list 1 2 3) 0)
- (rotate (list 1 2 3) 1)
- (rotate (list 1 2 3) 2)
- (rotate (list 1 2 3) 3)
- (rotate (list 1 2 3) 4))
- ((1 2 3)
- (3 1 2)
- (2 3 1)
- (1 2 3)
- (3 1 2)))
-
-(deftest rotate.2
- (list (rotate (vector 1 2 3 4) 0)
- (rotate (vector 1 2 3 4))
- (rotate (vector 1 2 3 4) 2)
- (rotate (vector 1 2 3 4) 3)
- (rotate (vector 1 2 3 4) 4)
- (rotate (vector 1 2 3 4) 5))
- (#(1 2 3 4)
- #(4 1 2 3)
- #(3 4 1 2)
- #(2 3 4 1)
- #(1 2 3 4)
- #(4 1 2 3)))
-
-(deftest rotate.3
- (list (rotate (list 1 2 3) 0)
- (rotate (list 1 2 3) -1)
- (rotate (list 1 2 3) -2)
- (rotate (list 1 2 3) -3)
- (rotate (list 1 2 3) -4))
- ((1 2 3)
- (2 3 1)
- (3 1 2)
- (1 2 3)
- (2 3 1)))
-
-(deftest rotate.4
- (list (rotate (vector 1 2 3 4) 0)
- (rotate (vector 1 2 3 4) -1)
- (rotate (vector 1 2 3 4) -2)
- (rotate (vector 1 2 3 4) -3)
- (rotate (vector 1 2 3 4) -4)
- (rotate (vector 1 2 3 4) -5))
- (#(1 2 3 4)
- #(2 3 4 1)
- #(3 4 1 2)
- #(4 1 2 3)
- #(1 2 3 4)
- #(2 3 4 1)))
-
-(deftest rotate.5
- (values (rotate (list 1) 17)
- (rotate (list 1) -5))
- (1)
- (1))
-
-(deftest shuffle.1
- (let ((s (shuffle (iota 100))))
- (list (equal s (iota 100))
- (every (lambda (x)
- (member x s))
- (iota 100))
- (every (lambda (x)
- (typep x '(integer 0 99)))
- s)))
- (nil t t))
-
-(deftest shuffle.2
- (let ((s (shuffle (coerce (iota 100) 'vector))))
- (list (equal s (coerce (iota 100) 'vector))
- (every (lambda (x)
- (find x s))
- (iota 100))
- (every (lambda (x)
- (typep x '(integer 0 99)))
- s)))
- (nil t t))
-
-(deftest shuffle.3
- (let* ((orig (coerce (iota 21) 'vector))
- (copy (copy-seq orig)))
- (shuffle copy :start 10 :end 15)
- (list (every #'eql (subseq copy 0 10) (subseq orig 0 10))
- (every #'eql (subseq copy 15) (subseq orig 15))))
- (t t))
-
-(deftest random-elt.1
- (let ((s1 #(1 2 3 4))
- (s2 '(1 2 3 4)))
- (list (dotimes (i 1000 nil)
- (unless (member (random-elt s1) s2)
- (return nil))
- (when (/= (random-elt s1) (random-elt s1))
- (return t)))
- (dotimes (i 1000 nil)
- (unless (member (random-elt s2) s2)
- (return nil))
- (when (/= (random-elt s2) (random-elt s2))
- (return t)))))
- (t t))
-
-(deftest removef.1
- (let* ((x '(1 2 3))
- (x* x)
- (y #(1 2 3))
- (y* y))
- (removef x 1)
- (removef y 3)
- (list x x* y y*))
- ((2 3)
- (1 2 3)
- #(1 2)
- #(1 2 3)))
-
-(deftest deletef.1
- (let* ((x (list 1 2 3))
- (x* x)
- (y (vector 1 2 3)))
- (deletef x 2)
- (deletef y 1)
- (list x x* y))
- ((1 3)
- (1 3)
- #(2 3)))
-
-(deftest map-permutations.1
- (let ((seq (list 1 2 3))
- (seen nil)
- (ok t))
- (map-permutations (lambda (s)
- (unless (set-equal s seq)
- (setf ok nil))
- (when (member s seen :test 'equal)
- (setf ok nil))
- (push s seen))
- seq
- :copy t)
- (values ok (length seen)))
- t
- 6)
-
-(deftest proper-sequence.type.1
- (mapcar (lambda (x)
- (typep x 'proper-sequence))
- (list (list 1 2 3)
- (vector 1 2 3)
- #2a((1 2) (3 4))
- (circular-list 1 2 3 4)))
- (t t nil nil))
-
-(deftest emptyp.1
- (mapcar #'emptyp
- (list (list 1)
- (circular-list 1)
- nil
- (vector)
- (vector 1)))
- (nil nil t t nil))
-
-(deftest sequence-of-length-p.1
- (mapcar #'sequence-of-length-p
- (list nil
- #()
- (list 1)
- (vector 1)
- (list 1 2)
- (vector 1 2)
- (list 1 2)
- (vector 1 2)
- (list 1 2)
- (vector 1 2))
- (list 0
- 0
- 1
- 1
- 2
- 2
- 1
- 1
- 4
- 4))
- (t t t t t t nil nil nil nil))
-
-(deftest length=.1
- (mapcar #'length=
- (list nil
- #()
- (list 1)
- (vector 1)
- (list 1 2)
- (vector 1 2)
- (list 1 2)
- (vector 1 2)
- (list 1 2)
- (vector 1 2))
- (list 0
- 0
- 1
- 1
- 2
- 2
- 1
- 1
- 4
- 4))
- (t t t t t t nil nil nil nil))
-
-(deftest length=.2
- ;; test the compiler macro
- (macrolet ((x (&rest args)
- (funcall
- (compile nil
- `(lambda ()
- (length= ,@args))))))
- (list (x 2 '(1 2))
- (x '(1 2) '(3 4))
- (x '(1 2) 2)
- (x '(1 2) 2 '(3 4))
- (x 1 2 3)))
- (t t t t nil))
-
-(deftest copy-sequence.1
- (let ((l (list 1 2 3))
- (v (vector #\a #\b #\c)))
- (declare (notinline copy-sequence))
- (let ((l.list (copy-sequence 'list l))
- (l.vector (copy-sequence 'vector l))
- (l.spec-v (copy-sequence '(vector fixnum) l))
- (v.vector (copy-sequence 'vector v))
- (v.list (copy-sequence 'list v))
- (v.string (copy-sequence 'string v)))
- (list (member l (list l.list l.vector l.spec-v))
- (member v (list v.vector v.list v.string))
- (equal l.list l)
- (equalp l.vector #(1 2 3))
- (type= (upgraded-array-element-type 'fixnum)
- (array-element-type l.spec-v))
- (equalp v.vector v)
- (equal v.list '(#\a #\b #\c))
- (equal "abc" v.string))))
- (nil nil t t t t t t))
-
-(deftest first-elt.1
- (mapcar #'first-elt
- (list (list 1 2 3)
- "abc"
- (vector :a :b :c)))
- (1 #\a :a))
-
-(deftest first-elt.error.1
- (mapcar (lambda (x)
- (handler-case
- (first-elt x)
- (type-error ()
- :type-error)))
- (list nil
- #()
- 12
- :zot))
- (:type-error
- :type-error
- :type-error
- :type-error))
-
-(deftest setf-first-elt.1
- (let ((l (list 1 2 3))
- (s (copy-seq "foobar"))
- (v (vector :a :b :c)))
- (setf (first-elt l) -1
- (first-elt s) #\x
- (first-elt v) 'zot)
- (values l s v))
- (-1 2 3)
- "xoobar"
- #(zot :b :c))
-
-(deftest setf-first-elt.error.1
- (let ((l 'foo))
- (multiple-value-bind (res err)
- (ignore-errors (setf (first-elt l) 4))
- (typep err 'type-error)))
- t)
-
-(deftest last-elt.1
- (mapcar #'last-elt
- (list (list 1 2 3)
- (vector :a :b :c)
- "FOOBAR"
- #*001
- #*010))
- (3 :c #\R 1 0))
-
-(deftest last-elt.error.1
- (mapcar (lambda (x)
- (handler-case
- (last-elt x)
- (type-error ()
- :type-error)))
- (list nil
- #()
- 12
- :zot
- (circular-list 1 2 3)
- (list* 1 2 3 (circular-list 4 5))))
- (:type-error
- :type-error
- :type-error
- :type-error
- :type-error
- :type-error))
-
-(deftest setf-last-elt.1
- (let ((l (list 1 2 3))
- (s (copy-seq "foobar"))
- (b (copy-seq #*010101001)))
- (setf (last-elt l) '???
- (last-elt s) #\?
- (last-elt b) 0)
- (values l s b))
- (1 2 ???)
- "fooba?"
- #*010101000)
-
-(deftest setf-last-elt.error.1
- (handler-case
- (setf (last-elt 'foo) 13)
- (type-error ()
- :type-error))
- :type-error)
-
-(deftest starts-with.1
- (list (starts-with 1 '(1 2 3))
- (starts-with 1 #(1 2 3))
- (starts-with #\x "xyz")
- (starts-with 2 '(1 2 3))
- (starts-with 3 #(1 2 3))
- (starts-with 1 1)
- (starts-with nil nil))
- (t t t nil nil nil nil))
-
-(deftest starts-with.2
- (values (starts-with 1 '(-1 2 3) :key '-)
- (starts-with "foo" '("foo" "bar") :test 'equal)
- (starts-with "f" '(#\f) :key 'string :test 'equal)
- (starts-with -1 '(0 1 2) :key #'1+)
- (starts-with "zot" '("ZOT") :test 'equal))
- t
- t
- t
- nil
- nil)
-
-(deftest ends-with.1
- (list (ends-with 3 '(1 2 3))
- (ends-with 3 #(1 2 3))
- (ends-with #\z "xyz")
- (ends-with 2 '(1 2 3))
- (ends-with 1 #(1 2 3))
- (ends-with 1 1)
- (ends-with nil nil))
- (t t t nil nil nil nil))
-
-(deftest ends-with.2
- (values (ends-with 2 '(0 13 1) :key '1+)
- (ends-with "foo" (vector "bar" "foo") :test 'equal)
- (ends-with "X" (vector 1 2 #\X) :key 'string :test 'equal)
- (ends-with "foo" "foo" :test 'equal))
- t
- t
- t
- nil)
-
-(deftest ends-with.error.1
- (handler-case
- (ends-with 3 (circular-list 3 3 3 1 3 3))
- (type-error ()
- :type-error))
- :type-error)
-
-(deftest sequences.passing-improper-lists
- (macrolet ((signals-error-p (form)
- `(handler-case
- (progn ,form nil)
- (type-error (e)
- t)))
- (cut (fn &rest args)
- (with-gensyms (arg)
- (print`(lambda (,arg)
- (apply ,fn (list ,@(substitute arg '_ args))))))))
- (let ((circular-list (make-circular-list 5 :initial-element :foo))
- (dotted-list (list* 'a 'b 'c 'd)))
- (loop for nth from 0
- for fn in (list
- (cut #'lastcar _)
- (cut #'rotate _ 3)
- (cut #'rotate _ -3)
- (cut #'shuffle _)
- (cut #'random-elt _)
- (cut #'last-elt _)
- (cut #'ends-with :foo _))
- nconcing
- (let ((on-circular-p (signals-error-p (funcall fn circular-list)))
- (on-dotted-p (signals-error-p (funcall fn dotted-list))))
- (when (or (not on-circular-p) (not on-dotted-p))
- (append
- (unless on-circular-p
- (let ((*print-circle* t))
- (list
- (format nil
- "No appropriate error signalled when passing ~S to ~Ath entry."
- circular-list nth))))
- (unless on-dotted-p
- (list
- (format nil
- "No appropriate error signalled when passing ~S to ~Ath entry."
- dotted-list nth)))))))))
- nil)
-
-;;;; IO
-
-(deftest read-stream-content-into-string.1
- (values (with-input-from-string (stream "foo bar")
- (read-stream-content-into-string stream))
- (with-input-from-string (stream "foo bar")
- (read-stream-content-into-string stream :buffer-size 1))
- (with-input-from-string (stream "foo bar")
- (read-stream-content-into-string stream :buffer-size 6))
- (with-input-from-string (stream "foo bar")
- (read-stream-content-into-string stream :buffer-size 7)))
- "foo bar"
- "foo bar"
- "foo bar"
- "foo bar")
-
-(deftest read-stream-content-into-string.2
- (handler-case
- (let ((stream (make-broadcast-stream)))
- (read-stream-content-into-string stream :buffer-size 0))
- (type-error ()
- :type-error))
- :type-error)
-
-#+(or)
-(defvar *octets*
- (map '(simple-array (unsigned-byte 8) (7)) #'char-code "foo bar"))
-
-#+(or)
-(deftest read-stream-content-into-byte-vector.1
- (values (with-input-from-byte-vector (stream *octets*)
- (read-stream-content-into-byte-vector stream))
- (with-input-from-byte-vector (stream *octets*)
- (read-stream-content-into-byte-vector stream :initial-size 1))
- (with-input-from-byte-vector (stream *octets*)
- (read-stream-content-into-byte-vector stream 'alexandria::%length 6))
- (with-input-from-byte-vector (stream *octets*)
- (read-stream-content-into-byte-vector stream 'alexandria::%length 3)))
- *octets*
- *octets*
- *octets*
- (subseq *octets* 0 3))
-
-(deftest read-stream-content-into-byte-vector.2
- (handler-case
- (let ((stream (make-broadcast-stream)))
- (read-stream-content-into-byte-vector stream :initial-size 0))
- (type-error ()
- :type-error))
- :type-error)
-
-;;;; Macros
-
-(deftest with-unique-names.1
- (let ((*gensym-counter* 0))
- (let ((syms (with-unique-names (foo bar quux)
- (list foo bar quux))))
- (list (find-if #'symbol-package syms)
- (equal '("FOO0" "BAR1" "QUUX2")
- (mapcar #'symbol-name syms)))))
- (nil t))
-
-(deftest with-unique-names.2
- (let ((*gensym-counter* 0))
- (let ((syms (with-unique-names ((foo "_foo_") (bar -bar-) (quux #\q))
- (list foo bar quux))))
- (list (find-if #'symbol-package syms)
- (equal '("_foo_0" "-BAR-1" "q2")
- (mapcar #'symbol-name syms)))))
- (nil t))
-
-(deftest with-unique-names.3
- (let ((*gensym-counter* 0))
- (multiple-value-bind (res err)
- (ignore-errors
- (eval
- '(let ((syms
- (with-unique-names ((foo "_foo_") (bar -bar-) (quux 42))
- (list foo bar quux))))
- (list (find-if #'symbol-package syms)
- (equal '("_foo_0" "-BAR-1" "q2")
- (mapcar #'symbol-name syms))))))
- (errorp err)))
- t)
-
-(deftest once-only.1
- (macrolet ((cons1.good (x)
- (once-only (x)
- `(cons ,x ,x)))
- (cons1.bad (x)
- `(cons ,x ,x)))
- (let ((y 0))
- (list (cons1.good (incf y))
- y
- (cons1.bad (incf y))
- y)))
- ((1 . 1) 1 (2 . 3) 3))
-
-(deftest once-only.2
- (macrolet ((cons1 (x)
- (once-only ((y x))
- `(cons ,y ,y))))
- (let ((z 0))
- (list (cons1 (incf z))
- z
- (cons1 (incf z)))))
- ((1 . 1) 1 (2 . 2)))
-
-(deftest parse-body.1
- (parse-body '("doc" "body") :documentation t)
- ("body")
- nil
- "doc")
-
-(deftest parse-body.2
- (parse-body '("body") :documentation t)
- ("body")
- nil
- nil)
-
-(deftest parse-body.3
- (parse-body '("doc" "body"))
- ("doc" "body")
- nil
- nil)
-
-(deftest parse-body.4
- (parse-body '((declare (foo)) "doc" (declare (bar)) body) :documentation t)
- (body)
- ((declare (foo)) (declare (bar)))
- "doc")
-
-(deftest parse-body.5
- (parse-body '((declare (foo)) "doc" (declare (bar)) body))
- ("doc" (declare (bar)) body)
- ((declare (foo)))
- nil)
-
-(deftest parse-body.6
- (multiple-value-bind (res err)
- (ignore-errors
- (parse-body '("foo" "bar" "quux")
- :documentation t))
- (errorp err))
- t)
-
-;;;; Symbols
-
-(deftest ensure-symbol.1
- (ensure-symbol :cons :cl)
- cons
- :external)
-
-(deftest ensure-symbol.2
- (ensure-symbol "CONS" :alexandria)
- cons
- :inherited)
-
-(deftest ensure-symbol.3
- (ensure-symbol 'foo :keyword)
- :foo
- :external)
-
-(deftest ensure-symbol.4
- (ensure-symbol #\* :alexandria)
- *
- :inherited)
-
-(deftest format-symbol.1
- (let ((s (format-symbol nil '#:x-~d 13)))
- (list (symbol-package s)
- (string= (string '#:x-13) (symbol-name s))))
- (nil t))
-
-(deftest format-symbol.2
- (format-symbol :keyword '#:sym-~a (string :bolic))
- :sym-bolic)
-
-(deftest format-symbol.3
- (let ((*package* (find-package :cl)))
- (format-symbol t '#:find-~a (string 'package)))
- find-package)
-
-(deftest make-keyword.1
- (list (make-keyword 'zot)
- (make-keyword "FOO")
- (make-keyword #\Q))
- (:zot :foo :q))
-
-(deftest make-gensym-list.1
- (let ((*gensym-counter* 0))
- (let ((syms (make-gensym-list 3 "FOO")))
- (list (find-if 'symbol-package syms)
- (equal '("FOO0" "FOO1" "FOO2")
- (mapcar 'symbol-name syms)))))
- (nil t))
-
-(deftest make-gensym-list.2
- (let ((*gensym-counter* 0))
- (let ((syms (make-gensym-list 3)))
- (list (find-if 'symbol-package syms)
- (equal '("G0" "G1" "G2")
- (mapcar 'symbol-name syms)))))
- (nil t))
-
-;;;; Type-system
-
-(deftest of-type.1
- (locally
- (declare (notinline of-type))
- (let ((f (of-type 'string)))
- (list (funcall f "foo")
- (funcall f 'bar))))
- (t nil))
-
-(deftest type=.1
- (type= 'string 'string)
- t
- t)
-
-(deftest type=.2
- (type= 'list '(or null cons))
- t
- t)
-
-(deftest type=.3
- (type= 'null '(and symbol list))
- t
- t)
-
-(deftest type=.4
- (type= 'string '(satisfies emptyp))
- nil
- nil)
-
-(deftest type=.5
- (type= 'string 'list)
- nil
- t)
-
-(macrolet
- ((test (type numbers)
- `(deftest ,(format-symbol t '#:cdr5.~a (string type))
- (let ((numbers ,numbers))
- (values (mapcar (of-type ',(format-symbol t '#:negative-~a (string type))) numbers)
- (mapcar (of-type ',(format-symbol t '#:non-positive-~a (string type))) numbers)
- (mapcar (of-type ',(format-symbol t '#:non-negative-~a (string type))) numbers)
- (mapcar (of-type ',(format-symbol t '#:positive-~a (string type))) numbers)))
- (t t t nil nil nil nil)
- (t t t t nil nil nil)
- (nil nil nil t t t t)
- (nil nil nil nil t t t))))
- (test fixnum (list most-negative-fixnum -42 -1 0 1 42 most-positive-fixnum))
- (test integer (list (1- most-negative-fixnum) -42 -1 0 1 42 (1+ most-positive-fixnum)))
- (test rational (list (1- most-negative-fixnum) -42/13 -1 0 1 42/13 (1+ most-positive-fixnum)))
- (test real (list most-negative-long-float -42/13 -1 0 1 42/13 most-positive-long-float))
- (test float (list most-negative-short-float -42.02 -1.0 0.0 1.0 42.02 most-positive-short-float))
- (test short-float (list most-negative-short-float -42.02s0 -1.0s0 0.0s0 1.0s0 42.02s0 most-positive-short-float))
- (test single-float (list most-negative-single-float -42.02f0 -1.0f0 0.0f0 1.0f0 42.02f0 most-positive-single-float))
- (test double-float (list most-negative-double-float -42.02d0 -1.0d0 0.0d0 1.0d0 42.02d0 most-positive-double-float))
- (test long-float (list most-negative-long-float -42.02l0 -1.0l0 0.0l0 1.0l0 42.02l0 most-positive-long-float)))
-
-;;;; Bindings
-
-(declaim (notinline opaque))
-(defun opaque (x)
- x)
-
-(deftest if-let.1
- (if-let (x (opaque :ok))
- x
- :bad)
- :ok)
-
-(deftest if-let.2
- (if-let (x (opaque nil))
- :bad
- (and (not x) :ok))
- :ok)
-
-(deftest if-let.3
- (let ((x 1))
- (if-let ((x 2)
- (y x))
- (+ x y)
- :oops))
- 3)
-
-(deftest if-let.4
- (if-let ((x 1)
- (y nil))
- :oops
- (and (not y) x))
- 1)
-
-(deftest if-let.5
- (if-let (x)
- :oops
- (not x))
- t)
-
-(deftest if-let.error.1
- (handler-case
- (eval '(if-let x
- :oops
- :oops))
- (type-error ()
- :type-error))
- :type-error)
-
-(deftest when-let.1
- (when-let (x (opaque :ok))
- (setf x (cons x x))
- x)
- (:ok . :ok))
-
-(deftest when-let.2
- (when-let ((x 1)
- (y nil)
- (z 3))
- :oops)
- nil)
-
-(deftest when-let.3
- (let ((x 1))
- (when-let ((x 2)
- (y x))
- (+ x y)))
- 3)
-
-(deftest when-let.error.1
- (handler-case
- (eval '(when-let x :oops))
- (type-error ()
- :type-error))
- :type-error)
-
-(deftest when-let*.1
- (let ((x 1))
- (when-let* ((x 2)
- (y x))
- (+ x y)))
- 4)
-
-(deftest when-let*.2
- (let ((y 1))
- (when-let* (x y)
- (1+ x)))
- 2)
-
-(deftest when-let*.3
- (when-let* ((x t)
- (y (consp x))
- (z (error "OOPS")))
- t)
- nil)
-
-(deftest when-let*.error.1
- (handler-case
- (eval '(when-let* x :oops))
- (type-error ()
- :type-error))
- :type-error)
-
-(deftest doplist.1
- (let (keys values)
- (doplist (k v '(a 1 b 2 c 3) (values t (reverse keys) (reverse values) k v))
- (push k keys)
- (push v values)))
- t
- (a b c)
- (1 2 3)
- nil
- nil)
-
-(deftest count-permutations.1
- (values (count-permutations 31 7)
- (count-permutations 1 1)
- (count-permutations 2 1)
- (count-permutations 2 2)
- (count-permutations 3 2)
- (count-permutations 3 1))
- 13253058000
- 1
- 2
- 2
- 6
- 3)
-
-(deftest binomial-coefficient.1
- (alexandria:binomial-coefficient 1239 139)
- 28794902202288970200771694600561826718847179309929858835480006683522184441358211423695124921058123706380656375919763349913245306834194782172712255592710204598527867804110129489943080460154)
-
-;; Exercise bignum case (at least on x86).
-(deftest binomial-coefficient.2
- (alexandria:binomial-coefficient 2000000000000 20)
- 430998041177272843950422879590338454856322722740402365741730748431530623813012487773080486408378680853987520854296499536311275320016878730999689934464711239072435565454954447356845336730100919970769793030177499999999900000000000)
-
-(deftest copy-stream.1
- (let ((data "sdkfjhsakfh weior763495ewofhsdfk sdfadlkfjhsadf woif sdlkjfhslkdfh sdklfjh"))
- (values (equal data
- (with-input-from-string (in data)
- (with-output-to-string (out)
- (alexandria:copy-stream in out))))
- (equal (subseq data 10 20)
- (with-input-from-string (in data)
- (with-output-to-string (out)
- (alexandria:copy-stream in out :start 10 :end 20))))
- (equal (subseq data 10)
- (with-input-from-string (in data)
- (with-output-to-string (out)
- (alexandria:copy-stream in out :start 10))))
- (equal (subseq data 0 20)
- (with-input-from-string (in data)
- (with-output-to-string (out)
- (alexandria:copy-stream in out :end 20))))))
- t
- t
- t
- t)
-
-(deftest extremum.1
- (let ((n 0))
- (dotimes (i 10)
- (let ((data (shuffle (coerce (iota 10000 :start i) 'vector)))
- (ok t))
- (unless (eql i (extremum data #'<))
- (setf ok nil))
- (unless (eql i (extremum (coerce data 'list) #'<))
- (setf ok nil))
- (unless (eql (+ 9999 i) (extremum data #'>))
- (setf ok nil))
- (unless (eql (+ 9999 i) (extremum (coerce data 'list) #'>))
- (setf ok nil))
- (when ok
- (incf n))))
- (when (eql 10 (extremum #(100 1 10 1000) #'> :start 1 :end 3))
- (incf n))
- (when (eql -1000 (extremum #(100 1 10 -1000) #'> :key 'abs))
- (incf n))
- (when (eq nil (extremum "" (lambda (a b) (error "wtf? ~S, ~S" a b))))
- (incf n))
- n)
- 13)
-
-(deftest starts-with-subseq.string
- (starts-with-subseq "f" "foo" :return-suffix t)
- t
- "oo")
-
-(deftest starts-with-subseq.vector
- (starts-with-subseq #(1) #(1 2 3) :return-suffix t)
- t
- #(2 3))
-
-(deftest starts-with-subseq.list
- (starts-with-subseq '(1) '(1 2 3) :return-suffix t)
- t
- (2 3))
-
-(deftest starts-with-subseq.start1
- (starts-with-subseq "foo" "oop" :start1 1)
- t
- nil)
-
-(deftest starts-with-subseq.start2
- (starts-with-subseq "foo" "xfoop" :start2 1)
- t
- nil)
-
-(deftest format-symbol.print-case-bound
- (let ((upper (intern "FOO-BAR"))
- (lower (intern "foo-bar"))
- (*print-escape* nil))
- (values
- (let ((*print-case* :downcase))
- (and (eq upper (format-symbol t "~A" upper))
- (eq lower (format-symbol t "~A" lower))))
- (let ((*print-case* :upcase))
- (and (eq upper (format-symbol t "~A" upper))
- (eq lower (format-symbol t "~A" lower))))
- (let ((*print-case* :capitalize))
- (and (eq upper (format-symbol t "~A" upper))
- (eq lower (format-symbol t "~A" lower))))))
- t
- t
- t)
-
-(deftest iota.fp-start-and-complex-integer-step
- (equal '(#C(0.0 0.0) #C(0.0 2.0) #C(0.0 4.0))
- (iota 3 :start 0.0 :step #C(0 2)))
- t)
-
-(deftest parse-ordinary-lambda-list.1
- (multiple-value-bind (req opt rest keys allowp aux keyp)
- (parse-ordinary-lambda-list '(a b c
- &optional o1 (o2 42) (o3 42 o3-supplied?)
- &key (k1) ((:key k2)) (k3 42 k3-supplied?))
- :normalize t)
- (and (equal '(a b c) req)
- (equal '((o1 nil nil)
- (o2 42 nil)
- (o3 42 o3-supplied?))
- opt)
- (equal '(((:k1 k1) nil nil)
- ((:key k2) nil nil)
- ((:k3 k3) 42 k3-supplied?))
- keys)
- (not allowp)
- (not aux)
- (eq t keyp)))
- t)
(DIR) diff --git a/3rdparties/software/alexandria-20181210-git/types.lisp b/3rdparties/software/alexandria-20181210-git/types.lisp
@@ -1,137 +0,0 @@
-(in-package :alexandria)
-
-(deftype array-index (&optional (length (1- array-dimension-limit)))
- "Type designator for an index into array of LENGTH: an integer between
-0 (inclusive) and LENGTH (exclusive). LENGTH defaults to one less than
-ARRAY-DIMENSION-LIMIT."
- `(integer 0 (,length)))
-
-(deftype array-length (&optional (length (1- array-dimension-limit)))
- "Type designator for a dimension of an array of LENGTH: an integer between
-0 (inclusive) and LENGTH (inclusive). LENGTH defaults to one less than
-ARRAY-DIMENSION-LIMIT."
- `(integer 0 ,length))
-
-;; This MACROLET will generate most of CDR5 (http://cdr.eurolisp.org/document/5/)
-;; except the RATIO related definitions and ARRAY-INDEX.
-(macrolet
- ((frob (type &optional (base-type type))
- (let ((subtype-names (list))
- (predicate-names (list)))
- (flet ((make-subtype-name (format-control)
- (let ((result (format-symbol :alexandria format-control
- (symbol-name type))))
- (push result subtype-names)
- result))
- (make-predicate-name (sybtype-name)
- (let ((result (format-symbol :alexandria '#:~A-p
- (symbol-name sybtype-name))))
- (push result predicate-names)
- result))
- (make-docstring (range-beg range-end range-type)
- (let ((inf (ecase range-type (:negative "-inf") (:positive "+inf"))))
- (format nil "Type specifier denoting the ~(~A~) range from ~A to ~A."
- type
- (if (equal range-beg ''*) inf (ensure-car range-beg))
- (if (equal range-end ''*) inf (ensure-car range-end))))))
- (let* ((negative-name (make-subtype-name '#:negative-~a))
- (non-positive-name (make-subtype-name '#:non-positive-~a))
- (non-negative-name (make-subtype-name '#:non-negative-~a))
- (positive-name (make-subtype-name '#:positive-~a))
- (negative-p-name (make-predicate-name negative-name))
- (non-positive-p-name (make-predicate-name non-positive-name))
- (non-negative-p-name (make-predicate-name non-negative-name))
- (positive-p-name (make-predicate-name positive-name))
- (negative-extremum)
- (positive-extremum)
- (below-zero)
- (above-zero)
- (zero))
- (setf (values negative-extremum below-zero
- above-zero positive-extremum zero)
- (ecase type
- (fixnum (values 'most-negative-fixnum -1 1 'most-positive-fixnum 0))
- (integer (values ''* -1 1 ''* 0))
- (rational (values ''* '(0) '(0) ''* 0))
- (real (values ''* '(0) '(0) ''* 0))
- (float (values ''* '(0.0E0) '(0.0E0) ''* 0.0E0))
- (short-float (values ''* '(0.0S0) '(0.0S0) ''* 0.0S0))
- (single-float (values ''* '(0.0F0) '(0.0F0) ''* 0.0F0))
- (double-float (values ''* '(0.0D0) '(0.0D0) ''* 0.0D0))
- (long-float (values ''* '(0.0L0) '(0.0L0) ''* 0.0L0))))
- `(progn
- (deftype ,negative-name ()
- ,(make-docstring negative-extremum below-zero :negative)
- `(,',base-type ,,negative-extremum ,',below-zero))
-
- (deftype ,non-positive-name ()
- ,(make-docstring negative-extremum zero :negative)
- `(,',base-type ,,negative-extremum ,',zero))
-
- (deftype ,non-negative-name ()
- ,(make-docstring zero positive-extremum :positive)
- `(,',base-type ,',zero ,,positive-extremum))
-
- (deftype ,positive-name ()
- ,(make-docstring above-zero positive-extremum :positive)
- `(,',base-type ,',above-zero ,,positive-extremum))
-
- (declaim (inline ,@predicate-names))
-
- (defun ,negative-p-name (n)
- (and (typep n ',type)
- (< n ,zero)))
-
- (defun ,non-positive-p-name (n)
- (and (typep n ',type)
- (<= n ,zero)))
-
- (defun ,non-negative-p-name (n)
- (and (typep n ',type)
- (<= ,zero n)))
-
- (defun ,positive-p-name (n)
- (and (typep n ',type)
- (< ,zero n)))))))))
- (frob fixnum integer)
- (frob integer)
- (frob rational)
- (frob real)
- (frob float)
- (frob short-float)
- (frob single-float)
- (frob double-float)
- (frob long-float))
-
-(defun of-type (type)
- "Returns a function of one argument, which returns true when its argument is
-of TYPE."
- (lambda (thing) (typep thing type)))
-
-(define-compiler-macro of-type (&whole form type &environment env)
- ;; This can yeild a big benefit, but no point inlining the function
- ;; all over the place if TYPE is not constant.
- (if (constantp type env)
- (with-gensyms (thing)
- `(lambda (,thing)
- (typep ,thing ,type)))
- form))
-
-(declaim (inline type=))
-(defun type= (type1 type2)
- "Returns a primary value of T is TYPE1 and TYPE2 are the same type,
-and a secondary value that is true is the type equality could be reliably
-determined: primary value of NIL and secondary value of T indicates that the
-types are not equivalent."
- (multiple-value-bind (sub ok) (subtypep type1 type2)
- (cond ((and ok sub)
- (subtypep type2 type1))
- (ok
- (values nil ok))
- (t
- (multiple-value-bind (sub ok) (subtypep type2 type1)
- (declare (ignore sub))
- (values nil ok))))))
-
-(define-modify-macro coercef (type-spec) coerce
- "Modify-macro for COERCE.")
(DIR) diff --git a/3rdparties/software/babel-20171227-git/.travis.yml b/3rdparties/software/babel-20171227-git/.travis.yml
@@ -1,31 +0,0 @@
-language: lisp
-
-env:
- matrix:
- - LISP=abcl
- - LISP=allegro
- - LISP=sbcl
- - LISP=sbcl32
- - LISP=ccl
- - LISP=ccl32
- - LISP=clisp
- - LISP=clisp32
- - LISP=cmucl
- - LISP=ecl
-
-matrix:
- allow_failures:
- - env: LISP=cmucl
- - env: LISP=ecl
-
-install:
- - curl -L https://github.com/luismbo/cl-travis/raw/master/install.sh | sh
- - git clone --depth=1 git://github.com/trivial-features/trivial-features.git ~/lisp/trivial-features
- - git clone https://gitlab.common-lisp.net/alexandria/alexandria.git ~/lisp/alexandria
-
-script:
- - cl -e '(ql:quickload :babel-tests)
- (unless (babel-tests:run)
- (uiop:quit 1))'
-
-sudo: required
(DIR) diff --git a/3rdparties/software/babel-20171227-git/COPYRIGHT b/3rdparties/software/babel-20171227-git/COPYRIGHT
@@ -1,20 +0,0 @@
-Copyright (C) 2007, Luis Oliveira <loliveira@common-lisp.net>
-
-Permission is hereby granted, free of charge, to any person obtaining
-a copy of this software and associated documentation files (the
-"Software"), to deal in the Software without restriction, including
-without limitation the rights to use, copy, modify, merge, publish,
-distribute, sublicense, and/or sell copies of the Software, and to
-permit persons to whom the Software is furnished to do so, subject to
-the following conditions:
-
-The above copyright notice and this permission notice shall be
-included in all copies or substantial portions of the Software.
-
-THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
-EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
-MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
-IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
-CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
-TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
-SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
(DIR) diff --git a/3rdparties/software/babel-20171227-git/HEADER b/3rdparties/software/babel-20171227-git/HEADER
@@ -1,27 +0,0 @@
-;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
-;;;
-;;; filename --- description
-;;;
-;;; Copyright (C) 2007, Luis Oliveira <loliveira@common-lisp.net>
-;;;
-;;; Permission is hereby granted, free of charge, to any person
-;;; obtaining a copy of this software and associated documentation
-;;; files (the "Software"), to deal in the Software without
-;;; restriction, including without limitation the rights to use, copy,
-;;; modify, merge, publish, distribute, sublicense, and/or sell copies
-;;; of the Software, and to permit persons to whom the Software is
-;;; furnished to do so, subject to the following conditions:
-;;;
-;;; The above copyright notice and this permission notice shall be
-;;; included in all copies or substantial portions of the Software.
-;;;
-;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
-;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
-;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
-;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
-;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
-;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
-;;; DEALINGS IN THE SOFTWARE.
-
-
(DIR) diff --git a/3rdparties/software/babel-20171227-git/NOTES b/3rdparties/software/babel-20171227-git/NOTES
@@ -1,34 +0,0 @@
-======================================
-LIST OF IDEAS AND TODO ITEMS FOR BABEL
-
- * VERY IMPORTANT: given that we steal a lot of code from OpenMCL we
- probably to license those files under the LLGPL (or is it the
- whole library?) Figure this out ASAP.
-
- * Many more tests needed.
- - test invalid sequences.
- - use more interesting test files.
- - test with big strings that when converted would need a array
- with more than array-index-limit elements.
-
- * Add support for ennforcing endiannes for multi-byte encodings like
- UTF-16 and UTF-32.
-
- * Implement more encodings. (ISO-8859-*, windows, CJK encodings, etc)
-
- * null-termination, bom-markers. Add to string-to-octets.
-
- * Unicode normalization routines?
-
- * Allow for non-fixnum indexes?
-
- * Documentation.
-
- * Address the various XXX and TODO items in the source.
-
- * Should we start adding a lot of encodings, a load-on-demand scheme
- might come in handy. It would also help with debugging.
-
- * Make the test suite reusable, very much like mappings are reusable.
-
- * Make the whole thing easier to debug.
(DIR) diff --git a/3rdparties/software/babel-20171227-git/README.md b/3rdparties/software/babel-20171227-git/README.md
@@ -1,19 +0,0 @@
-[](https://travis-ci.org/cl-babel/babel)
-
-Babel is a charset encoding/decoding library, not unlike GNU libiconv,
-but completely written in Common Lisp.
-
-It strives to achieve decent performance. To that effect, we use
-OpenMCL's approach of calculating the destination buffer size in
-advance. Most of the encoding/decoding algorithms have been adapted
-from OpenMCL's source.
-
-Another important goal is reusability. Similarly to SBCL, we define
-an interface wherein the algorithms can be reused between a variety of
-data types so long we're dealing with conversions between octets and
-unicode code points.
-
-Babel comes with converters between strings and (unsigned-byte 8)
-vectors but can be easily extended to deal with, e.g., strings and
-foreign memory, vectors and Closure's runes, etc...
-
(DIR) diff --git a/3rdparties/software/babel-20171227-git/babel-streams.asd b/3rdparties/software/babel-20171227-git/babel-streams.asd
@@ -1,38 +0,0 @@
-;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
-;;;
-;;; babel-streams.asd --- ASDF system definition for Babel streams.
-;;;
-;;; Copyright (C) 2008, Attila Lendvai <attila.lendvai@gmail.com>
-;;;
-;;; Permission is hereby granted, free of charge, to any person
-;;; obtaining a copy of this software and associated documentation
-;;; files (the "Software"), to deal in the Software without
-;;; restriction, including without limitation the rights to use, copy,
-;;; modify, merge, publish, distribute, sublicense, and/or sell copies
-;;; of the Software, and to permit persons to whom the Software is
-;;; furnished to do so, subject to the following conditions:
-;;;
-;;; The above copyright notice and this permission notice shall be
-;;; included in all copies or substantial portions of the Software.
-;;;
-;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
-;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
-;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
-;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
-;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
-;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
-;;; DEALINGS IN THE SOFTWARE.
-
-(defsystem :babel-streams
- :description "Some useful streams based on Babel's encoding code"
- :author ("Dr. Edmund Weitz"
- "Attila Lendvai <attila.lendvai@gmail.com>")
- :version "0.1.0"
- :licence "MIT"
- :depends-on (:babel :alexandria :trivial-gray-streams)
- :components
- ((:module "src"
- :serial t
- :components
- ((:file "streams")))))
(DIR) diff --git a/3rdparties/software/babel-20171227-git/babel-tests.asd b/3rdparties/software/babel-20171227-git/babel-tests.asd
@@ -1,42 +0,0 @@
-;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
-;;;
-;;; babel-tests.asd --- ASDF system definition for Babel unit tests.
-;;;
-;;; Copyright (C) 2007, Luis Oliveira <loliveira@common-lisp.net>
-;;;
-;;; Permission is hereby granted, free of charge, to any person
-;;; obtaining a copy of this software and associated documentation
-;;; files (the "Software"), to deal in the Software without
-;;; restriction, including without limitation the rights to use, copy,
-;;; modify, merge, publish, distribute, sublicense, and/or sell copies
-;;; of the Software, and to permit persons to whom the Software is
-;;; furnished to do so, subject to the following conditions:
-;;;
-;;; The above copyright notice and this permission notice shall be
-;;; included in all copies or substantial portions of the Software.
-;;;
-;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
-;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
-;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
-;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
-;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
-;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
-;;; DEALINGS IN THE SOFTWARE.
-
-(defsystem babel-tests
- :description "Unit tests for Babel."
- :depends-on (babel hu.dwim.stefil)
- :components
- ((:module "tests"
- :serial t
- :components
- ((:file "tests")))))
-
-(defmethod perform ((o test-op) (c (eql (find-system :babel-tests))))
- (funcall (intern (string '#:run) '#:babel-tests)))
-
-(defmethod operation-done-p ((o test-op) (c (eql (find-system :babel-tests))))
- nil)
-
-;;; vim: ft=lisp et
(DIR) diff --git a/3rdparties/software/babel-20171227-git/babel.asd b/3rdparties/software/babel-20171227-git/babel.asd
@@ -1,59 +0,0 @@
-;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
-;;;
-;;; babel.asd --- ASDF system definition for Babel.
-;;;
-;;; Copyright (C) 2007, Luis Oliveira <loliveira@common-lisp.net>
-;;;
-;;; Permission is hereby granted, free of charge, to any person
-;;; obtaining a copy of this software and associated documentation
-;;; files (the "Software"), to deal in the Software without
-;;; restriction, including without limitation the rights to use, copy,
-;;; modify, merge, publish, distribute, sublicense, and/or sell copies
-;;; of the Software, and to permit persons to whom the Software is
-;;; furnished to do so, subject to the following conditions:
-;;;
-;;; The above copyright notice and this permission notice shall be
-;;; included in all copies or substantial portions of the Software.
-;;;
-;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
-;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
-;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
-;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
-;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
-;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
-;;; DEALINGS IN THE SOFTWARE.
-
-(defsystem babel
- :description "Babel, a charset conversion library."
- :author "Luis Oliveira <loliveira@common-lisp.net>"
- :licence "MIT"
- :depends-on (trivial-features alexandria)
- :components
- ((:module src
- :serial t
- :components
- ((:file "packages")
- (:file "encodings")
- (:file "enc-ascii")
- (:file "enc-ebcdic")
- (:file "enc-ebcdic-int")
- (:file "enc-iso-8859")
- (:file "enc-unicode")
- (:file "enc-cp1251")
- (:file "enc-cp1252")
- (:file "jpn-table")
- (:file "enc-jpn")
- (:file "enc-gbk")
- (:file "enc-koi8")
- (:file "external-format")
- (:file "strings")
- (:file "gbk-map")
- (:file "sharp-backslash")))))
-
-(defmethod perform ((o test-op) (c (eql (find-system :babel))))
- (operate 'load-op :babel-tests)
- (operate 'test-op :babel-tests))
-
-(defmethod operation-done-p ((o test-op) (c (eql (find-system :babel))))
- nil)
(DIR) diff --git a/3rdparties/software/babel-20171227-git/doc/Makefile b/3rdparties/software/babel-20171227-git/doc/Makefile
@@ -1,31 +0,0 @@
-# -*- Mode: Makefile; tab-width: 4; indent-tabs-mode: t -*-
-
-MANUAL := "babel"
-SYSTEM := "babel"
-PACKAGES := babel babel-encodings
-TITLE := "Babel Manual"
-CSS := "default"
-
-export LISP ?= sbcl
-export SBCL_OPTIONS ?= --noinform
-
-.PHONY: all clean html pdf upload
-
-all:
- texinfo-docstrings all $(SYSTEM) $(MANUAL) $(TITLE) $(CSS) $(PACKAGES)
-
-pdf:
- texinfo-docstrings pdf $(SYSTEM) $(MANUAL) $(TITLE) $(CSS) $(PACKAGES)
-
-html:
- texinfo-docstrings html $(SYSTEM) $(MANUAL) $(TITLE) $(CSS) $(PACKAGES)
-
-upload:
-# rsync -av --delete -e ssh manual common-lisp.net:/project/FOO/public_html/
-# scp -r manual common-lisp.net:/project/cffi/public_html/
-
-clean:
- find . \( -name "*.pdf" -o -name "*.html" -o -name "*.info" -o -name "*.aux" -o -name "*.cp" -o -name "*.fn" -o -name "*.fns" -o -name "*.ky" -o -name "*.log" -o -name "*.pg" -o -name "*.toc" -o -name "*.tp" -o -name "*.vr" -o -name "*.dvi" -o -name "*.cps" -o -name "*.vrs" \) -exec rm {} \;
- rm -rf include manual
-
-# vim: ft=make ts=4 noet
(DIR) diff --git a/3rdparties/software/babel-20171227-git/doc/babel.texinfo b/3rdparties/software/babel-20171227-git/doc/babel.texinfo
@@ -1,105 +0,0 @@
-\input texinfo @c -*-texinfo-*-
-@c %**start of header
-@setfilename babel.info
-@settitle Babel Manual
-
-@c @exampleindent 2
-@c @documentencoding utf-8
-
-@c %**end of header
-
-@c for install-info
-@c @dircategory %%INFO-CATEGORY%%
-@c @direntry
-@c * babel: %%PROJECT-DESCRIPTION%%
-@c @end direntry
-
-@include macros.texinfo
-
-@c Show types, functions, and concepts in the same index.
-@syncodeindex tp cp
-@syncodeindex fn cp
-
-@copying
-@c Copyright @copyright{} 2084 John Doe <john@doe.com>
-
-@include license.texinfo
-@end copying
-
-@titlepage
-@title Babel Manual
-@subtitle draft version
-@c @author John Doe
-@page
-@vskip 0pt plus 1filll
-@insertcopying
-@end titlepage
-
-@contents
-
-@ifnottex
-@node Top
-@top babel
-@insertcopying
-@end ifnottex
-
-@c Top Menu
-@menu
-* First Chapter::
-* Comprehensive Index::
-@end menu
-
-@node First Chapter
-@chapter First Chapter
-
-Bla bla bla, bla bla bla.
-
-@section Conditions
-
-@include include/condition-babel-character-out-of-range.texinfo
-@include include/condition-babel-encodings-character-out-of-range.texinfo
-@include include/condition-babel-encodings-end-of-input-in-character.texinfo
-@include include/condition-babel-encodings-invalid-utf8-continuation-byte.texinfo
-@include include/condition-babel-encodings-invalid-utf8-starter-byte.texinfo
-@include include/condition-babel-encodings-overlong-utf8-sequence.texinfo
-@include include/condition-babel-end-of-input-in-character.texinfo
-@include include/condition-babel-invalid-utf8-continuation-byte.texinfo
-@include include/condition-babel-invalid-utf8-starter-byte.texinfo
-@include include/condition-babel-overlong-utf8-sequence.texinfo
-@include include/constant-babel-unicode-char-code-limit.texinfo
-
-@section More stuff
-
-@include include/fun-babel-encodings-get-character-encoding.texinfo
-@include include/fun-babel-encodings-list-character-encodings.texinfo
-@include include/fun-babel-encodings-lookup-mapping.texinfo
-@include include/fun-babel-list-character-encodings.texinfo
-@include include/macro-babel-encodings-with-checked-simple-vector.texinfo
-@include include/macro-babel-encodings-with-simple-vector.texinfo
-@include include/type-babel-simple-unicode-string.texinfo
-@include include/type-babel-unicode-char.texinfo
-@include include/type-babel-unicode-string.texinfo
-@include include/var-babel-encodings-star-default-character-encoding-star.texinfo
-@include include/var-babel-encodings-star-suppress-character-coding-errors-star.texinfo
-@include include/var-babel-star-default-character-encoding-star.texinfo
-@include include/var-babel-star-default-eol-style-star.texinfo
-
-@c @include include/fun-somepackage-somefunction.texinfo
-@c @include include/macro-somepackage-somemacro.texinfo
-
-@c @node First Section
-@c @section First Section
-
-@c @include include/fun-somepackage-somefunction.texinfo
-@c @include include/fun-somepackage-somefunction.texinfo
-
-
-
-@c We call this node ``Comprehensive Index'' so that texinfo's HTML
-@c output doesn't generate an index.html that'd overwrite the manual's
-@c initial page.
-@node Comprehensive Index
-@unnumbered Index
-@printindex cp
-
-@bye
(DIR) diff --git a/3rdparties/software/babel-20171227-git/doc/license.texinfo b/3rdparties/software/babel-20171227-git/doc/license.texinfo
@@ -1,20 +0,0 @@
-@quotation
-Permission is hereby granted, free of charge, to any person obtaining
-a copy of this software and associated documentation files (the
-``Software''), to deal in the Software without restriction, including
-without limitation the rights to use, copy, modify, merge, publish,
-distribute, sublicense, and/or sell copies of the Software, and to
-permit persons to whom the Software is furnished to do so, subject to
-the following conditions:
-
-The above copyright notice and this permission notice shall be
-included in all copies or substantial portions of the Software.
-
-@sc{The software is provided ``as is'', without warranty of any kind,
-express or implied, including but not limited to the warranties of
-merchantability, fitness for a particular purpose and noninfringement.
-In no event shall the authors or copyright holders be liable for any
-claim, damages or other liability, whether in an action of contract,
-tort or otherwise, arising from, out of or in connection with the
-software or the use or other dealings in the software.}
-@end quotation
(DIR) diff --git a/3rdparties/software/babel-20171227-git/doc/macros.texinfo b/3rdparties/software/babel-20171227-git/doc/macros.texinfo
@@ -1,27 +0,0 @@
-@c Some plain TeX macrology to wrap text in \hbox{} only if the text
-@c contains no hyphens.
-@iftex
-@tex
-\newif\ifdash
-\long\def\dashp#1{\expandafter\setnext#1-\dashphelper}
-\long\def\setnext#1-{\futurelet\next\dashphelper}
-\long\def\dashphelper#1\dashphelper{
- \ifx\dashphelper\next\dashfalse\else\dashtrue\fi
-}
-\def\lw#1{\leavevmode\dashp{#1}\ifdash#1\else\hbox{#1}\fi}
-@end tex
-@end iftex
-
-@c A Texinfo binding for the plain TeX above. Analogous to Texinfo's
-@c @w, but for Lisp symbols. AFAICT, the comment characters are
-@c necessary to prevent treating the newline as a space.
-@macro lw{word}
-@iftex
-@tex
-\\lw{\word\}%
-@end tex
-@end iftex
-@ifnottex
-\word\@c
-@end ifnottex
-@end macro
(DIR) diff --git a/3rdparties/software/babel-20171227-git/scripts/release.lisp b/3rdparties/software/babel-20171227-git/scripts/release.lisp
@@ -1,250 +0,0 @@
-#!/usr/bin/env clisp
-;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
-
-(defpackage :release-script (:use #:cl #:regexp))
-(in-package :release-script)
-
-;;;; Configuration ------------------------------------------------------------
-
-(defparameter *project-name* "babel")
-(defparameter *asdf-file* (format nil "~A.asd" *project-name*))
-
-(defparameter *host* "common-lisp.net")
-(defparameter *release-dir*
- (format nil "/project/~A/public_html/releases" *project-name*))
-
-(defparameter *version-file* "VERSION")
-(defparameter *version-file-dir*
- (format nil "/project/~A/public_html" *project-name*))
-
-;;;; --------------------------------------------------------------------------
-
-;;;; Utilities
-
-(defun ensure-list (x)
- (if (listp x) x (list x)))
-
-(defmacro string-case (expression &body clauses)
- `(let ((it ,expression)) ; yes, anaphoric, deal with it.
- (cond
- ,@(loop for clause in clauses collect
- `((or ,@(loop for alternative in (ensure-list (first clause))
- collect (or (eq t alternative)
- `(string= it ,alternative))))
- ,@(rest clause))))))
-
-(defparameter *development-mode* nil)
-
-(defun die (format-control &rest format-args)
- (format *error-output* "~?" format-control format-args)
- (if *development-mode*
- (cerror "continue" "die")
- (ext:quit 1)))
-
-(defun numeric-split (string)
- (if (digit-char-p (char string 0))
- (multiple-value-bind (number next-position)
- (parse-integer string :junk-allowed t)
- (cons number (when (< next-position (length string))
- (numeric-split (subseq string next-position)))))
- (let ((next-digit-position (position-if #'digit-char-p string)))
- (if next-digit-position
- (cons (subseq string 0 next-digit-position)
- (numeric-split (subseq string next-digit-position)))
- (list string)))))
-
-(defun natural-string-< (s1 s2)
- (labels ((aux< (l1 l2)
- (cond ((null l1) (not (null l2)))
- ((null l2) nil)
- (t (destructuring-bind (x . xs) l1
- (destructuring-bind (y . ys) l2
- (cond ((and (numberp x) (stringp y))
- t)
- ((and (numberp y) (stringp x))
- nil)
- ((and (numberp x) (numberp y))
- (or (< x y) (and (= x y) (aux< xs ys))))
- (t
- (or (string-lessp x y)
- (and (string-equal x y)
- (aux< xs ys)))))))))))
- (aux< (numeric-split s1)
- (numeric-split s2))))
-
-;;;; Running commands
-
-(defparameter *dry-run* nil)
-
-(defun cmd? (format-control &rest format-args)
- (let ((cmd (format nil "~?" format-control format-args)))
- (with-open-stream (s1 (ext:run-shell-command cmd :output :stream))
- (loop for line = (read-line s1 nil nil)
- while line
- collect line))))
-
-;; XXX: quote arguments.
-(defun cmd (format-control &rest format-args)
- (when *development-mode*
- (format *debug-io* "CMD: ~?~%" format-control format-args))
- (let ((ret (ext:run-shell-command (format nil "~?" format-control format-args))))
- (or (null ret)
- (zerop ret))))
-
-(defun cmd! (format-control &rest format-args)
- (or (apply #'cmd format-control format-args)
- (die "cmd '~?' failed." format-control format-args)))
-
-(defun maybe-cmd! (format-control &rest format-args)
- (if *dry-run*
- (format t "SUPPRESSING: ~?~%" format-control format-args)
- (apply #'cmd! format-control format-args)))
-
-;;;;
-
-(defun find-current-version ()
- (subseq (reduce (lambda (x y) (if (natural-string-< x y) y x))
- (or (cmd? "git tag -l v\\*")
- (die "no version tags found. Please specify initial version.")))
- 1))
-
-(defun parse-version (string)
- (mapcar (lambda (x)
- (parse-integer x :junk-allowed t))
- (loop repeat 3 ; XXX: parameterize
- for el in (regexp-split "\\." (find-current-version))
- collect el)))
-
-(defun check-for-unrecorded-changes (&optional force)
- (unless (cmd "git diff --exit-code")
- (write-line "Unrecorded changes.")
- (if force
- (write-line "Continuing anyway.")
- (die "Aborting.~@
- Use -f or --force if you want to make a release anyway."))))
-
-(defun new-version-number-candidates (current-version)
- (let ((current-version (parse-version current-version)))
- (labels ((alternatives (before after)
- (when after
- (cons (append before (list (1+ (first after)))
- (mapcar (constantly 0) (rest after)))
- (alternatives (append before (list (first after)))
- (rest after))))))
- (loop for alt in (alternatives nil current-version)
- collect (reduce (lambda (acc next)
- (format nil "~a.~a" acc next))
- alt)))))
-
-(defun ask-user-for-version (current-version next-versions)
- (format *query-io* "Current version is ~A. Which will be the next one?~%"
- current-version)
- (loop for i from 1 and version in next-versions
- do (format *query-io* "~T~A) ~A~%" i version))
- (format *query-io* "? ")
- (finish-output *query-io*)
- (nth (1- (parse-integer (read-line) :junk-allowed t))
- next-versions))
-
-(defun git-tag-tree (version)
- (write-line "Tagging the tree...")
- (maybe-cmd! "git tag \"v~A\"" version))
-
-(defun add-version-to-system-file (version path-in path-out)
- (with-open-file (in path-in :direction :input)
- (with-open-file (out path-out :direction :output)
- (loop for line = (read-line in nil nil) while line
- do (write-line line out)
- when (string= #1="(defsystem " line
- :end2 (min (length #1#) (length line)))
- do (format out " :version ~s~%" version)))))
-
-(defun create-dist (version distname)
- (write-line "Creating distribution...")
- (cmd! "mkdir \"~a\"" distname)
- (cmd! "git archive master | tar xC \"~A\"" distname)
- (format t "Updating ~A with new version: ~A~%" *asdf-file* version)
- (let* ((asdf-file-path (format nil "~A/~A" distname *asdf-file*))
- (tmp-asdf-file-path (format nil "~a.tmp" asdf-file-path)))
- (add-version-to-system-file version asdf-file-path tmp-asdf-file-path)
- (cmd! "mv \"~a\" \"~a\"" tmp-asdf-file-path asdf-file-path)))
-
-(defun tar-and-sign (distname tarball)
- (write-line "Creating and signing tarball...")
- (cmd! "tar czf \"~a\" \"~a\"" tarball distname)
- (cmd! "gpg -b -a \"~a\"" tarball))
-
-(defparameter *remote-directory* (format nil "~A:~A" *host* *release-dir*))
-
-(defun upload-tarball (tarball signature remote-directory)
- (write-line "Copying tarball to web server...")
- (maybe-cmd! "scp \"~A\" \"~A\" \"~A\"" tarball signature remote-directory)
- (format t "Uploaded ~A and ~A.~%" tarball signature))
-
-(defun update-remote-links (tarball signature host release-dir project-name)
- (format t "Updating ~A_latest links...~%" project-name)
- (maybe-cmd! "ssh \"~A\" ln -sf \"~A\" \"~A/~A_latest.tar.gz\""
- host tarball release-dir project-name)
- (maybe-cmd! "ssh \"~A\" ln -sf \"~A\" \"~A/~A_latest.tar.gz.asc\""
- host signature release-dir project-name))
-
-(defun upload-version-file (version version-file host version-file-dir)
- (format t "Uploading ~A...~%" version-file)
- (with-open-file (out version-file :direction :output)
- (write-string version out))
- (maybe-cmd! "scp \"~A\" \"~A\":\"~A\"" version-file host version-file-dir)
- (maybe-cmd! "rm \"~A\"" version-file))
-
-(defun maybe-clean-things-up (tarball signature)
- (when (y-or-n-p "Clean local tarball and signature?")
- (cmd! "rm \"~A\" \"~A\"" tarball signature)))
-
-(defun run (force version)
- (check-for-unrecorded-changes force)
- ;; figure out what version we'll be preparing.
- (unless version
- (let* ((current-version (find-current-version))
- (next-versions (new-version-number-candidates current-version)))
- (setf version (or (ask-user-for-version current-version next-versions)
- (die "invalid selection.")))))
- (git-tag-tree version)
- (let* ((distname (format nil "~A_~A" *project-name* version))
- (tarball (format nil "~A.tar.gz" distname))
- (signature (format nil "~A.asc" tarball)))
- ;; package things up.
- (create-dist version distname)
- (tar-and-sign distname tarball)
- ;; upload.
- (upload-tarball tarball signature *remote-directory*)
- (update-remote-links tarball signature *host* *release-dir* *project-name*)
- (when *version-file*
- (upload-version-file version *version-file* *host* *version-file-dir*))
- ;; clean up.
- (maybe-clean-things-up tarball signature)
- ;; documentation.
- ;; (write-line "Building and uploading documentation...")
- ;; (maybe-cmd! "make -C doc upload-docs")
- ;; push tags and any outstanding changes.
- (write-line "Pushing tags and changes...")
- (maybe-cmd! "git push --tags origin master")))
-
-
-;;;; Do it to it
-
-(let ((force nil)
- (version nil)
- (args ext:*args*))
- (loop while args
- do (string-case (pop args)
- (("-h" "--help")
- (write-line "No help, sorry. Read the source.")
- (ext:quit 0))
- (("-f" "--force")
- (setf force t))
- (("-v" "--version")
- (setf version (pop args)))
- (("-n" "--dry-run")
- (setf *dry-run* t))
- (t
- (die "Unrecognized argument '~a'" it))))
- (run force version))
(DIR) diff --git a/3rdparties/software/babel-20171227-git/src/enc-ascii.lisp b/3rdparties/software/babel-20171227-git/src/enc-ascii.lisp
@@ -1,43 +0,0 @@
-;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
-;;;
-;;; enc-ascii.lisp --- Implementation of the ASCII character encoding.
-;;;
-;;; Copyright (C) 2007, Luis Oliveira <loliveira@common-lisp.net>
-;;;
-;;; Permission is hereby granted, free of charge, to any person
-;;; obtaining a copy of this software and associated documentation
-;;; files (the "Software"), to deal in the Software without
-;;; restriction, including without limitation the rights to use, copy,
-;;; modify, merge, publish, distribute, sublicense, and/or sell copies
-;;; of the Software, and to permit persons to whom the Software is
-;;; furnished to do so, subject to the following conditions:
-;;;
-;;; The above copyright notice and this permission notice shall be
-;;; included in all copies or substantial portions of the Software.
-;;;
-;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
-;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
-;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
-;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
-;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
-;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
-;;; DEALINGS IN THE SOFTWARE.
-
-(in-package #:babel-encodings)
-
-(define-character-encoding :ascii
- "A 7-bit, fixed-width character encoding in which all
-character codes map to their Unicode equivalents."
- :aliases '(:us-ascii)
- :literal-char-code-limit 128)
-
-(define-unibyte-encoder :ascii (code)
- (if (>= code 128)
- (handle-error)
- code))
-
-(define-unibyte-decoder :ascii (octet)
- (if (>= octet 128)
- (handle-error)
- octet))
(DIR) diff --git a/3rdparties/software/babel-20171227-git/src/enc-cp1251.lisp b/3rdparties/software/babel-20171227-git/src/enc-cp1251.lisp
@@ -1,119 +0,0 @@
-;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
-;;;
-;;; enc-cp1251.lisp --- Implementation of the CP1251 character encoding.
-;;;
-;;; Copyright (C) 2009, Andrey Moskvitin
-;;;
-;;; Permission is hereby granted, free of charge, to any person
-;;; obtaining a copy of this software and associated documentation
-;;; files (the "Software"), to deal in the Software without
-;;; restriction, including without limitation the rights to use, copy,
-;;; modify, merge, publish, distribute, sublicense, and/or sell copies
-;;; of the Software, and to permit persons to whom the Software is
-;;; furnished to do so, subject to the following conditions:
-;;;
-;;; The above copyright notice and this permission notice shall be
-;;; included in all copies or substantial portions of the Software.
-;;;
-;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
-;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
-;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
-;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
-;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
-;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
-;;; DEALINGS IN THE SOFTWARE.
-
-(in-package #:babel-encodings)
-
-(define-character-encoding :cp1251
- "An 8-bit, fixed-width character Russian encoding from Windows."
- :aliases '(:windows-1251)
- :literal-char-code-limit #x80)
-
-(define-constant +cp1251-to-unicode+
- #(;; #x80
- #x0402 #x0403 #x201a #x0453 #x201e #x2026 #x2020 #x2021
- #x20ac #x2030 #x0409 #x2039 #x040a #x040c #x040b #x040f
- ;; #x90
- #x0452 #x2018 #x2019 #x201c #x201d #x2022 #x2013 #x2014
- #xfffd #x2122 #x0459 #x203a #x045a #x045c #x045b #x045f
- ;; #xa0
- #x00a0 #x040e #x045e #x0408 #x00a4 #x0490 #x00a6 #x00a7
- #x0401 #x00a9 #x0404 #x00ab #x00ac #x00ad #x00ae #x0407
- ;; #xb0
- #x00b0 #x00b1 #x0406 #x0456 #x0491 #x00b5 #x00b6 #x00b7
- #x0451 #x2116 #x0454 #x00bb #x0458 #x0405 #x0455 #x0457
- ;; #xc0
- #x0410 #x0411 #x0412 #x0413 #x0414 #x0415 #x0416 #x0417
- #x0418 #x0419 #x041a #x041b #x041c #x041d #x041e #x041f
- ;; #xd0
- #x0420 #x0421 #x0422 #x0423 #x0424 #x0425 #x0426 #x0427
- #x0428 #x0429 #x042a #x042b #x042c #x042d #x042e #x042f
- ;; #xe0
- #x0430 #x0431 #x0432 #x0433 #x0434 #x0435 #x0436 #x0437
- #x0438 #x0439 #x043a #x043b #x043c #x043d #x043e #x043f
- ;; #xf0
- #x0440 #x0441 #x0442 #x0443 #x0444 #x0445 #x0446 #x0447
- #x0448 #x0449 #x044a #x044b #x044c #x044d #x044e #x044f)
- :test #'equalp)
-
-(define-unibyte-decoder :cp1251 (octet)
- (if (< octet #x80)
- octet
- (svref +cp1251-to-unicode+ (the ub8 (- octet #x80)))))
-
-(define-constant +unicode-a0-bf-to-cp1251+
- #(#xa0 #x00 #x00 #x00 #xa4 #x00 #xa6 #xa7 ; #xa0-#xa7
- #x00 #xa9 #x00 #xab #xac #xad #xae #x00 ; #xa8-#xaf
- #xb0 #xb1 #x00 #x00 #x00 #xb5 #xb6 #xb7 ; #xb0-#xb7
- #x00 #x00 #x00 #xbb #x00 #x00 #x00 #x00) ; #xb8-#xbf
- :test #'equalp)
-
-(define-constant +unicode-0-97-to-cp1251+
- #(#x00 #xa8 #x80 #x81 #xaa #xbd #xb2 #xaf ; #x00-#x07
- #xa3 #x8a #x8c #x8e #x8d #x00 #xa1 #x8f ; #x08-#x0f
- #xc0 #xc1 #xc2 #xc3 #xc4 #xc5 #xc6 #xc7 ; #x10-#x17
- #xc8 #xc9 #xca #xcb #xcc #xcd #xce #xcf ; #x18-#x1f
- #xd0 #xd1 #xd2 #xd3 #xd4 #xd5 #xd6 #xd7 ; #x20-#x27
- #xd8 #xd9 #xda #xdb #xdc #xdd #xde #xdf ; #x28-#x2f
- #xe0 #xe1 #xe2 #xe3 #xe4 #xe5 #xe6 #xe7 ; #x30-#x37
- #xe8 #xe9 #xea #xeb #xec #xed #xee #xef ; #x38-#x3f
- #xf0 #xf1 #xf2 #xf3 #xf4 #xf5 #xf6 #xf7 ; #x40-#x47
- #xf8 #xf9 #xfa #xfb #xfc #xfd #xfe #xff ; #x48-#x4f
- #x00 #xb8 #x90 #x83 #xba #xbe #xb3 #xbf ; #x50-#x57
- #xbc #x9a #x9c #x9e #x9d #x00 #xa2 #x9f ; #x58-#x5f
- #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 ; #x60-#x67
- #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 ; #x68-#x6f
- #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 ; #x70-#x77
- #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 ; #x78-#x7f
- #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 ; #x80-#x87
- #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 ; #x88-#x8f
- #xa5 #xb4 #x00 #x00 #x00 #x00 #x00 #x00) ; #x90-#x97
- :test #'equalp)
-
-(define-constant +unicode-10-3f-to-cp1251+
- #(#x00 #x00 #x00 #x96 #x97 #x00 #x00 #x00 ; #x10-#x17
- #x91 #x92 #x82 #x00 #x93 #x94 #x84 #x00 ; #x18-#x1f
- #x86 #x87 #x95 #x00 #x00 #x00 #x85 #x00 ; #x20-#x27
- #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 ; #x28-#x2f
- #x89 #x00 #x00 #x00 #x00 #x00 #x00 #x00 ; #x30-#x37
- #x00 #x8b #x9b #x00 #x00 #x00 #x00 #x00) ; #x38-#x3f
- :test #'equalp)
-
-(define-unibyte-encoder :cp1251 (code)
- (cond
- ((< code #x80) code)
- ((and (>= code #xa0) (< code #xc0))
- (svref +unicode-a0-bf-to-cp1251+
- (the ub8 (- code #xa0))))
- ((and (>= code #x400) (< code #x498))
- (svref +unicode-0-97-to-cp1251+
- (the ub8 (- code #x400))))
- ((and (>= code #x2010) (< code #x2040))
- (svref +unicode-10-3f-to-cp1251+
- (the ub8 (- code #x2010))))
- ((= code #x20ac) #x88)
- ((= code #x2116) #xb9)
- ((= code #x2122) #x99)
- (t (handle-error))))
(DIR) diff --git a/3rdparties/software/babel-20171227-git/src/enc-cp1252.lisp b/3rdparties/software/babel-20171227-git/src/enc-cp1252.lisp
@@ -1,81 +0,0 @@
-;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
-;;;
-;;; enc-cp1252.lisp --- Implementation of the CP1252 character encoding.
-;;;
-;;; Copyright (C) 2011, Nicolas Martyanoff
-;;;
-;;; Permission is hereby granted, free of charge, to any person
-;;; obtaining a copy of this software and associated documentation
-;;; files (the "Software"), to deal in the Software without
-;;; restriction, including without limitation the rights to use, copy,
-;;; modify, merge, publish, distribute, sublicense, and/or sell copies
-;;; of the Software, and to permit persons to whom the Software is
-;;; furnished to do so, subject to the following conditions:
-;;;
-;;; The above copyright notice and this permission notice shall be
-;;; included in all copies or substantial portions of the Software.
-;;;
-;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
-;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
-;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
-;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
-;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
-;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
-;;; DEALINGS IN THE SOFTWARE.
-
-(in-package #:babel-encodings)
-
-(define-character-encoding :cp1252
- "A 8-bit, fixed-width character encoding used by Windows for Western
- European languages."
- :aliases '(:windows-1252)
- :literal-char-code-limit 256)
-
-(define-constant +cp1252-to-unicode+
- #(#x20ac nil #x201a #x0192 #x201e #x2026 #x2020 #x2021
- #x02c6 #x2030 #x0160 #x2039 #x0152 nil #x017d nil
- nil #x2018 #x2019 #x201c #x201d #x2022 #x2013 #x2014
- #x02dc #x2122 #x0161 #x203a #x0153 nil #x017e #x0178)
- :test #'equalp)
-
-(define-unibyte-decoder :cp1252 (octet)
- (if (and (>= octet #x80) (<= octet #x9f))
- (svref +cp1252-to-unicode+
- (the ub8 (- octet #x80)))
- octet))
-
-(define-constant +unicode-0152-017e-cp1252+
- #(#x8c #x9c #x00 #x00 #x00 #x00 #x00 #x00
- #x00 #x00 #x00 #x00 #x00 #x00 #x8a #x9a
- #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00
- #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00
- #x00 #x00 #x00 #x00 #x00 #x00 #x9f #x00
- #x00 #x00 #x00 #x8e #x9e)
- :test #'equalp)
-
-(define-constant +unicode-2013-203a-cp1252+
- #(#x96 #x97 #x00 #x00 #x00 #x91 #x92 #x82
- #x00 #x93 #x94 #x84 #x00 #x86 #x87 #x95
- #x00 #x00 #x00 #x85 #x00 #x00 #x00 #x00
- #x00 #x00 #x00 #x00 #x00 #x89 #x00 #x00
- #x00 #x00 #x00 #x00 #x00 #x00 #x8b #x9b)
- :test #'equalp)
-
-(define-unibyte-encoder :cp1252 (code)
- (cond
- ((or (< code #x80)
- (and (> code #xa0) (<= code #xff)))
- code)
- ((and (>= code #x0152) (<= code #x017e))
- (svref +unicode-0152-017e-cp1252+
- (the ub8 (- code #x0152))))
- ((= code #x0192) #x83)
- ((= code #x02c6) #x88)
- ((= code #x02dc) #x89)
- ((and (>= code #x2013) (<= code #x203a))
- (svref +unicode-2013-203a-cp1252+
- (the ub8 (- code #x2013))))
- ((= code #x20ac) #x80)
- ((= code #x2122) #x99)
- (t (handle-error))))
(DIR) diff --git a/3rdparties/software/babel-20171227-git/src/enc-ebcdic-int.lisp b/3rdparties/software/babel-20171227-git/src/enc-ebcdic-int.lisp
@@ -1,49 +0,0 @@
-(in-package #:babel-encodings)
-
-(define-character-encoding :ebcdic-international
- "An 8-bit, fixed-width character encoding from IBM.")
-
-(defparameter +ebcdic-int-to-unicode+
- #(0 1 2 3 156 9 134 127 151 141 142 11 12 13 14 15 16 17 18 19 157 133 8 135
- 24 25 146 143 28 29 30 31 128 129 130 65535 132 10 23 27 65535 65535 138 139
- 65535 5 6 7 65535 65535 22 65535 148 149 150 4 65535 65535 65535 155 20 21
- 65535 26 32 65535 65535 65535 65535 65535 65535 65535 65535 65535 91 46 60
- 40 43 33 38 65535 65535 65535 65535 65535 65535 65535 65535 65535 93 164 42
- 41 59 172 45 47 65535 65535 65535 65535 65535 65535 65535 65535 124 44 37 95
- 62 63 65535 65535 65535 65535 65535 65535 1102 1072 1073 96 58 35 64 39 61
- 34 1094 97 98 99 100 101 102 103 104 105 1076 1077 1092 1075 1093 1080 1081
- 106 107 108 109 110 111 112 113 114 1082 1083 1084 1085 1086 1087 1103 126
- 115 116 117 118 119 120 121 122 1088 1089 1090 1091 1078 1074 1100 1099 1079
- 1096 1101 1097 1095 1098 1070 1040 1041 1062 1044 1045 1060 1043 123 65 66
- 67 68 69 70 71 72 73 1061 1048 1049 1050 1051 1052 125 74 75 76 77 78 79 80
- 81 82 1053 1054 1055 1071 1056 1057 92 65535 83 84 85 86 87 88 89 90 1058
- 1059 1046 1042 1068 1067 48 49 50 51 52 53 54 55 56 57 1047 1064 1069 1065
- 1063 159))
-
-(defparameter +unicode-upto-ac-ebcdic-int+
- #(0 1 2 3 55 45 46 47 22 5 37 11 12 13 14 15 16 17 18 19 60 61 50 38 24 25 63
- 39 28 29 30 31 64 79 127 123 0 108 80 125 77 93 92 78 107 96 75 97 240 241
- 242 243 244 245 246 247 248 249 122 94 76 126 110 111 124 193 194 195 196
- 197 198 199 200 201 209 210 211 212 213 214 215 216 217 226 227 228 229 230
- 231 232 233 74 224 90 0 109 121 129 130 131 132 133 134 135 136 137 145 146
- 147 148 149 150 151 152 153 162 163 164 165 166 167 168 169 192 106 208 161
- 7 32 33 34 0 36 21 6 23 0 0 42 43 0 9 10 27 0 0 26 0 52 53 54 8 0 0 0 59 4
- 20 0 255 0 0 0 0 91 0 0 0 0 0 0 0 95))
-
-(defparameter +unicode-0410-0450-ebcdic-int+
- #(185 186 237 191 188 189 236 250 203 204 205 206 207 218 219 220 222 223 234
- 235 190 202 187 254 251 253 0 239 238 252 184 221 119 120 175 141 138 139
- 174 178 143 144 154 155 156 157 158 159 170 171 172 173 140 142 128 182 179
- 181 183 177 176 180 118 160))
-
-(define-unibyte-decoder :ebcdic-international (octet)
- (svref +ebcdic-int-to-unicode+ (the ub8 octet)))
-
-(define-unibyte-encoder :ebcdic-international (code)
- (let ((result (cond
- ((<= code 172) (svref +unicode-upto-ac-ebcdic-int+ code))
- ((<= #x0410 code #x0450) (svref +unicode-0410-0450-ebcdic-int+
- (- code #x0410))))))
- (prog1 result
- (when (and (zerop result) (plusp code))
- (handle-error)))))
(DIR) diff --git a/3rdparties/software/babel-20171227-git/src/enc-ebcdic.lisp b/3rdparties/software/babel-20171227-git/src/enc-ebcdic.lisp
@@ -1,71 +0,0 @@
-;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
-;;;
-;;; enc-ebcdic.lisp --- EBCDIC encodings.
-;;;
-;;; Copyright (C) 2007, Luis Oliveira <loliveira@common-lisp.net>
-;;;
-;;; Permission is hereby granted, free of charge, to any person
-;;; obtaining a copy of this software and associated documentation
-;;; files (the "Software"), to deal in the Software without
-;;; restriction, including without limitation the rights to use, copy,
-;;; modify, merge, publish, distribute, sublicense, and/or sell copies
-;;; of the Software, and to permit persons to whom the Software is
-;;; furnished to do so, subject to the following conditions:
-;;;
-;;; The above copyright notice and this permission notice shall be
-;;; included in all copies or substantial portions of the Software.
-;;;
-;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
-;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
-;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
-;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
-;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
-;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
-;;; DEALINGS IN THE SOFTWARE.
-
-(in-package #:babel-encodings)
-
-(define-character-encoding :ebcdic-us
- "An alleged character set used on IBM dinosaurs."
- :aliases '(:ibm-037))
-
-(define-constant +ebcdic-decode-table+
- (make-array
- 256 :element-type 'ub8 :initial-contents
- '(#x00 #x01 #x02 #x03 #x9c #x09 #x86 #x7f #x97 #x8d #x8e #x0b #x0c #x0d
- #x0e #x0f #x10 #x11 #x12 #x13 #x9d #x85 #x08 #x87 #x18 #x19 #x92 #x8f
- #x1c #x1d #x1e #x1f #x80 #x81 #x82 #x83 #x84 #x0a #x17 #x1b #x88 #x89
- #x8a #x8b #x8c #x05 #x06 #x07 #x90 #x91 #x16 #x93 #x94 #x95 #x96 #x04
- #x98 #x99 #x9a #x9b #x14 #x15 #x9e #x1a #x20 #xa0 #xe2 #xe4 #xe0 #xe1
- #xe3 #xe5 #xe7 #xf1 #xa2 #x2e #x3c #x28 #x2b #x7c #x26 #xe9 #xea #xeb
- #xe8 #xed #xee #xef #xec #xdf #x21 #x24 #x2a #x29 #x3b #xac #x2d #x2f
- #xc2 #xc4 #xc0 #xc1 #xc3 #xc5 #xc7 #xd1 #xa6 #x2c #x25 #x5f #x3e #x3f
- #xf8 #xc9 #xca #xcb #xc8 #xcd #xce #xcf #xcc #x60 #x3a #x23 #x40 #x27
- #x3d #x22 #xd8 #x61 #x62 #x63 #x64 #x65 #x66 #x67 #x68 #x69 #xab #xbb
- #xf0 #xfd #xfe #xb1 #xb0 #x6a #x6b #x6c #x6d #x6e #x6f #x70 #x71 #x72
- #xaa #xba #xe6 #xb8 #xc6 #xa4 #xb5 #x7e #x73 #x74 #x75 #x76 #x77 #x78
- #x79 #x7a #xa1 #xbf #xd0 #xdd #xde #xae #x5e #xa3 #xa5 #xb7 #xa9 #xa7
- #xb6 #xbc #xbd #xbe #x5b #x5d #xaf #xa8 #xb4 #xd7 #x7b #x41 #x42 #x43
- #x44 #x45 #x46 #x47 #x48 #x49 #xad #xf4 #xf6 #xf2 #xf3 #xf5 #x7d #x4a
- #x4b #x4c #x4d #x4e #x4f #x50 #x51 #x52 #xb9 #xfb #xfc #xf9 #xfa #xff
- #x5c #xf7 #x53 #x54 #x55 #x56 #x57 #x58 #x59 #x5a #xb2 #xd4 #xd6 #xd2
- #xd3 #xd5 #x30 #x31 #x32 #x33 #x34 #x35 #x36 #x37 #x38 #x39 #xb3 #xdb
- #xdc #xd9 #xda #x9f))
- :test #'equalp)
-
-(define-constant +ebcdic-encode-table+
- (loop with rt = (make-array 256 :element-type 'ub8 :initial-element 0)
- for code across +ebcdic-decode-table+ for i from 0 do
- (assert (= 0 (aref rt code)))
- (setf (aref rt code) i)
- finally (return rt))
- :test #'equalp)
-
-(define-unibyte-encoder :ebcdic-us (code)
- (if (>= code 256)
- (handle-error)
- (aref +ebcdic-encode-table+ code)))
-
-(define-unibyte-decoder :ebcdic-us (octet)
- (aref +ebcdic-decode-table+ octet))
(DIR) diff --git a/3rdparties/software/babel-20171227-git/src/enc-gbk.lisp b/3rdparties/software/babel-20171227-git/src/enc-gbk.lisp
@@ -1,184 +0,0 @@
-;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
-;;;
-;;; enc-gbk.lisp --- GBK encodings.
-;;;
-;;; Copyright (C) 2011, Li Wenpeng <levin108@gmail.com>
-;;;
-;;; Permission is hereby granted, free of charge, to any person
-;;; obtaining a copy of this software and associated documentation
-;;; files (the "Software"), to deal in the Software without
-;;; restriction, including without limitation the rights to use, copy,
-;;; modify, merge, publish, distribute, sublicense, and/or sell copies
-;;; of the Software, and to permit persons to whom the Software is
-;;; furnished to do so, subject to the following conditions:
-;;;
-;;; The above copyright notice and this permission notice shall be
-;;; included in all copies or substantial portions of the Software.
-;;;
-;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
-;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
-;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
-;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
-;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
-;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
-;;; DEALINGS IN THE SOFTWARE.
-
-(in-package #:babel-encodings)
-
-;; populated in gbk-map.lisp
-(defvar *gbk-unicode-mapping*)
-
-(defconstant +gbk2-offset+ 0)
-(defconstant +gbk3-offset+ 6763)
-(defconstant +gbk4-offset+ (+ 6763 6080))
-(defconstant +gbk1-offset+ 20902)
-(defconstant +gbk5-offset+ (+ 20902 846))
-
-(define-character-encoding :gbk
- "GBK is an extension of the GB2312 character set for simplified
-Chinese characters, used in the People's Republic of China."
- :max-units-per-char 4
- :literal-char-code-limit #x80)
-
-(define-condition invalid-gbk-byte (character-decoding-error)
- ()
- (:documentation "Signalled when an invalid GBK byte is found."))
-
-(define-condition invalid-gbk-character (character-encoding-error)
- ()
- (:documentation "Signalled when an invalid GBK character is found."))
-
-(define-octet-counter :gbk (getter type)
- `(lambda (seq start end max)
- (declare (type ,type seq) (fixnum start end max))
- (let ((noctets 0))
- (loop for i from start below end
- for u1 of-type code-point = (,getter seq i)
- do (cond ((< u1 #x80) (incf noctets))
- (t (incf noctets 2)))
- (when (and (plusp max) (= noctets max))
- (return (values noctets i)))
- finally (return (values noctets i))))))
-
-(define-code-point-counter :gbk (getter type)
- `(lambda (seq start end max)
- (declare (type ,type seq))
- (let (u1 (noctets 0))
- (loop with i = start
- while (< i end)
- do (setf u1 (,getter seq i))
- (cond
- ((eq 0 (logand u1 #x80)) (incf i))
- (t (incf i 2)))
- (incf noctets)
- (when (and (plusp max) (= noctets max))
- (return (values noctets i)))
- finally (return (values noctets i))))))
-
-(define-encoder :gbk (getter src-type setter dest-type)
- `(lambda (src start end dest d-start)
- (declare (type ,src-type src)
- (type ,dest-type dest)
- (fixnum start end d-start))
- (macrolet
- ((do-encoding (index)
- `(let ((u1 0) (u2 0))
- (cond
- ((<= +gbk2-offset+ ,index (- +gbk3-offset+ 1)) ; gbk/2
- (setf u1 (+ #xB0 (truncate (/ ,index 94))))
- (setf u2 (+ #xA1 (mod ,index 94))))
- ((<= +gbk3-offset+ ,index (- +gbk4-offset+ 1)) ; gbk/3
- (setf index (- ,index +gbk3-offset+))
- (setf u1 (+ #x81 (truncate (/ ,index 190))))
- (setf u2 (+ #x40 (mod ,index 190)))
- (if (>= u2 #x7F) (incf u2)))
- ((<= +gbk4-offset+ ,index (- +gbk1-offset+ 1)) ; gbk/4
- (setf index (- ,index +gbk4-offset+))
- (setf u1 (+ #xAA (truncate (/ ,index 96))))
- (setf u2 (+ #x40 (mod ,index 96)))
- (if (>= u2 #x7F) (incf u2)))
- ((<= +gbk1-offset+ ,index (- +gbk5-offset+ 1)) ; gbk/1
- (setf index (- ,index +gbk1-offset+))
- (setf u1 (+ #xA1 (truncate (/ ,index 94))))
- (setf u2 (+ #xA1 (mod ,index 94))))
- ((<= +gbk5-offset+ ,index (length *gbk-unicode-mapping*)) ; gbk/5
- (setf index (- ,index +gbk5-offset+))
- (setf u1 (+ #xA8 (truncate (/ ,index 96))))
- (setf u2 (+ #x40 (mod ,index 96)))
- (if (>= u2 #x7F) (incf u2))))
- (values u1 u2))))
- (let ((c 0) index (noctets 0))
- (loop for i from start below end
- for code of-type code-point = (,getter src i)
- do (macrolet
- ((handle-error (&optional (c 'character-encoding-error))
- `(encoding-error code :gbk src i +repl+ ',c)))
- (setf c (code-char code))
- (cond
- ((< code #x80) ; ascii
- (,setter code dest noctets)
- (incf noctets))
- (t ; gbk
- (setf index
- (position c *gbk-unicode-mapping*))
-
- (if (not index)
- (handle-error invalid-gbk-character))
- (multiple-value-bind (uh ul) (do-encoding index)
- (,setter uh dest noctets)
- (,setter ul dest (+ 1 noctets))
- (incf noctets 2)))))
- finally (return (the fixnum (- noctets d-start))))))))
-
-(define-decoder :gbk (getter src-type setter dest-type)
- `(lambda (src start end dest d-start)
- (declare (type ,src-type src)
- (type ,dest-type dest))
- (let ((u1 0) (u2 0) (index 0) (tmp 0) (noctets 0))
- (loop with i = start
- while (< i end)
- do (macrolet
- ((handle-error (&optional (c 'character-decoding-error))
- `(decoding-error #(u1 u2) :gbk src i +repl+ ',c)))
- (setf u1 (,getter src i))
- (incf i)
- (cond
- ((eq 0 (logand u1 #x80))
- (,setter u1 dest noctets))
- (t
- (setf u2 (,getter src i))
- (incf i)
- (setf index
- (block setter-block
- (cond
- ((and (<= #xB0 u1 #xF7) (<= #xA1 u2 #xFE))
- (+ +gbk2-offset+ (+ (* 94 (- u1 #xB0)) (- u2 #xA1))))
-
- ((and (<= #x81 u1 #xA0) (<= #x40 u2 #xFE))
- (cond ((> u2 #x7F) (setf tmp 1))
- (t (setf tmp 0)))
- (+ +gbk3-offset+ (* 190 (- u1 #x81)) (- u2 #x40 tmp)))
-
- ((and (<= #xAA u1 #xFE) (<= #x40 #xA0))
- (cond ((> u2 #x7F) (setf tmp 1))
- (t (setf tmp 0)))
- (+ +gbk4-offset+ (* 96 (- u1 #xAA)) (- u2 #x40 tmp)))
-
- ((and (<= #xA1 u1 #xA9) (<= #xA1 u2 #xFE))
- (+ +gbk1-offset+ (* 94 (- u1 #xA1)) (- u2 #xA1)))
-
- ((and (<= #xA8 u1 #xA9) (<= #x40 #xA0))
- (cond ((> u2 #x7F) (setf tmp 1))
- (t (setf tmp 0)))
- (+ +gbk5-offset+ (* 96 (- u1 #xA8)) (- u2 #x40 tmp)))
- (t
- (handle-error invalid-gbk-byte)))))
-
- (when (>= index (length *gbk-unicode-mapping*))
- (handle-error invalid-gbk-byte))
- (,setter (char-code
- (elt *gbk-unicode-mapping* index))
- dest noctets)))
- (incf noctets))
- finally (return (the fixnum (- noctets d-start)))))))
(DIR) diff --git a/3rdparties/software/babel-20171227-git/src/enc-iso-8859.lisp b/3rdparties/software/babel-20171227-git/src/enc-iso-8859.lisp
@@ -1,1087 +0,0 @@
-;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
-;;;
-;;; enc-iso-8859.lisp --- ISO-8859-* encodings.
-;;;
-;;; Copyright (C) 2007, Luis Oliveira <loliveira@common-lisp.net>
-;;;
-;;; Permission is hereby granted, free of charge, to any person
-;;; obtaining a copy of this software and associated documentation
-;;; files (the "Software"), to deal in the Software without
-;;; restriction, including without limitation the rights to use, copy,
-;;; modify, merge, publish, distribute, sublicense, and/or sell copies
-;;; of the Software, and to permit persons to whom the Software is
-;;; furnished to do so, subject to the following conditions:
-;;;
-;;; The above copyright notice and this permission notice shall be
-;;; included in all copies or substantial portions of the Software.
-;;;
-;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
-;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
-;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
-;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
-;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
-;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
-;;; DEALINGS IN THE SOFTWARE.
-
-;;; This implementation is largely based on OpenMCL's l1-unicode.lisp
-;;; Copyright (C) 2006 Clozure Associates and contributors.
-
-(in-package #:babel-encodings)
-
-;;; Typically, ISO-8859-* codes in the range #x00-#x9f map straight
-;;; through, while codes #xa0-#xff select arbitrary Unicode characters
-;;; that are commonly used in some locale. (Sometimes the break is at
-;;; #x80 instead of #xa0).
-;;;
-;;; (comment from OpenMCL's ccl/level-1/l1-unicode.lisp)
-
-(define-character-encoding :iso-8859-1
- "An 8-bit, fixed-width character encoding in which all
-character codes map to their Unicode equivalents. Intended to
-support most characters used in most Western European languages."
- :aliases '(:latin-1 :latin1)
- :literal-char-code-limit 256)
-
-(define-unibyte-encoder :iso-8859-1 (code)
- (if (>= code 256)
- (handle-error)
- code))
-
-(define-unibyte-decoder :iso-8859-1 (octet)
- octet)
-
-(define-character-encoding :iso-8859-2
- "An 8-bit, fixed-width character encoding in which codes
-#x00-#x9f map to their Unicode equivalents and other codes map to
-other Unicode character values. Intended to provide most
-characters found in most languages used in Central/Eastern
-Europe."
- :aliases '(:latin-2 :latin2)
- :literal-char-code-limit #xa0)
-
-(define-constant +unicode-00a0-0180-to-iso-8859-2+
- #(#xa0 nil nil nil #xa4 nil nil #xa7 ; #xa0-#xa7
- #xa8 nil nil nil nil #xad nil nil ; #xa8-#xaf
- #xb0 nil nil nil #xb4 nil nil nil ; #xb0-#xb7
- #xb8 nil nil nil nil nil nil nil ; #xb8-#xbf
- nil #xc1 #xc2 nil #xc4 nil nil #xc7 ; #xc0-#xc7
- nil #xc9 nil #xcb nil #xcd #xce nil ; #xc8-#xcf
- nil nil nil #xd3 #xd4 nil #xd6 #xd7 ; #xd0-#xd7
- nil nil #xda nil #xdc #xdd nil #xdf ; #xd8-#xdf
- nil #xe1 #xe2 nil #xe4 nil nil #xe7 ; #xe0-#xe7
- nil #xe9 nil #xeb nil #xed #xee nil ; #xe8-#xef
- nil nil nil #xf3 #xf4 nil #xf6 #xf7 ; #xf0-#xf7
- nil nil #xfa nil #xfc #xfd nil nil ; #xf8-#xff
- ;; #x0100
- nil nil #xc3 #xe3 #xa1 #xb1 #xc6 #xe6 ; #x100-#x107
- nil nil nil nil #xc8 #xe8 #xcf #xef ; #x108-#x10f
- #xd0 #xf0 nil nil nil nil nil nil ; #x110-#x117
- #xca #xea #xcc #xec nil nil nil nil ; #x118-#x11f
- nil nil nil nil nil nil nil nil ; #x120-#x127
- nil nil nil nil nil nil nil nil ; #x128-#x12f
- nil nil nil nil nil nil nil nil ; #x130-#x137
- nil #xc5 #xe5 nil nil #xa5 #xb5 nil ; #x138-#x13f
- nil #xa3 #xb3 #xd1 #xf1 nil nil #xd2 ; #x140-#x147
- #xf2 nil nil nil nil nil nil nil ; #x148-#x14f
- #xd5 #xf5 nil nil #xc0 #xe0 nil nil ; #x150-#x157
- #xd8 #xf8 #xa6 #xb6 nil nil #xaa #xba ; #x158-#x15f
- #xa9 #xb9 #xde #xfe #xab #xbb nil nil ; #x160-#x167
- nil nil nil nil nil nil #xd9 #xf9 ; #x168-#x16f
- #xdb #xfb nil nil nil nil nil nil ; #x170-#x177
- nil #xac #xbc #xaf #xbf #xae #xbe nil) ; #x178-#x17f
- :test #'equalp)
-
-(define-constant +unicode-02c0-02e0-to-iso-8859-2+
- #(nil nil nil nil nil nil nil #xb7 ; #x2c0-#x2c7
- nil nil nil nil nil nil nil nil ; #x2c8-#x2cf
- nil nil nil nil nil nil nil nil ; #x2d0-#x2d7
- #xa2 #xff nil #xb2 nil #xbd nil nil) ; #x2d8-#x2df
- :test #'equalp)
-
-(define-unibyte-encoder :iso-8859-2 (code)
- (or (cond ((< code #xa0) code)
- ((< code #x180)
- (svref +unicode-00a0-0180-to-iso-8859-2+
- (the ub8 (- code #xa0))))
- ((<= #x2c0 code #x2df)
- (svref +unicode-02c0-02e0-to-iso-8859-2+
- (the ub8 (- code #x2c0)))))
- (handle-error)))
-
-(define-constant +iso-8859-2-to-unicode+
- #(;; #xa0
- #x00a0 #x0104 #x02d8 #x0141 #x00a4 #x013d #x015a #x00a7
- #x00a8 #x0160 #x015e #x0164 #x0179 #x00ad #x017d #x017b
- ;; #xb0
- #x00b0 #x0105 #x02db #x0142 #x00b4 #x013e #x015b #x02c7
- #x00b8 #x0161 #x015f #x0165 #x017a #x02dd #x017e #x017c
- ;; #xc0
- #x0154 #x00c1 #x00c2 #x0102 #x00c4 #x0139 #x0106 #x00c7
- #x010c #x00c9 #x0118 #x00cb #x011a #x00cd #x00ce #x010e
- ;; #xd0
- #x0110 #x0143 #x0147 #x00d3 #x00d4 #x0150 #x00d6 #x00d7
- #x0158 #x016e #x00da #x0170 #x00dc #x00dd #x0162 #x00df
- ;; #xe0
- #x0155 #x00e1 #x00e2 #x0103 #x00e4 #x013a #x0107 #x00e7
- #x010d #x00e9 #x0119 #x00eb #x011b #x00ed #x00ee #x010f
- ;; #xf0
- #x0111 #x0144 #x0148 #x00f3 #x00f4 #x0151 #x00f6 #x00f7
- #x0159 #x016f #x00fa #x0171 #x00fc #x00fd #x0163 #x02d9)
- :test #'equalp)
-
-(define-unibyte-decoder :iso-8859-2 (octet)
- (if (< octet #xa0)
- octet
- (svref +iso-8859-2-to-unicode+ (the ub8 (- octet #xa0)))))
-
-(define-character-encoding :iso-8859-3
- "An 8-bit, fixed-width character encoding in which codes
-#x00-#x9f map to their Unicode equivalents and other codes map to
-other Unicode character values. Intended to provide most
-characters found in most languages used in Southern Europe."
- :aliases '(:latin-3 :latin3)
- :literal-char-code-limit #xa0)
-
-(define-constant +unicode-a0-100-to-iso-8859-3+
- #(#xa0 nil nil #xa3 #xa4 nil nil #xa7 ; #xa0-#xa7
- #xa8 nil nil nil nil #xad nil nil ; #xa8-#xaf
- #xb0 nil #xb2 #xb3 #xb4 #xb5 nil #xb7 ; #xb0-#xb7
- #xb8 nil nil nil nil #xbd nil nil ; #xb8-#xbf
- #xc0 #xc1 #xc2 nil #xc4 nil nil #xc7 ; #xc0-#xc7
- #xc8 #xc9 #xca #xcb #xcc #xcd #xce #xcf ; #xc8-#xcf
- nil #xd1 #xd2 #xd3 #xd4 nil #xd6 #xd7 ; #xd0-#xd7
- nil #xd9 #xda #xdb #xdc nil nil #xdf ; #xd8-#xdf
- #xe0 #xe1 #xe2 nil #xe4 nil nil #xe7 ; #xe0-#xe7
- #xe8 #xe9 #xea #xeb #xec #xed #xee #xef ; #xe8-#xef
- nil #xf1 #xf2 #xf3 #xf4 nil #xf6 #xf7 ; #xf0-#xf7
- nil #xf9 #xfa #xfb #xfc nil nil nil) ; #xf8-#xff
- :test #'equalp)
-
-(define-constant +unicode-108-180-to-iso-8859-3+
- #(#xc6 #xe6 #xc5 #xe5 #x00 #x00 #x00 #x00 ; #x108-#x10f
- nil nil nil nil nil nil nil nil ; #x110-#x117
- nil nil nil nil #xd8 #xf8 #xab #xbb ; #x118-#x11f
- #xd5 #xf5 nil nil #xa6 #xb6 #xa1 #xb1 ; #x120-#x127
- nil nil nil nil nil nil nil nil ; #x128-#x12f
- #xa9 #xb9 nil nil #xac #xbc nil nil ; #x130-#x137
- nil nil nil nil nil nil nil nil ; #x138-#x13f
- nil nil nil nil nil nil nil nil ; #x140-#x147
- nil nil nil nil nil nil nil nil ; #x148-#x14f
- nil nil nil nil nil nil nil nil ; #x150-#x157
- nil nil nil nil #xde #xfe #xaa #xba ; #x158-#x15f
- nil nil nil nil nil nil nil nil ; #x160-#x167
- nil nil nil nil #xdd #xfd nil nil ; #x168-#x16f
- nil nil nil nil nil nil nil nil ; #x170-#x177
- nil nil nil #xaf #xbf nil nil nil) ; #x178-#x17f
- :test #'equalp)
-
-(define-constant +unicode-2d8-2e0-to-iso-8859-3+
- #(#xa2 #xff nil nil nil nil nil nil) ; #x2d8-#x2df
- :test #'equalp)
-
-(define-unibyte-encoder :iso-8859-3 (code)
- (or (cond ((< code #xa0) code)
- ((< code #x100)
- (svref +unicode-a0-100-to-iso-8859-3+
- (the ub8 (- code #xa0))))
- ((<= #x108 code #x17f)
- (svref +unicode-108-180-to-iso-8859-3+
- (the ub8 (- code #x108))))
- ((<= #x2d8 code #x2df)
- (svref +unicode-2d8-2e0-to-iso-8859-3+
- (the ub8 (- code #x2d8)))))
- (handle-error)))
-
-(define-constant +iso-8859-3-to-unicode+
- #(;; #xa0
- #x00a0 #x0126 #x02d8 #x00a3 #x00a4 #xfffd #x0124 #x00a7
- #x00a8 #x0130 #x015e #x011e #x0134 #x00ad #xfffd #x017b
- ;; #xb0
- #x00b0 #x0127 #x00b2 #x00b3 #x00b4 #x00b5 #x0125 #x00b7
- #x00b8 #x0131 #x015f #x011f #x0135 #x00bd #xfffd #x017c
- ;; #xc0
- #x00c0 #x00c1 #x00c2 #xfffd #x00c4 #x010a #x0108 #x00c7
- #x00c8 #x00c9 #x00ca #x00cb #x00cc #x00cd #x00ce #x00cf
- ;; #xd0
- #xfffd #x00d1 #x00d2 #x00d3 #x00d4 #x0120 #x00d6 #x00d7
- #x011c #x00d9 #x00da #x00db #x00dc #x016c #x015c #x00df
- ;; #xe0
- #x00e0 #x00e1 #x00e2 #xfffd #x00e4 #x010b #x0109 #x00e7
- #x00e8 #x00e9 #x00ea #x00eb #x00ec #x00ed #x00ee #x00ef
- ;; #xf0
- #xfffd #x00f1 #x00f2 #x00f3 #x00f4 #x0121 #x00f6 #x00f7
- #x011d #x00f9 #x00fa #x00fb #x00fc #x016d #x015d #x02d9)
- :test #'equalp)
-
-(define-unibyte-decoder :iso-8859-3 (octet)
- (if (< octet #xa0)
- octet
- (svref +iso-8859-3-to-unicode+ (the ub8 (- octet #xa0)))))
-
-(define-character-encoding :iso-8859-4
- "An 8-bit, fixed-width character encoding in which codes
-#x00-#x9f map to their Unicode equivalents and other codes map to
-other Unicode character values. Intended to provide most
-characters found in most languages used in Northern Europe."
- :aliases '(:latin-4 :latin4)
- :literal-char-code-limit #xa0)
-
-(define-constant +unicode-a0-180-to-iso-8859-4+
- #(#xa0 nil nil nil #xa4 nil nil #xa7 ; #xa0-#xa7
- #xa8 nil nil nil nil #xad nil #xaf ; #xa8-#xaf
- #xb0 nil nil nil #xb4 nil nil nil ; #xb0-#xb7
- #xb8 nil nil nil nil nil nil nil ; #xb8-#xbf
- nil #xc1 #xc2 #xc3 #xc4 #xc5 #xc6 nil ; #xc0-#xc7
- nil #xc9 nil #xcb nil #xcd #xce nil ; #xc8-#xcf
- nil nil nil nil #xd4 #xd5 #xd6 #xd7 ; #xd0-#xd7
- #xd8 nil #xda #xdb #xdc nil nil #xdf ; #xd8-#xdf
- nil #xe1 #xe2 #xe3 #xe4 #xe5 #xe6 nil ; #xe0-#xe7
- nil #xe9 nil #xeb nil #xed #xee nil ; #xe8-#xef
- nil nil nil nil #xf4 #xf5 #xf6 #xf7 ; #xf0-#xf7
- #xf8 nil #xfa #xfb #xfc nil nil nil ; #xf8-#xff
- #xc0 #xe0 nil nil #xa1 #xb1 nil nil ; #x100-#x107
- nil nil nil nil #xc8 #xe8 nil nil ; #x108-#x10f
- #xd0 #xf0 #xaa #xba nil nil #xcc #xec ; #x110-#x117
- #xca #xea nil nil nil nil nil nil ; #x118-#x11f
- nil nil #xab #xbb nil nil nil nil ; #x120-#x127
- #xa5 #xb5 #xcf #xef nil nil #xc7 #xe7 ; #x128-#x12f
- nil nil nil nil nil nil #xd3 #xf3 ; #x130-#x137
- #xa2 nil nil #xa6 #xb6 nil nil nil ; #x138-#x13f
- nil nil nil nil nil #xd1 #xf1 nil ; #x140-#x147
- nil nil #xbd #xbf #xd2 #xf2 nil nil ; #x148-#x14f
- nil nil nil nil nil nil #xa3 #xb3 ; #x150-#x157
- nil nil nil nil nil nil nil nil ; #x158-#x15f
- #xa9 #xb9 nil nil nil nil #xac #xbc ; #x160-#x167
- #xdd #xfd #xde #xfe nil nil nil nil ; #x168-#x16f
- nil nil #xd9 #xf9 nil nil nil nil ; #x170-#x177
- nil nil nil nil nil #xae #xbe nil) ; #x178-#x17f
- :test #'equalp)
-
-(define-constant +unicode-2c0-2e0-to-iso-8859-4+
- #(nil nil nil nil nil nil nil #xb7 ; #x2c0-#x2c7
- nil nil nil nil nil nil nil nil ; #x2c8-#x2cf
- nil nil nil nil nil nil nil nil ; #x2d0-#x2d7
- nil #xff nil #xb2 nil nil nil nil) ; #x2d8-#x2df
- :test #'equalp)
-
-(define-unibyte-encoder :iso-8859-4 (code)
- (or (cond ((< code #xa0) code)
- ((< code #x180)
- (svref +unicode-a0-180-to-iso-8859-4+
- (the ub8 (- code #xa0))))
- ((<= #x2c0 code #x2df)
- (svref +unicode-2c0-2e0-to-iso-8859-4+
- (the ub8 (- code #x2c0)))))
- (handle-error)))
-
-(define-constant +iso-8859-4-to-unicode+
- #(;; #xa0
- #x00a0 #x0104 #x0138 #x0156 #x00a4 #x0128 #x013b #x00a7
- #x00a8 #x0160 #x0112 #x0122 #x0166 #x00ad #x017d #x00af
- ;; #xb0
- #x00b0 #x0105 #x02db #x0157 #x00b4 #x0129 #x013c #x02c7
- #x00b8 #x0161 #x0113 #x0123 #x0167 #x014a #x017e #x014b
- ;; #xc0
- #x0100 #x00c1 #x00c2 #x00c3 #x00c4 #x00c5 #x00c6 #x012e
- #x010c #x00c9 #x0118 #x00cb #x0116 #x00cd #x00ce #x012a
- ;; #xd0
- #x0110 #x0145 #x014c #x0136 #x00d4 #x00d5 #x00d6 #x00d7
- #x00d8 #x0172 #x00da #x00db #x00dc #x0168 #x016a #x00df
- ;; #xe0
- #x0101 #x00e1 #x00e2 #x00e3 #x00e4 #x00e5 #x00e6 #x012f
- #x010d #x00e9 #x0119 #x00eb #x0117 #x00ed #x00ee #x012b
- ;; #xf0
- #x0111 #x0146 #x014d #x0137 #x00f4 #x00f5 #x00f6 #x00f7
- #x00f8 #x0173 #x00fa #x00fb #x00fc #x0169 #x016b #x02d9)
- :test #'equalp)
-
-(define-unibyte-decoder :iso-8859-4 (octet)
- (if (< octet #xa0)
- octet
- (svref +iso-8859-4-to-unicode+ (the ub8 (- octet #xa0)))))
-
-(define-character-encoding :iso-8859-5
- "An 8-bit, fixed-width character encoding in which codes
-#x00-#x9f map to their Unicode equivalents and other codes map to
-other Unicode character values. Intended to provide most
-characters found in the Cyrillic alphabet."
- :aliases '(:cyrillic)
- :literal-char-code-limit #xa0)
-
-(define-constant +unicode-a0-b0-to-iso-8859-5+
- #(#xa0 nil nil nil nil nil nil #xfd ; #xa0-#xa7
- nil nil nil nil nil #xad nil nil) ; #xa8-#xaf
- :test #'equalp)
-
-(define-constant +unicode-400-460-to-iso-8859-5+
- #(nil #xa1 #xa2 #xa3 #xa4 #xa5 #xa6 #xa7 ; #x400-#x407
- #xa8 #xa9 #xaa #xab #xac nil #xae #xaf ; #x408-#x40f
- #xb0 #xb1 #xb2 #xb3 #xb4 #xb5 #xb6 #xb7 ; #x410-#x417
- #xb8 #xb9 #xba #xbb #xbc #xbd #xbe #xbf ; #x418-#x41f
- #xc0 #xc1 #xc2 #xc3 #xc4 #xc5 #xc6 #xc7 ; #x420-#x427
- #xc8 #xc9 #xca #xcb #xcc #xcd #xce #xcf ; #x428-#x42f
- #xd0 #xd1 #xd2 #xd3 #xd4 #xd5 #xd6 #xd7 ; #x430-#x437
- #xd8 #xd9 #xda #xdb #xdc #xdd #xde #xdf ; #x438-#x43f
- #xe0 #xe1 #xe2 #xe3 #xe4 #xe5 #xe6 #xe7 ; #x440-#x447
- #xe8 #xe9 #xea #xeb #xec #xed #xee #xef ; #x448-#x44f
- nil #xf1 #xf2 #xf3 #xf4 #xf5 #xf6 #xf7 ; #x450-#x457
- #xf8 #xf9 #xfa #xfb #xfc nil #xfe #xff) ; #x458-#x45f
- :test #'equalp)
-
-(define-unibyte-encoder :iso-8859-5 (code)
- (or (cond ((< code #xa0) code)
- ((< code #xb0)
- (svref +unicode-a0-b0-to-iso-8859-5+
- (the ub8 (- code #xa0))))
- ((<= #x400 code #x45f)
- (svref +unicode-400-460-to-iso-8859-5+
- (the ub8 (- code #x400))))
- ;; the Numero sign
- ((= code #x2116) #xf0))
- (handle-error)))
-
-(define-constant +iso-8859-5-to-unicode+
- #(;; #xa0
- #x00a0 #x0401 #x0402 #x0403 #x0404 #x0405 #x0406 #x0407
- #x0408 #x0409 #x040a #x040b #x040c #x00ad #x040e #x040f
- ;; #xb0
- #x0410 #x0411 #x0412 #x0413 #x0414 #x0415 #x0416 #x0417
- #x0418 #x0419 #x041a #x041b #x041c #x041d #x041e #x041f
- ;; #xc0
- #x0420 #x0421 #x0422 #x0423 #x0424 #x0425 #x0426 #x0427
- #x0428 #x0429 #x042a #x042b #x042c #x042d #x042e #x042f
- ;; #xd0
- #x0430 #x0431 #x0432 #x0433 #x0434 #x0435 #x0436 #x0437
- #x0438 #x0439 #x043a #x043b #x043c #x043d #x043e #x043f
- ;; #xe0
- #x0440 #x0441 #x0442 #x0443 #x0444 #x0445 #x0446 #x0447
- #x0448 #x0449 #x044a #x044b #x044c #x044d #x044e #x044f
- ;; #xf0
- #x2116 #x0451 #x0452 #x0453 #x0454 #x0455 #x0456 #x0457
- #x0458 #x0459 #x045a #x045b #x045c #x00a7 #x045e #x045f)
- :test #'equalp)
-
-(define-unibyte-decoder :iso-8859-5 (octet)
- (if (< octet #xa0)
- octet
- (svref +iso-8859-5-to-unicode+ (the ub8 (- octet #xa0)))))
-
-(define-character-encoding :iso-8859-6
- "An 8-bit, fixed-width character encoding in which codes #x00-#x9f
-map to their Unicode equivalents and other codes map to other Unicode
-character values. Intended to provide most characters found in the
-Arabic alphabet."
- :aliases '(:arabic)
- :literal-char-code-limit #xa0)
-
-(define-constant +unicode-a0-b0-to-iso-8859-6+
- #(#xa0 nil nil nil #xa4 nil nil nil ; #xa0-#xa7
- nil nil nil nil nil #xad nil nil) ; #xa8-#xaf
- :test #'equalp)
-
-(define-constant +unicode-608-658-to-iso-8859-6+
- #(nil nil nil nil #xac nil nil nil ; #x608-#x60f
- nil nil nil nil nil nil nil nil ; #x610-#x617
- nil nil nil #xbb nil nil nil #xbf ; #x618-#x61f
- nil #xc1 #xc2 #xc3 #xc4 #xc5 #xc6 #xc7 ; #x620-#x627
- #xc8 #xc9 #xca #xcb #xcc #xcd #xce #xcf ; #x628-#x62f
- #xd0 #xd1 #xd2 #xd3 #xd4 #xd5 #xd6 #xd7 ; #x630-#x637
- #xd8 #xd9 #xda nil nil nil nil nil ; #x638-#x63f
- #xe0 #xe1 #xe2 #xe3 #xe4 #xe5 #xe6 #xe7 ; #x640-#x647
- #xe8 #xe9 #xea #xeb #xec #xed #xee #xef ; #x648-#x64f
- #xf0 #xf1 #xf2 nil nil nil nil nil) ; #x650-#x657
- :test #'equalp)
-
-(define-unibyte-encoder :iso-8859-6 (code)
- (or (cond ((< code #xa0) code)
- ((< code #xb0)
- (svref +unicode-a0-b0-to-iso-8859-6+
- (the ub8 (- code #xa0))))
- ((<= #x608 code #x657)
- (svref +unicode-608-658-to-iso-8859-6+
- (the ub8 (- code #x608)))))
- (handle-error)))
-
-(define-constant +iso-8859-6-to-unicode+
- #(;; #xa0
- #x00a0 #xfffd #xfffd #xfffd #x00a4 #xfffd #xfffd #xfffd
- #xfffd #xfffd #xfffd #xfffd #x060c #x00ad #xfffd #xfffd
- ;; #xb0
- #xfffd #xfffd #xfffd #xfffd #xfffd #xfffd #xfffd #xfffd
- #xfffd #xfffd #xfffd #x061b #xfffd #xfffd #xfffd #x061f
- ;; #xc0
- #xfffd #x0621 #x0622 #x0623 #x0624 #x0625 #x0626 #x0627
- #x0628 #x0629 #x062a #x062b #x062c #x062d #x062e #x062f
- ;; #xd0
- #x0630 #x0631 #x0632 #x0633 #x0634 #x0635 #x0636 #x0637
- #x0638 #x0639 #x063a #xfffd #xfffd #xfffd #xfffd #xfffd
- ;; #xe0
- #x0640 #x0641 #x0642 #x0643 #x0644 #x0645 #x0646 #x0647
- #x0648 #x0649 #x064a #x064b #x064c #x064d #x064e #x064f
- ;; #xf0
- #x0650 #x0651 #x0652 #xfffd #xfffd #xfffd #xfffd #xfffd
- #xfffd #xfffd #xfffd #xfffd #xfffd #xfffd #xfffd #xfffd)
- :test #'equalp)
-
-(define-unibyte-decoder :iso-8859-6 (octet)
- (if (< octet #xa0)
- octet
- (svref +iso-8859-6-to-unicode+ (the ub8 (- octet #xa0)))))
-
-(define-character-encoding :iso-8859-7
- "An 8-bit, fixed-width character encoding in which codes
-#x00-#x9f map to their Unicode equivalents and other codes map to
-other Unicode character values. Intended to provide most
-characters found in the Greek alphabet."
- :aliases '(:greek)
- :literal-char-code-limit #xa0)
-
-(define-constant +unicode-a0-c0-to-iso-8859-7+
- #(#xa0 nil nil #xa3 nil nil #xa6 #xa7 ; #xa0-#xa7
- #xa8 #xa9 nil #xab #xac #xad nil nil ; #xa8-#xaf
- #xb0 #xb1 #xb2 #xb3 nil nil nil #xb7 ; #xb0-#xb7
- nil nil nil #xbb nil #xbd nil nil) ; #xb8-#xbf
- :test #'equalp)
-
-(define-constant +unicode-378-3d0-to-iso-8859-7+
- #(nil nil #xaa nil nil nil nil nil ; #x378-#x37f
- nil nil nil nil #xb4 #xb5 #xb6 nil ; #x380-#x387
- #xb8 #xb9 #xba nil #xbc nil #xbe #xbf ; #x388-#x38f
- #xc0 #xc1 #xc2 #xc3 #xc4 #xc5 #xc6 #xc7 ; #x390-#x397
- #xc8 #xc9 #xca #xcb #xcc #xcd #xce #xcf ; #x398-#x39f
- #xd0 #xd1 nil #xd3 #xd4 #xd5 #xd6 #xd7 ; #x3a0-#x3a7
- #xd8 #xd9 #xda #xdb #xdc #xdd #xde #xdf ; #x3a8-#x3af
- #xe0 #xe1 #xe2 #xe3 #xe4 #xe5 #xe6 #xe7 ; #x3b0-#x3b7
- #xe8 #xe9 #xea #xeb #xec #xed #xee #xef ; #x3b8-#x3bf
- #xf0 #xf1 #xf2 #xf3 #xf4 #xf5 #xf6 #xf7 ; #x3c0-#x3c7
- #xf8 #xf9 #xfa #xfb #xfc #xfd #xfe nil) ; #x3c8-#x3cf
- :test #'equalp)
-
-(define-constant +unicode-2010-2020-to-iso-8859-7+
- #(nil nil nil nil nil #xaf nil nil ; #x2010-#x2017
- #xa1 #xa2 nil nil nil nil nil nil) ; #x2018-#x201f
- :test #'equalp)
-
-(define-constant +unicode-20ac-20b0-to-iso-8859-7+
- #(#xa4 nil nil #xa5)
- :test #'equalp)
-
-(define-unibyte-encoder :iso-8859-7 (code)
- (or (cond ((< code #xa0) code)
- ((< code #xc0)
- (svref +unicode-a0-c0-to-iso-8859-7+
- (the ub8 (- code #xa0))))
- ((<= #x378 code #x3cf)
- (svref +unicode-378-3d0-to-iso-8859-7+
- (the ub8 (- code #x378))))
- ((<= #x2010 code #x201f)
- (svref +unicode-2010-2020-to-iso-8859-7+
- (the ub8 (- code #x2010))))
- ((<= #x201c code #x20af)
- (svref +unicode-20ac-20b0-to-iso-8859-7+
- (the ub8 (- code #x20ac)))))
- (handle-error)))
-
-(define-constant +iso-8859-7-to-unicode+
- #(;; #xa0
- #x00a0 #x2018 #x2019 #x00a3 #x20ac #x20af #x00a6 #x00a7
- #x00a8 #x00a9 #x037a #x00ab #x00ac #x00ad #xfffd #x2015
- ;; #xb0
- #x00b0 #x00b1 #x00b2 #x00b3 #x0384 #x0385 #x0386 #x00b7
- #x0388 #x0389 #x038a #x00bb #x038c #x00bd #x038e #x038f
- ;; #xc0
- #x0390 #x0391 #x0392 #x0393 #x0394 #x0395 #x0396 #x0397
- #x0398 #x0399 #x039a #x039b #x039c #x039d #x039e #x039f
- ;; #xd0
- #x03a0 #x03a1 #xfffd #x03a3 #x03a4 #x03a5 #x03a6 #x03a7
- #x03a8 #x03a9 #x03aa #x03ab #x03ac #x03ad #x03ae #x03af
- ;; #xe0
- #x03b0 #x03b1 #x03b2 #x03b3 #x03b4 #x03b5 #x03b6 #x03b7
- #x03b8 #x03b9 #x03ba #x03bb #x03bc #x03bd #x03be #x03bf
- ;; #xf0
- #x03c0 #x03c1 #x03c2 #x03c3 #x03c4 #x03c5 #x03c6 #x03c7
- #x03c8 #x03c9 #x03ca #x03cb #x03cc #x03cd #x03ce #xfffd)
- :test #'equalp)
-
-(define-unibyte-decoder :iso-8859-7 (octet)
- (if (< octet #xa0)
- octet
- (svref +iso-8859-7-to-unicode+ (the ub8 (- octet #xa0)))))
-
-(define-character-encoding :iso-8859-8
- "An 8-bit, fixed-width character encoding in which codes #x00-#x9f
-map to their Unicode equivalents and other codes map to other Unicode
-character values. Intended to provide most characters found in the
-Hebrew alphabet."
- :aliases '(:hebrew)
- :literal-char-code-limit #xa0)
-
-(define-constant +unicode-a0-f8-to-iso-8859-8+
- #(#xa0 nil #xa2 #xa3 #xa4 #xa5 #xa6 #xa7 ; #xa0-#xa7
- #xa8 #xa9 nil #xab #xac #xad #xae #xaf ; #xa8-#xaf
- #xb0 #xb1 #xb2 #xb3 #xb4 #xb5 #xb6 #xb7 ; #xb0-#xb7
- #xb8 #xb9 nil #xbb #xbc #xbd #xbe nil ; #xb8-#xbf
- nil nil nil nil nil nil nil nil ; #xc0-#xc7
- nil nil nil nil nil nil nil nil ; #xc8-#xcf
- nil nil nil nil nil nil nil #xaa ; #xd0-#xd7
- nil nil nil nil nil nil nil nil ; #xd8-#xdf
- nil nil nil nil nil nil nil nil ; #xe0-#xe7
- nil nil nil nil nil nil nil nil ; #xe8-#xef
- nil nil nil nil nil nil nil #xba) ; #xf0-#xf7
- :test #'equalp)
-
-(define-constant +unicode-5d0-5f0-to-iso-8859-8+
- #(#xe0 #xe1 #xe2 #xe3 #xe4 #xe5 #xe6 #xe7 ; #x5d0-#x5d7
- #xe8 #xe9 #xea #xeb #xec #xed #xee #xef ; #x5d8-#x5df
- #xf0 #xf1 #xf2 #xf3 #xf4 #xf5 #xf6 #xf7 ; #x5e0-#x5e7
- #xf8 #xf9 #xfa nil nil nil nil nil) ; #x5e8-#x5ef
- :test #'equalp)
-
-(define-constant +unicode-2008-2018-to-iso-8859-8+
- #(nil nil nil nil nil nil #xfd #xfe ; #x2008-#x200f
- nil nil nil nil nil nil nil #xdf) ; #x2010-#x2017
- :test #'equalp)
-
-(define-unibyte-encoder :iso-8859-8 (code)
- (or (cond ((< code #xa0) code)
- ((< code #xf8)
- (svref +unicode-a0-f8-to-iso-8859-8+
- (the ub8 (- code #xa0))))
- ((<= #x5d0 code #x5ef)
- (svref +unicode-5d0-5f0-to-iso-8859-8+
- (the ub8 (- code #x5d0))))
- ((<= #x2008 code #x201f)
- (svref +unicode-2008-2018-to-iso-8859-8+
- (the ub8 (- code #x2008)))))
- (handle-error)))
-
-(define-constant +iso-8859-8-to-unicode+
- #(;; #xa0
- #x00a0 #xfffd #x00a2 #x00a3 #x00a4 #x00a5 #x00a6 #x00a7
- #x00a8 #x00a9 #x00d7 #x00ab #x00ac #x00ad #x00ae #x00af
- ;; #xb0
- #x00b0 #x00b1 #x00b2 #x00b3 #x00b4 #x00b5 #x00b6 #x00b7
- #x00b8 #x00b9 #x00f7 #x00bb #x00bc #x00bd #x00be #xfffd
- ;; #xc0
- #xfffd #xfffd #xfffd #xfffd #xfffd #xfffd #xfffd #xfffd
- #xfffd #xfffd #xfffd #xfffd #xfffd #xfffd #xfffd #xfffd
- ;; #xd0
- #xfffd #xfffd #xfffd #xfffd #xfffd #xfffd #xfffd #xfffd
- #xfffd #xfffd #xfffd #xfffd #xfffd #xfffd #xfffd #x2017
- ;; #xe0
- #x05d0 #x05d1 #x05d2 #x05d3 #x05d4 #x05d5 #x05d6 #x05d7
- #x05d8 #x05d9 #x05da #x05db #x05dc #x05dd #x05de #x05df
- ;; #xf0
- #x05e0 #x05e1 #x05e2 #x05e3 #x05e4 #x05e5 #x05e6 #x05e7
- #x05e8 #x05e9 #x05ea #xfffd #xfffd #x200e #x200f #xfffd)
- :test #'equalp)
-
-(define-unibyte-decoder :iso-8859-8 (octet)
- (if (< octet #xa0)
- octet
- (svref +iso-8859-8-to-unicode+ (the ub8 (- octet #xa0)))))
-
-(define-character-encoding :iso-8859-9
- "An 8-bit, fixed-width character encoding in which codes
-#x00-#xcf map to their Unicode equivalents and other codes map to
-other Unicode character values. Intended to provide most
-characters found in the Turkish alphabet."
- :aliases '(:latin-5 :latin5)
- :decode-literal-code-unit-limit #xd0
- :encode-literal-code-unit-limit #xa0)
-
-(define-constant +unicode-d0-100-to-iso-8859-9+
- #(nil #xd1 #xd2 #xd3 #xd4 #xd5 #xd6 #xd7 ; #xd0-#xd7
- #xd8 #xd9 #xda #xdb #xdc nil nil #xdf ; #xd8-#xdf
- #xe0 #xe1 #xe2 #xe3 #xe4 #xe5 #xe6 #xe7 ; #xe0-#xe7
- #xe8 #xe9 #xea #xeb #xec #xed #xee #xef ; #xe8-#xef
- nil #xf1 #xf2 #xf3 #xf4 #xf5 #xf6 #xf7 ; #xf0-#xf7
- #xf8 #xf9 #xfa #xfb #xfc nil nil #xff) ; #xf8-#xff
- :test #'equalp)
-
-(define-constant +unicode-118-160-to-iso-8859-9+
- #(nil nil nil nil nil nil #xd0 #xf0 ; #x118-#x11f
- nil nil nil nil nil nil nil nil ; #x120-#x127
- nil nil nil nil nil nil nil nil ; #x128-#x12f
- #xdd #xfd nil nil nil nil nil nil ; #x130-#x137
- nil nil nil nil nil nil nil nil ; #x138-#x13f
- nil nil nil nil nil nil nil nil ; #x140-#x147
- nil nil nil nil nil nil nil nil ; #x148-#x14f
- nil nil nil nil nil nil nil nil ; #x150-#x157
- nil nil nil nil nil nil #xde #xfe) ; #x158-#x15f
- :test #'equalp)
-
-(define-unibyte-encoder :iso-8859-9 (code)
- (or (cond ((< code #xd0) code)
- ((< code #x100)
- (svref +unicode-d0-100-to-iso-8859-9+
- (the ub8 (- code #xd0))))
- ((<= #x118 code #x15f)
- (svref +unicode-118-160-to-iso-8859-9+
- (the ub8 (- code #x118)))))
- (handle-error)))
-
-(define-constant +iso-8859-9-to-unicode+
- #(;; #xd0
- #x011e #x00d1 #x00d2 #x00d3 #x00d4 #x00d5 #x00d6 #x00d7
- #x00d8 #x00d9 #x00da #x00db #x00dc #x0130 #x015e #x00df
- ;; #xe0
- #x00e0 #x00e1 #x00e2 #x00e3 #x00e4 #x00e5 #x00e6 #x00e7
- #x00e8 #x00e9 #x00ea #x00eb #x00ec #x00ed #x00ee #x00ef
- ;; #xf0
- #x011f #x00f1 #x00f2 #x00f3 #x00f4 #x00f5 #x00f6 #x00f7
- #x00f8 #x00f9 #x00fa #x00fb #x00fc #x0131 #x015f #x00ff)
- :test #'equalp)
-
-(define-unibyte-decoder :iso-8859-9 (octet)
- (if (< octet #xd0)
- octet
- (svref +iso-8859-9-to-unicode+ (the ub8 (- octet #xd0)))))
-
-(define-character-encoding :iso-8859-10
- "An 8-bit, fixed-width character encoding in which codes
-#x00-#x9f map to their Unicode equivalents and other codes map to
-other Unicode character values. Intended to provide most
-characters found in Nordic alphabets."
- :aliases '(:latin-6 :latin6)
- :literal-char-code-limit #xa0)
-
-(define-constant +unicode-a0-180-to-iso-8859-10+
- #(#xa0 nil nil nil nil nil nil #xa7 ; #xa0-#xa7
- nil nil nil nil nil #xad nil nil ; #xa8-#xaf
- #xb0 nil nil nil nil nil nil #xb7 ; #xb0-#xb7
- nil nil nil nil nil #x2015 nil nil ; #xb8-#xbf
- nil #xc1 #xc2 #xc3 #xc4 #xc5 #xc6 nil ; #xc0-#xc7
- nil #xc9 nil #xcb nil #xcd #xce #xcf ; #xc8-#xcf
- #xd0 nil nil #xd3 #xd4 #xd5 #xd6 nil ; #xd0-#xd7
- #xd8 nil #xda #xdb #xdc #xdd #xde #xdf ; #xd8-#xdf
- nil #xe1 #xe2 #xe3 #xe4 #xe5 #xe6 nil ; #xe0-#xe7
- nil #xe9 nil #xeb nil #xed #xee #xef ; #xe8-#xef
- #xf0 nil nil #xf3 #xf4 #xf5 #xf6 nil ; #xf0-#xf7
- #xf8 nil #xfa #xfb #xfc #xfd #xfe nil ; #xf8-#xff
- #xc0 #xe0 nil nil #xa1 #xb1 nil nil ; #x100-#x107
- nil nil nil nil #xc8 #xe8 nil nil ; #x108-#x10f
- #xa9 #xb9 #xa2 #xb2 nil nil #xcc #xec ; #x110-#x117
- #xca #xea nil nil nil nil nil nil ; #x118-#x11f
- nil nil #xa3 #xb3 nil nil nil nil ; #x120-#x127
- #xa5 #xb5 #xa4 #xb4 nil nil #xc7 #xe7 ; #x128-#x12f
- nil nil nil nil nil nil #xa6 #xb6 ; #x130-#x137
- #xff nil nil #xa8 #xb8 nil nil nil ; #x138-#x13f
- nil nil nil nil nil #xd1 #xf1 nil ; #x140-#x147
- nil nil #xaf #xbf #xd2 #xf2 nil nil ; #x148-#x14f
- nil nil nil nil nil nil nil nil ; #x150-#x157
- nil nil nil nil nil nil nil nil ; #x158-#x15f
- #xaa #xba nil nil nil nil #xab #xbb ; #x160-#x167
- #xd7 #xf7 #xae #xbe nil nil nil nil ; #x168-#x16f
- nil nil #xd9 #xf9 nil nil nil nil ; #x170-#x177
- nil nil nil nil nil #xac #xbc nil) ; #x178-#x17f
- :test #'equalp)
-
-(define-unibyte-encoder :iso-8859-10 (code)
- (or (cond ((< code #xa0) code)
- ((< code #x180)
- (svref +unicode-a0-180-to-iso-8859-10+
- (the ub8 (- code #xa0))))
- ;; Horizontal bar
- ((= code #x2015) #xbd))
- (handle-error)))
-
-(define-constant +iso-8859-10-to-unicode+
- #(;; #xa0
- #x00a0 #x0104 #x0112 #x0122 #x012a #x0128 #x0136 #x00a7
- #x013b #x0110 #x0160 #x0166 #x017d #x00ad #x016a #x014a
- ;; #xb0
- #x00b0 #x0105 #x0113 #x0123 #x012b #x0129 #x0137 #x00b7
- #x013c #x0111 #x0161 #x0167 #x017e #x2015 #x016b #x014b
- ;; #xc0
- #x0100 #x00c1 #x00c2 #x00c3 #x00c4 #x00c5 #x00c6 #x012e
- #x010c #x00c9 #x0118 #x00cb #x0116 #x00cd #x00ce #x00cf
- ;; #xd0
- #x00d0 #x0145 #x014c #x00d3 #x00d4 #x00d5 #x00d6 #x0168
- #x00d8 #x0172 #x00da #x00db #x00dc #x00dd #x00de #x00df
- ;; #xe0
- #x0101 #x00e1 #x00e2 #x00e3 #x00e4 #x00e5 #x00e6 #x012f
- #x010d #x00e9 #x0119 #x00eb #x0117 #x00ed #x00ee #x00ef
- ;; #xf0
- #x00f0 #x0146 #x014d #x00f3 #x00f4 #x00f5 #x00f6 #x0169
- #x00f8 #x0173 #x00fa #x00fb #x00fc #x00fd #x00fe #x0138)
- :test #'equalp)
-
-(define-unibyte-decoder :iso-8859-10 (octet)
- (if (< octet #xa0)
- octet
- (svref +iso-8859-10-to-unicode+ (the ub8 (- octet #xa0)))))
-
-(define-character-encoding :iso-8859-11
- "An 8-bit, fixed-width character encoding in which codes
-#x00-#x9f map to their Unicode equivalents and other codes map to
-other Unicode character values. Intended to provide most
-characters found the Thai alphabet."
- :aliases '()
- :literal-char-code-limit #xa0)
-
-(define-unibyte-encoder :iso-8859-11 (code)
- (cond ((< code #xa1) code)
- ((and (<= #xe01 code #xe5b)
- (not (<= #xe3b code #xe3e))
- (not (<= #xe5c code #xe5f)))
- (- code #xd60))
- (t (handle-error))))
-
-(define-unibyte-decoder :iso-8859-11 (octet)
- (cond ((<= octet #xa0) octet)
- ((or (<= #xdb octet #xde)
- (<= #xfc octet #xff))
- #xfffd)
- ((<= octet #xfb)
- (+ octet #x0d60))
- (t (handle-error))))
-
-;;; There is no iso-8859-12 encoding.
-
-(define-character-encoding :iso-8859-13
- "An 8-bit, fixed-width character encoding in which codes
-#x00-#x9f map to their Unicode equivalents and other codes map to
-other Unicode character values. Intended to provide most
-characters found in Baltic alphabets."
- :aliases '()
- :literal-char-code-limit #xa0)
-
-(define-constant +unicode-a0-180-to-iso-8859-13+
- #(#xa0 nil #xa2 #xa3 #xa4 nil #xa6 #xa7 ; #xa0-#xa7
- nil #xa9 nil #xab #xac #xad #xae nil ; #xa8-#xaf
- #xb0 #xb1 #xb2 #xb3 nil #xb5 #xb6 #xb7 ; #xb0-#xb7
- nil #xb9 nil #xbb #xbc #xbd #xbe nil ; #xb8-#xbf
- nil nil nil nil #xc4 #xc5 #xaf nil ; #xc0-#xc7
- nil #xc9 nil nil nil nil nil nil ; #xc8-#xcf
- nil nil nil #xd3 nil #xd5 #xd6 #xd7 ; #xd0-#xd7
- #xa8 nil nil nil #xdc nil nil #xdf ; #xd8-#xdf
- nil nil nil nil #xe4 #xe5 #xbf nil ; #xe0-#xe7
- nil #xe9 nil nil nil nil nil nil ; #xe8-#xef
- nil nil nil #xf3 nil #xf5 #xf6 #xf7 ; #xf0-#xf7
- #xb8 nil nil nil #xfc nil nil nil ; #xf8-#xff
- #xc2 #xe2 nil nil #xc0 #xe0 #xc3 #xe3 ; #x100-#x107
- nil nil nil nil #xc8 #xe8 nil nil ; #x108-#x10f
- nil nil #xc7 #xe7 nil nil #xcb #xeb ; #x110-#x117
- #xc6 #xe6 nil nil nil nil nil nil ; #x118-#x11f
- nil nil #xcc #xec nil nil nil nil ; #x120-#x127
- nil nil #xce #xee nil nil #xc1 #xe1 ; #x128-#x12f
- nil nil nil nil nil nil #xcd #xed ; #x130-#x137
- nil nil nil #xcf #xef nil nil nil ; #x138-#x13f
- nil #xd9 #xf9 #xd1 #xf1 #xd2 #xf2 nil ; #x140-#x147
- nil nil nil nil #xd4 #xf4 nil nil ; #x148-#x14f
- nil nil nil nil nil nil #xaa #xba ; #x150-#x157
- nil nil #xda #xfa nil nil nil nil ; #x158-#x15f
- #xd0 #xf0 nil nil nil nil nil nil ; #x160-#x167
- nil nil #xdb #xfb nil nil nil nil ; #x168-#x16f
- nil nil #xd8 #xf8 nil nil nil nil ; #x170-#x177
- nil #xca #xea #xdd #xfd #xde #xfe nil) ; #x178-#x17f
- :test #'equalp)
-
-(define-constant +unicode-2018-2020-to-iso-8859-13+
- #(nil #xff nil nil #xb4 #xa1 #xa5 nil) ; #x2018-#x201f
- :test #'equalp)
-
-(define-unibyte-encoder :iso-8859-13 (code)
- (or (cond ((< code #xa0) code)
- ((< code #x180)
- (svref +unicode-a0-180-to-iso-8859-13+
- (the ub8 (- code #xa0))))
- ((<= #x2018 code #x201f)
- (svref +unicode-2018-2020-to-iso-8859-13+
- (the ub8 (- code #x2018)))))
- (handle-error)))
-
-(define-constant +iso-8859-13-to-unicode+
- #(;; #xa0
- #x00a0 #x201d #x00a2 #x00a3 #x00a4 #x201e #x00a6 #x00a7
- #x00d8 #x00a9 #x0156 #x00ab #x00ac #x00ad #x00ae #x00c6
- ;; #xb0
- #x00b0 #x00b1 #x00b2 #x00b3 #x201c #x00b5 #x00b6 #x00b7
- #x00f8 #x00b9 #x0157 #x00bb #x00bc #x00bd #x00be #x00e6
- ;; #xc0
- #x0104 #x012e #x0100 #x0106 #x00c4 #x00c5 #x0118 #x0112
- #x010c #x00c9 #x0179 #x0116 #x0122 #x0136 #x012a #x013b
- ;; #xd0
- #x0160 #x0143 #x0145 #x00d3 #x014c #x00d5 #x00d6 #x00d7
- #x0172 #x0141 #x015a #x016a #x00dc #x017b #x017d #x00df
- ;; #xe0
- #x0105 #x012f #x0101 #x0107 #x00e4 #x00e5 #x0119 #x0113
- #x010d #x00e9 #x017a #x0117 #x0123 #x0137 #x012b #x013c
- ;; #xf0
- #x0161 #x0144 #x0146 #x00f3 #x014d #x00f5 #x00f6 #x00f7
- #x0173 #x0142 #x015b #x016b #x00fc #x017c #x017e #x2019)
- :test #'equalp)
-
-(define-unibyte-decoder :iso-8859-13 (octet)
- (if (< octet #xa0)
- octet
- (svref +iso-8859-13-to-unicode+ (the ub8 (- octet #xa0)))))
-
-(define-character-encoding :iso-8859-14
- "An 8-bit, fixed-width character encoding in which codes
-#x00-#x9f map to their Unicode equivalents and other codes map to
-other Unicode character values. Intended to provide most
-characters found in Celtic languages."
- :aliases '(:latin-8 :latin8)
- :literal-char-code-limit #xa0)
-
-(define-constant +unicode-a0-100-to-iso-8859-14+
- #(#xa0 nil nil #xa3 nil nil nil #xa7 ; #xa0-#xa7
- nil #xa9 nil nil nil #xad #xae nil ; #xa8-#xaf
- nil nil nil nil nil nil #xb6 nil ; #xb0-#xb7
- nil nil nil nil nil nil nil nil ; #xb8-#xbf
- #xc0 #xc1 #xc2 #xc3 #xc4 #xc5 #xc6 #xc7 ; #xc0-#xc7
- #xc8 #xc9 #xca #xcb #xcc #xcd #xce #xcf ; #xc8-#xcf
- nil #xd1 #xd2 #xd3 #xd4 #xd5 #xd6 nil ; #xd0-#xd7
- #xd8 #xd9 #xda #xdb #xdc #xdd nil #xdf ; #xd8-#xdf
- #xe0 #xe1 #xe2 #xe3 #xe4 #xe5 #xe6 #xe7 ; #xe0-#xe7
- #xe8 #xe9 #xea #xeb #xec #xed #xee #xef ; #xe8-#xef
- nil #xf1 #xf2 #xf3 #xf4 #xf5 #xf6 nil ; #xf0-#xf7
- #xf8 #xf9 #xfa #xfb #xfc #xfd nil #xff) ; #xf8-#xff
- :test #'equalp)
-
-(define-constant +unicode-108-128-to-iso-8859-14+
- #(nil nil #xa4 #xa5 nil nil nil nil ; #x108-#x10f
- nil nil nil nil nil nil nil nil ; #x110-#x117
- nil nil nil nil nil nil nil nil ; #x118-#x11f
- #xb2 #xb3 nil nil nil nil nil nil) ; #x120-#x127
- :test #'equalp)
-
-(define-constant +unicode-170-180-to-iso-8859-14+
- #(nil nil nil nil #xd0 #xf0 #xde #xfe ; #x170-#x177
- #xaf nil nil nil nil nil nil nil) ; #x178-#x17f
- :test #'equalp)
-
-(define-constant +unicode-1e00-1e88-to-iso-8859-14+
- #(nil nil #xa1 #xa2 nil nil nil nil ; #x1e00-#x1e07
- nil nil #xa6 #xab nil nil nil nil ; #x1e08-#x1e0f
- nil nil nil nil nil nil nil nil ; #x1e10-#x1e17
- nil nil nil nil nil nil #xb0 #xb1 ; #x1e18-#x1e1f
- nil nil nil nil nil nil nil nil ; #x1e20-#x1e27
- nil nil nil nil nil nil nil nil ; #x1e28-#x1e2f
- nil nil nil nil nil nil nil nil ; #x1e30-#x1e37
- nil nil nil nil nil nil nil nil ; #x1e38-#x1e3f
- #xb4 #xb5 nil nil nil nil nil nil ; #x1e40-#x1e47
- nil nil nil nil nil nil nil nil ; #x1e48-#x1e4f
- nil nil nil nil nil nil #xb7 #xb9 ; #x1e50-#x1e57
- nil nil nil nil nil nil nil nil ; #x1e58-#x1e5f
- #xbb #xbf nil nil nil nil nil nil ; #x1e60-#x1e67
- nil nil #xd7 #xf7 nil nil nil nil ; #x1e68-#x1e6f
- nil nil nil nil nil nil nil nil ; #x1e70-#x1e77
- nil nil nil nil nil nil nil nil ; #x1e78-#x1e7f
- #xa8 #xb8 #xaa #xba #xbd #xbe nil nil) ; #x1e80-#x1e87
- :test #'equalp)
-
-(define-constant +unicode-1ef0-1ef8-to-iso-8859-14+
- #(nil nil #xac #xbc nil nil nil nil) ; #x1ef0-#x1ef7
- :test #'equalp)
-
-(define-unibyte-encoder :iso-8859-14 (code)
- (or (cond ((< code #xa0) code)
- ((< code #x100)
- (svref +unicode-a0-100-to-iso-8859-14+
- (the ub8 (- code #xa0))))
- ((<= #x108 code #x127)
- (svref +unicode-108-128-to-iso-8859-14+
- (the ub8 (- code #x108))))
- ((<= #x170 code #x17f)
- (svref +unicode-170-180-to-iso-8859-14+
- (the ub8 (- code #x170))))
- ((<= #x1e00 code #x1e87)
- (svref +unicode-1e00-1e88-to-iso-8859-14+
- (the ub8 (- code #x1e00))))
- ((<= #x1ef0 code #x1ef7)
- (svref +unicode-1ef0-1ef8-to-iso-8859-14+
- (the ub8 (- code #x1ef0)))))
- (handle-error)))
-
-(define-constant +iso-8859-14-to-unicode+
- #(;; #xa0
- #x00a0 #x1e02 #x1e03 #x00a3 #x010a #x010b #x1e0a #x00a7
- #x1e80 #x00a9 #x1e82 #x1e0b #x1ef2 #x00ad #x00ae #x0178
- ;; #xb0
- #x1e1e #x1e1f #x0120 #x0121 #x1e40 #x1e41 #x00b6 #x1e56
- #x1e81 #x1e57 #x1e83 #x1e60 #x1ef3 #x1e84 #x1e85 #x1e61
- ;; #xc0
- #x00c0 #x00c1 #x00c2 #x00c3 #x00c4 #x00c5 #x00c6 #x00c7
- #x00c8 #x00c9 #x00ca #x00cb #x00cc #x00cd #x00ce #x00cf
- ;; #xd0
- #x0174 #x00d1 #x00d2 #x00d3 #x00d4 #x00d5 #x00d6 #x1e6a
- #x00d8 #x00d9 #x00da #x00db #x00dc #x00dd #x0176 #x00df
- ;; #xe0
- #x00e0 #x00e1 #x00e2 #x00e3 #x00e4 #x00e5 #x00e6 #x00e7
- #x00e8 #x00e9 #x00ea #x00eb #x00ec #x00ed #x00ee #x00ef
- ;; #xf0
- #x0175 #x00f1 #x00f2 #x00f3 #x00f4 #x00f5 #x00f6 #x1e6b
- #x00f8 #x00f9 #x00fa #x00fb #x00fc #x00fd #x0177 #x00ff)
- :test #'equalp)
-
-(define-unibyte-decoder :iso-8859-14 (octet)
- (if (< octet #xa0)
- octet
- (svref +iso-8859-14-to-unicode+ (the ub8 (- octet #xa0)))))
-
-(define-character-encoding :iso-8859-15
- "An 8-bit, fixed-width character encoding in which codes
-#x00-#x9f map to their Unicode equivalents and other codes map to
-other Unicode character values. Intended to provide most
-characters found in Western European languages (including the
-Euro sign and some other characters missing from ISO-8859-1."
- :aliases '(:latin-9 :latin9)
- :literal-char-code-limit #xa0)
-
-(define-constant +unicode-a0-100-to-iso-8859-15+
- #(#xa0 #xa1 #xa2 #xa3 nil #xa5 nil #xa7 ; #xa0-#xa7
- nil #xa9 #xaa #xab #xac #xad #xae #xaf ; #xa8-#xaf
- #xb0 #xb1 #xb2 #xb3 nil #xb5 #xb6 #xb7 ; #xb0-#xb7
- nil #xb9 #xba #xbb nil nil nil #xbf ; #xb8-0xbf
- #xc0 #xc1 #xc2 #xc3 #xc4 #xc5 #xc6 #xc7 ; #xc0-#xc7
- #xc8 #xc9 #xca #xcb #xcc #xcd #xce #xcf ; #xc8-#xcf
- #xd0 #xd1 #xd2 #xd3 #xd4 #xd5 #xd6 #xd7 ; #xd0-#xd7
- #xd8 #xd9 #xda #xdb #xdc #xdd #xde #xdf ; #xd8-#xdf
- #xe0 #xe1 #xe2 #xe3 #xe4 #xe5 #xe6 #xe7 ; #xe0-#xe7
- #xe8 #xe9 #xea #xeb #xec #xed #xee #xef ; #xe8-#xef
- #xf0 #xf1 #xf2 #xf3 #xf4 #xf5 #xf6 #xf7 ; #xf0-#xf7
- #xf8 #xf9 #xfa #xfb #xfc #xfd #xfe #xff) ; #xf8-#xff
- :test #'equalp)
-
-(define-constant +unicode-150-180-to-iso-8859-15+
- #(nil nil #xbc #xbd nil nil nil nil ; #x150-#x157
- nil nil nil nil nil nil nil nil ; #x158-#x15f
- #xa6 #xa8 nil nil nil nil nil nil ; #x160-#x167
- nil nil nil nil nil nil nil nil ; #x168-#x16f
- nil nil nil nil nil nil nil nil ; #x170-#x177
- #xbe nil nil nil nil #xb4 #xb8 nil) ; #x178-#x17f
- :test #'equalp)
-
-(define-unibyte-encoder :iso-8859-15 (code)
- (or (cond ((< code #xa0) code)
- ((< code #x100)
- (svref +unicode-a0-100-to-iso-8859-15+
- (the ub8 (- code #xa0))))
- ((<= #x150 code #x1f7)
- (svref +unicode-150-180-to-iso-8859-15+
- (the ub8 (- code #x150))))
- ;; Euro sign
- ((= code #x20ac) #xa4))
- (handle-error)))
-
-(define-constant +iso-8859-15-to-unicode+
- #(;; #xa0
- #x00a0 #x00a1 #x00a2 #x00a3 #x20ac #x00a5 #x0160 #x00a7
- #x0161 #x00a9 #x00aa #x00ab #x00ac #x00ad #x00ae #x00af
- ;; #xb0
- #x00b0 #x00b1 #x00b2 #x00b3 #x017d #x00b5 #x00b6 #x00b7
- #x017e #x00b9 #x00ba #x00bb #x0152 #x0153 #x0178 #x00bf
- ;; #xc0
- #x00c0 #x00c1 #x00c2 #x00c3 #x00c4 #x00c5 #x00c6 #x00c7
- ;; #xc8
- #x00c8 #x00c9 #x00ca #x00cb #x00cc #x00cd #x00ce #x00cf
- ;; #xd0
- #x00d0 #x00d1 #x00d2 #x00d3 #x00d4 #x00d5 #x00d6 #x00d7
- ;; #xd8
- #x00d8 #x00d9 #x00da #x00db #x00dc #x00dd #x00de #x00df
- ;; #xe0
- #x00e0 #x00e1 #x00e2 #x00e3 #x00e4 #x00e5 #x00e6 #x00e7
- ;; #xe8
- #x00e8 #x00e9 #x00ea #x00eb #x00ec #x00ed #x00ee #x00ef
- ;; #xf0
- #x00f0 #x00f1 #x00f2 #x00f3 #x00f4 #x00f5 #x00f6 #x00f7
- ;; #xf8
- #x00f8 #x00f9 #x00fa #x00fb #x00fc #x00fd #x00fe #x00ff)
- :test #'equalp)
-
-(define-unibyte-decoder :iso-8859-15 (octet)
- (if (< octet #xa0)
- octet
- (svref +iso-8859-15-to-unicode+ (the ub8 (- octet #xa0)))))
-
-(define-character-encoding :iso-8859-16
- "An 8-bit, fixed-width character encoding in which codes
-#x00-#x9f map to their Unicode equivalents and other codes map to
-other Unicode character values. Intended to provide most
-characters found in Southeast European languages."
- :aliases '(:latin-10 :latin10)
- :literal-char-code-limit #xa0)
-
-(define-constant +unicode-a0-180-to-iso-8859-16+
- #(#xa0 nil nil nil nil nil nil #xa7 ; #xa0-#xa7
- nil #xa9 nil #xab nil #xad nil nil ; #xa8-#xaf
- #xb0 #xb1 nil nil nil nil #xb6 #xb7 ; #xb0-#xb7
- nil nil nil #xbb nil nil nil nil ; #xb8-#xbf
- #xc0 #xc1 #xc2 nil #xc4 nil #xc6 #xc7 ; #xc0-#xc7
- #xc8 #xc9 #xca #xcb #xcc #xcd #xce #xcf ; #xc8-#xcf
- nil nil #xd2 #xd3 #xd4 nil #xd6 nil ; #xd0-#xd7
- nil #xd9 #xda #xdb #xdc nil nil #xdf ; #xd8-#xdf
- #xe0 #xe1 #xe2 nil #xe4 nil #xe6 #xe7 ; #xe0-#xe7
- #xe8 #xe9 #xea #xeb #xec #xed #xee #xef ; #xe8-#xef
- nil nil #xf2 #xf3 #xf4 nil #xf6 nil ; #xf0-#xf7
- nil #xf9 #xfa #xfb #xfc nil nil #xff ; #xf8-#xff
- nil nil #xc3 #xe3 #xa1 #xa2 #xc5 #xe5 ; #x100-#x107
- nil nil nil nil #xb2 #xb9 nil nil ; #x108-#x10f
- #xd0 #xf0 nil nil nil nil nil nil ; #x110-#x117
- #xdd #xfd nil nil nil nil nil nil ; #x118-#x11f
- nil nil nil nil nil nil nil nil ; #x120-#x127
- nil nil nil nil nil nil nil nil ; #x128-#x12f
- nil nil nil nil nil nil nil nil ; #x130-#x137
- nil nil nil nil nil nil nil nil ; #x138-#x13f
- nil #xa3 #xb3 #xd1 #xf1 nil nil nil ; #x140-#x147
- nil nil nil nil nil nil nil nil ; #x148-#x14f
- #xd5 #xf5 #xbc #xbd nil nil nil nil ; #x150-#x157
- nil nil #xd7 #xf7 nil nil nil nil ; #x158-#x15f
- #xa6 #xa8 nil nil nil nil nil nil ; #x160-#x167
- nil nil nil nil nil nil nil nil ; #x168-#x16f
- #xd8 #xf8 nil nil nil nil nil nil ; #x170-#x177
- #xbe #xac #xae #xaf #xbf #xb4 #xb8 nil) ; #x178-#x17f
- :test #'equalp)
-
-(define-constant +unicode-218-220-to-iso-8859-16+
- #(#xaa #xba #xde #xfe nil nil nil nil) ; #x218-#x21f
- :test #'equalp)
-
-(define-constant +unicode-2018-2020-to-iso-8859-16+
- #(nil nil nil nil nil #xb5 #xa5 nil) ; #x2018-#x201f
- :test #'equalp)
-
-(define-unibyte-encoder :iso-8859-16 (code)
- (or (cond ((< code #xa0) code)
- ((< code #x180)
- (svref +unicode-a0-180-to-iso-8859-16+
- (the ub8 (- code #xa0))))
- ((<= #x218 code #x21f)
- (svref +unicode-218-220-to-iso-8859-16+
- (the ub8 (- code #x218))))
- ((< #x2018 code #x201f)
- (svref +unicode-2018-2020-to-iso-8859-16+
- (the ub8 (- code #x2018))))
- ;; Euro sign
- ((= code #x20ac) #xa4))
- (handle-error)))
-
-(define-constant +iso-8859-16-to-unicode+
- #(;; #xa0
- #x00a0 #x0104 #x0105 #x0141 #x20ac #x201e #x0160 #x00a7
- #x0161 #x00a9 #x0218 #x00ab #x0179 #x00ad #x017a #x017b
- ;; #xb0
- #x00b0 #x00b1 #x010c #x0142 #x017d #x201d #x00b6 #x00b7
- #x017e #x010d #x0219 #x00bb #x0152 #x0153 #x0178 #x017c
- ;; #xc0
- #x00c0 #x00c1 #x00c2 #x0102 #x00c4 #x0106 #x00c6 #x00c7
- #x00c8 #x00c9 #x00ca #x00cb #x00cc #x00cd #x00ce #x00cf
- ;; #xd0
- #x0110 #x0143 #x00d2 #x00d3 #x00d4 #x0150 #x00d6 #x015a
- #x0170 #x00d9 #x00da #x00db #x00dc #x0118 #x021a #x00df
- ;; #xe0
- #x00e0 #x00e1 #x00e2 #x0103 #x00e4 #x0107 #x00e6 #x00e7
- #x00e8 #x00e9 #x00ea #x00eb #x00ec #x00ed #x00ee #x00ef
- ;; #xf0
- #x0111 #x0144 #x00f2 #x00f3 #x00f4 #x0151 #x00f6 #x015b
- #x0171 #x00f9 #x00fa #x00fb #x00fc #x0119 #x021b #x00ff)
- :test #'equalp)
-
-(define-unibyte-decoder :iso-8859-16 (octet)
- (if (< octet #xa0)
- octet
- (svref +iso-8859-16-to-unicode+ (the ub8 (- octet #xa0)))))
(DIR) diff --git a/3rdparties/software/babel-20171227-git/src/enc-jpn.lisp b/3rdparties/software/babel-20171227-git/src/enc-jpn.lisp
@@ -1,767 +0,0 @@
-;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
-;;;
-;;; enc-jpn.lisp --- Japanese encodings.
-;;;
-
-(in-package #:babel-encodings)
-
-;;;; helper functions
-(defvar *eucjp-to-ucs-hash* (make-hash-table))
-(defvar *ucs-to-eucjp-hash* (make-hash-table))
-(defvar *cp932-to-ucs-hash* (make-hash-table))
-(defvar *ucs-to-cp932-hash* (make-hash-table))
-
-(dolist (i `((,*cp932-only*
- ,*cp932-to-ucs-hash*
- ,*ucs-to-cp932-hash*)
- (,*eucjp-only*
- ,*eucjp-to-ucs-hash*
- ,*ucs-to-eucjp-hash*)
- (,*eucjp*
- ,*eucjp-to-ucs-hash*
- ,*ucs-to-eucjp-hash*)))
- (dolist (j (first i))
- (setf (gethash (car j) (second i)) (cadr j))
- (setf (gethash (cadr j) (third i)) (car j))))
-
-(flet ((euc-cp932 (x)
- (let ((high (ash x -16))
- (mid (logand (ash x -8) 255))
- (low (logand x 255)))
- (cond ((not (zerop high))
- nil)
- ((= mid #x8e)
- (logand x 255))
- ((zerop mid)
- x)
- ((decf mid #xa1)
- (decf low #x80)
- (incf low (if (zerop (logand mid 1)) #x1f #x7e))
- (incf low (if (<= #x7f low #x9d) 1 0))
- (setq mid (ash mid -1))
- (incf mid (if (<= mid #x1e) #x81 #xc1))
- (+ (ash mid 8) low))))))
- (dolist (i *eucjp*)
- (let ((cp932 (euc-cp932 (first i))))
- (when cp932
- (setf (gethash cp932 *cp932-to-ucs-hash*) (second i))
- (setf (gethash (second i) *ucs-to-cp932-hash*) cp932)))))
-
-;ascii
-(loop for i from #x00 to #x7f do
- (setf (gethash i *cp932-to-ucs-hash*) i)
- (setf (gethash i *eucjp-to-ucs-hash*) i)
- (setf (gethash i *ucs-to-eucjp-hash*) i)
- (setf (gethash i *ucs-to-cp932-hash*) i))
-
-;half-width katakana
-(loop for i from #xa1 to #xdf do
- (setf (gethash i *cp932-to-ucs-hash*) (+ #xff61 #x-a1 i))
- (setf (gethash (+ #xff61 #x-a1 i) *ucs-to-cp932-hash*) i)
- (setf (gethash (+ #x8e00 i) *eucjp-to-ucs-hash*) (+ #xff61 #x-a1 i))
- (setf (gethash (+ #xff61 #x-a1 i) *ucs-to-eucjp-hash*) (+ #x8e00 i)))
-
-;; This is quoted from https://support.microsoft.com/en-us/kb/170559/en-us
-(let ((kb170559 "0x8790 -> U+2252 -> 0x81e0 Approximately Equal To Or The Image Of
-0x8791 -> U+2261 -> 0x81df Identical To
-0x8792 -> U+222b -> 0x81e7 Integral
-0x8795 -> U+221a -> 0x81e3 Square Root
-0x8796 -> U+22a5 -> 0x81db Up Tack
-0x8797 -> U+2220 -> 0x81da Angle
-0x879a -> U+2235 -> 0x81e6 Because
-0x879b -> U+2229 -> 0x81bf Intersection
-0x879c -> U+222a -> 0x81be Union
-0xed40 -> U+7e8a -> 0xfa5c CJK Unified Ideograph
-0xed41 -> U+891c -> 0xfa5d CJK Unified Ideograph
-0xed42 -> U+9348 -> 0xfa5e CJK Unified Ideograph
-0xed43 -> U+9288 -> 0xfa5f CJK Unified Ideograph
-0xed44 -> U+84dc -> 0xfa60 CJK Unified Ideograph
-0xed45 -> U+4fc9 -> 0xfa61 CJK Unified Ideograph
-0xed46 -> U+70bb -> 0xfa62 CJK Unified Ideograph
-0xed47 -> U+6631 -> 0xfa63 CJK Unified Ideograph
-0xed48 -> U+68c8 -> 0xfa64 CJK Unified Ideograph
-0xed49 -> U+92f9 -> 0xfa65 CJK Unified Ideograph
-0xed4a -> U+66fb -> 0xfa66 CJK Unified Ideograph
-0xed4b -> U+5f45 -> 0xfa67 CJK Unified Ideograph
-0xed4c -> U+4e28 -> 0xfa68 CJK Unified Ideograph
-0xed4d -> U+4ee1 -> 0xfa69 CJK Unified Ideograph
-0xed4e -> U+4efc -> 0xfa6a CJK Unified Ideograph
-0xed4f -> U+4f00 -> 0xfa6b CJK Unified Ideograph
-0xed50 -> U+4f03 -> 0xfa6c CJK Unified Ideograph
-0xed51 -> U+4f39 -> 0xfa6d CJK Unified Ideograph
-0xed52 -> U+4f56 -> 0xfa6e CJK Unified Ideograph
-0xed53 -> U+4f92 -> 0xfa6f CJK Unified Ideograph
-0xed54 -> U+4f8a -> 0xfa70 CJK Unified Ideograph
-0xed55 -> U+4f9a -> 0xfa71 CJK Unified Ideograph
-0xed56 -> U+4f94 -> 0xfa72 CJK Unified Ideograph
-0xed57 -> U+4fcd -> 0xfa73 CJK Unified Ideograph
-0xed58 -> U+5040 -> 0xfa74 CJK Unified Ideograph
-0xed59 -> U+5022 -> 0xfa75 CJK Unified Ideograph
-0xed5a -> U+4fff -> 0xfa76 CJK Unified Ideograph
-0xed5b -> U+501e -> 0xfa77 CJK Unified Ideograph
-0xed5c -> U+5046 -> 0xfa78 CJK Unified Ideograph
-0xed5d -> U+5070 -> 0xfa79 CJK Unified Ideograph
-0xed5e -> U+5042 -> 0xfa7a CJK Unified Ideograph
-0xed5f -> U+5094 -> 0xfa7b CJK Unified Ideograph
-0xed60 -> U+50f4 -> 0xfa7c CJK Unified Ideograph
-0xed61 -> U+50d8 -> 0xfa7d CJK Unified Ideograph
-0xed62 -> U+514a -> 0xfa7e CJK Unified Ideograph
-0xed63 -> U+5164 -> 0xfa80 CJK Unified Ideograph
-0xed64 -> U+519d -> 0xfa81 CJK Unified Ideograph
-0xed65 -> U+51be -> 0xfa82 CJK Unified Ideograph
-0xed66 -> U+51ec -> 0xfa83 CJK Unified Ideograph
-0xed67 -> U+5215 -> 0xfa84 CJK Unified Ideograph
-0xed68 -> U+529c -> 0xfa85 CJK Unified Ideograph
-0xed69 -> U+52a6 -> 0xfa86 CJK Unified Ideograph
-0xed6a -> U+52c0 -> 0xfa87 CJK Unified Ideograph
-0xed6b -> U+52db -> 0xfa88 CJK Unified Ideograph
-0xed6c -> U+5300 -> 0xfa89 CJK Unified Ideograph
-0xed6d -> U+5307 -> 0xfa8a CJK Unified Ideograph
-0xed6e -> U+5324 -> 0xfa8b CJK Unified Ideograph
-0xed6f -> U+5372 -> 0xfa8c CJK Unified Ideograph
-0xed70 -> U+5393 -> 0xfa8d CJK Unified Ideograph
-0xed71 -> U+53b2 -> 0xfa8e CJK Unified Ideograph
-0xed72 -> U+53dd -> 0xfa8f CJK Unified Ideograph
-0xed73 -> U+fa0e -> 0xfa90 CJK compatibility Ideograph
-0xed74 -> U+549c -> 0xfa91 CJK Unified Ideograph
-0xed75 -> U+548a -> 0xfa92 CJK Unified Ideograph
-0xed76 -> U+54a9 -> 0xfa93 CJK Unified Ideograph
-0xed77 -> U+54ff -> 0xfa94 CJK Unified Ideograph
-0xed78 -> U+5586 -> 0xfa95 CJK Unified Ideograph
-0xed79 -> U+5759 -> 0xfa96 CJK Unified Ideograph
-0xed7a -> U+5765 -> 0xfa97 CJK Unified Ideograph
-0xed7b -> U+57ac -> 0xfa98 CJK Unified Ideograph
-0xed7c -> U+57c8 -> 0xfa99 CJK Unified Ideograph
-0xed7d -> U+57c7 -> 0xfa9a CJK Unified Ideograph
-0xed7e -> U+fa0f -> 0xfa9b CJK compatibility Ideograph
-0xed80 -> U+fa10 -> 0xfa9c CJK compatibility Ideograph
-0xed81 -> U+589e -> 0xfa9d CJK Unified Ideograph
-0xed82 -> U+58b2 -> 0xfa9e CJK Unified Ideograph
-0xed83 -> U+590b -> 0xfa9f CJK Unified Ideograph
-0xed84 -> U+5953 -> 0xfaa0 CJK Unified Ideograph
-0xed85 -> U+595b -> 0xfaa1 CJK Unified Ideograph
-0xed86 -> U+595d -> 0xfaa2 CJK Unified Ideograph
-0xed87 -> U+5963 -> 0xfaa3 CJK Unified Ideograph
-0xed88 -> U+59a4 -> 0xfaa4 CJK Unified Ideograph
-0xed89 -> U+59ba -> 0xfaa5 CJK Unified Ideograph
-0xed8a -> U+5b56 -> 0xfaa6 CJK Unified Ideograph
-0xed8b -> U+5bc0 -> 0xfaa7 CJK Unified Ideograph
-0xed8c -> U+752f -> 0xfaa8 CJK Unified Ideograph
-0xed8d -> U+5bd8 -> 0xfaa9 CJK Unified Ideograph
-0xed8e -> U+5bec -> 0xfaaa CJK Unified Ideograph
-0xed8f -> U+5c1e -> 0xfaab CJK Unified Ideograph
-0xed90 -> U+5ca6 -> 0xfaac CJK Unified Ideograph
-0xed91 -> U+5cba -> 0xfaad CJK Unified Ideograph
-0xed92 -> U+5cf5 -> 0xfaae CJK Unified Ideograph
-0xed93 -> U+5d27 -> 0xfaaf CJK Unified Ideograph
-0xed94 -> U+5d53 -> 0xfab0 CJK Unified Ideograph
-0xed95 -> U+fa11 -> 0xfab1 CJK compatibility Ideograph
-0xed96 -> U+5d42 -> 0xfab2 CJK Unified Ideograph
-0xed97 -> U+5d6d -> 0xfab3 CJK Unified Ideograph
-0xed98 -> U+5db8 -> 0xfab4 CJK Unified Ideograph
-0xed99 -> U+5db9 -> 0xfab5 CJK Unified Ideograph
-0xed9a -> U+5dd0 -> 0xfab6 CJK Unified Ideograph
-0xed9b -> U+5f21 -> 0xfab7 CJK Unified Ideograph
-0xed9c -> U+5f34 -> 0xfab8 CJK Unified Ideograph
-0xed9d -> U+5f67 -> 0xfab9 CJK Unified Ideograph
-0xed9e -> U+5fb7 -> 0xfaba CJK Unified Ideograph
-0xed9f -> U+5fde -> 0xfabb CJK Unified Ideograph
-0xeda0 -> U+605d -> 0xfabc CJK Unified Ideograph
-0xeda1 -> U+6085 -> 0xfabd CJK Unified Ideograph
-0xeda2 -> U+608a -> 0xfabe CJK Unified Ideograph
-0xeda3 -> U+60de -> 0xfabf CJK Unified Ideograph
-0xeda4 -> U+60d5 -> 0xfac0 CJK Unified Ideograph
-0xeda5 -> U+6120 -> 0xfac1 CJK Unified Ideograph
-0xeda6 -> U+60f2 -> 0xfac2 CJK Unified Ideograph
-0xeda7 -> U+6111 -> 0xfac3 CJK Unified Ideograph
-0xeda8 -> U+6137 -> 0xfac4 CJK Unified Ideograph
-0xeda9 -> U+6130 -> 0xfac5 CJK Unified Ideograph
-0xedaa -> U+6198 -> 0xfac6 CJK Unified Ideograph
-0xedab -> U+6213 -> 0xfac7 CJK Unified Ideograph
-0xedac -> U+62a6 -> 0xfac8 CJK Unified Ideograph
-0xedad -> U+63f5 -> 0xfac9 CJK Unified Ideograph
-0xedae -> U+6460 -> 0xfaca CJK Unified Ideograph
-0xedaf -> U+649d -> 0xfacb CJK Unified Ideograph
-0xedb0 -> U+64ce -> 0xfacc CJK Unified Ideograph
-0xedb1 -> U+654e -> 0xfacd CJK Unified Ideograph
-0xedb2 -> U+6600 -> 0xface CJK Unified Ideograph
-0xedb3 -> U+6615 -> 0xfacf CJK Unified Ideograph
-0xedb4 -> U+663b -> 0xfad0 CJK Unified Ideograph
-0xedb5 -> U+6609 -> 0xfad1 CJK Unified Ideograph
-0xedb6 -> U+662e -> 0xfad2 CJK Unified Ideograph
-0xedb7 -> U+661e -> 0xfad3 CJK Unified Ideograph
-0xedb8 -> U+6624 -> 0xfad4 CJK Unified Ideograph
-0xedb9 -> U+6665 -> 0xfad5 CJK Unified Ideograph
-0xedba -> U+6657 -> 0xfad6 CJK Unified Ideograph
-0xedbb -> U+6659 -> 0xfad7 CJK Unified Ideograph
-0xedbc -> U+fa12 -> 0xfad8 CJK compatibility Ideograph
-0xedbd -> U+6673 -> 0xfad9 CJK Unified Ideograph
-0xedbe -> U+6699 -> 0xfada CJK Unified Ideograph
-0xedbf -> U+66a0 -> 0xfadb CJK Unified Ideograph
-0xedc0 -> U+66b2 -> 0xfadc CJK Unified Ideograph
-0xedc1 -> U+66bf -> 0xfadd CJK Unified Ideograph
-0xedc2 -> U+66fa -> 0xfade CJK Unified Ideograph
-0xedc3 -> U+670e -> 0xfadf CJK Unified Ideograph
-0xedc4 -> U+f929 -> 0xfae0 CJK compatibility Ideograph
-0xedc5 -> U+6766 -> 0xfae1 CJK Unified Ideograph
-0xedc6 -> U+67bb -> 0xfae2 CJK Unified Ideograph
-0xedc7 -> U+6852 -> 0xfae3 CJK Unified Ideograph
-0xedc8 -> U+67c0 -> 0xfae4 CJK Unified Ideograph
-0xedc9 -> U+6801 -> 0xfae5 CJK Unified Ideograph
-0xedca -> U+6844 -> 0xfae6 CJK Unified Ideograph
-0xedcb -> U+68cf -> 0xfae7 CJK Unified Ideograph
-0xedcc -> U+fa13 -> 0xfae8 CJK compatibility Ideograph
-0xedcd -> U+6968 -> 0xfae9 CJK Unified Ideograph
-0xedce -> U+fa14 -> 0xfaea CJK compatibility Ideograph
-0xedcf -> U+6998 -> 0xfaeb CJK Unified Ideograph
-0xedd0 -> U+69e2 -> 0xfaec CJK Unified Ideograph
-0xedd1 -> U+6a30 -> 0xfaed CJK Unified Ideograph
-0xedd2 -> U+6a6b -> 0xfaee CJK Unified Ideograph
-0xedd3 -> U+6a46 -> 0xfaef CJK Unified Ideograph
-0xedd4 -> U+6a73 -> 0xfaf0 CJK Unified Ideograph
-0xedd5 -> U+6a7e -> 0xfaf1 CJK Unified Ideograph
-0xedd6 -> U+6ae2 -> 0xfaf2 CJK Unified Ideograph
-0xedd7 -> U+6ae4 -> 0xfaf3 CJK Unified Ideograph
-0xedd8 -> U+6bd6 -> 0xfaf4 CJK Unified Ideograph
-0xedd9 -> U+6c3f -> 0xfaf5 CJK Unified Ideograph
-0xedda -> U+6c5c -> 0xfaf6 CJK Unified Ideograph
-0xeddb -> U+6c86 -> 0xfaf7 CJK Unified Ideograph
-0xeddc -> U+6c6f -> 0xfaf8 CJK Unified Ideograph
-0xeddd -> U+6cda -> 0xfaf9 CJK Unified Ideograph
-0xedde -> U+6d04 -> 0xfafa CJK Unified Ideograph
-0xeddf -> U+6d87 -> 0xfafb CJK Unified Ideograph
-0xede0 -> U+6d6f -> 0xfafc CJK Unified Ideograph
-0xede1 -> U+6d96 -> 0xfb40 CJK Unified Ideograph
-0xede2 -> U+6dac -> 0xfb41 CJK Unified Ideograph
-0xede3 -> U+6dcf -> 0xfb42 CJK Unified Ideograph
-0xede4 -> U+6df8 -> 0xfb43 CJK Unified Ideograph
-0xede5 -> U+6df2 -> 0xfb44 CJK Unified Ideograph
-0xede6 -> U+6dfc -> 0xfb45 CJK Unified Ideograph
-0xede7 -> U+6e39 -> 0xfb46 CJK Unified Ideograph
-0xede8 -> U+6e5c -> 0xfb47 CJK Unified Ideograph
-0xede9 -> U+6e27 -> 0xfb48 CJK Unified Ideograph
-0xedea -> U+6e3c -> 0xfb49 CJK Unified Ideograph
-0xedeb -> U+6ebf -> 0xfb4a CJK Unified Ideograph
-0xedec -> U+6f88 -> 0xfb4b CJK Unified Ideograph
-0xeded -> U+6fb5 -> 0xfb4c CJK Unified Ideograph
-0xedee -> U+6ff5 -> 0xfb4d CJK Unified Ideograph
-0xedef -> U+7005 -> 0xfb4e CJK Unified Ideograph
-0xedf0 -> U+7007 -> 0xfb4f CJK Unified Ideograph
-0xedf1 -> U+7028 -> 0xfb50 CJK Unified Ideograph
-0xedf2 -> U+7085 -> 0xfb51 CJK Unified Ideograph
-0xedf3 -> U+70ab -> 0xfb52 CJK Unified Ideograph
-0xedf4 -> U+710f -> 0xfb53 CJK Unified Ideograph
-0xedf5 -> U+7104 -> 0xfb54 CJK Unified Ideograph
-0xedf6 -> U+715c -> 0xfb55 CJK Unified Ideograph
-0xedf7 -> U+7146 -> 0xfb56 CJK Unified Ideograph
-0xedf8 -> U+7147 -> 0xfb57 CJK Unified Ideograph
-0xedf9 -> U+fa15 -> 0xfb58 CJK compatibility Ideograph
-0xedfa -> U+71c1 -> 0xfb59 CJK Unified Ideograph
-0xedfb -> U+71fe -> 0xfb5a CJK Unified Ideograph
-0xedfc -> U+72b1 -> 0xfb5b CJK Unified Ideograph
-0xee40 -> U+72be -> 0xfb5c CJK Unified Ideograph
-0xee41 -> U+7324 -> 0xfb5d CJK Unified Ideograph
-0xee42 -> U+fa16 -> 0xfb5e CJK compatibility Ideograph
-0xee43 -> U+7377 -> 0xfb5f CJK Unified Ideograph
-0xee44 -> U+73bd -> 0xfb60 CJK Unified Ideograph
-0xee45 -> U+73c9 -> 0xfb61 CJK Unified Ideograph
-0xee46 -> U+73d6 -> 0xfb62 CJK Unified Ideograph
-0xee47 -> U+73e3 -> 0xfb63 CJK Unified Ideograph
-0xee48 -> U+73d2 -> 0xfb64 CJK Unified Ideograph
-0xee49 -> U+7407 -> 0xfb65 CJK Unified Ideograph
-0xee4a -> U+73f5 -> 0xfb66 CJK Unified Ideograph
-0xee4b -> U+7426 -> 0xfb67 CJK Unified Ideograph
-0xee4c -> U+742a -> 0xfb68 CJK Unified Ideograph
-0xee4d -> U+7429 -> 0xfb69 CJK Unified Ideograph
-0xee4e -> U+742e -> 0xfb6a CJK Unified Ideograph
-0xee4f -> U+7462 -> 0xfb6b CJK Unified Ideograph
-0xee50 -> U+7489 -> 0xfb6c CJK Unified Ideograph
-0xee51 -> U+749f -> 0xfb6d CJK Unified Ideograph
-0xee52 -> U+7501 -> 0xfb6e CJK Unified Ideograph
-0xee53 -> U+756f -> 0xfb6f CJK Unified Ideograph
-0xee54 -> U+7682 -> 0xfb70 CJK Unified Ideograph
-0xee55 -> U+769c -> 0xfb71 CJK Unified Ideograph
-0xee56 -> U+769e -> 0xfb72 CJK Unified Ideograph
-0xee57 -> U+769b -> 0xfb73 CJK Unified Ideograph
-0xee58 -> U+76a6 -> 0xfb74 CJK Unified Ideograph
-0xee59 -> U+fa17 -> 0xfb75 CJK compatibility Ideograph
-0xee5a -> U+7746 -> 0xfb76 CJK Unified Ideograph
-0xee5b -> U+52af -> 0xfb77 CJK Unified Ideograph
-0xee5c -> U+7821 -> 0xfb78 CJK Unified Ideograph
-0xee5d -> U+784e -> 0xfb79 CJK Unified Ideograph
-0xee5e -> U+7864 -> 0xfb7a CJK Unified Ideograph
-0xee5f -> U+787a -> 0xfb7b CJK Unified Ideograph
-0xee60 -> U+7930 -> 0xfb7c CJK Unified Ideograph
-0xee61 -> U+fa18 -> 0xfb7d CJK compatibility Ideograph
-0xee62 -> U+fa19 -> 0xfb7e CJK compatibility Ideograph
-0xee63 -> U+fa1a -> 0xfb80 CJK compatibility Ideograph
-0xee64 -> U+7994 -> 0xfb81 CJK Unified Ideograph
-0xee65 -> U+fa1b -> 0xfb82 CJK compatibility Ideograph
-0xee66 -> U+799b -> 0xfb83 CJK Unified Ideograph
-0xee67 -> U+7ad1 -> 0xfb84 CJK Unified Ideograph
-0xee68 -> U+7ae7 -> 0xfb85 CJK Unified Ideograph
-0xee69 -> U+fa1c -> 0xfb86 CJK compatibility Ideograph
-0xee6a -> U+7aeb -> 0xfb87 CJK Unified Ideograph
-0xee6b -> U+7b9e -> 0xfb88 CJK Unified Ideograph
-0xee6c -> U+fa1d -> 0xfb89 CJK compatibility Ideograph
-0xee6d -> U+7d48 -> 0xfb8a CJK Unified Ideograph
-0xee6e -> U+7d5c -> 0xfb8b CJK Unified Ideograph
-0xee6f -> U+7db7 -> 0xfb8c CJK Unified Ideograph
-0xee70 -> U+7da0 -> 0xfb8d CJK Unified Ideograph
-0xee71 -> U+7dd6 -> 0xfb8e CJK Unified Ideograph
-0xee72 -> U+7e52 -> 0xfb8f CJK Unified Ideograph
-0xee73 -> U+7f47 -> 0xfb90 CJK Unified Ideograph
-0xee74 -> U+7fa1 -> 0xfb91 CJK Unified Ideograph
-0xee75 -> U+fa1e -> 0xfb92 CJK compatibility Ideograph
-0xee76 -> U+8301 -> 0xfb93 CJK Unified Ideograph
-0xee77 -> U+8362 -> 0xfb94 CJK Unified Ideograph
-0xee78 -> U+837f -> 0xfb95 CJK Unified Ideograph
-0xee79 -> U+83c7 -> 0xfb96 CJK Unified Ideograph
-0xee7a -> U+83f6 -> 0xfb97 CJK Unified Ideograph
-0xee7b -> U+8448 -> 0xfb98 CJK Unified Ideograph
-0xee7c -> U+84b4 -> 0xfb99 CJK Unified Ideograph
-0xee7d -> U+8553 -> 0xfb9a CJK Unified Ideograph
-0xee7e -> U+8559 -> 0xfb9b CJK Unified Ideograph
-0xee80 -> U+856b -> 0xfb9c CJK Unified Ideograph
-0xee81 -> U+fa1f -> 0xfb9d CJK compatibility Ideograph
-0xee82 -> U+85b0 -> 0xfb9e CJK Unified Ideograph
-0xee83 -> U+fa20 -> 0xfb9f CJK compatibility Ideograph
-0xee84 -> U+fa21 -> 0xfba0 CJK compatibility Ideograph
-0xee85 -> U+8807 -> 0xfba1 CJK Unified Ideograph
-0xee86 -> U+88f5 -> 0xfba2 CJK Unified Ideograph
-0xee87 -> U+8a12 -> 0xfba3 CJK Unified Ideograph
-0xee88 -> U+8a37 -> 0xfba4 CJK Unified Ideograph
-0xee89 -> U+8a79 -> 0xfba5 CJK Unified Ideograph
-0xee8a -> U+8aa7 -> 0xfba6 CJK Unified Ideograph
-0xee8b -> U+8abe -> 0xfba7 CJK Unified Ideograph
-0xee8c -> U+8adf -> 0xfba8 CJK Unified Ideograph
-0xee8d -> U+fa22 -> 0xfba9 CJK compatibility Ideograph
-0xee8e -> U+8af6 -> 0xfbaa CJK Unified Ideograph
-0xee8f -> U+8b53 -> 0xfbab CJK Unified Ideograph
-0xee90 -> U+8b7f -> 0xfbac CJK Unified Ideograph
-0xee91 -> U+8cf0 -> 0xfbad CJK Unified Ideograph
-0xee92 -> U+8cf4 -> 0xfbae CJK Unified Ideograph
-0xee93 -> U+8d12 -> 0xfbaf CJK Unified Ideograph
-0xee94 -> U+8d76 -> 0xfbb0 CJK Unified Ideograph
-0xee95 -> U+fa23 -> 0xfbb1 CJK compatibility Ideograph
-0xee96 -> U+8ecf -> 0xfbb2 CJK Unified Ideograph
-0xee97 -> U+fa24 -> 0xfbb3 CJK compatibility Ideograph
-0xee98 -> U+fa25 -> 0xfbb4 CJK compatibility Ideograph
-0xee99 -> U+9067 -> 0xfbb5 CJK Unified Ideograph
-0xee9a -> U+90de -> 0xfbb6 CJK Unified Ideograph
-0xee9b -> U+fa26 -> 0xfbb7 CJK compatibility Ideograph
-0xee9c -> U+9115 -> 0xfbb8 CJK Unified Ideograph
-0xee9d -> U+9127 -> 0xfbb9 CJK Unified Ideograph
-0xee9e -> U+91da -> 0xfbba CJK Unified Ideograph
-0xee9f -> U+91d7 -> 0xfbbb CJK Unified Ideograph
-0xeea0 -> U+91de -> 0xfbbc CJK Unified Ideograph
-0xeea1 -> U+91ed -> 0xfbbd CJK Unified Ideograph
-0xeea2 -> U+91ee -> 0xfbbe CJK Unified Ideograph
-0xeea3 -> U+91e4 -> 0xfbbf CJK Unified Ideograph
-0xeea4 -> U+91e5 -> 0xfbc0 CJK Unified Ideograph
-0xeea5 -> U+9206 -> 0xfbc1 CJK Unified Ideograph
-0xeea6 -> U+9210 -> 0xfbc2 CJK Unified Ideograph
-0xeea7 -> U+920a -> 0xfbc3 CJK Unified Ideograph
-0xeea8 -> U+923a -> 0xfbc4 CJK Unified Ideograph
-0xeea9 -> U+9240 -> 0xfbc5 CJK Unified Ideograph
-0xeeaa -> U+923c -> 0xfbc6 CJK Unified Ideograph
-0xeeab -> U+924e -> 0xfbc7 CJK Unified Ideograph
-0xeeac -> U+9259 -> 0xfbc8 CJK Unified Ideograph
-0xeead -> U+9251 -> 0xfbc9 CJK Unified Ideograph
-0xeeae -> U+9239 -> 0xfbca CJK Unified Ideograph
-0xeeaf -> U+9267 -> 0xfbcb CJK Unified Ideograph
-0xeeb0 -> U+92a7 -> 0xfbcc CJK Unified Ideograph
-0xeeb1 -> U+9277 -> 0xfbcd CJK Unified Ideograph
-0xeeb2 -> U+9278 -> 0xfbce CJK Unified Ideograph
-0xeeb3 -> U+92e7 -> 0xfbcf CJK Unified Ideograph
-0xeeb4 -> U+92d7 -> 0xfbd0 CJK Unified Ideograph
-0xeeb5 -> U+92d9 -> 0xfbd1 CJK Unified Ideograph
-0xeeb6 -> U+92d0 -> 0xfbd2 CJK Unified Ideograph
-0xeeb7 -> U+fa27 -> 0xfbd3 CJK compatibility Ideograph
-0xeeb8 -> U+92d5 -> 0xfbd4 CJK Unified Ideograph
-0xeeb9 -> U+92e0 -> 0xfbd5 CJK Unified Ideograph
-0xeeba -> U+92d3 -> 0xfbd6 CJK Unified Ideograph
-0xeebb -> U+9325 -> 0xfbd7 CJK Unified Ideograph
-0xeebc -> U+9321 -> 0xfbd8 CJK Unified Ideograph
-0xeebd -> U+92fb -> 0xfbd9 CJK Unified Ideograph
-0xeebe -> U+fa28 -> 0xfbda CJK compatibility Ideograph
-0xeebf -> U+931e -> 0xfbdb CJK Unified Ideograph
-0xeec0 -> U+92ff -> 0xfbdc CJK Unified Ideograph
-0xeec1 -> U+931d -> 0xfbdd CJK Unified Ideograph
-0xeec2 -> U+9302 -> 0xfbde CJK Unified Ideograph
-0xeec3 -> U+9370 -> 0xfbdf CJK Unified Ideograph
-0xeec4 -> U+9357 -> 0xfbe0 CJK Unified Ideograph
-0xeec5 -> U+93a4 -> 0xfbe1 CJK Unified Ideograph
-0xeec6 -> U+93c6 -> 0xfbe2 CJK Unified Ideograph
-0xeec7 -> U+93de -> 0xfbe3 CJK Unified Ideograph
-0xeec8 -> U+93f8 -> 0xfbe4 CJK Unified Ideograph
-0xeec9 -> U+9431 -> 0xfbe5 CJK Unified Ideograph
-0xeeca -> U+9445 -> 0xfbe6 CJK Unified Ideograph
-0xeecb -> U+9448 -> 0xfbe7 CJK Unified Ideograph
-0xeecc -> U+9592 -> 0xfbe8 CJK Unified Ideograph
-0xeecd -> U+f9dc -> 0xfbe9 CJK compatibility Ideograph
-0xeece -> U+fa29 -> 0xfbea CJK compatibility Ideograph
-0xeecf -> U+969d -> 0xfbeb CJK Unified Ideograph
-0xeed0 -> U+96af -> 0xfbec CJK Unified Ideograph
-0xeed1 -> U+9733 -> 0xfbed CJK Unified Ideograph
-0xeed2 -> U+973b -> 0xfbee CJK Unified Ideograph
-0xeed3 -> U+9743 -> 0xfbef CJK Unified Ideograph
-0xeed4 -> U+974d -> 0xfbf0 CJK Unified Ideograph
-0xeed5 -> U+974f -> 0xfbf1 CJK Unified Ideograph
-0xeed6 -> U+9751 -> 0xfbf2 CJK Unified Ideograph
-0xeed7 -> U+9755 -> 0xfbf3 CJK Unified Ideograph
-0xeed8 -> U+9857 -> 0xfbf4 CJK Unified Ideograph
-0xeed9 -> U+9865 -> 0xfbf5 CJK Unified Ideograph
-0xeeda -> U+fa2a -> 0xfbf6 CJK compatibility Ideograph
-0xeedb -> U+fa2b -> 0xfbf7 CJK compatibility Ideograph
-0xeedc -> U+9927 -> 0xfbf8 CJK Unified Ideograph
-0xeedd -> U+fa2c -> 0xfbf9 CJK compatibility Ideograph
-0xeede -> U+999e -> 0xfbfa CJK Unified Ideograph
-0xeedf -> U+9a4e -> 0xfbfb CJK Unified Ideograph
-0xeee0 -> U+9ad9 -> 0xfbfc CJK Unified Ideograph
-0xeee1 -> U+9adc -> 0xfc40 CJK Unified Ideograph
-0xeee2 -> U+9b75 -> 0xfc41 CJK Unified Ideograph
-0xeee3 -> U+9b72 -> 0xfc42 CJK Unified Ideograph
-0xeee4 -> U+9b8f -> 0xfc43 CJK Unified Ideograph
-0xeee5 -> U+9bb1 -> 0xfc44 CJK Unified Ideograph
-0xeee6 -> U+9bbb -> 0xfc45 CJK Unified Ideograph
-0xeee7 -> U+9c00 -> 0xfc46 CJK Unified Ideograph
-0xeee8 -> U+9d70 -> 0xfc47 CJK Unified Ideograph
-0xeee9 -> U+9d6b -> 0xfc48 CJK Unified Ideograph
-0xeeea -> U+fa2d -> 0xfc49 CJK compatibility Ideograph
-0xeeeb -> U+9e19 -> 0xfc4a CJK Unified Ideograph
-0xeeec -> U+9ed1 -> 0xfc4b CJK Unified Ideograph
-0xeeef -> U+2170 -> 0xfa40 Small Roman Numeral One
-0xeef0 -> U+2171 -> 0xfa41 Small Roman Numeral Two
-0xeef1 -> U+2172 -> 0xfa42 Small Roman Numeral Three
-0xeef2 -> U+2173 -> 0xfa43 Small Roman Numeral Four
-0xeef3 -> U+2174 -> 0xfa44 Small Roman Numeral Five
-0xeef4 -> U+2175 -> 0xfa45 Small Roman Numeral Six
-0xeef5 -> U+2176 -> 0xfa46 Small Roman Numeral Seven
-0xeef6 -> U+2177 -> 0xfa47 Small Roman Numeral Eight
-0xeef7 -> U+2178 -> 0xfa48 Small Roman Numeral Nine
-0xeef8 -> U+2179 -> 0xfa49 Small Roman Numeral Ten
-0xeef9 -> U+ffe2 -> 0x81ca Fullwidth Not Sign
-0xeefa -> U+ffe4 -> 0xfa55 Fullwidth Broken Bar
-0xeefb -> U+ff07 -> 0xfa56 Fullwidth Apostrophe
-0xeefc -> U+ff02 -> 0xfa57 Fullwidth Quotation Mark
-0xfa4a -> U+2160 -> 0x8754 Roman Numeral One
-0xfa4b -> U+2161 -> 0x8755 Roman Numeral Two
-0xfa4c -> U+2162 -> 0x8756 Roman Numeral Three
-0xfa4d -> U+2163 -> 0x8757 Roman Numeral Four
-0xfa4e -> U+2164 -> 0x8758 Roman Numeral Five
-0xfa4f -> U+2165 -> 0x8759 Roman Numeral Six
-0xfa50 -> U+2166 -> 0x875a Roman Numeral Seven
-0xfa51 -> U+2167 -> 0x875b Roman Numeral Eight
-0xfa52 -> U+2168 -> 0x875c Roman Numeral Nine
-0xfa53 -> U+2169 -> 0x875d Roman Numeral Ten
-0xfa54 -> U+ffe2 -> 0x81ca Fullwidth Not Sign
-0xfa58 -> U+3231 -> 0x878a Parenthesized Ideograph Stock
-0xfa59 -> U+2116 -> 0x8782 Numero Sign
-0xfa5a -> U+2121 -> 0x8784 Telephone Sign
-0xfa5b -> U+2235 -> 0x81e6 Because"))
- (with-input-from-string (s kb170559)
- (loop for line = (read-line s nil) until (null line)
- do (let ((ucs (parse-integer (subseq line 14 18) :radix 16))
- (cp932 (parse-integer (subseq line 26 30) :radix 16)))
- (setf (gethash ucs *ucs-to-cp932-hash*) cp932)))))
-
-(defun eucjp-to-ucs (code)
- (values (gethash code *eucjp-to-ucs-hash*)))
-
-(defun ucs-to-eucjp (code)
- (values (gethash code *ucs-to-eucjp-hash*)))
-
-(defun cp932-to-ucs (code)
- (values (gethash code *cp932-to-ucs-hash*)))
-
-(defun ucs-to-cp932 (code)
- (values (gethash code *ucs-to-cp932-hash*)))
-
-;;;; EUC-JP
-
-(define-character-encoding :eucjp
- "An 8-bit, variable-length character encoding in which
-character code points in the range #x00-#x7f can be encoded in a
-single octet; characters with larger code values can be encoded
-in 2 to 3 bytes."
- :max-units-per-char 3
- :literal-char-code-limit #x80)
-
-
-(define-octet-counter :eucjp (getter type)
- `(named-lambda eucjp-octet-counter (seq start end max)
- (declare (type ,type seq) (fixnum start end max))
- (loop with noctets fixnum = 0
- for i fixnum from start below end
- for code of-type code-point = (,getter seq i)
- do (let* ((c (ucs-to-eucjp code))
- (new (+ (cond ((< #xffff c) 3)
- ((< #xff c) 2)
- (t 1))
- noctets)))
- (if (and (plusp max) (> new max))
- (loop-finish)
- (setq noctets new)))
- finally (return (values noctets i)))))
-
-(define-code-point-counter :eucjp (getter type)
- `(named-lambda eucjp-code-point-counter (seq start end max)
- (declare (type ,type seq) (fixnum start end max))
- (loop with nchars fixnum = 0
- with i fixnum = start
- while (< i end) do
- (let* ((octet (,getter seq i))
- (next-i (+ i (cond ((= #x8f octet) 3)
- ((or (< #xa0 octet #xff)
- (= #x8e octet)) 2)
- (t 1)))))
- (declare (type ub8 octet) (fixnum next-i))
- (cond ((> next-i end)
- ;; Should we add restarts to this error, we'll have
- ;; to figure out a way to communicate with the
- ;; decoder since we probably want to do something
- ;; about it right here when we have a chance to
- ;; change the count or something. (Like an
- ;; alternative replacement character or perhaps the
- ;; existence of this error so that the decoder
- ;; doesn't have to check for it on every iteration
- ;; like we do.)
- ;;
- ;; FIXME: The data for this error is not right.
- (decoding-error (vector octet) :eucjp seq i
- nil 'end-of-input-in-character)
- (return (values (1+ nchars) end)))
- (t
- (setq nchars (1+ nchars)
- i next-i)
- (when (and (plusp max) (= nchars max))
- (return (values nchars i))))))
- finally (progn (assert (= i end))
- (return (values nchars i))))))
-
-(define-encoder :eucjp (getter src-type setter dest-type)
- `(named-lambda eucjp-encoder (src start end dest d-start)
- (declare (type ,src-type src)
- (type ,dest-type dest)
- (fixnum start end d-start))
- (loop with di fixnum = d-start
- for i fixnum from start below end
- for code of-type code-point = (,getter src i)
- for eucjp of-type code-point
- = (ucs-to-eucjp code) do
- (macrolet ((set-octet (offset value)
- `(,',setter ,value dest (the fixnum (+ di ,offset)))))
- (cond
- ;; 1 octet
- ((< eucjp #x100)
- (set-octet 0 eucjp)
- (incf di))
- ;; 2 octets
- ((< eucjp #x10000)
- (set-octet 0 (f-logand #xff (f-ash eucjp -8)))
- (set-octet 1 (logand eucjp #xff))
- (incf di 2))
- ;; 3 octets
- (t
- (set-octet 0 (f-logand #xff (f-ash eucjp -16)))
- (set-octet 1 (f-logand #xff (f-ash eucjp -8)))
- (set-octet 2 (logand eucjp #xff))
- (incf di 3))
- ))
- finally (return (the fixnum (- di d-start))))))
-
-
-(define-decoder :eucjp (getter src-type setter dest-type)
- `(named-lambda eucjp-decoder (src start end dest d-start)
- (declare (type ,src-type src)
- (type ,dest-type dest)
- (fixnum start end d-start))
- (let ((u2 0))
- (declare (type ub8 u2))
- (loop for di fixnum from d-start
- for i fixnum from start below end
- for u1 of-type ub8 = (,getter src i) do
- ;; Note: CONSUME-OCTET doesn't check if I is being
- ;; incremented past END. We're assuming that END has
- ;; been calculated with the CODE-POINT-POINTER above that
- ;; checks this.
- (macrolet
- ((consume-octet ()
- `(let ((next-i (incf i)))
- (if (= next-i end)
- ;; FIXME: data for this error is incomplete.
- ;; and signalling this error twice
- (return-from setter-block
- (decoding-error nil :eucjp src i +repl+
- 'end-of-input-in-character))
- (,',getter src next-i))))
- (handle-error (n &optional (c 'character-decoding-error))
- `(decoding-error
- (vector ,@(subseq '(u1 u2) 0 n))
- :eucjp src (1+ (- i ,n)) +repl+ ',c))
- (handle-error-if-icb (var n)
- `(when (not (< #x7f ,var #xc0))
- (decf i)
- (return-from setter-block
- (handle-error ,n invalid-utf8-continuation-byte)))))
- (,setter
- (block setter-block
- (cond
- ;; 3 octets
- ((= u1 #x8f)
- (setq u2 (consume-octet))
- (eucjp-to-ucs (logior #x8f0000
- (f-ash u2 8)
- (consume-octet))))
- ;; 2 octets
- ((or (= u1 #x8e)
- (< #xa0 u1 #xff))
- (eucjp-to-ucs (logior (f-ash u1 8)
- (consume-octet))))
- ;; 1 octet
- (t
- (eucjp-to-ucs u1))))
- dest di))
- finally (return (the fixnum (- di d-start)))))))
-
-;;;; CP932
-
-(define-character-encoding :cp932
- "An 8-bit, variable-length character encoding in which
-character code points in the range #x00-#x7f can be encoded in a
-single octet; characters with larger code values can be encoded
-in 2 bytes."
- :max-units-per-char 2
- :literal-char-code-limit #x80)
-
-
-(define-octet-counter :cp932 (getter type)
- `(named-lambda cp932-octet-counter (seq start end max)
- (declare (type ,type seq) (fixnum start end max))
- (loop with noctets fixnum = 0
- for i fixnum from start below end
- for code of-type code-point = (,getter seq i)
- do (let* ((c (ucs-to-cp932 code))
- (new (+ (cond ((< #xff c) 2)
- (t 1))
- noctets)))
- (if (and (plusp max) (> new max))
- (loop-finish)
- (setq noctets new)))
- finally (return (values noctets i)))))
-
-(define-code-point-counter :cp932 (getter type)
- `(named-lambda cp932-code-point-counter (seq start end max)
- (declare (type ,type seq) (fixnum start end max))
- (loop with nchars fixnum = 0
- with i fixnum = start
- while (< i end) do
- (let* ((octet (,getter seq i))
- (next-i (+ i (cond ((or (<= #x81 octet #x9f)
- (<= #xe0 octet #xfc))
- 2)
- (t 1)))))
- (declare (type ub8 octet) (fixnum next-i))
- (cond ((> next-i end)
- ;; Should we add restarts to this error, we'll have
- ;; to figure out a way to communicate with the
- ;; decoder since we probably want to do something
- ;; about it right here when we have a chance to
- ;; change the count or something. (Like an
- ;; alternative replacement character or perhaps the
- ;; existence of this error so that the decoder
- ;; doesn't have to check for it on every iteration
- ;; like we do.)
- ;;
- ;; FIXME: The data for this error is not right.
- (decoding-error (vector octet) :cp932 seq i
- nil 'end-of-input-in-character)
- (return (values (1+ nchars) end)))
- (t
- (setq nchars (1+ nchars)
- i next-i)
- (when (and (plusp max) (= nchars max))
- (return (values nchars i))))))
- finally (progn (assert (= i end))
- (return (values nchars i))))))
-
-(define-encoder :cp932 (getter src-type setter dest-type)
- `(named-lambda cp932-encoder (src start end dest d-start)
- (declare (type ,src-type src)
- (type ,dest-type dest)
- (fixnum start end d-start))
- (loop with di fixnum = d-start
- for i fixnum from start below end
- for code of-type code-point = (,getter src i)
- for cp932 of-type code-point
- = (ucs-to-cp932 code) do
- (macrolet ((set-octet (offset value)
- `(,',setter ,value dest (the fixnum (+ di ,offset)))))
- (cond
- ;; 1 octet
- ((< cp932 #x100)
- (set-octet 0 cp932)
- (incf di))
- ;; 2 octets
- ((< cp932 #x10000)
- (set-octet 0 (f-logand #xff (f-ash cp932 -8)))
- (set-octet 1 (logand cp932 #xff))
- (incf di 2))
- ;; 3 octets
- (t
- (set-octet 0 (f-logand #xff (f-ash cp932 -16)))
- (set-octet 1 (f-logand #xff (f-ash cp932 -8)))
- (set-octet 2 (logand cp932 #xff))
- (incf di 3))
- ))
- finally (return (the fixnum (- di d-start))))))
-
-
-(define-decoder :cp932 (getter src-type setter dest-type)
- `(named-lambda cp932-decoder (src start end dest d-start)
- (declare (type ,src-type src)
- (type ,dest-type dest)
- (fixnum start end d-start))
- (let ((u2 0))
- (declare (type ub8 u2))
- (loop for di fixnum from d-start
- for i fixnum from start below end
- for u1 of-type ub8 = (,getter src i) do
- ;; Note: CONSUME-OCTET doesn't check if I is being
- ;; incremented past END. We're assuming that END has
- ;; been calculated with the CODE-POINT-POINTER above that
- ;; checks this.
- (macrolet
- ((consume-octet ()
- `(let ((next-i (incf i)))
- (if (= next-i end)
- ;; FIXME: data for this error is incomplete.
- ;; and signalling this error twice
- (return-from setter-block
- (decoding-error nil :cp932 src i +repl+
- 'end-of-input-in-character))
- (,',getter src next-i))))
- (handle-error (n &optional (c 'character-decoding-error))
- `(decoding-error
- (vector ,@(subseq '(u1 u2) 0 n))
- :cp932 src (1+ (- i ,n)) +repl+ ',c))
- (handle-error-if-icb (var n)
- `(when (not (< #x7f ,var #xc0))
- (decf i)
- (return-from setter-block
- (handle-error ,n invalid-utf8-continuation-byte)))))
- (,setter
- (block setter-block
- (cond
- ;; 2 octets
- ((or (<= #x81 u1 #x9f)
- (<= #xe0 u1 #xfc))
- (setq u2 (consume-octet))
- (cp932-to-ucs (logior (f-ash u1 8)
- u2)))
- ;; 1 octet
- (t
- (cp932-to-ucs u1))))
- dest di))
- finally (return (the fixnum (- di d-start)))))))
(DIR) diff --git a/3rdparties/software/babel-20171227-git/src/enc-koi8.lisp b/3rdparties/software/babel-20171227-git/src/enc-koi8.lisp
@@ -1,577 +0,0 @@
-;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
-;;;
-;;; enc-cp1251.lisp --- Implementation of the CP1251 character encoding.
-;;;
-;;; Copyright (C) 2009, Andrey Moskvitin
-;;;
-;;; Permission is hereby granted, free of charge, to any person
-;;; obtaining a copy of this software and associated documentation
-;;; files (the "Software"), to deal in the Software without
-;;; restriction, including without limitation the rights to use, copy,
-;;; modify, merge, publish, distribute, sublicense, and/or sell copies
-;;; of the Software, and to permit persons to whom the Software is
-;;; furnished to do so, subject to the following conditions:
-;;;
-;;; The above copyright notice and this permission notice shall be
-;;; included in all copies or substantial portions of the Software.
-;;;
-;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
-;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
-;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
-;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
-;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
-;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
-;;; DEALINGS IN THE SOFTWARE.
-
-(in-package #:babel-encodings)
-
-(define-character-encoding :koi8-ru
- "An 8-bit, fixed-width character Russian encoding."
- :literal-char-code-limit #x80)
-
-(define-constant +koi8-ru-to-unicode+
- #(#x2500 #x2502 #x250C #x2510 #x2514 #x2518 #x251C #x2524
- #x252C #x2534 #x253C #x2580 #x2584 #x2588 #x258C #x2590
- #x2591 #x2592 #x2593 #x2320 #x25A0 #x2219 #x221A #x2248
- #x2264 #x2265 #x00A0 #x2321 #x00B0 #x00B2 #x00B7 #x00F7
- #x2550 #x2551 #x2552 #x0451 #x0454 #x2554 #x0456 #x0457
- #x2557 #x2558 #x2559 #x255A #x255B #x0491 #x045E #x255E
- #x255F #x2560 #x2561 #x0401 #x0404 #x2563 #x0406 #x0407
- #x2566 #x2567 #x2568 #x2569 #x256A #x0490 #x040E #x00A9
- #x044E #x0430 #x0431 #x0446 #x0434 #x0435 #x0444 #x0433
- #x0445 #x0438 #x0439 #x043A #x043B #x043C #x043D #x043E
- #x043F #x044F #x0440 #x0441 #x0442 #x0443 #x0436 #x0432
- #x044C #x044B #x0437 #x0448 #x044D #x0449 #x0447 #x044A
- #x042E #x0410 #x0411 #x0426 #x0414 #x0415 #x0424 #x0413
- #x0425 #x0418 #x0419 #x041A #x041B #x041C #x041D #x041E
- #x041F #x042F #x0420 #x0421 #x0422 #x0423 #x0416 #x0412
- #x042C #x042B #x0417 #x0428 #x042D #x0429 #x0427 #x042A)
- :test #'equalp)
-
-(define-unibyte-decoder :koi8-ru (octet)
- (if (< octet #x80)
- octet
- (svref +koi8-ru-to-unicode+ (the ub8 (- octet #x80)))))
-
-(define-constant +unicode-04->koi8-ru+
- #(#x7f #x79 #x78 #x7c #x60 #x71 #x41 #x42 #x57 #x47 #x44 #x45 #x56 #x5a
- #x49 #x4a #x4b #x4c #x4d #x4e #x4f #x50 #x52 #x53 #x54 #x55 #x46 #x48
- #x43 #x5e #x5b #x5d #x5f #x59 #x58 #x5c #x40 #x51 nil #x23 nil nil #x24
- nil #x26 #x27 nil nil nil nil nil nil #x2e nil nil nil nil nil nil nil
- nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
- nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
- nil nil nil nil nil nil #x3d #x2d)
- :test 'equalp)
-
-(define-unibyte-encoder :koi8-ru (code)
- (or (and (< code #x80) code)
- (let ((hi (ldb (byte 8 8) code))
- (lo (ldb (byte 8 0) code)))
- (case hi
- (#x4
- (case lo
- (#x1 #xb3)
- (#x4 #xb4)
- (#x6 #xb6)
- (#x7 #xb7)
- (#xe #xbe)
- (#x10 #xe1)
- (#x11 #xe2)
- (#x12 #xf7)
- (#x13 #xe7)
- (#x14 #xe4)
- (#x15 #xe5)
- (#x16 #xf6)
- (#x17 #xfa)
- (#x18 #xe9)
- (#x19 #xea)
- (#x1a #xeb)
- (#x1b #xec)
- (#x1c #xed)
- (#x1d #xee)
- (#x1e #xef)
- (#x1f #xf0)
- (#x20 #xf2)
- (#x21 #xf3)
- (#x22 #xf4)
- (#x23 #xf5)
- (#x24 #xe6)
- (#x25 #xe8)
- (#x26 #xe3)
- (#x27 #xfe)
- (#x28 #xfb)
- (#x29 #xfd)
- (#x2a #xff)
- (#x2b #xf9)
- (#x2c #xf8)
- (#x2d #xfc)
- (#x2e #xe0)
- (#x2f #xf1)
- (#x30 #xc1)
- (#x31 #xc2)
- (#x32 #xd7)
- (#x33 #xc7)
- (#x34 #xc4)
- (#x35 #xc5)
- (#x36 #xd6)
- (#x37 #xda)
- (#x38 #xc9)
- (#x39 #xca)
- (#x3a #xcb)
- (#x3b #xcc)
- (#x3c #xcd)
- (#x3d #xce)
- (#x3e #xcf)
- (#x3f #xd0)
- (#x40 #xd2)
- (#x41 #xd3)
- (#x42 #xd4)
- (#x43 #xd5)
- (#x44 #xc6)
- (#x45 #xc8)
- (#x46 #xc3)
- (#x47 #xde)
- (#x48 #xdb)
- (#x49 #xdd)
- (#x4a #xdf)
- (#x4b #xd9)
- (#x4c #xd8)
- (#x4d #xdc)
- (#x4e #xc0)
- (#x4f #xd1)
- (#x51 #xa3)
- (#x54 #xa4)
- (#x56 #xa6)
- (#x57 #xa7)
- (#x5e #xae)
- (#x90 #xbd)
- (#x91 #xad)))
- (#x0
- (case lo
- (#xa0 #x9a)
- (#xa9 #xbf)
- (#xb0 #x9c)
- (#xb2 #x9d)
- (#xb7 #x9e)
- (#xf7 #x9f)))
- (#x22 (case lo (#x19 #x95) (#x1a #x96) (#x48 #x97) (#x64 #x98) (#x65 #x99)))
- (#x23 (case lo (#x20 #x93) (#x21 #x9b)))
- (#x25
- (case lo
- (#x0 #x80)
- (#x2 #x81)
- (#xc #x82)
- (#x10 #x83)
- (#x14 #x84)
- (#x18 #x85)
- (#x1c #x86)
- (#x24 #x87)
- (#x2c #x88)
- (#x34 #x89)
- (#x3c #x8a)
- (#x50 #xa0)
- (#x51 #xa1)
- (#x52 #xa2)
- (#x54 #xa5)
- (#x57 #xa8)
- (#x58 #xa9)
- (#x59 #xaa)
- (#x5a #xab)
- (#x5b #xac)
- (#x5e #xaf)
- (#x5f #xb0)
- (#x60 #xb1)
- (#x61 #xb2)
- (#x63 #xb5)
- (#x66 #xb8)
- (#x67 #xb9)
- (#x68 #xba)
- (#x69 #xbb)
- (#x6a #xbc)
- (#x80 #x8b)
- (#x84 #x8c)
- (#x88 #x8d)
- (#x8c #x8e)
- (#x90 #x8f)
- (#x91 #x90)
- (#x92 #x91)
- (#x93 #x92)
- (#xa0 #x94)))))
- (handle-error)))
-
-(define-character-encoding :koi8-r
- "An 8-bit, fixed-width character Russian encoding."
- :literal-char-code-limit #x80)
-
-(define-constant +koi8-r-to-unicode+
- #(#x2500 #x2502 #x250C #x2510 #x2514 #x2518 #x251C #x2524
- #x252C #x2534 #x253C #x2580 #x2584 #x2588 #x258C #x2590
- #x2591 #x2592 #x2593 #x2320 #x25A0 #x2219 #x221A #x2248
- #x2264 #x2265 #x00A0 #x2321 #x00B0 #x00B2 #x00B7 #x00F7
- #x2550 #x2551 #x2552 #x0451 #x2553 #x2554 #x2555 #x2556
- #x2557 #x2558 #x2559 #x255A #x255B #x255C #x255D #x255E
- #x255F #x2560 #x2561 #x0401 #x2562 #x2563 #x2564 #x2565
- #x2566 #x2567 #x2568 #x2569 #x256A #x256B #x256C #x00A9
- #x044E #x0430 #x0431 #x0446 #x0434 #x0435 #x0444 #x0433
- #x0445 #x0438 #x0439 #x043A #x043B #x043C #x043D #x043E
- #x043F #x044F #x0440 #x0441 #x0442 #x0443 #x0436 #x0432
- #x044C #x044B #x0437 #x0448 #x044D #x0449 #x0447 #x044A
- #x042E #x0410 #x0411 #x0426 #x0414 #x0415 #x0424 #x0413
- #x0425 #x0418 #x0419 #x041A #x041B #x041C #x041D #x041E
- #x041F #x042F #x0420 #x0421 #x0422 #x0423 #x0416 #x0412
- #x042C #x042B #x0417 #x0428 #x042D #x0429 #x0427 #x042A)
- :test #'equalp)
-
-(define-unibyte-decoder :koi8-r (octet)
- (if (< octet #x80)
- octet
- (svref +koi8-r-to-unicode+ (the ub8 (- octet #x80)))))
-
-(define-constant +unicode-x04->koi8-r+
- #(nil #x33 nil nil nil nil nil nil nil nil nil nil nil nil nil nil #x61
- #x62 #x77 #x67 #x64 #x65 #x76 #x7a #x69 #x6a #x6b #x6c #x6d #x6e #x6f
- #x70 #x72 #x73 #x74 #x75 #x66 #x68 #x63 #x7e #x7b #x7d #x7f #x79 #x78
- #x7c #x60 #x71 #x41 #x42 #x57 #x47 #x44 #x45 #x56 #x5a #x49 #x4a #x4b
- #x4c #x4d #x4e #x4f #x50 #x52 #x53 #x54 #x55 #x46 #x48 #x43 #x5e #x5b
- #x5d #x5f #x59 #x58 #x5c #x40 #x51 nil #x23)
- :test 'equalp)
-
-(define-constant +unicode-x25->koi8-r+
- #(#x0 nil #x1 nil nil nil nil nil nil nil nil nil #x2 nil nil nil #x3 nil
- nil nil #x4 nil nil nil #x5 nil nil nil #x6 nil nil nil nil nil nil nil
- #x7 nil nil nil nil nil nil nil #x8 nil nil nil nil nil nil nil #x9 nil
- nil nil nil nil nil nil #xa nil nil nil nil nil nil nil nil nil nil nil
- nil nil nil nil nil nil nil nil #x20 #x21 #x22 #x24 #x25 #x26 #x27 #x28
- #x29 #x2a #x2b #x2c #x2d #x2e #x2f #x30 #x31 #x32 #x34 #x35 #x36 #x37
- #x38 #x39 #x3a #x3b #x3c #x3d #x3e nil nil nil nil nil nil nil nil nil
- nil nil nil nil nil nil nil nil nil nil #xb nil nil nil #xc nil nil nil
- #xd nil nil nil #xe nil nil nil #xf #x10 #x11 #x12 nil nil nil nil nil
- nil nil nil nil nil nil nil #x14)
- :test 'equalp)
-
-(define-unibyte-encoder :koi8-r (code)
- (or (and (< code #x80) code)
- (let ((hi (ldb (byte 8 8) code))
- (lo (ldb (byte 8 0) code)))
- (case hi
- (#x4
- (case lo
- (#x1 #xb3)
- (#x10 #xe1)
- (#x11 #xe2)
- (#x12 #xf7)
- (#x13 #xe7)
- (#x14 #xe4)
- (#x15 #xe5)
- (#x16 #xf6)
- (#x17 #xfa)
- (#x18 #xe9)
- (#x19 #xea)
- (#x1a #xeb)
- (#x1b #xec)
- (#x1c #xed)
- (#x1d #xee)
- (#x1e #xef)
- (#x1f #xf0)
- (#x20 #xf2)
- (#x21 #xf3)
- (#x22 #xf4)
- (#x23 #xf5)
- (#x24 #xe6)
- (#x25 #xe8)
- (#x26 #xe3)
- (#x27 #xfe)
- (#x28 #xfb)
- (#x29 #xfd)
- (#x2a #xff)
- (#x2b #xf9)
- (#x2c #xf8)
- (#x2d #xfc)
- (#x2e #xe0)
- (#x2f #xf1)
- (#x30 #xc1)
- (#x31 #xc2)
- (#x32 #xd7)
- (#x33 #xc7)
- (#x34 #xc4)
- (#x35 #xc5)
- (#x36 #xd6)
- (#x37 #xda)
- (#x38 #xc9)
- (#x39 #xca)
- (#x3a #xcb)
- (#x3b #xcc)
- (#x3c #xcd)
- (#x3d #xce)
- (#x3e #xcf)
- (#x3f #xd0)
- (#x40 #xd2)
- (#x41 #xd3)
- (#x42 #xd4)
- (#x43 #xd5)
- (#x44 #xc6)
- (#x45 #xc8)
- (#x46 #xc3)
- (#x47 #xde)
- (#x48 #xdb)
- (#x49 #xdd)
- (#x4a #xdf)
- (#x4b #xd9)
- (#x4c #xd8)
- (#x4d #xdc)
- (#x4e #xc0)
- (#x4f #xd1)
- (#x51 #xa3)))
- (#x0
- (case lo
- (#xa0 #x9a)
- (#xa9 #xbf)
- (#xb0 #x9c)
- (#xb2 #x9d)
- (#xb7 #x9e)
- (#xf7 #x9f)))
- (#x22 (case lo (#x19 #x95) (#x1a #x96) (#x48 #x97) (#x64 #x98) (#x65 #x99)))
- (#x23 (case lo (#x20 #x93) (#x21 #x9b)))
- (#x25
- (case lo
- (#x0 #x80)
- (#x2 #x81)
- (#xc #x82)
- (#x10 #x83)
- (#x14 #x84)
- (#x18 #x85)
- (#x1c #x86)
- (#x24 #x87)
- (#x2c #x88)
- (#x34 #x89)
- (#x3c #x8a)
- (#x50 #xa0)
- (#x51 #xa1)
- (#x52 #xa2)
- (#x53 #xa4)
- (#x54 #xa5)
- (#x55 #xa6)
- (#x56 #xa7)
- (#x57 #xa8)
- (#x58 #xa9)
- (#x59 #xaa)
- (#x5a #xab)
- (#x5b #xac)
- (#x5c #xad)
- (#x5d #xae)
- (#x5e #xaf)
- (#x5f #xb0)
- (#x60 #xb1)
- (#x61 #xb2)
- (#x62 #xb4)
- (#x63 #xb5)
- (#x64 #xb6)
- (#x65 #xb7)
- (#x66 #xb8)
- (#x67 #xb9)
- (#x68 #xba)
- (#x69 #xbb)
- (#x6a #xbc)
- (#x6b #xbd)
- (#x6c #xbe)
- (#x80 #x8b)
- (#x84 #x8c)
- (#x88 #x8d)
- (#x8c #x8e)
- (#x90 #x8f)
- (#x91 #x90)
- (#x92 #x91)
- (#x93 #x92)
- (#xa0 #x94)))))
- (handle-error)))
-
-(define-character-encoding :koi8-u
- "An 8-bit, fixed-width character Ukranian encoding."
- :literal-char-code-limit #x80)
-
-(define-constant +koi8-u-to-unicode+
- #(#x2500 #x2502 #x250C #x2510 #x2514 #x2518 #x251C #x2524
- #x252C #x2534 #x253C #x2580 #x2584 #x2588 #x258C #x2590
- #x2591 #x2592 #x2593 #x2320 #x25A0 #x2219 #x221A #x2248
- #x2264 #x2265 #x00A0 #x2321 #x00B0 #x00B2 #x00B7 #x00F7
- #x2550 #x2551 #x2552 #x0451 #x0454 #x2554 #x0456 #x0457
- #x2557 #x2558 #x2559 #x255A #x255B #x0491 #x255D #x255E
- #x255F #x2560 #x2561 #x0401 #x0404 #x2563 #x0406 #x0407
- #x2566 #x2567 #x2568 #x2569 #x256A #x0490 #x256C #x00A9
- #x044E #x0430 #x0431 #x0446 #x0434 #x0435 #x0444 #x0433
- #x0445 #x0438 #x0439 #x043A #x043B #x043C #x043D #x043E
- #x043F #x044F #x0440 #x0441 #x0442 #x0443 #x0436 #x0432
- #x044C #x044B #x0437 #x0448 #x044D #x0449 #x0447 #x044A
- #x042E #x0410 #x0411 #x0426 #x0414 #x0415 #x0424 #x0413
- #x0425 #x0418 #x0419 #x041A #x041B #x041C #x041D #x041E
- #x041F #x042F #x0420 #x0421 #x0422 #x0423 #x0416 #x0412
- #x042C #x042B #x0417 #x0428 #x042D #x0429 #x0427 #x042A )
- :test #'equalp)
-
-(define-unibyte-decoder :koi8-u (octet)
- (if (< octet #x80)
- octet
- (svref +koi8-u-to-unicode+ (the ub8 (- octet #x80)))))
-
-(define-constant +unicode-x04->koi8-u+
- #(nil #x33 nil nil #x34 nil #x36 #x37 nil nil nil nil nil nil nil nil #x61
- #x62 #x77 #x67 #x64 #x65 #x76 #x7a #x69 #x6a #x6b #x6c #x6d #x6e #x6f
- #x70 #x72 #x73 #x74 #x75 #x66 #x68 #x63 #x7e #x7b #x7d #x7f #x79 #x78
- #x7c #x60 #x71 #x41 #x42 #x57 #x47 #x44 #x45 #x56 #x5a #x49 #x4a #x4b
- #x4c #x4d #x4e #x4f #x50 #x52 #x53 #x54 #x55 #x46 #x48 #x43 #x5e #x5b
- #x5d #x5f #x59 #x58 #x5c #x40 #x51 nil #x23 nil nil #x24 nil #x26 #x27
- nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
- nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
- nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
- nil nil #x3d #x2d)
- :test 'equalp)
-
-(define-constant +unicode-x25->koi8-u+
- #(#x0 nil #x1 nil nil nil nil nil nil nil nil nil #x2 nil nil nil #x3 nil
- nil nil #x4 nil nil nil #x5 nil nil nil #x6 nil nil nil nil nil nil nil
- #x7 nil nil nil nil nil nil nil #x8 nil nil nil nil nil nil nil #x9 nil
- nil nil nil nil nil nil #xa nil nil nil nil nil nil nil nil nil nil nil
- nil nil nil nil nil nil nil nil #x20 #x21 #x22 nil #x25 nil nil #x28
- #x29 #x2a #x2b #x2c nil #x2e #x2f #x30 #x31 #x32 nil #x35 nil nil #x38
- #x39 #x3a #x3b #x3c nil #x3e nil nil nil nil nil nil nil nil nil nil nil
- nil nil nil nil nil nil nil nil #xb nil nil nil #xc nil nil nil #xd nil
- nil nil #xe nil nil nil #xf #x10 #x11 #x12 nil nil nil nil nil nil nil
- nil nil nil nil nil #x14)
- :test 'equalp)
-
-(define-unibyte-encoder :koi8-u (code)
- (or (and (< code #x80) code)
- (let ((hi (ldb (byte 8 8) code))
- (lo (ldb (byte 8 0) code)))
- (case hi
- (#x4
- (case lo
- (#x1 #xb3)
- (#x4 #xb4)
- (#x6 #xb6)
- (#x7 #xb7)
- (#x10 #xe1)
- (#x11 #xe2)
- (#x12 #xf7)
- (#x13 #xe7)
- (#x14 #xe4)
- (#x15 #xe5)
- (#x16 #xf6)
- (#x17 #xfa)
- (#x18 #xe9)
- (#x19 #xea)
- (#x1a #xeb)
- (#x1b #xec)
- (#x1c #xed)
- (#x1d #xee)
- (#x1e #xef)
- (#x1f #xf0)
- (#x20 #xf2)
- (#x21 #xf3)
- (#x22 #xf4)
- (#x23 #xf5)
- (#x24 #xe6)
- (#x25 #xe8)
- (#x26 #xe3)
- (#x27 #xfe)
- (#x28 #xfb)
- (#x29 #xfd)
- (#x2a #xff)
- (#x2b #xf9)
- (#x2c #xf8)
- (#x2d #xfc)
- (#x2e #xe0)
- (#x2f #xf1)
- (#x30 #xc1)
- (#x31 #xc2)
- (#x32 #xd7)
- (#x33 #xc7)
- (#x34 #xc4)
- (#x35 #xc5)
- (#x36 #xd6)
- (#x37 #xda)
- (#x38 #xc9)
- (#x39 #xca)
- (#x3a #xcb)
- (#x3b #xcc)
- (#x3c #xcd)
- (#x3d #xce)
- (#x3e #xcf)
- (#x3f #xd0)
- (#x40 #xd2)
- (#x41 #xd3)
- (#x42 #xd4)
- (#x43 #xd5)
- (#x44 #xc6)
- (#x45 #xc8)
- (#x46 #xc3)
- (#x47 #xde)
- (#x48 #xdb)
- (#x49 #xdd)
- (#x4a #xdf)
- (#x4b #xd9)
- (#x4c #xd8)
- (#x4d #xdc)
- (#x4e #xc0)
- (#x4f #xd1)
- (#x51 #xa3)
- (#x54 #xa4)
- (#x56 #xa6)
- (#x57 #xa7)
- (#x90 #xbd)
- (#x91 #xad)))
- (#x0
- (case lo
- (#xa0 #x9a)
- (#xa9 #xbf)
- (#xb0 #x9c)
- (#xb2 #x9d)
- (#xb7 #x9e)
- (#xf7 #x9f)))
- (#x22 (case lo (#x19 #x95) (#x1a #x96) (#x48 #x97) (#x64 #x98) (#x65 #x99)))
- (#x23 (case lo (#x20 #x93) (#x21 #x9b)))
- (#x25
- (case lo
- (#x0 #x80)
- (#x2 #x81)
- (#xc #x82)
- (#x10 #x83)
- (#x14 #x84)
- (#x18 #x85)
- (#x1c #x86)
- (#x24 #x87)
- (#x2c #x88)
- (#x34 #x89)
- (#x3c #x8a)
- (#x50 #xa0)
- (#x51 #xa1)
- (#x52 #xa2)
- (#x54 #xa5)
- (#x57 #xa8)
- (#x58 #xa9)
- (#x59 #xaa)
- (#x5a #xab)
- (#x5b #xac)
- (#x5d #xae)
- (#x5e #xaf)
- (#x5f #xb0)
- (#x60 #xb1)
- (#x61 #xb2)
- (#x63 #xb5)
- (#x66 #xb8)
- (#x67 #xb9)
- (#x68 #xba)
- (#x69 #xbb)
- (#x6a #xbc)
- (#x6c #xbe)
- (#x80 #x8b)
- (#x84 #x8c)
- (#x88 #x8d)
- (#x8c #x8e)
- (#x90 #x8f)
- (#x91 #x90)
- (#x92 #x91)
- (#x93 #x92)
- (#xa0 #x94)))))
- (handle-error)))
(DIR) diff --git a/3rdparties/software/babel-20171227-git/src/enc-unicode.lisp b/3rdparties/software/babel-20171227-git/src/enc-unicode.lisp
@@ -1,881 +0,0 @@
-;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
-;;;
-;;; enc-unicode.lisp --- Unicode encodings.
-;;;
-;;; Copyright (C) 2007, Luis Oliveira <loliveira@common-lisp.net>
-;;;
-;;; Permission is hereby granted, free of charge, to any person
-;;; obtaining a copy of this software and associated documentation
-;;; files (the "Software"), to deal in the Software without
-;;; restriction, including without limitation the rights to use, copy,
-;;; modify, merge, publish, distribute, sublicense, and/or sell copies
-;;; of the Software, and to permit persons to whom the Software is
-;;; furnished to do so, subject to the following conditions:
-;;;
-;;; The above copyright notice and this permission notice shall be
-;;; included in all copies or substantial portions of the Software.
-;;;
-;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
-;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
-;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
-;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
-;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
-;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
-;;; DEALINGS IN THE SOFTWARE.
-
-;;; This implementation is largely based on OpenMCL's l1-unicode.lisp
-;;; Copyright (C) 2006 Clozure Associates and contributors.
-
-(in-package #:babel-encodings)
-
-(eval-when (:compile-toplevel :load-toplevel :execute)
- (defconstant +repl+ #xfffd "Unicode replacement character code point.")
- (defconstant +byte-order-mark-code+ #xfeff)
- (defconstant +swapped-byte-order-mark-code+ #xfffe)
- (defconstant +swapped-byte-order-mark-code-32+ #xfffe0000))
-
-;;; Some convenience macros adding FIXNUM declarations.
-(defmacro f-ash (integer count) `(the fixnum (ash ,integer ,count)))
-(defmacro f-logior (&rest integers) `(the fixnum (logior ,@integers)))
-(defmacro f-logand (&rest integers) `(the fixnum (logand ,@integers)))
-(defmacro f-logxor (&rest integers) `(the fixnum (logxor ,@integers)))
-
-;;;; UTF-8
-
-(define-character-encoding :utf-8
- "An 8-bit, variable-length character encoding in which
-character code points in the range #x00-#x7f can be encoded in a
-single octet; characters with larger code values can be encoded
-in 2 to 4 bytes."
- :max-units-per-char 4
- :literal-char-code-limit #x80
- :bom-encoding #(#xef #xbb #xbf)
- :default-replacement #xfffd)
-
-(define-condition invalid-utf8-starter-byte (character-decoding-error)
- ()
- (:documentation "Signalled when an invalid UTF-8 starter byte is found."))
-
-(define-condition invalid-utf8-continuation-byte (character-decoding-error)
- ()
- (:documentation
- "Signalled when an invalid UTF-8 continuation byte is found."))
-
-(define-condition overlong-utf8-sequence (character-decoding-error)
- ()
- (:documentation "Signalled upon overlong UTF-8 sequences."))
-
-(define-octet-counter :utf-8 (getter type)
- `(named-lambda utf-8-octet-counter (seq start end max)
- (declare (type ,type seq) (fixnum start end max))
- (loop with noctets fixnum = 0
- for i fixnum from start below end
- for code of-type code-point = (,getter seq i) do
- (let ((new (+ (cond ((< code #x80) 1)
- ((< code #x800) 2)
- ((< code #x10000) 3)
- (t 4))
- noctets)))
- (if (and (plusp max) (> new max))
- (loop-finish)
- (setq noctets new)))
- finally (return (values noctets i)))))
-
-(define-code-point-counter :utf-8 (getter type)
- `(named-lambda utf-8-code-point-counter (seq start end max)
- (declare (type ,type seq) (fixnum start end max))
- (loop with nchars fixnum = 0
- with i fixnum = start
- while (< i end) do
- ;; check for invalid continuation bytes
- (macrolet ((invalid-cb-p (n)
- `(and (< (+ i ,n) end)
- (not (< #x7f (,',getter seq (+ i ,n)) #xc0)))))
- ;; wrote this code with LET instead of FOR because CLISP's
- ;; LOOP doesn't like WHILE clauses before FOR clauses.
- (let* ((octet (,getter seq i))
- (next-i (+ i (cond ((or (< octet #xc0) (invalid-cb-p 1)) 1)
- ((or (< octet #xe0) (invalid-cb-p 2)) 2)
- ((or (< octet #xf0) (invalid-cb-p 3)) 3)
- ((or (< octet #xf8) (invalid-cb-p 4)) 4)
- ((or (< octet #xfc) (invalid-cb-p 5)) 5)
- (t 6)))))
- (declare (type ub8 octet) (fixnum next-i))
- (cond
- ((> next-i end)
- ;; Should we add restarts to this error, we'll have
- ;; to figure out a way to communicate with the
- ;; decoder since we probably want to do something
- ;; about it right here when we have a chance to
- ;; change the count or something. (Like an
- ;; alternative replacement character or perhaps the
- ;; existence of this error so that the decoder
- ;; doesn't have to check for it on every iteration
- ;; like we do.)
- ;;
- ;; FIXME: The data for this error is not right.
- (decoding-error (vector octet) :utf-8 seq i
- nil 'end-of-input-in-character)
- (return (values (1+ nchars) end)))
- (t
- (setq nchars (1+ nchars)
- i next-i)
- (when (and (plusp max) (= nchars max))
- (return (values nchars i)))))))
- finally (progn
- (assert (= i end))
- (return (values nchars i))))))
-
-(define-encoder :utf-8 (getter src-type setter dest-type)
- `(named-lambda utf-8-encoder (src start end dest d-start)
- (declare (type ,src-type src)
- (type ,dest-type dest)
- (fixnum start end d-start))
- (loop with di fixnum = d-start
- for i fixnum from start below end
- for code of-type code-point = (,getter src i) do
- (macrolet ((set-octet (offset value)
- `(,',setter ,value dest (the fixnum (+ di ,offset)))))
- (cond
- ;; 1 octet
- ((< code #x80)
- (set-octet 0 code)
- (incf di))
- ;; 2 octets
- ((< code #x800)
- (set-octet 0 (logior #xc0 (f-ash code -6)))
- (set-octet 1 (logior #x80 (f-logand code #x3f)))
- (incf di 2))
- ;; 3 octets
- ((< code #x10000)
- (set-octet 0 (logior #xe0 (f-ash code -12)))
- (set-octet 1 (logior #x80 (f-logand #x3f (f-ash code -6))))
- (set-octet 2 (logior #x80 (f-logand code #x3f)))
- (incf di 3))
- ;; 4 octets
- (t
- (set-octet 0 (logior #xf0 (f-logand #x07 (f-ash code -18))))
- (set-octet 1 (logior #x80 (f-logand #x3f (f-ash code -12))))
- (set-octet 2 (logior #x80 (f-logand #x3f (f-ash code -6))))
- (set-octet 3 (logior #x80 (logand code #x3f)))
- (incf di 4))))
- finally (return (the fixnum (- di d-start))))))
-
-(define-decoder :utf-8 (getter src-type setter dest-type)
- `(named-lambda utf-8-decoder (src start end dest d-start)
- (declare (type ,src-type src)
- (type ,dest-type dest)
- (fixnum start end d-start))
- (let ((u2 0) (u3 0) (u4 0) (u5 0) (u6 0))
- (declare (type ub8 u2 u3 u4 u5 u6))
- (loop for di fixnum from d-start
- for i fixnum from start below end
- for u1 of-type ub8 = (,getter src i) do
- ;; Note: CONSUME-OCTET doesn't check if I is being
- ;; incremented past END. We're assuming that END has
- ;; been calculated with the CODE-POINT-POINTER above that
- ;; checks this.
- (macrolet
- ((consume-octet ()
- `(let ((next-i (incf i)))
- (if (= next-i end)
- ;; FIXME: data for this error is incomplete.
- ;; and signalling this error twice
- (return-from setter-block
- (decoding-error nil :utf-8 src i +repl+
- 'end-of-input-in-character))
- (,',getter src next-i))))
- (handle-error (n &optional (c 'character-decoding-error))
- `(decoding-error
- (vector ,@(subseq '(u1 u2 u3 u4 u5 u6) 0 n))
- :utf-8 src (1+ (- i ,n)) +repl+ ',c))
- (handle-error-if-icb (var n)
- `(when (not (< #x7f ,var #xc0))
- (decf i)
- (return-from setter-block
- (handle-error ,n invalid-utf8-continuation-byte)))))
- (,setter
- (block setter-block
- (cond
- ((< u1 #x80) u1) ; 1 octet
- ((< u1 #xc0)
- (handle-error 1 invalid-utf8-starter-byte))
- (t
- (setq u2 (consume-octet))
- (handle-error-if-icb u2 1)
- (cond
- ((< u1 #xc2)
- (handle-error 2 overlong-utf8-sequence))
- ((< u1 #xe0) ; 2 octets
- (logior (f-ash (f-logand #x1f u1) 6)
- (f-logxor u2 #x80)))
- (t
- (setq u3 (consume-octet))
- (handle-error-if-icb u3 2)
- (cond
- ((and (= u1 #xe0) (< u2 #xa0))
- (handle-error 3 overlong-utf8-sequence))
- ((< u1 #xf0) ; 3 octets
- (let ((start (f-logior (f-ash (f-logand u1 #x0f) 12)
- (f-ash (f-logand u2 #x3f) 6))))
- (if (<= #xd800 start #xdfc0)
- (handle-error 3 character-out-of-range)
- (logior start (f-logand u3 #x3f)))))
- (t ; 4 octets
- (setq u4 (consume-octet))
- (handle-error-if-icb u4 3)
- (cond
- ((and (= u1 #xf0) (< u2 #x90))
- (handle-error 4 overlong-utf8-sequence))
- ((< u1 #xf8)
- (if (or (> u1 #xf4) (and (= u1 #xf4) (> u2 #x8f)))
- (handle-error 4 character-out-of-range)
- (f-logior (f-ash (f-logand u1 7) 18)
- (f-ash (f-logxor u2 #x80) 12)
- (f-ash (f-logxor u3 #x80) 6)
- (f-logxor u4 #x80))))
- ;; from here on we'll be getting either
- ;; invalid continuation bytes or overlong
- ;; 5-byte or 6-byte sequences.
- (t
- (setq u5 (consume-octet))
- (handle-error-if-icb u5 4)
- (cond
- ((and (= u1 #xf8) (< u2 #x88))
- (handle-error 5 overlong-utf8-sequence))
- ((< u1 #xfc)
- (handle-error 5 character-out-of-range))
- (t
- (setq u6 (consume-octet))
- (handle-error-if-icb u6 5)
- (cond
- ((and (= u1 #xfc) (< u2 #x84))
- (handle-error 6 overlong-utf8-sequence))
- (t
- (handle-error 6 character-out-of-range)
- )))))))))))))
- dest di))
- finally (return (the fixnum (- di d-start)))))))
-
-;;;; UTF-8B
-
-;;; The following excerpt from a linux-utf8 message by Markus Kuhn is
-;;; the closest thing to a UTF-8B specification:
-;;;
-;;; <http://mail.nl.linux.org/linux-utf8/2000-07/msg00040.html>
-;;;
-;;; "D) Emit a malformed UTF-16 sequence for every byte in a malformed
-;;; UTF-8 sequence
-;;;
-;;; All the previous options for converting malformed UTF-8 sequences
-;;; to UTF-16 destroy information. This can be highly undesirable in
-;;; applications such as text file editors, where guaranteed binary
-;;; transparency is a desireable feature. (E.g., I frequently edit
-;;; executable code or graphic files with the Emacs text editor and I
-;;; hate the idea that my editor might automatically make U+FFFD
-;;; substitutions at locations that I haven't even edited when I save
-;;; the file again.)
-;;;
-;;; I therefore suggested 1999-11-02 on the unicode@xxxxxxxxxxx
-;;; mailing list the following approach. Instead of using U+FFFD,
-;;; simply encode malformed UTF-8 sequences as malformed UTF-16
-;;; sequences. Malformed UTF-8 sequences consist excludively of the
-;;; bytes 0x80 - 0xff, and each of these bytes can be represented
-;;; using a 16-bit value from the UTF-16 low-half surrogate zone
-;;; U+DC80 to U+DCFF. Thus, the overlong "K" (U+004B) 0xc1 0x8b from
-;;; the above example would be represented in UTF-16 as U+DCC1
-;;; U+DC8B. If we simply make sure that every UTF-8 encoded surrogate
-;;; character is also treated like a malformed sequence, then there
-;;; is no way that a single high-half surrogate could precede the
-;;; encoded malformed sequence and cause a valid UTF-16 sequence to
-;;; emerge.
-;;;
-;;; This way 100% binary transparent UTF-8 -> UTF-16 -> UTF-8
-;;; round-trip compatibility can be achieved quite easily.
-;;;
-;;; On an output device, a lonely low-half surrogate character should
-;;; be treated just like a character outside the adopted subset of
-;;; representable characters, that is for the end user, the display
-;;; would look exactly like with semantics B), i.e. one symbol per
-;;; byte of a malformed sequence. However in contrast to semantics
-;;; B), no information is thrown away, and a cut&paste in an editor
-;;; or terminal emulator will be guaranteed to reconstruct the
-;;; original byte sequence. This should greatly reduce the incidence
-;;; of accidental corruption of binary data by UTF-8 -> UTF-16 ->
-;;; UTF-8 conversion round trips."
-
-(define-character-encoding :utf-8b
- "An 8-bit, variable-length character encoding in which
-character code points in the range #x00-#x7f can be encoded in a
-single octet; characters with larger code values can be encoded
-in 2 to 4 bytes. Invalid UTF-8 sequences are encoded with #xDCXX
-code points for each invalid byte."
- :max-units-per-char 4
- :literal-char-code-limit #x80
- :bom-encoding #(#xef #xbb #xbf)
- :default-replacement nil)
-
-;;; TODO: reuse the :UTF-8 octet counter through a simple macro.
-(define-octet-counter :utf-8b (getter type)
- `(named-lambda utf-8b-octet-counter (seq start end max)
- (declare (type ,type seq) (fixnum start end max))
- (loop with noctets fixnum = 0
- for i fixnum from start below end
- for code of-type code-point = (,getter seq i) do
- (let ((new (+ (cond ((< code #x80) 1)
- ((< code #x800) 2)
- ((<= #xdc80 code #xdcff) 1)
- ((< code #x10000) 3)
- (t 4))
- noctets)))
- (if (and (plusp max) (> new max))
- (loop-finish)
- (setq noctets new)))
- finally (return (values noctets i)))))
-
-(define-code-point-counter :utf-8b (getter type)
- `(named-lambda utf-8b-code-point-counter (seq start end max)
- (declare (type ,type seq) (fixnum start end max))
- (loop with nchars fixnum = 0
- with i fixnum = start
- while (< i end) do
- ;; wrote this code with LET instead of FOR because CLISP's
- ;; LOOP doesn't like WHILE clauses before FOR clauses.
- (let* ((octet (,getter seq i))
- (noctets (cond ((< octet #x80) 1)
- ((< octet #xe0) 2)
- ((< octet #xf0) 3)
- (t 4))))
- (declare (type ub8 octet) (fixnum noctets))
- (cond
- ((> (+ i noctets) end)
- ;; If this error is suppressed these last few bytes
- ;; will be encoded as raw bytes later.
- (decoding-error (vector octet) :utf-8 seq i
- nil 'end-of-input-in-character)
- (return (values (+ nchars (- end i)) end)))
- (t
- ;; FIXME: clean this mess up.
- (let* ((u1 octet)
- (u2 (if (>= noctets 2) (,getter seq (1+ i)) 0))
- (u3 (if (>= noctets 3) (,getter seq (+ i 2)) 0))
- (u4 (if (= noctets 4) (,getter seq (+ i 3)) 0))
- (inc (or (and (> noctets 1)
- (< u1 #xc2))
- (and (= noctets 2)
- (not (logior u2 #x40)))
- (and (= noctets 3)
- (not (and (< (f-logxor u2 #x80) #x40)
- (< (f-logxor u3 #x80) #x40)
- (or (>= u1 #xe1) (>= u2 #xa0))
- (or (/= u1 #xed) (< u2 #xa0) (> u2 #xbf)))))
- (and (= noctets 4)
- (not
- (and (< (f-logxor u2 #x80) #x40)
- (< (f-logxor u3 #x80) #x40)
- (< (f-logxor u4 #x80) #x40)
- (or (>= u1 #xf1) (>= u2 #x90))))))))
- (let ((new-nchars (if inc (+ nchars noctets) (1+ nchars))))
- (when (and (plusp max) (> new-nchars max))
- (return (values nchars i)))
- (incf i noctets)
- (setq nchars new-nchars))))))
- finally (progn
- (assert (= i end))
- (return (values nchars i))))))
-
-;;; TODO: reuse the :UTF-8 encoder with through a simple macro.
-(define-encoder :utf-8b (getter src-type setter dest-type)
- `(named-lambda utf-8b-encoder (src start end dest d-start)
- (declare (type ,src-type src)
- (type ,dest-type dest)
- (fixnum start end d-start))
- (loop with di fixnum = d-start
- for i fixnum from start below end
- for code of-type code-point = (,getter src i) do
- (macrolet ((set-octet (offset value)
- `(,',setter ,value dest (the fixnum (+ di ,offset)))))
- (cond
- ;; 1 octet
- ((< code #x80)
- (set-octet 0 code)
- (incf di))
- ;; 2 octets
- ((< code #x800)
- (set-octet 0 (logior #xc0 (f-ash code -6)))
- (set-octet 1 (logior #x80 (f-logand code #x3f)))
- (incf di 2))
- ;; 1 octet (invalid octet)
- ((<= #xdc80 code #xdcff)
- (set-octet 0 (f-logand code #xff))
- (incf di))
- ;; 3 octets
- ((< code #x10000)
- (set-octet 0 (logior #xe0 (f-ash code -12)))
- (set-octet 1 (logior #x80 (f-logand #x3f (f-ash code -6))))
- (set-octet 2 (logior #x80 (f-logand code #x3f)))
- (incf di 3))
- ;; 4 octets
- (t
- (set-octet 0 (logior #xf0 (f-logand #x07 (f-ash code -18))))
- (set-octet 1 (logior #x80 (f-logand #x3f (f-ash code -12))))
- (set-octet 2 (logior #x80 (f-logand #x3f (f-ash code -6))))
- (set-octet 3 (logand #x3f code))
- (incf di 4))))
- finally (return (the fixnum (- di d-start))))))
-
-(define-decoder :utf-8b (getter src-type setter dest-type)
- `(named-lambda utf-8b-decoder (src start end dest d-start)
- (declare (type ,src-type src)
- (type ,dest-type dest)
- (fixnum start end d-start))
- (let ((u2 0) (u3 0) (u4 0))
- (declare (type ub8 u2 u3 u4))
- (loop for di fixnum from d-start
- for i fixnum from start below end
- for u1 of-type ub8 = (,getter src i) do
- ;; Unlike the UTF-8 version, this version of
- ;; CONSUME-OCTET needs to check if I is being incremented
- ;; past END because we might have trailing binary
- ;; garbage.
- (macrolet
- ((consume-octet (n)
- `(if (= i (1- end))
- (encode-raw-octets ,n)
- (,',getter src (incf i))))
- (encode-raw-octets (n)
- `(progn
- ,@(loop for i below n and var in '(u1 u2 u3 u4)
- collect `(,',setter (logior #xdc00 ,var) dest di)
- unless (= i (1- n))
- collect '(incf di))
- (return-from set-body))))
- (block set-body
- (,setter (cond
- ((< u1 #x80) ; 1 octet
- u1)
- ((>= u1 #xc2)
- (setq u2 (consume-octet 1))
- (cond
- ((< u1 #xe0) ; 2 octets
- (if (< (f-logxor u2 #x80) #x40)
- (logior (f-ash (f-logand #x1f u1) 6)
- (f-logxor u2 #x80))
- (encode-raw-octets 2)))
- (t
- (setq u3 (consume-octet 2))
- (cond
- ((< u1 #xf0) ; 3 octets
- (if (and (< (f-logxor u2 #x80) #x40)
- (< (f-logxor u3 #x80) #x40)
- (or (>= u1 #xe1) (>= u2 #xa0)))
- (let ((start (f-logior (f-ash (f-logand u1 #x0f) 12)
- (f-ash (f-logand u2 #x3f) 6))))
- (if (<= #xd800 start #xdfc0)
- (encode-raw-octets 3)
- (logior start (f-logand u3 #x3f))))
- (encode-raw-octets 3)))
- (t ; 4 octets
- (setq u4 (consume-octet 3))
- (if (and (< (f-logxor u2 #x80) #x40)
- (< (f-logxor u3 #x80) #x40)
- (< (f-logxor u4 #x80) #x40)
- (or (>= u1 #xf1) (>= u2 #x90)))
- (logior
- (f-logior (f-ash (f-logand u1 7) 18)
- (f-ash (f-logxor u2 #x80) 12))
- (f-logior (f-ash (f-logxor u3 #x80) 6)
- (f-logxor u4 #x80)))
- (encode-raw-octets 4)))))))
- (t (encode-raw-octets 1)))
- dest di)))
- finally (return (the fixnum (- di d-start)))))))
-
-;;;; UTF-16
-
-;;; TODO: add a way to pass some info at compile-time telling us that,
-;;; for example, the maximum code-point will always be < #x10000 in
-;;; which case we could simply return (* 2 (- end start)).
-(defmacro utf16-octet-counter (getter type)
- `(named-lambda utf-16-octet-counter (seq start end max)
- (declare (type ,type seq) (fixnum start end max))
- (loop with noctets fixnum = 0
- for i fixnum from start below end
- for code of-type code-point = (,getter seq i)
- do (let ((new (the fixnum (+ (if (< code #x10000) 2 4) noctets))))
- (if (and (plusp max) (> new max))
- (loop-finish)
- (setq noctets new)))
- finally (return (values noctets i)))))
-
-(defmacro utf-16-combine-surrogate-pairs (u1 u2)
- `(the (unsigned-byte 21)
- (+ #x10000
- (the (unsigned-byte 20)
- (logior
- (the (unsigned-byte 20)
- (ash (the (unsigned-byte 10) (- ,u1 #xd800)) 10))
- (the (unsigned-byte 10)
- (- ,u2 #xdc00)))))))
-
-(defmacro define-utf-16 (name &optional endianness)
- (check-type endianness (or null (eql :be) (eql :le)))
- (check-type name keyword)
- (let ((swap-var (gensym "SWAP"))
- (code-point-counter-name
- (format-symbol t '#:~a-code-point-counter (string name)))
- (encoder-name (format-symbol t '#:~a-encoder (string name)))
- (decoder-name (format-symbol t '#:~a-decoder (string name))))
- (labels ((make-bom-check-form (end start getter seq)
- (if (null endianness)
- ``((,',swap-var
- (when (> ,,end ,,start)
- (case (,,getter ,,seq ,,start 2 :ne)
- (#.+byte-order-mark-code+ (incf ,,start 2) nil)
- (#.+swapped-byte-order-mark-code+ (incf ,,start 2) t)
- (t #+little-endian t)))))
- '()))
- (make-getter-form (getter src i)
- (case endianness
- (:le ``(,,getter ,,src ,,i 2 :le))
- (:be ``(,,getter ,,src ,,i 2 :be))
- (t ``(if ,',swap-var
- (,,getter ,,src ,,i 2 :re)
- (,,getter ,,src ,,i 2 :ne)))))
- (make-setter-form (setter code dest di)
- (case endianness
- (:be ``(,,setter ,,code ,,dest ,,di 2 :be))
- (:le ``(,,setter ,,code ,,dest ,,di 2 :le))
- (t ``(,,setter ,,code ,,dest ,,di 2 :ne)))))
- `(progn
- (define-octet-counter ,name (getter type)
- `(utf16-octet-counter ,getter ,type))
- (define-code-point-counter ,name (getter type)
- `(named-lambda ,',code-point-counter-name (seq start end max)
- (declare (type ,type seq) (fixnum start end max))
- (let* ,,(make-bom-check-form ''end ''start 'getter ''seq)
- (loop with count fixnum = 0
- with i fixnum = start
- while (<= i (- end 2)) do
- (let* ((code ,,(make-getter-form 'getter ''seq ''i))
- (next-i (+ i (if (or (< code #xd800) (>= code #xdc00))
- 2
- 4))))
- (declare (type (unsigned-byte 16) code) (fixnum next-i))
- (cond
- ((> next-i end)
- (decoding-error
- (vector (,getter seq i) (,getter seq (1+ i)))
- ,',name seq i nil 'end-of-input-in-character)
- (return (values count i)))
- (t
- (setq i next-i
- count (1+ count))
- (when (and (plusp max) (= count max))
- (return (values count i))))))
- finally (progn
- (assert (= i end))
- (return (values count i)))))))
- (define-encoder ,name (getter src-type setter dest-type)
- `(named-lambda ,',encoder-name (src start end dest d-start)
- (declare (type ,src-type src)
- (type ,dest-type dest)
- (fixnum start end d-start))
- (loop with di fixnum = d-start
- for i fixnum from start below end
- for code of-type code-point = (,getter src i)
- for high-bits fixnum = (- code #x10000) do
- (cond ((< high-bits 0)
- ,,(make-setter-form 'setter ''code ''dest ''di)
- (incf di 2))
- (t
- ,,(make-setter-form
- 'setter ''(logior #xd800 (f-ash high-bits -10))
- ''dest ''di)
- ,,(make-setter-form
- 'setter ''(logior #xdc00 (f-logand high-bits #x3ff))
- ''dest ''(+ di 2))
- (incf di 4)))
- finally (return (the fixnum (- di d-start))))))
- (define-decoder ,name (getter src-type setter dest-type)
- `(named-lambda ,',decoder-name (src start end dest d-start)
- (declare (type ,src-type src)
- (type ,dest-type dest)
- (fixnum start end d-start))
- (let ,,(make-bom-check-form ''end ''start 'getter ''src)
- (loop with i fixnum = start
- for di fixnum from d-start
- until (= i end) do
- (let ((u1 ,,(make-getter-form 'getter ''src ''i)))
- (declare (type (unsigned-byte 16) u1))
- (incf i 2)
- (,setter (cond
- ((or (< u1 #xd800) (>= u1 #xe000)) ; 2 octets
- u1)
- ((< u1 #xdc00) ; 4 octets
- (let ((u2 ,,(make-getter-form 'getter ''src ''i)))
- (declare (type (unsigned-byte 16) u2))
- (incf i 2)
- (if (and (>= u2 #xdc00) (< u2 #xe000))
- (utf-16-combine-surrogate-pairs u1 u2)
- (decoding-error
- (vector (,getter src (- i 4))
- (,getter src (- i 3))
- (,getter src (- i 2))
- (,getter src (- i 1)))
- ,',name src i +repl+))))
- (t
- (decoding-error (vector (,getter src (- i 2))
- (,getter src (- i 1)))
- ,',name src i +repl+)))
- dest di))
- finally (return (the fixnum (- di d-start)))))))
- ',name))))
-
-(define-character-encoding :utf-16
- "A 16-bit, variable-length encoding in which characters with
-code points less than #x10000 can be encoded in a single 16-bit
-word and characters with larger codes can be encoded in a pair of
-16-bit words. The endianness of the encoded data is indicated by
-the endianness of a byte-order-mark character (#\u+feff)
-prepended to the data; in the absence of such a character on
-input, the data is assumed to be in big-endian order. Output is
-written in native byte-order with a leading byte-order mark."
- :max-units-per-char 2
- :code-unit-size 16
- :native-endianness t ; not necessarily true when decoding
- :decode-literal-code-unit-limit #xd800
- :encode-literal-code-unit-limit #x10000
- :use-bom #+big-endian :utf-16be #+little-endian :utf-16le
- :bom-encoding #+big-endian #(#xfe #xff) #+little-endian #(#xff #xfe)
- :nul-encoding #(0 0)
- :default-replacement #xfffd
- :ambiguous #+little-endian t #+big-endian nil)
-
-(define-utf-16 :utf-16)
-
-(define-character-encoding :utf-16le
- "A 16-bit, variable-length encoding in which characters with
-code points less than #x10000 can be encoded in a single 16-bit
-word and characters with larger codes can be encoded in a pair of
-16-bit words. The data is assumed to be in little-endian order. Output is
-written in little-endian byte-order without a leading byte-order mark."
- :aliases '(:utf-16/le)
- :max-units-per-char 2
- :code-unit-size 16
- :native-endianness #+little-endian t #+big-endian nil
- :decode-literal-code-unit-limit #xd800
- :encode-literal-code-unit-limit #x10000
- :nul-encoding #(0 0)
- :default-replacement #xfffd)
-
-(define-utf-16 :utf-16le :le)
-
-(define-character-encoding :utf-16be
- "A 16-bit, variable-length encoding in which characters with
-code points less than #x10000 can be encoded in a single 16-bit
-word and characters with larger codes can be encoded in a pair of
-16-bit words. The data is assumed to be in big-endian order. Output is
-written in big-endian byte-order without a leading byte-order mark."
- :aliases '(:utf-16/be)
- :max-units-per-char 2
- :code-unit-size 16
- :native-endianness #+little-endian nil #+big-endian t
- :decode-literal-code-unit-limit #xd800
- :encode-literal-code-unit-limit #x10000
- :nul-encoding #(0 0)
- :default-replacement #xfffd)
-
-(define-utf-16 :utf-16be :be)
-
-(defmacro define-ucs (name bytes &optional endianness (limit #x110000))
- (check-type name keyword)
- (check-type bytes (or (eql 2) (eql 4)))
- (check-type endianness (or null (eql :le) (eql :be)))
- (let ((swap-var (gensym "SWAP"))
- (code-point-counter-name
- (format-symbol t '#:~a-code-point-counter (string name)))
- (encoder-name
- (format-symbol t '#:~a-encoder (string name)))
- (decoder-name
- (format-symbol t '#:~a-decoder (string name))))
- (labels ((make-bom-check-form (end start getter src)
- (if (null endianness)
- ``(when (not (zerop (- ,,end ,,start)))
- (case (,,getter ,,src 0 ,',bytes :ne)
- (#.+byte-order-mark-code+
- (incf ,,start ,',bytes) nil)
- (#.+swapped-byte-order-mark-code-32+
- (incf ,,start ,',bytes) t)
- (t #+little-endian t)))
- '()))
- (make-setter-form (setter code dest di)
- ``(,,setter ,,code ,,dest ,,di ,',bytes
- ,',(or endianness :ne)))
- (make-getter-form (getter src i)
- (if (null endianness)
- ``(if ,',swap-var
- (,,getter ,,src ,,i ,',bytes :re)
- (,,getter ,,src ,,i ,',bytes :ne))
- ``(,,getter ,,src ,,i ,',bytes ,',endianness))))
- `(progn
- (define-code-point-counter ,name (getter type)
- `(named-lambda ,',code-point-counter-name (seq start end max)
- (declare (type ,type seq) (fixnum start end max))
- ;; check for bom
- ,,(make-bom-check-form ''end ''start 'getter ''seq)
- (multiple-value-bind (count rem)
- (floor (- end start) ,',bytes)
- (cond
- ((and (plusp max) (> count max))
- (values max (the fixnum (+ start (* ,',bytes max)))))
- (t
- ;; check for incomplete last character
- (unless (zerop rem)
- (let ((vector (make-array ,',bytes :fill-pointer 0)))
- (dotimes (i rem)
- (vector-push (,getter seq (+ i (- end rem))) vector))
- (decoding-error vector ,',name seq (the fixnum (- end rem)) nil
- 'end-of-input-in-character)
- (decf end rem)))
- (values count end))))))
- (define-encoder ,name (getter src-type setter dest-type)
- `(named-lambda ,',encoder-name (src start end dest d-start)
- (declare (type ,src-type src)
- (type ,dest-type dest)
- (fixnum start end d-start))
- (loop for i fixnum from start below end
- and di fixnum from d-start by ,',bytes
- for code of-type code-point = (,getter src i)
- do (if (>= code ,',limit)
- (encoding-error code ,',name src i +repl+)
- ,,(make-setter-form 'setter ''code ''dest ''di))
- finally (return (the fixnum (- di d-start))))))
- (define-decoder ,name (getter src-type setter dest-type)
- `(named-lambda ,',decoder-name (src start end dest d-start)
- (declare (type ,src-type src)
- (type ,dest-type dest)
- (fixnum start end d-start))
- (let ((,',swap-var ,,(make-bom-check-form ''end ''start 'getter ''src)))
- (declare (ignorable ,',swap-var))
- (loop for i fixnum from start below end by ,',bytes
- and di from d-start
- do (,setter (let ((unit ,,(make-getter-form 'getter ''src ''i)))
- (if (>= unit ,',limit)
- (decoding-error
- (vector (,getter src i)
- (,getter src (+ i 1))
- ,@,(if (= bytes 4)
- ``((,getter src (+ i 2))
- (,getter src (+ i 3)))))
- ,',name src i +repl+
- 'character-out-of-range)
- unit))
- dest di)
- finally (return (the fixnum (- di d-start)))))))
- ',name))))
-
-;;;; UTF-32
-
-(define-character-encoding :utf-32
- "A 32-bit, fixed-length encoding in which all Unicode
-characters can be encoded in a single 32-bit word. The
-endianness of the encoded data is indicated by the endianness of
-a byte-order-mark character (#\u+feff) prepended to the data; in
-the absence of such a character on input, input data is assumed
-to be in big-endian order. Output is written in native byte
-order with a leading byte-order mark."
- :aliases '(:ucs-4)
- :max-units-per-char 1
- :code-unit-size 32
- :native-endianness t ; not necessarily true when decoding
- :literal-char-code-limit #x110000
- :use-bom #+little-endian :utf-32le #+big-endian :utf-32be
- :bom-encoding
- #+big-endian #(#x00 #x00 #xfe #xff)
- #+little-endian #(#xff #xfe #x00 #x00)
- :nul-encoding #(0 0 0 0)
- :ambiguous #+little-endian t #+big-endian nil)
-
-(define-ucs :utf-32 4)
-
-(define-character-encoding :utf-32le
- "A 32-bit, fixed-length encoding in which all Unicode
-characters can be encoded in a single 32-bit word. Input data is assumed
-to be in little-endian order. Output is also written in little-endian byte
-order without a leading byte-order mark."
- :max-units-per-char 1
- :code-unit-size 32
- :aliases '(:utf-32/le :ucs-4le :ucs-4/le)
- :native-endianness #+little-endian t #+big-endian nil
- :literal-char-code-limit #x110000
- :nul-encoding #(0 0 0 0))
-
-(define-ucs :utf-32le 4 :le)
-
-(define-character-encoding :utf-32be
- "A 32-bit, fixed-length encoding in which all Unicode
-characters can be encoded in a single 32-bit word. Input data is assumed
-to be in big-endian order. Output is also written in big-endian byte
-order without a leading byte-order mark."
- :max-units-per-char 1
- :code-unit-size 32
- :aliases '(:utf-32/be :ucs-4be :ucs-4/be)
- :native-endianness #+little-endian nil #+big-endian t
- :literal-char-code-limit #x110000
- :nul-encoding #(0 0 0 0))
-
-(define-ucs :utf-32be 4 :be)
-
-;; UCS-2
-
-(define-character-encoding :ucs-2
- "A 16-bit, fixed-length encoding in which all Unicode
-characters can be encoded in a single 16-bit word. The
-endianness of the encoded data is indicated by the endianness of
-a byte-order-mark character (#\u+feff) prepended to the data; in
-the absence of such a character on input, input data is assumed
-to be in big-endian order. Output is written in native byte
-order with a leading byte-order mark."
- :aliases '(:ucs-2)
- :max-units-per-char 1
- :code-unit-size 16
- :native-endianness t ; not necessarily true when decoding
- :literal-char-code-limit #x10000
- :use-bom #+little-endian :ucs-2le #+big-endian :ucs-2be
- :bom-encoding
- #+big-endian #(#xfe #xff)
- #+little-endian #(#xff #xfe)
- :nul-encoding #(0 0)
- :ambiguous #+little-endian t #+big-endian nil)
-
-(define-ucs :ucs-2 2 nil #x10000)
-
-(define-character-encoding :ucs-2le
- "A 16-bit, fixed-length encoding in which all Unicode
-characters can be encoded in a single 16-bit word. Input data is assumed
-to be in little-endian order. Output is also written in little-endian byte
-order without a leading byte-order mark."
- :max-units-per-char 1
- :code-unit-size 16
- :aliases '(:ucs-2/le)
- :native-endianness #+little-endian t #+big-endian nil
- :literal-char-code-limit #x10000
- :nul-encoding #(0 0))
-
-(define-ucs :ucs-2le 2 :le #x10000)
-
-(define-character-encoding :ucs-2be
- "A 16-bit, fixed-length encoding in which all Unicode
-characters can be encoded in a single 16-bit word. Input data is assumed
-to be in big-endian order. Output is also written in big-endian byte
-order without a leading byte-order mark."
- :max-units-per-char 1
- :code-unit-size 16
- :aliases '(:ucs-2/be)
- :native-endianness #+little-endian nil #+big-endian t
- :literal-char-code-limit #x10000
- :nul-encoding #(0 0))
-
-(define-ucs :ucs-2be 2 :be #x10000)
(DIR) diff --git a/3rdparties/software/babel-20171227-git/src/encodings.lisp b/3rdparties/software/babel-20171227-git/src/encodings.lisp
@@ -1,503 +0,0 @@
-;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
-;;;
-;;; encodings.lisp --- Character encodings and mappings.
-;;;
-;;; Copyright (C) 2007, Luis Oliveira <loliveira@common-lisp.net>
-;;;
-;;; Permission is hereby granted, free of charge, to any person
-;;; obtaining a copy of this software and associated documentation
-;;; files (the "Software"), to deal in the Software without
-;;; restriction, including without limitation the rights to use, copy,
-;;; modify, merge, publish, distribute, sublicense, and/or sell copies
-;;; of the Software, and to permit persons to whom the Software is
-;;; furnished to do so, subject to the following conditions:
-;;;
-;;; The above copyright notice and this permission notice shall be
-;;; included in all copies or substantial portions of the Software.
-;;;
-;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
-;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
-;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
-;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
-;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
-;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
-;;; DEALINGS IN THE SOFTWARE.
-
-(in-package #:babel-encodings)
-
-;;;; Character Encodings
-
-(defclass character-encoding ()
- ((name :initarg :name :reader enc-name
- :initform (error "Must specify a NAME for this character encoding."))
- ;; Most of these documentation strings are taken from OpenMCL.
- (documentation
- :initarg :documentation :reader enc-documentation :initform nil)
- ;; A non-exhaustive list of aliases for the encoding.
- (aliases :initarg :aliases :initform nil :reader enc-aliases)
- ;; Specified in bits. Usually 8, 16 or 32.
- (code-unit-size
- :initarg :code-unit-size :reader enc-code-unit-size :initform 8)
- (max-units-per-char
- :initarg :max-units-per-char :reader enc-max-units-per-char :initform 1)
- ;; If NIL, it is necessary to swap 16- and 32-bit units.
- (native-endianness
- :initarg :native-endianness :reader enc-native-endianness :initform t)
- ;; Code units less than this value map to themselves on input.
- (decode-literal-code-unit-limit
- :initarg :decode-literal-code-unit-limit :initform 0
- :reader enc-decode-literal-code-unit-limit)
- ;; Code points less than this value map to themselves on output.
- (encode-literal-code-unit-limit
- :initarg :encode-literal-code-unit-limit :initform 0
- :reader enc-encode-literal-code-unit-limit)
- ;; Defines whether it is necessary to prepend a byte-order-mark to
- ;; determine the endianness.
- (use-bom :initarg :use-bom :initform nil :reader enc-use-bom)
- ;; How the byte-order-mark should be encoded, specified as a
- ;; sequence of octets. NIL if it cannot be encoded.
- (bom-encoding
- :initarg :bom-encoding :reader enc-bom-encoding :initform nil)
- ;; How should NUL be encoded, specified as sequence of octets.
- (nul-encoding
- :initarg :nul-encoding :reader enc-nul-encoding :initform #(0))
- ;; Preferred replacement character code point.
- (default-replacement
- :initarg :default-replacement :reader enc-default-replacement
- :initform #x1a)
- ;; Does VALID-STRING => OCTETS => STRING2 guarantee a valid
- ;; STRING2? UTF-{16,32} on little-endian plaforms don't because
- ;; they assume different endianness on each direction.
- (ambiguous
- :initarg :ambiguous :reader ambiguous-encoding-p :initform nil)))
-
-;;; I'm too lazy to write all the identical limits twice.
-(defmethod initialize-instance :after ((enc character-encoding)
- &key literal-char-code-limit)
- (when literal-char-code-limit
- (setf (slot-value enc 'encode-literal-code-unit-limit)
- literal-char-code-limit)
- (setf (slot-value enc 'decode-literal-code-unit-limit)
- literal-char-code-limit)))
-
-#-(and)
-(defmethod describe-object ((enc character-encoding) s)
- "Prints out the name, aliases and documentation slots of a
-character encoding object."
- (with-slots (name aliases documentation) enc
- (format s "~&~S" name)
- (when aliases
- (format s " [Aliases:~{ ~S~}]" aliases))
- (format s "~&~A~%~%" documentation))
- (call-next-method))
-
-(defvar *supported-character-encodings* nil)
-
-(defun list-character-encodings ()
- "List of keyword symbols denoting supported character
-encodings. This list does not include aliases."
- *supported-character-encodings*)
-
-(defvar *character-encodings* (make-hash-table :test 'eq))
-
-(defvar *default-character-encoding* :utf-8
- "Special variable used to determine the default character
-encoding.")
-
-(defun get-character-encoding (name)
- "Lookups the character encoding denoted by the keyword symbol
-NAME. Signals an error if one is not found. If NAME is already
-a CHARACTER-ENCONDING object, it is returned unmodified."
- (when (typep name 'character-encoding)
- (return-from get-character-encoding name))
- (when (eq name :default)
- (setq name *default-character-encoding*))
- (or (gethash name *character-encodings*)
- (error "Unknown character encoding: ~S" name)))
-
-(defmethod ambiguous-encoding-p ((encoding symbol))
- (ambiguous-encoding-p (get-character-encoding encoding)))
-
-(defun notice-character-encoding (enc)
- (pushnew (enc-name enc) *supported-character-encodings*)
- (dolist (kw (cons (enc-name enc) (enc-aliases enc)))
- (setf (gethash kw *character-encodings*) enc))
- (enc-name enc))
-
-(defmacro define-character-encoding (name docstring &body options)
- `(notice-character-encoding
- (make-instance 'character-encoding :name ,name ,@options
- :documentation ,docstring)))
-
-;;;; Mappings
-
-;;; TODO: describe what mappings are
-
-(defun make-fixed-width-counter (getter type &optional (unit-size-in-bits 8))
- (declare (ignore getter type))
- (check-type unit-size-in-bits positive-fixnum)
- (let ((unit-size-in-bytes (/ unit-size-in-bits 8)))
- `(named-lambda fixed-width-counter (seq start end max)
- (declare (ignore seq) (fixnum start end max))
- ;; XXX: the result can be bigger than a fixnum when (> unit-size
- ;; 1) and we don't want that to happen. Possible solution: signal
- ;; a warning (hmm, make that an actual error) and truncate.
- (if (plusp max)
- (let ((count (the fixnum (min (floor max ,unit-size-in-bytes)
- (the fixnum (- end start))))))
- (values (the fixnum (* count ,unit-size-in-bytes))
- (the fixnum (+ start count))))
- (values (the fixnum (* (the fixnum (- end start))
- ,unit-size-in-bytes))
- (the fixnum end))))))
-
-;;; Useful to develop new encodings incrementally starting with octet
-;;; and code-unit counters.
-(defun make-dummy-coder (sg st ds dt)
- (declare (ignore sg st ds dt))
- `(named-lambda dummy-coder (src s e dest i)
- (declare (ignore src s e dest i))
- (error "this encoder/decoder hasn't been implemented yet")))
-
-;;; TODO: document here
-;;;
-;;; ENCODER -- (lambda (src-getter src-type dest-setter dest-type) ...)
-;;; DECODER -- (lambda (src-getter src-type dest-setter dest-type) ...)
-;;;
-;;; OCTET-COUNTER -- (lambda (getter type) ...)
-;;; CODE-POINT-COUNTER -- (lambda (getter type) ...)
-(defclass abstract-mapping ()
- ((encoder-factory :accessor encoder-factory :initform 'make-dummy-coder)
- (decoder-factory :accessor decoder-factory :initform 'make-dummy-coder)
- (octet-counter-factory :accessor octet-counter-factory
- :initform 'make-fixed-width-counter)
- (code-point-counter-factory :accessor code-point-counter-factory
- :initform 'make-fixed-width-counter)))
-
-;;; TODO: document these
-;;;
-;;; ENCODER -- (lambda (src start end dest d-start) ...)
-;;; DECODER -- (lambda (src start end dest d-start) ...)
-;;;
-;;; OCTET-COUNTER -- (lambda (seq start end max-octets) ...)
-;;; CODE-POINT-COUNTER -- (lambda (seq start end max-chars) ...)
-;;; => N-CHARS NEW-END
-;;; (important: describe NEW-END)
-(defclass concrete-mapping ()
- ((encoder :accessor encoder)
- (decoder :accessor decoder)
- (octet-counter :accessor octet-counter)
- (code-point-counter :accessor code-point-counter)))
-
-(defparameter *abstract-mappings* (make-hash-table :test 'eq))
-
-(defun get-abstract-mapping (encoding)
- (gethash encoding *abstract-mappings*))
-
-(defun (setf get-abstract-mapping) (value encoding)
- (setf (gethash encoding *abstract-mappings*) value))
-
-(defun %register-mapping-part (encoding slot-name fn)
- (let ((mapping (get-abstract-mapping encoding)))
- (unless mapping
- (setq mapping (make-instance 'abstract-mapping))
- (setf (get-abstract-mapping encoding) mapping))
- (setf (slot-value mapping slot-name) fn)))
-
-;;; See enc-*.lisp for example usages of these 4 macros.
-
-(defmacro define-encoder (encoding (sa st da dt) &body body)
- `(%register-mapping-part ,encoding 'encoder-factory
- (named-lambda encoder (,sa ,st ,da ,dt)
- ,@body)))
-
-(defmacro define-decoder (encoding (sa st da dt) &body body)
- `(%register-mapping-part ,encoding 'decoder-factory
- (named-lambda decoder (,sa ,st ,da ,dt)
- ,@body)))
-
-(defmacro define-octet-counter (encoding (acc type) &body body)
- `(%register-mapping-part ,encoding 'octet-counter-factory
- (named-lambda octet-counter-factory (,acc ,type)
- ,@body)))
-
-(defmacro define-code-point-counter (encoding (acc type) &body body)
- `(%register-mapping-part ,encoding 'code-point-counter-factory
- (named-lambda code-point-counter (,acc ,type)
- ,@body)))
-
-(defun instantiate-encoder (encoding am octet-seq-getter octet-seq-type
- code-point-seq-setter code-point-seq-type)
- (declare (ignore encoding))
- (funcall (encoder-factory am)
- octet-seq-getter
- octet-seq-type
- code-point-seq-setter
- code-point-seq-type))
-
-(defun instantiate-decoder (encoding am octet-seq-getter octet-seq-type
- code-point-seq-setter code-point-seq-type)
- (declare (ignore encoding))
- (funcall (decoder-factory am)
- octet-seq-getter
- octet-seq-type
- code-point-seq-setter
- code-point-seq-type))
-
-(defun instantiate-code-point-counter (encoding am octet-seq-getter
- octet-seq-type)
- (declare (ignore encoding))
- (funcall (code-point-counter-factory am)
- octet-seq-getter
- octet-seq-type))
-
-(defun instantiate-octet-counter (encoding am code-point-seq-getter
- code-point-seq-type)
- (if (= 1 (enc-max-units-per-char encoding))
- (make-fixed-width-counter code-point-seq-getter code-point-seq-type
- (enc-code-unit-size encoding))
- (funcall (octet-counter-factory am)
- code-point-seq-getter
- code-point-seq-type)))
-
-;;; Expands into code generated by the available abstract mappings
-;;; that will be compiled into concrete mappings. This is used in
-;;; e.g. strings.lisp to define mappings between strings and
-;;; (unsigned-byte 8) vectors.
-;;;
-;;; For each encoding funcall the abstract mappings at macro-expansion
-;;; time with the src/dest accessors and types to generate the
-;;; appropriate code for the concrete mappings. These functions are
-;;; then saved in their respective slots of the CONCRETE-MAPPING
-;;; object.
-(defmacro instantiate-concrete-mappings
- (&key (encodings (hash-table-keys *abstract-mappings*))
- (optimize '((speed 3) (debug 0) (compilation-speed 0)))
- octet-seq-getter octet-seq-setter octet-seq-type
- code-point-seq-getter code-point-seq-setter code-point-seq-type
- (instantiate-decoders t))
- `(let ((ht (make-hash-table :test 'eq)))
- (declare (optimize ,@optimize)
- #+sbcl (sb-ext:muffle-conditions sb-ext:compiler-note))
- (flet ((notice-mapping (encoding-name cm)
- (let* ((encoding (get-character-encoding encoding-name))
- (aliases (enc-aliases encoding)))
- (dolist (kw (cons (enc-name encoding) aliases))
- (setf (gethash kw ht) cm)))))
- ,@(loop for encoding-name in encodings
- for encoding = (get-character-encoding encoding-name)
- for am = (gethash encoding-name *abstract-mappings*)
- collect
- `(let ((cm (make-instance 'concrete-mapping)))
- (setf (encoder cm)
- ,(instantiate-encoder encoding am
- code-point-seq-getter
- code-point-seq-type
- octet-seq-setter
- octet-seq-type))
- ,(when instantiate-decoders
- `(progn
- (setf (decoder cm)
- ,(instantiate-decoder encoding am
- octet-seq-getter
- octet-seq-type
- code-point-seq-setter
- code-point-seq-type))
- (setf (code-point-counter cm)
- ,(instantiate-code-point-counter
- encoding am octet-seq-getter octet-seq-type))))
- (setf (octet-counter cm)
- ,(instantiate-octet-counter encoding am
- code-point-seq-getter
- code-point-seq-type))
- (notice-mapping ,encoding-name cm))))
- ht))
-
-;;; debugging stuff
-
-#-(and)
-(defun pprint-instantiate-concrete-mappings
- (&key (encodings (hash-table-keys *abstract-mappings*))
- (optimize '((debug 3) (safety 3)))
- (octet-seq-setter 'ub-set) (octet-seq-getter 'ub-get)
- (octet-seq-type '(simple-array (unsigned-byte 8) (*)))
- (code-point-seq-setter 'string-set)
- (code-point-seq-getter 'string-get)
- (code-point-seq-type 'simple-unicode-string))
- (let ((encodings (ensure-list encodings))
- (*package* (find-package :babel-encodings))
- (*print-case* :downcase))
- (pprint
- (macroexpand
- `(instantiate-concrete-mappings
- :encodings ,encodings
- :optimize ,optimize
- :octet-seq-getter ,octet-seq-getter
- :octet-seq-setter ,octet-seq-setter
- :octet-seq-type ,octet-seq-type
- :code-point-seq-getter ,code-point-seq-getter
- :code-point-seq-setter ,code-point-seq-setter
- :code-point-seq-type ,code-point-seq-type))))
- (values))
-
-;;;; Utilities used in enc-*.lisp
-
-(defconstant +default-substitution-code-point+ #x1a
- "Default ASCII substitution character code point used in case of an encoding/decoding error.")
-
-;;; We're converting between objects of the (UNSIGNED-BYTE 8) and
-;;; (MOD #x110000) types which are aliased here to UB8 and CODE-POINT
-;;; for convenience.
-(deftype ub8 () '(unsigned-byte 8))
-(deftype code-point () '(mod #x110000))
-
-;;; Utility macro around DEFINE-ENCODER that takes care of most of the
-;;; work need to deal with an 8-bit, fixed-width character encoding.
-;;;
-;;; BODY will be inside a loop and its return value will placed in the
-;;; destination buffer. BODY will be surounded by lexical BLOCK which
-;;; will have the ENCODING's name, usually a keyword. It handles all
-;;; sorts of type declarations.
-;;;
-;;; See enc-ascii.lisp for a simple usage example.
-(defmacro define-unibyte-encoder (encoding (code) &body body)
- (with-unique-names (s-getter s-type d-setter d-type
- src start end dest d-start i di)
- `(define-encoder ,encoding (,s-getter ,s-type ,d-setter ,d-type)
- `(named-lambda ,',(symbolicate encoding '#:-unibyte-encoder)
- (,',src ,',start ,',end ,',dest ,',d-start)
- (declare (type ,,s-type ,',src)
- (type ,,d-type ,',dest)
- (fixnum ,',start ,',end ,',d-start))
- (loop for ,',i fixnum from ,',start below ,',end
- and ,',di fixnum from ,',d-start do
- (,,d-setter
- (macrolet
- ;; this should probably be a function...
- ((handle-error (&optional (c ''character-encoding-error))
- `(encoding-error
- ,',',code ,',',encoding ,',',src ,',',i
- +default-substitution-code-point+ ,c)))
- (let ((,',code (,,s-getter ,',src ,',i)))
- (declare (type code-point ,',code))
- (block ,',encoding ,@',body)))
- ,',dest ,',di)
- finally (return (the fixnum (- ,',di ,',d-start))))))))
-
-;;; The decoder version of the above macro.
-(defmacro define-unibyte-decoder (encoding (octet) &body body)
- (with-unique-names (s-getter s-type d-setter d-type
- src start end dest d-start i di)
- `(define-decoder ,encoding (,s-getter ,s-type ,d-setter ,d-type)
- `(named-lambda ,',(symbolicate encoding '#:-unibyte-encoder)
- (,',src ,',start ,',end ,',dest ,',d-start)
- (declare (type ,,s-type ,',src)
- (type ,,d-type ,',dest)
- (fixnum ,',start ,',end ,',d-start))
- (loop for ,',i fixnum from ,',start below ,',end
- and ,',di fixnum from ,',d-start do
- (,,d-setter
- (macrolet
- ;; this should probably be a function...
- ((handle-error (&optional (c ''character-decoding-error))
- `(decoding-error
- (vector ,',',octet) ,',',encoding ,',',src ,',',i
- +default-substitution-code-point+ ,c)))
- (let ((,',octet (,,s-getter ,',src ,',i)))
- (declare (type ub8 ,',octet))
- (block ,',encoding ,@',body)))
- ,',dest ,',di)
- finally (return (the fixnum (- ,',di ,',d-start))))))))
-
-;;;; Error Conditions
-;;;
-;;; For now, we don't define any actual restarts. The only mechanism
-;;; for "restarting" a coding error is the
-;;; *SUPPRESS-CHARACTER-CODING-ERRORS* special variable which, when
-;;; bound to T (the default), suppresses any error and uses a default
-;;; replacement character instead.
-;;;
-;;; If it turns out that other more options are necessary, possible
-;;; alternative approaches include:
-;;;
-;;; a) use a *REPLACEMENT-CHARACTER* special variable that lets us
-;;; pick our own replacement character. The encoder must do
-;;; additional work to check if this is character is encodable.
-;;;
-;;; b) offer a restart to pick a replacement character. Same
-;;; problem as above.
-;;;
-;;; Both approaches pose encoding problems when dealing with a
-;;; variable-width encodings because different replacement characters
-;;; will need different numbers of octets. This is not a problem for
-;;; UTF but will be a problem for the CJK charsets. Approach (a) is
-;;; nevertheless easier since the replacement character is known in
-;;; advance and therefore the octet-counter can account for it.
-;;;
-;;; For more complex restarts like SBCL's -- that'll let you specify
-;;; _several_ replacement characters for a single character error --
-;;; will probably need extra support code outside the encoder/decoder
-;;; (i.e. in the string-to-octets function, for example) since the
-;;; encoders/decoders deal with pre-allocated fixed-length buffers.
-;;;
-;;; SBCL has ASCII-specific (MALFORMED-ASCII) and UTF8-specific
-;;; errors. Why? Do we want to add some of those too?
-
-;;; FIXME: We used to deal with this with an extra ERRORP argument for
-;;; encoders, decoders, etc... Still undecided on the best way to do
-;;; it. We could also use a simple restart instead of this...
-;;;
-;;; In any case, this is not for the users to bind and it's not
-;;; exported from the BABEL package.
-(defvar *suppress-character-coding-errors* nil
- "If non-NIL, encoding or decoding errors are suppressed and the
-the current character encoding's default replacement character is
-used.")
-
-;;; All of Babel's error conditions are subtypes of
-;;; CHARACTER-CODING-ERROR. This error hierarchy is based on SBCL's.
-(define-condition character-coding-error (error)
- ((buffer :initarg :buffer :reader character-coding-error-buffer)
- (position :initarg :position :reader character-coding-error-position)
- (encoding :initarg :encoding :reader character-coding-error-encoding)))
-
-(define-condition character-encoding-error (character-coding-error)
- ((code :initarg :code :reader character-encoding-error-code))
- (:report (lambda (c s)
- (format s "Unable to encode character code point ~A as ~S."
- (character-encoding-error-code c)
- (character-coding-error-encoding c)))))
-
-(declaim (inline encoding-error))
-(defun encoding-error (code enc buf pos &optional
- (sub +default-substitution-code-point+)
- (e 'character-encoding-error))
- (unless *suppress-character-coding-errors*
- (error e :encoding enc :buffer buf :position pos :code code))
- sub)
-
-(define-condition character-decoding-error (character-coding-error)
- ((octets :initarg :octets :reader character-decoding-error-octets))
- (:report (lambda (c s)
- (format s "Illegal ~S character starting at position ~D."
- (character-coding-error-encoding c)
- (character-coding-error-position c)))))
-
-(define-condition end-of-input-in-character (character-decoding-error)
- ()
- (:documentation "Signalled by DECODERs or CODE-POINT-COUNTERs
-of variable-width character encodings."))
-
-(define-condition character-out-of-range (character-decoding-error)
- ()
- (:documentation
- "Signalled when the character being decoded is out of range."))
-
-(declaim (inline decoding-error))
-(defun decoding-error (octets enc buf pos &optional
- (sub +default-substitution-code-point+)
- (e 'character-decoding-error))
- (unless *suppress-character-coding-errors*
- (error e :octets octets :encoding enc :buffer buf :position pos))
- sub)
(DIR) diff --git a/3rdparties/software/babel-20171227-git/src/external-format.lisp b/3rdparties/software/babel-20171227-git/src/external-format.lisp
@@ -1,88 +0,0 @@
-;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
-;;;
-;;; external-format.lisp --- External format classes and functions.
-;;;
-;;; Copyright (C) 2007, Luis Oliveira <loliveira@common-lisp.net>
-;;;
-;;; Permission is hereby granted, free of charge, to any person
-;;; obtaining a copy of this software and associated documentation
-;;; files (the "Software"), to deal in the Software without
-;;; restriction, including without limitation the rights to use, copy,
-;;; modify, merge, publish, distribute, sublicense, and/or sell copies
-;;; of the Software, and to permit persons to whom the Software is
-;;; furnished to do so, subject to the following conditions:
-;;;
-;;; The above copyright notice and this permission notice shall be
-;;; included in all copies or substantial portions of the Software.
-;;;
-;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
-;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
-;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
-;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
-;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
-;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
-;;; DEALINGS IN THE SOFTWARE.
-
-(in-package #:babel)
-
-(defvar *default-eol-style*
- #+windows :crlf
- #-windows :lf
- "The end-of-line style used by external formats if none is
-explicitly given. Depends on the OS the code is compiled on.")
-
-(deftype eol-style ()
- "Possible end-of-line styles."
- '(member :cr :lf :crlf))
-
-(defclass external-format ()
- ((encoding :initarg :encoding :reader external-format-encoding
- :type character-encoding)
- (eol-style :initarg :eol-style :reader external-format-eol-style
- :type eol-style :initform *default-eol-style*))
- (:documentation
- "An EXTERNAL-FORMAT consists in a combination of a Babel
-CHARACTER-ENCODING and an end-of-line style."))
-
-(defmethod print-object ((ef external-format) stream)
- (print-unreadable-object (ef stream :type t :identity t)
- (format stream "~A ~A"
- (enc-name (external-format-encoding ef))
- (external-format-eol-style ef))))
-
-;;; This interface is still somewhat sketchy. The rest of Babel
-;;; doesn't really understand external formats, for instance.
-(defun make-external-format (encoding &key (eol-style *default-eol-style*))
- (check-type eol-style eol-style)
- (make-instance 'external-format
- :encoding (get-character-encoding encoding)
- :eol-style eol-style))
-
-(defun ensure-external-format (thing)
- (etypecase thing
- (external-format thing)
- (character-encoding (make-instance 'external-format :encoding thing))
- (symbol (make-external-format thing))
- (list (apply #'make-external-format thing))))
-
-(defun external-format-equal (ef1 ef2)
- (and (eq (external-format-encoding ef1) (external-format-encoding ef2))
- (eq (external-format-eol-style ef1) (external-format-eol-style ef2))))
-
-(declaim (inline lookup-mapping))
-(defun lookup-mapping (ht encoding)
- "HT should be an hashtable created by
-INSTANTIATE-CONCRETE-MAPPINGS. ENCODING should be either an
-external format, an encoding object or a keyword symbol
-denoting a character encoding name or one of its aliases."
- (or (etypecase encoding
- (keyword
- (gethash encoding ht))
- (babel-encodings::concrete-mapping
- encoding)
- (character-encoding
- (gethash (enc-name encoding) ht))
- (external-format
- (gethash (enc-name (external-format-encoding encoding)) ht)))
- (error "~S is not a valid encoding designator" encoding)))
(DIR) diff --git a/3rdparties/software/babel-20171227-git/src/gbk-map.lisp b/3rdparties/software/babel-20171227-git/src/gbk-map.lisp
@@ -1,2226 +0,0 @@
-;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
-;;;
-;;; gbk-map.lisp --- GBK encoding map.
-;;;
-;;; Copyright (C) 2011, Li Wenpeng <levin108@gmail.com>
-;;;
-;;; Permission is hereby granted, free of charge, to any person
-;;; obtaining a copy of this software and associated documentation
-;;; files (the "Software"), to deal in the Software without
-;;; restriction, including without limitation the rights to use, copy,
-;;; modify, merge, publish, distribute, sublicense, and/or sell copies
-;;; of the Software, and to permit persons to whom the Software is
-;;; furnished to do so, subject to the following conditions:
-;;;
-;;; The above copyright notice and this permission notice shall be
-;;; included in all copies or substantial portions of the Software.
-;;;
-;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
-;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
-;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
-;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
-;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
-;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
-;;; DEALINGS IN THE SOFTWARE.
-
-(in-package #:babel-encodings)
-
-(defparameter *gbk-unicode-mapping*
- (map 'babel:unicode-string
- #'code-char
- '(#x554A #x963F #x57C3 #x6328 #x54CE #x5509 #x54C0 #x7691 #x764C #x853C
- #x77EE #x827E #x788D #x7231 #x9698 #x978D #x6C28 #x5B89 #x4FFA #x6309
- #x6697 #x5CB8 #x80FA #x6848 #x80AE #x6602 #x76CE #x51F9 #x6556 #x71AC
- #x7FF1 #x8884 #x50B2 #x5965 #x61CA #x6FB3 #x82AD #x634C #x6252 #x53ED
- #x5427 #x7B06 #x516B #x75A4 #x5DF4 #x62D4 #x8DCB #x9776 #x628A #x8019
- #x575D #x9738 #x7F62 #x7238 #x767D #x67CF #x767E #x6446 #x4F70 #x8D25
- #x62DC #x7A17 #x6591 #x73ED #x642C #x6273 #x822C #x9881 #x677F #x7248
- #x626E #x62CC #x4F34 #x74E3 #x534A #x529E #x7ECA #x90A6 #x5E2E #x6886
- #x699C #x8180 #x7ED1 #x68D2 #x78C5 #x868C #x9551 #x508D #x8C24 #x82DE
- #x80DE #x5305 #x8912 #x5265 #x8584 #x96F9 #x4FDD #x5821 #x9971 #x5B9D
- #x62B1 #x62A5 #x66B4 #x8C79 #x9C8D #x7206 #x676F #x7891 #x60B2 #x5351
- #x5317 #x8F88 #x80CC #x8D1D #x94A1 #x500D #x72C8 #x5907 #x60EB #x7119
- #x88AB #x5954 #x82EF #x672C #x7B28 #x5D29 #x7EF7 #x752D #x6CF5 #x8E66
- #x8FF8 #x903C #x9F3B #x6BD4 #x9119 #x7B14 #x5F7C #x78A7 #x84D6 #x853D
- #x6BD5 #x6BD9 #x6BD6 #x5E01 #x5E87 #x75F9 #x95ED #x655D #x5F0A #x5FC5
- #x8F9F #x58C1 #x81C2 #x907F #x965B #x97AD #x8FB9 #x7F16 #x8D2C #x6241
- #x4FBF #x53D8 #x535E #x8FA8 #x8FA9 #x8FAB #x904D #x6807 #x5F6A #x8198
- #x8868 #x9CD6 #x618B #x522B #x762A #x5F6C #x658C #x6FD2 #x6EE8 #x5BBE
- #x6448 #x5175 #x51B0 #x67C4 #x4E19 #x79C9 #x997C #x70B3 #x75C5 #x5E76
- #x73BB #x83E0 #x64AD #x62E8 #x94B5 #x6CE2 #x535A #x52C3 #x640F #x94C2
- #x7B94 #x4F2F #x5E1B #x8236 #x8116 #x818A #x6E24 #x6CCA #x9A73 #x6355
- #x535C #x54FA #x8865 #x57E0 #x4E0D #x5E03 #x6B65 #x7C3F #x90E8 #x6016
- #x64E6 #x731C #x88C1 #x6750 #x624D #x8D22 #x776C #x8E29 #x91C7 #x5F69
- #x83DC #x8521 #x9910 #x53C2 #x8695 #x6B8B #x60ED #x60E8 #x707F #x82CD
- #x8231 #x4ED3 #x6CA7 #x85CF #x64CD #x7CD9 #x69FD #x66F9 #x8349 #x5395
- #x7B56 #x4FA7 #x518C #x6D4B #x5C42 #x8E6D #x63D2 #x53C9 #x832C #x8336
- #x67E5 #x78B4 #x643D #x5BDF #x5C94 #x5DEE #x8BE7 #x62C6 #x67F4 #x8C7A
- #x6400 #x63BA #x8749 #x998B #x8C17 #x7F20 #x94F2 #x4EA7 #x9610 #x98A4
- #x660C #x7316 #x573A #x5C1D #x5E38 #x957F #x507F #x80A0 #x5382 #x655E
- #x7545 #x5531 #x5021 #x8D85 #x6284 #x949E #x671D #x5632 #x6F6E #x5DE2
- #x5435 #x7092 #x8F66 #x626F #x64A4 #x63A3 #x5F7B #x6F88 #x90F4 #x81E3
- #x8FB0 #x5C18 #x6668 #x5FF1 #x6C89 #x9648 #x8D81 #x886C #x6491 #x79F0
- #x57CE #x6A59 #x6210 #x5448 #x4E58 #x7A0B #x60E9 #x6F84 #x8BDA #x627F
- #x901E #x9A8B #x79E4 #x5403 #x75F4 #x6301 #x5319 #x6C60 #x8FDF #x5F1B
- #x9A70 #x803B #x9F7F #x4F88 #x5C3A #x8D64 #x7FC5 #x65A5 #x70BD #x5145
- #x51B2 #x866B #x5D07 #x5BA0 #x62BD #x916C #x7574 #x8E0C #x7A20 #x6101
- #x7B79 #x4EC7 #x7EF8 #x7785 #x4E11 #x81ED #x521D #x51FA #x6A71 #x53A8
- #x8E87 #x9504 #x96CF #x6EC1 #x9664 #x695A #x7840 #x50A8 #x77D7 #x6410
- #x89E6 #x5904 #x63E3 #x5DDD #x7A7F #x693D #x4F20 #x8239 #x5598 #x4E32
- #x75AE #x7A97 #x5E62 #x5E8A #x95EF #x521B #x5439 #x708A #x6376 #x9524
- #x5782 #x6625 #x693F #x9187 #x5507 #x6DF3 #x7EAF #x8822 #x6233 #x7EF0
- #x75B5 #x8328 #x78C1 #x96CC #x8F9E #x6148 #x74F7 #x8BCD #x6B64 #x523A
- #x8D50 #x6B21 #x806A #x8471 #x56F1 #x5306 #x4ECE #x4E1B #x51D1 #x7C97
- #x918B #x7C07 #x4FC3 #x8E7F #x7BE1 #x7A9C #x6467 #x5D14 #x50AC #x8106
- #x7601 #x7CB9 #x6DEC #x7FE0 #x6751 #x5B58 #x5BF8 #x78CB #x64AE #x6413
- #x63AA #x632B #x9519 #x642D #x8FBE #x7B54 #x7629 #x6253 #x5927 #x5446
- #x6B79 #x50A3 #x6234 #x5E26 #x6B86 #x4EE3 #x8D37 #x888B #x5F85 #x902E
- #x6020 #x803D #x62C5 #x4E39 #x5355 #x90F8 #x63B8 #x80C6 #x65E6 #x6C2E
- #x4F46 #x60EE #x6DE1 #x8BDE #x5F39 #x86CB #x5F53 #x6321 #x515A #x8361
- #x6863 #x5200 #x6363 #x8E48 #x5012 #x5C9B #x7977 #x5BFC #x5230 #x7A3B
- #x60BC #x9053 #x76D7 #x5FB7 #x5F97 #x7684 #x8E6C #x706F #x767B #x7B49
- #x77AA #x51F3 #x9093 #x5824 #x4F4E #x6EF4 #x8FEA #x654C #x7B1B #x72C4
- #x6DA4 #x7FDF #x5AE1 #x62B5 #x5E95 #x5730 #x8482 #x7B2C #x5E1D #x5F1F
- #x9012 #x7F14 #x98A0 #x6382 #x6EC7 #x7898 #x70B9 #x5178 #x975B #x57AB
- #x7535 #x4F43 #x7538 #x5E97 #x60E6 #x5960 #x6DC0 #x6BBF #x7889 #x53FC
- #x96D5 #x51CB #x5201 #x6389 #x540A #x9493 #x8C03 #x8DCC #x7239 #x789F
- #x8776 #x8FED #x8C0D #x53E0 #x4E01 #x76EF #x53EE #x9489 #x9876 #x9F0E
- #x952D #x5B9A #x8BA2 #x4E22 #x4E1C #x51AC #x8463 #x61C2 #x52A8 #x680B
- #x4F97 #x606B #x51BB #x6D1E #x515C #x6296 #x6597 #x9661 #x8C46 #x9017
- #x75D8 #x90FD #x7763 #x6BD2 #x728A #x72EC #x8BFB #x5835 #x7779 #x8D4C
- #x675C #x9540 #x809A #x5EA6 #x6E21 #x5992 #x7AEF #x77ED #x953B #x6BB5
- #x65AD #x7F0E #x5806 #x5151 #x961F #x5BF9 #x58A9 #x5428 #x8E72 #x6566
- #x987F #x56E4 #x949D #x76FE #x9041 #x6387 #x54C6 #x591A #x593A #x579B
- #x8EB2 #x6735 #x8DFA #x8235 #x5241 #x60F0 #x5815 #x86FE #x5CE8 #x9E45
- #x4FC4 #x989D #x8BB9 #x5A25 #x6076 #x5384 #x627C #x904F #x9102 #x997F
- #x6069 #x800C #x513F #x8033 #x5C14 #x9975 #x6D31 #x4E8C #x8D30 #x53D1
- #x7F5A #x7B4F #x4F10 #x4E4F #x9600 #x6CD5 #x73D0 #x85E9 #x5E06 #x756A
- #x7FFB #x6A0A #x77FE #x9492 #x7E41 #x51E1 #x70E6 #x53CD #x8FD4 #x8303
- #x8D29 #x72AF #x996D #x6CDB #x574A #x82B3 #x65B9 #x80AA #x623F #x9632
- #x59A8 #x4EFF #x8BBF #x7EBA #x653E #x83F2 #x975E #x5561 #x98DE #x80A5
- #x532A #x8BFD #x5420 #x80BA #x5E9F #x6CB8 #x8D39 #x82AC #x915A #x5429
- #x6C1B #x5206 #x7EB7 #x575F #x711A #x6C7E #x7C89 #x594B #x4EFD #x5FFF
- #x6124 #x7CAA #x4E30 #x5C01 #x67AB #x8702 #x5CF0 #x950B #x98CE #x75AF
- #x70FD #x9022 #x51AF #x7F1D #x8BBD #x5949 #x51E4 #x4F5B #x5426 #x592B
- #x6577 #x80A4 #x5B75 #x6276 #x62C2 #x8F90 #x5E45 #x6C1F #x7B26 #x4F0F
- #x4FD8 #x670D #x6D6E #x6DAA #x798F #x88B1 #x5F17 #x752B #x629A #x8F85
- #x4FEF #x91DC #x65A7 #x812F #x8151 #x5E9C #x8150 #x8D74 #x526F #x8986
- #x8D4B #x590D #x5085 #x4ED8 #x961C #x7236 #x8179 #x8D1F #x5BCC #x8BA3
- #x9644 #x5987 #x7F1A #x5490 #x5676 #x560E #x8BE5 #x6539 #x6982 #x9499
- #x76D6 #x6E89 #x5E72 #x7518 #x6746 #x67D1 #x7AFF #x809D #x8D76 #x611F
- #x79C6 #x6562 #x8D63 #x5188 #x521A #x94A2 #x7F38 #x809B #x7EB2 #x5C97
- #x6E2F #x6760 #x7BD9 #x768B #x9AD8 #x818F #x7F94 #x7CD5 #x641E #x9550
- #x7A3F #x544A #x54E5 #x6B4C #x6401 #x6208 #x9E3D #x80F3 #x7599 #x5272
- #x9769 #x845B #x683C #x86E4 #x9601 #x9694 #x94EC #x4E2A #x5404 #x7ED9
- #x6839 #x8DDF #x8015 #x66F4 #x5E9A #x7FB9 #x57C2 #x803F #x6897 #x5DE5
- #x653B #x529F #x606D #x9F9A #x4F9B #x8EAC #x516C #x5BAB #x5F13 #x5DE9
- #x6C5E #x62F1 #x8D21 #x5171 #x94A9 #x52FE #x6C9F #x82DF #x72D7 #x57A2
- #x6784 #x8D2D #x591F #x8F9C #x83C7 #x5495 #x7B8D #x4F30 #x6CBD #x5B64
- #x59D1 #x9F13 #x53E4 #x86CA #x9AA8 #x8C37 #x80A1 #x6545 #x987E #x56FA
- #x96C7 #x522E #x74DC #x5250 #x5BE1 #x6302 #x8902 #x4E56 #x62D0 #x602A
- #x68FA #x5173 #x5B98 #x51A0 #x89C2 #x7BA1 #x9986 #x7F50 #x60EF #x704C
- #x8D2F #x5149 #x5E7F #x901B #x7470 #x89C4 #x572D #x7845 #x5F52 #x9F9F
- #x95FA #x8F68 #x9B3C #x8BE1 #x7678 #x6842 #x67DC #x8DEA #x8D35 #x523D
- #x8F8A #x6EDA #x68CD #x9505 #x90ED #x56FD #x679C #x88F9 #x8FC7 #x54C8
- #x9AB8 #x5B69 #x6D77 #x6C26 #x4EA5 #x5BB3 #x9A87 #x9163 #x61A8 #x90AF
- #x97E9 #x542B #x6DB5 #x5BD2 #x51FD #x558A #x7F55 #x7FF0 #x64BC #x634D
- #x65F1 #x61BE #x608D #x710A #x6C57 #x6C49 #x592F #x676D #x822A #x58D5
- #x568E #x8C6A #x6BEB #x90DD #x597D #x8017 #x53F7 #x6D69 #x5475 #x559D
- #x8377 #x83CF #x6838 #x79BE #x548C #x4F55 #x5408 #x76D2 #x8C89 #x9602
- #x6CB3 #x6DB8 #x8D6B #x8910 #x9E64 #x8D3A #x563F #x9ED1 #x75D5 #x5F88
- #x72E0 #x6068 #x54FC #x4EA8 #x6A2A #x8861 #x6052 #x8F70 #x54C4 #x70D8
- #x8679 #x9E3F #x6D2A #x5B8F #x5F18 #x7EA2 #x5589 #x4FAF #x7334 #x543C
- #x539A #x5019 #x540E #x547C #x4E4E #x5FFD #x745A #x58F6 #x846B #x80E1
- #x8774 #x72D0 #x7CCA #x6E56 #x5F27 #x864E #x552C #x62A4 #x4E92 #x6CAA
- #x6237 #x82B1 #x54D7 #x534E #x733E #x6ED1 #x753B #x5212 #x5316 #x8BDD
- #x69D0 #x5F8A #x6000 #x6DEE #x574F #x6B22 #x73AF #x6853 #x8FD8 #x7F13
- #x6362 #x60A3 #x5524 #x75EA #x8C62 #x7115 #x6DA3 #x5BA6 #x5E7B #x8352
- #x614C #x9EC4 #x78FA #x8757 #x7C27 #x7687 #x51F0 #x60F6 #x714C #x6643
- #x5E4C #x604D #x8C0E #x7070 #x6325 #x8F89 #x5FBD #x6062 #x86D4 #x56DE
- #x6BC1 #x6094 #x6167 #x5349 #x60E0 #x6666 #x8D3F #x79FD #x4F1A #x70E9
- #x6C47 #x8BB3 #x8BF2 #x7ED8 #x8364 #x660F #x5A5A #x9B42 #x6D51 #x6DF7
- #x8C41 #x6D3B #x4F19 #x706B #x83B7 #x6216 #x60D1 #x970D #x8D27 #x7978
- #x51FB #x573E #x57FA #x673A #x7578 #x7A3D #x79EF #x7B95 #x808C #x9965
- #x8FF9 #x6FC0 #x8BA5 #x9E21 #x59EC #x7EE9 #x7F09 #x5409 #x6781 #x68D8
- #x8F91 #x7C4D #x96C6 #x53CA #x6025 #x75BE #x6C72 #x5373 #x5AC9 #x7EA7
- #x6324 #x51E0 #x810A #x5DF1 #x84DF #x6280 #x5180 #x5B63 #x4F0E #x796D
- #x5242 #x60B8 #x6D4E #x5BC4 #x5BC2 #x8BA1 #x8BB0 #x65E2 #x5FCC #x9645
- #x5993 #x7EE7 #x7EAA #x5609 #x67B7 #x5939 #x4F73 #x5BB6 #x52A0 #x835A
- #x988A #x8D3E #x7532 #x94BE #x5047 #x7A3C #x4EF7 #x67B6 #x9A7E #x5AC1
- #x6B7C #x76D1 #x575A #x5C16 #x7B3A #x95F4 #x714E #x517C #x80A9 #x8270
- #x5978 #x7F04 #x8327 #x68C0 #x67EC #x78B1 #x7877 #x62E3 #x6361 #x7B80
- #x4FED #x526A #x51CF #x8350 #x69DB #x9274 #x8DF5 #x8D31 #x89C1 #x952E
- #x7BAD #x4EF6 #x5065 #x8230 #x5251 #x996F #x6E10 #x6E85 #x6DA7 #x5EFA
- #x50F5 #x59DC #x5C06 #x6D46 #x6C5F #x7586 #x848B #x6868 #x5956 #x8BB2
- #x5320 #x9171 #x964D #x8549 #x6912 #x7901 #x7126 #x80F6 #x4EA4 #x90CA
- #x6D47 #x9A84 #x5A07 #x56BC #x6405 #x94F0 #x77EB #x4FA5 #x811A #x72E1
- #x89D2 #x997A #x7F34 #x7EDE #x527F #x6559 #x9175 #x8F7F #x8F83 #x53EB
- #x7A96 #x63ED #x63A5 #x7686 #x79F8 #x8857 #x9636 #x622A #x52AB #x8282
- #x6854 #x6770 #x6377 #x776B #x7AED #x6D01 #x7ED3 #x89E3 #x59D0 #x6212
- #x85C9 #x82A5 #x754C #x501F #x4ECB #x75A5 #x8BEB #x5C4A #x5DFE #x7B4B
- #x65A4 #x91D1 #x4ECA #x6D25 #x895F #x7D27 #x9526 #x4EC5 #x8C28 #x8FDB
- #x9773 #x664B #x7981 #x8FD1 #x70EC #x6D78 #x5C3D #x52B2 #x8346 #x5162
- #x830E #x775B #x6676 #x9CB8 #x4EAC #x60CA #x7CBE #x7CB3 #x7ECF #x4E95
- #x8B66 #x666F #x9888 #x9759 #x5883 #x656C #x955C #x5F84 #x75C9 #x9756
- #x7ADF #x7ADE #x51C0 #x70AF #x7A98 #x63EA #x7A76 #x7EA0 #x7396 #x97ED
- #x4E45 #x7078 #x4E5D #x9152 #x53A9 #x6551 #x65E7 #x81FC #x8205 #x548E
- #x5C31 #x759A #x97A0 #x62D8 #x72D9 #x75BD #x5C45 #x9A79 #x83CA #x5C40
- #x5480 #x77E9 #x4E3E #x6CAE #x805A #x62D2 #x636E #x5DE8 #x5177 #x8DDD
- #x8E1E #x952F #x4FF1 #x53E5 #x60E7 #x70AC #x5267 #x6350 #x9E43 #x5A1F
- #x5026 #x7737 #x5377 #x7EE2 #x6485 #x652B #x6289 #x6398 #x5014 #x7235
- #x89C9 #x51B3 #x8BC0 #x7EDD #x5747 #x83CC #x94A7 #x519B #x541B #x5CFB
- #x4FCA #x7AE3 #x6D5A #x90E1 #x9A8F #x5580 #x5496 #x5361 #x54AF #x5F00
- #x63E9 #x6977 #x51EF #x6168 #x520A #x582A #x52D8 #x574E #x780D #x770B
- #x5EB7 #x6177 #x7CE0 #x625B #x6297 #x4EA2 #x7095 #x8003 #x62F7 #x70E4
- #x9760 #x5777 #x82DB #x67EF #x68F5 #x78D5 #x9897 #x79D1 #x58F3 #x54B3
- #x53EF #x6E34 #x514B #x523B #x5BA2 #x8BFE #x80AF #x5543 #x57A6 #x6073
- #x5751 #x542D #x7A7A #x6050 #x5B54 #x63A7 #x62A0 #x53E3 #x6263 #x5BC7
- #x67AF #x54ED #x7A9F #x82E6 #x9177 #x5E93 #x88E4 #x5938 #x57AE #x630E
- #x8DE8 #x80EF #x5757 #x7B77 #x4FA9 #x5FEB #x5BBD #x6B3E #x5321 #x7B50
- #x72C2 #x6846 #x77FF #x7736 #x65F7 #x51B5 #x4E8F #x76D4 #x5CBF #x7AA5
- #x8475 #x594E #x9B41 #x5080 #x9988 #x6127 #x6E83 #x5764 #x6606 #x6346
- #x56F0 #x62EC #x6269 #x5ED3 #x9614 #x5783 #x62C9 #x5587 #x8721 #x814A
- #x8FA3 #x5566 #x83B1 #x6765 #x8D56 #x84DD #x5A6A #x680F #x62E6 #x7BEE
- #x9611 #x5170 #x6F9C #x8C30 #x63FD #x89C8 #x61D2 #x7F06 #x70C2 #x6EE5
- #x7405 #x6994 #x72FC #x5ECA #x90CE #x6717 #x6D6A #x635E #x52B3 #x7262
- #x8001 #x4F6C #x59E5 #x916A #x70D9 #x6D9D #x52D2 #x4E50 #x96F7 #x956D
- #x857E #x78CA #x7D2F #x5121 #x5792 #x64C2 #x808B #x7C7B #x6CEA #x68F1
- #x695E #x51B7 #x5398 #x68A8 #x7281 #x9ECE #x7BF1 #x72F8 #x79BB #x6F13
- #x7406 #x674E #x91CC #x9CA4 #x793C #x8389 #x8354 #x540F #x6817 #x4E3D
- #x5389 #x52B1 #x783E #x5386 #x5229 #x5088 #x4F8B #x4FD0 #x75E2 #x7ACB
- #x7C92 #x6CA5 #x96B6 #x529B #x7483 #x54E9 #x4FE9 #x8054 #x83B2 #x8FDE
- #x9570 #x5EC9 #x601C #x6D9F #x5E18 #x655B #x8138 #x94FE #x604B #x70BC
- #x7EC3 #x7CAE #x51C9 #x6881 #x7CB1 #x826F #x4E24 #x8F86 #x91CF #x667E
- #x4EAE #x8C05 #x64A9 #x804A #x50DA #x7597 #x71CE #x5BE5 #x8FBD #x6F66
- #x4E86 #x6482 #x9563 #x5ED6 #x6599 #x5217 #x88C2 #x70C8 #x52A3 #x730E
- #x7433 #x6797 #x78F7 #x9716 #x4E34 #x90BB #x9CDE #x6DCB #x51DB #x8D41
- #x541D #x62CE #x73B2 #x83F1 #x96F6 #x9F84 #x94C3 #x4F36 #x7F9A #x51CC
- #x7075 #x9675 #x5CAD #x9886 #x53E6 #x4EE4 #x6E9C #x7409 #x69B4 #x786B
- #x998F #x7559 #x5218 #x7624 #x6D41 #x67F3 #x516D #x9F99 #x804B #x5499
- #x7B3C #x7ABF #x9686 #x5784 #x62E2 #x9647 #x697C #x5A04 #x6402 #x7BD3
- #x6F0F #x964B #x82A6 #x5362 #x9885 #x5E90 #x7089 #x63B3 #x5364 #x864F
- #x9C81 #x9E93 #x788C #x9732 #x8DEF #x8D42 #x9E7F #x6F5E #x7984 #x5F55
- #x9646 #x622E #x9A74 #x5415 #x94DD #x4FA3 #x65C5 #x5C65 #x5C61 #x7F15
- #x8651 #x6C2F #x5F8B #x7387 #x6EE4 #x7EFF #x5CE6 #x631B #x5B6A #x6EE6
- #x5375 #x4E71 #x63A0 #x7565 #x62A1 #x8F6E #x4F26 #x4ED1 #x6CA6 #x7EB6
- #x8BBA #x841D #x87BA #x7F57 #x903B #x9523 #x7BA9 #x9AA1 #x88F8 #x843D
- #x6D1B #x9A86 #x7EDC #x5988 #x9EBB #x739B #x7801 #x8682 #x9A6C #x9A82
- #x561B #x5417 #x57CB #x4E70 #x9EA6 #x5356 #x8FC8 #x8109 #x7792 #x9992
- #x86EE #x6EE1 #x8513 #x66FC #x6162 #x6F2B #x8C29 #x8292 #x832B #x76F2
- #x6C13 #x5FD9 #x83BD #x732B #x8305 #x951A #x6BDB #x77DB #x94C6 #x536F
- #x8302 #x5192 #x5E3D #x8C8C #x8D38 #x4E48 #x73AB #x679A #x6885 #x9176
- #x9709 #x7164 #x6CA1 #x7709 #x5A92 #x9541 #x6BCF #x7F8E #x6627 #x5BD0
- #x59B9 #x5A9A #x95E8 #x95F7 #x4EEC #x840C #x8499 #x6AAC #x76DF #x9530
- #x731B #x68A6 #x5B5F #x772F #x919A #x9761 #x7CDC #x8FF7 #x8C1C #x5F25
- #x7C73 #x79D8 #x89C5 #x6CCC #x871C #x5BC6 #x5E42 #x68C9 #x7720 #x7EF5
- #x5195 #x514D #x52C9 #x5A29 #x7F05 #x9762 #x82D7 #x63CF #x7784 #x85D0
- #x79D2 #x6E3A #x5E99 #x5999 #x8511 #x706D #x6C11 #x62BF #x76BF #x654F
- #x60AF #x95FD #x660E #x879F #x9E23 #x94ED #x540D #x547D #x8C2C #x6478
- #x6479 #x8611 #x6A21 #x819C #x78E8 #x6469 #x9B54 #x62B9 #x672B #x83AB
- #x58A8 #x9ED8 #x6CAB #x6F20 #x5BDE #x964C #x8C0B #x725F #x67D0 #x62C7
- #x7261 #x4EA9 #x59C6 #x6BCD #x5893 #x66AE #x5E55 #x52DF #x6155 #x6728
- #x76EE #x7766 #x7267 #x7A46 #x62FF #x54EA #x5450 #x94A0 #x90A3 #x5A1C
- #x7EB3 #x6C16 #x4E43 #x5976 #x8010 #x5948 #x5357 #x7537 #x96BE #x56CA
- #x6320 #x8111 #x607C #x95F9 #x6DD6 #x5462 #x9981 #x5185 #x5AE9 #x80FD
- #x59AE #x9713 #x502A #x6CE5 #x5C3C #x62DF #x4F60 #x533F #x817B #x9006
- #x6EBA #x852B #x62C8 #x5E74 #x78BE #x64B5 #x637B #x5FF5 #x5A18 #x917F
- #x9E1F #x5C3F #x634F #x8042 #x5B7D #x556E #x954A #x954D #x6D85 #x60A8
- #x67E0 #x72DE #x51DD #x5B81 #x62E7 #x6CDE #x725B #x626D #x94AE #x7EBD
- #x8113 #x6D53 #x519C #x5F04 #x5974 #x52AA #x6012 #x5973 #x6696 #x8650
- #x759F #x632A #x61E6 #x7CEF #x8BFA #x54E6 #x6B27 #x9E25 #x6BB4 #x85D5
- #x5455 #x5076 #x6CA4 #x556A #x8DB4 #x722C #x5E15 #x6015 #x7436 #x62CD
- #x6392 #x724C #x5F98 #x6E43 #x6D3E #x6500 #x6F58 #x76D8 #x78D0 #x76FC
- #x7554 #x5224 #x53DB #x4E53 #x5E9E #x65C1 #x802A #x80D6 #x629B #x5486
- #x5228 #x70AE #x888D #x8DD1 #x6CE1 #x5478 #x80DA #x57F9 #x88F4 #x8D54
- #x966A #x914D #x4F69 #x6C9B #x55B7 #x76C6 #x7830 #x62A8 #x70F9 #x6F8E
- #x5F6D #x84EC #x68DA #x787C #x7BF7 #x81A8 #x670B #x9E4F #x6367 #x78B0
- #x576F #x7812 #x9739 #x6279 #x62AB #x5288 #x7435 #x6BD7 #x5564 #x813E
- #x75B2 #x76AE #x5339 #x75DE #x50FB #x5C41 #x8B6C #x7BC7 #x504F #x7247
- #x9A97 #x98D8 #x6F02 #x74E2 #x7968 #x6487 #x77A5 #x62FC #x9891 #x8D2B
- #x54C1 #x8058 #x4E52 #x576A #x82F9 #x840D #x5E73 #x51ED #x74F6 #x8BC4
- #x5C4F #x5761 #x6CFC #x9887 #x5A46 #x7834 #x9B44 #x8FEB #x7C95 #x5256
- #x6251 #x94FA #x4EC6 #x8386 #x8461 #x83E9 #x84B2 #x57D4 #x6734 #x5703
- #x666E #x6D66 #x8C31 #x66DD #x7011 #x671F #x6B3A #x6816 #x621A #x59BB
- #x4E03 #x51C4 #x6F06 #x67D2 #x6C8F #x5176 #x68CB #x5947 #x6B67 #x7566
- #x5D0E #x8110 #x9F50 #x65D7 #x7948 #x7941 #x9A91 #x8D77 #x5C82 #x4E5E
- #x4F01 #x542F #x5951 #x780C #x5668 #x6C14 #x8FC4 #x5F03 #x6C7D #x6CE3
- #x8BAB #x6390 #x6070 #x6D3D #x7275 #x6266 #x948E #x94C5 #x5343 #x8FC1
- #x7B7E #x4EDF #x8C26 #x4E7E #x9ED4 #x94B1 #x94B3 #x524D #x6F5C #x9063
- #x6D45 #x8C34 #x5811 #x5D4C #x6B20 #x6B49 #x67AA #x545B #x8154 #x7F8C
- #x5899 #x8537 #x5F3A #x62A2 #x6A47 #x9539 #x6572 #x6084 #x6865 #x77A7
- #x4E54 #x4FA8 #x5DE7 #x9798 #x64AC #x7FD8 #x5CED #x4FCF #x7A8D #x5207
- #x8304 #x4E14 #x602F #x7A83 #x94A6 #x4FB5 #x4EB2 #x79E6 #x7434 #x52E4
- #x82B9 #x64D2 #x79BD #x5BDD #x6C81 #x9752 #x8F7B #x6C22 #x503E #x537F
- #x6E05 #x64CE #x6674 #x6C30 #x60C5 #x9877 #x8BF7 #x5E86 #x743C #x7A77
- #x79CB #x4E18 #x90B1 #x7403 #x6C42 #x56DA #x914B #x6CC5 #x8D8B #x533A
- #x86C6 #x66F2 #x8EAF #x5C48 #x9A71 #x6E20 #x53D6 #x5A36 #x9F8B #x8DA3
- #x53BB #x5708 #x98A7 #x6743 #x919B #x6CC9 #x5168 #x75CA #x62F3 #x72AC
- #x5238 #x529D #x7F3A #x7094 #x7638 #x5374 #x9E4A #x69B7 #x786E #x96C0
- #x88D9 #x7FA4 #x7136 #x71C3 #x5189 #x67D3 #x74E4 #x58E4 #x6518 #x56B7
- #x8BA9 #x9976 #x6270 #x7ED5 #x60F9 #x70ED #x58EC #x4EC1 #x4EBA #x5FCD
- #x97E7 #x4EFB #x8BA4 #x5203 #x598A #x7EAB #x6254 #x4ECD #x65E5 #x620E
- #x8338 #x84C9 #x8363 #x878D #x7194 #x6EB6 #x5BB9 #x7ED2 #x5197 #x63C9
- #x67D4 #x8089 #x8339 #x8815 #x5112 #x5B7A #x5982 #x8FB1 #x4E73 #x6C5D
- #x5165 #x8925 #x8F6F #x962E #x854A #x745E #x9510 #x95F0 #x6DA6 #x82E5
- #x5F31 #x6492 #x6D12 #x8428 #x816E #x9CC3 #x585E #x8D5B #x4E09 #x53C1
- #x4F1E #x6563 #x6851 #x55D3 #x4E27 #x6414 #x9A9A #x626B #x5AC2 #x745F
- #x8272 #x6DA9 #x68EE #x50E7 #x838E #x7802 #x6740 #x5239 #x6C99 #x7EB1
- #x50BB #x5565 #x715E #x7B5B #x6652 #x73CA #x82EB #x6749 #x5C71 #x5220
- #x717D #x886B #x95EA #x9655 #x64C5 #x8D61 #x81B3 #x5584 #x6C55 #x6247
- #x7F2E #x5892 #x4F24 #x5546 #x8D4F #x664C #x4E0A #x5C1A #x88F3 #x68A2
- #x634E #x7A0D #x70E7 #x828D #x52FA #x97F6 #x5C11 #x54E8 #x90B5 #x7ECD
- #x5962 #x8D4A #x86C7 #x820C #x820D #x8D66 #x6444 #x5C04 #x6151 #x6D89
- #x793E #x8BBE #x7837 #x7533 #x547B #x4F38 #x8EAB #x6DF1 #x5A20 #x7EC5
- #x795E #x6C88 #x5BA1 #x5A76 #x751A #x80BE #x614E #x6E17 #x58F0 #x751F
- #x7525 #x7272 #x5347 #x7EF3 #x7701 #x76DB #x5269 #x80DC #x5723 #x5E08
- #x5931 #x72EE #x65BD #x6E7F #x8BD7 #x5C38 #x8671 #x5341 #x77F3 #x62FE
- #x65F6 #x4EC0 #x98DF #x8680 #x5B9E #x8BC6 #x53F2 #x77E2 #x4F7F #x5C4E
- #x9A76 #x59CB #x5F0F #x793A #x58EB #x4E16 #x67FF #x4E8B #x62ED #x8A93
- #x901D #x52BF #x662F #x55DC #x566C #x9002 #x4ED5 #x4F8D #x91CA #x9970
- #x6C0F #x5E02 #x6043 #x5BA4 #x89C6 #x8BD5 #x6536 #x624B #x9996 #x5B88
- #x5BFF #x6388 #x552E #x53D7 #x7626 #x517D #x852C #x67A2 #x68B3 #x6B8A
- #x6292 #x8F93 #x53D4 #x8212 #x6DD1 #x758F #x4E66 #x8D4E #x5B70 #x719F
- #x85AF #x6691 #x66D9 #x7F72 #x8700 #x9ECD #x9F20 #x5C5E #x672F #x8FF0
- #x6811 #x675F #x620D #x7AD6 #x5885 #x5EB6 #x6570 #x6F31 #x6055 #x5237
- #x800D #x6454 #x8870 #x7529 #x5E05 #x6813 #x62F4 #x971C #x53CC #x723D
- #x8C01 #x6C34 #x7761 #x7A0E #x542E #x77AC #x987A #x821C #x8BF4 #x7855
- #x6714 #x70C1 #x65AF #x6495 #x5636 #x601D #x79C1 #x53F8 #x4E1D #x6B7B
- #x8086 #x5BFA #x55E3 #x56DB #x4F3A #x4F3C #x9972 #x5DF3 #x677E #x8038
- #x6002 #x9882 #x9001 #x5B8B #x8BBC #x8BF5 #x641C #x8258 #x64DE #x55FD
- #x82CF #x9165 #x4FD7 #x7D20 #x901F #x7C9F #x50F3 #x5851 #x6EAF #x5BBF
- #x8BC9 #x8083 #x9178 #x849C #x7B97 #x867D #x968B #x968F #x7EE5 #x9AD3
- #x788E #x5C81 #x7A57 #x9042 #x96A7 #x795F #x5B59 #x635F #x7B0B #x84D1
- #x68AD #x5506 #x7F29 #x7410 #x7D22 #x9501 #x6240 #x584C #x4ED6 #x5B83
- #x5979 #x5854 #x736D #x631E #x8E4B #x8E0F #x80CE #x82D4 #x62AC #x53F0
- #x6CF0 #x915E #x592A #x6001 #x6C70 #x574D #x644A #x8D2A #x762B #x6EE9
- #x575B #x6A80 #x75F0 #x6F6D #x8C2D #x8C08 #x5766 #x6BEF #x8892 #x78B3
- #x63A2 #x53F9 #x70AD #x6C64 #x5858 #x642A #x5802 #x68E0 #x819B #x5510
- #x7CD6 #x5018 #x8EBA #x6DCC #x8D9F #x70EB #x638F #x6D9B #x6ED4 #x7EE6
- #x8404 #x6843 #x9003 #x6DD8 #x9676 #x8BA8 #x5957 #x7279 #x85E4 #x817E
- #x75BC #x8A8A #x68AF #x5254 #x8E22 #x9511 #x63D0 #x9898 #x8E44 #x557C
- #x4F53 #x66FF #x568F #x60D5 #x6D95 #x5243 #x5C49 #x5929 #x6DFB #x586B
- #x7530 #x751C #x606C #x8214 #x8146 #x6311 #x6761 #x8FE2 #x773A #x8DF3
- #x8D34 #x94C1 #x5E16 #x5385 #x542C #x70C3 #x6C40 #x5EF7 #x505C #x4EAD
- #x5EAD #x633A #x8247 #x901A #x6850 #x916E #x77B3 #x540C #x94DC #x5F64
- #x7AE5 #x6876 #x6345 #x7B52 #x7EDF #x75DB #x5077 #x6295 #x5934 #x900F
- #x51F8 #x79C3 #x7A81 #x56FE #x5F92 #x9014 #x6D82 #x5C60 #x571F #x5410
- #x5154 #x6E4D #x56E2 #x63A8 #x9893 #x817F #x8715 #x892A #x9000 #x541E
- #x5C6F #x81C0 #x62D6 #x6258 #x8131 #x9E35 #x9640 #x9A6E #x9A7C #x692D
- #x59A5 #x62D3 #x553E #x6316 #x54C7 #x86D9 #x6D3C #x5A03 #x74E6 #x889C
- #x6B6A #x5916 #x8C4C #x5F2F #x6E7E #x73A9 #x987D #x4E38 #x70F7 #x5B8C
- #x7897 #x633D #x665A #x7696 #x60CB #x5B9B #x5A49 #x4E07 #x8155 #x6C6A
- #x738B #x4EA1 #x6789 #x7F51 #x5F80 #x65FA #x671B #x5FD8 #x5984 #x5A01
- #x5DCD #x5FAE #x5371 #x97E6 #x8FDD #x6845 #x56F4 #x552F #x60DF #x4E3A
- #x6F4D #x7EF4 #x82C7 #x840E #x59D4 #x4F1F #x4F2A #x5C3E #x7EAC #x672A
- #x851A #x5473 #x754F #x80C3 #x5582 #x9B4F #x4F4D #x6E2D #x8C13 #x5C09
- #x6170 #x536B #x761F #x6E29 #x868A #x6587 #x95FB #x7EB9 #x543B #x7A33
- #x7D0A #x95EE #x55E1 #x7FC1 #x74EE #x631D #x8717 #x6DA1 #x7A9D #x6211
- #x65A1 #x5367 #x63E1 #x6C83 #x5DEB #x545C #x94A8 #x4E4C #x6C61 #x8BEC
- #x5C4B #x65E0 #x829C #x68A7 #x543E #x5434 #x6BCB #x6B66 #x4E94 #x6342
- #x5348 #x821E #x4F0D #x4FAE #x575E #x620A #x96FE #x6664 #x7269 #x52FF
- #x52A1 #x609F #x8BEF #x6614 #x7199 #x6790 #x897F #x7852 #x77FD #x6670
- #x563B #x5438 #x9521 #x727A #x7A00 #x606F #x5E0C #x6089 #x819D #x5915
- #x60DC #x7184 #x70EF #x6EAA #x6C50 #x7280 #x6A84 #x88AD #x5E2D #x4E60
- #x5AB3 #x559C #x94E3 #x6D17 #x7CFB #x9699 #x620F #x7EC6 #x778E #x867E
- #x5323 #x971E #x8F96 #x6687 #x5CE1 #x4FA0 #x72ED #x4E0B #x53A6 #x590F
- #x5413 #x6380 #x9528 #x5148 #x4ED9 #x9C9C #x7EA4 #x54B8 #x8D24 #x8854
- #x8237 #x95F2 #x6D8E #x5F26 #x5ACC #x663E #x9669 #x73B0 #x732E #x53BF
- #x817A #x9985 #x7FA1 #x5BAA #x9677 #x9650 #x7EBF #x76F8 #x53A2 #x9576
- #x9999 #x7BB1 #x8944 #x6E58 #x4E61 #x7FD4 #x7965 #x8BE6 #x60F3 #x54CD
- #x4EAB #x9879 #x5DF7 #x6A61 #x50CF #x5411 #x8C61 #x8427 #x785D #x9704
- #x524A #x54EE #x56A3 #x9500 #x6D88 #x5BB5 #x6DC6 #x6653 #x5C0F #x5B5D
- #x6821 #x8096 #x5578 #x7B11 #x6548 #x6954 #x4E9B #x6B47 #x874E #x978B
- #x534F #x631F #x643A #x90AA #x659C #x80C1 #x8C10 #x5199 #x68B0 #x5378
- #x87F9 #x61C8 #x6CC4 #x6CFB #x8C22 #x5C51 #x85AA #x82AF #x950C #x6B23
- #x8F9B #x65B0 #x5FFB #x5FC3 #x4FE1 #x8845 #x661F #x8165 #x7329 #x60FA
- #x5174 #x5211 #x578B #x5F62 #x90A2 #x884C #x9192 #x5E78 #x674F #x6027
- #x59D3 #x5144 #x51F6 #x80F8 #x5308 #x6C79 #x96C4 #x718A #x4F11 #x4FEE
- #x7F9E #x673D #x55C5 #x9508 #x79C0 #x8896 #x7EE3 #x589F #x620C #x9700
- #x865A #x5618 #x987B #x5F90 #x8BB8 #x84C4 #x9157 #x53D9 #x65ED #x5E8F
- #x755C #x6064 #x7D6E #x5A7F #x7EEA #x7EED #x8F69 #x55A7 #x5BA3 #x60AC
- #x65CB #x7384 #x9009 #x7663 #x7729 #x7EDA #x9774 #x859B #x5B66 #x7A74
- #x96EA #x8840 #x52CB #x718F #x5FAA #x65EC #x8BE2 #x5BFB #x9A6F #x5DE1
- #x6B89 #x6C5B #x8BAD #x8BAF #x900A #x8FC5 #x538B #x62BC #x9E26 #x9E2D
- #x5440 #x4E2B #x82BD #x7259 #x869C #x5D16 #x8859 #x6DAF #x96C5 #x54D1
- #x4E9A #x8BB6 #x7109 #x54BD #x9609 #x70DF #x6DF9 #x76D0 #x4E25 #x7814
- #x8712 #x5CA9 #x5EF6 #x8A00 #x989C #x960E #x708E #x6CBF #x5944 #x63A9
- #x773C #x884D #x6F14 #x8273 #x5830 #x71D5 #x538C #x781A #x96C1 #x5501
- #x5F66 #x7130 #x5BB4 #x8C1A #x9A8C #x6B83 #x592E #x9E2F #x79E7 #x6768
- #x626C #x4F6F #x75A1 #x7F8A #x6D0B #x9633 #x6C27 #x4EF0 #x75D2 #x517B
- #x6837 #x6F3E #x9080 #x8170 #x5996 #x7476 #x6447 #x5C27 #x9065 #x7A91
- #x8C23 #x59DA #x54AC #x8200 #x836F #x8981 #x8000 #x6930 #x564E #x8036
- #x7237 #x91CE #x51B6 #x4E5F #x9875 #x6396 #x4E1A #x53F6 #x66F3 #x814B
- #x591C #x6DB2 #x4E00 #x58F9 #x533B #x63D6 #x94F1 #x4F9D #x4F0A #x8863
- #x9890 #x5937 #x9057 #x79FB #x4EEA #x80F0 #x7591 #x6C82 #x5B9C #x59E8
- #x5F5D #x6905 #x8681 #x501A #x5DF2 #x4E59 #x77E3 #x4EE5 #x827A #x6291
- #x6613 #x9091 #x5C79 #x4EBF #x5F79 #x81C6 #x9038 #x8084 #x75AB #x4EA6
- #x88D4 #x610F #x6BC5 #x5FC6 #x4E49 #x76CA #x6EA2 #x8BE3 #x8BAE #x8C0A
- #x8BD1 #x5F02 #x7FFC #x7FCC #x7ECE #x8335 #x836B #x56E0 #x6BB7 #x97F3
- #x9634 #x59FB #x541F #x94F6 #x6DEB #x5BC5 #x996E #x5C39 #x5F15 #x9690
- #x5370 #x82F1 #x6A31 #x5A74 #x9E70 #x5E94 #x7F28 #x83B9 #x8424 #x8425
- #x8367 #x8747 #x8FCE #x8D62 #x76C8 #x5F71 #x9896 #x786C #x6620 #x54DF
- #x62E5 #x4F63 #x81C3 #x75C8 #x5EB8 #x96CD #x8E0A #x86F9 #x548F #x6CF3
- #x6D8C #x6C38 #x607F #x52C7 #x7528 #x5E7D #x4F18 #x60A0 #x5FE7 #x5C24
- #x7531 #x90AE #x94C0 #x72B9 #x6CB9 #x6E38 #x9149 #x6709 #x53CB #x53F3
- #x4F51 #x91C9 #x8BF1 #x53C8 #x5E7C #x8FC2 #x6DE4 #x4E8E #x76C2 #x6986
- #x865E #x611A #x8206 #x4F59 #x4FDE #x903E #x9C7C #x6109 #x6E1D #x6E14
- #x9685 #x4E88 #x5A31 #x96E8 #x4E0E #x5C7F #x79B9 #x5B87 #x8BED #x7FBD
- #x7389 #x57DF #x828B #x90C1 #x5401 #x9047 #x55BB #x5CEA #x5FA1 #x6108
- #x6B32 #x72F1 #x80B2 #x8A89 #x6D74 #x5BD3 #x88D5 #x9884 #x8C6B #x9A6D
- #x9E33 #x6E0A #x51A4 #x5143 #x57A3 #x8881 #x539F #x63F4 #x8F95 #x56ED
- #x5458 #x5706 #x733F #x6E90 #x7F18 #x8FDC #x82D1 #x613F #x6028 #x9662
- #x66F0 #x7EA6 #x8D8A #x8DC3 #x94A5 #x5CB3 #x7CA4 #x6708 #x60A6 #x9605
- #x8018 #x4E91 #x90E7 #x5300 #x9668 #x5141 #x8FD0 #x8574 #x915D #x6655
- #x97F5 #x5B55 #x531D #x7838 #x6742 #x683D #x54C9 #x707E #x5BB0 #x8F7D
- #x518D #x5728 #x54B1 #x6512 #x6682 #x8D5E #x8D43 #x810F #x846C #x906D
- #x7CDF #x51FF #x85FB #x67A3 #x65E9 #x6FA1 #x86A4 #x8E81 #x566A #x9020
- #x7682 #x7076 #x71E5 #x8D23 #x62E9 #x5219 #x6CFD #x8D3C #x600E #x589E
- #x618E #x66FE #x8D60 #x624E #x55B3 #x6E23 #x672D #x8F67 #x94E1 #x95F8
- #x7728 #x6805 #x69A8 #x548B #x4E4D #x70B8 #x8BC8 #x6458 #x658B #x5B85
- #x7A84 #x503A #x5BE8 #x77BB #x6BE1 #x8A79 #x7C98 #x6CBE #x76CF #x65A9
- #x8F97 #x5D2D #x5C55 #x8638 #x6808 #x5360 #x6218 #x7AD9 #x6E5B #x7EFD
- #x6A1F #x7AE0 #x5F70 #x6F33 #x5F20 #x638C #x6DA8 #x6756 #x4E08 #x5E10
- #x8D26 #x4ED7 #x80C0 #x7634 #x969C #x62DB #x662D #x627E #x6CBC #x8D75
- #x7167 #x7F69 #x5146 #x8087 #x53EC #x906E #x6298 #x54F2 #x86F0 #x8F99
- #x8005 #x9517 #x8517 #x8FD9 #x6D59 #x73CD #x659F #x771F #x7504 #x7827
- #x81FB #x8D1E #x9488 #x4FA6 #x6795 #x75B9 #x8BCA #x9707 #x632F #x9547
- #x9635 #x84B8 #x6323 #x7741 #x5F81 #x72F0 #x4E89 #x6014 #x6574 #x62EF
- #x6B63 #x653F #x5E27 #x75C7 #x90D1 #x8BC1 #x829D #x679D #x652F #x5431
- #x8718 #x77E5 #x80A2 #x8102 #x6C41 #x4E4B #x7EC7 #x804C #x76F4 #x690D
- #x6B96 #x6267 #x503C #x4F84 #x5740 #x6307 #x6B62 #x8DBE #x53EA #x65E8
- #x7EB8 #x5FD7 #x631A #x63B7 #x81F3 #x81F4 #x7F6E #x5E1C #x5CD9 #x5236
- #x667A #x79E9 #x7A1A #x8D28 #x7099 #x75D4 #x6EDE #x6CBB #x7A92 #x4E2D
- #x76C5 #x5FE0 #x949F #x8877 #x7EC8 #x79CD #x80BF #x91CD #x4EF2 #x4F17
- #x821F #x5468 #x5DDE #x6D32 #x8BCC #x7CA5 #x8F74 #x8098 #x5E1A #x5492
- #x76B1 #x5B99 #x663C #x9AA4 #x73E0 #x682A #x86DB #x6731 #x732A #x8BF8
- #x8BDB #x9010 #x7AF9 #x70DB #x716E #x62C4 #x77A9 #x5631 #x4E3B #x8457
- #x67F1 #x52A9 #x86C0 #x8D2E #x94F8 #x7B51 #x4F4F #x6CE8 #x795D #x9A7B
- #x6293 #x722A #x62FD #x4E13 #x7816 #x8F6C #x64B0 #x8D5A #x7BC6 #x6869
- #x5E84 #x88C5 #x5986 #x649E #x58EE #x72B6 #x690E #x9525 #x8FFD #x8D58
- #x5760 #x7F00 #x8C06 #x51C6 #x6349 #x62D9 #x5353 #x684C #x7422 #x8301
- #x914C #x5544 #x7740 #x707C #x6D4A #x5179 #x54A8 #x8D44 #x59FF #x6ECB
- #x6DC4 #x5B5C #x7D2B #x4ED4 #x7C7D #x6ED3 #x5B50 #x81EA #x6E0D #x5B57
- #x9B03 #x68D5 #x8E2A #x5B97 #x7EFC #x603B #x7EB5 #x90B9 #x8D70 #x594F
- #x63CD #x79DF #x8DB3 #x5352 #x65CF #x7956 #x8BC5 #x963B #x7EC4 #x94BB
- #x7E82 #x5634 #x9189 #x6700 #x7F6A #x5C0A #x9075 #x6628 #x5DE6 #x4F50
- #x67DE #x505A #x4F5C #x5750 #x5EA7 #x4E8D #x4E0C #x5140 #x4E10 #x5EFF
- #x5345 #x4E15 #x4E98 #x4E1E #x9B32 #x5B6C #x5669 #x4E28 #x79BA #x4E3F
- #x5315 #x4E47 #x592D #x723B #x536E #x6C10 #x56DF #x80E4 #x9997 #x6BD3
- #x777E #x9F17 #x4E36 #x4E9F #x9F10 #x4E5C #x4E69 #x4E93 #x8288 #x5B5B
- #x556C #x560F #x4EC4 #x538D #x539D #x53A3 #x53A5 #x53AE #x9765 #x8D5D
- #x531A #x53F5 #x5326 #x532E #x533E #x8D5C #x5366 #x5363 #x5202 #x5208
- #x520E #x522D #x5233 #x523F #x5240 #x524C #x525E #x5261 #x525C #x84AF
- #x527D #x5282 #x5281 #x5290 #x5293 #x5182 #x7F54 #x4EBB #x4EC3 #x4EC9
- #x4EC2 #x4EE8 #x4EE1 #x4EEB #x4EDE #x4F1B #x4EF3 #x4F22 #x4F64 #x4EF5
- #x4F25 #x4F27 #x4F09 #x4F2B #x4F5E #x4F67 #x6538 #x4F5A #x4F5D #x4F5F
- #x4F57 #x4F32 #x4F3D #x4F76 #x4F74 #x4F91 #x4F89 #x4F83 #x4F8F #x4F7E
- #x4F7B #x4FAA #x4F7C #x4FAC #x4F94 #x4FE6 #x4FE8 #x4FEA #x4FC5 #x4FDA
- #x4FE3 #x4FDC #x4FD1 #x4FDF #x4FF8 #x5029 #x504C #x4FF3 #x502C #x500F
- #x502E #x502D #x4FFE #x501C #x500C #x5025 #x5028 #x507E #x5043 #x5055
- #x5048 #x504E #x506C #x507B #x50A5 #x50A7 #x50A9 #x50BA #x50D6 #x5106
- #x50ED #x50EC #x50E6 #x50EE #x5107 #x510B #x4EDD #x6C3D #x4F58 #x4F65
- #x4FCE #x9FA0 #x6C46 #x7C74 #x516E #x5DFD #x9EC9 #x9998 #x5181 #x5914
- #x52F9 #x530D #x8A07 #x5310 #x51EB #x5919 #x5155 #x4EA0 #x5156 #x4EB3
- #x886E #x88A4 #x4EB5 #x8114 #x88D2 #x7980 #x5B34 #x8803 #x7FB8 #x51AB
- #x51B1 #x51BD #x51BC #x51C7 #x5196 #x51A2 #x51A5 #x8BA0 #x8BA6 #x8BA7
- #x8BAA #x8BB4 #x8BB5 #x8BB7 #x8BC2 #x8BC3 #x8BCB #x8BCF #x8BCE #x8BD2
- #x8BD3 #x8BD4 #x8BD6 #x8BD8 #x8BD9 #x8BDC #x8BDF #x8BE0 #x8BE4 #x8BE8
- #x8BE9 #x8BEE #x8BF0 #x8BF3 #x8BF6 #x8BF9 #x8BFC #x8BFF #x8C00 #x8C02
- #x8C04 #x8C07 #x8C0C #x8C0F #x8C11 #x8C12 #x8C14 #x8C15 #x8C16 #x8C19
- #x8C1B #x8C18 #x8C1D #x8C1F #x8C20 #x8C21 #x8C25 #x8C27 #x8C2A #x8C2B
- #x8C2E #x8C2F #x8C32 #x8C33 #x8C35 #x8C36 #x5369 #x537A #x961D #x9622
- #x9621 #x9631 #x962A #x963D #x963C #x9642 #x9649 #x9654 #x965F #x9667
- #x966C #x9672 #x9674 #x9688 #x968D #x9697 #x96B0 #x9097 #x909B #x909D
- #x9099 #x90AC #x90A1 #x90B4 #x90B3 #x90B6 #x90BA #x90B8 #x90B0 #x90CF
- #x90C5 #x90BE #x90D0 #x90C4 #x90C7 #x90D3 #x90E6 #x90E2 #x90DC #x90D7
- #x90DB #x90EB #x90EF #x90FE #x9104 #x9122 #x911E #x9123 #x9131 #x912F
- #x9139 #x9143 #x9146 #x520D #x5942 #x52A2 #x52AC #x52AD #x52BE #x54FF
- #x52D0 #x52D6 #x52F0 #x53DF #x71EE #x77CD #x5EF4 #x51F5 #x51FC #x9B2F
- #x53B6 #x5F01 #x755A #x5DEF #x574C #x57A9 #x57A1 #x587E #x58BC #x58C5
- #x58D1 #x5729 #x572C #x572A #x5733 #x5739 #x572E #x572F #x575C #x573B
- #x5742 #x5769 #x5785 #x576B #x5786 #x577C #x577B #x5768 #x576D #x5776
- #x5773 #x57AD #x57A4 #x578C #x57B2 #x57CF #x57A7 #x57B4 #x5793 #x57A0
- #x57D5 #x57D8 #x57DA #x57D9 #x57D2 #x57B8 #x57F4 #x57EF #x57F8 #x57E4
- #x57DD #x580B #x580D #x57FD #x57ED #x5800 #x581E #x5819 #x5844 #x5820
- #x5865 #x586C #x5881 #x5889 #x589A #x5880 #x99A8 #x9F19 #x61FF #x8279
- #x827D #x827F #x828F #x828A #x82A8 #x8284 #x828E #x8291 #x8297 #x8299
- #x82AB #x82B8 #x82BE #x82B0 #x82C8 #x82CA #x82E3 #x8298 #x82B7 #x82AE
- #x82CB #x82CC #x82C1 #x82A9 #x82B4 #x82A1 #x82AA #x829F #x82C4 #x82CE
- #x82A4 #x82E1 #x8309 #x82F7 #x82E4 #x830F #x8307 #x82DC #x82F4 #x82D2
- #x82D8 #x830C #x82FB #x82D3 #x8311 #x831A #x8306 #x8314 #x8315 #x82E0
- #x82D5 #x831C #x8351 #x835B #x835C #x8308 #x8392 #x833C #x8334 #x8331
- #x839B #x835E #x832F #x834F #x8347 #x8343 #x835F #x8340 #x8317 #x8360
- #x832D #x833A #x8333 #x8366 #x8365 #x8368 #x831B #x8369 #x836C #x836A
- #x836D #x836E #x83B0 #x8378 #x83B3 #x83B4 #x83A0 #x83AA #x8393 #x839C
- #x8385 #x837C #x83B6 #x83A9 #x837D #x83B8 #x837B #x8398 #x839E #x83A8
- #x83BA #x83BC #x83C1 #x8401 #x83E5 #x83D8 #x5807 #x8418 #x840B #x83DD
- #x83FD #x83D6 #x841C #x8438 #x8411 #x8406 #x83D4 #x83DF #x840F #x8403
- #x83F8 #x83F9 #x83EA #x83C5 #x83C0 #x8426 #x83F0 #x83E1 #x845C #x8451
- #x845A #x8459 #x8473 #x8487 #x8488 #x847A #x8489 #x8478 #x843C #x8446
- #x8469 #x8476 #x848C #x848E #x8431 #x846D #x84C1 #x84CD #x84D0 #x84E6
- #x84BD #x84D3 #x84CA #x84BF #x84BA #x84E0 #x84A1 #x84B9 #x84B4 #x8497
- #x84E5 #x84E3 #x850C #x750D #x8538 #x84F0 #x8539 #x851F #x853A #x8556
- #x853B #x84FF #x84FC #x8559 #x8548 #x8568 #x8564 #x855E #x857A #x77A2
- #x8543 #x8572 #x857B #x85A4 #x85A8 #x8587 #x858F #x8579 #x85AE #x859C
- #x8585 #x85B9 #x85B7 #x85B0 #x85D3 #x85C1 #x85DC #x85FF #x8627 #x8605
- #x8629 #x8616 #x863C #x5EFE #x5F08 #x593C #x5941 #x8037 #x5955 #x595A
- #x5958 #x530F #x5C22 #x5C25 #x5C2C #x5C34 #x624C #x626A #x629F #x62BB
- #x62CA #x62DA #x62D7 #x62EE #x6322 #x62F6 #x6339 #x634B #x6343 #x63AD
- #x63F6 #x6371 #x637A #x638E #x63B4 #x636D #x63AC #x638A #x6369 #x63AE
- #x63BC #x63F2 #x63F8 #x63E0 #x63FF #x63C4 #x63DE #x63CE #x6452 #x63C6
- #x63BE #x6445 #x6441 #x640B #x641B #x6420 #x640C #x6426 #x6421 #x645E
- #x6484 #x646D #x6496 #x647A #x64B7 #x64B8 #x6499 #x64BA #x64C0 #x64D0
- #x64D7 #x64E4 #x64E2 #x6509 #x6525 #x652E #x5F0B #x5FD2 #x7519 #x5F11
- #x535F #x53F1 #x53FD #x53E9 #x53E8 #x53FB #x5412 #x5416 #x5406 #x544B
- #x5452 #x5453 #x5454 #x5456 #x5443 #x5421 #x5457 #x5459 #x5423 #x5432
- #x5482 #x5494 #x5477 #x5471 #x5464 #x549A #x549B #x5484 #x5476 #x5466
- #x549D #x54D0 #x54AD #x54C2 #x54B4 #x54D2 #x54A7 #x54A6 #x54D3 #x54D4
- #x5472 #x54A3 #x54D5 #x54BB #x54BF #x54CC #x54D9 #x54DA #x54DC #x54A9
- #x54AA #x54A4 #x54DD #x54CF #x54DE #x551B #x54E7 #x5520 #x54FD #x5514
- #x54F3 #x5522 #x5523 #x550F #x5511 #x5527 #x552A #x5567 #x558F #x55B5
- #x5549 #x556D #x5541 #x5555 #x553F #x5550 #x553C #x5537 #x5556 #x5575
- #x5576 #x5577 #x5533 #x5530 #x555C #x558B #x55D2 #x5583 #x55B1 #x55B9
- #x5588 #x5581 #x559F #x557E #x55D6 #x5591 #x557B #x55DF #x55BD #x55BE
- #x5594 #x5599 #x55EA #x55F7 #x55C9 #x561F #x55D1 #x55EB #x55EC #x55D4
- #x55E6 #x55DD #x55C4 #x55EF #x55E5 #x55F2 #x55F3 #x55CC #x55CD #x55E8
- #x55F5 #x55E4 #x8F94 #x561E #x5608 #x560C #x5601 #x5624 #x5623 #x55FE
- #x5600 #x5627 #x562D #x5658 #x5639 #x5657 #x562C #x564D #x5662 #x5659
- #x565C #x564C #x5654 #x5686 #x5664 #x5671 #x566B #x567B #x567C #x5685
- #x5693 #x56AF #x56D4 #x56D7 #x56DD #x56E1 #x56F5 #x56EB #x56F9 #x56FF
- #x5704 #x570A #x5709 #x571C #x5E0F #x5E19 #x5E14 #x5E11 #x5E31 #x5E3B
- #x5E3C #x5E37 #x5E44 #x5E54 #x5E5B #x5E5E #x5E61 #x5C8C #x5C7A #x5C8D
- #x5C90 #x5C96 #x5C88 #x5C98 #x5C99 #x5C91 #x5C9A #x5C9C #x5CB5 #x5CA2
- #x5CBD #x5CAC #x5CAB #x5CB1 #x5CA3 #x5CC1 #x5CB7 #x5CC4 #x5CD2 #x5CE4
- #x5CCB #x5CE5 #x5D02 #x5D03 #x5D27 #x5D26 #x5D2E #x5D24 #x5D1E #x5D06
- #x5D1B #x5D58 #x5D3E #x5D34 #x5D3D #x5D6C #x5D5B #x5D6F #x5D5D #x5D6B
- #x5D4B #x5D4A #x5D69 #x5D74 #x5D82 #x5D99 #x5D9D #x8C73 #x5DB7 #x5DC5
- #x5F73 #x5F77 #x5F82 #x5F87 #x5F89 #x5F8C #x5F95 #x5F99 #x5F9C #x5FA8
- #x5FAD #x5FB5 #x5FBC #x8862 #x5F61 #x72AD #x72B0 #x72B4 #x72B7 #x72B8
- #x72C3 #x72C1 #x72CE #x72CD #x72D2 #x72E8 #x72EF #x72E9 #x72F2 #x72F4
- #x72F7 #x7301 #x72F3 #x7303 #x72FA #x72FB #x7317 #x7313 #x7321 #x730A
- #x731E #x731D #x7315 #x7322 #x7339 #x7325 #x732C #x7338 #x7331 #x7350
- #x734D #x7357 #x7360 #x736C #x736F #x737E #x821B #x5925 #x98E7 #x5924
- #x5902 #x9963 #x9967 #x9968 #x9969 #x996A #x996B #x996C #x9974 #x9977
- #x997D #x9980 #x9984 #x9987 #x998A #x998D #x9990 #x9991 #x9993 #x9994
- #x9995 #x5E80 #x5E91 #x5E8B #x5E96 #x5EA5 #x5EA0 #x5EB9 #x5EB5 #x5EBE
- #x5EB3 #x8D53 #x5ED2 #x5ED1 #x5EDB #x5EE8 #x5EEA #x81BA #x5FC4 #x5FC9
- #x5FD6 #x5FCF #x6003 #x5FEE #x6004 #x5FE1 #x5FE4 #x5FFE #x6005 #x6006
- #x5FEA #x5FED #x5FF8 #x6019 #x6035 #x6026 #x601B #x600F #x600D #x6029
- #x602B #x600A #x603F #x6021 #x6078 #x6079 #x607B #x607A #x6042 #x606A
- #x607D #x6096 #x609A #x60AD #x609D #x6083 #x6092 #x608C #x609B #x60EC
- #x60BB #x60B1 #x60DD #x60D8 #x60C6 #x60DA #x60B4 #x6120 #x6126 #x6115
- #x6123 #x60F4 #x6100 #x610E #x612B #x614A #x6175 #x61AC #x6194 #x61A7
- #x61B7 #x61D4 #x61F5 #x5FDD #x96B3 #x95E9 #x95EB #x95F1 #x95F3 #x95F5
- #x95F6 #x95FC #x95FE #x9603 #x9604 #x9606 #x9608 #x960A #x960B #x960C
- #x960D #x960F #x9612 #x9615 #x9616 #x9617 #x9619 #x961A #x4E2C #x723F
- #x6215 #x6C35 #x6C54 #x6C5C #x6C4A #x6CA3 #x6C85 #x6C90 #x6C94 #x6C8C
- #x6C68 #x6C69 #x6C74 #x6C76 #x6C86 #x6CA9 #x6CD0 #x6CD4 #x6CAD #x6CF7
- #x6CF8 #x6CF1 #x6CD7 #x6CB2 #x6CE0 #x6CD6 #x6CFA #x6CEB #x6CEE #x6CB1
- #x6CD3 #x6CEF #x6CFE #x6D39 #x6D27 #x6D0C #x6D43 #x6D48 #x6D07 #x6D04
- #x6D19 #x6D0E #x6D2B #x6D4D #x6D2E #x6D35 #x6D1A #x6D4F #x6D52 #x6D54
- #x6D33 #x6D91 #x6D6F #x6D9E #x6DA0 #x6D5E #x6D93 #x6D94 #x6D5C #x6D60
- #x6D7C #x6D63 #x6E1A #x6DC7 #x6DC5 #x6DDE #x6E0E #x6DBF #x6DE0 #x6E11
- #x6DE6 #x6DDD #x6DD9 #x6E16 #x6DAB #x6E0C #x6DAE #x6E2B #x6E6E #x6E4E
- #x6E6B #x6EB2 #x6E5F #x6E86 #x6E53 #x6E54 #x6E32 #x6E25 #x6E44 #x6EDF
- #x6EB1 #x6E98 #x6EE0 #x6F2D #x6EE2 #x6EA5 #x6EA7 #x6EBD #x6EBB #x6EB7
- #x6ED7 #x6EB4 #x6ECF #x6E8F #x6EC2 #x6E9F #x6F62 #x6F46 #x6F47 #x6F24
- #x6F15 #x6EF9 #x6F2F #x6F36 #x6F4B #x6F74 #x6F2A #x6F09 #x6F29 #x6F89
- #x6F8D #x6F8C #x6F78 #x6F72 #x6F7C #x6F7A #x6FD1 #x6FC9 #x6FA7 #x6FB9
- #x6FB6 #x6FC2 #x6FE1 #x6FEE #x6FDE #x6FE0 #x6FEF #x701A #x7023 #x701B
- #x7039 #x7035 #x704F #x705E #x5B80 #x5B84 #x5B95 #x5B93 #x5BA5 #x5BB8
- #x752F #x9A9E #x6434 #x5BE4 #x5BEE #x8930 #x5BF0 #x8E47 #x8B07 #x8FB6
- #x8FD3 #x8FD5 #x8FE5 #x8FEE #x8FE4 #x8FE9 #x8FE6 #x8FF3 #x8FE8 #x9005
- #x9004 #x900B #x9026 #x9011 #x900D #x9016 #x9021 #x9035 #x9036 #x902D
- #x902F #x9044 #x9051 #x9052 #x9050 #x9068 #x9058 #x9062 #x905B #x66B9
- #x9074 #x907D #x9082 #x9088 #x9083 #x908B #x5F50 #x5F57 #x5F56 #x5F58
- #x5C3B #x54AB #x5C50 #x5C59 #x5B71 #x5C63 #x5C66 #x7FBC #x5F2A #x5F29
- #x5F2D #x8274 #x5F3C #x9B3B #x5C6E #x5981 #x5983 #x598D #x59A9 #x59AA
- #x59A3 #x5997 #x59CA #x59AB #x599E #x59A4 #x59D2 #x59B2 #x59AF #x59D7
- #x59BE #x5A05 #x5A06 #x59DD #x5A08 #x59E3 #x59D8 #x59F9 #x5A0C #x5A09
- #x5A32 #x5A34 #x5A11 #x5A23 #x5A13 #x5A40 #x5A67 #x5A4A #x5A55 #x5A3C
- #x5A62 #x5A75 #x80EC #x5AAA #x5A9B #x5A77 #x5A7A #x5ABE #x5AEB #x5AB2
- #x5AD2 #x5AD4 #x5AB8 #x5AE0 #x5AE3 #x5AF1 #x5AD6 #x5AE6 #x5AD8 #x5ADC
- #x5B09 #x5B17 #x5B16 #x5B32 #x5B37 #x5B40 #x5C15 #x5C1C #x5B5A #x5B65
- #x5B73 #x5B51 #x5B53 #x5B62 #x9A75 #x9A77 #x9A78 #x9A7A #x9A7F #x9A7D
- #x9A80 #x9A81 #x9A85 #x9A88 #x9A8A #x9A90 #x9A92 #x9A93 #x9A96 #x9A98
- #x9A9B #x9A9C #x9A9D #x9A9F #x9AA0 #x9AA2 #x9AA3 #x9AA5 #x9AA7 #x7E9F
- #x7EA1 #x7EA3 #x7EA5 #x7EA8 #x7EA9 #x7EAD #x7EB0 #x7EBE #x7EC0 #x7EC1
- #x7EC2 #x7EC9 #x7ECB #x7ECC #x7ED0 #x7ED4 #x7ED7 #x7EDB #x7EE0 #x7EE1
- #x7EE8 #x7EEB #x7EEE #x7EEF #x7EF1 #x7EF2 #x7F0D #x7EF6 #x7EFA #x7EFB
- #x7EFE #x7F01 #x7F02 #x7F03 #x7F07 #x7F08 #x7F0B #x7F0C #x7F0F #x7F11
- #x7F12 #x7F17 #x7F19 #x7F1C #x7F1B #x7F1F #x7F21 #x7F22 #x7F23 #x7F24
- #x7F25 #x7F26 #x7F27 #x7F2A #x7F2B #x7F2C #x7F2D #x7F2F #x7F30 #x7F31
- #x7F32 #x7F33 #x7F35 #x5E7A #x757F #x5DDB #x753E #x9095 #x738E #x7391
- #x73AE #x73A2 #x739F #x73CF #x73C2 #x73D1 #x73B7 #x73B3 #x73C0 #x73C9
- #x73C8 #x73E5 #x73D9 #x987C #x740A #x73E9 #x73E7 #x73DE #x73BA #x73F2
- #x740F #x742A #x745B #x7426 #x7425 #x7428 #x7430 #x742E #x742C #x741B
- #x741A #x7441 #x745C #x7457 #x7455 #x7459 #x7477 #x746D #x747E #x749C
- #x748E #x7480 #x7481 #x7487 #x748B #x749E #x74A8 #x74A9 #x7490 #x74A7
- #x74D2 #x74BA #x97EA #x97EB #x97EC #x674C #x6753 #x675E #x6748 #x6769
- #x67A5 #x6787 #x676A #x6773 #x6798 #x67A7 #x6775 #x67A8 #x679E #x67AD
- #x678B #x6777 #x677C #x67F0 #x6809 #x67D8 #x680A #x67E9 #x67B0 #x680C
- #x67D9 #x67B5 #x67DA #x67B3 #x67DD #x6800 #x67C3 #x67B8 #x67E2 #x680E
- #x67C1 #x67FD #x6832 #x6833 #x6860 #x6861 #x684E #x6862 #x6844 #x6864
- #x6883 #x681D #x6855 #x6866 #x6841 #x6867 #x6840 #x683E #x684A #x6849
- #x6829 #x68B5 #x688F #x6874 #x6877 #x6893 #x686B #x68C2 #x696E #x68FC
- #x691F #x6920 #x68F9 #x6924 #x68F0 #x690B #x6901 #x6957 #x68E3 #x6910
- #x6971 #x6939 #x6960 #x6942 #x695D #x6984 #x696B #x6980 #x6998 #x6978
- #x6934 #x69CC #x6987 #x6988 #x69CE #x6989 #x6966 #x6963 #x6979 #x699B
- #x69A7 #x69BB #x69AB #x69AD #x69D4 #x69B1 #x69C1 #x69CA #x69DF #x6995
- #x69E0 #x698D #x69FF #x6A2F #x69ED #x6A17 #x6A18 #x6A65 #x69F2 #x6A44
- #x6A3E #x6AA0 #x6A50 #x6A5B #x6A35 #x6A8E #x6A79 #x6A3D #x6A28 #x6A58
- #x6A7C #x6A91 #x6A90 #x6AA9 #x6A97 #x6AAB #x7337 #x7352 #x6B81 #x6B82
- #x6B87 #x6B84 #x6B92 #x6B93 #x6B8D #x6B9A #x6B9B #x6BA1 #x6BAA #x8F6B
- #x8F6D #x8F71 #x8F72 #x8F73 #x8F75 #x8F76 #x8F78 #x8F77 #x8F79 #x8F7A
- #x8F7C #x8F7E #x8F81 #x8F82 #x8F84 #x8F87 #x8F8B #x8F8D #x8F8E #x8F8F
- #x8F98 #x8F9A #x8ECE #x620B #x6217 #x621B #x621F #x6222 #x6221 #x6225
- #x6224 #x622C #x81E7 #x74EF #x74F4 #x74FF #x750F #x7511 #x7513 #x6534
- #x65EE #x65EF #x65F0 #x660A #x6619 #x6772 #x6603 #x6615 #x6600 #x7085
- #x66F7 #x661D #x6634 #x6631 #x6636 #x6635 #x8006 #x665F #x6654 #x6641
- #x664F #x6656 #x6661 #x6657 #x6677 #x6684 #x668C #x66A7 #x669D #x66BE
- #x66DB #x66DC #x66E6 #x66E9 #x8D32 #x8D33 #x8D36 #x8D3B #x8D3D #x8D40
- #x8D45 #x8D46 #x8D48 #x8D49 #x8D47 #x8D4D #x8D55 #x8D59 #x89C7 #x89CA
- #x89CB #x89CC #x89CE #x89CF #x89D0 #x89D1 #x726E #x729F #x725D #x7266
- #x726F #x727E #x727F #x7284 #x728B #x728D #x728F #x7292 #x6308 #x6332
- #x63B0 #x643F #x64D8 #x8004 #x6BEA #x6BF3 #x6BFD #x6BF5 #x6BF9 #x6C05
- #x6C07 #x6C06 #x6C0D #x6C15 #x6C18 #x6C19 #x6C1A #x6C21 #x6C29 #x6C24
- #x6C2A #x6C32 #x6535 #x6555 #x656B #x724D #x7252 #x7256 #x7230 #x8662
- #x5216 #x809F #x809C #x8093 #x80BC #x670A #x80BD #x80B1 #x80AB #x80AD
- #x80B4 #x80B7 #x80E7 #x80E8 #x80E9 #x80EA #x80DB #x80C2 #x80C4 #x80D9
- #x80CD #x80D7 #x6710 #x80DD #x80EB #x80F1 #x80F4 #x80ED #x810D #x810E
- #x80F2 #x80FC #x6715 #x8112 #x8C5A #x8136 #x811E #x812C #x8118 #x8132
- #x8148 #x814C #x8153 #x8174 #x8159 #x815A #x8171 #x8160 #x8169 #x817C
- #x817D #x816D #x8167 #x584D #x5AB5 #x8188 #x8182 #x8191 #x6ED5 #x81A3
- #x81AA #x81CC #x6726 #x81CA #x81BB #x81C1 #x81A6 #x6B24 #x6B37 #x6B39
- #x6B43 #x6B46 #x6B59 #x98D1 #x98D2 #x98D3 #x98D5 #x98D9 #x98DA #x6BB3
- #x5F40 #x6BC2 #x89F3 #x6590 #x9F51 #x6593 #x65BC #x65C6 #x65C4 #x65C3
- #x65CC #x65CE #x65D2 #x65D6 #x7080 #x709C #x7096 #x709D #x70BB #x70C0
- #x70B7 #x70AB #x70B1 #x70E8 #x70CA #x7110 #x7113 #x7116 #x712F #x7131
- #x7173 #x715C #x7168 #x7145 #x7172 #x714A #x7178 #x717A #x7198 #x71B3
- #x71B5 #x71A8 #x71A0 #x71E0 #x71D4 #x71E7 #x71F9 #x721D #x7228 #x706C
- #x7118 #x7166 #x71B9 #x623E #x623D #x6243 #x6248 #x6249 #x793B #x7940
- #x7946 #x7949 #x795B #x795C #x7953 #x795A #x7962 #x7957 #x7960 #x796F
- #x7967 #x797A #x7985 #x798A #x799A #x79A7 #x79B3 #x5FD1 #x5FD0 #x603C
- #x605D #x605A #x6067 #x6041 #x6059 #x6063 #x60AB #x6106 #x610D #x615D
- #x61A9 #x619D #x61CB #x61D1 #x6206 #x8080 #x807F #x6C93 #x6CF6 #x6DFC
- #x77F6 #x77F8 #x7800 #x7809 #x7817 #x7818 #x7811 #x65AB #x782D #x781C
- #x781D #x7839 #x783A #x783B #x781F #x783C #x7825 #x782C #x7823 #x7829
- #x784E #x786D #x7856 #x7857 #x7826 #x7850 #x7847 #x784C #x786A #x789B
- #x7893 #x789A #x7887 #x789C #x78A1 #x78A3 #x78B2 #x78B9 #x78A5 #x78D4
- #x78D9 #x78C9 #x78EC #x78F2 #x7905 #x78F4 #x7913 #x7924 #x791E #x7934
- #x9F9B #x9EF9 #x9EFB #x9EFC #x76F1 #x7704 #x770D #x76F9 #x7707 #x7708
- #x771A #x7722 #x7719 #x772D #x7726 #x7735 #x7738 #x7750 #x7751 #x7747
- #x7743 #x775A #x7768 #x7762 #x7765 #x777F #x778D #x777D #x7780 #x778C
- #x7791 #x779F #x77A0 #x77B0 #x77B5 #x77BD #x753A #x7540 #x754E #x754B
- #x7548 #x755B #x7572 #x7579 #x7583 #x7F58 #x7F61 #x7F5F #x8A48 #x7F68
- #x7F74 #x7F71 #x7F79 #x7F81 #x7F7E #x76CD #x76E5 #x8832 #x9485 #x9486
- #x9487 #x948B #x948A #x948C #x948D #x948F #x9490 #x9494 #x9497 #x9495
- #x949A #x949B #x949C #x94A3 #x94A4 #x94AB #x94AA #x94AD #x94AC #x94AF
- #x94B0 #x94B2 #x94B4 #x94B6 #x94B7 #x94B8 #x94B9 #x94BA #x94BC #x94BD
- #x94BF #x94C4 #x94C8 #x94C9 #x94CA #x94CB #x94CC #x94CD #x94CE #x94D0
- #x94D1 #x94D2 #x94D5 #x94D6 #x94D7 #x94D9 #x94D8 #x94DB #x94DE #x94DF
- #x94E0 #x94E2 #x94E4 #x94E5 #x94E7 #x94E8 #x94EA #x94E9 #x94EB #x94EE
- #x94EF #x94F3 #x94F4 #x94F5 #x94F7 #x94F9 #x94FC #x94FD #x94FF #x9503
- #x9502 #x9506 #x9507 #x9509 #x950A #x950D #x950E #x950F #x9512 #x9513
- #x9514 #x9515 #x9516 #x9518 #x951B #x951D #x951E #x951F #x9522 #x952A
- #x952B #x9529 #x952C #x9531 #x9532 #x9534 #x9536 #x9537 #x9538 #x953C
- #x953E #x953F #x9542 #x9535 #x9544 #x9545 #x9546 #x9549 #x954C #x954E
- #x954F #x9552 #x9553 #x9554 #x9556 #x9557 #x9558 #x9559 #x955B #x955E
- #x955F #x955D #x9561 #x9562 #x9564 #x9565 #x9566 #x9567 #x9568 #x9569
- #x956A #x956B #x956C #x956F #x9571 #x9572 #x9573 #x953A #x77E7 #x77EC
- #x96C9 #x79D5 #x79ED #x79E3 #x79EB #x7A06 #x5D47 #x7A03 #x7A02 #x7A1E
- #x7A14 #x7A39 #x7A37 #x7A51 #x9ECF #x99A5 #x7A70 #x7688 #x768E #x7693
- #x7699 #x76A4 #x74DE #x74E0 #x752C #x9E20 #x9E22 #x9E28 #x9E29 #x9E2A
- #x9E2B #x9E2C #x9E32 #x9E31 #x9E36 #x9E38 #x9E37 #x9E39 #x9E3A #x9E3E
- #x9E41 #x9E42 #x9E44 #x9E46 #x9E47 #x9E48 #x9E49 #x9E4B #x9E4C #x9E4E
- #x9E51 #x9E55 #x9E57 #x9E5A #x9E5B #x9E5C #x9E5E #x9E63 #x9E66 #x9E67
- #x9E68 #x9E69 #x9E6A #x9E6B #x9E6C #x9E71 #x9E6D #x9E73 #x7592 #x7594
- #x7596 #x75A0 #x759D #x75AC #x75A3 #x75B3 #x75B4 #x75B8 #x75C4 #x75B1
- #x75B0 #x75C3 #x75C2 #x75D6 #x75CD #x75E3 #x75E8 #x75E6 #x75E4 #x75EB
- #x75E7 #x7603 #x75F1 #x75FC #x75FF #x7610 #x7600 #x7605 #x760C #x7617
- #x760A #x7625 #x7618 #x7615 #x7619 #x761B #x763C #x7622 #x7620 #x7640
- #x762D #x7630 #x763F #x7635 #x7643 #x763E #x7633 #x764D #x765E #x7654
- #x765C #x7656 #x766B #x766F #x7FCA #x7AE6 #x7A78 #x7A79 #x7A80 #x7A86
- #x7A88 #x7A95 #x7AA6 #x7AA0 #x7AAC #x7AA8 #x7AAD #x7AB3 #x8864 #x8869
- #x8872 #x887D #x887F #x8882 #x88A2 #x88C6 #x88B7 #x88BC #x88C9 #x88E2
- #x88CE #x88E3 #x88E5 #x88F1 #x891A #x88FC #x88E8 #x88FE #x88F0 #x8921
- #x8919 #x8913 #x891B #x890A #x8934 #x892B #x8936 #x8941 #x8966 #x897B
- #x758B #x80E5 #x76B2 #x76B4 #x77DC #x8012 #x8014 #x8016 #x801C #x8020
- #x8022 #x8025 #x8026 #x8027 #x8029 #x8028 #x8031 #x800B #x8035 #x8043
- #x8046 #x804D #x8052 #x8069 #x8071 #x8983 #x9878 #x9880 #x9883 #x9889
- #x988C #x988D #x988F #x9894 #x989A #x989B #x989E #x989F #x98A1 #x98A2
- #x98A5 #x98A6 #x864D #x8654 #x866C #x866E #x867F #x867A #x867C #x867B
- #x86A8 #x868D #x868B #x86AC #x869D #x86A7 #x86A3 #x86AA #x8693 #x86A9
- #x86B6 #x86C4 #x86B5 #x86CE #x86B0 #x86BA #x86B1 #x86AF #x86C9 #x86CF
- #x86B4 #x86E9 #x86F1 #x86F2 #x86ED #x86F3 #x86D0 #x8713 #x86DE #x86F4
- #x86DF #x86D8 #x86D1 #x8703 #x8707 #x86F8 #x8708 #x870A #x870D #x8709
- #x8723 #x873B #x871E #x8725 #x872E #x871A #x873E #x8748 #x8734 #x8731
- #x8729 #x8737 #x873F #x8782 #x8722 #x877D #x877E #x877B #x8760 #x8770
- #x874C #x876E #x878B #x8753 #x8763 #x877C #x8764 #x8759 #x8765 #x8793
- #x87AF #x87A8 #x87D2 #x87C6 #x8788 #x8785 #x87AD #x8797 #x8783 #x87AB
- #x87E5 #x87AC #x87B5 #x87B3 #x87CB #x87D3 #x87BD #x87D1 #x87C0 #x87CA
- #x87DB #x87EA #x87E0 #x87EE #x8816 #x8813 #x87FE #x880A #x881B #x8821
- #x8839 #x883C #x7F36 #x7F42 #x7F44 #x7F45 #x8210 #x7AFA #x7AFD #x7B08
- #x7B03 #x7B04 #x7B15 #x7B0A #x7B2B #x7B0F #x7B47 #x7B38 #x7B2A #x7B19
- #x7B2E #x7B31 #x7B20 #x7B25 #x7B24 #x7B33 #x7B3E #x7B1E #x7B58 #x7B5A
- #x7B45 #x7B75 #x7B4C #x7B5D #x7B60 #x7B6E #x7B7B #x7B62 #x7B72 #x7B71
- #x7B90 #x7BA6 #x7BA7 #x7BB8 #x7BAC #x7B9D #x7BA8 #x7B85 #x7BAA #x7B9C
- #x7BA2 #x7BAB #x7BB4 #x7BD1 #x7BC1 #x7BCC #x7BDD #x7BDA #x7BE5 #x7BE6
- #x7BEA #x7C0C #x7BFE #x7BFC #x7C0F #x7C16 #x7C0B #x7C1F #x7C2A #x7C26
- #x7C38 #x7C41 #x7C40 #x81FE #x8201 #x8202 #x8204 #x81EC #x8844 #x8221
- #x8222 #x8223 #x822D #x822F #x8228 #x822B #x8238 #x823B #x8233 #x8234
- #x823E #x8244 #x8249 #x824B #x824F #x825A #x825F #x8268 #x887E #x8885
- #x8888 #x88D8 #x88DF #x895E #x7F9D #x7F9F #x7FA7 #x7FAF #x7FB0 #x7FB2
- #x7C7C #x6549 #x7C91 #x7C9D #x7C9C #x7C9E #x7CA2 #x7CB2 #x7CBC #x7CBD
- #x7CC1 #x7CC7 #x7CCC #x7CCD #x7CC8 #x7CC5 #x7CD7 #x7CE8 #x826E #x66A8
- #x7FBF #x7FCE #x7FD5 #x7FE5 #x7FE1 #x7FE6 #x7FE9 #x7FEE #x7FF3 #x7CF8
- #x7D77 #x7DA6 #x7DAE #x7E47 #x7E9B #x9EB8 #x9EB4 #x8D73 #x8D84 #x8D94
- #x8D91 #x8DB1 #x8D67 #x8D6D #x8C47 #x8C49 #x914A #x9150 #x914E #x914F
- #x9164 #x9162 #x9161 #x9170 #x9169 #x916F #x917D #x917E #x9172 #x9174
- #x9179 #x918C #x9185 #x9190 #x918D #x9191 #x91A2 #x91A3 #x91AA #x91AD
- #x91AE #x91AF #x91B5 #x91B4 #x91BA #x8C55 #x9E7E #x8DB8 #x8DEB #x8E05
- #x8E59 #x8E69 #x8DB5 #x8DBF #x8DBC #x8DBA #x8DC4 #x8DD6 #x8DD7 #x8DDA
- #x8DDE #x8DCE #x8DCF #x8DDB #x8DC6 #x8DEC #x8DF7 #x8DF8 #x8DE3 #x8DF9
- #x8DFB #x8DE4 #x8E09 #x8DFD #x8E14 #x8E1D #x8E1F #x8E2C #x8E2E #x8E23
- #x8E2F #x8E3A #x8E40 #x8E39 #x8E35 #x8E3D #x8E31 #x8E49 #x8E41 #x8E42
- #x8E51 #x8E52 #x8E4A #x8E70 #x8E76 #x8E7C #x8E6F #x8E74 #x8E85 #x8E8F
- #x8E94 #x8E90 #x8E9C #x8E9E #x8C78 #x8C82 #x8C8A #x8C85 #x8C98 #x8C94
- #x659B #x89D6 #x89DE #x89DA #x89DC #x89E5 #x89EB #x89EF #x8A3E #x8B26
- #x9753 #x96E9 #x96F3 #x96EF #x9706 #x9701 #x9708 #x970F #x970E #x972A
- #x972D #x9730 #x973E #x9F80 #x9F83 #x9F85 #x9F86 #x9F87 #x9F88 #x9F89
- #x9F8A #x9F8C #x9EFE #x9F0B #x9F0D #x96B9 #x96BC #x96BD #x96CE #x96D2
- #x77BF #x96E0 #x928E #x92AE #x92C8 #x933E #x936A #x93CA #x938F #x943E
- #x946B #x9C7F #x9C82 #x9C85 #x9C86 #x9C87 #x9C88 #x7A23 #x9C8B #x9C8E
- #x9C90 #x9C91 #x9C92 #x9C94 #x9C95 #x9C9A #x9C9B #x9C9E #x9C9F #x9CA0
- #x9CA1 #x9CA2 #x9CA3 #x9CA5 #x9CA6 #x9CA7 #x9CA8 #x9CA9 #x9CAB #x9CAD
- #x9CAE #x9CB0 #x9CB1 #x9CB2 #x9CB3 #x9CB4 #x9CB5 #x9CB6 #x9CB7 #x9CBA
- #x9CBB #x9CBC #x9CBD #x9CC4 #x9CC5 #x9CC6 #x9CC7 #x9CCA #x9CCB #x9CCC
- #x9CCD #x9CCE #x9CCF #x9CD0 #x9CD3 #x9CD4 #x9CD5 #x9CD7 #x9CD8 #x9CD9
- #x9CDC #x9CDD #x9CDF #x9CE2 #x977C #x9785 #x9791 #x9792 #x9794 #x97AF
- #x97AB #x97A3 #x97B2 #x97B4 #x9AB1 #x9AB0 #x9AB7 #x9E58 #x9AB6 #x9ABA
- #x9ABC #x9AC1 #x9AC0 #x9AC5 #x9AC2 #x9ACB #x9ACC #x9AD1 #x9B45 #x9B43
- #x9B47 #x9B49 #x9B48 #x9B4D #x9B51 #x98E8 #x990D #x992E #x9955 #x9954
- #x9ADF #x9AE1 #x9AE6 #x9AEF #x9AEB #x9AFB #x9AED #x9AF9 #x9B08 #x9B0F
- #x9B13 #x9B1F #x9B23 #x9EBD #x9EBE #x7E3B #x9E82 #x9E87 #x9E88 #x9E8B
- #x9E92 #x93D6 #x9E9D #x9E9F #x9EDB #x9EDC #x9EDD #x9EE0 #x9EDF #x9EE2
- #x9EE9 #x9EE7 #x9EE5 #x9EEA #x9EEF #x9F22 #x9F2C #x9F2F #x9F39 #x9F37
- #x9F3D #x9F3E #x9F44 #x4E02 #x4E04 #x4E05 #x4E06 #x4E0F #x4E12 #x4E17
- #x4E1F #x4E20 #x4E21 #x4E23 #x4E26 #x4E29 #x4E2E #x4E2F #x4E31 #x4E33
- #x4E35 #x4E37 #x4E3C #x4E40 #x4E41 #x4E42 #x4E44 #x4E46 #x4E4A #x4E51
- #x4E55 #x4E57 #x4E5A #x4E5B #x4E62 #x4E63 #x4E64 #x4E65 #x4E67 #x4E68
- #x4E6A #x4E6B #x4E6C #x4E6D #x4E6E #x4E6F #x4E72 #x4E74 #x4E75 #x4E76
- #x4E77 #x4E78 #x4E79 #x4E7A #x4E7B #x4E7C #x4E7D #x4E7F #x4E80 #x4E81
- #x4E82 #x4E83 #x4E84 #x4E85 #x4E87 #x4E8A #x4E90 #x4E96 #x4E97 #x4E99
- #x4E9C #x4E9D #x4E9E #x4EA3 #x4EAA #x4EAF #x4EB0 #x4EB1 #x4EB4 #x4EB6
- #x4EB7 #x4EB8 #x4EB9 #x4EBC #x4EBD #x4EBE #x4EC8 #x4ECC #x4ECF #x4ED0
- #x4ED2 #x4EDA #x4EDB #x4EDC #x4EE0 #x4EE2 #x4EE6 #x4EE7 #x4EE9 #x4EED
- #x4EEE #x4EEF #x4EF1 #x4EF4 #x4EF8 #x4EF9 #x4EFA #x4EFC #x4EFE #x4F00
- #x4F02 #x4F03 #x4F04 #x4F05 #x4F06 #x4F07 #x4F08 #x4F0B #x4F0C #x4F12
- #x4F13 #x4F14 #x4F15 #x4F16 #x4F1C #x4F1D #x4F21 #x4F23 #x4F28 #x4F29
- #x4F2C #x4F2D #x4F2E #x4F31 #x4F33 #x4F35 #x4F37 #x4F39 #x4F3B #x4F3E
- #x4F3F #x4F40 #x4F41 #x4F42 #x4F44 #x4F45 #x4F47 #x4F48 #x4F49 #x4F4A
- #x4F4B #x4F4C #x4F52 #x4F54 #x4F56 #x4F61 #x4F62 #x4F66 #x4F68 #x4F6A
- #x4F6B #x4F6D #x4F6E #x4F71 #x4F72 #x4F75 #x4F77 #x4F78 #x4F79 #x4F7A
- #x4F7D #x4F80 #x4F81 #x4F82 #x4F85 #x4F86 #x4F87 #x4F8A #x4F8C #x4F8E
- #x4F90 #x4F92 #x4F93 #x4F95 #x4F96 #x4F98 #x4F99 #x4F9A #x4F9C #x4F9E
- #x4F9F #x4FA1 #x4FA2 #x4FA4 #x4FAB #x4FAD #x4FB0 #x4FB1 #x4FB2 #x4FB3
- #x4FB4 #x4FB6 #x4FB7 #x4FB8 #x4FB9 #x4FBA #x4FBB #x4FBC #x4FBD #x4FBE
- #x4FC0 #x4FC1 #x4FC2 #x4FC6 #x4FC7 #x4FC8 #x4FC9 #x4FCB #x4FCC #x4FCD
- #x4FD2 #x4FD3 #x4FD4 #x4FD5 #x4FD6 #x4FD9 #x4FDB #x4FE0 #x4FE2 #x4FE4
- #x4FE5 #x4FE7 #x4FEB #x4FEC #x4FF0 #x4FF2 #x4FF4 #x4FF5 #x4FF6 #x4FF7
- #x4FF9 #x4FFB #x4FFC #x4FFD #x4FFF #x5000 #x5001 #x5002 #x5003 #x5004
- #x5005 #x5006 #x5007 #x5008 #x5009 #x500A #x500B #x500E #x5010 #x5011
- #x5013 #x5015 #x5016 #x5017 #x501B #x501D #x501E #x5020 #x5022 #x5023
- #x5024 #x5027 #x502B #x502F #x5030 #x5031 #x5032 #x5033 #x5034 #x5035
- #x5036 #x5037 #x5038 #x5039 #x503B #x503D #x503F #x5040 #x5041 #x5042
- #x5044 #x5045 #x5046 #x5049 #x504A #x504B #x504D #x5050 #x5051 #x5052
- #x5053 #x5054 #x5056 #x5057 #x5058 #x5059 #x505B #x505D #x505E #x505F
- #x5060 #x5061 #x5062 #x5063 #x5064 #x5066 #x5067 #x5068 #x5069 #x506A
- #x506B #x506D #x506E #x506F #x5070 #x5071 #x5072 #x5073 #x5074 #x5075
- #x5078 #x5079 #x507A #x507C #x507D #x5081 #x5082 #x5083 #x5084 #x5086
- #x5087 #x5089 #x508A #x508B #x508C #x508E #x508F #x5090 #x5091 #x5092
- #x5093 #x5094 #x5095 #x5096 #x5097 #x5098 #x5099 #x509A #x509B #x509C
- #x509D #x509E #x509F #x50A0 #x50A1 #x50A2 #x50A4 #x50A6 #x50AA #x50AB
- #x50AD #x50AE #x50AF #x50B0 #x50B1 #x50B3 #x50B4 #x50B5 #x50B6 #x50B7
- #x50B8 #x50B9 #x50BC #x50BD #x50BE #x50BF #x50C0 #x50C1 #x50C2 #x50C3
- #x50C4 #x50C5 #x50C6 #x50C7 #x50C8 #x50C9 #x50CA #x50CB #x50CC #x50CD
- #x50CE #x50D0 #x50D1 #x50D2 #x50D3 #x50D4 #x50D5 #x50D7 #x50D8 #x50D9
- #x50DB #x50DC #x50DD #x50DE #x50DF #x50E0 #x50E1 #x50E2 #x50E3 #x50E4
- #x50E5 #x50E8 #x50E9 #x50EA #x50EB #x50EF #x50F0 #x50F1 #x50F2 #x50F4
- #x50F6 #x50F7 #x50F8 #x50F9 #x50FA #x50FC #x50FD #x50FE #x50FF #x5100
- #x5101 #x5102 #x5103 #x5104 #x5105 #x5108 #x5109 #x510A #x510C #x510D
- #x510E #x510F #x5110 #x5111 #x5113 #x5114 #x5115 #x5116 #x5117 #x5118
- #x5119 #x511A #x511B #x511C #x511D #x511E #x511F #x5120 #x5122 #x5123
- #x5124 #x5125 #x5126 #x5127 #x5128 #x5129 #x512A #x512B #x512C #x512D
- #x512E #x512F #x5130 #x5131 #x5132 #x5133 #x5134 #x5135 #x5136 #x5137
- #x5138 #x5139 #x513A #x513B #x513C #x513D #x513E #x5142 #x5147 #x514A
- #x514C #x514E #x514F #x5150 #x5152 #x5153 #x5157 #x5158 #x5159 #x515B
- #x515D #x515E #x515F #x5160 #x5161 #x5163 #x5164 #x5166 #x5167 #x5169
- #x516A #x516F #x5172 #x517A #x517E #x517F #x5183 #x5184 #x5186 #x5187
- #x518A #x518B #x518E #x518F #x5190 #x5191 #x5193 #x5194 #x5198 #x519A
- #x519D #x519E #x519F #x51A1 #x51A3 #x51A6 #x51A7 #x51A8 #x51A9 #x51AA
- #x51AD #x51AE #x51B4 #x51B8 #x51B9 #x51BA #x51BE #x51BF #x51C1 #x51C2
- #x51C3 #x51C5 #x51C8 #x51CA #x51CD #x51CE #x51D0 #x51D2 #x51D3 #x51D4
- #x51D5 #x51D6 #x51D7 #x51D8 #x51D9 #x51DA #x51DC #x51DE #x51DF #x51E2
- #x51E3 #x51E5 #x51E6 #x51E7 #x51E8 #x51E9 #x51EA #x51EC #x51EE #x51F1
- #x51F2 #x51F4 #x51F7 #x51FE #x5204 #x5205 #x5209 #x520B #x520C #x520F
- #x5210 #x5213 #x5214 #x5215 #x521C #x521E #x521F #x5221 #x5222 #x5223
- #x5225 #x5226 #x5227 #x522A #x522C #x522F #x5231 #x5232 #x5234 #x5235
- #x523C #x523E #x5244 #x5245 #x5246 #x5247 #x5248 #x5249 #x524B #x524E
- #x524F #x5252 #x5253 #x5255 #x5257 #x5258 #x5259 #x525A #x525B #x525D
- #x525F #x5260 #x5262 #x5263 #x5264 #x5266 #x5268 #x526B #x526C #x526D
- #x526E #x5270 #x5271 #x5273 #x5274 #x5275 #x5276 #x5277 #x5278 #x5279
- #x527A #x527B #x527C #x527E #x5280 #x5283 #x5284 #x5285 #x5286 #x5287
- #x5289 #x528A #x528B #x528C #x528D #x528E #x528F #x5291 #x5292 #x5294
- #x5295 #x5296 #x5297 #x5298 #x5299 #x529A #x529C #x52A4 #x52A5 #x52A6
- #x52A7 #x52AE #x52AF #x52B0 #x52B4 #x52B5 #x52B6 #x52B7 #x52B8 #x52B9
- #x52BA #x52BB #x52BC #x52BD #x52C0 #x52C1 #x52C2 #x52C4 #x52C5 #x52C6
- #x52C8 #x52CA #x52CC #x52CD #x52CE #x52CF #x52D1 #x52D3 #x52D4 #x52D5
- #x52D7 #x52D9 #x52DA #x52DB #x52DC #x52DD #x52DE #x52E0 #x52E1 #x52E2
- #x52E3 #x52E5 #x52E6 #x52E7 #x52E8 #x52E9 #x52EA #x52EB #x52EC #x52ED
- #x52EE #x52EF #x52F1 #x52F2 #x52F3 #x52F4 #x52F5 #x52F6 #x52F7 #x52F8
- #x52FB #x52FC #x52FD #x5301 #x5302 #x5303 #x5304 #x5307 #x5309 #x530A
- #x530B #x530C #x530E #x5311 #x5312 #x5313 #x5314 #x5318 #x531B #x531C
- #x531E #x531F #x5322 #x5324 #x5325 #x5327 #x5328 #x5329 #x532B #x532C
- #x532D #x532F #x5330 #x5331 #x5332 #x5333 #x5334 #x5335 #x5336 #x5337
- #x5338 #x533C #x533D #x5340 #x5342 #x5344 #x5346 #x534B #x534C #x534D
- #x5350 #x5354 #x5358 #x5359 #x535B #x535D #x5365 #x5368 #x536A #x536C
- #x536D #x5372 #x5376 #x5379 #x537B #x537C #x537D #x537E #x5380 #x5381
- #x5383 #x5387 #x5388 #x538A #x538E #x538F #x5390 #x5391 #x5392 #x5393
- #x5394 #x5396 #x5397 #x5399 #x539B #x539C #x539E #x53A0 #x53A1 #x53A4
- #x53A7 #x53AA #x53AB #x53AC #x53AD #x53AF #x53B0 #x53B1 #x53B2 #x53B3
- #x53B4 #x53B5 #x53B7 #x53B8 #x53B9 #x53BA #x53BC #x53BD #x53BE #x53C0
- #x53C3 #x53C4 #x53C5 #x53C6 #x53C7 #x53CE #x53CF #x53D0 #x53D2 #x53D3
- #x53D5 #x53DA #x53DC #x53DD #x53DE #x53E1 #x53E2 #x53E7 #x53F4 #x53FA
- #x53FE #x53FF #x5400 #x5402 #x5405 #x5407 #x540B #x5414 #x5418 #x5419
- #x541A #x541C #x5422 #x5424 #x5425 #x542A #x5430 #x5433 #x5436 #x5437
- #x543A #x543D #x543F #x5441 #x5442 #x5444 #x5445 #x5447 #x5449 #x544C
- #x544D #x544E #x544F #x5451 #x545A #x545D #x545E #x545F #x5460 #x5461
- #x5463 #x5465 #x5467 #x5469 #x546A #x546B #x546C #x546D #x546E #x546F
- #x5470 #x5474 #x5479 #x547A #x547E #x547F #x5481 #x5483 #x5485 #x5487
- #x5488 #x5489 #x548A #x548D #x5491 #x5493 #x5497 #x5498 #x549C #x549E
- #x549F #x54A0 #x54A1 #x54A2 #x54A5 #x54AE #x54B0 #x54B2 #x54B5 #x54B6
- #x54B7 #x54B9 #x54BA #x54BC #x54BE #x54C3 #x54C5 #x54CA #x54CB #x54D6
- #x54D8 #x54DB #x54E0 #x54E1 #x54E2 #x54E3 #x54E4 #x54EB #x54EC #x54EF
- #x54F0 #x54F1 #x54F4 #x54F5 #x54F6 #x54F7 #x54F8 #x54F9 #x54FB #x54FE
- #x5500 #x5502 #x5503 #x5504 #x5505 #x5508 #x550A #x550B #x550C #x550D
- #x550E #x5512 #x5513 #x5515 #x5516 #x5517 #x5518 #x5519 #x551A #x551C
- #x551D #x551E #x551F #x5521 #x5525 #x5526 #x5528 #x5529 #x552B #x552D
- #x5532 #x5534 #x5535 #x5536 #x5538 #x5539 #x553A #x553B #x553D #x5540
- #x5542 #x5545 #x5547 #x5548 #x554B #x554C #x554D #x554E #x554F #x5551
- #x5552 #x5553 #x5554 #x5557 #x5558 #x5559 #x555A #x555B #x555D #x555E
- #x555F #x5560 #x5562 #x5563 #x5568 #x5569 #x556B #x556F #x5570 #x5571
- #x5572 #x5573 #x5574 #x5579 #x557A #x557D #x557F #x5585 #x5586 #x558C
- #x558D #x558E #x5590 #x5592 #x5593 #x5595 #x5596 #x5597 #x559A #x559B
- #x559E #x55A0 #x55A1 #x55A2 #x55A3 #x55A4 #x55A5 #x55A6 #x55A8 #x55A9
- #x55AA #x55AB #x55AC #x55AD #x55AE #x55AF #x55B0 #x55B2 #x55B4 #x55B6
- #x55B8 #x55BA #x55BC #x55BF #x55C0 #x55C1 #x55C2 #x55C3 #x55C6 #x55C7
- #x55C8 #x55CA #x55CB #x55CE #x55CF #x55D0 #x55D5 #x55D7 #x55D8 #x55D9
- #x55DA #x55DB #x55DE #x55E0 #x55E2 #x55E7 #x55E9 #x55ED #x55EE #x55F0
- #x55F1 #x55F4 #x55F6 #x55F8 #x55F9 #x55FA #x55FB #x55FC #x55FF #x5602
- #x5603 #x5604 #x5605 #x5606 #x5607 #x560A #x560B #x560D #x5610 #x5611
- #x5612 #x5613 #x5614 #x5615 #x5616 #x5617 #x5619 #x561A #x561C #x561D
- #x5620 #x5621 #x5622 #x5625 #x5626 #x5628 #x5629 #x562A #x562B #x562E
- #x562F #x5630 #x5633 #x5635 #x5637 #x5638 #x563A #x563C #x563D #x563E
- #x5640 #x5641 #x5642 #x5643 #x5644 #x5645 #x5646 #x5647 #x5648 #x5649
- #x564A #x564B #x564F #x5650 #x5651 #x5652 #x5653 #x5655 #x5656 #x565A
- #x565B #x565D #x565E #x565F #x5660 #x5661 #x5663 #x5665 #x5666 #x5667
- #x566D #x566E #x566F #x5670 #x5672 #x5673 #x5674 #x5675 #x5677 #x5678
- #x5679 #x567A #x567D #x567E #x567F #x5680 #x5681 #x5682 #x5683 #x5684
- #x5687 #x5688 #x5689 #x568A #x568B #x568C #x568D #x5690 #x5691 #x5692
- #x5694 #x5695 #x5696 #x5697 #x5698 #x5699 #x569A #x569B #x569C #x569D
- #x569E #x569F #x56A0 #x56A1 #x56A2 #x56A4 #x56A5 #x56A6 #x56A7 #x56A8
- #x56A9 #x56AA #x56AB #x56AC #x56AD #x56AE #x56B0 #x56B1 #x56B2 #x56B3
- #x56B4 #x56B5 #x56B6 #x56B8 #x56B9 #x56BA #x56BB #x56BD #x56BE #x56BF
- #x56C0 #x56C1 #x56C2 #x56C3 #x56C4 #x56C5 #x56C6 #x56C7 #x56C8 #x56C9
- #x56CB #x56CC #x56CD #x56CE #x56CF #x56D0 #x56D1 #x56D2 #x56D3 #x56D5
- #x56D6 #x56D8 #x56D9 #x56DC #x56E3 #x56E5 #x56E6 #x56E7 #x56E8 #x56E9
- #x56EA #x56EC #x56EE #x56EF #x56F2 #x56F3 #x56F6 #x56F7 #x56F8 #x56FB
- #x56FC #x5700 #x5701 #x5702 #x5705 #x5707 #x570B #x570C #x570D #x570E
- #x570F #x5710 #x5711 #x5712 #x5713 #x5714 #x5715 #x5716 #x5717 #x5718
- #x5719 #x571A #x571B #x571D #x571E #x5720 #x5721 #x5722 #x5724 #x5725
- #x5726 #x5727 #x572B #x5731 #x5732 #x5734 #x5735 #x5736 #x5737 #x5738
- #x573C #x573D #x573F #x5741 #x5743 #x5744 #x5745 #x5746 #x5748 #x5749
- #x574B #x5752 #x5753 #x5754 #x5755 #x5756 #x5758 #x5759 #x5762 #x5763
- #x5765 #x5767 #x576C #x576E #x5770 #x5771 #x5772 #x5774 #x5775 #x5778
- #x5779 #x577A #x577D #x577E #x577F #x5780 #x5781 #x5787 #x5788 #x5789
- #x578A #x578D #x578E #x578F #x5790 #x5791 #x5794 #x5795 #x5796 #x5797
- #x5798 #x5799 #x579A #x579C #x579D #x579E #x579F #x57A5 #x57A8 #x57AA
- #x57AC #x57AF #x57B0 #x57B1 #x57B3 #x57B5 #x57B6 #x57B7 #x57B9 #x57BA
- #x57BB #x57BC #x57BD #x57BE #x57BF #x57C0 #x57C1 #x57C4 #x57C5 #x57C6
- #x57C7 #x57C8 #x57C9 #x57CA #x57CC #x57CD #x57D0 #x57D1 #x57D3 #x57D6
- #x57D7 #x57DB #x57DC #x57DE #x57E1 #x57E2 #x57E3 #x57E5 #x57E6 #x57E7
- #x57E8 #x57E9 #x57EA #x57EB #x57EC #x57EE #x57F0 #x57F1 #x57F2 #x57F3
- #x57F5 #x57F6 #x57F7 #x57FB #x57FC #x57FE #x57FF #x5801 #x5803 #x5804
- #x5805 #x5808 #x5809 #x580A #x580C #x580E #x580F #x5810 #x5812 #x5813
- #x5814 #x5816 #x5817 #x5818 #x581A #x581B #x581C #x581D #x581F #x5822
- #x5823 #x5825 #x5826 #x5827 #x5828 #x5829 #x582B #x582C #x582D #x582E
- #x582F #x5831 #x5832 #x5833 #x5834 #x5836 #x5837 #x5838 #x5839 #x583A
- #x583B #x583C #x583D #x583E #x583F #x5840 #x5841 #x5842 #x5843 #x5845
- #x5846 #x5847 #x5848 #x5849 #x584A #x584B #x584E #x584F #x5850 #x5852
- #x5853 #x5855 #x5856 #x5857 #x5859 #x585A #x585B #x585C #x585D #x585F
- #x5860 #x5861 #x5862 #x5863 #x5864 #x5866 #x5867 #x5868 #x5869 #x586A
- #x586D #x586E #x586F #x5870 #x5871 #x5872 #x5873 #x5874 #x5875 #x5876
- #x5877 #x5878 #x5879 #x587A #x587B #x587C #x587D #x587F #x5882 #x5884
- #x5886 #x5887 #x5888 #x588A #x588B #x588C #x588D #x588E #x588F #x5890
- #x5891 #x5894 #x5895 #x5896 #x5897 #x5898 #x589B #x589C #x589D #x58A0
- #x58A1 #x58A2 #x58A3 #x58A4 #x58A5 #x58A6 #x58A7 #x58AA #x58AB #x58AC
- #x58AD #x58AE #x58AF #x58B0 #x58B1 #x58B2 #x58B3 #x58B4 #x58B5 #x58B6
- #x58B7 #x58B8 #x58B9 #x58BA #x58BB #x58BD #x58BE #x58BF #x58C0 #x58C2
- #x58C3 #x58C4 #x58C6 #x58C7 #x58C8 #x58C9 #x58CA #x58CB #x58CC #x58CD
- #x58CE #x58CF #x58D0 #x58D2 #x58D3 #x58D4 #x58D6 #x58D7 #x58D8 #x58D9
- #x58DA #x58DB #x58DC #x58DD #x58DE #x58DF #x58E0 #x58E1 #x58E2 #x58E3
- #x58E5 #x58E6 #x58E7 #x58E8 #x58E9 #x58EA #x58ED #x58EF #x58F1 #x58F2
- #x58F4 #x58F5 #x58F7 #x58F8 #x58FA #x58FB #x58FC #x58FD #x58FE #x58FF
- #x5900 #x5901 #x5903 #x5905 #x5906 #x5908 #x5909 #x590A #x590B #x590C
- #x590E #x5910 #x5911 #x5912 #x5913 #x5917 #x5918 #x591B #x591D #x591E
- #x5920 #x5921 #x5922 #x5923 #x5926 #x5928 #x592C #x5930 #x5932 #x5933
- #x5935 #x5936 #x593B #x593D #x593E #x593F #x5940 #x5943 #x5945 #x5946
- #x594A #x594C #x594D #x5950 #x5952 #x5953 #x5959 #x595B #x595C #x595D
- #x595E #x595F #x5961 #x5963 #x5964 #x5966 #x5967 #x5968 #x5969 #x596A
- #x596B #x596C #x596D #x596E #x596F #x5970 #x5971 #x5972 #x5975 #x5977
- #x597A #x597B #x597C #x597E #x597F #x5980 #x5985 #x5989 #x598B #x598C
- #x598E #x598F #x5990 #x5991 #x5994 #x5995 #x5998 #x599A #x599B #x599C
- #x599D #x599F #x59A0 #x59A1 #x59A2 #x59A6 #x59A7 #x59AC #x59AD #x59B0
- #x59B1 #x59B3 #x59B4 #x59B5 #x59B6 #x59B7 #x59B8 #x59BA #x59BC #x59BD
- #x59BF #x59C0 #x59C1 #x59C2 #x59C3 #x59C4 #x59C5 #x59C7 #x59C8 #x59C9
- #x59CC #x59CD #x59CE #x59CF #x59D5 #x59D6 #x59D9 #x59DB #x59DE #x59DF
- #x59E0 #x59E1 #x59E2 #x59E4 #x59E6 #x59E7 #x59E9 #x59EA #x59EB #x59ED
- #x59EE #x59EF #x59F0 #x59F1 #x59F2 #x59F3 #x59F4 #x59F5 #x59F6 #x59F7
- #x59F8 #x59FA #x59FC #x59FD #x59FE #x5A00 #x5A02 #x5A0A #x5A0B #x5A0D
- #x5A0E #x5A0F #x5A10 #x5A12 #x5A14 #x5A15 #x5A16 #x5A17 #x5A19 #x5A1A
- #x5A1B #x5A1D #x5A1E #x5A21 #x5A22 #x5A24 #x5A26 #x5A27 #x5A28 #x5A2A
- #x5A2B #x5A2C #x5A2D #x5A2E #x5A2F #x5A30 #x5A33 #x5A35 #x5A37 #x5A38
- #x5A39 #x5A3A #x5A3B #x5A3D #x5A3E #x5A3F #x5A41 #x5A42 #x5A43 #x5A44
- #x5A45 #x5A47 #x5A48 #x5A4B #x5A4C #x5A4D #x5A4E #x5A4F #x5A50 #x5A51
- #x5A52 #x5A53 #x5A54 #x5A56 #x5A57 #x5A58 #x5A59 #x5A5B #x5A5C #x5A5D
- #x5A5E #x5A5F #x5A60 #x5A61 #x5A63 #x5A64 #x5A65 #x5A66 #x5A68 #x5A69
- #x5A6B #x5A6C #x5A6D #x5A6E #x5A6F #x5A70 #x5A71 #x5A72 #x5A73 #x5A78
- #x5A79 #x5A7B #x5A7C #x5A7D #x5A7E #x5A80 #x5A81 #x5A82 #x5A83 #x5A84
- #x5A85 #x5A86 #x5A87 #x5A88 #x5A89 #x5A8A #x5A8B #x5A8C #x5A8D #x5A8E
- #x5A8F #x5A90 #x5A91 #x5A93 #x5A94 #x5A95 #x5A96 #x5A97 #x5A98 #x5A99
- #x5A9C #x5A9D #x5A9E #x5A9F #x5AA0 #x5AA1 #x5AA2 #x5AA3 #x5AA4 #x5AA5
- #x5AA6 #x5AA7 #x5AA8 #x5AA9 #x5AAB #x5AAC #x5AAD #x5AAE #x5AAF #x5AB0
- #x5AB1 #x5AB4 #x5AB6 #x5AB7 #x5AB9 #x5ABA #x5ABB #x5ABC #x5ABD #x5ABF
- #x5AC0 #x5AC3 #x5AC4 #x5AC5 #x5AC6 #x5AC7 #x5AC8 #x5ACA #x5ACB #x5ACD
- #x5ACE #x5ACF #x5AD0 #x5AD1 #x5AD3 #x5AD5 #x5AD7 #x5AD9 #x5ADA #x5ADB
- #x5ADD #x5ADE #x5ADF #x5AE2 #x5AE4 #x5AE5 #x5AE7 #x5AE8 #x5AEA #x5AEC
- #x5AED #x5AEE #x5AEF #x5AF0 #x5AF2 #x5AF3 #x5AF4 #x5AF5 #x5AF6 #x5AF7
- #x5AF8 #x5AF9 #x5AFA #x5AFB #x5AFC #x5AFD #x5AFE #x5AFF #x5B00 #x5B01
- #x5B02 #x5B03 #x5B04 #x5B05 #x5B06 #x5B07 #x5B08 #x5B0A #x5B0B #x5B0C
- #x5B0D #x5B0E #x5B0F #x5B10 #x5B11 #x5B12 #x5B13 #x5B14 #x5B15 #x5B18
- #x5B19 #x5B1A #x5B1B #x5B1C #x5B1D #x5B1E #x5B1F #x5B20 #x5B21 #x5B22
- #x5B23 #x5B24 #x5B25 #x5B26 #x5B27 #x5B28 #x5B29 #x5B2A #x5B2B #x5B2C
- #x5B2D #x5B2E #x5B2F #x5B30 #x5B31 #x5B33 #x5B35 #x5B36 #x5B38 #x5B39
- #x5B3A #x5B3B #x5B3C #x5B3D #x5B3E #x5B3F #x5B41 #x5B42 #x5B43 #x5B44
- #x5B45 #x5B46 #x5B47 #x5B48 #x5B49 #x5B4A #x5B4B #x5B4C #x5B4D #x5B4E
- #x5B4F #x5B52 #x5B56 #x5B5E #x5B60 #x5B61 #x5B67 #x5B68 #x5B6B #x5B6D
- #x5B6E #x5B6F #x5B72 #x5B74 #x5B76 #x5B77 #x5B78 #x5B79 #x5B7B #x5B7C
- #x5B7E #x5B7F #x5B82 #x5B86 #x5B8A #x5B8D #x5B8E #x5B90 #x5B91 #x5B92
- #x5B94 #x5B96 #x5B9F #x5BA7 #x5BA8 #x5BA9 #x5BAC #x5BAD #x5BAE #x5BAF
- #x5BB1 #x5BB2 #x5BB7 #x5BBA #x5BBB #x5BBC #x5BC0 #x5BC1 #x5BC3 #x5BC8
- #x5BC9 #x5BCA #x5BCB #x5BCD #x5BCE #x5BCF #x5BD1 #x5BD4 #x5BD5 #x5BD6
- #x5BD7 #x5BD8 #x5BD9 #x5BDA #x5BDB #x5BDC #x5BE0 #x5BE2 #x5BE3 #x5BE6
- #x5BE7 #x5BE9 #x5BEA #x5BEB #x5BEC #x5BED #x5BEF #x5BF1 #x5BF2 #x5BF3
- #x5BF4 #x5BF5 #x5BF6 #x5BF7 #x5BFD #x5BFE #x5C00 #x5C02 #x5C03 #x5C05
- #x5C07 #x5C08 #x5C0B #x5C0C #x5C0D #x5C0E #x5C10 #x5C12 #x5C13 #x5C17
- #x5C19 #x5C1B #x5C1E #x5C1F #x5C20 #x5C21 #x5C23 #x5C26 #x5C28 #x5C29
- #x5C2A #x5C2B #x5C2D #x5C2E #x5C2F #x5C30 #x5C32 #x5C33 #x5C35 #x5C36
- #x5C37 #x5C43 #x5C44 #x5C46 #x5C47 #x5C4C #x5C4D #x5C52 #x5C53 #x5C54
- #x5C56 #x5C57 #x5C58 #x5C5A #x5C5B #x5C5C #x5C5D #x5C5F #x5C62 #x5C64
- #x5C67 #x5C68 #x5C69 #x5C6A #x5C6B #x5C6C #x5C6D #x5C70 #x5C72 #x5C73
- #x5C74 #x5C75 #x5C76 #x5C77 #x5C78 #x5C7B #x5C7C #x5C7D #x5C7E #x5C80
- #x5C83 #x5C84 #x5C85 #x5C86 #x5C87 #x5C89 #x5C8A #x5C8B #x5C8E #x5C8F
- #x5C92 #x5C93 #x5C95 #x5C9D #x5C9E #x5C9F #x5CA0 #x5CA1 #x5CA4 #x5CA5
- #x5CA6 #x5CA7 #x5CA8 #x5CAA #x5CAE #x5CAF #x5CB0 #x5CB2 #x5CB4 #x5CB6
- #x5CB9 #x5CBA #x5CBB #x5CBC #x5CBE #x5CC0 #x5CC2 #x5CC3 #x5CC5 #x5CC6
- #x5CC7 #x5CC8 #x5CC9 #x5CCA #x5CCC #x5CCD #x5CCE #x5CCF #x5CD0 #x5CD1
- #x5CD3 #x5CD4 #x5CD5 #x5CD6 #x5CD7 #x5CD8 #x5CDA #x5CDB #x5CDC #x5CDD
- #x5CDE #x5CDF #x5CE0 #x5CE2 #x5CE3 #x5CE7 #x5CE9 #x5CEB #x5CEC #x5CEE
- #x5CEF #x5CF1 #x5CF2 #x5CF3 #x5CF4 #x5CF5 #x5CF6 #x5CF7 #x5CF8 #x5CF9
- #x5CFA #x5CFC #x5CFD #x5CFE #x5CFF #x5D00 #x5D01 #x5D04 #x5D05 #x5D08
- #x5D09 #x5D0A #x5D0B #x5D0C #x5D0D #x5D0F #x5D10 #x5D11 #x5D12 #x5D13
- #x5D15 #x5D17 #x5D18 #x5D19 #x5D1A #x5D1C #x5D1D #x5D1F #x5D20 #x5D21
- #x5D22 #x5D23 #x5D25 #x5D28 #x5D2A #x5D2B #x5D2C #x5D2F #x5D30 #x5D31
- #x5D32 #x5D33 #x5D35 #x5D36 #x5D37 #x5D38 #x5D39 #x5D3A #x5D3B #x5D3C
- #x5D3F #x5D40 #x5D41 #x5D42 #x5D43 #x5D44 #x5D45 #x5D46 #x5D48 #x5D49
- #x5D4D #x5D4E #x5D4F #x5D50 #x5D51 #x5D52 #x5D53 #x5D54 #x5D55 #x5D56
- #x5D57 #x5D59 #x5D5A #x5D5C #x5D5E #x5D5F #x5D60 #x5D61 #x5D62 #x5D63
- #x5D64 #x5D65 #x5D66 #x5D67 #x5D68 #x5D6A #x5D6D #x5D6E #x5D70 #x5D71
- #x5D72 #x5D73 #x5D75 #x5D76 #x5D77 #x5D78 #x5D79 #x5D7A #x5D7B #x5D7C
- #x5D7D #x5D7E #x5D7F #x5D80 #x5D81 #x5D83 #x5D84 #x5D85 #x5D86 #x5D87
- #x5D88 #x5D89 #x5D8A #x5D8B #x5D8C #x5D8D #x5D8E #x5D8F #x5D90 #x5D91
- #x5D92 #x5D93 #x5D94 #x5D95 #x5D96 #x5D97 #x5D98 #x5D9A #x5D9B #x5D9C
- #x5D9E #x5D9F #x5DA0 #x5DA1 #x5DA2 #x5DA3 #x5DA4 #x5DA5 #x5DA6 #x5DA7
- #x5DA8 #x5DA9 #x5DAA #x5DAB #x5DAC #x5DAD #x5DAE #x5DAF #x5DB0 #x5DB1
- #x5DB2 #x5DB3 #x5DB4 #x5DB5 #x5DB6 #x5DB8 #x5DB9 #x5DBA #x5DBB #x5DBC
- #x5DBD #x5DBE #x5DBF #x5DC0 #x5DC1 #x5DC2 #x5DC3 #x5DC4 #x5DC6 #x5DC7
- #x5DC8 #x5DC9 #x5DCA #x5DCB #x5DCC #x5DCE #x5DCF #x5DD0 #x5DD1 #x5DD2
- #x5DD3 #x5DD4 #x5DD5 #x5DD6 #x5DD7 #x5DD8 #x5DD9 #x5DDA #x5DDC #x5DDF
- #x5DE0 #x5DE3 #x5DE4 #x5DEA #x5DEC #x5DED #x5DF0 #x5DF5 #x5DF6 #x5DF8
- #x5DF9 #x5DFA #x5DFB #x5DFC #x5DFF #x5E00 #x5E04 #x5E07 #x5E09 #x5E0A
- #x5E0B #x5E0D #x5E0E #x5E12 #x5E13 #x5E17 #x5E1E #x5E1F #x5E20 #x5E21
- #x5E22 #x5E23 #x5E24 #x5E25 #x5E28 #x5E29 #x5E2A #x5E2B #x5E2C #x5E2F
- #x5E30 #x5E32 #x5E33 #x5E34 #x5E35 #x5E36 #x5E39 #x5E3A #x5E3E #x5E3F
- #x5E40 #x5E41 #x5E43 #x5E46 #x5E47 #x5E48 #x5E49 #x5E4A #x5E4B #x5E4D
- #x5E4E #x5E4F #x5E50 #x5E51 #x5E52 #x5E53 #x5E56 #x5E57 #x5E58 #x5E59
- #x5E5A #x5E5C #x5E5D #x5E5F #x5E60 #x5E63 #x5E64 #x5E65 #x5E66 #x5E67
- #x5E68 #x5E69 #x5E6A #x5E6B #x5E6C #x5E6D #x5E6E #x5E6F #x5E70 #x5E71
- #x5E75 #x5E77 #x5E79 #x5E7E #x5E81 #x5E82 #x5E83 #x5E85 #x5E88 #x5E89
- #x5E8C #x5E8D #x5E8E #x5E92 #x5E98 #x5E9B #x5E9D #x5EA1 #x5EA2 #x5EA3
- #x5EA4 #x5EA8 #x5EA9 #x5EAA #x5EAB #x5EAC #x5EAE #x5EAF #x5EB0 #x5EB1
- #x5EB2 #x5EB4 #x5EBA #x5EBB #x5EBC #x5EBD #x5EBF #x5EC0 #x5EC1 #x5EC2
- #x5EC3 #x5EC4 #x5EC5 #x5EC6 #x5EC7 #x5EC8 #x5ECB #x5ECC #x5ECD #x5ECE
- #x5ECF #x5ED0 #x5ED4 #x5ED5 #x5ED7 #x5ED8 #x5ED9 #x5EDA #x5EDC #x5EDD
- #x5EDE #x5EDF #x5EE0 #x5EE1 #x5EE2 #x5EE3 #x5EE4 #x5EE5 #x5EE6 #x5EE7
- #x5EE9 #x5EEB #x5EEC #x5EED #x5EEE #x5EEF #x5EF0 #x5EF1 #x5EF2 #x5EF3
- #x5EF5 #x5EF8 #x5EF9 #x5EFB #x5EFC #x5EFD #x5F05 #x5F06 #x5F07 #x5F09
- #x5F0C #x5F0D #x5F0E #x5F10 #x5F12 #x5F14 #x5F16 #x5F19 #x5F1A #x5F1C
- #x5F1D #x5F1E #x5F21 #x5F22 #x5F23 #x5F24 #x5F28 #x5F2B #x5F2C #x5F2E
- #x5F30 #x5F32 #x5F33 #x5F34 #x5F35 #x5F36 #x5F37 #x5F38 #x5F3B #x5F3D
- #x5F3E #x5F3F #x5F41 #x5F42 #x5F43 #x5F44 #x5F45 #x5F46 #x5F47 #x5F48
- #x5F49 #x5F4A #x5F4B #x5F4C #x5F4D #x5F4E #x5F4F #x5F51 #x5F54 #x5F59
- #x5F5A #x5F5B #x5F5C #x5F5E #x5F5F #x5F60 #x5F63 #x5F65 #x5F67 #x5F68
- #x5F6B #x5F6E #x5F6F #x5F72 #x5F74 #x5F75 #x5F76 #x5F78 #x5F7A #x5F7D
- #x5F7E #x5F7F #x5F83 #x5F86 #x5F8D #x5F8E #x5F8F #x5F91 #x5F93 #x5F94
- #x5F96 #x5F9A #x5F9B #x5F9D #x5F9E #x5F9F #x5FA0 #x5FA2 #x5FA3 #x5FA4
- #x5FA5 #x5FA6 #x5FA7 #x5FA9 #x5FAB #x5FAC #x5FAF #x5FB0 #x5FB1 #x5FB2
- #x5FB3 #x5FB4 #x5FB6 #x5FB8 #x5FB9 #x5FBA #x5FBB #x5FBE #x5FBF #x5FC0
- #x5FC1 #x5FC2 #x5FC7 #x5FC8 #x5FCA #x5FCB #x5FCE #x5FD3 #x5FD4 #x5FD5
- #x5FDA #x5FDB #x5FDC #x5FDE #x5FDF #x5FE2 #x5FE3 #x5FE5 #x5FE6 #x5FE8
- #x5FE9 #x5FEC #x5FEF #x5FF0 #x5FF2 #x5FF3 #x5FF4 #x5FF6 #x5FF7 #x5FF9
- #x5FFA #x5FFC #x6007 #x6008 #x6009 #x600B #x600C #x6010 #x6011 #x6013
- #x6017 #x6018 #x601A #x601E #x601F #x6022 #x6023 #x6024 #x602C #x602D
- #x602E #x6030 #x6031 #x6032 #x6033 #x6034 #x6036 #x6037 #x6038 #x6039
- #x603A #x603D #x603E #x6040 #x6044 #x6045 #x6046 #x6047 #x6048 #x6049
- #x604A #x604C #x604E #x604F #x6051 #x6053 #x6054 #x6056 #x6057 #x6058
- #x605B #x605C #x605E #x605F #x6060 #x6061 #x6065 #x6066 #x606E #x6071
- #x6072 #x6074 #x6075 #x6077 #x607E #x6080 #x6081 #x6082 #x6085 #x6086
- #x6087 #x6088 #x608A #x608B #x608E #x608F #x6090 #x6091 #x6093 #x6095
- #x6097 #x6098 #x6099 #x609C #x609E #x60A1 #x60A2 #x60A4 #x60A5 #x60A7
- #x60A9 #x60AA #x60AE #x60B0 #x60B3 #x60B5 #x60B6 #x60B7 #x60B9 #x60BA
- #x60BD #x60BE #x60BF #x60C0 #x60C1 #x60C2 #x60C3 #x60C4 #x60C7 #x60C8
- #x60C9 #x60CC #x60CD #x60CE #x60CF #x60D0 #x60D2 #x60D3 #x60D4 #x60D6
- #x60D7 #x60D9 #x60DB #x60DE #x60E1 #x60E2 #x60E3 #x60E4 #x60E5 #x60EA
- #x60F1 #x60F2 #x60F5 #x60F7 #x60F8 #x60FB #x60FC #x60FD #x60FE #x60FF
- #x6102 #x6103 #x6104 #x6105 #x6107 #x610A #x610B #x610C #x6110 #x6111
- #x6112 #x6113 #x6114 #x6116 #x6117 #x6118 #x6119 #x611B #x611C #x611D
- #x611E #x6121 #x6122 #x6125 #x6128 #x6129 #x612A #x612C #x612D #x612E
- #x612F #x6130 #x6131 #x6132 #x6133 #x6134 #x6135 #x6136 #x6137 #x6138
- #x6139 #x613A #x613B #x613C #x613D #x613E #x6140 #x6141 #x6142 #x6143
- #x6144 #x6145 #x6146 #x6147 #x6149 #x614B #x614D #x614F #x6150 #x6152
- #x6153 #x6154 #x6156 #x6157 #x6158 #x6159 #x615A #x615B #x615C #x615E
- #x615F #x6160 #x6161 #x6163 #x6164 #x6165 #x6166 #x6169 #x616A #x616B
- #x616C #x616D #x616E #x616F #x6171 #x6172 #x6173 #x6174 #x6176 #x6178
- #x6179 #x617A #x617B #x617C #x617D #x617E #x617F #x6180 #x6181 #x6182
- #x6183 #x6184 #x6185 #x6186 #x6187 #x6188 #x6189 #x618A #x618C #x618D
- #x618F #x6190 #x6191 #x6192 #x6193 #x6195 #x6196 #x6197 #x6198 #x6199
- #x619A #x619B #x619C #x619E #x619F #x61A0 #x61A1 #x61A2 #x61A3 #x61A4
- #x61A5 #x61A6 #x61AA #x61AB #x61AD #x61AE #x61AF #x61B0 #x61B1 #x61B2
- #x61B3 #x61B4 #x61B5 #x61B6 #x61B8 #x61B9 #x61BA #x61BB #x61BC #x61BD
- #x61BF #x61C0 #x61C1 #x61C3 #x61C4 #x61C5 #x61C6 #x61C7 #x61C9 #x61CC
- #x61CD #x61CE #x61CF #x61D0 #x61D3 #x61D5 #x61D6 #x61D7 #x61D8 #x61D9
- #x61DA #x61DB #x61DC #x61DD #x61DE #x61DF #x61E0 #x61E1 #x61E2 #x61E3
- #x61E4 #x61E5 #x61E7 #x61E8 #x61E9 #x61EA #x61EB #x61EC #x61ED #x61EE
- #x61EF #x61F0 #x61F1 #x61F2 #x61F3 #x61F4 #x61F6 #x61F7 #x61F8 #x61F9
- #x61FA #x61FB #x61FC #x61FD #x61FE #x6200 #x6201 #x6202 #x6203 #x6204
- #x6205 #x6207 #x6209 #x6213 #x6214 #x6219 #x621C #x621D #x621E #x6220
- #x6223 #x6226 #x6227 #x6228 #x6229 #x622B #x622D #x622F #x6230 #x6231
- #x6232 #x6235 #x6236 #x6238 #x6239 #x623A #x623B #x623C #x6242 #x6244
- #x6245 #x6246 #x624A #x624F #x6250 #x6255 #x6256 #x6257 #x6259 #x625A
- #x625C #x625D #x625E #x625F #x6260 #x6261 #x6262 #x6264 #x6265 #x6268
- #x6271 #x6272 #x6274 #x6275 #x6277 #x6278 #x627A #x627B #x627D #x6281
- #x6282 #x6283 #x6285 #x6286 #x6287 #x6288 #x628B #x628C #x628D #x628E
- #x628F #x6290 #x6294 #x6299 #x629C #x629D #x629E #x62A3 #x62A6 #x62A7
- #x62A9 #x62AA #x62AD #x62AE #x62AF #x62B0 #x62B2 #x62B3 #x62B4 #x62B6
- #x62B7 #x62B8 #x62BA #x62BE #x62C0 #x62C1 #x62C3 #x62CB #x62CF #x62D1
- #x62D5 #x62DD #x62DE #x62E0 #x62E1 #x62E4 #x62EA #x62EB #x62F0 #x62F2
- #x62F5 #x62F8 #x62F9 #x62FA #x62FB #x6300 #x6303 #x6304 #x6305 #x6306
- #x630A #x630B #x630C #x630D #x630F #x6310 #x6312 #x6313 #x6314 #x6315
- #x6317 #x6318 #x6319 #x631C #x6326 #x6327 #x6329 #x632C #x632D #x632E
- #x6330 #x6331 #x6333 #x6334 #x6335 #x6336 #x6337 #x6338 #x633B #x633C
- #x633E #x633F #x6340 #x6341 #x6344 #x6347 #x6348 #x634A #x6351 #x6352
- #x6353 #x6354 #x6356 #x6357 #x6358 #x6359 #x635A #x635B #x635C #x635D
- #x6360 #x6364 #x6365 #x6366 #x6368 #x636A #x636B #x636C #x636F #x6370
- #x6372 #x6373 #x6374 #x6375 #x6378 #x6379 #x637C #x637D #x637E #x637F
- #x6381 #x6383 #x6384 #x6385 #x6386 #x638B #x638D #x6391 #x6393 #x6394
- #x6395 #x6397 #x6399 #x639A #x639B #x639C #x639D #x639E #x639F #x63A1
- #x63A4 #x63A6 #x63AB #x63AF #x63B1 #x63B2 #x63B5 #x63B6 #x63B9 #x63BB
- #x63BD #x63BF #x63C0 #x63C1 #x63C2 #x63C3 #x63C5 #x63C7 #x63C8 #x63CA
- #x63CB #x63CC #x63D1 #x63D3 #x63D4 #x63D5 #x63D7 #x63D8 #x63D9 #x63DA
- #x63DB #x63DC #x63DD #x63DF #x63E2 #x63E4 #x63E5 #x63E6 #x63E7 #x63E8
- #x63EB #x63EC #x63EE #x63EF #x63F0 #x63F1 #x63F3 #x63F5 #x63F7 #x63F9
- #x63FA #x63FB #x63FC #x63FE #x6403 #x6404 #x6406 #x6407 #x6408 #x6409
- #x640A #x640D #x640E #x6411 #x6412 #x6415 #x6416 #x6417 #x6418 #x6419
- #x641A #x641D #x641F #x6422 #x6423 #x6424 #x6425 #x6427 #x6428 #x6429
- #x642B #x642E #x642F #x6430 #x6431 #x6432 #x6433 #x6435 #x6436 #x6437
- #x6438 #x6439 #x643B #x643C #x643E #x6440 #x6442 #x6443 #x6449 #x644B
- #x644C #x644D #x644E #x644F #x6450 #x6451 #x6453 #x6455 #x6456 #x6457
- #x6459 #x645A #x645B #x645C #x645D #x645F #x6460 #x6461 #x6462 #x6463
- #x6464 #x6465 #x6466 #x6468 #x646A #x646B #x646C #x646E #x646F #x6470
- #x6471 #x6472 #x6473 #x6474 #x6475 #x6476 #x6477 #x647B #x647C #x647D
- #x647E #x647F #x6480 #x6481 #x6483 #x6486 #x6488 #x6489 #x648A #x648B
- #x648C #x648D #x648E #x648F #x6490 #x6493 #x6494 #x6497 #x6498 #x649A
- #x649B #x649C #x649D #x649F #x64A0 #x64A1 #x64A2 #x64A3 #x64A5 #x64A6
- #x64A7 #x64A8 #x64AA #x64AB #x64AF #x64B1 #x64B2 #x64B3 #x64B4 #x64B6
- #x64B9 #x64BB #x64BD #x64BE #x64BF #x64C1 #x64C3 #x64C4 #x64C6 #x64C7
- #x64C8 #x64C9 #x64CA #x64CB #x64CC #x64CF #x64D1 #x64D3 #x64D4 #x64D5
- #x64D6 #x64D9 #x64DA #x64DB #x64DC #x64DD #x64DF #x64E0 #x64E1 #x64E3
- #x64E5 #x64E7 #x64E8 #x64E9 #x64EA #x64EB #x64EC #x64ED #x64EE #x64EF
- #x64F0 #x64F1 #x64F2 #x64F3 #x64F4 #x64F5 #x64F6 #x64F7 #x64F8 #x64F9
- #x64FA #x64FB #x64FC #x64FD #x64FE #x64FF #x6501 #x6502 #x6503 #x6504
- #x6505 #x6506 #x6507 #x6508 #x650A #x650B #x650C #x650D #x650E #x650F
- #x6510 #x6511 #x6513 #x6514 #x6515 #x6516 #x6517 #x6519 #x651A #x651B
- #x651C #x651D #x651E #x651F #x6520 #x6521 #x6522 #x6523 #x6524 #x6526
- #x6527 #x6528 #x6529 #x652A #x652C #x652D #x6530 #x6531 #x6532 #x6533
- #x6537 #x653A #x653C #x653D #x6540 #x6541 #x6542 #x6543 #x6544 #x6546
- #x6547 #x654A #x654B #x654D #x654E #x6550 #x6552 #x6553 #x6554 #x6557
- #x6558 #x655A #x655C #x655F #x6560 #x6561 #x6564 #x6565 #x6567 #x6568
- #x6569 #x656A #x656D #x656E #x656F #x6571 #x6573 #x6575 #x6576 #x6578
- #x6579 #x657A #x657B #x657C #x657D #x657E #x657F #x6580 #x6581 #x6582
- #x6583 #x6584 #x6585 #x6586 #x6588 #x6589 #x658A #x658D #x658E #x658F
- #x6592 #x6594 #x6595 #x6596 #x6598 #x659A #x659D #x659E #x65A0 #x65A2
- #x65A3 #x65A6 #x65A8 #x65AA #x65AC #x65AE #x65B1 #x65B2 #x65B3 #x65B4
- #x65B5 #x65B6 #x65B7 #x65B8 #x65BA #x65BB #x65BE #x65BF #x65C0 #x65C2
- #x65C7 #x65C8 #x65C9 #x65CA #x65CD #x65D0 #x65D1 #x65D3 #x65D4 #x65D5
- #x65D8 #x65D9 #x65DA #x65DB #x65DC #x65DD #x65DE #x65DF #x65E1 #x65E3
- #x65E4 #x65EA #x65EB #x65F2 #x65F3 #x65F4 #x65F5 #x65F8 #x65F9 #x65FB
- #x65FC #x65FD #x65FE #x65FF #x6601 #x6604 #x6605 #x6607 #x6608 #x6609
- #x660B #x660D #x6610 #x6611 #x6612 #x6616 #x6617 #x6618 #x661A #x661B
- #x661C #x661E #x6621 #x6622 #x6623 #x6624 #x6626 #x6629 #x662A #x662B
- #x662C #x662E #x6630 #x6632 #x6633 #x6637 #x6638 #x6639 #x663A #x663B
- #x663D #x663F #x6640 #x6642 #x6644 #x6645 #x6646 #x6647 #x6648 #x6649
- #x664A #x664D #x664E #x6650 #x6651 #x6658 #x6659 #x665B #x665C #x665D
- #x665E #x6660 #x6662 #x6663 #x6665 #x6667 #x6669 #x666A #x666B #x666C
- #x666D #x6671 #x6672 #x6673 #x6675 #x6678 #x6679 #x667B #x667C #x667D
- #x667F #x6680 #x6681 #x6683 #x6685 #x6686 #x6688 #x6689 #x668A #x668B
- #x668D #x668E #x668F #x6690 #x6692 #x6693 #x6694 #x6695 #x6698 #x6699
- #x669A #x669B #x669C #x669E #x669F #x66A0 #x66A1 #x66A2 #x66A3 #x66A4
- #x66A5 #x66A6 #x66A9 #x66AA #x66AB #x66AC #x66AD #x66AF #x66B0 #x66B1
- #x66B2 #x66B3 #x66B5 #x66B6 #x66B7 #x66B8 #x66BA #x66BB #x66BC #x66BD
- #x66BF #x66C0 #x66C1 #x66C2 #x66C3 #x66C4 #x66C5 #x66C6 #x66C7 #x66C8
- #x66C9 #x66CA #x66CB #x66CC #x66CD #x66CE #x66CF #x66D0 #x66D1 #x66D2
- #x66D3 #x66D4 #x66D5 #x66D6 #x66D7 #x66D8 #x66DA #x66DE #x66DF #x66E0
- #x66E1 #x66E2 #x66E3 #x66E4 #x66E5 #x66E7 #x66E8 #x66EA #x66EB #x66EC
- #x66ED #x66EE #x66EF #x66F1 #x66F5 #x66F6 #x66F8 #x66FA #x66FB #x66FD
- #x6701 #x6702 #x6703 #x6704 #x6705 #x6706 #x6707 #x670C #x670E #x670F
- #x6711 #x6712 #x6713 #x6716 #x6718 #x6719 #x671A #x671C #x671E #x6720
- #x6721 #x6722 #x6723 #x6724 #x6725 #x6727 #x6729 #x672E #x6730 #x6732
- #x6733 #x6736 #x6737 #x6738 #x6739 #x673B #x673C #x673E #x673F #x6741
- #x6744 #x6745 #x6747 #x674A #x674B #x674D #x6752 #x6754 #x6755 #x6757
- #x6758 #x6759 #x675A #x675B #x675D #x6762 #x6763 #x6764 #x6766 #x6767
- #x676B #x676C #x676E #x6771 #x6774 #x6776 #x6778 #x6779 #x677A #x677B
- #x677D #x6780 #x6782 #x6783 #x6785 #x6786 #x6788 #x678A #x678C #x678D
- #x678E #x678F #x6791 #x6792 #x6793 #x6794 #x6796 #x6799 #x679B #x679F
- #x67A0 #x67A1 #x67A4 #x67A6 #x67A9 #x67AC #x67AE #x67B1 #x67B2 #x67B4
- #x67B9 #x67BA #x67BB #x67BC #x67BD #x67BE #x67BF #x67C0 #x67C2 #x67C5
- #x67C6 #x67C7 #x67C8 #x67C9 #x67CA #x67CB #x67CC #x67CD #x67CE #x67D5
- #x67D6 #x67D7 #x67DB #x67DF #x67E1 #x67E3 #x67E4 #x67E6 #x67E7 #x67E8
- #x67EA #x67EB #x67ED #x67EE #x67F2 #x67F5 #x67F6 #x67F7 #x67F8 #x67F9
- #x67FA #x67FB #x67FC #x67FE #x6801 #x6802 #x6803 #x6804 #x6806 #x680D
- #x6810 #x6812 #x6814 #x6815 #x6818 #x6819 #x681A #x681B #x681C #x681E
- #x681F #x6820 #x6822 #x6823 #x6824 #x6825 #x6826 #x6827 #x6828 #x682B
- #x682C #x682D #x682E #x682F #x6830 #x6831 #x6834 #x6835 #x6836 #x683A
- #x683B #x683F #x6847 #x684B #x684D #x684F #x6852 #x6856 #x6857 #x6858
- #x6859 #x685A #x685B #x685C #x685D #x685E #x685F #x686A #x686C #x686D
- #x686E #x686F #x6870 #x6871 #x6872 #x6873 #x6875 #x6878 #x6879 #x687A
- #x687B #x687C #x687D #x687E #x687F #x6880 #x6882 #x6884 #x6887 #x6888
- #x6889 #x688A #x688B #x688C #x688D #x688E #x6890 #x6891 #x6892 #x6894
- #x6895 #x6896 #x6898 #x6899 #x689A #x689B #x689C #x689D #x689E #x689F
- #x68A0 #x68A1 #x68A3 #x68A4 #x68A5 #x68A9 #x68AA #x68AB #x68AC #x68AE
- #x68B1 #x68B2 #x68B4 #x68B6 #x68B7 #x68B8 #x68B9 #x68BA #x68BB #x68BC
- #x68BD #x68BE #x68BF #x68C1 #x68C3 #x68C4 #x68C5 #x68C6 #x68C7 #x68C8
- #x68CA #x68CC #x68CE #x68CF #x68D0 #x68D1 #x68D3 #x68D4 #x68D6 #x68D7
- #x68D9 #x68DB #x68DC #x68DD #x68DE #x68DF #x68E1 #x68E2 #x68E4 #x68E5
- #x68E6 #x68E7 #x68E8 #x68E9 #x68EA #x68EB #x68EC #x68ED #x68EF #x68F2
- #x68F3 #x68F4 #x68F6 #x68F7 #x68F8 #x68FB #x68FD #x68FE #x68FF #x6900
- #x6902 #x6903 #x6904 #x6906 #x6907 #x6908 #x6909 #x690A #x690C #x690F
- #x6911 #x6913 #x6914 #x6915 #x6916 #x6917 #x6918 #x6919 #x691A #x691B
- #x691C #x691D #x691E #x6921 #x6922 #x6923 #x6925 #x6926 #x6927 #x6928
- #x6929 #x692A #x692B #x692C #x692E #x692F #x6931 #x6932 #x6933 #x6935
- #x6936 #x6937 #x6938 #x693A #x693B #x693C #x693E #x6940 #x6941 #x6943
- #x6944 #x6945 #x6946 #x6947 #x6948 #x6949 #x694A #x694B #x694C #x694D
- #x694E #x694F #x6950 #x6951 #x6952 #x6953 #x6955 #x6956 #x6958 #x6959
- #x695B #x695C #x695F #x6961 #x6962 #x6964 #x6965 #x6967 #x6968 #x6969
- #x696A #x696C #x696D #x696F #x6970 #x6972 #x6973 #x6974 #x6975 #x6976
- #x697A #x697B #x697D #x697E #x697F #x6981 #x6983 #x6985 #x698A #x698B
- #x698C #x698E #x698F #x6990 #x6991 #x6992 #x6993 #x6996 #x6997 #x6999
- #x699A #x699D #x699E #x699F #x69A0 #x69A1 #x69A2 #x69A3 #x69A4 #x69A5
- #x69A6 #x69A9 #x69AA #x69AC #x69AE #x69AF #x69B0 #x69B2 #x69B3 #x69B5
- #x69B6 #x69B8 #x69B9 #x69BA #x69BC #x69BD #x69BE #x69BF #x69C0 #x69C2
- #x69C3 #x69C4 #x69C5 #x69C6 #x69C7 #x69C8 #x69C9 #x69CB #x69CD #x69CF
- #x69D1 #x69D2 #x69D3 #x69D5 #x69D6 #x69D7 #x69D8 #x69D9 #x69DA #x69DC
- #x69DD #x69DE #x69E1 #x69E2 #x69E3 #x69E4 #x69E5 #x69E6 #x69E7 #x69E8
- #x69E9 #x69EA #x69EB #x69EC #x69EE #x69EF #x69F0 #x69F1 #x69F3 #x69F4
- #x69F5 #x69F6 #x69F7 #x69F8 #x69F9 #x69FA #x69FB #x69FC #x69FE #x6A00
- #x6A01 #x6A02 #x6A03 #x6A04 #x6A05 #x6A06 #x6A07 #x6A08 #x6A09 #x6A0B
- #x6A0C #x6A0D #x6A0E #x6A0F #x6A10 #x6A11 #x6A12 #x6A13 #x6A14 #x6A15
- #x6A16 #x6A19 #x6A1A #x6A1B #x6A1C #x6A1D #x6A1E #x6A20 #x6A22 #x6A23
- #x6A24 #x6A25 #x6A26 #x6A27 #x6A29 #x6A2B #x6A2C #x6A2D #x6A2E #x6A30
- #x6A32 #x6A33 #x6A34 #x6A36 #x6A37 #x6A38 #x6A39 #x6A3A #x6A3B #x6A3C
- #x6A3F #x6A40 #x6A41 #x6A42 #x6A43 #x6A45 #x6A46 #x6A48 #x6A49 #x6A4A
- #x6A4B #x6A4C #x6A4D #x6A4E #x6A4F #x6A51 #x6A52 #x6A53 #x6A54 #x6A55
- #x6A56 #x6A57 #x6A5A #x6A5C #x6A5D #x6A5E #x6A5F #x6A60 #x6A62 #x6A63
- #x6A64 #x6A66 #x6A67 #x6A68 #x6A69 #x6A6A #x6A6B #x6A6C #x6A6D #x6A6E
- #x6A6F #x6A70 #x6A72 #x6A73 #x6A74 #x6A75 #x6A76 #x6A77 #x6A78 #x6A7A
- #x6A7B #x6A7D #x6A7E #x6A7F #x6A81 #x6A82 #x6A83 #x6A85 #x6A86 #x6A87
- #x6A88 #x6A89 #x6A8A #x6A8B #x6A8C #x6A8D #x6A8F #x6A92 #x6A93 #x6A94
- #x6A95 #x6A96 #x6A98 #x6A99 #x6A9A #x6A9B #x6A9C #x6A9D #x6A9E #x6A9F
- #x6AA1 #x6AA2 #x6AA3 #x6AA4 #x6AA5 #x6AA6 #x6AA7 #x6AA8 #x6AAA #x6AAD
- #x6AAE #x6AAF #x6AB0 #x6AB1 #x6AB2 #x6AB3 #x6AB4 #x6AB5 #x6AB6 #x6AB7
- #x6AB8 #x6AB9 #x6ABA #x6ABB #x6ABC #x6ABD #x6ABE #x6ABF #x6AC0 #x6AC1
- #x6AC2 #x6AC3 #x6AC4 #x6AC5 #x6AC6 #x6AC7 #x6AC8 #x6AC9 #x6ACA #x6ACB
- #x6ACC #x6ACD #x6ACE #x6ACF #x6AD0 #x6AD1 #x6AD2 #x6AD3 #x6AD4 #x6AD5
- #x6AD6 #x6AD7 #x6AD8 #x6AD9 #x6ADA #x6ADB #x6ADC #x6ADD #x6ADE #x6ADF
- #x6AE0 #x6AE1 #x6AE2 #x6AE3 #x6AE4 #x6AE5 #x6AE6 #x6AE7 #x6AE8 #x6AE9
- #x6AEA #x6AEB #x6AEC #x6AED #x6AEE #x6AEF #x6AF0 #x6AF1 #x6AF2 #x6AF3
- #x6AF4 #x6AF5 #x6AF6 #x6AF7 #x6AF8 #x6AF9 #x6AFA #x6AFB #x6AFC #x6AFD
- #x6AFE #x6AFF #x6B00 #x6B01 #x6B02 #x6B03 #x6B04 #x6B05 #x6B06 #x6B07
- #x6B08 #x6B09 #x6B0A #x6B0B #x6B0C #x6B0D #x6B0E #x6B0F #x6B10 #x6B11
- #x6B12 #x6B13 #x6B14 #x6B15 #x6B16 #x6B17 #x6B18 #x6B19 #x6B1A #x6B1B
- #x6B1C #x6B1D #x6B1E #x6B1F #x6B25 #x6B26 #x6B28 #x6B29 #x6B2A #x6B2B
- #x6B2C #x6B2D #x6B2E #x6B2F #x6B30 #x6B31 #x6B33 #x6B34 #x6B35 #x6B36
- #x6B38 #x6B3B #x6B3C #x6B3D #x6B3F #x6B40 #x6B41 #x6B42 #x6B44 #x6B45
- #x6B48 #x6B4A #x6B4B #x6B4D #x6B4E #x6B4F #x6B50 #x6B51 #x6B52 #x6B53
- #x6B54 #x6B55 #x6B56 #x6B57 #x6B58 #x6B5A #x6B5B #x6B5C #x6B5D #x6B5E
- #x6B5F #x6B60 #x6B61 #x6B68 #x6B69 #x6B6B #x6B6C #x6B6D #x6B6E #x6B6F
- #x6B70 #x6B71 #x6B72 #x6B73 #x6B74 #x6B75 #x6B76 #x6B77 #x6B78 #x6B7A
- #x6B7D #x6B7E #x6B7F #x6B80 #x6B85 #x6B88 #x6B8C #x6B8E #x6B8F #x6B90
- #x6B91 #x6B94 #x6B95 #x6B97 #x6B98 #x6B99 #x6B9C #x6B9D #x6B9E #x6B9F
- #x6BA0 #x6BA2 #x6BA3 #x6BA4 #x6BA5 #x6BA6 #x6BA7 #x6BA8 #x6BA9 #x6BAB
- #x6BAC #x6BAD #x6BAE #x6BAF #x6BB0 #x6BB1 #x6BB2 #x6BB6 #x6BB8 #x6BB9
- #x6BBA #x6BBB #x6BBC #x6BBD #x6BBE #x6BC0 #x6BC3 #x6BC4 #x6BC6 #x6BC7
- #x6BC8 #x6BC9 #x6BCA #x6BCC #x6BCE #x6BD0 #x6BD1 #x6BD8 #x6BDA #x6BDC
- #x6BDD #x6BDE #x6BDF #x6BE0 #x6BE2 #x6BE3 #x6BE4 #x6BE5 #x6BE6 #x6BE7
- #x6BE8 #x6BE9 #x6BEC #x6BED #x6BEE #x6BF0 #x6BF1 #x6BF2 #x6BF4 #x6BF6
- #x6BF7 #x6BF8 #x6BFA #x6BFB #x6BFC #x6BFE #x6BFF #x6C00 #x6C01 #x6C02
- #x6C03 #x6C04 #x6C08 #x6C09 #x6C0A #x6C0B #x6C0C #x6C0E #x6C12 #x6C17
- #x6C1C #x6C1D #x6C1E #x6C20 #x6C23 #x6C25 #x6C2B #x6C2C #x6C2D #x6C31
- #x6C33 #x6C36 #x6C37 #x6C39 #x6C3A #x6C3B #x6C3C #x6C3E #x6C3F #x6C43
- #x6C44 #x6C45 #x6C48 #x6C4B #x6C4C #x6C4D #x6C4E #x6C4F #x6C51 #x6C52
- #x6C53 #x6C56 #x6C58 #x6C59 #x6C5A #x6C62 #x6C63 #x6C65 #x6C66 #x6C67
- #x6C6B #x6C6C #x6C6D #x6C6E #x6C6F #x6C71 #x6C73 #x6C75 #x6C77 #x6C78
- #x6C7A #x6C7B #x6C7C #x6C7F #x6C80 #x6C84 #x6C87 #x6C8A #x6C8B #x6C8D
- #x6C8E #x6C91 #x6C92 #x6C95 #x6C96 #x6C97 #x6C98 #x6C9A #x6C9C #x6C9D
- #x6C9E #x6CA0 #x6CA2 #x6CA8 #x6CAC #x6CAF #x6CB0 #x6CB4 #x6CB5 #x6CB6
- #x6CB7 #x6CBA #x6CC0 #x6CC1 #x6CC2 #x6CC3 #x6CC6 #x6CC7 #x6CC8 #x6CCB
- #x6CCD #x6CCE #x6CCF #x6CD1 #x6CD2 #x6CD8 #x6CD9 #x6CDA #x6CDC #x6CDD
- #x6CDF #x6CE4 #x6CE6 #x6CE7 #x6CE9 #x6CEC #x6CED #x6CF2 #x6CF4 #x6CF9
- #x6CFF #x6D00 #x6D02 #x6D03 #x6D05 #x6D06 #x6D08 #x6D09 #x6D0A #x6D0D
- #x6D0F #x6D10 #x6D11 #x6D13 #x6D14 #x6D15 #x6D16 #x6D18 #x6D1C #x6D1D
- #x6D1F #x6D20 #x6D21 #x6D22 #x6D23 #x6D24 #x6D26 #x6D28 #x6D29 #x6D2C
- #x6D2D #x6D2F #x6D30 #x6D34 #x6D36 #x6D37 #x6D38 #x6D3A #x6D3F #x6D40
- #x6D42 #x6D44 #x6D49 #x6D4C #x6D50 #x6D55 #x6D56 #x6D57 #x6D58 #x6D5B
- #x6D5D #x6D5F #x6D61 #x6D62 #x6D64 #x6D65 #x6D67 #x6D68 #x6D6B #x6D6C
- #x6D6D #x6D70 #x6D71 #x6D72 #x6D73 #x6D75 #x6D76 #x6D79 #x6D7A #x6D7B
- #x6D7D #x6D7E #x6D7F #x6D80 #x6D81 #x6D83 #x6D84 #x6D86 #x6D87 #x6D8A
- #x6D8B #x6D8D #x6D8F #x6D90 #x6D92 #x6D96 #x6D97 #x6D98 #x6D99 #x6D9A
- #x6D9C #x6DA2 #x6DA5 #x6DAC #x6DAD #x6DB0 #x6DB1 #x6DB3 #x6DB4 #x6DB6
- #x6DB7 #x6DB9 #x6DBA #x6DBB #x6DBC #x6DBD #x6DBE #x6DC1 #x6DC2 #x6DC3
- #x6DC8 #x6DC9 #x6DCA #x6DCD #x6DCE #x6DCF #x6DD0 #x6DD2 #x6DD3 #x6DD4
- #x6DD5 #x6DD7 #x6DDA #x6DDB #x6DDC #x6DDF #x6DE2 #x6DE3 #x6DE5 #x6DE7
- #x6DE8 #x6DE9 #x6DEA #x6DED #x6DEF #x6DF0 #x6DF2 #x6DF4 #x6DF5 #x6DF6
- #x6DF8 #x6DFA #x6DFD #x6DFE #x6DFF #x6E00 #x6E01 #x6E02 #x6E03 #x6E04
- #x6E06 #x6E07 #x6E08 #x6E09 #x6E0B #x6E0F #x6E12 #x6E13 #x6E15 #x6E18
- #x6E19 #x6E1B #x6E1C #x6E1E #x6E1F #x6E22 #x6E26 #x6E27 #x6E28 #x6E2A
- #x6E2C #x6E2E #x6E30 #x6E31 #x6E33 #x6E35 #x6E36 #x6E37 #x6E39 #x6E3B
- #x6E3C #x6E3D #x6E3E #x6E3F #x6E40 #x6E41 #x6E42 #x6E45 #x6E46 #x6E47
- #x6E48 #x6E49 #x6E4A #x6E4B #x6E4C #x6E4F #x6E50 #x6E51 #x6E52 #x6E55
- #x6E57 #x6E59 #x6E5A #x6E5C #x6E5D #x6E5E #x6E60 #x6E61 #x6E62 #x6E63
- #x6E64 #x6E65 #x6E66 #x6E67 #x6E68 #x6E69 #x6E6A #x6E6C #x6E6D #x6E6F
- #x6E70 #x6E71 #x6E72 #x6E73 #x6E74 #x6E75 #x6E76 #x6E77 #x6E78 #x6E79
- #x6E7A #x6E7B #x6E7C #x6E7D #x6E80 #x6E81 #x6E82 #x6E84 #x6E87 #x6E88
- #x6E8A #x6E8B #x6E8C #x6E8D #x6E8E #x6E91 #x6E92 #x6E93 #x6E94 #x6E95
- #x6E96 #x6E97 #x6E99 #x6E9A #x6E9B #x6E9D #x6E9E #x6EA0 #x6EA1 #x6EA3
- #x6EA4 #x6EA6 #x6EA8 #x6EA9 #x6EAB #x6EAC #x6EAD #x6EAE #x6EB0 #x6EB3
- #x6EB5 #x6EB8 #x6EB9 #x6EBC #x6EBE #x6EBF #x6EC0 #x6EC3 #x6EC4 #x6EC5
- #x6EC6 #x6EC8 #x6EC9 #x6ECA #x6ECC #x6ECD #x6ECE #x6ED0 #x6ED2 #x6ED6
- #x6ED8 #x6ED9 #x6EDB #x6EDC #x6EDD #x6EE3 #x6EE7 #x6EEA #x6EEB #x6EEC
- #x6EED #x6EEE #x6EEF #x6EF0 #x6EF1 #x6EF2 #x6EF3 #x6EF5 #x6EF6 #x6EF7
- #x6EF8 #x6EFA #x6EFB #x6EFC #x6EFD #x6EFE #x6EFF #x6F00 #x6F01 #x6F03
- #x6F04 #x6F05 #x6F07 #x6F08 #x6F0A #x6F0B #x6F0C #x6F0D #x6F0E #x6F10
- #x6F11 #x6F12 #x6F16 #x6F17 #x6F18 #x6F19 #x6F1A #x6F1B #x6F1C #x6F1D
- #x6F1E #x6F1F #x6F21 #x6F22 #x6F23 #x6F25 #x6F26 #x6F27 #x6F28 #x6F2C
- #x6F2E #x6F30 #x6F32 #x6F34 #x6F35 #x6F37 #x6F38 #x6F39 #x6F3A #x6F3B
- #x6F3C #x6F3D #x6F3F #x6F40 #x6F41 #x6F42 #x6F43 #x6F44 #x6F45 #x6F48
- #x6F49 #x6F4A #x6F4C #x6F4E #x6F4F #x6F50 #x6F51 #x6F52 #x6F53 #x6F54
- #x6F55 #x6F56 #x6F57 #x6F59 #x6F5A #x6F5B #x6F5D #x6F5F #x6F60 #x6F61
- #x6F63 #x6F64 #x6F65 #x6F67 #x6F68 #x6F69 #x6F6A #x6F6B #x6F6C #x6F6F
- #x6F70 #x6F71 #x6F73 #x6F75 #x6F76 #x6F77 #x6F79 #x6F7B #x6F7D #x6F7E
- #x6F7F #x6F80 #x6F81 #x6F82 #x6F83 #x6F85 #x6F86 #x6F87 #x6F8A #x6F8B
- #x6F8F #x6F90 #x6F91 #x6F92 #x6F93 #x6F94 #x6F95 #x6F96 #x6F97 #x6F98
- #x6F99 #x6F9A #x6F9B #x6F9D #x6F9E #x6F9F #x6FA0 #x6FA2 #x6FA3 #x6FA4
- #x6FA5 #x6FA6 #x6FA8 #x6FA9 #x6FAA #x6FAB #x6FAC #x6FAD #x6FAE #x6FAF
- #x6FB0 #x6FB1 #x6FB2 #x6FB4 #x6FB5 #x6FB7 #x6FB8 #x6FBA #x6FBB #x6FBC
- #x6FBD #x6FBE #x6FBF #x6FC1 #x6FC3 #x6FC4 #x6FC5 #x6FC6 #x6FC7 #x6FC8
- #x6FCA #x6FCB #x6FCC #x6FCD #x6FCE #x6FCF #x6FD0 #x6FD3 #x6FD4 #x6FD5
- #x6FD6 #x6FD7 #x6FD8 #x6FD9 #x6FDA #x6FDB #x6FDC #x6FDD #x6FDF #x6FE2
- #x6FE3 #x6FE4 #x6FE5 #x6FE6 #x6FE7 #x6FE8 #x6FE9 #x6FEA #x6FEB #x6FEC
- #x6FED #x6FF0 #x6FF1 #x6FF2 #x6FF3 #x6FF4 #x6FF5 #x6FF6 #x6FF7 #x6FF8
- #x6FF9 #x6FFA #x6FFB #x6FFC #x6FFD #x6FFE #x6FFF #x7000 #x7001 #x7002
- #x7003 #x7004 #x7005 #x7006 #x7007 #x7008 #x7009 #x700A #x700B #x700C
- #x700D #x700E #x700F #x7010 #x7012 #x7013 #x7014 #x7015 #x7016 #x7017
- #x7018 #x7019 #x701C #x701D #x701E #x701F #x7020 #x7021 #x7022 #x7024
- #x7025 #x7026 #x7027 #x7028 #x7029 #x702A #x702B #x702C #x702D #x702E
- #x702F #x7030 #x7031 #x7032 #x7033 #x7034 #x7036 #x7037 #x7038 #x703A
- #x703B #x703C #x703D #x703E #x703F #x7040 #x7041 #x7042 #x7043 #x7044
- #x7045 #x7046 #x7047 #x7048 #x7049 #x704A #x704B #x704D #x704E #x7050
- #x7051 #x7052 #x7053 #x7054 #x7055 #x7056 #x7057 #x7058 #x7059 #x705A
- #x705B #x705C #x705D #x705F #x7060 #x7061 #x7062 #x7063 #x7064 #x7065
- #x7066 #x7067 #x7068 #x7069 #x706A #x706E #x7071 #x7072 #x7073 #x7074
- #x7077 #x7079 #x707A #x707B #x707D #x7081 #x7082 #x7083 #x7084 #x7086
- #x7087 #x7088 #x708B #x708C #x708D #x708F #x7090 #x7091 #x7093 #x7097
- #x7098 #x709A #x709B #x709E #x709F #x70A0 #x70A1 #x70A2 #x70A3 #x70A4
- #x70A5 #x70A6 #x70A7 #x70A8 #x70A9 #x70AA #x70B0 #x70B2 #x70B4 #x70B5
- #x70B6 #x70BA #x70BE #x70BF #x70C4 #x70C5 #x70C6 #x70C7 #x70C9 #x70CB
- #x70CC #x70CD #x70CE #x70CF #x70D0 #x70D1 #x70D2 #x70D3 #x70D4 #x70D5
- #x70D6 #x70D7 #x70DA #x70DC #x70DD #x70DE #x70E0 #x70E1 #x70E2 #x70E3
- #x70E5 #x70EA #x70EE #x70F0 #x70F1 #x70F2 #x70F3 #x70F4 #x70F5 #x70F6
- #x70F8 #x70FA #x70FB #x70FC #x70FE #x70FF #x7100 #x7101 #x7102 #x7103
- #x7104 #x7105 #x7106 #x7107 #x7108 #x710B #x710C #x710D #x710E #x710F
- #x7111 #x7112 #x7114 #x7117 #x711B #x711C #x711D #x711E #x711F #x7120
- #x7121 #x7122 #x7123 #x7124 #x7125 #x7127 #x7128 #x7129 #x712A #x712B
- #x712C #x712D #x712E #x7132 #x7133 #x7134 #x7135 #x7137 #x7138 #x7139
- #x713A #x713B #x713C #x713D #x713E #x713F #x7140 #x7141 #x7142 #x7143
- #x7144 #x7146 #x7147 #x7148 #x7149 #x714B #x714D #x714F #x7150 #x7151
- #x7152 #x7153 #x7154 #x7155 #x7156 #x7157 #x7158 #x7159 #x715A #x715B
- #x715D #x715F #x7160 #x7161 #x7162 #x7163 #x7165 #x7169 #x716A #x716B
- #x716C #x716D #x716F #x7170 #x7171 #x7174 #x7175 #x7176 #x7177 #x7179
- #x717B #x717C #x717E #x717F #x7180 #x7181 #x7182 #x7183 #x7185 #x7186
- #x7187 #x7188 #x7189 #x718B #x718C #x718D #x718E #x7190 #x7191 #x7192
- #x7193 #x7195 #x7196 #x7197 #x719A #x719B #x719C #x719D #x719E #x71A1
- #x71A2 #x71A3 #x71A4 #x71A5 #x71A6 #x71A7 #x71A9 #x71AA #x71AB #x71AD
- #x71AE #x71AF #x71B0 #x71B1 #x71B2 #x71B4 #x71B6 #x71B7 #x71B8 #x71BA
- #x71BB #x71BC #x71BD #x71BE #x71BF #x71C0 #x71C1 #x71C2 #x71C4 #x71C5
- #x71C6 #x71C7 #x71C8 #x71C9 #x71CA #x71CB #x71CC #x71CD #x71CF #x71D0
- #x71D1 #x71D2 #x71D3 #x71D6 #x71D7 #x71D8 #x71D9 #x71DA #x71DB #x71DC
- #x71DD #x71DE #x71DF #x71E1 #x71E2 #x71E3 #x71E4 #x71E6 #x71E8 #x71E9
- #x71EA #x71EB #x71EC #x71ED #x71EF #x71F0 #x71F1 #x71F2 #x71F3 #x71F4
- #x71F5 #x71F6 #x71F7 #x71F8 #x71FA #x71FB #x71FC #x71FD #x71FE #x71FF
- #x7200 #x7201 #x7202 #x7203 #x7204 #x7205 #x7207 #x7208 #x7209 #x720A
- #x720B #x720C #x720D #x720E #x720F #x7210 #x7211 #x7212 #x7213 #x7214
- #x7215 #x7216 #x7217 #x7218 #x7219 #x721A #x721B #x721C #x721E #x721F
- #x7220 #x7221 #x7222 #x7223 #x7224 #x7225 #x7226 #x7227 #x7229 #x722B
- #x722D #x722E #x722F #x7232 #x7233 #x7234 #x723A #x723C #x723E #x7240
- #x7241 #x7242 #x7243 #x7244 #x7245 #x7246 #x7249 #x724A #x724B #x724E
- #x724F #x7250 #x7251 #x7253 #x7254 #x7255 #x7257 #x7258 #x725A #x725C
- #x725E #x7260 #x7263 #x7264 #x7265 #x7268 #x726A #x726B #x726C #x726D
- #x7270 #x7271 #x7273 #x7274 #x7276 #x7277 #x7278 #x727B #x727C #x727D
- #x7282 #x7283 #x7285 #x7286 #x7287 #x7288 #x7289 #x728C #x728E #x7290
- #x7291 #x7293 #x7294 #x7295 #x7296 #x7297 #x7298 #x7299 #x729A #x729B
- #x729C #x729D #x729E #x72A0 #x72A1 #x72A2 #x72A3 #x72A4 #x72A5 #x72A6
- #x72A7 #x72A8 #x72A9 #x72AA #x72AB #x72AE #x72B1 #x72B2 #x72B3 #x72B5
- #x72BA #x72BB #x72BC #x72BD #x72BE #x72BF #x72C0 #x72C5 #x72C6 #x72C7
- #x72C9 #x72CA #x72CB #x72CC #x72CF #x72D1 #x72D3 #x72D4 #x72D5 #x72D6
- #x72D8 #x72DA #x72DB #x72DC #x72DD #x72DF #x72E2 #x72E3 #x72E4 #x72E5
- #x72E6 #x72E7 #x72EA #x72EB #x72F5 #x72F6 #x72F9 #x72FD #x72FE #x72FF
- #x7300 #x7302 #x7304 #x7305 #x7306 #x7307 #x7308 #x7309 #x730B #x730C
- #x730D #x730F #x7310 #x7311 #x7312 #x7314 #x7318 #x7319 #x731A #x731F
- #x7320 #x7323 #x7324 #x7326 #x7327 #x7328 #x732D #x732F #x7330 #x7332
- #x7333 #x7335 #x7336 #x733A #x733B #x733C #x733D #x7340 #x7341 #x7342
- #x7343 #x7344 #x7345 #x7346 #x7347 #x7348 #x7349 #x734A #x734B #x734C
- #x734E #x734F #x7351 #x7353 #x7354 #x7355 #x7356 #x7358 #x7359 #x735A
- #x735B #x735C #x735D #x735E #x735F #x7361 #x7362 #x7363 #x7364 #x7365
- #x7366 #x7367 #x7368 #x7369 #x736A #x736B #x736E #x7370 #x7371 #x7372
- #x7373 #x7374 #x7375 #x7376 #x7377 #x7378 #x7379 #x737A #x737B #x737C
- #x737D #x737F #x7380 #x7381 #x7382 #x7383 #x7385 #x7386 #x7388 #x738A
- #x738C #x738D #x738F #x7390 #x7392 #x7393 #x7394 #x7395 #x7397 #x7398
- #x7399 #x739A #x739C #x739D #x739E #x73A0 #x73A1 #x73A3 #x73A4 #x73A5
- #x73A6 #x73A7 #x73A8 #x73AA #x73AC #x73AD #x73B1 #x73B4 #x73B5 #x73B6
- #x73B8 #x73B9 #x73BC #x73BD #x73BE #x73BF #x73C1 #x73C3 #x73C4 #x73C5
- #x73C6 #x73C7 #x73CB #x73CC #x73CE #x73D2 #x73D3 #x73D4 #x73D5 #x73D6
- #x73D7 #x73D8 #x73DA #x73DB #x73DC #x73DD #x73DF #x73E1 #x73E2 #x73E3
- #x73E4 #x73E6 #x73E8 #x73EA #x73EB #x73EC #x73EE #x73EF #x73F0 #x73F1
- #x73F3 #x73F4 #x73F5 #x73F6 #x73F7 #x73F8 #x73F9 #x73FA #x73FB #x73FC
- #x73FD #x73FE #x73FF #x7400 #x7401 #x7402 #x7404 #x7407 #x7408 #x740B
- #x740C #x740D #x740E #x7411 #x7412 #x7413 #x7414 #x7415 #x7416 #x7417
- #x7418 #x7419 #x741C #x741D #x741E #x741F #x7420 #x7421 #x7423 #x7424
- #x7427 #x7429 #x742B #x742D #x742F #x7431 #x7432 #x7437 #x7438 #x7439
- #x743A #x743B #x743D #x743E #x743F #x7440 #x7442 #x7443 #x7444 #x7445
- #x7446 #x7447 #x7448 #x7449 #x744A #x744B #x744C #x744D #x744E #x744F
- #x7450 #x7451 #x7452 #x7453 #x7454 #x7456 #x7458 #x745D #x7460 #x7461
- #x7462 #x7463 #x7464 #x7465 #x7466 #x7467 #x7468 #x7469 #x746A #x746B
- #x746C #x746E #x746F #x7471 #x7472 #x7473 #x7474 #x7475 #x7478 #x7479
- #x747A #x747B #x747C #x747D #x747F #x7482 #x7484 #x7485 #x7486 #x7488
- #x7489 #x748A #x748C #x748D #x748F #x7491 #x7492 #x7493 #x7494 #x7495
- #x7496 #x7497 #x7498 #x7499 #x749A #x749B #x749D #x749F #x74A0 #x74A1
- #x74A2 #x74A3 #x74A4 #x74A5 #x74A6 #x74AA #x74AB #x74AC #x74AD #x74AE
- #x74AF #x74B0 #x74B1 #x74B2 #x74B3 #x74B4 #x74B5 #x74B6 #x74B7 #x74B8
- #x74B9 #x74BB #x74BC #x74BD #x74BE #x74BF #x74C0 #x74C1 #x74C2 #x74C3
- #x74C4 #x74C5 #x74C6 #x74C7 #x74C8 #x74C9 #x74CA #x74CB #x74CC #x74CD
- #x74CE #x74CF #x74D0 #x74D1 #x74D3 #x74D4 #x74D5 #x74D6 #x74D7 #x74D8
- #x74D9 #x74DA #x74DB #x74DD #x74DF #x74E1 #x74E5 #x74E7 #x74E8 #x74E9
- #x74EA #x74EB #x74EC #x74ED #x74F0 #x74F1 #x74F2 #x74F3 #x74F5 #x74F8
- #x74F9 #x74FA #x74FB #x74FC #x74FD #x74FE #x7500 #x7501 #x7502 #x7503
- #x7505 #x7506 #x7507 #x7508 #x7509 #x750A #x750B #x750C #x750E #x7510
- #x7512 #x7514 #x7515 #x7516 #x7517 #x751B #x751D #x751E #x7520 #x7521
- #x7522 #x7523 #x7524 #x7526 #x7527 #x752A #x752E #x7534 #x7536 #x7539
- #x753C #x753D #x753F #x7541 #x7542 #x7543 #x7544 #x7546 #x7547 #x7549
- #x754A #x754D #x7550 #x7551 #x7552 #x7553 #x7555 #x7556 #x7557 #x7558
- #x755D #x755E #x755F #x7560 #x7561 #x7562 #x7563 #x7564 #x7567 #x7568
- #x7569 #x756B #x756C #x756D #x756E #x756F #x7570 #x7571 #x7573 #x7575
- #x7576 #x7577 #x757A #x757B #x757C #x757D #x757E #x7580 #x7581 #x7582
- #x7584 #x7585 #x7587 #x7588 #x7589 #x758A #x758C #x758D #x758E #x7590
- #x7593 #x7595 #x7598 #x759B #x759C #x759E #x75A2 #x75A6 #x75A7 #x75A8
- #x75A9 #x75AA #x75AD #x75B6 #x75B7 #x75BA #x75BB #x75BF #x75C0 #x75C1
- #x75C6 #x75CB #x75CC #x75CE #x75CF #x75D0 #x75D1 #x75D3 #x75D7 #x75D9
- #x75DA #x75DC #x75DD #x75DF #x75E0 #x75E1 #x75E5 #x75E9 #x75EC #x75ED
- #x75EE #x75EF #x75F2 #x75F3 #x75F5 #x75F6 #x75F7 #x75F8 #x75FA #x75FB
- #x75FD #x75FE #x7602 #x7604 #x7606 #x7607 #x7608 #x7609 #x760B #x760D
- #x760E #x760F #x7611 #x7612 #x7613 #x7614 #x7616 #x761A #x761C #x761D
- #x761E #x7621 #x7623 #x7627 #x7628 #x762C #x762E #x762F #x7631 #x7632
- #x7636 #x7637 #x7639 #x763A #x763B #x763D #x7641 #x7642 #x7644 #x7645
- #x7646 #x7647 #x7648 #x7649 #x764A #x764B #x764E #x764F #x7650 #x7651
- #x7652 #x7653 #x7655 #x7657 #x7658 #x7659 #x765A #x765B #x765D #x765F
- #x7660 #x7661 #x7662 #x7664 #x7665 #x7666 #x7667 #x7668 #x7669 #x766A
- #x766C #x766D #x766E #x7670 #x7671 #x7672 #x7673 #x7674 #x7675 #x7676
- #x7677 #x7679 #x767A #x767C #x767F #x7680 #x7681 #x7683 #x7685 #x7689
- #x768A #x768C #x768D #x768F #x7690 #x7692 #x7694 #x7695 #x7697 #x7698
- #x769A #x769B #x769C #x769D #x769E #x769F #x76A0 #x76A1 #x76A2 #x76A3
- #x76A5 #x76A6 #x76A7 #x76A8 #x76A9 #x76AA #x76AB #x76AC #x76AD #x76AF
- #x76B0 #x76B3 #x76B5 #x76B6 #x76B7 #x76B8 #x76B9 #x76BA #x76BB #x76BC
- #x76BD #x76BE #x76C0 #x76C1 #x76C3 #x76C4 #x76C7 #x76C9 #x76CB #x76CC
- #x76D3 #x76D5 #x76D9 #x76DA #x76DC #x76DD #x76DE #x76E0 #x76E1 #x76E2
- #x76E3 #x76E4 #x76E6 #x76E7 #x76E8 #x76E9 #x76EA #x76EB #x76EC #x76ED
- #x76F0 #x76F3 #x76F5 #x76F6 #x76F7 #x76FA #x76FB #x76FD #x76FF #x7700
- #x7702 #x7703 #x7705 #x7706 #x770A #x770C #x770E #x770F #x7710 #x7711
- #x7712 #x7713 #x7714 #x7715 #x7716 #x7717 #x7718 #x771B #x771C #x771D
- #x771E #x7721 #x7723 #x7724 #x7725 #x7727 #x772A #x772B #x772C #x772E
- #x7730 #x7731 #x7732 #x7733 #x7734 #x7739 #x773B #x773D #x773E #x773F
- #x7742 #x7744 #x7745 #x7746 #x7748 #x7749 #x774A #x774B #x774C #x774D
- #x774E #x774F #x7752 #x7753 #x7754 #x7755 #x7756 #x7757 #x7758 #x7759
- #x775C #x775D #x775E #x775F #x7760 #x7764 #x7767 #x7769 #x776A #x776D
- #x776E #x776F #x7770 #x7771 #x7772 #x7773 #x7774 #x7775 #x7776 #x7777
- #x7778 #x777A #x777B #x777C #x7781 #x7782 #x7783 #x7786 #x7787 #x7788
- #x7789 #x778A #x778B #x778F #x7790 #x7793 #x7794 #x7795 #x7796 #x7797
- #x7798 #x7799 #x779A #x779B #x779C #x779D #x779E #x77A1 #x77A3 #x77A4
- #x77A6 #x77A8 #x77AB #x77AD #x77AE #x77AF #x77B1 #x77B2 #x77B4 #x77B6
- #x77B7 #x77B8 #x77B9 #x77BA #x77BC #x77BE #x77C0 #x77C1 #x77C2 #x77C3
- #x77C4 #x77C5 #x77C6 #x77C7 #x77C8 #x77C9 #x77CA #x77CB #x77CC #x77CE
- #x77CF #x77D0 #x77D1 #x77D2 #x77D3 #x77D4 #x77D5 #x77D6 #x77D8 #x77D9
- #x77DA #x77DD #x77DE #x77DF #x77E0 #x77E1 #x77E4 #x77E6 #x77E8 #x77EA
- #x77EF #x77F0 #x77F1 #x77F2 #x77F4 #x77F5 #x77F7 #x77F9 #x77FA #x77FB
- #x77FC #x7803 #x7804 #x7805 #x7806 #x7807 #x7808 #x780A #x780B #x780E
- #x780F #x7810 #x7813 #x7815 #x7819 #x781B #x781E #x7820 #x7821 #x7822
- #x7824 #x7828 #x782A #x782B #x782E #x782F #x7831 #x7832 #x7833 #x7835
- #x7836 #x783D #x783F #x7841 #x7842 #x7843 #x7844 #x7846 #x7848 #x7849
- #x784A #x784B #x784D #x784F #x7851 #x7853 #x7854 #x7858 #x7859 #x785A
- #x785B #x785C #x785E #x785F #x7860 #x7861 #x7862 #x7863 #x7864 #x7865
- #x7866 #x7867 #x7868 #x7869 #x786F #x7870 #x7871 #x7872 #x7873 #x7874
- #x7875 #x7876 #x7878 #x7879 #x787A #x787B #x787D #x787E #x787F #x7880
- #x7881 #x7882 #x7883 #x7884 #x7885 #x7886 #x7888 #x788A #x788B #x788F
- #x7890 #x7892 #x7894 #x7895 #x7896 #x7899 #x789D #x789E #x78A0 #x78A2
- #x78A4 #x78A6 #x78A8 #x78A9 #x78AA #x78AB #x78AC #x78AD #x78AE #x78AF
- #x78B5 #x78B6 #x78B7 #x78B8 #x78BA #x78BB #x78BC #x78BD #x78BF #x78C0
- #x78C2 #x78C3 #x78C4 #x78C6 #x78C7 #x78C8 #x78CC #x78CD #x78CE #x78CF
- #x78D1 #x78D2 #x78D3 #x78D6 #x78D7 #x78D8 #x78DA #x78DB #x78DC #x78DD
- #x78DE #x78DF #x78E0 #x78E1 #x78E2 #x78E3 #x78E4 #x78E5 #x78E6 #x78E7
- #x78E9 #x78EA #x78EB #x78ED #x78EE #x78EF #x78F0 #x78F1 #x78F3 #x78F5
- #x78F6 #x78F8 #x78F9 #x78FB #x78FC #x78FD #x78FE #x78FF #x7900 #x7902
- #x7903 #x7904 #x7906 #x7907 #x7908 #x7909 #x790A #x790B #x790C #x790D
- #x790E #x790F #x7910 #x7911 #x7912 #x7914 #x7915 #x7916 #x7917 #x7918
- #x7919 #x791A #x791B #x791C #x791D #x791F #x7920 #x7921 #x7922 #x7923
- #x7925 #x7926 #x7927 #x7928 #x7929 #x792A #x792B #x792C #x792D #x792E
- #x792F #x7930 #x7931 #x7932 #x7933 #x7935 #x7936 #x7937 #x7938 #x7939
- #x793D #x793F #x7942 #x7943 #x7944 #x7945 #x7947 #x794A #x794B #x794C
- #x794D #x794E #x794F #x7950 #x7951 #x7952 #x7954 #x7955 #x7958 #x7959
- #x7961 #x7963 #x7964 #x7966 #x7969 #x796A #x796B #x796C #x796E #x7970
- #x7971 #x7972 #x7973 #x7974 #x7975 #x7976 #x7979 #x797B #x797C #x797D
- #x797E #x797F #x7982 #x7983 #x7986 #x7987 #x7988 #x7989 #x798B #x798C
- #x798D #x798E #x7990 #x7991 #x7992 #x7993 #x7994 #x7995 #x7996 #x7997
- #x7998 #x7999 #x799B #x799C #x799D #x799E #x799F #x79A0 #x79A1 #x79A2
- #x79A3 #x79A4 #x79A5 #x79A6 #x79A8 #x79A9 #x79AA #x79AB #x79AC #x79AD
- #x79AE #x79AF #x79B0 #x79B1 #x79B2 #x79B4 #x79B5 #x79B6 #x79B7 #x79B8
- #x79BC #x79BF #x79C2 #x79C4 #x79C5 #x79C7 #x79C8 #x79CA #x79CC #x79CE
- #x79CF #x79D0 #x79D3 #x79D4 #x79D6 #x79D7 #x79D9 #x79DA #x79DB #x79DC
- #x79DD #x79DE #x79E0 #x79E1 #x79E2 #x79E5 #x79E8 #x79EA #x79EC #x79EE
- #x79F1 #x79F2 #x79F3 #x79F4 #x79F5 #x79F6 #x79F7 #x79F9 #x79FA #x79FC
- #x79FE #x79FF #x7A01 #x7A04 #x7A05 #x7A07 #x7A08 #x7A09 #x7A0A #x7A0C
- #x7A0F #x7A10 #x7A11 #x7A12 #x7A13 #x7A15 #x7A16 #x7A18 #x7A19 #x7A1B
- #x7A1C #x7A1D #x7A1F #x7A21 #x7A22 #x7A24 #x7A25 #x7A26 #x7A27 #x7A28
- #x7A29 #x7A2A #x7A2B #x7A2C #x7A2D #x7A2E #x7A2F #x7A30 #x7A31 #x7A32
- #x7A34 #x7A35 #x7A36 #x7A38 #x7A3A #x7A3E #x7A40 #x7A41 #x7A42 #x7A43
- #x7A44 #x7A45 #x7A47 #x7A48 #x7A49 #x7A4A #x7A4B #x7A4C #x7A4D #x7A4E
- #x7A4F #x7A50 #x7A52 #x7A53 #x7A54 #x7A55 #x7A56 #x7A58 #x7A59 #x7A5A
- #x7A5B #x7A5C #x7A5D #x7A5E #x7A5F #x7A60 #x7A61 #x7A62 #x7A63 #x7A64
- #x7A65 #x7A66 #x7A67 #x7A68 #x7A69 #x7A6A #x7A6B #x7A6C #x7A6D #x7A6E
- #x7A6F #x7A71 #x7A72 #x7A73 #x7A75 #x7A7B #x7A7C #x7A7D #x7A7E #x7A82
- #x7A85 #x7A87 #x7A89 #x7A8A #x7A8B #x7A8C #x7A8E #x7A8F #x7A90 #x7A93
- #x7A94 #x7A99 #x7A9A #x7A9B #x7A9E #x7AA1 #x7AA2 #x7AA3 #x7AA4 #x7AA7
- #x7AA9 #x7AAA #x7AAB #x7AAE #x7AAF #x7AB0 #x7AB1 #x7AB2 #x7AB4 #x7AB5
- #x7AB6 #x7AB7 #x7AB8 #x7AB9 #x7ABA #x7ABB #x7ABC #x7ABD #x7ABE #x7AC0
- #x7AC1 #x7AC2 #x7AC3 #x7AC4 #x7AC5 #x7AC6 #x7AC7 #x7AC8 #x7AC9 #x7ACA
- #x7ACC #x7ACD #x7ACE #x7ACF #x7AD0 #x7AD1 #x7AD2 #x7AD3 #x7AD4 #x7AD5
- #x7AD7 #x7AD8 #x7ADA #x7ADB #x7ADC #x7ADD #x7AE1 #x7AE2 #x7AE4 #x7AE7
- #x7AE8 #x7AE9 #x7AEA #x7AEB #x7AEC #x7AEE #x7AF0 #x7AF1 #x7AF2 #x7AF3
- #x7AF4 #x7AF5 #x7AF6 #x7AF7 #x7AF8 #x7AFB #x7AFC #x7AFE #x7B00 #x7B01
- #x7B02 #x7B05 #x7B07 #x7B09 #x7B0C #x7B0D #x7B0E #x7B10 #x7B12 #x7B13
- #x7B16 #x7B17 #x7B18 #x7B1A #x7B1C #x7B1D #x7B1F #x7B21 #x7B22 #x7B23
- #x7B27 #x7B29 #x7B2D #x7B2F #x7B30 #x7B32 #x7B34 #x7B35 #x7B36 #x7B37
- #x7B39 #x7B3B #x7B3D #x7B3F #x7B40 #x7B41 #x7B42 #x7B43 #x7B44 #x7B46
- #x7B48 #x7B4A #x7B4D #x7B4E #x7B53 #x7B55 #x7B57 #x7B59 #x7B5C #x7B5E
- #x7B5F #x7B61 #x7B63 #x7B64 #x7B65 #x7B66 #x7B67 #x7B68 #x7B69 #x7B6A
- #x7B6B #x7B6C #x7B6D #x7B6F #x7B70 #x7B73 #x7B74 #x7B76 #x7B78 #x7B7A
- #x7B7C #x7B7D #x7B7F #x7B81 #x7B82 #x7B83 #x7B84 #x7B86 #x7B87 #x7B88
- #x7B89 #x7B8A #x7B8B #x7B8C #x7B8E #x7B8F #x7B91 #x7B92 #x7B93 #x7B96
- #x7B98 #x7B99 #x7B9A #x7B9B #x7B9E #x7B9F #x7BA0 #x7BA3 #x7BA4 #x7BA5
- #x7BAE #x7BAF #x7BB0 #x7BB2 #x7BB3 #x7BB5 #x7BB6 #x7BB7 #x7BB9 #x7BBA
- #x7BBB #x7BBC #x7BBD #x7BBE #x7BBF #x7BC0 #x7BC2 #x7BC3 #x7BC4 #x7BC5
- #x7BC8 #x7BC9 #x7BCA #x7BCB #x7BCD #x7BCE #x7BCF #x7BD0 #x7BD2 #x7BD4
- #x7BD5 #x7BD6 #x7BD7 #x7BD8 #x7BDB #x7BDC #x7BDE #x7BDF #x7BE0 #x7BE2
- #x7BE3 #x7BE4 #x7BE7 #x7BE8 #x7BE9 #x7BEB #x7BEC #x7BED #x7BEF #x7BF0
- #x7BF2 #x7BF3 #x7BF4 #x7BF5 #x7BF6 #x7BF8 #x7BF9 #x7BFA #x7BFB #x7BFD
- #x7BFF #x7C00 #x7C01 #x7C02 #x7C03 #x7C04 #x7C05 #x7C06 #x7C08 #x7C09
- #x7C0A #x7C0D #x7C0E #x7C10 #x7C11 #x7C12 #x7C13 #x7C14 #x7C15 #x7C17
- #x7C18 #x7C19 #x7C1A #x7C1B #x7C1C #x7C1D #x7C1E #x7C20 #x7C21 #x7C22
- #x7C23 #x7C24 #x7C25 #x7C28 #x7C29 #x7C2B #x7C2C #x7C2D #x7C2E #x7C2F
- #x7C30 #x7C31 #x7C32 #x7C33 #x7C34 #x7C35 #x7C36 #x7C37 #x7C39 #x7C3A
- #x7C3B #x7C3C #x7C3D #x7C3E #x7C42 #x7C43 #x7C44 #x7C45 #x7C46 #x7C47
- #x7C48 #x7C49 #x7C4A #x7C4B #x7C4C #x7C4E #x7C4F #x7C50 #x7C51 #x7C52
- #x7C53 #x7C54 #x7C55 #x7C56 #x7C57 #x7C58 #x7C59 #x7C5A #x7C5B #x7C5C
- #x7C5D #x7C5E #x7C5F #x7C60 #x7C61 #x7C62 #x7C63 #x7C64 #x7C65 #x7C66
- #x7C67 #x7C68 #x7C69 #x7C6A #x7C6B #x7C6C #x7C6D #x7C6E #x7C6F #x7C70
- #x7C71 #x7C72 #x7C75 #x7C76 #x7C77 #x7C78 #x7C79 #x7C7A #x7C7E #x7C7F
- #x7C80 #x7C81 #x7C82 #x7C83 #x7C84 #x7C85 #x7C86 #x7C87 #x7C88 #x7C8A
- #x7C8B #x7C8C #x7C8D #x7C8E #x7C8F #x7C90 #x7C93 #x7C94 #x7C96 #x7C99
- #x7C9A #x7C9B #x7CA0 #x7CA1 #x7CA3 #x7CA6 #x7CA7 #x7CA8 #x7CA9 #x7CAB
- #x7CAC #x7CAD #x7CAF #x7CB0 #x7CB4 #x7CB5 #x7CB6 #x7CB7 #x7CB8 #x7CBA
- #x7CBB #x7CBF #x7CC0 #x7CC2 #x7CC3 #x7CC4 #x7CC6 #x7CC9 #x7CCB #x7CCE
- #x7CCF #x7CD0 #x7CD1 #x7CD2 #x7CD3 #x7CD4 #x7CD8 #x7CDA #x7CDB #x7CDD
- #x7CDE #x7CE1 #x7CE2 #x7CE3 #x7CE4 #x7CE5 #x7CE6 #x7CE7 #x7CE9 #x7CEA
- #x7CEB #x7CEC #x7CED #x7CEE #x7CF0 #x7CF1 #x7CF2 #x7CF3 #x7CF4 #x7CF5
- #x7CF6 #x7CF7 #x7CF9 #x7CFA #x7CFC #x7CFD #x7CFE #x7CFF #x7D00 #x7D01
- #x7D02 #x7D03 #x7D04 #x7D05 #x7D06 #x7D07 #x7D08 #x7D09 #x7D0B #x7D0C
- #x7D0D #x7D0E #x7D0F #x7D10 #x7D11 #x7D12 #x7D13 #x7D14 #x7D15 #x7D16
- #x7D17 #x7D18 #x7D19 #x7D1A #x7D1B #x7D1C #x7D1D #x7D1E #x7D1F #x7D21
- #x7D23 #x7D24 #x7D25 #x7D26 #x7D28 #x7D29 #x7D2A #x7D2C #x7D2D #x7D2E
- #x7D30 #x7D31 #x7D32 #x7D33 #x7D34 #x7D35 #x7D36 #x7D37 #x7D38 #x7D39
- #x7D3A #x7D3B #x7D3C #x7D3D #x7D3E #x7D3F #x7D40 #x7D41 #x7D42 #x7D43
- #x7D44 #x7D45 #x7D46 #x7D47 #x7D48 #x7D49 #x7D4A #x7D4B #x7D4C #x7D4D
- #x7D4E #x7D4F #x7D50 #x7D51 #x7D52 #x7D53 #x7D54 #x7D55 #x7D56 #x7D57
- #x7D58 #x7D59 #x7D5A #x7D5B #x7D5C #x7D5D #x7D5E #x7D5F #x7D60 #x7D61
- #x7D62 #x7D63 #x7D64 #x7D65 #x7D66 #x7D67 #x7D68 #x7D69 #x7D6A #x7D6B
- #x7D6C #x7D6D #x7D6F #x7D70 #x7D71 #x7D72 #x7D73 #x7D74 #x7D75 #x7D76
- #x7D78 #x7D79 #x7D7A #x7D7B #x7D7C #x7D7D #x7D7E #x7D7F #x7D80 #x7D81
- #x7D82 #x7D83 #x7D84 #x7D85 #x7D86 #x7D87 #x7D88 #x7D89 #x7D8A #x7D8B
- #x7D8C #x7D8D #x7D8E #x7D8F #x7D90 #x7D91 #x7D92 #x7D93 #x7D94 #x7D95
- #x7D96 #x7D97 #x7D98 #x7D99 #x7D9A #x7D9B #x7D9C #x7D9D #x7D9E #x7D9F
- #x7DA0 #x7DA1 #x7DA2 #x7DA3 #x7DA4 #x7DA5 #x7DA7 #x7DA8 #x7DA9 #x7DAA
- #x7DAB #x7DAC #x7DAD #x7DAF #x7DB0 #x7DB1 #x7DB2 #x7DB3 #x7DB4 #x7DB5
- #x7DB6 #x7DB7 #x7DB8 #x7DB9 #x7DBA #x7DBB #x7DBC #x7DBD #x7DBE #x7DBF
- #x7DC0 #x7DC1 #x7DC2 #x7DC3 #x7DC4 #x7DC5 #x7DC6 #x7DC7 #x7DC8 #x7DC9
- #x7DCA #x7DCB #x7DCC #x7DCD #x7DCE #x7DCF #x7DD0 #x7DD1 #x7DD2 #x7DD3
- #x7DD4 #x7DD5 #x7DD6 #x7DD7 #x7DD8 #x7DD9 #x7DDA #x7DDB #x7DDC #x7DDD
- #x7DDE #x7DDF #x7DE0 #x7DE1 #x7DE2 #x7DE3 #x7DE4 #x7DE5 #x7DE6 #x7DE7
- #x7DE8 #x7DE9 #x7DEA #x7DEB #x7DEC #x7DED #x7DEE #x7DEF #x7DF0 #x7DF1
- #x7DF2 #x7DF3 #x7DF4 #x7DF5 #x7DF6 #x7DF7 #x7DF8 #x7DF9 #x7DFA #x7DFB
- #x7DFC #x7DFD #x7DFE #x7DFF #x7E00 #x7E01 #x7E02 #x7E03 #x7E04 #x7E05
- #x7E06 #x7E07 #x7E08 #x7E09 #x7E0A #x7E0B #x7E0C #x7E0D #x7E0E #x7E0F
- #x7E10 #x7E11 #x7E12 #x7E13 #x7E14 #x7E15 #x7E16 #x7E17 #x7E18 #x7E19
- #x7E1A #x7E1B #x7E1C #x7E1D #x7E1E #x7E1F #x7E20 #x7E21 #x7E22 #x7E23
- #x7E24 #x7E25 #x7E26 #x7E27 #x7E28 #x7E29 #x7E2A #x7E2B #x7E2C #x7E2D
- #x7E2E #x7E2F #x7E30 #x7E31 #x7E32 #x7E33 #x7E34 #x7E35 #x7E36 #x7E37
- #x7E38 #x7E39 #x7E3A #x7E3C #x7E3D #x7E3E #x7E3F #x7E40 #x7E42 #x7E43
- #x7E44 #x7E45 #x7E46 #x7E48 #x7E49 #x7E4A #x7E4B #x7E4C #x7E4D #x7E4E
- #x7E4F #x7E50 #x7E51 #x7E52 #x7E53 #x7E54 #x7E55 #x7E56 #x7E57 #x7E58
- #x7E59 #x7E5A #x7E5B #x7E5C #x7E5D #x7E5E #x7E5F #x7E60 #x7E61 #x7E62
- #x7E63 #x7E64 #x7E65 #x7E66 #x7E67 #x7E68 #x7E69 #x7E6A #x7E6B #x7E6C
- #x7E6D #x7E6E #x7E6F #x7E70 #x7E71 #x7E72 #x7E73 #x7E74 #x7E75 #x7E76
- #x7E77 #x7E78 #x7E79 #x7E7A #x7E7B #x7E7C #x7E7D #x7E7E #x7E7F #x7E80
- #x7E81 #x7E83 #x7E84 #x7E85 #x7E86 #x7E87 #x7E88 #x7E89 #x7E8A #x7E8B
- #x7E8C #x7E8D #x7E8E #x7E8F #x7E90 #x7E91 #x7E92 #x7E93 #x7E94 #x7E95
- #x7E96 #x7E97 #x7E98 #x7E99 #x7E9A #x7E9C #x7E9D #x7E9E #x7EAE #x7EB4
- #x7EBB #x7EBC #x7ED6 #x7EE4 #x7EEC #x7EF9 #x7F0A #x7F10 #x7F1E #x7F37
- #x7F39 #x7F3B #x7F3C #x7F3D #x7F3E #x7F3F #x7F40 #x7F41 #x7F43 #x7F46
- #x7F47 #x7F48 #x7F49 #x7F4A #x7F4B #x7F4C #x7F4D #x7F4E #x7F4F #x7F52
- #x7F53 #x7F56 #x7F59 #x7F5B #x7F5C #x7F5D #x7F5E #x7F60 #x7F63 #x7F64
- #x7F65 #x7F66 #x7F67 #x7F6B #x7F6C #x7F6D #x7F6F #x7F70 #x7F73 #x7F75
- #x7F76 #x7F77 #x7F78 #x7F7A #x7F7B #x7F7C #x7F7D #x7F7F #x7F80 #x7F82
- #x7F83 #x7F84 #x7F85 #x7F86 #x7F87 #x7F88 #x7F89 #x7F8B #x7F8D #x7F8F
- #x7F90 #x7F91 #x7F92 #x7F93 #x7F95 #x7F96 #x7F97 #x7F98 #x7F99 #x7F9B
- #x7F9C #x7FA0 #x7FA2 #x7FA3 #x7FA5 #x7FA6 #x7FA8 #x7FA9 #x7FAA #x7FAB
- #x7FAC #x7FAD #x7FAE #x7FB1 #x7FB3 #x7FB4 #x7FB5 #x7FB6 #x7FB7 #x7FBA
- #x7FBB #x7FBE #x7FC0 #x7FC2 #x7FC3 #x7FC4 #x7FC6 #x7FC7 #x7FC8 #x7FC9
- #x7FCB #x7FCD #x7FCF #x7FD0 #x7FD1 #x7FD2 #x7FD3 #x7FD6 #x7FD7 #x7FD9
- #x7FDA #x7FDB #x7FDC #x7FDD #x7FDE #x7FE2 #x7FE3 #x7FE4 #x7FE7 #x7FE8
- #x7FEA #x7FEB #x7FEC #x7FED #x7FEF #x7FF2 #x7FF4 #x7FF5 #x7FF6 #x7FF7
- #x7FF8 #x7FF9 #x7FFA #x7FFD #x7FFE #x7FFF #x8002 #x8007 #x8008 #x8009
- #x800A #x800E #x800F #x8011 #x8013 #x801A #x801B #x801D #x801E #x801F
- #x8021 #x8023 #x8024 #x802B #x802C #x802D #x802E #x802F #x8030 #x8032
- #x8034 #x8039 #x803A #x803C #x803E #x8040 #x8041 #x8044 #x8045 #x8047
- #x8048 #x8049 #x804E #x804F #x8050 #x8051 #x8053 #x8055 #x8056 #x8057
- #x8059 #x805B #x805C #x805D #x805E #x805F #x8060 #x8061 #x8062 #x8063
- #x8064 #x8065 #x8066 #x8067 #x8068 #x806B #x806C #x806D #x806E #x806F
- #x8070 #x8072 #x8073 #x8074 #x8075 #x8076 #x8077 #x8078 #x8079 #x807A
- #x807B #x807C #x807D #x807E #x8081 #x8082 #x8085 #x8088 #x808A #x808D
- #x808E #x808F #x8090 #x8091 #x8092 #x8094 #x8095 #x8097 #x8099 #x809E
- #x80A3 #x80A6 #x80A7 #x80A8 #x80AC #x80B0 #x80B3 #x80B5 #x80B6 #x80B8
- #x80B9 #x80BB #x80C5 #x80C7 #x80C8 #x80C9 #x80CA #x80CB #x80CF #x80D0
- #x80D1 #x80D2 #x80D3 #x80D4 #x80D5 #x80D8 #x80DF #x80E0 #x80E2 #x80E3
- #x80E6 #x80EE #x80F5 #x80F7 #x80F9 #x80FB #x80FE #x80FF #x8100 #x8101
- #x8103 #x8104 #x8105 #x8107 #x8108 #x810B #x810C #x8115 #x8117 #x8119
- #x811B #x811C #x811D #x811F #x8120 #x8121 #x8122 #x8123 #x8124 #x8125
- #x8126 #x8127 #x8128 #x8129 #x812A #x812B #x812D #x812E #x8130 #x8133
- #x8134 #x8135 #x8137 #x8139 #x813A #x813B #x813C #x813D #x813F #x8140
- #x8141 #x8142 #x8143 #x8144 #x8145 #x8147 #x8149 #x814D #x814E #x814F
- #x8152 #x8156 #x8157 #x8158 #x815B #x815C #x815D #x815E #x815F #x8161
- #x8162 #x8163 #x8164 #x8166 #x8168 #x816A #x816B #x816C #x816F #x8172
- #x8173 #x8175 #x8176 #x8177 #x8178 #x8181 #x8183 #x8184 #x8185 #x8186
- #x8187 #x8189 #x818B #x818C #x818D #x818E #x8190 #x8192 #x8193 #x8194
- #x8195 #x8196 #x8197 #x8199 #x819A #x819E #x819F #x81A0 #x81A1 #x81A2
- #x81A4 #x81A5 #x81A7 #x81A9 #x81AB #x81AC #x81AD #x81AE #x81AF #x81B0
- #x81B1 #x81B2 #x81B4 #x81B5 #x81B6 #x81B7 #x81B8 #x81B9 #x81BC #x81BD
- #x81BE #x81BF #x81C4 #x81C5 #x81C7 #x81C8 #x81C9 #x81CB #x81CD #x81CE
- #x81CF #x81D0 #x81D1 #x81D2 #x81D3 #x81D4 #x81D5 #x81D6 #x81D7 #x81D8
- #x81D9 #x81DA #x81DB #x81DC #x81DD #x81DE #x81DF #x81E0 #x81E1 #x81E2
- #x81E4 #x81E5 #x81E6 #x81E8 #x81E9 #x81EB #x81EE #x81EF #x81F0 #x81F1
- #x81F2 #x81F5 #x81F6 #x81F7 #x81F8 #x81F9 #x81FA #x81FD #x81FF #x8203
- #x8207 #x8208 #x8209 #x820A #x820B #x820E #x820F #x8211 #x8213 #x8215
- #x8216 #x8217 #x8218 #x8219 #x821A #x821D #x8220 #x8224 #x8225 #x8226
- #x8227 #x8229 #x822E #x8232 #x823A #x823C #x823D #x823F #x8240 #x8241
- #x8242 #x8243 #x8245 #x8246 #x8248 #x824A #x824C #x824D #x824E #x8250
- #x8251 #x8252 #x8253 #x8254 #x8255 #x8256 #x8257 #x8259 #x825B #x825C
- #x825D #x825E #x8260 #x8261 #x8262 #x8263 #x8264 #x8265 #x8266 #x8267
- #x8269 #x826A #x826B #x826C #x826D #x8271 #x8275 #x8276 #x8277 #x8278
- #x827B #x827C #x8280 #x8281 #x8283 #x8285 #x8286 #x8287 #x8289 #x828C
- #x8290 #x8293 #x8294 #x8295 #x8296 #x829A #x829B #x829E #x82A0 #x82A2
- #x82A3 #x82A7 #x82B2 #x82B5 #x82B6 #x82BA #x82BB #x82BC #x82BF #x82C0
- #x82C2 #x82C3 #x82C5 #x82C6 #x82C9 #x82D0 #x82D6 #x82D9 #x82DA #x82DD
- #x82E2 #x82E7 #x82E8 #x82E9 #x82EA #x82EC #x82ED #x82EE #x82F0 #x82F2
- #x82F3 #x82F5 #x82F6 #x82F8 #x82FA #x82FC #x82FD #x82FE #x82FF #x8300
- #x830A #x830B #x830D #x8310 #x8312 #x8313 #x8316 #x8318 #x8319 #x831D
- #x831E #x831F #x8320 #x8321 #x8322 #x8323 #x8324 #x8325 #x8326 #x8329
- #x832A #x832E #x8330 #x8332 #x8337 #x833B #x833D #x833E #x833F #x8341
- #x8342 #x8344 #x8345 #x8348 #x834A #x834B #x834C #x834D #x834E #x8353
- #x8355 #x8356 #x8357 #x8358 #x8359 #x835D #x8362 #x8370 #x8371 #x8372
- #x8373 #x8374 #x8375 #x8376 #x8379 #x837A #x837E #x837F #x8380 #x8381
- #x8382 #x8383 #x8384 #x8387 #x8388 #x838A #x838B #x838C #x838D #x838F
- #x8390 #x8391 #x8394 #x8395 #x8396 #x8397 #x8399 #x839A #x839D #x839F
- #x83A1 #x83A2 #x83A3 #x83A4 #x83A5 #x83A6 #x83A7 #x83AC #x83AD #x83AE
- #x83AF #x83B5 #x83BB #x83BE #x83BF #x83C2 #x83C3 #x83C4 #x83C6 #x83C8
- #x83C9 #x83CB #x83CD #x83CE #x83D0 #x83D1 #x83D2 #x83D3 #x83D5 #x83D7
- #x83D9 #x83DA #x83DB #x83DE #x83E2 #x83E3 #x83E4 #x83E6 #x83E7 #x83E8
- #x83EB #x83EC #x83ED #x83EE #x83EF #x83F3 #x83F4 #x83F5 #x83F6 #x83F7
- #x83FA #x83FB #x83FC #x83FE #x83FF #x8400 #x8402 #x8405 #x8407 #x8408
- #x8409 #x840A #x8410 #x8412 #x8413 #x8414 #x8415 #x8416 #x8417 #x8419
- #x841A #x841B #x841E #x841F #x8420 #x8421 #x8422 #x8423 #x8429 #x842A
- #x842B #x842C #x842D #x842E #x842F #x8430 #x8432 #x8433 #x8434 #x8435
- #x8436 #x8437 #x8439 #x843A #x843B #x843E #x843F #x8440 #x8441 #x8442
- #x8443 #x8444 #x8445 #x8447 #x8448 #x8449 #x844A #x844B #x844C #x844D
- #x844E #x844F #x8450 #x8452 #x8453 #x8454 #x8455 #x8456 #x8458 #x845D
- #x845E #x845F #x8460 #x8462 #x8464 #x8465 #x8466 #x8467 #x8468 #x846A
- #x846E #x846F #x8470 #x8472 #x8474 #x8477 #x8479 #x847B #x847C #x847D
- #x847E #x847F #x8480 #x8481 #x8483 #x8484 #x8485 #x8486 #x848A #x848D
- #x848F #x8490 #x8491 #x8492 #x8493 #x8494 #x8495 #x8496 #x8498 #x849A
- #x849B #x849D #x849E #x849F #x84A0 #x84A2 #x84A3 #x84A4 #x84A5 #x84A6
- #x84A7 #x84A8 #x84A9 #x84AA #x84AB #x84AC #x84AD #x84AE #x84B0 #x84B1
- #x84B3 #x84B5 #x84B6 #x84B7 #x84BB #x84BC #x84BE #x84C0 #x84C2 #x84C3
- #x84C5 #x84C6 #x84C7 #x84C8 #x84CB #x84CC #x84CE #x84CF #x84D2 #x84D4
- #x84D5 #x84D7 #x84D8 #x84D9 #x84DA #x84DB #x84DC #x84DE #x84E1 #x84E2
- #x84E4 #x84E7 #x84E8 #x84E9 #x84EA #x84EB #x84ED #x84EE #x84EF #x84F1
- #x84F2 #x84F3 #x84F4 #x84F5 #x84F6 #x84F7 #x84F8 #x84F9 #x84FA #x84FB
- #x84FD #x84FE #x8500 #x8501 #x8502 #x8503 #x8504 #x8505 #x8506 #x8507
- #x8508 #x8509 #x850A #x850B #x850D #x850E #x850F #x8510 #x8512 #x8514
- #x8515 #x8516 #x8518 #x8519 #x851B #x851C #x851D #x851E #x8520 #x8522
- #x8523 #x8524 #x8525 #x8526 #x8527 #x8528 #x8529 #x852A #x852D #x852E
- #x852F #x8530 #x8531 #x8532 #x8533 #x8534 #x8535 #x8536 #x853E #x853F
- #x8540 #x8541 #x8542 #x8544 #x8545 #x8546 #x8547 #x854B #x854C #x854D
- #x854E #x854F #x8550 #x8551 #x8552 #x8553 #x8554 #x8555 #x8557 #x8558
- #x855A #x855B #x855C #x855D #x855F #x8560 #x8561 #x8562 #x8563 #x8565
- #x8566 #x8567 #x8569 #x856A #x856B #x856C #x856D #x856E #x856F #x8570
- #x8571 #x8573 #x8575 #x8576 #x8577 #x8578 #x857C #x857D #x857F #x8580
- #x8581 #x8582 #x8583 #x8586 #x8588 #x8589 #x858A #x858B #x858C #x858D
- #x858E #x8590 #x8591 #x8592 #x8593 #x8594 #x8595 #x8596 #x8597 #x8598
- #x8599 #x859A #x859D #x859E #x859F #x85A0 #x85A1 #x85A2 #x85A3 #x85A5
- #x85A6 #x85A7 #x85A9 #x85AB #x85AC #x85AD #x85B1 #x85B2 #x85B3 #x85B4
- #x85B5 #x85B6 #x85B8 #x85BA #x85BB #x85BC #x85BD #x85BE #x85BF #x85C0
- #x85C2 #x85C3 #x85C4 #x85C5 #x85C6 #x85C7 #x85C8 #x85CA #x85CB #x85CC
- #x85CD #x85CE #x85D1 #x85D2 #x85D4 #x85D6 #x85D7 #x85D8 #x85D9 #x85DA
- #x85DB #x85DD #x85DE #x85DF #x85E0 #x85E1 #x85E2 #x85E3 #x85E5 #x85E6
- #x85E7 #x85E8 #x85EA #x85EB #x85EC #x85ED #x85EE #x85EF #x85F0 #x85F1
- #x85F2 #x85F3 #x85F4 #x85F5 #x85F6 #x85F7 #x85F8 #x85F9 #x85FA #x85FC
- #x85FD #x85FE #x8600 #x8601 #x8602 #x8603 #x8604 #x8606 #x8607 #x8608
- #x8609 #x860A #x860B #x860C #x860D #x860E #x860F #x8610 #x8612 #x8613
- #x8614 #x8615 #x8617 #x8618 #x8619 #x861A #x861B #x861C #x861D #x861E
- #x861F #x8620 #x8621 #x8622 #x8623 #x8624 #x8625 #x8626 #x8628 #x862A
- #x862B #x862C #x862D #x862E #x862F #x8630 #x8631 #x8632 #x8633 #x8634
- #x8635 #x8636 #x8637 #x8639 #x863A #x863B #x863D #x863E #x863F #x8640
- #x8641 #x8642 #x8643 #x8644 #x8645 #x8646 #x8647 #x8648 #x8649 #x864A
- #x864B #x864C #x8652 #x8653 #x8655 #x8656 #x8657 #x8658 #x8659 #x865B
- #x865C #x865D #x865F #x8660 #x8661 #x8663 #x8664 #x8665 #x8666 #x8667
- #x8668 #x8669 #x866A #x866D #x866F #x8670 #x8672 #x8673 #x8674 #x8675
- #x8676 #x8677 #x8678 #x8683 #x8684 #x8685 #x8686 #x8687 #x8688 #x8689
- #x868E #x868F #x8690 #x8691 #x8692 #x8694 #x8696 #x8697 #x8698 #x8699
- #x869A #x869B #x869E #x869F #x86A0 #x86A1 #x86A2 #x86A5 #x86A6 #x86AB
- #x86AD #x86AE #x86B2 #x86B3 #x86B7 #x86B8 #x86B9 #x86BB #x86BC #x86BD
- #x86BE #x86BF #x86C1 #x86C2 #x86C3 #x86C5 #x86C8 #x86CC #x86CD #x86D2
- #x86D3 #x86D5 #x86D6 #x86D7 #x86DA #x86DC #x86DD #x86E0 #x86E1 #x86E2
- #x86E3 #x86E5 #x86E6 #x86E7 #x86E8 #x86EA #x86EB #x86EC #x86EF #x86F5
- #x86F6 #x86F7 #x86FA #x86FB #x86FC #x86FD #x86FF #x8701 #x8704 #x8705
- #x8706 #x870B #x870C #x870E #x870F #x8710 #x8711 #x8714 #x8716 #x8719
- #x871B #x871D #x871F #x8720 #x8724 #x8726 #x8727 #x8728 #x872A #x872B
- #x872C #x872D #x872F #x8730 #x8732 #x8733 #x8735 #x8736 #x8738 #x8739
- #x873A #x873C #x873D #x8740 #x8741 #x8742 #x8743 #x8744 #x8745 #x8746
- #x874A #x874B #x874D #x874F #x8750 #x8751 #x8752 #x8754 #x8755 #x8756
- #x8758 #x875A #x875B #x875C #x875D #x875E #x875F #x8761 #x8762 #x8766
- #x8767 #x8768 #x8769 #x876A #x876B #x876C #x876D #x876F #x8771 #x8772
- #x8773 #x8775 #x8777 #x8778 #x8779 #x877A #x877F #x8780 #x8781 #x8784
- #x8786 #x8787 #x8789 #x878A #x878C #x878E #x878F #x8790 #x8791 #x8792
- #x8794 #x8795 #x8796 #x8798 #x8799 #x879A #x879B #x879C #x879D #x879E
- #x87A0 #x87A1 #x87A2 #x87A3 #x87A4 #x87A5 #x87A6 #x87A7 #x87A9 #x87AA
- #x87AE #x87B0 #x87B1 #x87B2 #x87B4 #x87B6 #x87B7 #x87B8 #x87B9 #x87BB
- #x87BC #x87BE #x87BF #x87C1 #x87C2 #x87C3 #x87C4 #x87C5 #x87C7 #x87C8
- #x87C9 #x87CC #x87CD #x87CE #x87CF #x87D0 #x87D4 #x87D5 #x87D6 #x87D7
- #x87D8 #x87D9 #x87DA #x87DC #x87DD #x87DE #x87DF #x87E1 #x87E2 #x87E3
- #x87E4 #x87E6 #x87E7 #x87E8 #x87E9 #x87EB #x87EC #x87ED #x87EF #x87F0
- #x87F1 #x87F2 #x87F3 #x87F4 #x87F5 #x87F6 #x87F7 #x87F8 #x87FA #x87FB
- #x87FC #x87FD #x87FF #x8800 #x8801 #x8802 #x8804 #x8805 #x8806 #x8807
- #x8808 #x8809 #x880B #x880C #x880D #x880E #x880F #x8810 #x8811 #x8812
- #x8814 #x8817 #x8818 #x8819 #x881A #x881C #x881D #x881E #x881F #x8820
- #x8823 #x8824 #x8825 #x8826 #x8827 #x8828 #x8829 #x882A #x882B #x882C
- #x882D #x882E #x882F #x8830 #x8831 #x8833 #x8834 #x8835 #x8836 #x8837
- #x8838 #x883A #x883B #x883D #x883E #x883F #x8841 #x8842 #x8843 #x8846
- #x8847 #x8848 #x8849 #x884A #x884B #x884E #x884F #x8850 #x8851 #x8852
- #x8853 #x8855 #x8856 #x8858 #x885A #x885B #x885C #x885D #x885E #x885F
- #x8860 #x8866 #x8867 #x886A #x886D #x886F #x8871 #x8873 #x8874 #x8875
- #x8876 #x8878 #x8879 #x887A #x887B #x887C #x8880 #x8883 #x8886 #x8887
- #x8889 #x888A #x888C #x888E #x888F #x8890 #x8891 #x8893 #x8894 #x8895
- #x8897 #x8898 #x8899 #x889A #x889B #x889D #x889E #x889F #x88A0 #x88A1
- #x88A3 #x88A5 #x88A6 #x88A7 #x88A8 #x88A9 #x88AA #x88AC #x88AE #x88AF
- #x88B0 #x88B2 #x88B3 #x88B4 #x88B5 #x88B6 #x88B8 #x88B9 #x88BA #x88BB
- #x88BD #x88BE #x88BF #x88C0 #x88C3 #x88C4 #x88C7 #x88C8 #x88CA #x88CB
- #x88CC #x88CD #x88CF #x88D0 #x88D1 #x88D3 #x88D6 #x88D7 #x88DA #x88DB
- #x88DC #x88DD #x88DE #x88E0 #x88E1 #x88E6 #x88E7 #x88E9 #x88EA #x88EB
- #x88EC #x88ED #x88EE #x88EF #x88F2 #x88F5 #x88F6 #x88F7 #x88FA #x88FB
- #x88FD #x88FF #x8900 #x8901 #x8903 #x8904 #x8905 #x8906 #x8907 #x8908
- #x8909 #x890B #x890C #x890D #x890E #x890F #x8911 #x8914 #x8915 #x8916
- #x8917 #x8918 #x891C #x891D #x891E #x891F #x8920 #x8922 #x8923 #x8924
- #x8926 #x8927 #x8928 #x8929 #x892C #x892D #x892E #x892F #x8931 #x8932
- #x8933 #x8935 #x8937 #x8938 #x8939 #x893A #x893B #x893C #x893D #x893E
- #x893F #x8940 #x8942 #x8943 #x8945 #x8946 #x8947 #x8948 #x8949 #x894A
- #x894B #x894C #x894D #x894E #x894F #x8950 #x8951 #x8952 #x8953 #x8954
- #x8955 #x8956 #x8957 #x8958 #x8959 #x895A #x895B #x895C #x895D #x8960
- #x8961 #x8962 #x8963 #x8964 #x8965 #x8967 #x8968 #x8969 #x896A #x896B
- #x896C #x896D #x896E #x896F #x8970 #x8971 #x8972 #x8973 #x8974 #x8975
- #x8976 #x8977 #x8978 #x8979 #x897A #x897C #x897D #x897E #x8980 #x8982
- #x8984 #x8985 #x8987 #x8988 #x8989 #x898A #x898B #x898C #x898D #x898E
- #x898F #x8990 #x8991 #x8992 #x8993 #x8994 #x8995 #x8996 #x8997 #x8998
- #x8999 #x899A #x899B #x899C #x899D #x899E #x899F #x89A0 #x89A1 #x89A2
- #x89A3 #x89A4 #x89A5 #x89A6 #x89A7 #x89A8 #x89A9 #x89AA #x89AB #x89AC
- #x89AD #x89AE #x89AF #x89B0 #x89B1 #x89B2 #x89B3 #x89B4 #x89B5 #x89B6
- #x89B7 #x89B8 #x89B9 #x89BA #x89BB #x89BC #x89BD #x89BE #x89BF #x89C0
- #x89C3 #x89CD #x89D3 #x89D4 #x89D5 #x89D7 #x89D8 #x89D9 #x89DB #x89DD
- #x89DF #x89E0 #x89E1 #x89E2 #x89E4 #x89E7 #x89E8 #x89E9 #x89EA #x89EC
- #x89ED #x89EE #x89F0 #x89F1 #x89F2 #x89F4 #x89F5 #x89F6 #x89F7 #x89F8
- #x89F9 #x89FA #x89FB #x89FC #x89FD #x89FE #x89FF #x8A01 #x8A02 #x8A03
- #x8A04 #x8A05 #x8A06 #x8A08 #x8A09 #x8A0A #x8A0B #x8A0C #x8A0D #x8A0E
- #x8A0F #x8A10 #x8A11 #x8A12 #x8A13 #x8A14 #x8A15 #x8A16 #x8A17 #x8A18
- #x8A19 #x8A1A #x8A1B #x8A1C #x8A1D #x8A1E #x8A1F #x8A20 #x8A21 #x8A22
- #x8A23 #x8A24 #x8A25 #x8A26 #x8A27 #x8A28 #x8A29 #x8A2A #x8A2B #x8A2C
- #x8A2D #x8A2E #x8A2F #x8A30 #x8A31 #x8A32 #x8A33 #x8A34 #x8A35 #x8A36
- #x8A37 #x8A38 #x8A39 #x8A3A #x8A3B #x8A3C #x8A3D #x8A3F #x8A40 #x8A41
- #x8A42 #x8A43 #x8A44 #x8A45 #x8A46 #x8A47 #x8A49 #x8A4A #x8A4B #x8A4C
- #x8A4D #x8A4E #x8A4F #x8A50 #x8A51 #x8A52 #x8A53 #x8A54 #x8A55 #x8A56
- #x8A57 #x8A58 #x8A59 #x8A5A #x8A5B #x8A5C #x8A5D #x8A5E #x8A5F #x8A60
- #x8A61 #x8A62 #x8A63 #x8A64 #x8A65 #x8A66 #x8A67 #x8A68 #x8A69 #x8A6A
- #x8A6B #x8A6C #x8A6D #x8A6E #x8A6F #x8A70 #x8A71 #x8A72 #x8A73 #x8A74
- #x8A75 #x8A76 #x8A77 #x8A78 #x8A7A #x8A7B #x8A7C #x8A7D #x8A7E #x8A7F
- #x8A80 #x8A81 #x8A82 #x8A83 #x8A84 #x8A85 #x8A86 #x8A87 #x8A88 #x8A8B
- #x8A8C #x8A8D #x8A8E #x8A8F #x8A90 #x8A91 #x8A92 #x8A94 #x8A95 #x8A96
- #x8A97 #x8A98 #x8A99 #x8A9A #x8A9B #x8A9C #x8A9D #x8A9E #x8A9F #x8AA0
- #x8AA1 #x8AA2 #x8AA3 #x8AA4 #x8AA5 #x8AA6 #x8AA7 #x8AA8 #x8AA9 #x8AAA
- #x8AAB #x8AAC #x8AAD #x8AAE #x8AAF #x8AB0 #x8AB1 #x8AB2 #x8AB3 #x8AB4
- #x8AB5 #x8AB6 #x8AB7 #x8AB8 #x8AB9 #x8ABA #x8ABB #x8ABC #x8ABD #x8ABE
- #x8ABF #x8AC0 #x8AC1 #x8AC2 #x8AC3 #x8AC4 #x8AC5 #x8AC6 #x8AC7 #x8AC8
- #x8AC9 #x8ACA #x8ACB #x8ACC #x8ACD #x8ACE #x8ACF #x8AD0 #x8AD1 #x8AD2
- #x8AD3 #x8AD4 #x8AD5 #x8AD6 #x8AD7 #x8AD8 #x8AD9 #x8ADA #x8ADB #x8ADC
- #x8ADD #x8ADE #x8ADF #x8AE0 #x8AE1 #x8AE2 #x8AE3 #x8AE4 #x8AE5 #x8AE6
- #x8AE7 #x8AE8 #x8AE9 #x8AEA #x8AEB #x8AEC #x8AED #x8AEE #x8AEF #x8AF0
- #x8AF1 #x8AF2 #x8AF3 #x8AF4 #x8AF5 #x8AF6 #x8AF7 #x8AF8 #x8AF9 #x8AFA
- #x8AFB #x8AFC #x8AFD #x8AFE #x8AFF #x8B00 #x8B01 #x8B02 #x8B03 #x8B04
- #x8B05 #x8B06 #x8B08 #x8B09 #x8B0A #x8B0B #x8B0C #x8B0D #x8B0E #x8B0F
- #x8B10 #x8B11 #x8B12 #x8B13 #x8B14 #x8B15 #x8B16 #x8B17 #x8B18 #x8B19
- #x8B1A #x8B1B #x8B1C #x8B1D #x8B1E #x8B1F #x8B20 #x8B21 #x8B22 #x8B23
- #x8B24 #x8B25 #x8B27 #x8B28 #x8B29 #x8B2A #x8B2B #x8B2C #x8B2D #x8B2E
- #x8B2F #x8B30 #x8B31 #x8B32 #x8B33 #x8B34 #x8B35 #x8B36 #x8B37 #x8B38
- #x8B39 #x8B3A #x8B3B #x8B3C #x8B3D #x8B3E #x8B3F #x8B40 #x8B41 #x8B42
- #x8B43 #x8B44 #x8B45 #x8B46 #x8B47 #x8B48 #x8B49 #x8B4A #x8B4B #x8B4C
- #x8B4D #x8B4E #x8B4F #x8B50 #x8B51 #x8B52 #x8B53 #x8B54 #x8B55 #x8B56
- #x8B57 #x8B58 #x8B59 #x8B5A #x8B5B #x8B5C #x8B5D #x8B5E #x8B5F #x8B60
- #x8B61 #x8B62 #x8B63 #x8B64 #x8B65 #x8B67 #x8B68 #x8B69 #x8B6A #x8B6B
- #x8B6D #x8B6E #x8B6F #x8B70 #x8B71 #x8B72 #x8B73 #x8B74 #x8B75 #x8B76
- #x8B77 #x8B78 #x8B79 #x8B7A #x8B7B #x8B7C #x8B7D #x8B7E #x8B7F #x8B80
- #x8B81 #x8B82 #x8B83 #x8B84 #x8B85 #x8B86 #x8B87 #x8B88 #x8B89 #x8B8A
- #x8B8B #x8B8C #x8B8D #x8B8E #x8B8F #x8B90 #x8B91 #x8B92 #x8B93 #x8B94
- #x8B95 #x8B96 #x8B97 #x8B98 #x8B99 #x8B9A #x8B9B #x8B9C #x8B9D #x8B9E
- #x8B9F #x8BAC #x8BB1 #x8BBB #x8BC7 #x8BD0 #x8BEA #x8C09 #x8C1E #x8C38
- #x8C39 #x8C3A #x8C3B #x8C3C #x8C3D #x8C3E #x8C3F #x8C40 #x8C42 #x8C43
- #x8C44 #x8C45 #x8C48 #x8C4A #x8C4B #x8C4D #x8C4E #x8C4F #x8C50 #x8C51
- #x8C52 #x8C53 #x8C54 #x8C56 #x8C57 #x8C58 #x8C59 #x8C5B #x8C5C #x8C5D
- #x8C5E #x8C5F #x8C60 #x8C63 #x8C64 #x8C65 #x8C66 #x8C67 #x8C68 #x8C69
- #x8C6C #x8C6D #x8C6E #x8C6F #x8C70 #x8C71 #x8C72 #x8C74 #x8C75 #x8C76
- #x8C77 #x8C7B #x8C7C #x8C7D #x8C7E #x8C7F #x8C80 #x8C81 #x8C83 #x8C84
- #x8C86 #x8C87 #x8C88 #x8C8B #x8C8D #x8C8E #x8C8F #x8C90 #x8C91 #x8C92
- #x8C93 #x8C95 #x8C96 #x8C97 #x8C99 #x8C9A #x8C9B #x8C9C #x8C9D #x8C9E
- #x8C9F #x8CA0 #x8CA1 #x8CA2 #x8CA3 #x8CA4 #x8CA5 #x8CA6 #x8CA7 #x8CA8
- #x8CA9 #x8CAA #x8CAB #x8CAC #x8CAD #x8CAE #x8CAF #x8CB0 #x8CB1 #x8CB2
- #x8CB3 #x8CB4 #x8CB5 #x8CB6 #x8CB7 #x8CB8 #x8CB9 #x8CBA #x8CBB #x8CBC
- #x8CBD #x8CBE #x8CBF #x8CC0 #x8CC1 #x8CC2 #x8CC3 #x8CC4 #x8CC5 #x8CC6
- #x8CC7 #x8CC8 #x8CC9 #x8CCA #x8CCB #x8CCC #x8CCD #x8CCE #x8CCF #x8CD0
- #x8CD1 #x8CD2 #x8CD3 #x8CD4 #x8CD5 #x8CD6 #x8CD7 #x8CD8 #x8CD9 #x8CDA
- #x8CDB #x8CDC #x8CDD #x8CDE #x8CDF #x8CE0 #x8CE1 #x8CE2 #x8CE3 #x8CE4
- #x8CE5 #x8CE6 #x8CE7 #x8CE8 #x8CE9 #x8CEA #x8CEB #x8CEC #x8CED #x8CEE
- #x8CEF #x8CF0 #x8CF1 #x8CF2 #x8CF3 #x8CF4 #x8CF5 #x8CF6 #x8CF7 #x8CF8
- #x8CF9 #x8CFA #x8CFB #x8CFC #x8CFD #x8CFE #x8CFF #x8D00 #x8D01 #x8D02
- #x8D03 #x8D04 #x8D05 #x8D06 #x8D07 #x8D08 #x8D09 #x8D0A #x8D0B #x8D0C
- #x8D0D #x8D0E #x8D0F #x8D10 #x8D11 #x8D12 #x8D13 #x8D14 #x8D15 #x8D16
- #x8D17 #x8D18 #x8D19 #x8D1A #x8D1B #x8D1C #x8D20 #x8D51 #x8D52 #x8D57
- #x8D5F #x8D65 #x8D68 #x8D69 #x8D6A #x8D6C #x8D6E #x8D6F #x8D71 #x8D72
- #x8D78 #x8D79 #x8D7A #x8D7B #x8D7C #x8D7D #x8D7E #x8D7F #x8D80 #x8D82
- #x8D83 #x8D86 #x8D87 #x8D88 #x8D89 #x8D8C #x8D8D #x8D8E #x8D8F #x8D90
- #x8D92 #x8D93 #x8D95 #x8D96 #x8D97 #x8D98 #x8D99 #x8D9A #x8D9B #x8D9C
- #x8D9D #x8D9E #x8DA0 #x8DA1 #x8DA2 #x8DA4 #x8DA5 #x8DA6 #x8DA7 #x8DA8
- #x8DA9 #x8DAA #x8DAB #x8DAC #x8DAD #x8DAE #x8DAF #x8DB0 #x8DB2 #x8DB6
- #x8DB7 #x8DB9 #x8DBB #x8DBD #x8DC0 #x8DC1 #x8DC2 #x8DC5 #x8DC7 #x8DC8
- #x8DC9 #x8DCA #x8DCD #x8DD0 #x8DD2 #x8DD3 #x8DD4 #x8DD5 #x8DD8 #x8DD9
- #x8DDC #x8DE0 #x8DE1 #x8DE2 #x8DE5 #x8DE6 #x8DE7 #x8DE9 #x8DED #x8DEE
- #x8DF0 #x8DF1 #x8DF2 #x8DF4 #x8DF6 #x8DFC #x8DFE #x8DFF #x8E00 #x8E01
- #x8E02 #x8E03 #x8E04 #x8E06 #x8E07 #x8E08 #x8E0B #x8E0D #x8E0E #x8E10
- #x8E11 #x8E12 #x8E13 #x8E15 #x8E16 #x8E17 #x8E18 #x8E19 #x8E1A #x8E1B
- #x8E1C #x8E20 #x8E21 #x8E24 #x8E25 #x8E26 #x8E27 #x8E28 #x8E2B #x8E2D
- #x8E30 #x8E32 #x8E33 #x8E34 #x8E36 #x8E37 #x8E38 #x8E3B #x8E3C #x8E3E
- #x8E3F #x8E43 #x8E45 #x8E46 #x8E4C #x8E4D #x8E4E #x8E4F #x8E50 #x8E53
- #x8E54 #x8E55 #x8E56 #x8E57 #x8E58 #x8E5A #x8E5B #x8E5C #x8E5D #x8E5E
- #x8E5F #x8E60 #x8E61 #x8E62 #x8E63 #x8E64 #x8E65 #x8E67 #x8E68 #x8E6A
- #x8E6B #x8E6E #x8E71 #x8E73 #x8E75 #x8E77 #x8E78 #x8E79 #x8E7A #x8E7B
- #x8E7D #x8E7E #x8E80 #x8E82 #x8E83 #x8E84 #x8E86 #x8E88 #x8E89 #x8E8A
- #x8E8B #x8E8C #x8E8D #x8E8E #x8E91 #x8E92 #x8E93 #x8E95 #x8E96 #x8E97
- #x8E98 #x8E99 #x8E9A #x8E9B #x8E9D #x8E9F #x8EA0 #x8EA1 #x8EA2 #x8EA3
- #x8EA4 #x8EA5 #x8EA6 #x8EA7 #x8EA8 #x8EA9 #x8EAA #x8EAD #x8EAE #x8EB0
- #x8EB1 #x8EB3 #x8EB4 #x8EB5 #x8EB6 #x8EB7 #x8EB8 #x8EB9 #x8EBB #x8EBC
- #x8EBD #x8EBE #x8EBF #x8EC0 #x8EC1 #x8EC2 #x8EC3 #x8EC4 #x8EC5 #x8EC6
- #x8EC7 #x8EC8 #x8EC9 #x8ECA #x8ECB #x8ECC #x8ECD #x8ECF #x8ED0 #x8ED1
- #x8ED2 #x8ED3 #x8ED4 #x8ED5 #x8ED6 #x8ED7 #x8ED8 #x8ED9 #x8EDA #x8EDB
- #x8EDC #x8EDD #x8EDE #x8EDF #x8EE0 #x8EE1 #x8EE2 #x8EE3 #x8EE4 #x8EE5
- #x8EE6 #x8EE7 #x8EE8 #x8EE9 #x8EEA #x8EEB #x8EEC #x8EED #x8EEE #x8EEF
- #x8EF0 #x8EF1 #x8EF2 #x8EF3 #x8EF4 #x8EF5 #x8EF6 #x8EF7 #x8EF8 #x8EF9
- #x8EFA #x8EFB #x8EFC #x8EFD #x8EFE #x8EFF #x8F00 #x8F01 #x8F02 #x8F03
- #x8F04 #x8F05 #x8F06 #x8F07 #x8F08 #x8F09 #x8F0A #x8F0B #x8F0C #x8F0D
- #x8F0E #x8F0F #x8F10 #x8F11 #x8F12 #x8F13 #x8F14 #x8F15 #x8F16 #x8F17
- #x8F18 #x8F19 #x8F1A #x8F1B #x8F1C #x8F1D #x8F1E #x8F1F #x8F20 #x8F21
- #x8F22 #x8F23 #x8F24 #x8F25 #x8F26 #x8F27 #x8F28 #x8F29 #x8F2A #x8F2B
- #x8F2C #x8F2D #x8F2E #x8F2F #x8F30 #x8F31 #x8F32 #x8F33 #x8F34 #x8F35
- #x8F36 #x8F37 #x8F38 #x8F39 #x8F3A #x8F3B #x8F3C #x8F3D #x8F3E #x8F3F
- #x8F40 #x8F41 #x8F42 #x8F43 #x8F44 #x8F45 #x8F46 #x8F47 #x8F48 #x8F49
- #x8F4A #x8F4B #x8F4C #x8F4D #x8F4E #x8F4F #x8F50 #x8F51 #x8F52 #x8F53
- #x8F54 #x8F55 #x8F56 #x8F57 #x8F58 #x8F59 #x8F5A #x8F5B #x8F5C #x8F5D
- #x8F5E #x8F5F #x8F60 #x8F61 #x8F62 #x8F63 #x8F64 #x8F65 #x8F6A #x8F80
- #x8F8C #x8F92 #x8F9D #x8FA0 #x8FA1 #x8FA2 #x8FA4 #x8FA5 #x8FA6 #x8FA7
- #x8FAA #x8FAC #x8FAD #x8FAE #x8FAF #x8FB2 #x8FB3 #x8FB4 #x8FB5 #x8FB7
- #x8FB8 #x8FBA #x8FBB #x8FBC #x8FBF #x8FC0 #x8FC3 #x8FC6 #x8FC9 #x8FCA
- #x8FCB #x8FCC #x8FCD #x8FCF #x8FD2 #x8FD6 #x8FD7 #x8FDA #x8FE0 #x8FE1
- #x8FE3 #x8FE7 #x8FEC #x8FEF #x8FF1 #x8FF2 #x8FF4 #x8FF5 #x8FF6 #x8FFA
- #x8FFB #x8FFC #x8FFE #x8FFF #x9007 #x9008 #x900C #x900E #x9013 #x9015
- #x9018 #x9019 #x901C #x9023 #x9024 #x9025 #x9027 #x9028 #x9029 #x902A
- #x902B #x902C #x9030 #x9031 #x9032 #x9033 #x9034 #x9037 #x9039 #x903A
- #x903D #x903F #x9040 #x9043 #x9045 #x9046 #x9048 #x9049 #x904A #x904B
- #x904C #x904E #x9054 #x9055 #x9056 #x9059 #x905A #x905C #x905D #x905E
- #x905F #x9060 #x9061 #x9064 #x9066 #x9067 #x9069 #x906A #x906B #x906C
- #x906F #x9070 #x9071 #x9072 #x9073 #x9076 #x9077 #x9078 #x9079 #x907A
- #x907B #x907C #x907E #x9081 #x9084 #x9085 #x9086 #x9087 #x9089 #x908A
- #x908C #x908D #x908E #x908F #x9090 #x9092 #x9094 #x9096 #x9098 #x909A
- #x909C #x909E #x909F #x90A0 #x90A4 #x90A5 #x90A7 #x90A8 #x90A9 #x90AB
- #x90AD #x90B2 #x90B7 #x90BC #x90BD #x90BF #x90C0 #x90C2 #x90C3 #x90C6
- #x90C8 #x90C9 #x90CB #x90CC #x90CD #x90D2 #x90D4 #x90D5 #x90D6 #x90D8
- #x90D9 #x90DA #x90DE #x90DF #x90E0 #x90E3 #x90E4 #x90E5 #x90E9 #x90EA
- #x90EC #x90EE #x90F0 #x90F1 #x90F2 #x90F3 #x90F5 #x90F6 #x90F7 #x90F9
- #x90FA #x90FB #x90FC #x90FF #x9100 #x9101 #x9103 #x9105 #x9106 #x9107
- #x9108 #x9109 #x910A #x910B #x910C #x910D #x910E #x910F #x9110 #x9111
- #x9112 #x9113 #x9114 #x9115 #x9116 #x9117 #x9118 #x911A #x911B #x911C
- #x911D #x911F #x9120 #x9121 #x9124 #x9125 #x9126 #x9127 #x9128 #x9129
- #x912A #x912B #x912C #x912D #x912E #x9130 #x9132 #x9133 #x9134 #x9135
- #x9136 #x9137 #x9138 #x913A #x913B #x913C #x913D #x913E #x913F #x9140
- #x9141 #x9142 #x9144 #x9145 #x9147 #x9148 #x9151 #x9153 #x9154 #x9155
- #x9156 #x9158 #x9159 #x915B #x915C #x915F #x9160 #x9166 #x9167 #x9168
- #x916B #x916D #x9173 #x917A #x917B #x917C #x9180 #x9181 #x9182 #x9183
- #x9184 #x9186 #x9188 #x918A #x918E #x918F #x9193 #x9194 #x9195 #x9196
- #x9197 #x9198 #x9199 #x919C #x919D #x919E #x919F #x91A0 #x91A1 #x91A4
- #x91A5 #x91A6 #x91A7 #x91A8 #x91A9 #x91AB #x91AC #x91B0 #x91B1 #x91B2
- #x91B3 #x91B6 #x91B7 #x91B8 #x91B9 #x91BB #x91BC #x91BD #x91BE #x91BF
- #x91C0 #x91C1 #x91C2 #x91C3 #x91C4 #x91C5 #x91C6 #x91C8 #x91CB #x91D0
- #x91D2 #x91D3 #x91D4 #x91D5 #x91D6 #x91D7 #x91D8 #x91D9 #x91DA #x91DB
- #x91DD #x91DE #x91DF #x91E0 #x91E1 #x91E2 #x91E3 #x91E4 #x91E5 #x91E6
- #x91E7 #x91E8 #x91E9 #x91EA #x91EB #x91EC #x91ED #x91EE #x91EF #x91F0
- #x91F1 #x91F2 #x91F3 #x91F4 #x91F5 #x91F6 #x91F7 #x91F8 #x91F9 #x91FA
- #x91FB #x91FC #x91FD #x91FE #x91FF #x9200 #x9201 #x9202 #x9203 #x9204
- #x9205 #x9206 #x9207 #x9208 #x9209 #x920A #x920B #x920C #x920D #x920E
- #x920F #x9210 #x9211 #x9212 #x9213 #x9214 #x9215 #x9216 #x9217 #x9218
- #x9219 #x921A #x921B #x921C #x921D #x921E #x921F #x9220 #x9221 #x9222
- #x9223 #x9224 #x9225 #x9226 #x9227 #x9228 #x9229 #x922A #x922B #x922C
- #x922D #x922E #x922F #x9230 #x9231 #x9232 #x9233 #x9234 #x9235 #x9236
- #x9237 #x9238 #x9239 #x923A #x923B #x923C #x923D #x923E #x923F #x9240
- #x9241 #x9242 #x9243 #x9244 #x9245 #x9246 #x9247 #x9248 #x9249 #x924A
- #x924B #x924C #x924D #x924E #x924F #x9250 #x9251 #x9252 #x9253 #x9254
- #x9255 #x9256 #x9257 #x9258 #x9259 #x925A #x925B #x925C #x925D #x925E
- #x925F #x9260 #x9261 #x9262 #x9263 #x9264 #x9265 #x9266 #x9267 #x9268
- #x9269 #x926A #x926B #x926C #x926D #x926E #x926F #x9270 #x9271 #x9272
- #x9273 #x9275 #x9276 #x9277 #x9278 #x9279 #x927A #x927B #x927C #x927D
- #x927E #x927F #x9280 #x9281 #x9282 #x9283 #x9284 #x9285 #x9286 #x9287
- #x9288 #x9289 #x928A #x928B #x928C #x928D #x928F #x9290 #x9291 #x9292
- #x9293 #x9294 #x9295 #x9296 #x9297 #x9298 #x9299 #x929A #x929B #x929C
- #x929D #x929E #x929F #x92A0 #x92A1 #x92A2 #x92A3 #x92A4 #x92A5 #x92A6
- #x92A7 #x92A8 #x92A9 #x92AA #x92AB #x92AC #x92AD #x92AF #x92B0 #x92B1
- #x92B2 #x92B3 #x92B4 #x92B5 #x92B6 #x92B7 #x92B8 #x92B9 #x92BA #x92BB
- #x92BC #x92BD #x92BE #x92BF #x92C0 #x92C1 #x92C2 #x92C3 #x92C4 #x92C5
- #x92C6 #x92C7 #x92C9 #x92CA #x92CB #x92CC #x92CD #x92CE #x92CF #x92D0
- #x92D1 #x92D2 #x92D3 #x92D4 #x92D5 #x92D6 #x92D7 #x92D8 #x92D9 #x92DA
- #x92DB #x92DC #x92DD #x92DE #x92DF #x92E0 #x92E1 #x92E2 #x92E3 #x92E4
- #x92E5 #x92E6 #x92E7 #x92E8 #x92E9 #x92EA #x92EB #x92EC #x92ED #x92EE
- #x92EF #x92F0 #x92F1 #x92F2 #x92F3 #x92F4 #x92F5 #x92F6 #x92F7 #x92F8
- #x92F9 #x92FA #x92FB #x92FC #x92FD #x92FE #x92FF #x9300 #x9301 #x9302
- #x9303 #x9304 #x9305 #x9306 #x9307 #x9308 #x9309 #x930A #x930B #x930C
- #x930D #x930E #x930F #x9310 #x9311 #x9312 #x9313 #x9314 #x9315 #x9316
- #x9317 #x9318 #x9319 #x931A #x931B #x931C #x931D #x931E #x931F #x9320
- #x9321 #x9322 #x9323 #x9324 #x9325 #x9326 #x9327 #x9328 #x9329 #x932A
- #x932B #x932C #x932D #x932E #x932F #x9330 #x9331 #x9332 #x9333 #x9334
- #x9335 #x9336 #x9337 #x9338 #x9339 #x933A #x933B #x933C #x933D #x933F
- #x9340 #x9341 #x9342 #x9343 #x9344 #x9345 #x9346 #x9347 #x9348 #x9349
- #x934A #x934B #x934C #x934D #x934E #x934F #x9350 #x9351 #x9352 #x9353
- #x9354 #x9355 #x9356 #x9357 #x9358 #x9359 #x935A #x935B #x935C #x935D
- #x935E #x935F #x9360 #x9361 #x9362 #x9363 #x9364 #x9365 #x9366 #x9367
- #x9368 #x9369 #x936B #x936C #x936D #x936E #x936F #x9370 #x9371 #x9372
- #x9373 #x9374 #x9375 #x9376 #x9377 #x9378 #x9379 #x937A #x937B #x937C
- #x937D #x937E #x937F #x9380 #x9381 #x9382 #x9383 #x9384 #x9385 #x9386
- #x9387 #x9388 #x9389 #x938A #x938B #x938C #x938D #x938E #x9390 #x9391
- #x9392 #x9393 #x9394 #x9395 #x9396 #x9397 #x9398 #x9399 #x939A #x939B
- #x939C #x939D #x939E #x939F #x93A0 #x93A1 #x93A2 #x93A3 #x93A4 #x93A5
- #x93A6 #x93A7 #x93A8 #x93A9 #x93AA #x93AB #x93AC #x93AD #x93AE #x93AF
- #x93B0 #x93B1 #x93B2 #x93B3 #x93B4 #x93B5 #x93B6 #x93B7 #x93B8 #x93B9
- #x93BA #x93BB #x93BC #x93BD #x93BE #x93BF #x93C0 #x93C1 #x93C2 #x93C3
- #x93C4 #x93C5 #x93C6 #x93C7 #x93C8 #x93C9 #x93CB #x93CC #x93CD #x93CE
- #x93CF #x93D0 #x93D1 #x93D2 #x93D3 #x93D4 #x93D5 #x93D7 #x93D8 #x93D9
- #x93DA #x93DB #x93DC #x93DD #x93DE #x93DF #x93E0 #x93E1 #x93E2 #x93E3
- #x93E4 #x93E5 #x93E6 #x93E7 #x93E8 #x93E9 #x93EA #x93EB #x93EC #x93ED
- #x93EE #x93EF #x93F0 #x93F1 #x93F2 #x93F3 #x93F4 #x93F5 #x93F6 #x93F7
- #x93F8 #x93F9 #x93FA #x93FB #x93FC #x93FD #x93FE #x93FF #x9400 #x9401
- #x9402 #x9403 #x9404 #x9405 #x9406 #x9407 #x9408 #x9409 #x940A #x940B
- #x940C #x940D #x940E #x940F #x9410 #x9411 #x9412 #x9413 #x9414 #x9415
- #x9416 #x9417 #x9418 #x9419 #x941A #x941B #x941C #x941D #x941E #x941F
- #x9420 #x9421 #x9422 #x9423 #x9424 #x9425 #x9426 #x9427 #x9428 #x9429
- #x942A #x942B #x942C #x942D #x942E #x942F #x9430 #x9431 #x9432 #x9433
- #x9434 #x9435 #x9436 #x9437 #x9438 #x9439 #x943A #x943B #x943C #x943D
- #x943F #x9440 #x9441 #x9442 #x9443 #x9444 #x9445 #x9446 #x9447 #x9448
- #x9449 #x944A #x944B #x944C #x944D #x944E #x944F #x9450 #x9451 #x9452
- #x9453 #x9454 #x9455 #x9456 #x9457 #x9458 #x9459 #x945A #x945B #x945C
- #x945D #x945E #x945F #x9460 #x9461 #x9462 #x9463 #x9464 #x9465 #x9466
- #x9467 #x9468 #x9469 #x946A #x946C #x946D #x946E #x946F #x9470 #x9471
- #x9472 #x9473 #x9474 #x9475 #x9476 #x9477 #x9478 #x9479 #x947A #x947B
- #x947C #x947D #x947E #x947F #x9480 #x9481 #x9482 #x9483 #x9484 #x9491
- #x9496 #x9498 #x94C7 #x94CF #x94D3 #x94D4 #x94DA #x94E6 #x94FB #x951C
- #x9520 #x9527 #x9533 #x953D #x9543 #x9548 #x954B #x9555 #x955A #x9560
- #x956E #x9574 #x9575 #x9577 #x9578 #x9579 #x957A #x957B #x957C #x957D
- #x957E #x9580 #x9581 #x9582 #x9583 #x9584 #x9585 #x9586 #x9587 #x9588
- #x9589 #x958A #x958B #x958C #x958D #x958E #x958F #x9590 #x9591 #x9592
- #x9593 #x9594 #x9595 #x9596 #x9597 #x9598 #x9599 #x959A #x959B #x959C
- #x959D #x959E #x959F #x95A0 #x95A1 #x95A2 #x95A3 #x95A4 #x95A5 #x95A6
- #x95A7 #x95A8 #x95A9 #x95AA #x95AB #x95AC #x95AD #x95AE #x95AF #x95B0
- #x95B1 #x95B2 #x95B3 #x95B4 #x95B5 #x95B6 #x95B7 #x95B8 #x95B9 #x95BA
- #x95BB #x95BC #x95BD #x95BE #x95BF #x95C0 #x95C1 #x95C2 #x95C3 #x95C4
- #x95C5 #x95C6 #x95C7 #x95C8 #x95C9 #x95CA #x95CB #x95CC #x95CD #x95CE
- #x95CF #x95D0 #x95D1 #x95D2 #x95D3 #x95D4 #x95D5 #x95D6 #x95D7 #x95D8
- #x95D9 #x95DA #x95DB #x95DC #x95DD #x95DE #x95DF #x95E0 #x95E1 #x95E2
- #x95E3 #x95E4 #x95E5 #x95E6 #x95E7 #x95EC #x95FF #x9607 #x9613 #x9618
- #x961B #x961E #x9620 #x9623 #x9624 #x9625 #x9626 #x9627 #x9628 #x9629
- #x962B #x962C #x962D #x962F #x9630 #x9637 #x9638 #x9639 #x963A #x963E
- #x9641 #x9643 #x964A #x964E #x964F #x9651 #x9652 #x9653 #x9656 #x9657
- #x9658 #x9659 #x965A #x965C #x965D #x965E #x9660 #x9663 #x9665 #x9666
- #x966B #x966D #x966E #x966F #x9670 #x9671 #x9673 #x9678 #x9679 #x967A
- #x967B #x967C #x967D #x967E #x967F #x9680 #x9681 #x9682 #x9683 #x9684
- #x9687 #x9689 #x968A #x968C #x968E #x9691 #x9692 #x9693 #x9695 #x9696
- #x969A #x969B #x969D #x969E #x969F #x96A0 #x96A1 #x96A2 #x96A3 #x96A4
- #x96A5 #x96A6 #x96A8 #x96A9 #x96AA #x96AB #x96AC #x96AD #x96AE #x96AF
- #x96B1 #x96B2 #x96B4 #x96B5 #x96B7 #x96B8 #x96BA #x96BB #x96BF #x96C2
- #x96C3 #x96C8 #x96CA #x96CB #x96D0 #x96D1 #x96D3 #x96D4 #x96D6 #x96D7
- #x96D8 #x96D9 #x96DA #x96DB #x96DC #x96DD #x96DE #x96DF #x96E1 #x96E2
- #x96E3 #x96E4 #x96E5 #x96E6 #x96E7 #x96EB #x96EC #x96ED #x96EE #x96F0
- #x96F1 #x96F2 #x96F4 #x96F5 #x96F8 #x96FA #x96FB #x96FC #x96FD #x96FF
- #x9702 #x9703 #x9705 #x970A #x970B #x970C #x9710 #x9711 #x9712 #x9714
- #x9715 #x9717 #x9718 #x9719 #x971A #x971B #x971D #x971F #x9720 #x9721
- #x9722 #x9723 #x9724 #x9725 #x9726 #x9727 #x9728 #x9729 #x972B #x972C
- #x972E #x972F #x9731 #x9733 #x9734 #x9735 #x9736 #x9737 #x973A #x973B
- #x973C #x973D #x973F #x9740 #x9741 #x9742 #x9743 #x9744 #x9745 #x9746
- #x9747 #x9748 #x9749 #x974A #x974B #x974C #x974D #x974E #x974F #x9750
- #x9751 #x9754 #x9755 #x9757 #x9758 #x975A #x975C #x975D #x975F #x9763
- #x9764 #x9766 #x9767 #x9768 #x976A #x976B #x976C #x976D #x976E #x976F
- #x9770 #x9771 #x9772 #x9775 #x9777 #x9778 #x9779 #x977A #x977B #x977D
- #x977E #x977F #x9780 #x9781 #x9782 #x9783 #x9784 #x9786 #x9787 #x9788
- #x9789 #x978A #x978C #x978E #x978F #x9790 #x9793 #x9795 #x9796 #x9797
- #x9799 #x979A #x979B #x979C #x979D #x979E #x979F #x97A1 #x97A2 #x97A4
- #x97A5 #x97A6 #x97A7 #x97A8 #x97A9 #x97AA #x97AC #x97AE #x97B0 #x97B1
- #x97B3 #x97B5 #x97B6 #x97B7 #x97B8 #x97B9 #x97BA #x97BB #x97BC #x97BD
- #x97BE #x97BF #x97C0 #x97C1 #x97C2 #x97C3 #x97C4 #x97C5 #x97C6 #x97C7
- #x97C8 #x97C9 #x97CA #x97CB #x97CC #x97CD #x97CE #x97CF #x97D0 #x97D1
- #x97D2 #x97D3 #x97D4 #x97D5 #x97D6 #x97D7 #x97D8 #x97D9 #x97DA #x97DB
- #x97DC #x97DD #x97DE #x97DF #x97E0 #x97E1 #x97E2 #x97E3 #x97E4 #x97E5
- #x97E8 #x97EE #x97EF #x97F0 #x97F1 #x97F2 #x97F4 #x97F7 #x97F8 #x97F9
- #x97FA #x97FB #x97FC #x97FD #x97FE #x97FF #x9800 #x9801 #x9802 #x9803
- #x9804 #x9805 #x9806 #x9807 #x9808 #x9809 #x980A #x980B #x980C #x980D
- #x980E #x980F #x9810 #x9811 #x9812 #x9813 #x9814 #x9815 #x9816 #x9817
- #x9818 #x9819 #x981A #x981B #x981C #x981D #x981E #x981F #x9820 #x9821
- #x9822 #x9823 #x9824 #x9825 #x9826 #x9827 #x9828 #x9829 #x982A #x982B
- #x982C #x982D #x982E #x982F #x9830 #x9831 #x9832 #x9833 #x9834 #x9835
- #x9836 #x9837 #x9838 #x9839 #x983A #x983B #x983C #x983D #x983E #x983F
- #x9840 #x9841 #x9842 #x9843 #x9844 #x9845 #x9846 #x9847 #x9848 #x9849
- #x984A #x984B #x984C #x984D #x984E #x984F #x9850 #x9851 #x9852 #x9853
- #x9854 #x9855 #x9856 #x9857 #x9858 #x9859 #x985A #x985B #x985C #x985D
- #x985E #x985F #x9860 #x9861 #x9862 #x9863 #x9864 #x9865 #x9866 #x9867
- #x9868 #x9869 #x986A #x986B #x986C #x986D #x986E #x986F #x9870 #x9871
- #x9872 #x9873 #x9874 #x988B #x988E #x9892 #x9895 #x9899 #x98A3 #x98A8
- #x98A9 #x98AA #x98AB #x98AC #x98AD #x98AE #x98AF #x98B0 #x98B1 #x98B2
- #x98B3 #x98B4 #x98B5 #x98B6 #x98B7 #x98B8 #x98B9 #x98BA #x98BB #x98BC
- #x98BD #x98BE #x98BF #x98C0 #x98C1 #x98C2 #x98C3 #x98C4 #x98C5 #x98C6
- #x98C7 #x98C8 #x98C9 #x98CA #x98CB #x98CC #x98CD #x98CF #x98D0 #x98D4
- #x98D6 #x98D7 #x98DB #x98DC #x98DD #x98E0 #x98E1 #x98E2 #x98E3 #x98E4
- #x98E5 #x98E6 #x98E9 #x98EA #x98EB #x98EC #x98ED #x98EE #x98EF #x98F0
- #x98F1 #x98F2 #x98F3 #x98F4 #x98F5 #x98F6 #x98F7 #x98F8 #x98F9 #x98FA
- #x98FB #x98FC #x98FD #x98FE #x98FF #x9900 #x9901 #x9902 #x9903 #x9904
- #x9905 #x9906 #x9907 #x9908 #x9909 #x990A #x990B #x990C #x990E #x990F
- #x9911 #x9912 #x9913 #x9914 #x9915 #x9916 #x9917 #x9918 #x9919 #x991A
- #x991B #x991C #x991D #x991E #x991F #x9920 #x9921 #x9922 #x9923 #x9924
- #x9925 #x9926 #x9927 #x9928 #x9929 #x992A #x992B #x992C #x992D #x992F
- #x9930 #x9931 #x9932 #x9933 #x9934 #x9935 #x9936 #x9937 #x9938 #x9939
- #x993A #x993B #x993C #x993D #x993E #x993F #x9940 #x9941 #x9942 #x9943
- #x9944 #x9945 #x9946 #x9947 #x9948 #x9949 #x994A #x994B #x994C #x994D
- #x994E #x994F #x9950 #x9951 #x9952 #x9953 #x9956 #x9957 #x9958 #x9959
- #x995A #x995B #x995C #x995D #x995E #x995F #x9960 #x9961 #x9962 #x9964
- #x9966 #x9973 #x9978 #x9979 #x997B #x997E #x9982 #x9983 #x9989 #x998C
- #x998E #x999A #x999B #x999C #x999D #x999E #x999F #x99A0 #x99A1 #x99A2
- #x99A3 #x99A4 #x99A6 #x99A7 #x99A9 #x99AA #x99AB #x99AC #x99AD #x99AE
- #x99AF #x99B0 #x99B1 #x99B2 #x99B3 #x99B4 #x99B5 #x99B6 #x99B7 #x99B8
- #x99B9 #x99BA #x99BB #x99BC #x99BD #x99BE #x99BF #x99C0 #x99C1 #x99C2
- #x99C3 #x99C4 #x99C5 #x99C6 #x99C7 #x99C8 #x99C9 #x99CA #x99CB #x99CC
- #x99CD #x99CE #x99CF #x99D0 #x99D1 #x99D2 #x99D3 #x99D4 #x99D5 #x99D6
- #x99D7 #x99D8 #x99D9 #x99DA #x99DB #x99DC #x99DD #x99DE #x99DF #x99E0
- #x99E1 #x99E2 #x99E3 #x99E4 #x99E5 #x99E6 #x99E7 #x99E8 #x99E9 #x99EA
- #x99EB #x99EC #x99ED #x99EE #x99EF #x99F0 #x99F1 #x99F2 #x99F3 #x99F4
- #x99F5 #x99F6 #x99F7 #x99F8 #x99F9 #x99FA #x99FB #x99FC #x99FD #x99FE
- #x99FF #x9A00 #x9A01 #x9A02 #x9A03 #x9A04 #x9A05 #x9A06 #x9A07 #x9A08
- #x9A09 #x9A0A #x9A0B #x9A0C #x9A0D #x9A0E #x9A0F #x9A10 #x9A11 #x9A12
- #x9A13 #x9A14 #x9A15 #x9A16 #x9A17 #x9A18 #x9A19 #x9A1A #x9A1B #x9A1C
- #x9A1D #x9A1E #x9A1F #x9A20 #x9A21 #x9A22 #x9A23 #x9A24 #x9A25 #x9A26
- #x9A27 #x9A28 #x9A29 #x9A2A #x9A2B #x9A2C #x9A2D #x9A2E #x9A2F #x9A30
- #x9A31 #x9A32 #x9A33 #x9A34 #x9A35 #x9A36 #x9A37 #x9A38 #x9A39 #x9A3A
- #x9A3B #x9A3C #x9A3D #x9A3E #x9A3F #x9A40 #x9A41 #x9A42 #x9A43 #x9A44
- #x9A45 #x9A46 #x9A47 #x9A48 #x9A49 #x9A4A #x9A4B #x9A4C #x9A4D #x9A4E
- #x9A4F #x9A50 #x9A51 #x9A52 #x9A53 #x9A54 #x9A55 #x9A56 #x9A57 #x9A58
- #x9A59 #x9A5A #x9A5B #x9A5C #x9A5D #x9A5E #x9A5F #x9A60 #x9A61 #x9A62
- #x9A63 #x9A64 #x9A65 #x9A66 #x9A67 #x9A68 #x9A69 #x9A6A #x9A6B #x9A72
- #x9A83 #x9A89 #x9A8D #x9A8E #x9A94 #x9A95 #x9A99 #x9AA6 #x9AA9 #x9AAA
- #x9AAB #x9AAC #x9AAD #x9AAE #x9AAF #x9AB2 #x9AB3 #x9AB4 #x9AB5 #x9AB9
- #x9ABB #x9ABD #x9ABE #x9ABF #x9AC3 #x9AC4 #x9AC6 #x9AC7 #x9AC8 #x9AC9
- #x9ACA #x9ACD #x9ACE #x9ACF #x9AD0 #x9AD2 #x9AD4 #x9AD5 #x9AD6 #x9AD7
- #x9AD9 #x9ADA #x9ADB #x9ADC #x9ADD #x9ADE #x9AE0 #x9AE2 #x9AE3 #x9AE4
- #x9AE5 #x9AE7 #x9AE8 #x9AE9 #x9AEA #x9AEC #x9AEE #x9AF0 #x9AF1 #x9AF2
- #x9AF3 #x9AF4 #x9AF5 #x9AF6 #x9AF7 #x9AF8 #x9AFA #x9AFC #x9AFD #x9AFE
- #x9AFF #x9B00 #x9B01 #x9B02 #x9B04 #x9B05 #x9B06 #x9B07 #x9B09 #x9B0A
- #x9B0B #x9B0C #x9B0D #x9B0E #x9B10 #x9B11 #x9B12 #x9B14 #x9B15 #x9B16
- #x9B17 #x9B18 #x9B19 #x9B1A #x9B1B #x9B1C #x9B1D #x9B1E #x9B20 #x9B21
- #x9B22 #x9B24 #x9B25 #x9B26 #x9B27 #x9B28 #x9B29 #x9B2A #x9B2B #x9B2C
- #x9B2D #x9B2E #x9B30 #x9B31 #x9B33 #x9B34 #x9B35 #x9B36 #x9B37 #x9B38
- #x9B39 #x9B3A #x9B3D #x9B3E #x9B3F #x9B40 #x9B46 #x9B4A #x9B4B #x9B4C
- #x9B4E #x9B50 #x9B52 #x9B53 #x9B55 #x9B56 #x9B57 #x9B58 #x9B59 #x9B5A
- #x9B5B #x9B5C #x9B5D #x9B5E #x9B5F #x9B60 #x9B61 #x9B62 #x9B63 #x9B64
- #x9B65 #x9B66 #x9B67 #x9B68 #x9B69 #x9B6A #x9B6B #x9B6C #x9B6D #x9B6E
- #x9B6F #x9B70 #x9B71 #x9B72 #x9B73 #x9B74 #x9B75 #x9B76 #x9B77 #x9B78
- #x9B79 #x9B7A #x9B7B #x9B7C #x9B7D #x9B7E #x9B7F #x9B80 #x9B81 #x9B82
- #x9B83 #x9B84 #x9B85 #x9B86 #x9B87 #x9B88 #x9B89 #x9B8A #x9B8B #x9B8C
- #x9B8D #x9B8E #x9B8F #x9B90 #x9B91 #x9B92 #x9B93 #x9B94 #x9B95 #x9B96
- #x9B97 #x9B98 #x9B99 #x9B9A #x9B9B #x9B9C #x9B9D #x9B9E #x9B9F #x9BA0
- #x9BA1 #x9BA2 #x9BA3 #x9BA4 #x9BA5 #x9BA6 #x9BA7 #x9BA8 #x9BA9 #x9BAA
- #x9BAB #x9BAC #x9BAD #x9BAE #x9BAF #x9BB0 #x9BB1 #x9BB2 #x9BB3 #x9BB4
- #x9BB5 #x9BB6 #x9BB7 #x9BB8 #x9BB9 #x9BBA #x9BBB #x9BBC #x9BBD #x9BBE
- #x9BBF #x9BC0 #x9BC1 #x9BC2 #x9BC3 #x9BC4 #x9BC5 #x9BC6 #x9BC7 #x9BC8
- #x9BC9 #x9BCA #x9BCB #x9BCC #x9BCD #x9BCE #x9BCF #x9BD0 #x9BD1 #x9BD2
- #x9BD3 #x9BD4 #x9BD5 #x9BD6 #x9BD7 #x9BD8 #x9BD9 #x9BDA #x9BDB #x9BDC
- #x9BDD #x9BDE #x9BDF #x9BE0 #x9BE1 #x9BE2 #x9BE3 #x9BE4 #x9BE5 #x9BE6
- #x9BE7 #x9BE8 #x9BE9 #x9BEA #x9BEB #x9BEC #x9BED #x9BEE #x9BEF #x9BF0
- #x9BF1 #x9BF2 #x9BF3 #x9BF4 #x9BF5 #x9BF6 #x9BF7 #x9BF8 #x9BF9 #x9BFA
- #x9BFB #x9BFC #x9BFD #x9BFE #x9BFF #x9C00 #x9C01 #x9C02 #x9C03 #x9C04
- #x9C05 #x9C06 #x9C07 #x9C08 #x9C09 #x9C0A #x9C0B #x9C0C #x9C0D #x9C0E
- #x9C0F #x9C10 #x9C11 #x9C12 #x9C13 #x9C14 #x9C15 #x9C16 #x9C17 #x9C18
- #x9C19 #x9C1A #x9C1B #x9C1C #x9C1D #x9C1E #x9C1F #x9C20 #x9C21 #x9C22
- #x9C23 #x9C24 #x9C25 #x9C26 #x9C27 #x9C28 #x9C29 #x9C2A #x9C2B #x9C2C
- #x9C2D #x9C2E #x9C2F #x9C30 #x9C31 #x9C32 #x9C33 #x9C34 #x9C35 #x9C36
- #x9C37 #x9C38 #x9C39 #x9C3A #x9C3B #x9C3C #x9C3D #x9C3E #x9C3F #x9C40
- #x9C41 #x9C42 #x9C43 #x9C44 #x9C45 #x9C46 #x9C47 #x9C48 #x9C49 #x9C4A
- #x9C4B #x9C4C #x9C4D #x9C4E #x9C4F #x9C50 #x9C51 #x9C52 #x9C53 #x9C54
- #x9C55 #x9C56 #x9C57 #x9C58 #x9C59 #x9C5A #x9C5B #x9C5C #x9C5D #x9C5E
- #x9C5F #x9C60 #x9C61 #x9C62 #x9C63 #x9C64 #x9C65 #x9C66 #x9C67 #x9C68
- #x9C69 #x9C6A #x9C6B #x9C6C #x9C6D #x9C6E #x9C6F #x9C70 #x9C71 #x9C72
- #x9C73 #x9C74 #x9C75 #x9C76 #x9C77 #x9C78 #x9C79 #x9C7A #x9C7B #x9C7D
- #x9C7E #x9C80 #x9C83 #x9C84 #x9C89 #x9C8A #x9C8C #x9C8F #x9C93 #x9C96
- #x9C97 #x9C98 #x9C99 #x9C9D #x9CAA #x9CAC #x9CAF #x9CB9 #x9CBE #x9CBF
- #x9CC0 #x9CC1 #x9CC2 #x9CC8 #x9CC9 #x9CD1 #x9CD2 #x9CDA #x9CDB #x9CE0
- #x9CE1 #x9CE3 #x9CE4 #x9CE5 #x9CE6 #x9CE7 #x9CE8 #x9CE9 #x9CEA #x9CEB
- #x9CEC #x9CED #x9CEE #x9CEF #x9CF0 #x9CF1 #x9CF2 #x9CF3 #x9CF4 #x9CF5
- #x9CF6 #x9CF7 #x9CF8 #x9CF9 #x9CFA #x9CFB #x9CFC #x9CFD #x9CFE #x9CFF
- #x9D00 #x9D01 #x9D02 #x9D03 #x9D04 #x9D05 #x9D06 #x9D07 #x9D08 #x9D09
- #x9D0A #x9D0B #x9D0C #x9D0D #x9D0E #x9D0F #x9D10 #x9D11 #x9D12 #x9D13
- #x9D14 #x9D15 #x9D16 #x9D17 #x9D18 #x9D19 #x9D1A #x9D1B #x9D1C #x9D1D
- #x9D1E #x9D1F #x9D20 #x9D21 #x9D22 #x9D23 #x9D24 #x9D25 #x9D26 #x9D27
- #x9D28 #x9D29 #x9D2A #x9D2B #x9D2C #x9D2D #x9D2E #x9D2F #x9D30 #x9D31
- #x9D32 #x9D33 #x9D34 #x9D35 #x9D36 #x9D37 #x9D38 #x9D39 #x9D3A #x9D3B
- #x9D3C #x9D3D #x9D3E #x9D3F #x9D40 #x9D41 #x9D42 #x9D43 #x9D44 #x9D45
- #x9D46 #x9D47 #x9D48 #x9D49 #x9D4A #x9D4B #x9D4C #x9D4D #x9D4E #x9D4F
- #x9D50 #x9D51 #x9D52 #x9D53 #x9D54 #x9D55 #x9D56 #x9D57 #x9D58 #x9D59
- #x9D5A #x9D5B #x9D5C #x9D5D #x9D5E #x9D5F #x9D60 #x9D61 #x9D62 #x9D63
- #x9D64 #x9D65 #x9D66 #x9D67 #x9D68 #x9D69 #x9D6A #x9D6B #x9D6C #x9D6D
- #x9D6E #x9D6F #x9D70 #x9D71 #x9D72 #x9D73 #x9D74 #x9D75 #x9D76 #x9D77
- #x9D78 #x9D79 #x9D7A #x9D7B #x9D7C #x9D7D #x9D7E #x9D7F #x9D80 #x9D81
- #x9D82 #x9D83 #x9D84 #x9D85 #x9D86 #x9D87 #x9D88 #x9D89 #x9D8A #x9D8B
- #x9D8C #x9D8D #x9D8E #x9D8F #x9D90 #x9D91 #x9D92 #x9D93 #x9D94 #x9D95
- #x9D96 #x9D97 #x9D98 #x9D99 #x9D9A #x9D9B #x9D9C #x9D9D #x9D9E #x9D9F
- #x9DA0 #x9DA1 #x9DA2 #x9DA3 #x9DA4 #x9DA5 #x9DA6 #x9DA7 #x9DA8 #x9DA9
- #x9DAA #x9DAB #x9DAC #x9DAD #x9DAE #x9DAF #x9DB0 #x9DB1 #x9DB2 #x9DB3
- #x9DB4 #x9DB5 #x9DB6 #x9DB7 #x9DB8 #x9DB9 #x9DBA #x9DBB #x9DBC #x9DBD
- #x9DBE #x9DBF #x9DC0 #x9DC1 #x9DC2 #x9DC3 #x9DC4 #x9DC5 #x9DC6 #x9DC7
- #x9DC8 #x9DC9 #x9DCA #x9DCB #x9DCC #x9DCD #x9DCE #x9DCF #x9DD0 #x9DD1
- #x9DD2 #x9DD3 #x9DD4 #x9DD5 #x9DD6 #x9DD7 #x9DD8 #x9DD9 #x9DDA #x9DDB
- #x9DDC #x9DDD #x9DDE #x9DDF #x9DE0 #x9DE1 #x9DE2 #x9DE3 #x9DE4 #x9DE5
- #x9DE6 #x9DE7 #x9DE8 #x9DE9 #x9DEA #x9DEB #x9DEC #x9DED #x9DEE #x9DEF
- #x9DF0 #x9DF1 #x9DF2 #x9DF3 #x9DF4 #x9DF5 #x9DF6 #x9DF7 #x9DF8 #x9DF9
- #x9DFA #x9DFB #x9DFC #x9DFD #x9DFE #x9DFF #x9E00 #x9E01 #x9E02 #x9E03
- #x9E04 #x9E05 #x9E06 #x9E07 #x9E08 #x9E09 #x9E0A #x9E0B #x9E0C #x9E0D
- #x9E0E #x9E0F #x9E10 #x9E11 #x9E12 #x9E13 #x9E14 #x9E15 #x9E16 #x9E17
- #x9E18 #x9E19 #x9E1A #x9E1B #x9E1C #x9E1D #x9E1E #x9E24 #x9E27 #x9E2E
- #x9E30 #x9E34 #x9E3B #x9E3C #x9E40 #x9E4D #x9E50 #x9E52 #x9E53 #x9E54
- #x9E56 #x9E59 #x9E5D #x9E5F #x9E60 #x9E61 #x9E62 #x9E65 #x9E6E #x9E6F
- #x9E72 #x9E74 #x9E75 #x9E76 #x9E77 #x9E78 #x9E79 #x9E7A #x9E7B #x9E7C
- #x9E7D #x9E80 #x9E81 #x9E83 #x9E84 #x9E85 #x9E86 #x9E89 #x9E8A #x9E8C
- #x9E8D #x9E8E #x9E8F #x9E90 #x9E91 #x9E94 #x9E95 #x9E96 #x9E97 #x9E98
- #x9E99 #x9E9A #x9E9B #x9E9C #x9E9E #x9EA0 #x9EA1 #x9EA2 #x9EA3 #x9EA4
- #x9EA5 #x9EA7 #x9EA8 #x9EA9 #x9EAA #x9EAB #x9EAC #x9EAD #x9EAE #x9EAF
- #x9EB0 #x9EB1 #x9EB2 #x9EB3 #x9EB5 #x9EB6 #x9EB7 #x9EB9 #x9EBA #x9EBC
- #x9EBF #x9EC0 #x9EC1 #x9EC2 #x9EC3 #x9EC5 #x9EC6 #x9EC7 #x9EC8 #x9ECA
- #x9ECB #x9ECC #x9ED0 #x9ED2 #x9ED3 #x9ED5 #x9ED6 #x9ED7 #x9ED9 #x9EDA
- #x9EDE #x9EE1 #x9EE3 #x9EE4 #x9EE6 #x9EE8 #x9EEB #x9EEC #x9EED #x9EEE
- #x9EF0 #x9EF1 #x9EF2 #x9EF3 #x9EF4 #x9EF5 #x9EF6 #x9EF7 #x9EF8 #x9EFA
- #x9EFD #x9EFF #x9F00 #x9F01 #x9F02 #x9F03 #x9F04 #x9F05 #x9F06 #x9F07
- #x9F08 #x9F09 #x9F0A #x9F0C #x9F0F #x9F11 #x9F12 #x9F14 #x9F15 #x9F16
- #x9F18 #x9F1A #x9F1B #x9F1C #x9F1D #x9F1E #x9F1F #x9F21 #x9F23 #x9F24
- #x9F25 #x9F26 #x9F27 #x9F28 #x9F29 #x9F2A #x9F2B #x9F2D #x9F2E #x9F30
- #x9F31 #x9F32 #x9F33 #x9F34 #x9F35 #x9F36 #x9F38 #x9F3A #x9F3C #x9F3F
- #x9F40 #x9F41 #x9F42 #x9F43 #x9F45 #x9F46 #x9F47 #x9F48 #x9F49 #x9F4A
- #x9F4B #x9F4C #x9F4D #x9F4E #x9F4F #x9F52 #x9F53 #x9F54 #x9F55 #x9F56
- #x9F57 #x9F58 #x9F59 #x9F5A #x9F5B #x9F5C #x9F5D #x9F5E #x9F5F #x9F60
- #x9F61 #x9F62 #x9F63 #x9F64 #x9F65 #x9F66 #x9F67 #x9F68 #x9F69 #x9F6A
- #x9F6B #x9F6C #x9F6D #x9F6E #x9F6F #x9F70 #x9F71 #x9F72 #x9F73 #x9F74
- #x9F75 #x9F76 #x9F77 #x9F78 #x9F79 #x9F7A #x9F7B #x9F7C #x9F7D #x9F7E
- #x9F81 #x9F82 #x9F8D #x9F8E #x9F8F #x9F90 #x9F91 #x9F92 #x9F93 #x9F94
- #x9F95 #x9F96 #x9F97 #x9F98 #x9F9C #x9F9D #x9F9E #x9FA1 #x9FA2 #x9FA3
- #x9FA4 #x9FA5 #x3000 #x3001 #x3002 #x00B7 #x02C9 #x02C7 #x00A8 #x3003
- #x3005 #x2014 #xFF5E #x2016 #x2026 #x2018 #x2019 #x201C #x201D #x3014
- #x3015 #x3008 #x3009 #x300A #x300B #x300C #x300D #x300E #x300F #x3016
- #x3017 #x3010 #x3011 #x00B1 #x00D7 #x00F7 #x2236 #x2227 #x2228 #x2211
- #x220F #x222A #x2229 #x2208 #x2237 #x221A #x22A5 #x2225 #x2220 #x2312
- #x2299 #x222B #x222E #x2261 #x224C #x2248 #x223D #x221D #x2260 #x226E
- #x226F #x2264 #x2265 #x221E #x2235 #x2234 #x2642 #x2640 #x00B0 #x2032
- #x2033 #x2103 #xFF04 #x00A4 #xFFE0 #xFFE1 #x2030 #x00A7 #x2116 #x2606
- #x2605 #x25CB #x25CF #x25CE #x25C7 #x25C6 #x25A1 #x25A0 #x25B3 #x25B2
- #x203B #x2192 #x2190 #x2191 #x2193 #x3013 #x2170 #x2171 #x2172 #x2173
- #x2174 #x2175 #x2176 #x2177 #x2178 #x2179 #xE766 #xE767 #xE768 #xE769
- #xE76A #xE76B #x2488 #x2489 #x248A #x248B #x248C #x248D #x248E #x248F
- #x2490 #x2491 #x2492 #x2493 #x2494 #x2495 #x2496 #x2497 #x2498 #x2499
- #x249A #x249B #x2474 #x2475 #x2476 #x2477 #x2478 #x2479 #x247A #x247B
- #x247C #x247D #x247E #x247F #x2480 #x2481 #x2482 #x2483 #x2484 #x2485
- #x2486 #x2487 #x2460 #x2461 #x2462 #x2463 #x2464 #x2465 #x2466 #x2467
- #x2468 #x2469 #xE76C #xE76D #x3220 #x3221 #x3222 #x3223 #x3224 #x3225
- #x3226 #x3227 #x3228 #x3229 #xE76E #xE76F #x2160 #x2161 #x2162 #x2163
- #x2164 #x2165 #x2166 #x2167 #x2168 #x2169 #x216A #x216B #xE770 #xE771
- #xFF01 #xFF02 #xFF03 #xFFE5 #xFF05 #xFF06 #xFF07 #xFF08 #xFF09 #xFF0A
- #xFF0B #xFF0C #xFF0D #xFF0E #xFF0F #xFF10 #xFF11 #xFF12 #xFF13 #xFF14
- #xFF15 #xFF16 #xFF17 #xFF18 #xFF19 #xFF1A #xFF1B #xFF1C #xFF1D #xFF1E
- #xFF1F #xFF20 #xFF21 #xFF22 #xFF23 #xFF24 #xFF25 #xFF26 #xFF27 #xFF28
- #xFF29 #xFF2A #xFF2B #xFF2C #xFF2D #xFF2E #xFF2F #xFF30 #xFF31 #xFF32
- #xFF33 #xFF34 #xFF35 #xFF36 #xFF37 #xFF38 #xFF39 #xFF3A #xFF3B #xFF3C
- #xFF3D #xFF3E #xFF3F #xFF40 #xFF41 #xFF42 #xFF43 #xFF44 #xFF45 #xFF46
- #xFF47 #xFF48 #xFF49 #xFF4A #xFF4B #xFF4C #xFF4D #xFF4E #xFF4F #xFF50
- #xFF51 #xFF52 #xFF53 #xFF54 #xFF55 #xFF56 #xFF57 #xFF58 #xFF59 #xFF5A
- #xFF5B #xFF5C #xFF5D #xFFE3 #x3041 #x3042 #x3043 #x3044 #x3045 #x3046
- #x3047 #x3048 #x3049 #x304A #x304B #x304C #x304D #x304E #x304F #x3050
- #x3051 #x3052 #x3053 #x3054 #x3055 #x3056 #x3057 #x3058 #x3059 #x305A
- #x305B #x305C #x305D #x305E #x305F #x3060 #x3061 #x3062 #x3063 #x3064
- #x3065 #x3066 #x3067 #x3068 #x3069 #x306A #x306B #x306C #x306D #x306E
- #x306F #x3070 #x3071 #x3072 #x3073 #x3074 #x3075 #x3076 #x3077 #x3078
- #x3079 #x307A #x307B #x307C #x307D #x307E #x307F #x3080 #x3081 #x3082
- #x3083 #x3084 #x3085 #x3086 #x3087 #x3088 #x3089 #x308A #x308B #x308C
- #x308D #x308E #x308F #x3090 #x3091 #x3092 #x3093 #xE772 #xE773 #xE774
- #xE775 #xE776 #xE777 #xE778 #xE779 #xE77A #xE77B #xE77C #x30A1 #x30A2
- #x30A3 #x30A4 #x30A5 #x30A6 #x30A7 #x30A8 #x30A9 #x30AA #x30AB #x30AC
- #x30AD #x30AE #x30AF #x30B0 #x30B1 #x30B2 #x30B3 #x30B4 #x30B5 #x30B6
- #x30B7 #x30B8 #x30B9 #x30BA #x30BB #x30BC #x30BD #x30BE #x30BF #x30C0
- #x30C1 #x30C2 #x30C3 #x30C4 #x30C5 #x30C6 #x30C7 #x30C8 #x30C9 #x30CA
- #x30CB #x30CC #x30CD #x30CE #x30CF #x30D0 #x30D1 #x30D2 #x30D3 #x30D4
- #x30D5 #x30D6 #x30D7 #x30D8 #x30D9 #x30DA #x30DB #x30DC #x30DD #x30DE
- #x30DF #x30E0 #x30E1 #x30E2 #x30E3 #x30E4 #x30E5 #x30E6 #x30E7 #x30E8
- #x30E9 #x30EA #x30EB #x30EC #x30ED #x30EE #x30EF #x30F0 #x30F1 #x30F2
- #x30F3 #x30F4 #x30F5 #x30F6 #xE77D #xE77E #xE77F #xE780 #xE781 #xE782
- #xE783 #xE784 #x0391 #x0392 #x0393 #x0394 #x0395 #x0396 #x0397 #x0398
- #x0399 #x039A #x039B #x039C #x039D #x039E #x039F #x03A0 #x03A1 #x03A3
- #x03A4 #x03A5 #x03A6 #x03A7 #x03A8 #x03A9 #xE785 #xE786 #xE787 #xE788
- #xE789 #xE78A #xE78B #xE78C #x03B1 #x03B2 #x03B3 #x03B4 #x03B5 #x03B6
- #x03B7 #x03B8 #x03B9 #x03BA #x03BB #x03BC #x03BD #x03BE #x03BF #x03C0
- #x03C1 #x03C3 #x03C4 #x03C5 #x03C6 #x03C7 #x03C8 #x03C9 #xE78D #xE78E
- #xE78F #xE790 #xE791 #xE792 #xE793 #xFE35 #xFE36 #xFE39 #xFE3A #xFE3F
- #xFE40 #xFE3D #xFE3E #xFE41 #xFE42 #xFE43 #xFE44 #xE794 #xE795 #xFE3B
- #xFE3C #xFE37 #xFE38 #xFE31 #xE796 #xFE33 #xFE34 #xE797 #xE798 #xE799
- #xE79A #xE79B #xE79C #xE79D #xE79E #xE79F #x0410 #x0411 #x0412 #x0413
- #x0414 #x0415 #x0401 #x0416 #x0417 #x0418 #x0419 #x041A #x041B #x041C
- #x041D #x041E #x041F #x0420 #x0421 #x0422 #x0423 #x0424 #x0425 #x0426
- #x0427 #x0428 #x0429 #x042A #x042B #x042C #x042D #x042E #x042F #xE7A0
- #xE7A1 #xE7A2 #xE7A3 #xE7A4 #xE7A5 #xE7A6 #xE7A7 #xE7A8 #xE7A9 #xE7AA
- #xE7AB #xE7AC #xE7AD #xE7AE #x0430 #x0431 #x0432 #x0433 #x0434 #x0435
- #x0451 #x0436 #x0437 #x0438 #x0439 #x043A #x043B #x043C #x043D #x043E
- #x043F #x0440 #x0441 #x0442 #x0443 #x0444 #x0445 #x0446 #x0447 #x0448
- #x0449 #x044A #x044B #x044C #x044D #x044E #x044F #xE7AF #xE7B0 #xE7B1
- #xE7B2 #xE7B3 #xE7B4 #xE7B5 #xE7B6 #xE7B7 #xE7B8 #xE7B9 #xE7BA #xE7BB
- #x0101 #x00E1 #x01CE #x00E0 #x0113 #x00E9 #x011B #x00E8 #x012B #x00ED
- #x01D0 #x00EC #x014D #x00F3 #x01D2 #x00F2 #x016B #x00FA #x01D4 #x00F9
- #x01D6 #x01D8 #x01DA #x01DC #x00FC #x00EA #x0251 #xE7C7 #x0144 #x0148
- #xE7C8 #x0261 #xE7C9 #xE7CA #xE7CB #xE7CC #x3105 #x3106 #x3107 #x3108
- #x3109 #x310A #x310B #x310C #x310D #x310E #x310F #x3110 #x3111 #x3112
- #x3113 #x3114 #x3115 #x3116 #x3117 #x3118 #x3119 #x311A #x311B #x311C
- #x311D #x311E #x311F #x3120 #x3121 #x3122 #x3123 #x3124 #x3125 #x3126
- #x3127 #x3128 #x3129 #xE7CD #xE7CE #xE7CF #xE7D0 #xE7D1 #xE7D2 #xE7D3
- #xE7D4 #xE7D5 #xE7D6 #xE7D7 #xE7D8 #xE7D9 #xE7DA #xE7DB #xE7DC #xE7DD
- #xE7DE #xE7DF #xE7E0 #xE7E1 #xE7FE #xE7FF #xE800 #x2500 #x2501 #x2502
- #x2503 #x2504 #x2505 #x2506 #x2507 #x2508 #x2509 #x250A #x250B #x250C
- #x250D #x250E #x250F #x2510 #x2511 #x2512 #x2513 #x2514 #x2515 #x2516
- #x2517 #x2518 #x2519 #x251A #x251B #x251C #x251D #x251E #x251F #x2520
- #x2521 #x2522 #x2523 #x2524 #x2525 #x2526 #x2527 #x2528 #x2529 #x252A
- #x252B #x252C #x252D #x252E #x252F #x2530 #x2531 #x2532 #x2533 #x2534
- #x2535 #x2536 #x2537 #x2538 #x2539 #x253A #x253B #x253C #x253D #x253E
- #x253F #x2540 #x2541 #x2542 #x2543 #x2544 #x2545 #x2546 #x2547 #x2548
- #x2549 #x254A #x254B #xE801 #xE802 #xE803 #xE804 #xE805 #xE806 #xE807
- #xE808 #xE809 #xE80A #xE80B #xE80C #xE80D #xE80E #xE80F #x02CA #x02CB
- #x02D9 #x2013 #x2015 #x2025 #x2035 #x2105 #x2109 #x2196 #x2197 #x2198
- #x2199 #x2215 #x221F #x2223 #x2252 #x2266 #x2267 #x22BF #x2550 #x2551
- #x2552 #x2553 #x2554 #x2555 #x2556 #x2557 #x2558 #x2559 #x255A #x255B
- #x255C #x255D #x255E #x255F #x2560 #x2561 #x2562 #x2563 #x2564 #x2565
- #x2566 #x2567 #x2568 #x2569 #x256A #x256B #x256C #x256D #x256E #x256F
- #x2570 #x2571 #x2572 #x2573 #x2581 #x2582 #x2583 #x2584 #x2585 #x2586
- #x2587 #x2588 #x2589 #x258A #x258B #x258C #x258D #x258E #x258F #x2593
- #x2594 #x2595 #x25BC #x25BD #x25E2 #x25E3 #x25E4 #x25E5 #x2609 #x2295
- #x3012 #x301D #x301E #xE7BC #xE7BD #xE7BE #xE7BF #xE7C0 #xE7C1 #xE7C2
- #xE7C3 #xE7C4 #xE7C5 #xE7C6 #x3021 #x3022 #x3023 #x3024 #x3025 #x3026
- #x3027 #x3028 #x3029 #x32A3 #x338E #x338F #x339C #x339D #x339E #x33A1
- #x33C4 #x33CE #x33D1 #x33D2 #x33D5 #xFE30 #xFFE2 #xFFE4 #xE7E2 #x2121
- #x3231 #xE7E3 #x2010 #xE7E4 #xE7E5 #xE7E6 #x30FC #x309B #x309C #x30FD
- #x30FE #x3006 #x309D #x309E #xFE49 #xFE4A #xFE4B #xFE4C #xFE4D #xFE4E
- #xFE4F #xFE50 #xFE51 #xFE52 #xFE54 #xFE55 #xFE56 #xFE57 #xFE59 #xFE5A
- #xFE5B #xFE5C #xFE5D #xFE5E #xFE5F #xFE60 #xFE61 #xFE62 #xFE63 #xFE64
- #xFE65 #xFE66 #xFE68 #xFE69 #xFE6A #xFE6B #xE7E7 #xE7E8 #xE7E9 #xE7EA
- #xE7EB #xE7EC #xE7ED #xE7EE #xE7EF #xE7F0 #xE7F1 #xE7F2 #xE7F3 #x3007
- #xE7F4 #xE7F5 #xE7F6 #xE7F7 #xE7F8 #xE7F9 #xE7FA #xE7FB #xE7FC #xE7FD
- #x0020)))
(DIR) diff --git a/3rdparties/software/babel-20171227-git/src/jpn-table.lisp b/3rdparties/software/babel-20171227-git/src/jpn-table.lisp
@@ -1,17637 +0,0 @@
-;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
-;;;
-;;; jpn-table.lisp --- Unicode tables for Japanese encodings.
-;;;
-
-(in-package #:babel-encodings)
-
-(defvar *cp932-only*
- '((#xFC4B #x9ED1)
- (#xFC4A #x9E19)
- (#xFC49 #xFA2D)
- (#xFC48 #x9D6B)
- (#xFC47 #x9D70)
- (#xFC46 #x9C00)
- (#xFC45 #x9BBB)
- (#xFC44 #x9BB1)
- (#xFC43 #x9B8F)
- (#xFC42 #x9B72)
- (#xFC41 #x9B75)
- (#xFC40 #x9ADC)
- (#xFBFC #x9AD9)
- (#xFBFB #x9A4E)
- (#xFBFA #x999E)
- (#xFBF9 #xFA2C)
- (#xFBF8 #x9927)
- (#xFBF7 #xFA2B)
- (#xFBF6 #xFA2A)
- (#xFBF5 #x9865)
- (#xFBF4 #x9857)
- (#xFBF3 #x9755)
- (#xFBF2 #x9751)
- (#xFBF1 #x974F)
- (#xFBF0 #x974D)
- (#xFBEF #x9743)
- (#xFBEE #x973B)
- (#xFBED #x9733)
- (#xFBEC #x96AF)
- (#xFBEB #x969D)
- (#xFBEA #xFA29)
- (#xFBE9 #xF9DC)
- (#xFBE8 #x9592)
- (#xFBE7 #x9448)
- (#xFBE6 #x9445)
- (#xFBE5 #x9431)
- (#xFBE4 #x93F8)
- (#xFBE3 #x93DE)
- (#xFBE2 #x93C6)
- (#xFBE1 #x93A4)
- (#xFBE0 #x9357)
- (#xFBDF #x9370)
- (#xFBDE #x9302)
- (#xFBDD #x931D)
- (#xFBDC #x92FF)
- (#xFBDB #x931E)
- (#xFBDA #xFA28)
- (#xFBD9 #x92FB)
- (#xFBD8 #x9321)
- (#xFBD7 #x9325)
- (#xFBD6 #x92D3)
- (#xFBD5 #x92E0)
- (#xFBD4 #x92D5)
- (#xFBD3 #xFA27)
- (#xFBD2 #x92D0)
- (#xFBD1 #x92D9)
- (#xFBD0 #x92D7)
- (#xFBCF #x92E7)
- (#xFBCE #x9278)
- (#xFBCD #x9277)
- (#xFBCC #x92A7)
- (#xFBCB #x9267)
- (#xFBCA #x9239)
- (#xFBC9 #x9251)
- (#xFBC8 #x9259)
- (#xFBC7 #x924E)
- (#xFBC6 #x923C)
- (#xFBC5 #x9240)
- (#xFBC4 #x923A)
- (#xFBC3 #x920A)
- (#xFBC2 #x9210)
- (#xFBC1 #x9206)
- (#xFBC0 #x91E5)
- (#xFBBF #x91E4)
- (#xFBBE #x91EE)
- (#xFBBD #x91ED)
- (#xFBBC #x91DE)
- (#xFBBB #x91D7)
- (#xFBBA #x91DA)
- (#xFBB9 #x9127)
- (#xFBB8 #x9115)
- (#xFBB7 #xFA26)
- (#xFBB6 #x90DE)
- (#xFBB5 #x9067)
- (#xFBB4 #xFA25)
- (#xFBB3 #xFA24)
- (#xFBB2 #x8ECF)
- (#xFBB1 #xFA23)
- (#xFBB0 #x8D76)
- (#xFBAF #x8D12)
- (#xFBAE #x8CF4)
- (#xFBAD #x8CF0)
- (#xFBAC #x8B7F)
- (#xFBAB #x8B53)
- (#xFBAA #x8AF6)
- (#xFBA9 #xFA22)
- (#xFBA8 #x8ADF)
- (#xFBA7 #x8ABE)
- (#xFBA6 #x8AA7)
- (#xFBA5 #x8A79)
- (#xFBA4 #x8A37)
- (#xFBA3 #x8A12)
- (#xFBA2 #x88F5)
- (#xFBA1 #x8807)
- (#xFBA0 #xFA21)
- (#xFB9F #xFA20)
- (#xFB9E #x85B0)
- (#xFB9D #xFA1F)
- (#xFB9C #x856B)
- (#xFB9B #x8559)
- (#xFB9A #x8553)
- (#xFB99 #x84B4)
- (#xFB98 #x8448)
- (#xFB97 #x83F6)
- (#xFB96 #x83C7)
- (#xFB95 #x837F)
- (#xFB94 #x8362)
- (#xFB93 #x8301)
- (#xFB92 #xFA1E)
- (#xFB91 #x7FA1)
- (#xFB90 #x7F47)
- (#xFB8F #x7E52)
- (#xFB8E #x7DD6)
- (#xFB8D #x7DA0)
- (#xFB8C #x7DB7)
- (#xFB8B #x7D5C)
- (#xFB8A #x7D48)
- (#xFB89 #xFA1D)
- (#xFB88 #x7B9E)
- (#xFB87 #x7AEB)
- (#xFB86 #xFA1C)
- (#xFB85 #x7AE7)
- (#xFB84 #x7AD1)
- (#xFB83 #x799B)
- (#xFB82 #xFA1B)
- (#xFB81 #x7994)
- (#xFB80 #xFA1A)
- (#xFB7E #xFA19)
- (#xFB7D #xFA18)
- (#xFB7C #x7930)
- (#xFB7B #x787A)
- (#xFB7A #x7864)
- (#xFB79 #x784E)
- (#xFB78 #x7821)
- (#xFB77 #x52AF)
- (#xFB76 #x7746)
- (#xFB75 #xFA17)
- (#xFB74 #x76A6)
- (#xFB73 #x769B)
- (#xFB72 #x769E)
- (#xFB71 #x769C)
- (#xFB70 #x7682)
- (#xFB6F #x756F)
- (#xFB6E #x7501)
- (#xFB6D #x749F)
- (#xFB6C #x7489)
- (#xFB6B #x7462)
- (#xFB6A #x742E)
- (#xFB69 #x7429)
- (#xFB68 #x742A)
- (#xFB67 #x7426)
- (#xFB66 #x73F5)
- (#xFB65 #x7407)
- (#xFB64 #x73D2)
- (#xFB63 #x73E3)
- (#xFB62 #x73D6)
- (#xFB61 #x73C9)
- (#xFB60 #x73BD)
- (#xFB5F #x7377)
- (#xFB5E #xFA16)
- (#xFB5D #x7324)
- (#xFB5C #x72BE)
- (#xFB5B #x72B1)
- (#xFB5A #x71FE)
- (#xFB59 #x71C1)
- (#xFB58 #xFA15)
- (#xFB57 #x7147)
- (#xFB56 #x7146)
- (#xFB55 #x715C)
- (#xFB54 #x7104)
- (#xFB53 #x710F)
- (#xFB52 #x70AB)
- (#xFB51 #x7085)
- (#xFB50 #x7028)
- (#xFB4F #x7007)
- (#xFB4E #x7005)
- (#xFB4D #x6FF5)
- (#xFB4C #x6FB5)
- (#xFB4B #x6F88)
- (#xFB4A #x6EBF)
- (#xFB49 #x6E3C)
- (#xFB48 #x6E27)
- (#xFB47 #x6E5C)
- (#xFB46 #x6E39)
- (#xFB45 #x6DFC)
- (#xFB44 #x6DF2)
- (#xFB43 #x6DF8)
- (#xFB42 #x6DCF)
- (#xFB41 #x6DAC)
- (#xFB40 #x6D96)
- (#xFAFC #x6D6F)
- (#xFAFB #x6D87)
- (#xFAFA #x6D04)
- (#xFAF9 #x6CDA)
- (#xFAF8 #x6C6F)
- (#xFAF7 #x6C86)
- (#xFAF6 #x6C5C)
- (#xFAF5 #x6C3F)
- (#xFAF4 #x6BD6)
- (#xFAF3 #x6AE4)
- (#xFAF2 #x6AE2)
- (#xFAF1 #x6A7E)
- (#xFAF0 #x6A73)
- (#xFAEF #x6A46)
- (#xFAEE #x6A6B)
- (#xFAED #x6A30)
- (#xFAEC #x69E2)
- (#xFAEB #x6998)
- (#xFAEA #xFA14)
- (#xFAE9 #x6968)
- (#xFAE8 #xFA13)
- (#xFAE7 #x68CF)
- (#xFAE6 #x6844)
- (#xFAE5 #x6801)
- (#xFAE4 #x67C0)
- (#xFAE3 #x6852)
- (#xFAE2 #x67BB)
- (#xFAE1 #x6766)
- (#xFAE0 #xF929)
- (#xFADF #x670E)
- (#xFADE #x66FA)
- (#xFADD #x66BF)
- (#xFADC #x66B2)
- (#xFADB #x66A0)
- (#xFADA #x6699)
- (#xFAD9 #x6673)
- (#xFAD8 #xFA12)
- (#xFAD7 #x6659)
- (#xFAD6 #x6657)
- (#xFAD5 #x6665)
- (#xFAD4 #x6624)
- (#xFAD3 #x661E)
- (#xFAD2 #x662E)
- (#xFAD1 #x6609)
- (#xFAD0 #x663B)
- (#xFACF #x6615)
- (#xFACE #x6600)
- (#xFACD #x654E)
- (#xFACC #x64CE)
- (#xFACB #x649D)
- (#xFACA #x6460)
- (#xFAC9 #x63F5)
- (#xFAC8 #x62A6)
- (#xFAC7 #x6213)
- (#xFAC6 #x6198)
- (#xFAC5 #x6130)
- (#xFAC4 #x6137)
- (#xFAC3 #x6111)
- (#xFAC2 #x60F2)
- (#xFAC1 #x6120)
- (#xFAC0 #x60D5)
- (#xFABF #x60DE)
- (#xFABE #x608A)
- (#xFABD #x6085)
- (#xFABC #x605D)
- (#xFABB #x5FDE)
- (#xFABA #x5FB7)
- (#xFAB9 #x5F67)
- (#xFAB8 #x5F34)
- (#xFAB7 #x5F21)
- (#xFAB6 #x5DD0)
- (#xFAB5 #x5DB9)
- (#xFAB4 #x5DB8)
- (#xFAB3 #x5D6D)
- (#xFAB2 #x5D42)
- (#xFAB1 #xFA11)
- (#xFAB0 #x5D53)
- (#xFAAF #x5D27)
- (#xFAAE #x5CF5)
- (#xFAAD #x5CBA)
- (#xFAAC #x5CA6)
- (#xFAAB #x5C1E)
- (#xFAAA #x5BEC)
- (#xFAA9 #x5BD8)
- (#xFAA8 #x752F)
- (#xFAA7 #x5BC0)
- (#xFAA6 #x5B56)
- (#xFAA5 #x59BA)
- (#xFAA4 #x59A4)
- (#xFAA3 #x5963)
- (#xFAA2 #x595D)
- (#xFAA1 #x595B)
- (#xFAA0 #x5953)
- (#xFA9F #x590B)
- (#xFA9E #x58B2)
- (#xFA9D #x589E)
- (#xFA9C #xFA10)
- (#xFA9B #xFA0F)
- (#xFA9A #x57C7)
- (#xFA99 #x57C8)
- (#xFA98 #x57AC)
- (#xFA97 #x5765)
- (#xFA96 #x5759)
- (#xFA95 #x5586)
- (#xFA94 #x54FF)
- (#xFA93 #x54A9)
- (#xFA92 #x548A)
- (#xFA91 #x549C)
- (#xFA90 #xFA0E)
- (#xFA8F #x53DD)
- (#xFA8E #x53B2)
- (#xFA8D #x5393)
- (#xFA8C #x5372)
- (#xFA8B #x5324)
- (#xFA8A #x5307)
- (#xFA89 #x5300)
- (#xFA88 #x52DB)
- (#xFA87 #x52C0)
- (#xFA86 #x52A6)
- (#xFA85 #x529C)
- (#xFA84 #x5215)
- (#xFA83 #x51EC)
- (#xFA82 #x51BE)
- (#xFA81 #x519D)
- (#xFA80 #x5164)
- (#xFA7E #x514A)
- (#xFA7D #x50D8)
- (#xFA7C #x50F4)
- (#xFA7B #x5094)
- (#xFA7A #x5042)
- (#xFA79 #x5070)
- (#xFA78 #x5046)
- (#xFA77 #x501E)
- (#xFA76 #x4FFF)
- (#xFA75 #x5022)
- (#xFA74 #x5040)
- (#xFA73 #x4FCD)
- (#xFA72 #x4F94)
- (#xFA71 #x4F9A)
- (#xFA70 #x4F8A)
- (#xFA6F #x4F92)
- (#xFA6E #x4F56)
- (#xFA6D #x4F39)
- (#xFA6C #x4F03)
- (#xFA6B #x4F00)
- (#xFA6A #x4EFC)
- (#xFA69 #x4EE1)
- (#xFA68 #x4E28)
- (#xFA67 #x5F45)
- (#xFA66 #x66FB)
- (#xFA65 #x92F9)
- (#xFA64 #x68C8)
- (#xFA63 #x6631)
- (#xFA62 #x70BB)
- (#xFA61 #x4FC9)
- (#xFA60 #x84DC)
- (#xFA5F #x9288)
- (#xFA5E #x9348)
- (#xFA5D #x891C)
- (#xFA5C #x7E8A)
- (#xFA5B #x2235)
- (#xFA5A #x2121)
- (#xFA59 #x2116)
- (#xFA58 #x3231)
- (#xFA57 #xFF02)
- (#xFA56 #xFF07)
- (#xFA55 #xFFE4)
- (#xFA54 #xFFE2)
- (#xFA53 #x2169)
- (#xFA52 #x2168)
- (#xFA51 #x2167)
- (#xFA50 #x2166)
- (#xFA4F #x2165)
- (#xFA4E #x2164)
- (#xFA4D #x2163)
- (#xFA4C #x2162)
- (#xFA4B #x2161)
- (#xFA4A #x2160)
- (#xFA49 #x2179)
- (#xFA48 #x2178)
- (#xFA47 #x2177)
- (#xFA46 #x2176)
- (#xFA45 #x2175)
- (#xFA44 #x2174)
- (#xFA43 #x2173)
- (#xFA42 #x2172)
- (#xFA41 #x2171)
- (#xFA40 #x2170)
- (#xF9FC #xE757)
- (#xF9FB #xE756)
- (#xF9FA #xE755)
- (#xF9F9 #xE754)
- (#xF9F8 #xE753)
- (#xF9F7 #xE752)
- (#xF9F6 #xE751)
- (#xF9F5 #xE750)
- (#xF9F4 #xE74F)
- (#xF9F3 #xE74E)
- (#xF9F2 #xE74D)
- (#xF9F1 #xE74C)
- (#xF9F0 #xE74B)
- (#xF9EF #xE74A)
- (#xF9EE #xE749)
- (#xF9ED #xE748)
- (#xF9EC #xE747)
- (#xF9EB #xE746)
- (#xF9EA #xE745)
- (#xF9E9 #xE744)
- (#xF9E8 #xE743)
- (#xF9E7 #xE742)
- (#xF9E6 #xE741)
- (#xF9E5 #xE740)
- (#xF9E4 #xE73F)
- (#xF9E3 #xE73E)
- (#xF9E2 #xE73D)
- (#xF9E1 #xE73C)
- (#xF9E0 #xE73B)
- (#xF9DF #xE73A)
- (#xF9DE #xE739)
- (#xF9DD #xE738)
- (#xF9DC #xE737)
- (#xF9DB #xE736)
- (#xF9DA #xE735)
- (#xF9D9 #xE734)
- (#xF9D8 #xE733)
- (#xF9D7 #xE732)
- (#xF9D6 #xE731)
- (#xF9D5 #xE730)
- (#xF9D4 #xE72F)
- (#xF9D3 #xE72E)
- (#xF9D2 #xE72D)
- (#xF9D1 #xE72C)
- (#xF9D0 #xE72B)
- (#xF9CF #xE72A)
- (#xF9CE #xE729)
- (#xF9CD #xE728)
- (#xF9CC #xE727)
- (#xF9CB #xE726)
- (#xF9CA #xE725)
- (#xF9C9 #xE724)
- (#xF9C8 #xE723)
- (#xF9C7 #xE722)
- (#xF9C6 #xE721)
- (#xF9C5 #xE720)
- (#xF9C4 #xE71F)
- (#xF9C3 #xE71E)
- (#xF9C2 #xE71D)
- (#xF9C1 #xE71C)
- (#xF9C0 #xE71B)
- (#xF9BF #xE71A)
- (#xF9BE #xE719)
- (#xF9BD #xE718)
- (#xF9BC #xE717)
- (#xF9BB #xE716)
- (#xF9BA #xE715)
- (#xF9B9 #xE714)
- (#xF9B8 #xE713)
- (#xF9B7 #xE712)
- (#xF9B6 #xE711)
- (#xF9B5 #xE710)
- (#xF9B4 #xE70F)
- (#xF9B3 #xE70E)
- (#xF9B2 #xE70D)
- (#xF9B1 #xE70C)
- (#xF9B0 #xE70B)
- (#xF9AF #xE70A)
- (#xF9AE #xE709)
- (#xF9AD #xE708)
- (#xF9AC #xE707)
- (#xF9AB #xE706)
- (#xF9AA #xE705)
- (#xF9A9 #xE704)
- (#xF9A8 #xE703)
- (#xF9A7 #xE702)
- (#xF9A6 #xE701)
- (#xF9A5 #xE700)
- (#xF9A4 #xE6FF)
- (#xF9A3 #xE6FE)
- (#xF9A2 #xE6FD)
- (#xF9A1 #xE6FC)
- (#xF9A0 #xE6FB)
- (#xF99F #xE6FA)
- (#xF99E #xE6F9)
- (#xF99D #xE6F8)
- (#xF99C #xE6F7)
- (#xF99B #xE6F6)
- (#xF99A #xE6F5)
- (#xF999 #xE6F4)
- (#xF998 #xE6F3)
- (#xF997 #xE6F2)
- (#xF996 #xE6F1)
- (#xF995 #xE6F0)
- (#xF994 #xE6EF)
- (#xF993 #xE6EE)
- (#xF992 #xE6ED)
- (#xF991 #xE6EC)
- (#xF990 #xE6EB)
- (#xF98F #xE6EA)
- (#xF98E #xE6E9)
- (#xF98D #xE6E8)
- (#xF98C #xE6E7)
- (#xF98B #xE6E6)
- (#xF98A #xE6E5)
- (#xF989 #xE6E4)
- (#xF988 #xE6E3)
- (#xF987 #xE6E2)
- (#xF986 #xE6E1)
- (#xF985 #xE6E0)
- (#xF984 #xE6DF)
- (#xF983 #xE6DE)
- (#xF982 #xE6DD)
- (#xF981 #xE6DC)
- (#xF980 #xE6DB)
- (#xF97E #xE6DA)
- (#xF97D #xE6D9)
- (#xF97C #xE6D8)
- (#xF97B #xE6D7)
- (#xF97A #xE6D6)
- (#xF979 #xE6D5)
- (#xF978 #xE6D4)
- (#xF977 #xE6D3)
- (#xF976 #xE6D2)
- (#xF975 #xE6D1)
- (#xF974 #xE6D0)
- (#xF973 #xE6CF)
- (#xF972 #xE6CE)
- (#xF971 #xE6CD)
- (#xF970 #xE6CC)
- (#xF96F #xE6CB)
- (#xF96E #xE6CA)
- (#xF96D #xE6C9)
- (#xF96C #xE6C8)
- (#xF96B #xE6C7)
- (#xF96A #xE6C6)
- (#xF969 #xE6C5)
- (#xF968 #xE6C4)
- (#xF967 #xE6C3)
- (#xF966 #xE6C2)
- (#xF965 #xE6C1)
- (#xF964 #xE6C0)
- (#xF963 #xE6BF)
- (#xF962 #xE6BE)
- (#xF961 #xE6BD)
- (#xF960 #xE6BC)
- (#xF95F #xE6BB)
- (#xF95E #xE6BA)
- (#xF95D #xE6B9)
- (#xF95C #xE6B8)
- (#xF95B #xE6B7)
- (#xF95A #xE6B6)
- (#xF959 #xE6B5)
- (#xF958 #xE6B4)
- (#xF957 #xE6B3)
- (#xF956 #xE6B2)
- (#xF955 #xE6B1)
- (#xF954 #xE6B0)
- (#xF953 #xE6AF)
- (#xF952 #xE6AE)
- (#xF951 #xE6AD)
- (#xF950 #xE6AC)
- (#xF94F #xE6AB)
- (#xF94E #xE6AA)
- (#xF94D #xE6A9)
- (#xF94C #xE6A8)
- (#xF94B #xE6A7)
- (#xF94A #xE6A6)
- (#xF949 #xE6A5)
- (#xF948 #xE6A4)
- (#xF947 #xE6A3)
- (#xF946 #xE6A2)
- (#xF945 #xE6A1)
- (#xF944 #xE6A0)
- (#xF943 #xE69F)
- (#xF942 #xE69E)
- (#xF941 #xE69D)
- (#xF940 #xE69C)
- (#xF8FC #xE69B)
- (#xF8FB #xE69A)
- (#xF8FA #xE699)
- (#xF8F9 #xE698)
- (#xF8F8 #xE697)
- (#xF8F7 #xE696)
- (#xF8F6 #xE695)
- (#xF8F5 #xE694)
- (#xF8F4 #xE693)
- (#xF8F3 #xE692)
- (#xF8F2 #xE691)
- (#xF8F1 #xE690)
- (#xF8F0 #xE68F)
- (#xF8EF #xE68E)
- (#xF8EE #xE68D)
- (#xF8ED #xE68C)
- (#xF8EC #xE68B)
- (#xF8EB #xE68A)
- (#xF8EA #xE689)
- (#xF8E9 #xE688)
- (#xF8E8 #xE687)
- (#xF8E7 #xE686)
- (#xF8E6 #xE685)
- (#xF8E5 #xE684)
- (#xF8E4 #xE683)
- (#xF8E3 #xE682)
- (#xF8E2 #xE681)
- (#xF8E1 #xE680)
- (#xF8E0 #xE67F)
- (#xF8DF #xE67E)
- (#xF8DE #xE67D)
- (#xF8DD #xE67C)
- (#xF8DC #xE67B)
- (#xF8DB #xE67A)
- (#xF8DA #xE679)
- (#xF8D9 #xE678)
- (#xF8D8 #xE677)
- (#xF8D7 #xE676)
- (#xF8D6 #xE675)
- (#xF8D5 #xE674)
- (#xF8D4 #xE673)
- (#xF8D3 #xE672)
- (#xF8D2 #xE671)
- (#xF8D1 #xE670)
- (#xF8D0 #xE66F)
- (#xF8CF #xE66E)
- (#xF8CE #xE66D)
- (#xF8CD #xE66C)
- (#xF8CC #xE66B)
- (#xF8CB #xE66A)
- (#xF8CA #xE669)
- (#xF8C9 #xE668)
- (#xF8C8 #xE667)
- (#xF8C7 #xE666)
- (#xF8C6 #xE665)
- (#xF8C5 #xE664)
- (#xF8C4 #xE663)
- (#xF8C3 #xE662)
- (#xF8C2 #xE661)
- (#xF8C1 #xE660)
- (#xF8C0 #xE65F)
- (#xF8BF #xE65E)
- (#xF8BE #xE65D)
- (#xF8BD #xE65C)
- (#xF8BC #xE65B)
- (#xF8BB #xE65A)
- (#xF8BA #xE659)
- (#xF8B9 #xE658)
- (#xF8B8 #xE657)
- (#xF8B7 #xE656)
- (#xF8B6 #xE655)
- (#xF8B5 #xE654)
- (#xF8B4 #xE653)
- (#xF8B3 #xE652)
- (#xF8B2 #xE651)
- (#xF8B1 #xE650)
- (#xF8B0 #xE64F)
- (#xF8AF #xE64E)
- (#xF8AE #xE64D)
- (#xF8AD #xE64C)
- (#xF8AC #xE64B)
- (#xF8AB #xE64A)
- (#xF8AA #xE649)
- (#xF8A9 #xE648)
- (#xF8A8 #xE647)
- (#xF8A7 #xE646)
- (#xF8A6 #xE645)
- (#xF8A5 #xE644)
- (#xF8A4 #xE643)
- (#xF8A3 #xE642)
- (#xF8A2 #xE641)
- (#xF8A1 #xE640)
- (#xF8A0 #xE63F)
- (#xF89F #xE63E)
- (#xF89E #xE63D)
- (#xF89D #xE63C)
- (#xF89C #xE63B)
- (#xF89B #xE63A)
- (#xF89A #xE639)
- (#xF899 #xE638)
- (#xF898 #xE637)
- (#xF897 #xE636)
- (#xF896 #xE635)
- (#xF895 #xE634)
- (#xF894 #xE633)
- (#xF893 #xE632)
- (#xF892 #xE631)
- (#xF891 #xE630)
- (#xF890 #xE62F)
- (#xF88F #xE62E)
- (#xF88E #xE62D)
- (#xF88D #xE62C)
- (#xF88C #xE62B)
- (#xF88B #xE62A)
- (#xF88A #xE629)
- (#xF889 #xE628)
- (#xF888 #xE627)
- (#xF887 #xE626)
- (#xF886 #xE625)
- (#xF885 #xE624)
- (#xF884 #xE623)
- (#xF883 #xE622)
- (#xF882 #xE621)
- (#xF881 #xE620)
- (#xF880 #xE61F)
- (#xF87E #xE61E)
- (#xF87D #xE61D)
- (#xF87C #xE61C)
- (#xF87B #xE61B)
- (#xF87A #xE61A)
- (#xF879 #xE619)
- (#xF878 #xE618)
- (#xF877 #xE617)
- (#xF876 #xE616)
- (#xF875 #xE615)
- (#xF874 #xE614)
- (#xF873 #xE613)
- (#xF872 #xE612)
- (#xF871 #xE611)
- (#xF870 #xE610)
- (#xF86F #xE60F)
- (#xF86E #xE60E)
- (#xF86D #xE60D)
- (#xF86C #xE60C)
- (#xF86B #xE60B)
- (#xF86A #xE60A)
- (#xF869 #xE609)
- (#xF868 #xE608)
- (#xF867 #xE607)
- (#xF866 #xE606)
- (#xF865 #xE605)
- (#xF864 #xE604)
- (#xF863 #xE603)
- (#xF862 #xE602)
- (#xF861 #xE601)
- (#xF860 #xE600)
- (#xF85F #xE5FF)
- (#xF85E #xE5FE)
- (#xF85D #xE5FD)
- (#xF85C #xE5FC)
- (#xF85B #xE5FB)
- (#xF85A #xE5FA)
- (#xF859 #xE5F9)
- (#xF858 #xE5F8)
- (#xF857 #xE5F7)
- (#xF856 #xE5F6)
- (#xF855 #xE5F5)
- (#xF854 #xE5F4)
- (#xF853 #xE5F3)
- (#xF852 #xE5F2)
- (#xF851 #xE5F1)
- (#xF850 #xE5F0)
- (#xF84F #xE5EF)
- (#xF84E #xE5EE)
- (#xF84D #xE5ED)
- (#xF84C #xE5EC)
- (#xF84B #xE5EB)
- (#xF84A #xE5EA)
- (#xF849 #xE5E9)
- (#xF848 #xE5E8)
- (#xF847 #xE5E7)
- (#xF846 #xE5E6)
- (#xF845 #xE5E5)
- (#xF844 #xE5E4)
- (#xF843 #xE5E3)
- (#xF842 #xE5E2)
- (#xF841 #xE5E1)
- (#xF840 #xE5E0)
- (#xF7FC #xE5DF)
- (#xF7FB #xE5DE)
- (#xF7FA #xE5DD)
- (#xF7F9 #xE5DC)
- (#xF7F8 #xE5DB)
- (#xF7F7 #xE5DA)
- (#xF7F6 #xE5D9)
- (#xF7F5 #xE5D8)
- (#xF7F4 #xE5D7)
- (#xF7F3 #xE5D6)
- (#xF7F2 #xE5D5)
- (#xF7F1 #xE5D4)
- (#xF7F0 #xE5D3)
- (#xF7EF #xE5D2)
- (#xF7EE #xE5D1)
- (#xF7ED #xE5D0)
- (#xF7EC #xE5CF)
- (#xF7EB #xE5CE)
- (#xF7EA #xE5CD)
- (#xF7E9 #xE5CC)
- (#xF7E8 #xE5CB)
- (#xF7E7 #xE5CA)
- (#xF7E6 #xE5C9)
- (#xF7E5 #xE5C8)
- (#xF7E4 #xE5C7)
- (#xF7E3 #xE5C6)
- (#xF7E2 #xE5C5)
- (#xF7E1 #xE5C4)
- (#xF7E0 #xE5C3)
- (#xF7DF #xE5C2)
- (#xF7DE #xE5C1)
- (#xF7DD #xE5C0)
- (#xF7DC #xE5BF)
- (#xF7DB #xE5BE)
- (#xF7DA #xE5BD)
- (#xF7D9 #xE5BC)
- (#xF7D8 #xE5BB)
- (#xF7D7 #xE5BA)
- (#xF7D6 #xE5B9)
- (#xF7D5 #xE5B8)
- (#xF7D4 #xE5B7)
- (#xF7D3 #xE5B6)
- (#xF7D2 #xE5B5)
- (#xF7D1 #xE5B4)
- (#xF7D0 #xE5B3)
- (#xF7CF #xE5B2)
- (#xF7CE #xE5B1)
- (#xF7CD #xE5B0)
- (#xF7CC #xE5AF)
- (#xF7CB #xE5AE)
- (#xF7CA #xE5AD)
- (#xF7C9 #xE5AC)
- (#xF7C8 #xE5AB)
- (#xF7C7 #xE5AA)
- (#xF7C6 #xE5A9)
- (#xF7C5 #xE5A8)
- (#xF7C4 #xE5A7)
- (#xF7C3 #xE5A6)
- (#xF7C2 #xE5A5)
- (#xF7C1 #xE5A4)
- (#xF7C0 #xE5A3)
- (#xF7BF #xE5A2)
- (#xF7BE #xE5A1)
- (#xF7BD #xE5A0)
- (#xF7BC #xE59F)
- (#xF7BB #xE59E)
- (#xF7BA #xE59D)
- (#xF7B9 #xE59C)
- (#xF7B8 #xE59B)
- (#xF7B7 #xE59A)
- (#xF7B6 #xE599)
- (#xF7B5 #xE598)
- (#xF7B4 #xE597)
- (#xF7B3 #xE596)
- (#xF7B2 #xE595)
- (#xF7B1 #xE594)
- (#xF7B0 #xE593)
- (#xF7AF #xE592)
- (#xF7AE #xE591)
- (#xF7AD #xE590)
- (#xF7AC #xE58F)
- (#xF7AB #xE58E)
- (#xF7AA #xE58D)
- (#xF7A9 #xE58C)
- (#xF7A8 #xE58B)
- (#xF7A7 #xE58A)
- (#xF7A6 #xE589)
- (#xF7A5 #xE588)
- (#xF7A4 #xE587)
- (#xF7A3 #xE586)
- (#xF7A2 #xE585)
- (#xF7A1 #xE584)
- (#xF7A0 #xE583)
- (#xF79F #xE582)
- (#xF79E #xE581)
- (#xF79D #xE580)
- (#xF79C #xE57F)
- (#xF79B #xE57E)
- (#xF79A #xE57D)
- (#xF799 #xE57C)
- (#xF798 #xE57B)
- (#xF797 #xE57A)
- (#xF796 #xE579)
- (#xF795 #xE578)
- (#xF794 #xE577)
- (#xF793 #xE576)
- (#xF792 #xE575)
- (#xF791 #xE574)
- (#xF790 #xE573)
- (#xF78F #xE572)
- (#xF78E #xE571)
- (#xF78D #xE570)
- (#xF78C #xE56F)
- (#xF78B #xE56E)
- (#xF78A #xE56D)
- (#xF789 #xE56C)
- (#xF788 #xE56B)
- (#xF787 #xE56A)
- (#xF786 #xE569)
- (#xF785 #xE568)
- (#xF784 #xE567)
- (#xF783 #xE566)
- (#xF782 #xE565)
- (#xF781 #xE564)
- (#xF780 #xE563)
- (#xF77E #xE562)
- (#xF77D #xE561)
- (#xF77C #xE560)
- (#xF77B #xE55F)
- (#xF77A #xE55E)
- (#xF779 #xE55D)
- (#xF778 #xE55C)
- (#xF777 #xE55B)
- (#xF776 #xE55A)
- (#xF775 #xE559)
- (#xF774 #xE558)
- (#xF773 #xE557)
- (#xF772 #xE556)
- (#xF771 #xE555)
- (#xF770 #xE554)
- (#xF76F #xE553)
- (#xF76E #xE552)
- (#xF76D #xE551)
- (#xF76C #xE550)
- (#xF76B #xE54F)
- (#xF76A #xE54E)
- (#xF769 #xE54D)
- (#xF768 #xE54C)
- (#xF767 #xE54B)
- (#xF766 #xE54A)
- (#xF765 #xE549)
- (#xF764 #xE548)
- (#xF763 #xE547)
- (#xF762 #xE546)
- (#xF761 #xE545)
- (#xF760 #xE544)
- (#xF75F #xE543)
- (#xF75E #xE542)
- (#xF75D #xE541)
- (#xF75C #xE540)
- (#xF75B #xE53F)
- (#xF75A #xE53E)
- (#xF759 #xE53D)
- (#xF758 #xE53C)
- (#xF757 #xE53B)
- (#xF756 #xE53A)
- (#xF755 #xE539)
- (#xF754 #xE538)
- (#xF753 #xE537)
- (#xF752 #xE536)
- (#xF751 #xE535)
- (#xF750 #xE534)
- (#xF74F #xE533)
- (#xF74E #xE532)
- (#xF74D #xE531)
- (#xF74C #xE530)
- (#xF74B #xE52F)
- (#xF74A #xE52E)
- (#xF749 #xE52D)
- (#xF748 #xE52C)
- (#xF747 #xE52B)
- (#xF746 #xE52A)
- (#xF745 #xE529)
- (#xF744 #xE528)
- (#xF743 #xE527)
- (#xF742 #xE526)
- (#xF741 #xE525)
- (#xF740 #xE524)
- (#xF6FC #xE523)
- (#xF6FB #xE522)
- (#xF6FA #xE521)
- (#xF6F9 #xE520)
- (#xF6F8 #xE51F)
- (#xF6F7 #xE51E)
- (#xF6F6 #xE51D)
- (#xF6F5 #xE51C)
- (#xF6F4 #xE51B)
- (#xF6F3 #xE51A)
- (#xF6F2 #xE519)
- (#xF6F1 #xE518)
- (#xF6F0 #xE517)
- (#xF6EF #xE516)
- (#xF6EE #xE515)
- (#xF6ED #xE514)
- (#xF6EC #xE513)
- (#xF6EB #xE512)
- (#xF6EA #xE511)
- (#xF6E9 #xE510)
- (#xF6E8 #xE50F)
- (#xF6E7 #xE50E)
- (#xF6E6 #xE50D)
- (#xF6E5 #xE50C)
- (#xF6E4 #xE50B)
- (#xF6E3 #xE50A)
- (#xF6E2 #xE509)
- (#xF6E1 #xE508)
- (#xF6E0 #xE507)
- (#xF6DF #xE506)
- (#xF6DE #xE505)
- (#xF6DD #xE504)
- (#xF6DC #xE503)
- (#xF6DB #xE502)
- (#xF6DA #xE501)
- (#xF6D9 #xE500)
- (#xF6D8 #xE4FF)
- (#xF6D7 #xE4FE)
- (#xF6D6 #xE4FD)
- (#xF6D5 #xE4FC)
- (#xF6D4 #xE4FB)
- (#xF6D3 #xE4FA)
- (#xF6D2 #xE4F9)
- (#xF6D1 #xE4F8)
- (#xF6D0 #xE4F7)
- (#xF6CF #xE4F6)
- (#xF6CE #xE4F5)
- (#xF6CD #xE4F4)
- (#xF6CC #xE4F3)
- (#xF6CB #xE4F2)
- (#xF6CA #xE4F1)
- (#xF6C9 #xE4F0)
- (#xF6C8 #xE4EF)
- (#xF6C7 #xE4EE)
- (#xF6C6 #xE4ED)
- (#xF6C5 #xE4EC)
- (#xF6C4 #xE4EB)
- (#xF6C3 #xE4EA)
- (#xF6C2 #xE4E9)
- (#xF6C1 #xE4E8)
- (#xF6C0 #xE4E7)
- (#xF6BF #xE4E6)
- (#xF6BE #xE4E5)
- (#xF6BD #xE4E4)
- (#xF6BC #xE4E3)
- (#xF6BB #xE4E2)
- (#xF6BA #xE4E1)
- (#xF6B9 #xE4E0)
- (#xF6B8 #xE4DF)
- (#xF6B7 #xE4DE)
- (#xF6B6 #xE4DD)
- (#xF6B5 #xE4DC)
- (#xF6B4 #xE4DB)
- (#xF6B3 #xE4DA)
- (#xF6B2 #xE4D9)
- (#xF6B1 #xE4D8)
- (#xF6B0 #xE4D7)
- (#xF6AF #xE4D6)
- (#xF6AE #xE4D5)
- (#xF6AD #xE4D4)
- (#xF6AC #xE4D3)
- (#xF6AB #xE4D2)
- (#xF6AA #xE4D1)
- (#xF6A9 #xE4D0)
- (#xF6A8 #xE4CF)
- (#xF6A7 #xE4CE)
- (#xF6A6 #xE4CD)
- (#xF6A5 #xE4CC)
- (#xF6A4 #xE4CB)
- (#xF6A3 #xE4CA)
- (#xF6A2 #xE4C9)
- (#xF6A1 #xE4C8)
- (#xF6A0 #xE4C7)
- (#xF69F #xE4C6)
- (#xF69E #xE4C5)
- (#xF69D #xE4C4)
- (#xF69C #xE4C3)
- (#xF69B #xE4C2)
- (#xF69A #xE4C1)
- (#xF699 #xE4C0)
- (#xF698 #xE4BF)
- (#xF697 #xE4BE)
- (#xF696 #xE4BD)
- (#xF695 #xE4BC)
- (#xF694 #xE4BB)
- (#xF693 #xE4BA)
- (#xF692 #xE4B9)
- (#xF691 #xE4B8)
- (#xF690 #xE4B7)
- (#xF68F #xE4B6)
- (#xF68E #xE4B5)
- (#xF68D #xE4B4)
- (#xF68C #xE4B3)
- (#xF68B #xE4B2)
- (#xF68A #xE4B1)
- (#xF689 #xE4B0)
- (#xF688 #xE4AF)
- (#xF687 #xE4AE)
- (#xF686 #xE4AD)
- (#xF685 #xE4AC)
- (#xF684 #xE4AB)
- (#xF683 #xE4AA)
- (#xF682 #xE4A9)
- (#xF681 #xE4A8)
- (#xF680 #xE4A7)
- (#xF67E #xE4A6)
- (#xF67D #xE4A5)
- (#xF67C #xE4A4)
- (#xF67B #xE4A3)
- (#xF67A #xE4A2)
- (#xF679 #xE4A1)
- (#xF678 #xE4A0)
- (#xF677 #xE49F)
- (#xF676 #xE49E)
- (#xF675 #xE49D)
- (#xF674 #xE49C)
- (#xF673 #xE49B)
- (#xF672 #xE49A)
- (#xF671 #xE499)
- (#xF670 #xE498)
- (#xF66F #xE497)
- (#xF66E #xE496)
- (#xF66D #xE495)
- (#xF66C #xE494)
- (#xF66B #xE493)
- (#xF66A #xE492)
- (#xF669 #xE491)
- (#xF668 #xE490)
- (#xF667 #xE48F)
- (#xF666 #xE48E)
- (#xF665 #xE48D)
- (#xF664 #xE48C)
- (#xF663 #xE48B)
- (#xF662 #xE48A)
- (#xF661 #xE489)
- (#xF660 #xE488)
- (#xF65F #xE487)
- (#xF65E #xE486)
- (#xF65D #xE485)
- (#xF65C #xE484)
- (#xF65B #xE483)
- (#xF65A #xE482)
- (#xF659 #xE481)
- (#xF658 #xE480)
- (#xF657 #xE47F)
- (#xF656 #xE47E)
- (#xF655 #xE47D)
- (#xF654 #xE47C)
- (#xF653 #xE47B)
- (#xF652 #xE47A)
- (#xF651 #xE479)
- (#xF650 #xE478)
- (#xF64F #xE477)
- (#xF64E #xE476)
- (#xF64D #xE475)
- (#xF64C #xE474)
- (#xF64B #xE473)
- (#xF64A #xE472)
- (#xF649 #xE471)
- (#xF648 #xE470)
- (#xF647 #xE46F)
- (#xF646 #xE46E)
- (#xF645 #xE46D)
- (#xF644 #xE46C)
- (#xF643 #xE46B)
- (#xF642 #xE46A)
- (#xF641 #xE469)
- (#xF640 #xE468)
- (#xF5FC #xE467)
- (#xF5FB #xE466)
- (#xF5FA #xE465)
- (#xF5F9 #xE464)
- (#xF5F8 #xE463)
- (#xF5F7 #xE462)
- (#xF5F6 #xE461)
- (#xF5F5 #xE460)
- (#xF5F4 #xE45F)
- (#xF5F3 #xE45E)
- (#xF5F2 #xE45D)
- (#xF5F1 #xE45C)
- (#xF5F0 #xE45B)
- (#xF5EF #xE45A)
- (#xF5EE #xE459)
- (#xF5ED #xE458)
- (#xF5EC #xE457)
- (#xF5EB #xE456)
- (#xF5EA #xE455)
- (#xF5E9 #xE454)
- (#xF5E8 #xE453)
- (#xF5E7 #xE452)
- (#xF5E6 #xE451)
- (#xF5E5 #xE450)
- (#xF5E4 #xE44F)
- (#xF5E3 #xE44E)
- (#xF5E2 #xE44D)
- (#xF5E1 #xE44C)
- (#xF5E0 #xE44B)
- (#xF5DF #xE44A)
- (#xF5DE #xE449)
- (#xF5DD #xE448)
- (#xF5DC #xE447)
- (#xF5DB #xE446)
- (#xF5DA #xE445)
- (#xF5D9 #xE444)
- (#xF5D8 #xE443)
- (#xF5D7 #xE442)
- (#xF5D6 #xE441)
- (#xF5D5 #xE440)
- (#xF5D4 #xE43F)
- (#xF5D3 #xE43E)
- (#xF5D2 #xE43D)
- (#xF5D1 #xE43C)
- (#xF5D0 #xE43B)
- (#xF5CF #xE43A)
- (#xF5CE #xE439)
- (#xF5CD #xE438)
- (#xF5CC #xE437)
- (#xF5CB #xE436)
- (#xF5CA #xE435)
- (#xF5C9 #xE434)
- (#xF5C8 #xE433)
- (#xF5C7 #xE432)
- (#xF5C6 #xE431)
- (#xF5C5 #xE430)
- (#xF5C4 #xE42F)
- (#xF5C3 #xE42E)
- (#xF5C2 #xE42D)
- (#xF5C1 #xE42C)
- (#xF5C0 #xE42B)
- (#xF5BF #xE42A)
- (#xF5BE #xE429)
- (#xF5BD #xE428)
- (#xF5BC #xE427)
- (#xF5BB #xE426)
- (#xF5BA #xE425)
- (#xF5B9 #xE424)
- (#xF5B8 #xE423)
- (#xF5B7 #xE422)
- (#xF5B6 #xE421)
- (#xF5B5 #xE420)
- (#xF5B4 #xE41F)
- (#xF5B3 #xE41E)
- (#xF5B2 #xE41D)
- (#xF5B1 #xE41C)
- (#xF5B0 #xE41B)
- (#xF5AF #xE41A)
- (#xF5AE #xE419)
- (#xF5AD #xE418)
- (#xF5AC #xE417)
- (#xF5AB #xE416)
- (#xF5AA #xE415)
- (#xF5A9 #xE414)
- (#xF5A8 #xE413)
- (#xF5A7 #xE412)
- (#xF5A6 #xE411)
- (#xF5A5 #xE410)
- (#xF5A4 #xE40F)
- (#xF5A3 #xE40E)
- (#xF5A2 #xE40D)
- (#xF5A1 #xE40C)
- (#xF5A0 #xE40B)
- (#xF59F #xE40A)
- (#xF59E #xE409)
- (#xF59D #xE408)
- (#xF59C #xE407)
- (#xF59B #xE406)
- (#xF59A #xE405)
- (#xF599 #xE404)
- (#xF598 #xE403)
- (#xF597 #xE402)
- (#xF596 #xE401)
- (#xF595 #xE400)
- (#xF594 #xE3FF)
- (#xF593 #xE3FE)
- (#xF592 #xE3FD)
- (#xF591 #xE3FC)
- (#xF590 #xE3FB)
- (#xF58F #xE3FA)
- (#xF58E #xE3F9)
- (#xF58D #xE3F8)
- (#xF58C #xE3F7)
- (#xF58B #xE3F6)
- (#xF58A #xE3F5)
- (#xF589 #xE3F4)
- (#xF588 #xE3F3)
- (#xF587 #xE3F2)
- (#xF586 #xE3F1)
- (#xF585 #xE3F0)
- (#xF584 #xE3EF)
- (#xF583 #xE3EE)
- (#xF582 #xE3ED)
- (#xF581 #xE3EC)
- (#xF580 #xE3EB)
- (#xF57E #xE3EA)
- (#xF57D #xE3E9)
- (#xF57C #xE3E8)
- (#xF57B #xE3E7)
- (#xF57A #xE3E6)
- (#xF579 #xE3E5)
- (#xF578 #xE3E4)
- (#xF577 #xE3E3)
- (#xF576 #xE3E2)
- (#xF575 #xE3E1)
- (#xF574 #xE3E0)
- (#xF573 #xE3DF)
- (#xF572 #xE3DE)
- (#xF571 #xE3DD)
- (#xF570 #xE3DC)
- (#xF56F #xE3DB)
- (#xF56E #xE3DA)
- (#xF56D #xE3D9)
- (#xF56C #xE3D8)
- (#xF56B #xE3D7)
- (#xF56A #xE3D6)
- (#xF569 #xE3D5)
- (#xF568 #xE3D4)
- (#xF567 #xE3D3)
- (#xF566 #xE3D2)
- (#xF565 #xE3D1)
- (#xF564 #xE3D0)
- (#xF563 #xE3CF)
- (#xF562 #xE3CE)
- (#xF561 #xE3CD)
- (#xF560 #xE3CC)
- (#xF55F #xE3CB)
- (#xF55E #xE3CA)
- (#xF55D #xE3C9)
- (#xF55C #xE3C8)
- (#xF55B #xE3C7)
- (#xF55A #xE3C6)
- (#xF559 #xE3C5)
- (#xF558 #xE3C4)
- (#xF557 #xE3C3)
- (#xF556 #xE3C2)
- (#xF555 #xE3C1)
- (#xF554 #xE3C0)
- (#xF553 #xE3BF)
- (#xF552 #xE3BE)
- (#xF551 #xE3BD)
- (#xF550 #xE3BC)
- (#xF54F #xE3BB)
- (#xF54E #xE3BA)
- (#xF54D #xE3B9)
- (#xF54C #xE3B8)
- (#xF54B #xE3B7)
- (#xF54A #xE3B6)
- (#xF549 #xE3B5)
- (#xF548 #xE3B4)
- (#xF547 #xE3B3)
- (#xF546 #xE3B2)
- (#xF545 #xE3B1)
- (#xF544 #xE3B0)
- (#xF543 #xE3AF)
- (#xF542 #xE3AE)
- (#xF541 #xE3AD)
- (#xF540 #xE3AC)
- (#xF4FC #xE3AB)
- (#xF4FB #xE3AA)
- (#xF4FA #xE3A9)
- (#xF4F9 #xE3A8)
- (#xF4F8 #xE3A7)
- (#xF4F7 #xE3A6)
- (#xF4F6 #xE3A5)
- (#xF4F5 #xE3A4)
- (#xF4F4 #xE3A3)
- (#xF4F3 #xE3A2)
- (#xF4F2 #xE3A1)
- (#xF4F1 #xE3A0)
- (#xF4F0 #xE39F)
- (#xF4EF #xE39E)
- (#xF4EE #xE39D)
- (#xF4ED #xE39C)
- (#xF4EC #xE39B)
- (#xF4EB #xE39A)
- (#xF4EA #xE399)
- (#xF4E9 #xE398)
- (#xF4E8 #xE397)
- (#xF4E7 #xE396)
- (#xF4E6 #xE395)
- (#xF4E5 #xE394)
- (#xF4E4 #xE393)
- (#xF4E3 #xE392)
- (#xF4E2 #xE391)
- (#xF4E1 #xE390)
- (#xF4E0 #xE38F)
- (#xF4DF #xE38E)
- (#xF4DE #xE38D)
- (#xF4DD #xE38C)
- (#xF4DC #xE38B)
- (#xF4DB #xE38A)
- (#xF4DA #xE389)
- (#xF4D9 #xE388)
- (#xF4D8 #xE387)
- (#xF4D7 #xE386)
- (#xF4D6 #xE385)
- (#xF4D5 #xE384)
- (#xF4D4 #xE383)
- (#xF4D3 #xE382)
- (#xF4D2 #xE381)
- (#xF4D1 #xE380)
- (#xF4D0 #xE37F)
- (#xF4CF #xE37E)
- (#xF4CE #xE37D)
- (#xF4CD #xE37C)
- (#xF4CC #xE37B)
- (#xF4CB #xE37A)
- (#xF4CA #xE379)
- (#xF4C9 #xE378)
- (#xF4C8 #xE377)
- (#xF4C7 #xE376)
- (#xF4C6 #xE375)
- (#xF4C5 #xE374)
- (#xF4C4 #xE373)
- (#xF4C3 #xE372)
- (#xF4C2 #xE371)
- (#xF4C1 #xE370)
- (#xF4C0 #xE36F)
- (#xF4BF #xE36E)
- (#xF4BE #xE36D)
- (#xF4BD #xE36C)
- (#xF4BC #xE36B)
- (#xF4BB #xE36A)
- (#xF4BA #xE369)
- (#xF4B9 #xE368)
- (#xF4B8 #xE367)
- (#xF4B7 #xE366)
- (#xF4B6 #xE365)
- (#xF4B5 #xE364)
- (#xF4B4 #xE363)
- (#xF4B3 #xE362)
- (#xF4B2 #xE361)
- (#xF4B1 #xE360)
- (#xF4B0 #xE35F)
- (#xF4AF #xE35E)
- (#xF4AE #xE35D)
- (#xF4AD #xE35C)
- (#xF4AC #xE35B)
- (#xF4AB #xE35A)
- (#xF4AA #xE359)
- (#xF4A9 #xE358)
- (#xF4A8 #xE357)
- (#xF4A7 #xE356)
- (#xF4A6 #xE355)
- (#xF4A5 #xE354)
- (#xF4A4 #xE353)
- (#xF4A3 #xE352)
- (#xF4A2 #xE351)
- (#xF4A1 #xE350)
- (#xF4A0 #xE34F)
- (#xF49F #xE34E)
- (#xF49E #xE34D)
- (#xF49D #xE34C)
- (#xF49C #xE34B)
- (#xF49B #xE34A)
- (#xF49A #xE349)
- (#xF499 #xE348)
- (#xF498 #xE347)
- (#xF497 #xE346)
- (#xF496 #xE345)
- (#xF495 #xE344)
- (#xF494 #xE343)
- (#xF493 #xE342)
- (#xF492 #xE341)
- (#xF491 #xE340)
- (#xF490 #xE33F)
- (#xF48F #xE33E)
- (#xF48E #xE33D)
- (#xF48D #xE33C)
- (#xF48C #xE33B)
- (#xF48B #xE33A)
- (#xF48A #xE339)
- (#xF489 #xE338)
- (#xF488 #xE337)
- (#xF487 #xE336)
- (#xF486 #xE335)
- (#xF485 #xE334)
- (#xF484 #xE333)
- (#xF483 #xE332)
- (#xF482 #xE331)
- (#xF481 #xE330)
- (#xF480 #xE32F)
- (#xF47E #xE32E)
- (#xF47D #xE32D)
- (#xF47C #xE32C)
- (#xF47B #xE32B)
- (#xF47A #xE32A)
- (#xF479 #xE329)
- (#xF478 #xE328)
- (#xF477 #xE327)
- (#xF476 #xE326)
- (#xF475 #xE325)
- (#xF474 #xE324)
- (#xF473 #xE323)
- (#xF472 #xE322)
- (#xF471 #xE321)
- (#xF470 #xE320)
- (#xF46F #xE31F)
- (#xF46E #xE31E)
- (#xF46D #xE31D)
- (#xF46C #xE31C)
- (#xF46B #xE31B)
- (#xF46A #xE31A)
- (#xF469 #xE319)
- (#xF468 #xE318)
- (#xF467 #xE317)
- (#xF466 #xE316)
- (#xF465 #xE315)
- (#xF464 #xE314)
- (#xF463 #xE313)
- (#xF462 #xE312)
- (#xF461 #xE311)
- (#xF460 #xE310)
- (#xF45F #xE30F)
- (#xF45E #xE30E)
- (#xF45D #xE30D)
- (#xF45C #xE30C)
- (#xF45B #xE30B)
- (#xF45A #xE30A)
- (#xF459 #xE309)
- (#xF458 #xE308)
- (#xF457 #xE307)
- (#xF456 #xE306)
- (#xF455 #xE305)
- (#xF454 #xE304)
- (#xF453 #xE303)
- (#xF452 #xE302)
- (#xF451 #xE301)
- (#xF450 #xE300)
- (#xF44F #xE2FF)
- (#xF44E #xE2FE)
- (#xF44D #xE2FD)
- (#xF44C #xE2FC)
- (#xF44B #xE2FB)
- (#xF44A #xE2FA)
- (#xF449 #xE2F9)
- (#xF448 #xE2F8)
- (#xF447 #xE2F7)
- (#xF446 #xE2F6)
- (#xF445 #xE2F5)
- (#xF444 #xE2F4)
- (#xF443 #xE2F3)
- (#xF442 #xE2F2)
- (#xF441 #xE2F1)
- (#xF440 #xE2F0)
- (#xF3FC #xE2EF)
- (#xF3FB #xE2EE)
- (#xF3FA #xE2ED)
- (#xF3F9 #xE2EC)
- (#xF3F8 #xE2EB)
- (#xF3F7 #xE2EA)
- (#xF3F6 #xE2E9)
- (#xF3F5 #xE2E8)
- (#xF3F4 #xE2E7)
- (#xF3F3 #xE2E6)
- (#xF3F2 #xE2E5)
- (#xF3F1 #xE2E4)
- (#xF3F0 #xE2E3)
- (#xF3EF #xE2E2)
- (#xF3EE #xE2E1)
- (#xF3ED #xE2E0)
- (#xF3EC #xE2DF)
- (#xF3EB #xE2DE)
- (#xF3EA #xE2DD)
- (#xF3E9 #xE2DC)
- (#xF3E8 #xE2DB)
- (#xF3E7 #xE2DA)
- (#xF3E6 #xE2D9)
- (#xF3E5 #xE2D8)
- (#xF3E4 #xE2D7)
- (#xF3E3 #xE2D6)
- (#xF3E2 #xE2D5)
- (#xF3E1 #xE2D4)
- (#xF3E0 #xE2D3)
- (#xF3DF #xE2D2)
- (#xF3DE #xE2D1)
- (#xF3DD #xE2D0)
- (#xF3DC #xE2CF)
- (#xF3DB #xE2CE)
- (#xF3DA #xE2CD)
- (#xF3D9 #xE2CC)
- (#xF3D8 #xE2CB)
- (#xF3D7 #xE2CA)
- (#xF3D6 #xE2C9)
- (#xF3D5 #xE2C8)
- (#xF3D4 #xE2C7)
- (#xF3D3 #xE2C6)
- (#xF3D2 #xE2C5)
- (#xF3D1 #xE2C4)
- (#xF3D0 #xE2C3)
- (#xF3CF #xE2C2)
- (#xF3CE #xE2C1)
- (#xF3CD #xE2C0)
- (#xF3CC #xE2BF)
- (#xF3CB #xE2BE)
- (#xF3CA #xE2BD)
- (#xF3C9 #xE2BC)
- (#xF3C8 #xE2BB)
- (#xF3C7 #xE2BA)
- (#xF3C6 #xE2B9)
- (#xF3C5 #xE2B8)
- (#xF3C4 #xE2B7)
- (#xF3C3 #xE2B6)
- (#xF3C2 #xE2B5)
- (#xF3C1 #xE2B4)
- (#xF3C0 #xE2B3)
- (#xF3BF #xE2B2)
- (#xF3BE #xE2B1)
- (#xF3BD #xE2B0)
- (#xF3BC #xE2AF)
- (#xF3BB #xE2AE)
- (#xF3BA #xE2AD)
- (#xF3B9 #xE2AC)
- (#xF3B8 #xE2AB)
- (#xF3B7 #xE2AA)
- (#xF3B6 #xE2A9)
- (#xF3B5 #xE2A8)
- (#xF3B4 #xE2A7)
- (#xF3B3 #xE2A6)
- (#xF3B2 #xE2A5)
- (#xF3B1 #xE2A4)
- (#xF3B0 #xE2A3)
- (#xF3AF #xE2A2)
- (#xF3AE #xE2A1)
- (#xF3AD #xE2A0)
- (#xF3AC #xE29F)
- (#xF3AB #xE29E)
- (#xF3AA #xE29D)
- (#xF3A9 #xE29C)
- (#xF3A8 #xE29B)
- (#xF3A7 #xE29A)
- (#xF3A6 #xE299)
- (#xF3A5 #xE298)
- (#xF3A4 #xE297)
- (#xF3A3 #xE296)
- (#xF3A2 #xE295)
- (#xF3A1 #xE294)
- (#xF3A0 #xE293)
- (#xF39F #xE292)
- (#xF39E #xE291)
- (#xF39D #xE290)
- (#xF39C #xE28F)
- (#xF39B #xE28E)
- (#xF39A #xE28D)
- (#xF399 #xE28C)
- (#xF398 #xE28B)
- (#xF397 #xE28A)
- (#xF396 #xE289)
- (#xF395 #xE288)
- (#xF394 #xE287)
- (#xF393 #xE286)
- (#xF392 #xE285)
- (#xF391 #xE284)
- (#xF390 #xE283)
- (#xF38F #xE282)
- (#xF38E #xE281)
- (#xF38D #xE280)
- (#xF38C #xE27F)
- (#xF38B #xE27E)
- (#xF38A #xE27D)
- (#xF389 #xE27C)
- (#xF388 #xE27B)
- (#xF387 #xE27A)
- (#xF386 #xE279)
- (#xF385 #xE278)
- (#xF384 #xE277)
- (#xF383 #xE276)
- (#xF382 #xE275)
- (#xF381 #xE274)
- (#xF380 #xE273)
- (#xF37E #xE272)
- (#xF37D #xE271)
- (#xF37C #xE270)
- (#xF37B #xE26F)
- (#xF37A #xE26E)
- (#xF379 #xE26D)
- (#xF378 #xE26C)
- (#xF377 #xE26B)
- (#xF376 #xE26A)
- (#xF375 #xE269)
- (#xF374 #xE268)
- (#xF373 #xE267)
- (#xF372 #xE266)
- (#xF371 #xE265)
- (#xF370 #xE264)
- (#xF36F #xE263)
- (#xF36E #xE262)
- (#xF36D #xE261)
- (#xF36C #xE260)
- (#xF36B #xE25F)
- (#xF36A #xE25E)
- (#xF369 #xE25D)
- (#xF368 #xE25C)
- (#xF367 #xE25B)
- (#xF366 #xE25A)
- (#xF365 #xE259)
- (#xF364 #xE258)
- (#xF363 #xE257)
- (#xF362 #xE256)
- (#xF361 #xE255)
- (#xF360 #xE254)
- (#xF35F #xE253)
- (#xF35E #xE252)
- (#xF35D #xE251)
- (#xF35C #xE250)
- (#xF35B #xE24F)
- (#xF35A #xE24E)
- (#xF359 #xE24D)
- (#xF358 #xE24C)
- (#xF357 #xE24B)
- (#xF356 #xE24A)
- (#xF355 #xE249)
- (#xF354 #xE248)
- (#xF353 #xE247)
- (#xF352 #xE246)
- (#xF351 #xE245)
- (#xF350 #xE244)
- (#xF34F #xE243)
- (#xF34E #xE242)
- (#xF34D #xE241)
- (#xF34C #xE240)
- (#xF34B #xE23F)
- (#xF34A #xE23E)
- (#xF349 #xE23D)
- (#xF348 #xE23C)
- (#xF347 #xE23B)
- (#xF346 #xE23A)
- (#xF345 #xE239)
- (#xF344 #xE238)
- (#xF343 #xE237)
- (#xF342 #xE236)
- (#xF341 #xE235)
- (#xF340 #xE234)
- (#xF2FC #xE233)
- (#xF2FB #xE232)
- (#xF2FA #xE231)
- (#xF2F9 #xE230)
- (#xF2F8 #xE22F)
- (#xF2F7 #xE22E)
- (#xF2F6 #xE22D)
- (#xF2F5 #xE22C)
- (#xF2F4 #xE22B)
- (#xF2F3 #xE22A)
- (#xF2F2 #xE229)
- (#xF2F1 #xE228)
- (#xF2F0 #xE227)
- (#xF2EF #xE226)
- (#xF2EE #xE225)
- (#xF2ED #xE224)
- (#xF2EC #xE223)
- (#xF2EB #xE222)
- (#xF2EA #xE221)
- (#xF2E9 #xE220)
- (#xF2E8 #xE21F)
- (#xF2E7 #xE21E)
- (#xF2E6 #xE21D)
- (#xF2E5 #xE21C)
- (#xF2E4 #xE21B)
- (#xF2E3 #xE21A)
- (#xF2E2 #xE219)
- (#xF2E1 #xE218)
- (#xF2E0 #xE217)
- (#xF2DF #xE216)
- (#xF2DE #xE215)
- (#xF2DD #xE214)
- (#xF2DC #xE213)
- (#xF2DB #xE212)
- (#xF2DA #xE211)
- (#xF2D9 #xE210)
- (#xF2D8 #xE20F)
- (#xF2D7 #xE20E)
- (#xF2D6 #xE20D)
- (#xF2D5 #xE20C)
- (#xF2D4 #xE20B)
- (#xF2D3 #xE20A)
- (#xF2D2 #xE209)
- (#xF2D1 #xE208)
- (#xF2D0 #xE207)
- (#xF2CF #xE206)
- (#xF2CE #xE205)
- (#xF2CD #xE204)
- (#xF2CC #xE203)
- (#xF2CB #xE202)
- (#xF2CA #xE201)
- (#xF2C9 #xE200)
- (#xF2C8 #xE1FF)
- (#xF2C7 #xE1FE)
- (#xF2C6 #xE1FD)
- (#xF2C5 #xE1FC)
- (#xF2C4 #xE1FB)
- (#xF2C3 #xE1FA)
- (#xF2C2 #xE1F9)
- (#xF2C1 #xE1F8)
- (#xF2C0 #xE1F7)
- (#xF2BF #xE1F6)
- (#xF2BE #xE1F5)
- (#xF2BD #xE1F4)
- (#xF2BC #xE1F3)
- (#xF2BB #xE1F2)
- (#xF2BA #xE1F1)
- (#xF2B9 #xE1F0)
- (#xF2B8 #xE1EF)
- (#xF2B7 #xE1EE)
- (#xF2B6 #xE1ED)
- (#xF2B5 #xE1EC)
- (#xF2B4 #xE1EB)
- (#xF2B3 #xE1EA)
- (#xF2B2 #xE1E9)
- (#xF2B1 #xE1E8)
- (#xF2B0 #xE1E7)
- (#xF2AF #xE1E6)
- (#xF2AE #xE1E5)
- (#xF2AD #xE1E4)
- (#xF2AC #xE1E3)
- (#xF2AB #xE1E2)
- (#xF2AA #xE1E1)
- (#xF2A9 #xE1E0)
- (#xF2A8 #xE1DF)
- (#xF2A7 #xE1DE)
- (#xF2A6 #xE1DD)
- (#xF2A5 #xE1DC)
- (#xF2A4 #xE1DB)
- (#xF2A3 #xE1DA)
- (#xF2A2 #xE1D9)
- (#xF2A1 #xE1D8)
- (#xF2A0 #xE1D7)
- (#xF29F #xE1D6)
- (#xF29E #xE1D5)
- (#xF29D #xE1D4)
- (#xF29C #xE1D3)
- (#xF29B #xE1D2)
- (#xF29A #xE1D1)
- (#xF299 #xE1D0)
- (#xF298 #xE1CF)
- (#xF297 #xE1CE)
- (#xF296 #xE1CD)
- (#xF295 #xE1CC)
- (#xF294 #xE1CB)
- (#xF293 #xE1CA)
- (#xF292 #xE1C9)
- (#xF291 #xE1C8)
- (#xF290 #xE1C7)
- (#xF28F #xE1C6)
- (#xF28E #xE1C5)
- (#xF28D #xE1C4)
- (#xF28C #xE1C3)
- (#xF28B #xE1C2)
- (#xF28A #xE1C1)
- (#xF289 #xE1C0)
- (#xF288 #xE1BF)
- (#xF287 #xE1BE)
- (#xF286 #xE1BD)
- (#xF285 #xE1BC)
- (#xF284 #xE1BB)
- (#xF283 #xE1BA)
- (#xF282 #xE1B9)
- (#xF281 #xE1B8)
- (#xF280 #xE1B7)
- (#xF27E #xE1B6)
- (#xF27D #xE1B5)
- (#xF27C #xE1B4)
- (#xF27B #xE1B3)
- (#xF27A #xE1B2)
- (#xF279 #xE1B1)
- (#xF278 #xE1B0)
- (#xF277 #xE1AF)
- (#xF276 #xE1AE)
- (#xF275 #xE1AD)
- (#xF274 #xE1AC)
- (#xF273 #xE1AB)
- (#xF272 #xE1AA)
- (#xF271 #xE1A9)
- (#xF270 #xE1A8)
- (#xF26F #xE1A7)
- (#xF26E #xE1A6)
- (#xF26D #xE1A5)
- (#xF26C #xE1A4)
- (#xF26B #xE1A3)
- (#xF26A #xE1A2)
- (#xF269 #xE1A1)
- (#xF268 #xE1A0)
- (#xF267 #xE19F)
- (#xF266 #xE19E)
- (#xF265 #xE19D)
- (#xF264 #xE19C)
- (#xF263 #xE19B)
- (#xF262 #xE19A)
- (#xF261 #xE199)
- (#xF260 #xE198)
- (#xF25F #xE197)
- (#xF25E #xE196)
- (#xF25D #xE195)
- (#xF25C #xE194)
- (#xF25B #xE193)
- (#xF25A #xE192)
- (#xF259 #xE191)
- (#xF258 #xE190)
- (#xF257 #xE18F)
- (#xF256 #xE18E)
- (#xF255 #xE18D)
- (#xF254 #xE18C)
- (#xF253 #xE18B)
- (#xF252 #xE18A)
- (#xF251 #xE189)
- (#xF250 #xE188)
- (#xF24F #xE187)
- (#xF24E #xE186)
- (#xF24D #xE185)
- (#xF24C #xE184)
- (#xF24B #xE183)
- (#xF24A #xE182)
- (#xF249 #xE181)
- (#xF248 #xE180)
- (#xF247 #xE17F)
- (#xF246 #xE17E)
- (#xF245 #xE17D)
- (#xF244 #xE17C)
- (#xF243 #xE17B)
- (#xF242 #xE17A)
- (#xF241 #xE179)
- (#xF240 #xE178)
- (#xF1FC #xE177)
- (#xF1FB #xE176)
- (#xF1FA #xE175)
- (#xF1F9 #xE174)
- (#xF1F8 #xE173)
- (#xF1F7 #xE172)
- (#xF1F6 #xE171)
- (#xF1F5 #xE170)
- (#xF1F4 #xE16F)
- (#xF1F3 #xE16E)
- (#xF1F2 #xE16D)
- (#xF1F1 #xE16C)
- (#xF1F0 #xE16B)
- (#xF1EF #xE16A)
- (#xF1EE #xE169)
- (#xF1ED #xE168)
- (#xF1EC #xE167)
- (#xF1EB #xE166)
- (#xF1EA #xE165)
- (#xF1E9 #xE164)
- (#xF1E8 #xE163)
- (#xF1E7 #xE162)
- (#xF1E6 #xE161)
- (#xF1E5 #xE160)
- (#xF1E4 #xE15F)
- (#xF1E3 #xE15E)
- (#xF1E2 #xE15D)
- (#xF1E1 #xE15C)
- (#xF1E0 #xE15B)
- (#xF1DF #xE15A)
- (#xF1DE #xE159)
- (#xF1DD #xE158)
- (#xF1DC #xE157)
- (#xF1DB #xE156)
- (#xF1DA #xE155)
- (#xF1D9 #xE154)
- (#xF1D8 #xE153)
- (#xF1D7 #xE152)
- (#xF1D6 #xE151)
- (#xF1D5 #xE150)
- (#xF1D4 #xE14F)
- (#xF1D3 #xE14E)
- (#xF1D2 #xE14D)
- (#xF1D1 #xE14C)
- (#xF1D0 #xE14B)
- (#xF1CF #xE14A)
- (#xF1CE #xE149)
- (#xF1CD #xE148)
- (#xF1CC #xE147)
- (#xF1CB #xE146)
- (#xF1CA #xE145)
- (#xF1C9 #xE144)
- (#xF1C8 #xE143)
- (#xF1C7 #xE142)
- (#xF1C6 #xE141)
- (#xF1C5 #xE140)
- (#xF1C4 #xE13F)
- (#xF1C3 #xE13E)
- (#xF1C2 #xE13D)
- (#xF1C1 #xE13C)
- (#xF1C0 #xE13B)
- (#xF1BF #xE13A)
- (#xF1BE #xE139)
- (#xF1BD #xE138)
- (#xF1BC #xE137)
- (#xF1BB #xE136)
- (#xF1BA #xE135)
- (#xF1B9 #xE134)
- (#xF1B8 #xE133)
- (#xF1B7 #xE132)
- (#xF1B6 #xE131)
- (#xF1B5 #xE130)
- (#xF1B4 #xE12F)
- (#xF1B3 #xE12E)
- (#xF1B2 #xE12D)
- (#xF1B1 #xE12C)
- (#xF1B0 #xE12B)
- (#xF1AF #xE12A)
- (#xF1AE #xE129)
- (#xF1AD #xE128)
- (#xF1AC #xE127)
- (#xF1AB #xE126)
- (#xF1AA #xE125)
- (#xF1A9 #xE124)
- (#xF1A8 #xE123)
- (#xF1A7 #xE122)
- (#xF1A6 #xE121)
- (#xF1A5 #xE120)
- (#xF1A4 #xE11F)
- (#xF1A3 #xE11E)
- (#xF1A2 #xE11D)
- (#xF1A1 #xE11C)
- (#xF1A0 #xE11B)
- (#xF19F #xE11A)
- (#xF19E #xE119)
- (#xF19D #xE118)
- (#xF19C #xE117)
- (#xF19B #xE116)
- (#xF19A #xE115)
- (#xF199 #xE114)
- (#xF198 #xE113)
- (#xF197 #xE112)
- (#xF196 #xE111)
- (#xF195 #xE110)
- (#xF194 #xE10F)
- (#xF193 #xE10E)
- (#xF192 #xE10D)
- (#xF191 #xE10C)
- (#xF190 #xE10B)
- (#xF18F #xE10A)
- (#xF18E #xE109)
- (#xF18D #xE108)
- (#xF18C #xE107)
- (#xF18B #xE106)
- (#xF18A #xE105)
- (#xF189 #xE104)
- (#xF188 #xE103)
- (#xF187 #xE102)
- (#xF186 #xE101)
- (#xF185 #xE100)
- (#xF184 #xE0FF)
- (#xF183 #xE0FE)
- (#xF182 #xE0FD)
- (#xF181 #xE0FC)
- (#xF180 #xE0FB)
- (#xF17E #xE0FA)
- (#xF17D #xE0F9)
- (#xF17C #xE0F8)
- (#xF17B #xE0F7)
- (#xF17A #xE0F6)
- (#xF179 #xE0F5)
- (#xF178 #xE0F4)
- (#xF177 #xE0F3)
- (#xF176 #xE0F2)
- (#xF175 #xE0F1)
- (#xF174 #xE0F0)
- (#xF173 #xE0EF)
- (#xF172 #xE0EE)
- (#xF171 #xE0ED)
- (#xF170 #xE0EC)
- (#xF16F #xE0EB)
- (#xF16E #xE0EA)
- (#xF16D #xE0E9)
- (#xF16C #xE0E8)
- (#xF16B #xE0E7)
- (#xF16A #xE0E6)
- (#xF169 #xE0E5)
- (#xF168 #xE0E4)
- (#xF167 #xE0E3)
- (#xF166 #xE0E2)
- (#xF165 #xE0E1)
- (#xF164 #xE0E0)
- (#xF163 #xE0DF)
- (#xF162 #xE0DE)
- (#xF161 #xE0DD)
- (#xF160 #xE0DC)
- (#xF15F #xE0DB)
- (#xF15E #xE0DA)
- (#xF15D #xE0D9)
- (#xF15C #xE0D8)
- (#xF15B #xE0D7)
- (#xF15A #xE0D6)
- (#xF159 #xE0D5)
- (#xF158 #xE0D4)
- (#xF157 #xE0D3)
- (#xF156 #xE0D2)
- (#xF155 #xE0D1)
- (#xF154 #xE0D0)
- (#xF153 #xE0CF)
- (#xF152 #xE0CE)
- (#xF151 #xE0CD)
- (#xF150 #xE0CC)
- (#xF14F #xE0CB)
- (#xF14E #xE0CA)
- (#xF14D #xE0C9)
- (#xF14C #xE0C8)
- (#xF14B #xE0C7)
- (#xF14A #xE0C6)
- (#xF149 #xE0C5)
- (#xF148 #xE0C4)
- (#xF147 #xE0C3)
- (#xF146 #xE0C2)
- (#xF145 #xE0C1)
- (#xF144 #xE0C0)
- (#xF143 #xE0BF)
- (#xF142 #xE0BE)
- (#xF141 #xE0BD)
- (#xF140 #xE0BC)
- (#xF0FC #xE0BB)
- (#xF0FB #xE0BA)
- (#xF0FA #xE0B9)
- (#xF0F9 #xE0B8)
- (#xF0F8 #xE0B7)
- (#xF0F7 #xE0B6)
- (#xF0F6 #xE0B5)
- (#xF0F5 #xE0B4)
- (#xF0F4 #xE0B3)
- (#xF0F3 #xE0B2)
- (#xF0F2 #xE0B1)
- (#xF0F1 #xE0B0)
- (#xF0F0 #xE0AF)
- (#xF0EF #xE0AE)
- (#xF0EE #xE0AD)
- (#xF0ED #xE0AC)
- (#xF0EC #xE0AB)
- (#xF0EB #xE0AA)
- (#xF0EA #xE0A9)
- (#xF0E9 #xE0A8)
- (#xF0E8 #xE0A7)
- (#xF0E7 #xE0A6)
- (#xF0E6 #xE0A5)
- (#xF0E5 #xE0A4)
- (#xF0E4 #xE0A3)
- (#xF0E3 #xE0A2)
- (#xF0E2 #xE0A1)
- (#xF0E1 #xE0A0)
- (#xF0E0 #xE09F)
- (#xF0DF #xE09E)
- (#xF0DE #xE09D)
- (#xF0DD #xE09C)
- (#xF0DC #xE09B)
- (#xF0DB #xE09A)
- (#xF0DA #xE099)
- (#xF0D9 #xE098)
- (#xF0D8 #xE097)
- (#xF0D7 #xE096)
- (#xF0D6 #xE095)
- (#xF0D5 #xE094)
- (#xF0D4 #xE093)
- (#xF0D3 #xE092)
- (#xF0D2 #xE091)
- (#xF0D1 #xE090)
- (#xF0D0 #xE08F)
- (#xF0CF #xE08E)
- (#xF0CE #xE08D)
- (#xF0CD #xE08C)
- (#xF0CC #xE08B)
- (#xF0CB #xE08A)
- (#xF0CA #xE089)
- (#xF0C9 #xE088)
- (#xF0C8 #xE087)
- (#xF0C7 #xE086)
- (#xF0C6 #xE085)
- (#xF0C5 #xE084)
- (#xF0C4 #xE083)
- (#xF0C3 #xE082)
- (#xF0C2 #xE081)
- (#xF0C1 #xE080)
- (#xF0C0 #xE07F)
- (#xF0BF #xE07E)
- (#xF0BE #xE07D)
- (#xF0BD #xE07C)
- (#xF0BC #xE07B)
- (#xF0BB #xE07A)
- (#xF0BA #xE079)
- (#xF0B9 #xE078)
- (#xF0B8 #xE077)
- (#xF0B7 #xE076)
- (#xF0B6 #xE075)
- (#xF0B5 #xE074)
- (#xF0B4 #xE073)
- (#xF0B3 #xE072)
- (#xF0B2 #xE071)
- (#xF0B1 #xE070)
- (#xF0B0 #xE06F)
- (#xF0AF #xE06E)
- (#xF0AE #xE06D)
- (#xF0AD #xE06C)
- (#xF0AC #xE06B)
- (#xF0AB #xE06A)
- (#xF0AA #xE069)
- (#xF0A9 #xE068)
- (#xF0A8 #xE067)
- (#xF0A7 #xE066)
- (#xF0A6 #xE065)
- (#xF0A5 #xE064)
- (#xF0A4 #xE063)
- (#xF0A3 #xE062)
- (#xF0A2 #xE061)
- (#xF0A1 #xE060)
- (#xF0A0 #xE05F)
- (#xF09F #xE05E)
- (#xF09E #xE05D)
- (#xF09D #xE05C)
- (#xF09C #xE05B)
- (#xF09B #xE05A)
- (#xF09A #xE059)
- (#xF099 #xE058)
- (#xF098 #xE057)
- (#xF097 #xE056)
- (#xF096 #xE055)
- (#xF095 #xE054)
- (#xF094 #xE053)
- (#xF093 #xE052)
- (#xF092 #xE051)
- (#xF091 #xE050)
- (#xF090 #xE04F)
- (#xF08F #xE04E)
- (#xF08E #xE04D)
- (#xF08D #xE04C)
- (#xF08C #xE04B)
- (#xF08B #xE04A)
- (#xF08A #xE049)
- (#xF089 #xE048)
- (#xF088 #xE047)
- (#xF087 #xE046)
- (#xF086 #xE045)
- (#xF085 #xE044)
- (#xF084 #xE043)
- (#xF083 #xE042)
- (#xF082 #xE041)
- (#xF081 #xE040)
- (#xF080 #xE03F)
- (#xF07E #xE03E)
- (#xF07D #xE03D)
- (#xF07C #xE03C)
- (#xF07B #xE03B)
- (#xF07A #xE03A)
- (#xF079 #xE039)
- (#xF078 #xE038)
- (#xF077 #xE037)
- (#xF076 #xE036)
- (#xF075 #xE035)
- (#xF074 #xE034)
- (#xF073 #xE033)
- (#xF072 #xE032)
- (#xF071 #xE031)
- (#xF070 #xE030)
- (#xF06F #xE02F)
- (#xF06E #xE02E)
- (#xF06D #xE02D)
- (#xF06C #xE02C)
- (#xF06B #xE02B)
- (#xF06A #xE02A)
- (#xF069 #xE029)
- (#xF068 #xE028)
- (#xF067 #xE027)
- (#xF066 #xE026)
- (#xF065 #xE025)
- (#xF064 #xE024)
- (#xF063 #xE023)
- (#xF062 #xE022)
- (#xF061 #xE021)
- (#xF060 #xE020)
- (#xF05F #xE01F)
- (#xF05E #xE01E)
- (#xF05D #xE01D)
- (#xF05C #xE01C)
- (#xF05B #xE01B)
- (#xF05A #xE01A)
- (#xF059 #xE019)
- (#xF058 #xE018)
- (#xF057 #xE017)
- (#xF056 #xE016)
- (#xF055 #xE015)
- (#xF054 #xE014)
- (#xF053 #xE013)
- (#xF052 #xE012)
- (#xF051 #xE011)
- (#xF050 #xE010)
- (#xF04F #xE00F)
- (#xF04E #xE00E)
- (#xF04D #xE00D)
- (#xF04C #xE00C)
- (#xF04B #xE00B)
- (#xF04A #xE00A)
- (#xF049 #xE009)
- (#xF048 #xE008)
- (#xF047 #xE007)
- (#xF046 #xE006)
- (#xF045 #xE005)
- (#xF044 #xE004)
- (#xF043 #xE003)
- (#xF042 #xE002)
- (#xF041 #xE001)
- (#xF040 #xE000)
- (#xEEFC #xFF02)
- (#xEEFB #xFF07)
- (#xEEFA #xFFE4)
- (#xEEF9 #xFFE2)
- (#xEEF8 #x2179)
- (#xEEF7 #x2178)
- (#xEEF6 #x2177)
- (#xEEF5 #x2176)
- (#xEEF4 #x2175)
- (#xEEF3 #x2174)
- (#xEEF2 #x2173)
- (#xEEF1 #x2172)
- (#xEEF0 #x2171)
- (#xEEEF #x2170)
- (#xEEEC #x9ED1)
- (#xEEEB #x9E19)
- (#xEEEA #xFA2D)
- (#xEEE9 #x9D6B)
- (#xEEE8 #x9D70)
- (#xEEE7 #x9C00)
- (#xEEE6 #x9BBB)
- (#xEEE5 #x9BB1)
- (#xEEE4 #x9B8F)
- (#xEEE3 #x9B72)
- (#xEEE2 #x9B75)
- (#xEEE1 #x9ADC)
- (#xEEE0 #x9AD9)
- (#xEEDF #x9A4E)
- (#xEEDE #x999E)
- (#xEEDD #xFA2C)
- (#xEEDC #x9927)
- (#xEEDB #xFA2B)
- (#xEEDA #xFA2A)
- (#xEED9 #x9865)
- (#xEED8 #x9857)
- (#xEED7 #x9755)
- (#xEED6 #x9751)
- (#xEED5 #x974F)
- (#xEED4 #x974D)
- (#xEED3 #x9743)
- (#xEED2 #x973B)
- (#xEED1 #x9733)
- (#xEED0 #x96AF)
- (#xEECF #x969D)
- (#xEECE #xFA29)
- (#xEECD #xF9DC)
- (#xEECC #x9592)
- (#xEECB #x9448)
- (#xEECA #x9445)
- (#xEEC9 #x9431)
- (#xEEC8 #x93F8)
- (#xEEC7 #x93DE)
- (#xEEC6 #x93C6)
- (#xEEC5 #x93A4)
- (#xEEC4 #x9357)
- (#xEEC3 #x9370)
- (#xEEC2 #x9302)
- (#xEEC1 #x931D)
- (#xEEC0 #x92FF)
- (#xEEBF #x931E)
- (#xEEBE #xFA28)
- (#xEEBD #x92FB)
- (#xEEBC #x9321)
- (#xEEBB #x9325)
- (#xEEBA #x92D3)
- (#xEEB9 #x92E0)
- (#xEEB8 #x92D5)
- (#xEEB7 #xFA27)
- (#xEEB6 #x92D0)
- (#xEEB5 #x92D9)
- (#xEEB4 #x92D7)
- (#xEEB3 #x92E7)
- (#xEEB2 #x9278)
- (#xEEB1 #x9277)
- (#xEEB0 #x92A7)
- (#xEEAF #x9267)
- (#xEEAE #x9239)
- (#xEEAD #x9251)
- (#xEEAC #x9259)
- (#xEEAB #x924E)
- (#xEEAA #x923C)
- (#xEEA9 #x9240)
- (#xEEA8 #x923A)
- (#xEEA7 #x920A)
- (#xEEA6 #x9210)
- (#xEEA5 #x9206)
- (#xEEA4 #x91E5)
- (#xEEA3 #x91E4)
- (#xEEA2 #x91EE)
- (#xEEA1 #x91ED)
- (#xEEA0 #x91DE)
- (#xEE9F #x91D7)
- (#xEE9E #x91DA)
- (#xEE9D #x9127)
- (#xEE9C #x9115)
- (#xEE9B #xFA26)
- (#xEE9A #x90DE)
- (#xEE99 #x9067)
- (#xEE98 #xFA25)
- (#xEE97 #xFA24)
- (#xEE96 #x8ECF)
- (#xEE95 #xFA23)
- (#xEE94 #x8D76)
- (#xEE93 #x8D12)
- (#xEE92 #x8CF4)
- (#xEE91 #x8CF0)
- (#xEE90 #x8B7F)
- (#xEE8F #x8B53)
- (#xEE8E #x8AF6)
- (#xEE8D #xFA22)
- (#xEE8C #x8ADF)
- (#xEE8B #x8ABE)
- (#xEE8A #x8AA7)
- (#xEE89 #x8A79)
- (#xEE88 #x8A37)
- (#xEE87 #x8A12)
- (#xEE86 #x88F5)
- (#xEE85 #x8807)
- (#xEE84 #xFA21)
- (#xEE83 #xFA20)
- (#xEE82 #x85B0)
- (#xEE81 #xFA1F)
- (#xEE80 #x856B)
- (#xEE7E #x8559)
- (#xEE7D #x8553)
- (#xEE7C #x84B4)
- (#xEE7B #x8448)
- (#xEE7A #x83F6)
- (#xEE79 #x83C7)
- (#xEE78 #x837F)
- (#xEE77 #x8362)
- (#xEE76 #x8301)
- (#xEE75 #xFA1E)
- (#xEE74 #x7FA1)
- (#xEE73 #x7F47)
- (#xEE72 #x7E52)
- (#xEE71 #x7DD6)
- (#xEE70 #x7DA0)
- (#xEE6F #x7DB7)
- (#xEE6E #x7D5C)
- (#xEE6D #x7D48)
- (#xEE6C #xFA1D)
- (#xEE6B #x7B9E)
- (#xEE6A #x7AEB)
- (#xEE69 #xFA1C)
- (#xEE68 #x7AE7)
- (#xEE67 #x7AD1)
- (#xEE66 #x799B)
- (#xEE65 #xFA1B)
- (#xEE64 #x7994)
- (#xEE63 #xFA1A)
- (#xEE62 #xFA19)
- (#xEE61 #xFA18)
- (#xEE60 #x7930)
- (#xEE5F #x787A)
- (#xEE5E #x7864)
- (#xEE5D #x784E)
- (#xEE5C #x7821)
- (#xEE5B #x52AF)
- (#xEE5A #x7746)
- (#xEE59 #xFA17)
- (#xEE58 #x76A6)
- (#xEE57 #x769B)
- (#xEE56 #x769E)
- (#xEE55 #x769C)
- (#xEE54 #x7682)
- (#xEE53 #x756F)
- (#xEE52 #x7501)
- (#xEE51 #x749F)
- (#xEE50 #x7489)
- (#xEE4F #x7462)
- (#xEE4E #x742E)
- (#xEE4D #x7429)
- (#xEE4C #x742A)
- (#xEE4B #x7426)
- (#xEE4A #x73F5)
- (#xEE49 #x7407)
- (#xEE48 #x73D2)
- (#xEE47 #x73E3)
- (#xEE46 #x73D6)
- (#xEE45 #x73C9)
- (#xEE44 #x73BD)
- (#xEE43 #x7377)
- (#xEE42 #xFA16)
- (#xEE41 #x7324)
- (#xEE40 #x72BE)
- (#xEDFC #x72B1)
- (#xEDFB #x71FE)
- (#xEDFA #x71C1)
- (#xEDF9 #xFA15)
- (#xEDF8 #x7147)
- (#xEDF7 #x7146)
- (#xEDF6 #x715C)
- (#xEDF5 #x7104)
- (#xEDF4 #x710F)
- (#xEDF3 #x70AB)
- (#xEDF2 #x7085)
- (#xEDF1 #x7028)
- (#xEDF0 #x7007)
- (#xEDEF #x7005)
- (#xEDEE #x6FF5)
- (#xEDED #x6FB5)
- (#xEDEC #x6F88)
- (#xEDEB #x6EBF)
- (#xEDEA #x6E3C)
- (#xEDE9 #x6E27)
- (#xEDE8 #x6E5C)
- (#xEDE7 #x6E39)
- (#xEDE6 #x6DFC)
- (#xEDE5 #x6DF2)
- (#xEDE4 #x6DF8)
- (#xEDE3 #x6DCF)
- (#xEDE2 #x6DAC)
- (#xEDE1 #x6D96)
- (#xEDE0 #x6D6F)
- (#xEDDF #x6D87)
- (#xEDDE #x6D04)
- (#xEDDD #x6CDA)
- (#xEDDC #x6C6F)
- (#xEDDB #x6C86)
- (#xEDDA #x6C5C)
- (#xEDD9 #x6C3F)
- (#xEDD8 #x6BD6)
- (#xEDD7 #x6AE4)
- (#xEDD6 #x6AE2)
- (#xEDD5 #x6A7E)
- (#xEDD4 #x6A73)
- (#xEDD3 #x6A46)
- (#xEDD2 #x6A6B)
- (#xEDD1 #x6A30)
- (#xEDD0 #x69E2)
- (#xEDCF #x6998)
- (#xEDCE #xFA14)
- (#xEDCD #x6968)
- (#xEDCC #xFA13)
- (#xEDCB #x68CF)
- (#xEDCA #x6844)
- (#xEDC9 #x6801)
- (#xEDC8 #x67C0)
- (#xEDC7 #x6852)
- (#xEDC6 #x67BB)
- (#xEDC5 #x6766)
- (#xEDC4 #xF929)
- (#xEDC3 #x670E)
- (#xEDC2 #x66FA)
- (#xEDC1 #x66BF)
- (#xEDC0 #x66B2)
- (#xEDBF #x66A0)
- (#xEDBE #x6699)
- (#xEDBD #x6673)
- (#xEDBC #xFA12)
- (#xEDBB #x6659)
- (#xEDBA #x6657)
- (#xEDB9 #x6665)
- (#xEDB8 #x6624)
- (#xEDB7 #x661E)
- (#xEDB6 #x662E)
- (#xEDB5 #x6609)
- (#xEDB4 #x663B)
- (#xEDB3 #x6615)
- (#xEDB2 #x6600)
- (#xEDB1 #x654E)
- (#xEDB0 #x64CE)
- (#xEDAF #x649D)
- (#xEDAE #x6460)
- (#xEDAD #x63F5)
- (#xEDAC #x62A6)
- (#xEDAB #x6213)
- (#xEDAA #x6198)
- (#xEDA9 #x6130)
- (#xEDA8 #x6137)
- (#xEDA7 #x6111)
- (#xEDA6 #x60F2)
- (#xEDA5 #x6120)
- (#xEDA4 #x60D5)
- (#xEDA3 #x60DE)
- (#xEDA2 #x608A)
- (#xEDA1 #x6085)
- (#xEDA0 #x605D)
- (#xED9F #x5FDE)
- (#xED9E #x5FB7)
- (#xED9D #x5F67)
- (#xED9C #x5F34)
- (#xED9B #x5F21)
- (#xED9A #x5DD0)
- (#xED99 #x5DB9)
- (#xED98 #x5DB8)
- (#xED97 #x5D6D)
- (#xED96 #x5D42)
- (#xED95 #xFA11)
- (#xED94 #x5D53)
- (#xED93 #x5D27)
- (#xED92 #x5CF5)
- (#xED91 #x5CBA)
- (#xED90 #x5CA6)
- (#xED8F #x5C1E)
- (#xED8E #x5BEC)
- (#xED8D #x5BD8)
- (#xED8C #x752F)
- (#xED8B #x5BC0)
- (#xED8A #x5B56)
- (#xED89 #x59BA)
- (#xED88 #x59A4)
- (#xED87 #x5963)
- (#xED86 #x595D)
- (#xED85 #x595B)
- (#xED84 #x5953)
- (#xED83 #x590B)
- (#xED82 #x58B2)
- (#xED81 #x589E)
- (#xED80 #xFA10)
- (#xED7E #xFA0F)
- (#xED7D #x57C7)
- (#xED7C #x57C8)
- (#xED7B #x57AC)
- (#xED7A #x5765)
- (#xED79 #x5759)
- (#xED78 #x5586)
- (#xED77 #x54FF)
- (#xED76 #x54A9)
- (#xED75 #x548A)
- (#xED74 #x549C)
- (#xED73 #xFA0E)
- (#xED72 #x53DD)
- (#xED71 #x53B2)
- (#xED70 #x5393)
- (#xED6F #x5372)
- (#xED6E #x5324)
- (#xED6D #x5307)
- (#xED6C #x5300)
- (#xED6B #x52DB)
- (#xED6A #x52C0)
- (#xED69 #x52A6)
- (#xED68 #x529C)
- (#xED67 #x5215)
- (#xED66 #x51EC)
- (#xED65 #x51BE)
- (#xED64 #x519D)
- (#xED63 #x5164)
- (#xED62 #x514A)
- (#xED61 #x50D8)
- (#xED60 #x50F4)
- (#xED5F #x5094)
- (#xED5E #x5042)
- (#xED5D #x5070)
- (#xED5C #x5046)
- (#xED5B #x501E)
- (#xED5A #x4FFF)
- (#xED59 #x5022)
- (#xED58 #x5040)
- (#xED57 #x4FCD)
- (#xED56 #x4F94)
- (#xED55 #x4F9A)
- (#xED54 #x4F8A)
- (#xED53 #x4F92)
- (#xED52 #x4F56)
- (#xED51 #x4F39)
- (#xED50 #x4F03)
- (#xED4F #x4F00)
- (#xED4E #x4EFC)
- (#xED4D #x4EE1)
- (#xED4C #x4E28)
- (#xED4B #x5F45)
- (#xED4A #x66FB)
- (#xED49 #x92F9)
- (#xED48 #x68C8)
- (#xED47 #x6631)
- (#xED46 #x70BB)
- (#xED45 #x4FC9)
- (#xED44 #x84DC)
- (#xED43 #x9288)
- (#xED42 #x9348)
- (#xED41 #x891C)
- (#xED40 #x7E8A)
- (#xEA9E #x9FA0)
- (#xEA40 #x9D5D)
- (#xE99E #x9AF7)
- (#xE940 #x9871)
- (#xE89E #x965E)
- (#xE840 #x9319)
- (#xE79E #x8FF8)
- (#xE740 #x8E47)
- (#xE69E #x8B6B)
- (#xE640 #x8966)
- (#xE59E #x8759)
- (#xE540 #x8541)
- (#xE49E #x82D9)
- (#xE440 #x968B)
- (#xE39E #x7F3A)
- (#xE340 #x7D02)
- (#xE29E #x7B50)
- (#xE240 #x78E7)
- (#xE19E #x7670)
- (#xE140 #x74E0)
- (#xE09E #x71FC)
- (#xE040 #x6F3E)
- (#x9F9E #x6CBE)
- (#x9F40 #x6A97)
- (#x9E9E #x68CD)
- (#x9E40 #x66C4)
- (#x9D9E #x64BC)
- (#x9D40 #x621E)
- (#x9C9E #x609A)
- (#x9C40 #x5ED6)
- (#x9B9E #x5C53)
- (#x9B40 #x5978)
- (#x9A9E #x5709)
- (#x9A40 #x54AB)
- (#x999E #x8FA8)
- (#x9940 #x50C9)
- (#x9840 #x84EE)
- (#x979E #x7483)
- (#x9740 #x8AED)
- (#x969E #x6E80)
- (#x9640 #x6CD5)
- (#x959E #x670D)
- (#x9540 #x9F3B)
- (#x949E #x9EA6)
- (#x9440 #x5982)
- (#x939E #x5230)
- (#x9340 #x90B8)
- (#x929E #x5BF5)
- (#x9240 #x53E9)
- (#x919E #x618E)
- (#x9140 #x7E4A)
- (#x909E #x88FE)
- (#x9040 #x62ED)
- (#x8F9E #x511F)
- (#x8F40 #x5B97)
- (#x8E9E #x6642)
- (#x8E40 #x5BDF)
- (#x8D9E #x8FBC)
- (#x8D40 #x540E)
- (#x8C9E #x6372)
- (#x8C40 #x6398)
- (#x8B9E #x4EAC)
- (#x8B40 #x6A5F)
- (#x8A9E #x8431)
- (#x8A40 #x9B41)
- (#x899E #x5FDC)
- (#x8940 #x9662)
- (#x879C #x222A)
- (#x879B #x2229)
- (#x879A #x2235)
- (#x8799 #x22BF)
- (#x8798 #x221F)
- (#x8797 #x2220)
- (#x8796 #x22A5)
- (#x8795 #x221A)
- (#x8794 #x2211)
- (#x8793 #x222E)
- (#x8792 #x222B)
- (#x8791 #x2261)
- (#x8790 #x2252)
- (#x878F #x337C)
- (#x878E #x337D)
- (#x878D #x337E)
- (#x878C #x3239)
- (#x878B #x3232)
- (#x878A #x3231)
- (#x8789 #x32A8)
- (#x8788 #x32A7)
- (#x8787 #x32A6)
- (#x8786 #x32A5)
- (#x8785 #x32A4)
- (#x8784 #x2121)
- (#x8783 #x33CD)
- (#x8782 #x2116)
- (#x8781 #x301F)
- (#x8780 #x301D)
- (#x877E #x337B)
- (#x8775 #x33A1)
- (#x8774 #x33C4)
- (#x8773 #x338F)
- (#x8772 #x338E)
- (#x8771 #x339E)
- (#x8770 #x339D)
- (#x876F #x339C)
- (#x876E #x333B)
- (#x876D #x334A)
- (#x876C #x332B)
- (#x876B #x3323)
- (#x876A #x3326)
- (#x8769 #x330D)
- (#x8768 #x3357)
- (#x8767 #x3351)
- (#x8766 #x3336)
- (#x8765 #x3303)
- (#x8764 #x3327)
- (#x8763 #x3318)
- (#x8762 #x334D)
- (#x8761 #x3322)
- (#x8760 #x3314)
- (#x875F #x3349)
- (#x875D #x2169)
- (#x875C #x2168)
- (#x875B #x2167)
- (#x875A #x2166)
- (#x8759 #x2165)
- (#x8758 #x2164)
- (#x8757 #x2163)
- (#x8756 #x2162)
- (#x8755 #x2161)
- (#x8754 #x2160)
- (#x8753 #x2473)
- (#x8752 #x2472)
- (#x8751 #x2471)
- (#x8750 #x2470)
- (#x874F #x246F)
- (#x874E #x246E)
- (#x874D #x246D)
- (#x874C #x246C)
- (#x874B #x246B)
- (#x874A #x246A)
- (#x8749 #x2469)
- (#x8748 #x2468)
- (#x8747 #x2467)
- (#x8746 #x2466)
- (#x8745 #x2465)
- (#x8744 #x2464)
- (#x8743 #x2463)
- (#x8742 #x2462)
- (#x8741 #x2461)
- (#x8740 #x2460)
- (#x8440 #x410)
- (#x8340 #x30A1)
- (#x819E #x25C7)
- (#x8140 #x3000)
- ))
-
-(defvar *eucjp-only*
- '((#xFEFE #xE3AB)
- (#xFEFD #xE3AA)
- (#xFEFC #xE3A9)
- (#xFEFB #xE3A8)
- (#xFEFA #xE3A7)
- (#xFEF9 #xE3A6)
- (#xFEF8 #xE3A5)
- (#xFEF7 #xE3A4)
- (#xFEF6 #xE3A3)
- (#xFEF5 #xE3A2)
- (#xFEF4 #xE3A1)
- (#xFEF3 #xE3A0)
- (#xFEF2 #xE39F)
- (#xFEF1 #xE39E)
- (#xFEF0 #xE39D)
- (#xFEEF #xE39C)
- (#xFEEE #xE39B)
- (#xFEED #xE39A)
- (#xFEEC #xE399)
- (#xFEEB #xE398)
- (#xFEEA #xE397)
- (#xFEE9 #xE396)
- (#xFEE8 #xE395)
- (#xFEE7 #xE394)
- (#xFEE6 #xE393)
- (#xFEE5 #xE392)
- (#xFEE4 #xE391)
- (#xFEE3 #xE390)
- (#xFEE2 #xE38F)
- (#xFEE1 #xE38E)
- (#xFEE0 #xE38D)
- (#xFEDF #xE38C)
- (#xFEDE #xE38B)
- (#xFEDD #xE38A)
- (#xFEDC #xE389)
- (#xFEDB #xE388)
- (#xFEDA #xE387)
- (#xFED9 #xE386)
- (#xFED8 #xE385)
- (#xFED7 #xE384)
- (#xFED6 #xE383)
- (#xFED5 #xE382)
- (#xFED4 #xE381)
- (#xFED3 #xE380)
- (#xFED2 #xE37F)
- (#xFED1 #xE37E)
- (#xFED0 #xE37D)
- (#xFECF #xE37C)
- (#xFECE #xE37B)
- (#xFECD #xE37A)
- (#xFECC #xE379)
- (#xFECB #xE378)
- (#xFECA #xE377)
- (#xFEC9 #xE376)
- (#xFEC8 #xE375)
- (#xFEC7 #xE374)
- (#xFEC6 #xE373)
- (#xFEC5 #xE372)
- (#xFEC4 #xE371)
- (#xFEC3 #xE370)
- (#xFEC2 #xE36F)
- (#xFEC1 #xE36E)
- (#xFEC0 #xE36D)
- (#xFEBF #xE36C)
- (#xFEBE #xE36B)
- (#xFEBD #xE36A)
- (#xFEBC #xE369)
- (#xFEBB #xE368)
- (#xFEBA #xE367)
- (#xFEB9 #xE366)
- (#xFEB8 #xE365)
- (#xFEB7 #xE364)
- (#xFEB6 #xE363)
- (#xFEB5 #xE362)
- (#xFEB4 #xE361)
- (#xFEB3 #xE360)
- (#xFEB2 #xE35F)
- (#xFEB1 #xE35E)
- (#xFEB0 #xE35D)
- (#xFEAF #xE35C)
- (#xFEAE #xE35B)
- (#xFEAD #xE35A)
- (#xFEAC #xE359)
- (#xFEAB #xE358)
- (#xFEAA #xE357)
- (#xFEA9 #xE356)
- (#xFEA8 #xE355)
- (#xFEA7 #xE354)
- (#xFEA6 #xE353)
- (#xFEA5 #xE352)
- (#xFEA4 #xE351)
- (#xFEA3 #xE350)
- (#xFEA2 #xE34F)
- (#xFEA1 #xE34E)
- (#xFDFE #xE34D)
- (#xFDFD #xE34C)
- (#xFDFC #xE34B)
- (#xFDFB #xE34A)
- (#xFDFA #xE349)
- (#xFDF9 #xE348)
- (#xFDF8 #xE347)
- (#xFDF7 #xE346)
- (#xFDF6 #xE345)
- (#xFDF5 #xE344)
- (#xFDF4 #xE343)
- (#xFDF3 #xE342)
- (#xFDF2 #xE341)
- (#xFDF1 #xE340)
- (#xFDF0 #xE33F)
- (#xFDEF #xE33E)
- (#xFDEE #xE33D)
- (#xFDED #xE33C)
- (#xFDEC #xE33B)
- (#xFDEB #xE33A)
- (#xFDEA #xE339)
- (#xFDE9 #xE338)
- (#xFDE8 #xE337)
- (#xFDE7 #xE336)
- (#xFDE6 #xE335)
- (#xFDE5 #xE334)
- (#xFDE4 #xE333)
- (#xFDE3 #xE332)
- (#xFDE2 #xE331)
- (#xFDE1 #xE330)
- (#xFDE0 #xE32F)
- (#xFDDF #xE32E)
- (#xFDDE #xE32D)
- (#xFDDD #xE32C)
- (#xFDDC #xE32B)
- (#xFDDB #xE32A)
- (#xFDDA #xE329)
- (#xFDD9 #xE328)
- (#xFDD8 #xE327)
- (#xFDD7 #xE326)
- (#xFDD6 #xE325)
- (#xFDD5 #xE324)
- (#xFDD4 #xE323)
- (#xFDD3 #xE322)
- (#xFDD2 #xE321)
- (#xFDD1 #xE320)
- (#xFDD0 #xE31F)
- (#xFDCF #xE31E)
- (#xFDCE #xE31D)
- (#xFDCD #xE31C)
- (#xFDCC #xE31B)
- (#xFDCB #xE31A)
- (#xFDCA #xE319)
- (#xFDC9 #xE318)
- (#xFDC8 #xE317)
- (#xFDC7 #xE316)
- (#xFDC6 #xE315)
- (#xFDC5 #xE314)
- (#xFDC4 #xE313)
- (#xFDC3 #xE312)
- (#xFDC2 #xE311)
- (#xFDC1 #xE310)
- (#xFDC0 #xE30F)
- (#xFDBF #xE30E)
- (#xFDBE #xE30D)
- (#xFDBD #xE30C)
- (#xFDBC #xE30B)
- (#xFDBB #xE30A)
- (#xFDBA #xE309)
- (#xFDB9 #xE308)
- (#xFDB8 #xE307)
- (#xFDB7 #xE306)
- (#xFDB6 #xE305)
- (#xFDB5 #xE304)
- (#xFDB4 #xE303)
- (#xFDB3 #xE302)
- (#xFDB2 #xE301)
- (#xFDB1 #xE300)
- (#xFDB0 #xE2FF)
- (#xFDAF #xE2FE)
- (#xFDAE #xE2FD)
- (#xFDAD #xE2FC)
- (#xFDAC #xE2FB)
- (#xFDAB #xE2FA)
- (#xFDAA #xE2F9)
- (#xFDA9 #xE2F8)
- (#xFDA8 #xE2F7)
- (#xFDA7 #xE2F6)
- (#xFDA6 #xE2F5)
- (#xFDA5 #xE2F4)
- (#xFDA4 #xE2F3)
- (#xFDA3 #xE2F2)
- (#xFDA2 #xE2F1)
- (#xFDA1 #xE2F0)
- (#xFCFE #xE2EF)
- (#xFCFD #xE2EE)
- (#xFCFC #xE2ED)
- (#xFCFB #xE2EC)
- (#xFCFA #xE2EB)
- (#xFCF9 #xE2EA)
- (#xFCF8 #xE2E9)
- (#xFCF7 #xE2E8)
- (#xFCF6 #xE2E7)
- (#xFCF5 #xE2E6)
- (#xFCF4 #xE2E5)
- (#xFCF3 #xE2E4)
- (#xFCF2 #xE2E3)
- (#xFCF1 #xE2E2)
- (#xFCF0 #xE2E1)
- (#xFCEF #xE2E0)
- (#xFCEE #xE2DF)
- (#xFCED #xE2DE)
- (#xFCEC #xE2DD)
- (#xFCEB #xE2DC)
- (#xFCEA #xE2DB)
- (#xFCE9 #xE2DA)
- (#xFCE8 #xE2D9)
- (#xFCE7 #xE2D8)
- (#xFCE6 #xE2D7)
- (#xFCE5 #xE2D6)
- (#xFCE4 #xE2D5)
- (#xFCE3 #xE2D4)
- (#xFCE2 #xE2D3)
- (#xFCE1 #xE2D2)
- (#xFCE0 #xE2D1)
- (#xFCDF #xE2D0)
- (#xFCDE #xE2CF)
- (#xFCDD #xE2CE)
- (#xFCDC #xE2CD)
- (#xFCDB #xE2CC)
- (#xFCDA #xE2CB)
- (#xFCD9 #xE2CA)
- (#xFCD8 #xE2C9)
- (#xFCD7 #xE2C8)
- (#xFCD6 #xE2C7)
- (#xFCD5 #xE2C6)
- (#xFCD4 #xE2C5)
- (#xFCD3 #xE2C4)
- (#xFCD2 #xE2C3)
- (#xFCD1 #xE2C2)
- (#xFCD0 #xE2C1)
- (#xFCCF #xE2C0)
- (#xFCCE #xE2BF)
- (#xFCCD #xE2BE)
- (#xFCCC #xE2BD)
- (#xFCCB #xE2BC)
- (#xFCCA #xE2BB)
- (#xFCC9 #xE2BA)
- (#xFCC8 #xE2B9)
- (#xFCC7 #xE2B8)
- (#xFCC6 #xE2B7)
- (#xFCC5 #xE2B6)
- (#xFCC4 #xE2B5)
- (#xFCC3 #xE2B4)
- (#xFCC2 #xE2B3)
- (#xFCC1 #xE2B2)
- (#xFCC0 #xE2B1)
- (#xFCBF #xE2B0)
- (#xFCBE #xE2AF)
- (#xFCBD #xE2AE)
- (#xFCBC #xE2AD)
- (#xFCBB #xE2AC)
- (#xFCBA #xE2AB)
- (#xFCB9 #xE2AA)
- (#xFCB8 #xE2A9)
- (#xFCB7 #xE2A8)
- (#xFCB6 #xE2A7)
- (#xFCB5 #xE2A6)
- (#xFCB4 #xE2A5)
- (#xFCB3 #xE2A4)
- (#xFCB2 #xE2A3)
- (#xFCB1 #xE2A2)
- (#xFCB0 #xE2A1)
- (#xFCAF #xE2A0)
- (#xFCAE #xE29F)
- (#xFCAD #xE29E)
- (#xFCAC #xE29D)
- (#xFCAB #xE29C)
- (#xFCAA #xE29B)
- (#xFCA9 #xE29A)
- (#xFCA8 #xE299)
- (#xFCA7 #xE298)
- (#xFCA6 #xE297)
- (#xFCA5 #xE296)
- (#xFCA4 #xE295)
- (#xFCA3 #xE294)
- (#xFCA2 #xE293)
- (#xFCA1 #xE292)
- (#xFBFE #xE291)
- (#xFBFD #xE290)
- (#xFBFC #xE28F)
- (#xFBFB #xE28E)
- (#xFBFA #xE28D)
- (#xFBF9 #xE28C)
- (#xFBF8 #xE28B)
- (#xFBF7 #xE28A)
- (#xFBF6 #xE289)
- (#xFBF5 #xE288)
- (#xFBF4 #xE287)
- (#xFBF3 #xE286)
- (#xFBF2 #xE285)
- (#xFBF1 #xE284)
- (#xFBF0 #xE283)
- (#xFBEF #xE282)
- (#xFBEE #xE281)
- (#xFBED #xE280)
- (#xFBEC #xE27F)
- (#xFBEB #xE27E)
- (#xFBEA #xE27D)
- (#xFBE9 #xE27C)
- (#xFBE8 #xE27B)
- (#xFBE7 #xE27A)
- (#xFBE6 #xE279)
- (#xFBE5 #xE278)
- (#xFBE4 #xE277)
- (#xFBE3 #xE276)
- (#xFBE2 #xE275)
- (#xFBE1 #xE274)
- (#xFBE0 #xE273)
- (#xFBDF #xE272)
- (#xFBDE #xE271)
- (#xFBDD #xE270)
- (#xFBDC #xE26F)
- (#xFBDB #xE26E)
- (#xFBDA #xE26D)
- (#xFBD9 #xE26C)
- (#xFBD8 #xE26B)
- (#xFBD7 #xE26A)
- (#xFBD6 #xE269)
- (#xFBD5 #xE268)
- (#xFBD4 #xE267)
- (#xFBD3 #xE266)
- (#xFBD2 #xE265)
- (#xFBD1 #xE264)
- (#xFBD0 #xE263)
- (#xFBCF #xE262)
- (#xFBCE #xE261)
- (#xFBCD #xE260)
- (#xFBCC #xE25F)
- (#xFBCB #xE25E)
- (#xFBCA #xE25D)
- (#xFBC9 #xE25C)
- (#xFBC8 #xE25B)
- (#xFBC7 #xE25A)
- (#xFBC6 #xE259)
- (#xFBC5 #xE258)
- (#xFBC4 #xE257)
- (#xFBC3 #xE256)
- (#xFBC2 #xE255)
- (#xFBC1 #xE254)
- (#xFBC0 #xE253)
- (#xFBBF #xE252)
- (#xFBBE #xE251)
- (#xFBBD #xE250)
- (#xFBBC #xE24F)
- (#xFBBB #xE24E)
- (#xFBBA #xE24D)
- (#xFBB9 #xE24C)
- (#xFBB8 #xE24B)
- (#xFBB7 #xE24A)
- (#xFBB6 #xE249)
- (#xFBB5 #xE248)
- (#xFBB4 #xE247)
- (#xFBB3 #xE246)
- (#xFBB2 #xE245)
- (#xFBB1 #xE244)
- (#xFBB0 #xE243)
- (#xFBAF #xE242)
- (#xFBAE #xE241)
- (#xFBAD #xE240)
- (#xFBAC #xE23F)
- (#xFBAB #xE23E)
- (#xFBAA #xE23D)
- (#xFBA9 #xE23C)
- (#xFBA8 #xE23B)
- (#xFBA7 #xE23A)
- (#xFBA6 #xE239)
- (#xFBA5 #xE238)
- (#xFBA4 #xE237)
- (#xFBA3 #xE236)
- (#xFBA2 #xE235)
- (#xFBA1 #xE234)
- (#xFAFE #xE233)
- (#xFAFD #xE232)
- (#xFAFC #xE231)
- (#xFAFB #xE230)
- (#xFAFA #xE22F)
- (#xFAF9 #xE22E)
- (#xFAF8 #xE22D)
- (#xFAF7 #xE22C)
- (#xFAF6 #xE22B)
- (#xFAF5 #xE22A)
- (#xFAF4 #xE229)
- (#xFAF3 #xE228)
- (#xFAF2 #xE227)
- (#xFAF1 #xE226)
- (#xFAF0 #xE225)
- (#xFAEF #xE224)
- (#xFAEE #xE223)
- (#xFAED #xE222)
- (#xFAEC #xE221)
- (#xFAEB #xE220)
- (#xFAEA #xE21F)
- (#xFAE9 #xE21E)
- (#xFAE8 #xE21D)
- (#xFAE7 #xE21C)
- (#xFAE6 #xE21B)
- (#xFAE5 #xE21A)
- (#xFAE4 #xE219)
- (#xFAE3 #xE218)
- (#xFAE2 #xE217)
- (#xFAE1 #xE216)
- (#xFAE0 #xE215)
- (#xFADF #xE214)
- (#xFADE #xE213)
- (#xFADD #xE212)
- (#xFADC #xE211)
- (#xFADB #xE210)
- (#xFADA #xE20F)
- (#xFAD9 #xE20E)
- (#xFAD8 #xE20D)
- (#xFAD7 #xE20C)
- (#xFAD6 #xE20B)
- (#xFAD5 #xE20A)
- (#xFAD4 #xE209)
- (#xFAD3 #xE208)
- (#xFAD2 #xE207)
- (#xFAD1 #xE206)
- (#xFAD0 #xE205)
- (#xFACF #xE204)
- (#xFACE #xE203)
- (#xFACD #xE202)
- (#xFACC #xE201)
- (#xFACB #xE200)
- (#xFACA #xE1FF)
- (#xFAC9 #xE1FE)
- (#xFAC8 #xE1FD)
- (#xFAC7 #xE1FC)
- (#xFAC6 #xE1FB)
- (#xFAC5 #xE1FA)
- (#xFAC4 #xE1F9)
- (#xFAC3 #xE1F8)
- (#xFAC2 #xE1F7)
- (#xFAC1 #xE1F6)
- (#xFAC0 #xE1F5)
- (#xFABF #xE1F4)
- (#xFABE #xE1F3)
- (#xFABD #xE1F2)
- (#xFABC #xE1F1)
- (#xFABB #xE1F0)
- (#xFABA #xE1EF)
- (#xFAB9 #xE1EE)
- (#xFAB8 #xE1ED)
- (#xFAB7 #xE1EC)
- (#xFAB6 #xE1EB)
- (#xFAB5 #xE1EA)
- (#xFAB4 #xE1E9)
- (#xFAB3 #xE1E8)
- (#xFAB2 #xE1E7)
- (#xFAB1 #xE1E6)
- (#xFAB0 #xE1E5)
- (#xFAAF #xE1E4)
- (#xFAAE #xE1E3)
- (#xFAAD #xE1E2)
- (#xFAAC #xE1E1)
- (#xFAAB #xE1E0)
- (#xFAAA #xE1DF)
- (#xFAA9 #xE1DE)
- (#xFAA8 #xE1DD)
- (#xFAA7 #xE1DC)
- (#xFAA6 #xE1DB)
- (#xFAA5 #xE1DA)
- (#xFAA4 #xE1D9)
- (#xFAA3 #xE1D8)
- (#xFAA2 #xE1D7)
- (#xFAA1 #xE1D6)
- (#xF9FE #xE1D5)
- (#xF9FD #xE1D4)
- (#xF9FC #xE1D3)
- (#xF9FB #xE1D2)
- (#xF9FA #xE1D1)
- (#xF9F9 #xE1D0)
- (#xF9F8 #xE1CF)
- (#xF9F7 #xE1CE)
- (#xF9F6 #xE1CD)
- (#xF9F5 #xE1CC)
- (#xF9F4 #xE1CB)
- (#xF9F3 #xE1CA)
- (#xF9F2 #xE1C9)
- (#xF9F1 #xE1C8)
- (#xF9F0 #xE1C7)
- (#xF9EF #xE1C6)
- (#xF9EE #xE1C5)
- (#xF9ED #xE1C4)
- (#xF9EC #xE1C3)
- (#xF9EB #xE1C2)
- (#xF9EA #xE1C1)
- (#xF9E9 #xE1C0)
- (#xF9E8 #xE1BF)
- (#xF9E7 #xE1BE)
- (#xF9E6 #xE1BD)
- (#xF9E5 #xE1BC)
- (#xF9E4 #xE1BB)
- (#xF9E3 #xE1BA)
- (#xF9E2 #xE1B9)
- (#xF9E1 #xE1B8)
- (#xF9E0 #xE1B7)
- (#xF9DF #xE1B6)
- (#xF9DE #xE1B5)
- (#xF9DD #xE1B4)
- (#xF9DC #xE1B3)
- (#xF9DB #xE1B2)
- (#xF9DA #xE1B1)
- (#xF9D9 #xE1B0)
- (#xF9D8 #xE1AF)
- (#xF9D7 #xE1AE)
- (#xF9D6 #xE1AD)
- (#xF9D5 #xE1AC)
- (#xF9D4 #xE1AB)
- (#xF9D3 #xE1AA)
- (#xF9D2 #xE1A9)
- (#xF9D1 #xE1A8)
- (#xF9D0 #xE1A7)
- (#xF9CF #xE1A6)
- (#xF9CE #xE1A5)
- (#xF9CD #xE1A4)
- (#xF9CC #xE1A3)
- (#xF9CB #xE1A2)
- (#xF9CA #xE1A1)
- (#xF9C9 #xE1A0)
- (#xF9C8 #xE19F)
- (#xF9C7 #xE19E)
- (#xF9C6 #xE19D)
- (#xF9C5 #xE19C)
- (#xF9C4 #xE19B)
- (#xF9C3 #xE19A)
- (#xF9C2 #xE199)
- (#xF9C1 #xE198)
- (#xF9C0 #xE197)
- (#xF9BF #xE196)
- (#xF9BE #xE195)
- (#xF9BD #xE194)
- (#xF9BC #xE193)
- (#xF9BB #xE192)
- (#xF9BA #xE191)
- (#xF9B9 #xE190)
- (#xF9B8 #xE18F)
- (#xF9B7 #xE18E)
- (#xF9B6 #xE18D)
- (#xF9B5 #xE18C)
- (#xF9B4 #xE18B)
- (#xF9B3 #xE18A)
- (#xF9B2 #xE189)
- (#xF9B1 #xE188)
- (#xF9B0 #xE187)
- (#xF9AF #xE186)
- (#xF9AE #xE185)
- (#xF9AD #xE184)
- (#xF9AC #xE183)
- (#xF9AB #xE182)
- (#xF9AA #xE181)
- (#xF9A9 #xE180)
- (#xF9A8 #xE17F)
- (#xF9A7 #xE17E)
- (#xF9A6 #xE17D)
- (#xF9A5 #xE17C)
- (#xF9A4 #xE17B)
- (#xF9A3 #xE17A)
- (#xF9A2 #xE179)
- (#xF9A1 #xE178)
- (#xF8FE #xE177)
- (#xF8FD #xE176)
- (#xF8FC #xE175)
- (#xF8FB #xE174)
- (#xF8FA #xE173)
- (#xF8F9 #xE172)
- (#xF8F8 #xE171)
- (#xF8F7 #xE170)
- (#xF8F6 #xE16F)
- (#xF8F5 #xE16E)
- (#xF8F4 #xE16D)
- (#xF8F3 #xE16C)
- (#xF8F2 #xE16B)
- (#xF8F1 #xE16A)
- (#xF8F0 #xE169)
- (#xF8EF #xE168)
- (#xF8EE #xE167)
- (#xF8ED #xE166)
- (#xF8EC #xE165)
- (#xF8EB #xE164)
- (#xF8EA #xE163)
- (#xF8E9 #xE162)
- (#xF8E8 #xE161)
- (#xF8E7 #xE160)
- (#xF8E6 #xE15F)
- (#xF8E5 #xE15E)
- (#xF8E4 #xE15D)
- (#xF8E3 #xE15C)
- (#xF8E2 #xE15B)
- (#xF8E1 #xE15A)
- (#xF8E0 #xE159)
- (#xF8DF #xE158)
- (#xF8DE #xE157)
- (#xF8DD #xE156)
- (#xF8DC #xE155)
- (#xF8DB #xE154)
- (#xF8DA #xE153)
- (#xF8D9 #xE152)
- (#xF8D8 #xE151)
- (#xF8D7 #xE150)
- (#xF8D6 #xE14F)
- (#xF8D5 #xE14E)
- (#xF8D4 #xE14D)
- (#xF8D3 #xE14C)
- (#xF8D2 #xE14B)
- (#xF8D1 #xE14A)
- (#xF8D0 #xE149)
- (#xF8CF #xE148)
- (#xF8CE #xE147)
- (#xF8CD #xE146)
- (#xF8CC #xE145)
- (#xF8CB #xE144)
- (#xF8CA #xE143)
- (#xF8C9 #xE142)
- (#xF8C8 #xE141)
- (#xF8C7 #xE140)
- (#xF8C6 #xE13F)
- (#xF8C5 #xE13E)
- (#xF8C4 #xE13D)
- (#xF8C3 #xE13C)
- (#xF8C2 #xE13B)
- (#xF8C1 #xE13A)
- (#xF8C0 #xE139)
- (#xF8BF #xE138)
- (#xF8BE #xE137)
- (#xF8BD #xE136)
- (#xF8BC #xE135)
- (#xF8BB #xE134)
- (#xF8BA #xE133)
- (#xF8B9 #xE132)
- (#xF8B8 #xE131)
- (#xF8B7 #xE130)
- (#xF8B6 #xE12F)
- (#xF8B5 #xE12E)
- (#xF8B4 #xE12D)
- (#xF8B3 #xE12C)
- (#xF8B2 #xE12B)
- (#xF8B1 #xE12A)
- (#xF8B0 #xE129)
- (#xF8AF #xE128)
- (#xF8AE #xE127)
- (#xF8AD #xE126)
- (#xF8AC #xE125)
- (#xF8AB #xE124)
- (#xF8AA #xE123)
- (#xF8A9 #xE122)
- (#xF8A8 #xE121)
- (#xF8A7 #xE120)
- (#xF8A6 #xE11F)
- (#xF8A5 #xE11E)
- (#xF8A4 #xE11D)
- (#xF8A3 #xE11C)
- (#xF8A2 #xE11B)
- (#xF8A1 #xE11A)
- (#xF7FE #xE119)
- (#xF7FD #xE118)
- (#xF7FC #xE117)
- (#xF7FB #xE116)
- (#xF7FA #xE115)
- (#xF7F9 #xE114)
- (#xF7F8 #xE113)
- (#xF7F7 #xE112)
- (#xF7F6 #xE111)
- (#xF7F5 #xE110)
- (#xF7F4 #xE10F)
- (#xF7F3 #xE10E)
- (#xF7F2 #xE10D)
- (#xF7F1 #xE10C)
- (#xF7F0 #xE10B)
- (#xF7EF #xE10A)
- (#xF7EE #xE109)
- (#xF7ED #xE108)
- (#xF7EC #xE107)
- (#xF7EB #xE106)
- (#xF7EA #xE105)
- (#xF7E9 #xE104)
- (#xF7E8 #xE103)
- (#xF7E7 #xE102)
- (#xF7E6 #xE101)
- (#xF7E5 #xE100)
- (#xF7E4 #xE0FF)
- (#xF7E3 #xE0FE)
- (#xF7E2 #xE0FD)
- (#xF7E1 #xE0FC)
- (#xF7E0 #xE0FB)
- (#xF7DF #xE0FA)
- (#xF7DE #xE0F9)
- (#xF7DD #xE0F8)
- (#xF7DC #xE0F7)
- (#xF7DB #xE0F6)
- (#xF7DA #xE0F5)
- (#xF7D9 #xE0F4)
- (#xF7D8 #xE0F3)
- (#xF7D7 #xE0F2)
- (#xF7D6 #xE0F1)
- (#xF7D5 #xE0F0)
- (#xF7D4 #xE0EF)
- (#xF7D3 #xE0EE)
- (#xF7D2 #xE0ED)
- (#xF7D1 #xE0EC)
- (#xF7D0 #xE0EB)
- (#xF7CF #xE0EA)
- (#xF7CE #xE0E9)
- (#xF7CD #xE0E8)
- (#xF7CC #xE0E7)
- (#xF7CB #xE0E6)
- (#xF7CA #xE0E5)
- (#xF7C9 #xE0E4)
- (#xF7C8 #xE0E3)
- (#xF7C7 #xE0E2)
- (#xF7C6 #xE0E1)
- (#xF7C5 #xE0E0)
- (#xF7C4 #xE0DF)
- (#xF7C3 #xE0DE)
- (#xF7C2 #xE0DD)
- (#xF7C1 #xE0DC)
- (#xF7C0 #xE0DB)
- (#xF7BF #xE0DA)
- (#xF7BE #xE0D9)
- (#xF7BD #xE0D8)
- (#xF7BC #xE0D7)
- (#xF7BB #xE0D6)
- (#xF7BA #xE0D5)
- (#xF7B9 #xE0D4)
- (#xF7B8 #xE0D3)
- (#xF7B7 #xE0D2)
- (#xF7B6 #xE0D1)
- (#xF7B5 #xE0D0)
- (#xF7B4 #xE0CF)
- (#xF7B3 #xE0CE)
- (#xF7B2 #xE0CD)
- (#xF7B1 #xE0CC)
- (#xF7B0 #xE0CB)
- (#xF7AF #xE0CA)
- (#xF7AE #xE0C9)
- (#xF7AD #xE0C8)
- (#xF7AC #xE0C7)
- (#xF7AB #xE0C6)
- (#xF7AA #xE0C5)
- (#xF7A9 #xE0C4)
- (#xF7A8 #xE0C3)
- (#xF7A7 #xE0C2)
- (#xF7A6 #xE0C1)
- (#xF7A5 #xE0C0)
- (#xF7A4 #xE0BF)
- (#xF7A3 #xE0BE)
- (#xF7A2 #xE0BD)
- (#xF7A1 #xE0BC)
- (#xF6FE #xE0BB)
- (#xF6FD #xE0BA)
- (#xF6FC #xE0B9)
- (#xF6FB #xE0B8)
- (#xF6FA #xE0B7)
- (#xF6F9 #xE0B6)
- (#xF6F8 #xE0B5)
- (#xF6F7 #xE0B4)
- (#xF6F6 #xE0B3)
- (#xF6F5 #xE0B2)
- (#xF6F4 #xE0B1)
- (#xF6F3 #xE0B0)
- (#xF6F2 #xE0AF)
- (#xF6F1 #xE0AE)
- (#xF6F0 #xE0AD)
- (#xF6EF #xE0AC)
- (#xF6EE #xE0AB)
- (#xF6ED #xE0AA)
- (#xF6EC #xE0A9)
- (#xF6EB #xE0A8)
- (#xF6EA #xE0A7)
- (#xF6E9 #xE0A6)
- (#xF6E8 #xE0A5)
- (#xF6E7 #xE0A4)
- (#xF6E6 #xE0A3)
- (#xF6E5 #xE0A2)
- (#xF6E4 #xE0A1)
- (#xF6E3 #xE0A0)
- (#xF6E2 #xE09F)
- (#xF6E1 #xE09E)
- (#xF6E0 #xE09D)
- (#xF6DF #xE09C)
- (#xF6DE #xE09B)
- (#xF6DD #xE09A)
- (#xF6DC #xE099)
- (#xF6DB #xE098)
- (#xF6DA #xE097)
- (#xF6D9 #xE096)
- (#xF6D8 #xE095)
- (#xF6D7 #xE094)
- (#xF6D6 #xE093)
- (#xF6D5 #xE092)
- (#xF6D4 #xE091)
- (#xF6D3 #xE090)
- (#xF6D2 #xE08F)
- (#xF6D1 #xE08E)
- (#xF6D0 #xE08D)
- (#xF6CF #xE08C)
- (#xF6CE #xE08B)
- (#xF6CD #xE08A)
- (#xF6CC #xE089)
- (#xF6CB #xE088)
- (#xF6CA #xE087)
- (#xF6C9 #xE086)
- (#xF6C8 #xE085)
- (#xF6C7 #xE084)
- (#xF6C6 #xE083)
- (#xF6C5 #xE082)
- (#xF6C4 #xE081)
- (#xF6C3 #xE080)
- (#xF6C2 #xE07F)
- (#xF6C1 #xE07E)
- (#xF6C0 #xE07D)
- (#xF6BF #xE07C)
- (#xF6BE #xE07B)
- (#xF6BD #xE07A)
- (#xF6BC #xE079)
- (#xF6BB #xE078)
- (#xF6BA #xE077)
- (#xF6B9 #xE076)
- (#xF6B8 #xE075)
- (#xF6B7 #xE074)
- (#xF6B6 #xE073)
- (#xF6B5 #xE072)
- (#xF6B4 #xE071)
- (#xF6B3 #xE070)
- (#xF6B2 #xE06F)
- (#xF6B1 #xE06E)
- (#xF6B0 #xE06D)
- (#xF6AF #xE06C)
- (#xF6AE #xE06B)
- (#xF6AD #xE06A)
- (#xF6AC #xE069)
- (#xF6AB #xE068)
- (#xF6AA #xE067)
- (#xF6A9 #xE066)
- (#xF6A8 #xE065)
- (#xF6A7 #xE064)
- (#xF6A6 #xE063)
- (#xF6A5 #xE062)
- (#xF6A4 #xE061)
- (#xF6A3 #xE060)
- (#xF6A2 #xE05F)
- (#xF6A1 #xE05E)
- (#xF5FE #xE05D)
- (#xF5FD #xE05C)
- (#xF5FC #xE05B)
- (#xF5FB #xE05A)
- (#xF5FA #xE059)
- (#xF5F9 #xE058)
- (#xF5F8 #xE057)
- (#xF5F7 #xE056)
- (#xF5F6 #xE055)
- (#xF5F5 #xE054)
- (#xF5F4 #xE053)
- (#xF5F3 #xE052)
- (#xF5F2 #xE051)
- (#xF5F1 #xE050)
- (#xF5F0 #xE04F)
- (#xF5EF #xE04E)
- (#xF5EE #xE04D)
- (#xF5ED #xE04C)
- (#xF5EC #xE04B)
- (#xF5EB #xE04A)
- (#xF5EA #xE049)
- (#xF5E9 #xE048)
- (#xF5E8 #xE047)
- (#xF5E7 #xE046)
- (#xF5E6 #xE045)
- (#xF5E5 #xE044)
- (#xF5E4 #xE043)
- (#xF5E3 #xE042)
- (#xF5E2 #xE041)
- (#xF5E1 #xE040)
- (#xF5E0 #xE03F)
- (#xF5DF #xE03E)
- (#xF5DE #xE03D)
- (#xF5DD #xE03C)
- (#xF5DC #xE03B)
- (#xF5DB #xE03A)
- (#xF5DA #xE039)
- (#xF5D9 #xE038)
- (#xF5D8 #xE037)
- (#xF5D7 #xE036)
- (#xF5D6 #xE035)
- (#xF5D5 #xE034)
- (#xF5D4 #xE033)
- (#xF5D3 #xE032)
- (#xF5D2 #xE031)
- (#xF5D1 #xE030)
- (#xF5D0 #xE02F)
- (#xF5CF #xE02E)
- (#xF5CE #xE02D)
- (#xF5CD #xE02C)
- (#xF5CC #xE02B)
- (#xF5CB #xE02A)
- (#xF5CA #xE029)
- (#xF5C9 #xE028)
- (#xF5C8 #xE027)
- (#xF5C7 #xE026)
- (#xF5C6 #xE025)
- (#xF5C5 #xE024)
- (#xF5C4 #xE023)
- (#xF5C3 #xE022)
- (#xF5C2 #xE021)
- (#xF5C1 #xE020)
- (#xF5C0 #xE01F)
- (#xF5BF #xE01E)
- (#xF5BE #xE01D)
- (#xF5BD #xE01C)
- (#xF5BC #xE01B)
- (#xF5BB #xE01A)
- (#xF5BA #xE019)
- (#xF5B9 #xE018)
- (#xF5B8 #xE017)
- (#xF5B7 #xE016)
- (#xF5B6 #xE015)
- (#xF5B5 #xE014)
- (#xF5B4 #xE013)
- (#xF5B3 #xE012)
- (#xF5B2 #xE011)
- (#xF5B1 #xE010)
- (#xF5B0 #xE00F)
- (#xF5AF #xE00E)
- (#xF5AE #xE00D)
- (#xF5AD #xE00C)
- (#xF5AC #xE00B)
- (#xF5AB #xE00A)
- (#xF5AA #xE009)
- (#xF5A9 #xE008)
- (#xF5A8 #xE007)
- (#xF5A7 #xE006)
- (#xF5A6 #xE005)
- (#xF5A5 #xE004)
- (#xF5A4 #xE003)
- (#xF5A3 #xE002)
- (#xF5A2 #xE001)
- (#xF5A1 #xE000)
- ))
-
-(defvar *eucjp*
- '((#x8FA2AF #x2D8)
- (#x8FA2B0 #x2C7)
- (#x8FA2B1 #xB8)
- (#x8FA2B2 #x2D9)
- (#x8FA2B3 #x2DD)
- (#x8FA2B4 #xAF)
- (#x8FA2B5 #x2DB)
- (#x8FA2B6 #x2DA)
- (#x8FA2B7 #xFF5E)
- (#x8FA2B8 #x384)
- (#x8FA2B9 #x385)
- (#x8FA2C2 #xA1)
- (#x8FA2C3 #xA6)
- (#x8FA2C4 #xBF)
- (#x8FA2EB #xBA)
- (#x8FA2EC #xAA)
- (#x8FA2ED #xA9)
- (#x8FA2EE #xAE)
- (#x8FA2EF #x2122)
- (#x8FA2F0 #xA4)
- (#x8FA2F1 #x2116)
- (#x8FA6E1 #x386)
- (#x8FA6E2 #x388)
- (#x8FA6E3 #x389)
- (#x8FA6E4 #x38A)
- (#x8FA6E5 #x3AA)
- (#x8FA6E7 #x38C)
- (#x8FA6E9 #x38E)
- (#x8FA6EA #x3AB)
- (#x8FA6EC #x38F)
- (#x8FA6F1 #x3AC)
- (#x8FA6F2 #x3AD)
- (#x8FA6F3 #x3AE)
- (#x8FA6F4 #x3AF)
- (#x8FA6F5 #x3CA)
- (#x8FA6F6 #x390)
- (#x8FA6F7 #x3CC)
- (#x8FA6F8 #x3C2)
- (#x8FA6F9 #x3CD)
- (#x8FA6FA #x3CB)
- (#x8FA6FB #x3B0)
- (#x8FA6FC #x3CE)
- (#x8FA7C2 #x402)
- (#x8FA7C3 #x403)
- (#x8FA7C4 #x404)
- (#x8FA7C5 #x405)
- (#x8FA7C6 #x406)
- (#x8FA7C7 #x407)
- (#x8FA7C8 #x408)
- (#x8FA7C9 #x409)
- (#x8FA7CA #x40A)
- (#x8FA7CB #x40B)
- (#x8FA7CC #x40C)
- (#x8FA7CD #x40E)
- (#x8FA7CE #x40F)
- (#x8FA7F2 #x452)
- (#x8FA7F3 #x453)
- (#x8FA7F4 #x454)
- (#x8FA7F5 #x455)
- (#x8FA7F6 #x456)
- (#x8FA7F7 #x457)
- (#x8FA7F8 #x458)
- (#x8FA7F9 #x459)
- (#x8FA7FA #x45A)
- (#x8FA7FB #x45B)
- (#x8FA7FC #x45C)
- (#x8FA7FD #x45E)
- (#x8FA7FE #x45F)
- (#x8FA9A1 #xC6)
- (#x8FA9A2 #x110)
- (#x8FA9A4 #x126)
- (#x8FA9A6 #x132)
- (#x8FA9A8 #x141)
- (#x8FA9A9 #x13F)
- (#x8FA9AB #x14A)
- (#x8FA9AC #xD8)
- (#x8FA9AD #x152)
- (#x8FA9AF #x166)
- (#x8FA9B0 #xDE)
- (#x8FA9C1 #xE6)
- (#x8FA9C2 #x111)
- (#x8FA9C3 #xF0)
- (#x8FA9C4 #x127)
- (#x8FA9C5 #x131)
- (#x8FA9C6 #x133)
- (#x8FA9C7 #x138)
- (#x8FA9C8 #x142)
- (#x8FA9C9 #x140)
- (#x8FA9CA #x149)
- (#x8FA9CB #x14B)
- (#x8FA9CC #xF8)
- (#x8FA9CD #x153)
- (#x8FA9CE #xDF)
- (#x8FA9CF #x167)
- (#x8FA9D0 #xFE)
- (#x8FAAA1 #xC1)
- (#x8FAAA2 #xC0)
- (#x8FAAA3 #xC4)
- (#x8FAAA4 #xC2)
- (#x8FAAA5 #x102)
- (#x8FAAA6 #x1CD)
- (#x8FAAA7 #x100)
- (#x8FAAA8 #x104)
- (#x8FAAA9 #xC5)
- (#x8FAAAA #xC3)
- (#x8FAAAB #x106)
- (#x8FAAAC #x108)
- (#x8FAAAD #x10C)
- (#x8FAAAE #xC7)
- (#x8FAAAF #x10A)
- (#x8FAAB0 #x10E)
- (#x8FAAB1 #xC9)
- (#x8FAAB2 #xC8)
- (#x8FAAB3 #xCB)
- (#x8FAAB4 #xCA)
- (#x8FAAB5 #x11A)
- (#x8FAAB6 #x116)
- (#x8FAAB7 #x112)
- (#x8FAAB8 #x118)
- (#x8FAABA #x11C)
- (#x8FAABB #x11E)
- (#x8FAABC #x122)
- (#x8FAABD #x120)
- (#x8FAABE #x124)
- (#x8FAABF #xCD)
- (#x8FAAC0 #xCC)
- (#x8FAAC1 #xCF)
- (#x8FAAC2 #xCE)
- (#x8FAAC3 #x1CF)
- (#x8FAAC4 #x130)
- (#x8FAAC5 #x12A)
- (#x8FAAC6 #x12E)
- (#x8FAAC7 #x128)
- (#x8FAAC8 #x134)
- (#x8FAAC9 #x136)
- (#x8FAACA #x139)
- (#x8FAACB #x13D)
- (#x8FAACC #x13B)
- (#x8FAACD #x143)
- (#x8FAACE #x147)
- (#x8FAACF #x145)
- (#x8FAAD0 #xD1)
- (#x8FAAD1 #xD3)
- (#x8FAAD2 #xD2)
- (#x8FAAD3 #xD6)
- (#x8FAAD4 #xD4)
- (#x8FAAD5 #x1D1)
- (#x8FAAD6 #x150)
- (#x8FAAD7 #x14C)
- (#x8FAAD8 #xD5)
- (#x8FAAD9 #x154)
- (#x8FAADA #x158)
- (#x8FAADB #x156)
- (#x8FAADC #x15A)
- (#x8FAADD #x15C)
- (#x8FAADE #x160)
- (#x8FAADF #x15E)
- (#x8FAAE0 #x164)
- (#x8FAAE1 #x162)
- (#x8FAAE2 #xDA)
- (#x8FAAE3 #xD9)
- (#x8FAAE4 #xDC)
- (#x8FAAE5 #xDB)
- (#x8FAAE6 #x16C)
- (#x8FAAE7 #x1D3)
- (#x8FAAE8 #x170)
- (#x8FAAE9 #x16A)
- (#x8FAAEA #x172)
- (#x8FAAEB #x16E)
- (#x8FAAEC #x168)
- (#x8FAAED #x1D7)
- (#x8FAAEE #x1DB)
- (#x8FAAEF #x1D9)
- (#x8FAAF0 #x1D5)
- (#x8FAAF1 #x174)
- (#x8FAAF2 #xDD)
- (#x8FAAF3 #x178)
- (#x8FAAF4 #x176)
- (#x8FAAF5 #x179)
- (#x8FAAF6 #x17D)
- (#x8FAAF7 #x17B)
- (#x8FABA1 #xE1)
- (#x8FABA2 #xE0)
- (#x8FABA3 #xE4)
- (#x8FABA4 #xE2)
- (#x8FABA5 #x103)
- (#x8FABA6 #x1CE)
- (#x8FABA7 #x101)
- (#x8FABA8 #x105)
- (#x8FABA9 #xE5)
- (#x8FABAA #xE3)
- (#x8FABAB #x107)
- (#x8FABAC #x109)
- (#x8FABAD #x10D)
- (#x8FABAE #xE7)
- (#x8FABAF #x10B)
- (#x8FABB0 #x10F)
- (#x8FABB1 #xE9)
- (#x8FABB2 #xE8)
- (#x8FABB3 #xEB)
- (#x8FABB4 #xEA)
- (#x8FABB5 #x11B)
- (#x8FABB6 #x117)
- (#x8FABB7 #x113)
- (#x8FABB8 #x119)
- (#x8FABB9 #x1F5)
- (#x8FABBA #x11D)
- (#x8FABBB #x11F)
- (#x8FABBD #x121)
- (#x8FABBE #x125)
- (#x8FABBF #xED)
- (#x8FABC0 #xEC)
- (#x8FABC1 #xEF)
- (#x8FABC2 #xEE)
- (#x8FABC3 #x1D0)
- (#x8FABC5 #x12B)
- (#x8FABC6 #x12F)
- (#x8FABC7 #x129)
- (#x8FABC8 #x135)
- (#x8FABC9 #x137)
- (#x8FABCA #x13A)
- (#x8FABCB #x13E)
- (#x8FABCC #x13C)
- (#x8FABCD #x144)
- (#x8FABCE #x148)
- (#x8FABCF #x146)
- (#x8FABD0 #xF1)
- (#x8FABD1 #xF3)
- (#x8FABD2 #xF2)
- (#x8FABD3 #xF6)
- (#x8FABD4 #xF4)
- (#x8FABD5 #x1D2)
- (#x8FABD6 #x151)
- (#x8FABD7 #x14D)
- (#x8FABD8 #xF5)
- (#x8FABD9 #x155)
- (#x8FABDA #x159)
- (#x8FABDB #x157)
- (#x8FABDC #x15B)
- (#x8FABDD #x15D)
- (#x8FABDE #x161)
- (#x8FABDF #x15F)
- (#x8FABE0 #x165)
- (#x8FABE1 #x163)
- (#x8FABE2 #xFA)
- (#x8FABE3 #xF9)
- (#x8FABE4 #xFC)
- (#x8FABE5 #xFB)
- (#x8FABE6 #x16D)
- (#x8FABE7 #x1D4)
- (#x8FABE8 #x171)
- (#x8FABE9 #x16B)
- (#x8FABEA #x173)
- (#x8FABEB #x16F)
- (#x8FABEC #x169)
- (#x8FABED #x1D8)
- (#x8FABEE #x1DC)
- (#x8FABEF #x1DA)
- (#x8FABF0 #x1D6)
- (#x8FABF1 #x175)
- (#x8FABF2 #xFD)
- (#x8FABF3 #xFF)
- (#x8FABF4 #x177)
- (#x8FABF5 #x17A)
- (#x8FABF6 #x17E)
- (#x8FABF7 #x17C)
- (#x8FB0A1 #x4E02)
- (#x8FB0A2 #x4E04)
- (#x8FB0A3 #x4E05)
- (#x8FB0A4 #x4E0C)
- (#x8FB0A5 #x4E12)
- (#x8FB0A6 #x4E1F)
- (#x8FB0A7 #x4E23)
- (#x8FB0A8 #x4E24)
- (#x8FB0A9 #x4E28)
- (#x8FB0AA #x4E2B)
- (#x8FB0AB #x4E2E)
- (#x8FB0AC #x4E2F)
- (#x8FB0AD #x4E30)
- (#x8FB0AE #x4E35)
- (#x8FB0AF #x4E40)
- (#x8FB0B0 #x4E41)
- (#x8FB0B1 #x4E44)
- (#x8FB0B2 #x4E47)
- (#x8FB0B3 #x4E51)
- (#x8FB0B4 #x4E5A)
- (#x8FB0B5 #x4E5C)
- (#x8FB0B6 #x4E63)
- (#x8FB0B7 #x4E68)
- (#x8FB0B8 #x4E69)
- (#x8FB0B9 #x4E74)
- (#x8FB0BA #x4E75)
- (#x8FB0BB #x4E79)
- (#x8FB0BC #x4E7F)
- (#x8FB0BD #x4E8D)
- (#x8FB0BE #x4E96)
- (#x8FB0BF #x4E97)
- (#x8FB0C0 #x4E9D)
- (#x8FB0C1 #x4EAF)
- (#x8FB0C2 #x4EB9)
- (#x8FB0C3 #x4EC3)
- (#x8FB0C4 #x4ED0)
- (#x8FB0C5 #x4EDA)
- (#x8FB0C6 #x4EDB)
- (#x8FB0C7 #x4EE0)
- (#x8FB0C8 #x4EE1)
- (#x8FB0C9 #x4EE2)
- (#x8FB0CA #x4EE8)
- (#x8FB0CB #x4EEF)
- (#x8FB0CC #x4EF1)
- (#x8FB0CD #x4EF3)
- (#x8FB0CE #x4EF5)
- (#x8FB0CF #x4EFD)
- (#x8FB0D0 #x4EFE)
- (#x8FB0D1 #x4EFF)
- (#x8FB0D2 #x4F00)
- (#x8FB0D3 #x4F02)
- (#x8FB0D4 #x4F03)
- (#x8FB0D5 #x4F08)
- (#x8FB0D6 #x4F0B)
- (#x8FB0D7 #x4F0C)
- (#x8FB0D8 #x4F12)
- (#x8FB0D9 #x4F15)
- (#x8FB0DA #x4F16)
- (#x8FB0DB #x4F17)
- (#x8FB0DC #x4F19)
- (#x8FB0DD #x4F2E)
- (#x8FB0DE #x4F31)
- (#x8FB0DF #x4F60)
- (#x8FB0E0 #x4F33)
- (#x8FB0E1 #x4F35)
- (#x8FB0E2 #x4F37)
- (#x8FB0E3 #x4F39)
- (#x8FB0E4 #x4F3B)
- (#x8FB0E5 #x4F3E)
- (#x8FB0E6 #x4F40)
- (#x8FB0E7 #x4F42)
- (#x8FB0E8 #x4F48)
- (#x8FB0E9 #x4F49)
- (#x8FB0EA #x4F4B)
- (#x8FB0EB #x4F4C)
- (#x8FB0EC #x4F52)
- (#x8FB0ED #x4F54)
- (#x8FB0EE #x4F56)
- (#x8FB0EF #x4F58)
- (#x8FB0F0 #x4F5F)
- (#x8FB0F1 #x4F63)
- (#x8FB0F2 #x4F6A)
- (#x8FB0F3 #x4F6C)
- (#x8FB0F4 #x4F6E)
- (#x8FB0F5 #x4F71)
- (#x8FB0F6 #x4F77)
- (#x8FB0F7 #x4F78)
- (#x8FB0F8 #x4F79)
- (#x8FB0F9 #x4F7A)
- (#x8FB0FA #x4F7D)
- (#x8FB0FB #x4F7E)
- (#x8FB0FC #x4F81)
- (#x8FB0FD #x4F82)
- (#x8FB0FE #x4F84)
- (#x8FB1A1 #x4F85)
- (#x8FB1A2 #x4F89)
- (#x8FB1A3 #x4F8A)
- (#x8FB1A4 #x4F8C)
- (#x8FB1A5 #x4F8E)
- (#x8FB1A6 #x4F90)
- (#x8FB1A7 #x4F92)
- (#x8FB1A8 #x4F93)
- (#x8FB1A9 #x4F94)
- (#x8FB1AA #x4F97)
- (#x8FB1AB #x4F99)
- (#x8FB1AC #x4F9A)
- (#x8FB1AD #x4F9E)
- (#x8FB1AE #x4F9F)
- (#x8FB1AF #x4FB2)
- (#x8FB1B0 #x4FB7)
- (#x8FB1B1 #x4FB9)
- (#x8FB1B2 #x4FBB)
- (#x8FB1B3 #x4FBC)
- (#x8FB1B4 #x4FBD)
- (#x8FB1B5 #x4FBE)
- (#x8FB1B6 #x4FC0)
- (#x8FB1B7 #x4FC1)
- (#x8FB1B8 #x4FC5)
- (#x8FB1B9 #x4FC6)
- (#x8FB1BA #x4FC8)
- (#x8FB1BB #x4FC9)
- (#x8FB1BC #x4FCB)
- (#x8FB1BD #x4FCC)
- (#x8FB1BE #x4FCD)
- (#x8FB1BF #x4FCF)
- (#x8FB1C0 #x4FD2)
- (#x8FB1C1 #x4FDC)
- (#x8FB1C2 #x4FE0)
- (#x8FB1C3 #x4FE2)
- (#x8FB1C4 #x4FF0)
- (#x8FB1C5 #x4FF2)
- (#x8FB1C6 #x4FFC)
- (#x8FB1C7 #x4FFD)
- (#x8FB1C8 #x4FFF)
- (#x8FB1C9 #x5000)
- (#x8FB1CA #x5001)
- (#x8FB1CB #x5004)
- (#x8FB1CC #x5007)
- (#x8FB1CD #x500A)
- (#x8FB1CE #x500C)
- (#x8FB1CF #x500E)
- (#x8FB1D0 #x5010)
- (#x8FB1D1 #x5013)
- (#x8FB1D2 #x5017)
- (#x8FB1D3 #x5018)
- (#x8FB1D4 #x501B)
- (#x8FB1D5 #x501C)
- (#x8FB1D6 #x501D)
- (#x8FB1D7 #x501E)
- (#x8FB1D8 #x5022)
- (#x8FB1D9 #x5027)
- (#x8FB1DA #x502E)
- (#x8FB1DB #x5030)
- (#x8FB1DC #x5032)
- (#x8FB1DD #x5033)
- (#x8FB1DE #x5035)
- (#x8FB1DF #x5040)
- (#x8FB1E0 #x5041)
- (#x8FB1E1 #x5042)
- (#x8FB1E2 #x5045)
- (#x8FB1E3 #x5046)
- (#x8FB1E4 #x504A)
- (#x8FB1E5 #x504C)
- (#x8FB1E6 #x504E)
- (#x8FB1E7 #x5051)
- (#x8FB1E8 #x5052)
- (#x8FB1E9 #x5053)
- (#x8FB1EA #x5057)
- (#x8FB1EB #x5059)
- (#x8FB1EC #x505F)
- (#x8FB1ED #x5060)
- (#x8FB1EE #x5062)
- (#x8FB1EF #x5063)
- (#x8FB1F0 #x5066)
- (#x8FB1F1 #x5067)
- (#x8FB1F2 #x506A)
- (#x8FB1F3 #x506D)
- (#x8FB1F4 #x5070)
- (#x8FB1F5 #x5071)
- (#x8FB1F6 #x503B)
- (#x8FB1F7 #x5081)
- (#x8FB1F8 #x5083)
- (#x8FB1F9 #x5084)
- (#x8FB1FA #x5086)
- (#x8FB1FB #x508A)
- (#x8FB1FC #x508E)
- (#x8FB1FD #x508F)
- (#x8FB1FE #x5090)
- (#x8FB2A1 #x5092)
- (#x8FB2A2 #x5093)
- (#x8FB2A3 #x5094)
- (#x8FB2A4 #x5096)
- (#x8FB2A5 #x509B)
- (#x8FB2A6 #x509C)
- (#x8FB2A7 #x509E)
- (#x8FB2A8 #x509F)
- (#x8FB2A9 #x50A0)
- (#x8FB2AA #x50A1)
- (#x8FB2AB #x50A2)
- (#x8FB2AC #x50AA)
- (#x8FB2AD #x50AF)
- (#x8FB2AE #x50B0)
- (#x8FB2AF #x50B9)
- (#x8FB2B0 #x50BA)
- (#x8FB2B1 #x50BD)
- (#x8FB2B2 #x50C0)
- (#x8FB2B3 #x50C3)
- (#x8FB2B4 #x50C4)
- (#x8FB2B5 #x50C7)
- (#x8FB2B6 #x50CC)
- (#x8FB2B7 #x50CE)
- (#x8FB2B8 #x50D0)
- (#x8FB2B9 #x50D3)
- (#x8FB2BA #x50D4)
- (#x8FB2BB #x50D8)
- (#x8FB2BC #x50DC)
- (#x8FB2BD #x50DD)
- (#x8FB2BE #x50DF)
- (#x8FB2BF #x50E2)
- (#x8FB2C0 #x50E4)
- (#x8FB2C1 #x50E6)
- (#x8FB2C2 #x50E8)
- (#x8FB2C3 #x50E9)
- (#x8FB2C4 #x50EF)
- (#x8FB2C5 #x50F1)
- (#x8FB2C6 #x50F6)
- (#x8FB2C7 #x50FA)
- (#x8FB2C8 #x50FE)
- (#x8FB2C9 #x5103)
- (#x8FB2CA #x5106)
- (#x8FB2CB #x5107)
- (#x8FB2CC #x5108)
- (#x8FB2CD #x510B)
- (#x8FB2CE #x510C)
- (#x8FB2CF #x510D)
- (#x8FB2D0 #x510E)
- (#x8FB2D1 #x50F2)
- (#x8FB2D2 #x5110)
- (#x8FB2D3 #x5117)
- (#x8FB2D4 #x5119)
- (#x8FB2D5 #x511B)
- (#x8FB2D6 #x511C)
- (#x8FB2D7 #x511D)
- (#x8FB2D8 #x511E)
- (#x8FB2D9 #x5123)
- (#x8FB2DA #x5127)
- (#x8FB2DB #x5128)
- (#x8FB2DC #x512C)
- (#x8FB2DD #x512D)
- (#x8FB2DE #x512F)
- (#x8FB2DF #x5131)
- (#x8FB2E0 #x5133)
- (#x8FB2E1 #x5134)
- (#x8FB2E2 #x5135)
- (#x8FB2E3 #x5138)
- (#x8FB2E4 #x5139)
- (#x8FB2E5 #x5142)
- (#x8FB2E6 #x514A)
- (#x8FB2E7 #x514F)
- (#x8FB2E8 #x5153)
- (#x8FB2E9 #x5155)
- (#x8FB2EA #x5157)
- (#x8FB2EB #x5158)
- (#x8FB2EC #x515F)
- (#x8FB2ED #x5164)
- (#x8FB2EE #x5166)
- (#x8FB2EF #x517E)
- (#x8FB2F0 #x5183)
- (#x8FB2F1 #x5184)
- (#x8FB2F2 #x518B)
- (#x8FB2F3 #x518E)
- (#x8FB2F4 #x5198)
- (#x8FB2F5 #x519D)
- (#x8FB2F6 #x51A1)
- (#x8FB2F7 #x51A3)
- (#x8FB2F8 #x51AD)
- (#x8FB2F9 #x51B8)
- (#x8FB2FA #x51BA)
- (#x8FB2FB #x51BC)
- (#x8FB2FC #x51BE)
- (#x8FB2FD #x51BF)
- (#x8FB2FE #x51C2)
- (#x8FB3A1 #x51C8)
- (#x8FB3A2 #x51CF)
- (#x8FB3A3 #x51D1)
- (#x8FB3A4 #x51D2)
- (#x8FB3A5 #x51D3)
- (#x8FB3A6 #x51D5)
- (#x8FB3A7 #x51D8)
- (#x8FB3A8 #x51DE)
- (#x8FB3A9 #x51E2)
- (#x8FB3AA #x51E5)
- (#x8FB3AB #x51EE)
- (#x8FB3AC #x51F2)
- (#x8FB3AD #x51F3)
- (#x8FB3AE #x51F4)
- (#x8FB3AF #x51F7)
- (#x8FB3B0 #x5201)
- (#x8FB3B1 #x5202)
- (#x8FB3B2 #x5205)
- (#x8FB3B3 #x5212)
- (#x8FB3B4 #x5213)
- (#x8FB3B5 #x5215)
- (#x8FB3B6 #x5216)
- (#x8FB3B7 #x5218)
- (#x8FB3B8 #x5222)
- (#x8FB3B9 #x5228)
- (#x8FB3BA #x5231)
- (#x8FB3BB #x5232)
- (#x8FB3BC #x5235)
- (#x8FB3BD #x523C)
- (#x8FB3BE #x5245)
- (#x8FB3BF #x5249)
- (#x8FB3C0 #x5255)
- (#x8FB3C1 #x5257)
- (#x8FB3C2 #x5258)
- (#x8FB3C3 #x525A)
- (#x8FB3C4 #x525C)
- (#x8FB3C5 #x525F)
- (#x8FB3C6 #x5260)
- (#x8FB3C7 #x5261)
- (#x8FB3C8 #x5266)
- (#x8FB3C9 #x526E)
- (#x8FB3CA #x5277)
- (#x8FB3CB #x5278)
- (#x8FB3CC #x5279)
- (#x8FB3CD #x5280)
- (#x8FB3CE #x5282)
- (#x8FB3CF #x5285)
- (#x8FB3D0 #x528A)
- (#x8FB3D1 #x528C)
- (#x8FB3D2 #x5293)
- (#x8FB3D3 #x5295)
- (#x8FB3D4 #x5296)
- (#x8FB3D5 #x5297)
- (#x8FB3D6 #x5298)
- (#x8FB3D7 #x529A)
- (#x8FB3D8 #x529C)
- (#x8FB3D9 #x52A4)
- (#x8FB3DA #x52A5)
- (#x8FB3DB #x52A6)
- (#x8FB3DC #x52A7)
- (#x8FB3DD #x52AF)
- (#x8FB3DE #x52B0)
- (#x8FB3DF #x52B6)
- (#x8FB3E0 #x52B7)
- (#x8FB3E1 #x52B8)
- (#x8FB3E2 #x52BA)
- (#x8FB3E3 #x52BB)
- (#x8FB3E4 #x52BD)
- (#x8FB3E5 #x52C0)
- (#x8FB3E6 #x52C4)
- (#x8FB3E7 #x52C6)
- (#x8FB3E8 #x52C8)
- (#x8FB3E9 #x52CC)
- (#x8FB3EA #x52CF)
- (#x8FB3EB #x52D1)
- (#x8FB3EC #x52D4)
- (#x8FB3ED #x52D6)
- (#x8FB3EE #x52DB)
- (#x8FB3EF #x52DC)
- (#x8FB3F0 #x52E1)
- (#x8FB3F1 #x52E5)
- (#x8FB3F2 #x52E8)
- (#x8FB3F3 #x52E9)
- (#x8FB3F4 #x52EA)
- (#x8FB3F5 #x52EC)
- (#x8FB3F6 #x52F0)
- (#x8FB3F7 #x52F1)
- (#x8FB3F8 #x52F4)
- (#x8FB3F9 #x52F6)
- (#x8FB3FA #x52F7)
- (#x8FB3FB #x5300)
- (#x8FB3FC #x5303)
- (#x8FB3FD #x530A)
- (#x8FB3FE #x530B)
- (#x8FB4A1 #x530C)
- (#x8FB4A2 #x5311)
- (#x8FB4A3 #x5313)
- (#x8FB4A4 #x5318)
- (#x8FB4A5 #x531B)
- (#x8FB4A6 #x531C)
- (#x8FB4A7 #x531E)
- (#x8FB4A8 #x531F)
- (#x8FB4A9 #x5325)
- (#x8FB4AA #x5327)
- (#x8FB4AB #x5328)
- (#x8FB4AC #x5329)
- (#x8FB4AD #x532B)
- (#x8FB4AE #x532C)
- (#x8FB4AF #x532D)
- (#x8FB4B0 #x5330)
- (#x8FB4B1 #x5332)
- (#x8FB4B2 #x5335)
- (#x8FB4B3 #x533C)
- (#x8FB4B4 #x533D)
- (#x8FB4B5 #x533E)
- (#x8FB4B6 #x5342)
- (#x8FB4B7 #x534C)
- (#x8FB4B8 #x534B)
- (#x8FB4B9 #x5359)
- (#x8FB4BA #x535B)
- (#x8FB4BB #x5361)
- (#x8FB4BC #x5363)
- (#x8FB4BD #x5365)
- (#x8FB4BE #x536C)
- (#x8FB4BF #x536D)
- (#x8FB4C0 #x5372)
- (#x8FB4C1 #x5379)
- (#x8FB4C2 #x537E)
- (#x8FB4C3 #x5383)
- (#x8FB4C4 #x5387)
- (#x8FB4C5 #x5388)
- (#x8FB4C6 #x538E)
- (#x8FB4C7 #x5393)
- (#x8FB4C8 #x5394)
- (#x8FB4C9 #x5399)
- (#x8FB4CA #x539D)
- (#x8FB4CB #x53A1)
- (#x8FB4CC #x53A4)
- (#x8FB4CD #x53AA)
- (#x8FB4CE #x53AB)
- (#x8FB4CF #x53AF)
- (#x8FB4D0 #x53B2)
- (#x8FB4D1 #x53B4)
- (#x8FB4D2 #x53B5)
- (#x8FB4D3 #x53B7)
- (#x8FB4D4 #x53B8)
- (#x8FB4D5 #x53BA)
- (#x8FB4D6 #x53BD)
- (#x8FB4D7 #x53C0)
- (#x8FB4D8 #x53C5)
- (#x8FB4D9 #x53CF)
- (#x8FB4DA #x53D2)
- (#x8FB4DB #x53D3)
- (#x8FB4DC #x53D5)
- (#x8FB4DD #x53DA)
- (#x8FB4DE #x53DD)
- (#x8FB4DF #x53DE)
- (#x8FB4E0 #x53E0)
- (#x8FB4E1 #x53E6)
- (#x8FB4E2 #x53E7)
- (#x8FB4E3 #x53F5)
- (#x8FB4E4 #x5402)
- (#x8FB4E5 #x5413)
- (#x8FB4E6 #x541A)
- (#x8FB4E7 #x5421)
- (#x8FB4E8 #x5427)
- (#x8FB4E9 #x5428)
- (#x8FB4EA #x542A)
- (#x8FB4EB #x542F)
- (#x8FB4EC #x5431)
- (#x8FB4ED #x5434)
- (#x8FB4EE #x5435)
- (#x8FB4EF #x5443)
- (#x8FB4F0 #x5444)
- (#x8FB4F1 #x5447)
- (#x8FB4F2 #x544D)
- (#x8FB4F3 #x544F)
- (#x8FB4F4 #x545E)
- (#x8FB4F5 #x5462)
- (#x8FB4F6 #x5464)
- (#x8FB4F7 #x5466)
- (#x8FB4F8 #x5467)
- (#x8FB4F9 #x5469)
- (#x8FB4FA #x546B)
- (#x8FB4FB #x546D)
- (#x8FB4FC #x546E)
- (#x8FB4FD #x5474)
- (#x8FB4FE #x547F)
- (#x8FB5A1 #x5481)
- (#x8FB5A2 #x5483)
- (#x8FB5A3 #x5485)
- (#x8FB5A4 #x5488)
- (#x8FB5A5 #x5489)
- (#x8FB5A6 #x548D)
- (#x8FB5A7 #x5491)
- (#x8FB5A8 #x5495)
- (#x8FB5A9 #x5496)
- (#x8FB5AA #x549C)
- (#x8FB5AB #x549F)
- (#x8FB5AC #x54A1)
- (#x8FB5AD #x54A6)
- (#x8FB5AE #x54A7)
- (#x8FB5AF #x54A9)
- (#x8FB5B0 #x54AA)
- (#x8FB5B1 #x54AD)
- (#x8FB5B2 #x54AE)
- (#x8FB5B3 #x54B1)
- (#x8FB5B4 #x54B7)
- (#x8FB5B5 #x54B9)
- (#x8FB5B6 #x54BA)
- (#x8FB5B7 #x54BB)
- (#x8FB5B8 #x54BF)
- (#x8FB5B9 #x54C6)
- (#x8FB5BA #x54CA)
- (#x8FB5BB #x54CD)
- (#x8FB5BC #x54CE)
- (#x8FB5BD #x54E0)
- (#x8FB5BE #x54EA)
- (#x8FB5BF #x54EC)
- (#x8FB5C0 #x54EF)
- (#x8FB5C1 #x54F6)
- (#x8FB5C2 #x54FC)
- (#x8FB5C3 #x54FE)
- (#x8FB5C4 #x54FF)
- (#x8FB5C5 #x5500)
- (#x8FB5C6 #x5501)
- (#x8FB5C7 #x5505)
- (#x8FB5C8 #x5508)
- (#x8FB5C9 #x5509)
- (#x8FB5CA #x550C)
- (#x8FB5CB #x550D)
- (#x8FB5CC #x550E)
- (#x8FB5CD #x5515)
- (#x8FB5CE #x552A)
- (#x8FB5CF #x552B)
- (#x8FB5D0 #x5532)
- (#x8FB5D1 #x5535)
- (#x8FB5D2 #x5536)
- (#x8FB5D3 #x553B)
- (#x8FB5D4 #x553C)
- (#x8FB5D5 #x553D)
- (#x8FB5D6 #x5541)
- (#x8FB5D7 #x5547)
- (#x8FB5D8 #x5549)
- (#x8FB5D9 #x554A)
- (#x8FB5DA #x554D)
- (#x8FB5DB #x5550)
- (#x8FB5DC #x5551)
- (#x8FB5DD #x5558)
- (#x8FB5DE #x555A)
- (#x8FB5DF #x555B)
- (#x8FB5E0 #x555E)
- (#x8FB5E1 #x5560)
- (#x8FB5E2 #x5561)
- (#x8FB5E3 #x5564)
- (#x8FB5E4 #x5566)
- (#x8FB5E5 #x557F)
- (#x8FB5E6 #x5581)
- (#x8FB5E7 #x5582)
- (#x8FB5E8 #x5586)
- (#x8FB5E9 #x5588)
- (#x8FB5EA #x558E)
- (#x8FB5EB #x558F)
- (#x8FB5EC #x5591)
- (#x8FB5ED #x5592)
- (#x8FB5EE #x5593)
- (#x8FB5EF #x5594)
- (#x8FB5F0 #x5597)
- (#x8FB5F1 #x55A3)
- (#x8FB5F2 #x55A4)
- (#x8FB5F3 #x55AD)
- (#x8FB5F4 #x55B2)
- (#x8FB5F5 #x55BF)
- (#x8FB5F6 #x55C1)
- (#x8FB5F7 #x55C3)
- (#x8FB5F8 #x55C6)
- (#x8FB5F9 #x55C9)
- (#x8FB5FA #x55CB)
- (#x8FB5FB #x55CC)
- (#x8FB5FC #x55CE)
- (#x8FB5FD #x55D1)
- (#x8FB5FE #x55D2)
- (#x8FB6A1 #x55D3)
- (#x8FB6A2 #x55D7)
- (#x8FB6A3 #x55D8)
- (#x8FB6A4 #x55DB)
- (#x8FB6A5 #x55DE)
- (#x8FB6A6 #x55E2)
- (#x8FB6A7 #x55E9)
- (#x8FB6A8 #x55F6)
- (#x8FB6A9 #x55FF)
- (#x8FB6AA #x5605)
- (#x8FB6AB #x5608)
- (#x8FB6AC #x560A)
- (#x8FB6AD #x560D)
- (#x8FB6AE #x560E)
- (#x8FB6AF #x560F)
- (#x8FB6B0 #x5610)
- (#x8FB6B1 #x5611)
- (#x8FB6B2 #x5612)
- (#x8FB6B3 #x5619)
- (#x8FB6B4 #x562C)
- (#x8FB6B5 #x5630)
- (#x8FB6B6 #x5633)
- (#x8FB6B7 #x5635)
- (#x8FB6B8 #x5637)
- (#x8FB6B9 #x5639)
- (#x8FB6BA #x563B)
- (#x8FB6BB #x563C)
- (#x8FB6BC #x563D)
- (#x8FB6BD #x563F)
- (#x8FB6BE #x5640)
- (#x8FB6BF #x5641)
- (#x8FB6C0 #x5643)
- (#x8FB6C1 #x5644)
- (#x8FB6C2 #x5646)
- (#x8FB6C3 #x5649)
- (#x8FB6C4 #x564B)
- (#x8FB6C5 #x564D)
- (#x8FB6C6 #x564F)
- (#x8FB6C7 #x5654)
- (#x8FB6C8 #x565E)
- (#x8FB6C9 #x5660)
- (#x8FB6CA #x5661)
- (#x8FB6CB #x5662)
- (#x8FB6CC #x5663)
- (#x8FB6CD #x5666)
- (#x8FB6CE #x5669)
- (#x8FB6CF #x566D)
- (#x8FB6D0 #x566F)
- (#x8FB6D1 #x5671)
- (#x8FB6D2 #x5672)
- (#x8FB6D3 #x5675)
- (#x8FB6D4 #x5684)
- (#x8FB6D5 #x5685)
- (#x8FB6D6 #x5688)
- (#x8FB6D7 #x568B)
- (#x8FB6D8 #x568C)
- (#x8FB6D9 #x5695)
- (#x8FB6DA #x5699)
- (#x8FB6DB #x569A)
- (#x8FB6DC #x569D)
- (#x8FB6DD #x569E)
- (#x8FB6DE #x569F)
- (#x8FB6DF #x56A6)
- (#x8FB6E0 #x56A7)
- (#x8FB6E1 #x56A8)
- (#x8FB6E2 #x56A9)
- (#x8FB6E3 #x56AB)
- (#x8FB6E4 #x56AC)
- (#x8FB6E5 #x56AD)
- (#x8FB6E6 #x56B1)
- (#x8FB6E7 #x56B3)
- (#x8FB6E8 #x56B7)
- (#x8FB6E9 #x56BE)
- (#x8FB6EA #x56C5)
- (#x8FB6EB #x56C9)
- (#x8FB6EC #x56CA)
- (#x8FB6ED #x56CB)
- (#x8FB6EE #x56CF)
- (#x8FB6EF #x56D0)
- (#x8FB6F0 #x56CC)
- (#x8FB6F1 #x56CD)
- (#x8FB6F2 #x56D9)
- (#x8FB6F3 #x56DC)
- (#x8FB6F4 #x56DD)
- (#x8FB6F5 #x56DF)
- (#x8FB6F6 #x56E1)
- (#x8FB6F7 #x56E4)
- (#x8FB6F8 #x56E5)
- (#x8FB6F9 #x56E6)
- (#x8FB6FA #x56E7)
- (#x8FB6FB #x56E8)
- (#x8FB6FC #x56F1)
- (#x8FB6FD #x56EB)
- (#x8FB6FE #x56ED)
- (#x8FB7A1 #x56F6)
- (#x8FB7A2 #x56F7)
- (#x8FB7A3 #x5701)
- (#x8FB7A4 #x5702)
- (#x8FB7A5 #x5707)
- (#x8FB7A6 #x570A)
- (#x8FB7A7 #x570C)
- (#x8FB7A8 #x5711)
- (#x8FB7A9 #x5715)
- (#x8FB7AA #x571A)
- (#x8FB7AB #x571B)
- (#x8FB7AC #x571D)
- (#x8FB7AD #x5720)
- (#x8FB7AE #x5722)
- (#x8FB7AF #x5723)
- (#x8FB7B0 #x5724)
- (#x8FB7B1 #x5725)
- (#x8FB7B2 #x5729)
- (#x8FB7B3 #x572A)
- (#x8FB7B4 #x572C)
- (#x8FB7B5 #x572E)
- (#x8FB7B6 #x572F)
- (#x8FB7B7 #x5733)
- (#x8FB7B8 #x5734)
- (#x8FB7B9 #x573D)
- (#x8FB7BA #x573E)
- (#x8FB7BB #x573F)
- (#x8FB7BC #x5745)
- (#x8FB7BD #x5746)
- (#x8FB7BE #x574C)
- (#x8FB7BF #x574D)
- (#x8FB7C0 #x5752)
- (#x8FB7C1 #x5762)
- (#x8FB7C2 #x5765)
- (#x8FB7C3 #x5767)
- (#x8FB7C4 #x5768)
- (#x8FB7C5 #x576B)
- (#x8FB7C6 #x576D)
- (#x8FB7C7 #x576E)
- (#x8FB7C8 #x576F)
- (#x8FB7C9 #x5770)
- (#x8FB7CA #x5771)
- (#x8FB7CB #x5773)
- (#x8FB7CC #x5774)
- (#x8FB7CD #x5775)
- (#x8FB7CE #x5777)
- (#x8FB7CF #x5779)
- (#x8FB7D0 #x577A)
- (#x8FB7D1 #x577B)
- (#x8FB7D2 #x577C)
- (#x8FB7D3 #x577E)
- (#x8FB7D4 #x5781)
- (#x8FB7D5 #x5783)
- (#x8FB7D6 #x578C)
- (#x8FB7D7 #x5794)
- (#x8FB7D8 #x5797)
- (#x8FB7D9 #x5799)
- (#x8FB7DA #x579A)
- (#x8FB7DB #x579C)
- (#x8FB7DC #x579D)
- (#x8FB7DD #x579E)
- (#x8FB7DE #x579F)
- (#x8FB7DF #x57A1)
- (#x8FB7E0 #x5795)
- (#x8FB7E1 #x57A7)
- (#x8FB7E2 #x57A8)
- (#x8FB7E3 #x57A9)
- (#x8FB7E4 #x57AC)
- (#x8FB7E5 #x57B8)
- (#x8FB7E6 #x57BD)
- (#x8FB7E7 #x57C7)
- (#x8FB7E8 #x57C8)
- (#x8FB7E9 #x57CC)
- (#x8FB7EA #x57CF)
- (#x8FB7EB #x57D5)
- (#x8FB7EC #x57DD)
- (#x8FB7ED #x57DE)
- (#x8FB7EE #x57E4)
- (#x8FB7EF #x57E6)
- (#x8FB7F0 #x57E7)
- (#x8FB7F1 #x57E9)
- (#x8FB7F2 #x57ED)
- (#x8FB7F3 #x57F0)
- (#x8FB7F4 #x57F5)
- (#x8FB7F5 #x57F6)
- (#x8FB7F6 #x57F8)
- (#x8FB7F7 #x57FD)
- (#x8FB7F8 #x57FE)
- (#x8FB7F9 #x57FF)
- (#x8FB7FA #x5803)
- (#x8FB7FB #x5804)
- (#x8FB7FC #x5808)
- (#x8FB7FD #x5809)
- (#x8FB7FE #x57E1)
- (#x8FB8A1 #x580C)
- (#x8FB8A2 #x580D)
- (#x8FB8A3 #x581B)
- (#x8FB8A4 #x581E)
- (#x8FB8A5 #x581F)
- (#x8FB8A6 #x5820)
- (#x8FB8A7 #x5826)
- (#x8FB8A8 #x5827)
- (#x8FB8A9 #x582D)
- (#x8FB8AA #x5832)
- (#x8FB8AB #x5839)
- (#x8FB8AC #x583F)
- (#x8FB8AD #x5849)
- (#x8FB8AE #x584C)
- (#x8FB8AF #x584D)
- (#x8FB8B0 #x584F)
- (#x8FB8B1 #x5850)
- (#x8FB8B2 #x5855)
- (#x8FB8B3 #x585F)
- (#x8FB8B4 #x5861)
- (#x8FB8B5 #x5864)
- (#x8FB8B6 #x5867)
- (#x8FB8B7 #x5868)
- (#x8FB8B8 #x5878)
- (#x8FB8B9 #x587C)
- (#x8FB8BA #x587F)
- (#x8FB8BB #x5880)
- (#x8FB8BC #x5881)
- (#x8FB8BD #x5887)
- (#x8FB8BE #x5888)
- (#x8FB8BF #x5889)
- (#x8FB8C0 #x588A)
- (#x8FB8C1 #x588C)
- (#x8FB8C2 #x588D)
- (#x8FB8C3 #x588F)
- (#x8FB8C4 #x5890)
- (#x8FB8C5 #x5894)
- (#x8FB8C6 #x5896)
- (#x8FB8C7 #x589D)
- (#x8FB8C8 #x58A0)
- (#x8FB8C9 #x58A1)
- (#x8FB8CA #x58A2)
- (#x8FB8CB #x58A6)
- (#x8FB8CC #x58A9)
- (#x8FB8CD #x58B1)
- (#x8FB8CE #x58B2)
- (#x8FB8CF #x58C4)
- (#x8FB8D0 #x58BC)
- (#x8FB8D1 #x58C2)
- (#x8FB8D2 #x58C8)
- (#x8FB8D3 #x58CD)
- (#x8FB8D4 #x58CE)
- (#x8FB8D5 #x58D0)
- (#x8FB8D6 #x58D2)
- (#x8FB8D7 #x58D4)
- (#x8FB8D8 #x58D6)
- (#x8FB8D9 #x58DA)
- (#x8FB8DA #x58DD)
- (#x8FB8DB #x58E1)
- (#x8FB8DC #x58E2)
- (#x8FB8DD #x58E9)
- (#x8FB8DE #x58F3)
- (#x8FB8DF #x5905)
- (#x8FB8E0 #x5906)
- (#x8FB8E1 #x590B)
- (#x8FB8E2 #x590C)
- (#x8FB8E3 #x5912)
- (#x8FB8E4 #x5913)
- (#x8FB8E5 #x5914)
- (#x8FB8E6 #x8641)
- (#x8FB8E7 #x591D)
- (#x8FB8E8 #x5921)
- (#x8FB8E9 #x5923)
- (#x8FB8EA #x5924)
- (#x8FB8EB #x5928)
- (#x8FB8EC #x592F)
- (#x8FB8ED #x5930)
- (#x8FB8EE #x5933)
- (#x8FB8EF #x5935)
- (#x8FB8F0 #x5936)
- (#x8FB8F1 #x593F)
- (#x8FB8F2 #x5943)
- (#x8FB8F3 #x5946)
- (#x8FB8F4 #x5952)
- (#x8FB8F5 #x5953)
- (#x8FB8F6 #x5959)
- (#x8FB8F7 #x595B)
- (#x8FB8F8 #x595D)
- (#x8FB8F9 #x595E)
- (#x8FB8FA #x595F)
- (#x8FB8FB #x5961)
- (#x8FB8FC #x5963)
- (#x8FB8FD #x596B)
- (#x8FB8FE #x596D)
- (#x8FB9A1 #x596F)
- (#x8FB9A2 #x5972)
- (#x8FB9A3 #x5975)
- (#x8FB9A4 #x5976)
- (#x8FB9A5 #x5979)
- (#x8FB9A6 #x597B)
- (#x8FB9A7 #x597C)
- (#x8FB9A8 #x598B)
- (#x8FB9A9 #x598C)
- (#x8FB9AA #x598E)
- (#x8FB9AB #x5992)
- (#x8FB9AC #x5995)
- (#x8FB9AD #x5997)
- (#x8FB9AE #x599F)
- (#x8FB9AF #x59A4)
- (#x8FB9B0 #x59A7)
- (#x8FB9B1 #x59AD)
- (#x8FB9B2 #x59AE)
- (#x8FB9B3 #x59AF)
- (#x8FB9B4 #x59B0)
- (#x8FB9B5 #x59B3)
- (#x8FB9B6 #x59B7)
- (#x8FB9B7 #x59BA)
- (#x8FB9B8 #x59BC)
- (#x8FB9B9 #x59C1)
- (#x8FB9BA #x59C3)
- (#x8FB9BB #x59C4)
- (#x8FB9BC #x59C8)
- (#x8FB9BD #x59CA)
- (#x8FB9BE #x59CD)
- (#x8FB9BF #x59D2)
- (#x8FB9C0 #x59DD)
- (#x8FB9C1 #x59DE)
- (#x8FB9C2 #x59DF)
- (#x8FB9C3 #x59E3)
- (#x8FB9C4 #x59E4)
- (#x8FB9C5 #x59E7)
- (#x8FB9C6 #x59EE)
- (#x8FB9C7 #x59EF)
- (#x8FB9C8 #x59F1)
- (#x8FB9C9 #x59F2)
- (#x8FB9CA #x59F4)
- (#x8FB9CB #x59F7)
- (#x8FB9CC #x5A00)
- (#x8FB9CD #x5A04)
- (#x8FB9CE #x5A0C)
- (#x8FB9CF #x5A0D)
- (#x8FB9D0 #x5A0E)
- (#x8FB9D1 #x5A12)
- (#x8FB9D2 #x5A13)
- (#x8FB9D3 #x5A1E)
- (#x8FB9D4 #x5A23)
- (#x8FB9D5 #x5A24)
- (#x8FB9D6 #x5A27)
- (#x8FB9D7 #x5A28)
- (#x8FB9D8 #x5A2A)
- (#x8FB9D9 #x5A2D)
- (#x8FB9DA #x5A30)
- (#x8FB9DB #x5A44)
- (#x8FB9DC #x5A45)
- (#x8FB9DD #x5A47)
- (#x8FB9DE #x5A48)
- (#x8FB9DF #x5A4C)
- (#x8FB9E0 #x5A50)
- (#x8FB9E1 #x5A55)
- (#x8FB9E2 #x5A5E)
- (#x8FB9E3 #x5A63)
- (#x8FB9E4 #x5A65)
- (#x8FB9E5 #x5A67)
- (#x8FB9E6 #x5A6D)
- (#x8FB9E7 #x5A77)
- (#x8FB9E8 #x5A7A)
- (#x8FB9E9 #x5A7B)
- (#x8FB9EA #x5A7E)
- (#x8FB9EB #x5A8B)
- (#x8FB9EC #x5A90)
- (#x8FB9ED #x5A93)
- (#x8FB9EE #x5A96)
- (#x8FB9EF #x5A99)
- (#x8FB9F0 #x5A9C)
- (#x8FB9F1 #x5A9E)
- (#x8FB9F2 #x5A9F)
- (#x8FB9F3 #x5AA0)
- (#x8FB9F4 #x5AA2)
- (#x8FB9F5 #x5AA7)
- (#x8FB9F6 #x5AAC)
- (#x8FB9F7 #x5AB1)
- (#x8FB9F8 #x5AB2)
- (#x8FB9F9 #x5AB3)
- (#x8FB9FA #x5AB5)
- (#x8FB9FB #x5AB8)
- (#x8FB9FC #x5ABA)
- (#x8FB9FD #x5ABB)
- (#x8FB9FE #x5ABF)
- (#x8FBAA1 #x5AC4)
- (#x8FBAA2 #x5AC6)
- (#x8FBAA3 #x5AC8)
- (#x8FBAA4 #x5ACF)
- (#x8FBAA5 #x5ADA)
- (#x8FBAA6 #x5ADC)
- (#x8FBAA7 #x5AE0)
- (#x8FBAA8 #x5AE5)
- (#x8FBAA9 #x5AEA)
- (#x8FBAAA #x5AEE)
- (#x8FBAAB #x5AF5)
- (#x8FBAAC #x5AF6)
- (#x8FBAAD #x5AFD)
- (#x8FBAAE #x5B00)
- (#x8FBAAF #x5B01)
- (#x8FBAB0 #x5B08)
- (#x8FBAB1 #x5B17)
- (#x8FBAB2 #x5B34)
- (#x8FBAB3 #x5B19)
- (#x8FBAB4 #x5B1B)
- (#x8FBAB5 #x5B1D)
- (#x8FBAB6 #x5B21)
- (#x8FBAB7 #x5B25)
- (#x8FBAB8 #x5B2D)
- (#x8FBAB9 #x5B38)
- (#x8FBABA #x5B41)
- (#x8FBABB #x5B4B)
- (#x8FBABC #x5B4C)
- (#x8FBABD #x5B52)
- (#x8FBABE #x5B56)
- (#x8FBABF #x5B5E)
- (#x8FBAC0 #x5B68)
- (#x8FBAC1 #x5B6E)
- (#x8FBAC2 #x5B6F)
- (#x8FBAC3 #x5B7C)
- (#x8FBAC4 #x5B7D)
- (#x8FBAC5 #x5B7E)
- (#x8FBAC6 #x5B7F)
- (#x8FBAC7 #x5B81)
- (#x8FBAC8 #x5B84)
- (#x8FBAC9 #x5B86)
- (#x8FBACA #x5B8A)
- (#x8FBACB #x5B8E)
- (#x8FBACC #x5B90)
- (#x8FBACD #x5B91)
- (#x8FBACE #x5B93)
- (#x8FBACF #x5B94)
- (#x8FBAD0 #x5B96)
- (#x8FBAD1 #x5BA8)
- (#x8FBAD2 #x5BA9)
- (#x8FBAD3 #x5BAC)
- (#x8FBAD4 #x5BAD)
- (#x8FBAD5 #x5BAF)
- (#x8FBAD6 #x5BB1)
- (#x8FBAD7 #x5BB2)
- (#x8FBAD8 #x5BB7)
- (#x8FBAD9 #x5BBA)
- (#x8FBADA #x5BBC)
- (#x8FBADB #x5BC0)
- (#x8FBADC #x5BC1)
- (#x8FBADD #x5BCD)
- (#x8FBADE #x5BCF)
- (#x8FBADF #x5BD6)
- (#x8FBAE0 #x5BD7)
- (#x8FBAE1 #x5BD8)
- (#x8FBAE2 #x5BD9)
- (#x8FBAE3 #x5BDA)
- (#x8FBAE4 #x5BE0)
- (#x8FBAE5 #x5BEF)
- (#x8FBAE6 #x5BF1)
- (#x8FBAE7 #x5BF4)
- (#x8FBAE8 #x5BFD)
- (#x8FBAE9 #x5C0C)
- (#x8FBAEA #x5C17)
- (#x8FBAEB #x5C1E)
- (#x8FBAEC #x5C1F)
- (#x8FBAED #x5C23)
- (#x8FBAEE #x5C26)
- (#x8FBAEF #x5C29)
- (#x8FBAF0 #x5C2B)
- (#x8FBAF1 #x5C2C)
- (#x8FBAF2 #x5C2E)
- (#x8FBAF3 #x5C30)
- (#x8FBAF4 #x5C32)
- (#x8FBAF5 #x5C35)
- (#x8FBAF6 #x5C36)
- (#x8FBAF7 #x5C59)
- (#x8FBAF8 #x5C5A)
- (#x8FBAF9 #x5C5C)
- (#x8FBAFA #x5C62)
- (#x8FBAFB #x5C63)
- (#x8FBAFC #x5C67)
- (#x8FBAFD #x5C68)
- (#x8FBAFE #x5C69)
- (#x8FBBA1 #x5C6D)
- (#x8FBBA2 #x5C70)
- (#x8FBBA3 #x5C74)
- (#x8FBBA4 #x5C75)
- (#x8FBBA5 #x5C7A)
- (#x8FBBA6 #x5C7B)
- (#x8FBBA7 #x5C7C)
- (#x8FBBA8 #x5C7D)
- (#x8FBBA9 #x5C87)
- (#x8FBBAA #x5C88)
- (#x8FBBAB #x5C8A)
- (#x8FBBAC #x5C8F)
- (#x8FBBAD #x5C92)
- (#x8FBBAE #x5C9D)
- (#x8FBBAF #x5C9F)
- (#x8FBBB0 #x5CA0)
- (#x8FBBB1 #x5CA2)
- (#x8FBBB2 #x5CA3)
- (#x8FBBB3 #x5CA6)
- (#x8FBBB4 #x5CAA)
- (#x8FBBB5 #x5CB2)
- (#x8FBBB6 #x5CB4)
- (#x8FBBB7 #x5CB5)
- (#x8FBBB8 #x5CBA)
- (#x8FBBB9 #x5CC9)
- (#x8FBBBA #x5CCB)
- (#x8FBBBB #x5CD2)
- (#x8FBBBC #x5CDD)
- (#x8FBBBD #x5CD7)
- (#x8FBBBE #x5CEE)
- (#x8FBBBF #x5CF1)
- (#x8FBBC0 #x5CF2)
- (#x8FBBC1 #x5CF4)
- (#x8FBBC2 #x5D01)
- (#x8FBBC3 #x5D06)
- (#x8FBBC4 #x5D0D)
- (#x8FBBC5 #x5D12)
- (#x8FBBC6 #x5D2B)
- (#x8FBBC7 #x5D23)
- (#x8FBBC8 #x5D24)
- (#x8FBBC9 #x5D26)
- (#x8FBBCA #x5D27)
- (#x8FBBCB #x5D31)
- (#x8FBBCC #x5D34)
- (#x8FBBCD #x5D39)
- (#x8FBBCE #x5D3D)
- (#x8FBBCF #x5D3F)
- (#x8FBBD0 #x5D42)
- (#x8FBBD1 #x5D43)
- (#x8FBBD2 #x5D46)
- (#x8FBBD3 #x5D48)
- (#x8FBBD4 #x5D55)
- (#x8FBBD5 #x5D51)
- (#x8FBBD6 #x5D59)
- (#x8FBBD7 #x5D4A)
- (#x8FBBD8 #x5D5F)
- (#x8FBBD9 #x5D60)
- (#x8FBBDA #x5D61)
- (#x8FBBDB #x5D62)
- (#x8FBBDC #x5D64)
- (#x8FBBDD #x5D6A)
- (#x8FBBDE #x5D6D)
- (#x8FBBDF #x5D70)
- (#x8FBBE0 #x5D79)
- (#x8FBBE1 #x5D7A)
- (#x8FBBE2 #x5D7E)
- (#x8FBBE3 #x5D7F)
- (#x8FBBE4 #x5D81)
- (#x8FBBE5 #x5D83)
- (#x8FBBE6 #x5D88)
- (#x8FBBE7 #x5D8A)
- (#x8FBBE8 #x5D92)
- (#x8FBBE9 #x5D93)
- (#x8FBBEA #x5D94)
- (#x8FBBEB #x5D95)
- (#x8FBBEC #x5D99)
- (#x8FBBED #x5D9B)
- (#x8FBBEE #x5D9F)
- (#x8FBBEF #x5DA0)
- (#x8FBBF0 #x5DA7)
- (#x8FBBF1 #x5DAB)
- (#x8FBBF2 #x5DB0)
- (#x8FBBF3 #x5DB4)
- (#x8FBBF4 #x5DB8)
- (#x8FBBF5 #x5DB9)
- (#x8FBBF6 #x5DC3)
- (#x8FBBF7 #x5DC7)
- (#x8FBBF8 #x5DCB)
- (#x8FBBF9 #x5DD0)
- (#x8FBBFA #x5DCE)
- (#x8FBBFB #x5DD8)
- (#x8FBBFC #x5DD9)
- (#x8FBBFD #x5DE0)
- (#x8FBBFE #x5DE4)
- (#x8FBCA1 #x5DE9)
- (#x8FBCA2 #x5DF8)
- (#x8FBCA3 #x5DF9)
- (#x8FBCA4 #x5E00)
- (#x8FBCA5 #x5E07)
- (#x8FBCA6 #x5E0D)
- (#x8FBCA7 #x5E12)
- (#x8FBCA8 #x5E14)
- (#x8FBCA9 #x5E15)
- (#x8FBCAA #x5E18)
- (#x8FBCAB #x5E1F)
- (#x8FBCAC #x5E20)
- (#x8FBCAD #x5E2E)
- (#x8FBCAE #x5E28)
- (#x8FBCAF #x5E32)
- (#x8FBCB0 #x5E35)
- (#x8FBCB1 #x5E3E)
- (#x8FBCB2 #x5E4B)
- (#x8FBCB3 #x5E50)
- (#x8FBCB4 #x5E49)
- (#x8FBCB5 #x5E51)
- (#x8FBCB6 #x5E56)
- (#x8FBCB7 #x5E58)
- (#x8FBCB8 #x5E5B)
- (#x8FBCB9 #x5E5C)
- (#x8FBCBA #x5E5E)
- (#x8FBCBB #x5E68)
- (#x8FBCBC #x5E6A)
- (#x8FBCBD #x5E6B)
- (#x8FBCBE #x5E6C)
- (#x8FBCBF #x5E6D)
- (#x8FBCC0 #x5E6E)
- (#x8FBCC1 #x5E70)
- (#x8FBCC2 #x5E80)
- (#x8FBCC3 #x5E8B)
- (#x8FBCC4 #x5E8E)
- (#x8FBCC5 #x5EA2)
- (#x8FBCC6 #x5EA4)
- (#x8FBCC7 #x5EA5)
- (#x8FBCC8 #x5EA8)
- (#x8FBCC9 #x5EAA)
- (#x8FBCCA #x5EAC)
- (#x8FBCCB #x5EB1)
- (#x8FBCCC #x5EB3)
- (#x8FBCCD #x5EBD)
- (#x8FBCCE #x5EBE)
- (#x8FBCCF #x5EBF)
- (#x8FBCD0 #x5EC6)
- (#x8FBCD1 #x5ECC)
- (#x8FBCD2 #x5ECB)
- (#x8FBCD3 #x5ECE)
- (#x8FBCD4 #x5ED1)
- (#x8FBCD5 #x5ED2)
- (#x8FBCD6 #x5ED4)
- (#x8FBCD7 #x5ED5)
- (#x8FBCD8 #x5EDC)
- (#x8FBCD9 #x5EDE)
- (#x8FBCDA #x5EE5)
- (#x8FBCDB #x5EEB)
- (#x8FBCDC #x5F02)
- (#x8FBCDD #x5F06)
- (#x8FBCDE #x5F07)
- (#x8FBCDF #x5F08)
- (#x8FBCE0 #x5F0E)
- (#x8FBCE1 #x5F19)
- (#x8FBCE2 #x5F1C)
- (#x8FBCE3 #x5F1D)
- (#x8FBCE4 #x5F21)
- (#x8FBCE5 #x5F22)
- (#x8FBCE6 #x5F23)
- (#x8FBCE7 #x5F24)
- (#x8FBCE8 #x5F28)
- (#x8FBCE9 #x5F2B)
- (#x8FBCEA #x5F2C)
- (#x8FBCEB #x5F2E)
- (#x8FBCEC #x5F30)
- (#x8FBCED #x5F34)
- (#x8FBCEE #x5F36)
- (#x8FBCEF #x5F3B)
- (#x8FBCF0 #x5F3D)
- (#x8FBCF1 #x5F3F)
- (#x8FBCF2 #x5F40)
- (#x8FBCF3 #x5F44)
- (#x8FBCF4 #x5F45)
- (#x8FBCF5 #x5F47)
- (#x8FBCF6 #x5F4D)
- (#x8FBCF7 #x5F50)
- (#x8FBCF8 #x5F54)
- (#x8FBCF9 #x5F58)
- (#x8FBCFA #x5F5B)
- (#x8FBCFB #x5F60)
- (#x8FBCFC #x5F63)
- (#x8FBCFD #x5F64)
- (#x8FBCFE #x5F67)
- (#x8FBDA1 #x5F6F)
- (#x8FBDA2 #x5F72)
- (#x8FBDA3 #x5F74)
- (#x8FBDA4 #x5F75)
- (#x8FBDA5 #x5F78)
- (#x8FBDA6 #x5F7A)
- (#x8FBDA7 #x5F7D)
- (#x8FBDA8 #x5F7E)
- (#x8FBDA9 #x5F89)
- (#x8FBDAA #x5F8D)
- (#x8FBDAB #x5F8F)
- (#x8FBDAC #x5F96)
- (#x8FBDAD #x5F9C)
- (#x8FBDAE #x5F9D)
- (#x8FBDAF #x5FA2)
- (#x8FBDB0 #x5FA7)
- (#x8FBDB1 #x5FAB)
- (#x8FBDB2 #x5FA4)
- (#x8FBDB3 #x5FAC)
- (#x8FBDB4 #x5FAF)
- (#x8FBDB5 #x5FB0)
- (#x8FBDB6 #x5FB1)
- (#x8FBDB7 #x5FB8)
- (#x8FBDB8 #x5FC4)
- (#x8FBDB9 #x5FC7)
- (#x8FBDBA #x5FC8)
- (#x8FBDBB #x5FC9)
- (#x8FBDBC #x5FCB)
- (#x8FBDBD #x5FD0)
- (#x8FBDBE #x5FD1)
- (#x8FBDBF #x5FD2)
- (#x8FBDC0 #x5FD3)
- (#x8FBDC1 #x5FD4)
- (#x8FBDC2 #x5FDE)
- (#x8FBDC3 #x5FE1)
- (#x8FBDC4 #x5FE2)
- (#x8FBDC5 #x5FE8)
- (#x8FBDC6 #x5FE9)
- (#x8FBDC7 #x5FEA)
- (#x8FBDC8 #x5FEC)
- (#x8FBDC9 #x5FED)
- (#x8FBDCA #x5FEE)
- (#x8FBDCB #x5FEF)
- (#x8FBDCC #x5FF2)
- (#x8FBDCD #x5FF3)
- (#x8FBDCE #x5FF6)
- (#x8FBDCF #x5FFA)
- (#x8FBDD0 #x5FFC)
- (#x8FBDD1 #x6007)
- (#x8FBDD2 #x600A)
- (#x8FBDD3 #x600D)
- (#x8FBDD4 #x6013)
- (#x8FBDD5 #x6014)
- (#x8FBDD6 #x6017)
- (#x8FBDD7 #x6018)
- (#x8FBDD8 #x601A)
- (#x8FBDD9 #x601F)
- (#x8FBDDA #x6024)
- (#x8FBDDB #x602D)
- (#x8FBDDC #x6033)
- (#x8FBDDD #x6035)
- (#x8FBDDE #x6040)
- (#x8FBDDF #x6047)
- (#x8FBDE0 #x6048)
- (#x8FBDE1 #x6049)
- (#x8FBDE2 #x604C)
- (#x8FBDE3 #x6051)
- (#x8FBDE4 #x6054)
- (#x8FBDE5 #x6056)
- (#x8FBDE6 #x6057)
- (#x8FBDE7 #x605D)
- (#x8FBDE8 #x6061)
- (#x8FBDE9 #x6067)
- (#x8FBDEA #x6071)
- (#x8FBDEB #x607E)
- (#x8FBDEC #x607F)
- (#x8FBDED #x6082)
- (#x8FBDEE #x6086)
- (#x8FBDEF #x6088)
- (#x8FBDF0 #x608A)
- (#x8FBDF1 #x608E)
- (#x8FBDF2 #x6091)
- (#x8FBDF3 #x6093)
- (#x8FBDF4 #x6095)
- (#x8FBDF5 #x6098)
- (#x8FBDF6 #x609D)
- (#x8FBDF7 #x609E)
- (#x8FBDF8 #x60A2)
- (#x8FBDF9 #x60A4)
- (#x8FBDFA #x60A5)
- (#x8FBDFB #x60A8)
- (#x8FBDFC #x60B0)
- (#x8FBDFD #x60B1)
- (#x8FBDFE #x60B7)
- (#x8FBEA1 #x60BB)
- (#x8FBEA2 #x60BE)
- (#x8FBEA3 #x60C2)
- (#x8FBEA4 #x60C4)
- (#x8FBEA5 #x60C8)
- (#x8FBEA6 #x60C9)
- (#x8FBEA7 #x60CA)
- (#x8FBEA8 #x60CB)
- (#x8FBEA9 #x60CE)
- (#x8FBEAA #x60CF)
- (#x8FBEAB #x60D4)
- (#x8FBEAC #x60D5)
- (#x8FBEAD #x60D9)
- (#x8FBEAE #x60DB)
- (#x8FBEAF #x60DD)
- (#x8FBEB0 #x60DE)
- (#x8FBEB1 #x60E2)
- (#x8FBEB2 #x60E5)
- (#x8FBEB3 #x60F2)
- (#x8FBEB4 #x60F5)
- (#x8FBEB5 #x60F8)
- (#x8FBEB6 #x60FC)
- (#x8FBEB7 #x60FD)
- (#x8FBEB8 #x6102)
- (#x8FBEB9 #x6107)
- (#x8FBEBA #x610A)
- (#x8FBEBB #x610C)
- (#x8FBEBC #x6110)
- (#x8FBEBD #x6111)
- (#x8FBEBE #x6112)
- (#x8FBEBF #x6113)
- (#x8FBEC0 #x6114)
- (#x8FBEC1 #x6116)
- (#x8FBEC2 #x6117)
- (#x8FBEC3 #x6119)
- (#x8FBEC4 #x611C)
- (#x8FBEC5 #x611E)
- (#x8FBEC6 #x6122)
- (#x8FBEC7 #x612A)
- (#x8FBEC8 #x612B)
- (#x8FBEC9 #x6130)
- (#x8FBECA #x6131)
- (#x8FBECB #x6135)
- (#x8FBECC #x6136)
- (#x8FBECD #x6137)
- (#x8FBECE #x6139)
- (#x8FBECF #x6141)
- (#x8FBED0 #x6145)
- (#x8FBED1 #x6146)
- (#x8FBED2 #x6149)
- (#x8FBED3 #x615E)
- (#x8FBED4 #x6160)
- (#x8FBED5 #x616C)
- (#x8FBED6 #x6172)
- (#x8FBED7 #x6178)
- (#x8FBED8 #x617B)
- (#x8FBED9 #x617C)
- (#x8FBEDA #x617F)
- (#x8FBEDB #x6180)
- (#x8FBEDC #x6181)
- (#x8FBEDD #x6183)
- (#x8FBEDE #x6184)
- (#x8FBEDF #x618B)
- (#x8FBEE0 #x618D)
- (#x8FBEE1 #x6192)
- (#x8FBEE2 #x6193)
- (#x8FBEE3 #x6197)
- (#x8FBEE4 #x6198)
- (#x8FBEE5 #x619C)
- (#x8FBEE6 #x619D)
- (#x8FBEE7 #x619F)
- (#x8FBEE8 #x61A0)
- (#x8FBEE9 #x61A5)
- (#x8FBEEA #x61A8)
- (#x8FBEEB #x61AA)
- (#x8FBEEC #x61AD)
- (#x8FBEED #x61B8)
- (#x8FBEEE #x61B9)
- (#x8FBEEF #x61BC)
- (#x8FBEF0 #x61C0)
- (#x8FBEF1 #x61C1)
- (#x8FBEF2 #x61C2)
- (#x8FBEF3 #x61CE)
- (#x8FBEF4 #x61CF)
- (#x8FBEF5 #x61D5)
- (#x8FBEF6 #x61DC)
- (#x8FBEF7 #x61DD)
- (#x8FBEF8 #x61DE)
- (#x8FBEF9 #x61DF)
- (#x8FBEFA #x61E1)
- (#x8FBEFB #x61E2)
- (#x8FBEFC #x61E7)
- (#x8FBEFD #x61E9)
- (#x8FBEFE #x61E5)
- (#x8FBFA1 #x61EC)
- (#x8FBFA2 #x61ED)
- (#x8FBFA3 #x61EF)
- (#x8FBFA4 #x6201)
- (#x8FBFA5 #x6203)
- (#x8FBFA6 #x6204)
- (#x8FBFA7 #x6207)
- (#x8FBFA8 #x6213)
- (#x8FBFA9 #x6215)
- (#x8FBFAA #x621C)
- (#x8FBFAB #x6220)
- (#x8FBFAC #x6222)
- (#x8FBFAD #x6223)
- (#x8FBFAE #x6227)
- (#x8FBFAF #x6229)
- (#x8FBFB0 #x622B)
- (#x8FBFB1 #x6239)
- (#x8FBFB2 #x623D)
- (#x8FBFB3 #x6242)
- (#x8FBFB4 #x6243)
- (#x8FBFB5 #x6244)
- (#x8FBFB6 #x6246)
- (#x8FBFB7 #x624C)
- (#x8FBFB8 #x6250)
- (#x8FBFB9 #x6251)
- (#x8FBFBA #x6252)
- (#x8FBFBB #x6254)
- (#x8FBFBC #x6256)
- (#x8FBFBD #x625A)
- (#x8FBFBE #x625C)
- (#x8FBFBF #x6264)
- (#x8FBFC0 #x626D)
- (#x8FBFC1 #x626F)
- (#x8FBFC2 #x6273)
- (#x8FBFC3 #x627A)
- (#x8FBFC4 #x627D)
- (#x8FBFC5 #x628D)
- (#x8FBFC6 #x628E)
- (#x8FBFC7 #x628F)
- (#x8FBFC8 #x6290)
- (#x8FBFC9 #x62A6)
- (#x8FBFCA #x62A8)
- (#x8FBFCB #x62B3)
- (#x8FBFCC #x62B6)
- (#x8FBFCD #x62B7)
- (#x8FBFCE #x62BA)
- (#x8FBFCF #x62BE)
- (#x8FBFD0 #x62BF)
- (#x8FBFD1 #x62C4)
- (#x8FBFD2 #x62CE)
- (#x8FBFD3 #x62D5)
- (#x8FBFD4 #x62D6)
- (#x8FBFD5 #x62DA)
- (#x8FBFD6 #x62EA)
- (#x8FBFD7 #x62F2)
- (#x8FBFD8 #x62F4)
- (#x8FBFD9 #x62FC)
- (#x8FBFDA #x62FD)
- (#x8FBFDB #x6303)
- (#x8FBFDC #x6304)
- (#x8FBFDD #x630A)
- (#x8FBFDE #x630B)
- (#x8FBFDF #x630D)
- (#x8FBFE0 #x6310)
- (#x8FBFE1 #x6313)
- (#x8FBFE2 #x6316)
- (#x8FBFE3 #x6318)
- (#x8FBFE4 #x6329)
- (#x8FBFE5 #x632A)
- (#x8FBFE6 #x632D)
- (#x8FBFE7 #x6335)
- (#x8FBFE8 #x6336)
- (#x8FBFE9 #x6339)
- (#x8FBFEA #x633C)
- (#x8FBFEB #x6341)
- (#x8FBFEC #x6342)
- (#x8FBFED #x6343)
- (#x8FBFEE #x6344)
- (#x8FBFEF #x6346)
- (#x8FBFF0 #x634A)
- (#x8FBFF1 #x634B)
- (#x8FBFF2 #x634E)
- (#x8FBFF3 #x6352)
- (#x8FBFF4 #x6353)
- (#x8FBFF5 #x6354)
- (#x8FBFF6 #x6358)
- (#x8FBFF7 #x635B)
- (#x8FBFF8 #x6365)
- (#x8FBFF9 #x6366)
- (#x8FBFFA #x636C)
- (#x8FBFFB #x636D)
- (#x8FBFFC #x6371)
- (#x8FBFFD #x6374)
- (#x8FBFFE #x6375)
- (#x8FC0A1 #x6378)
- (#x8FC0A2 #x637C)
- (#x8FC0A3 #x637D)
- (#x8FC0A4 #x637F)
- (#x8FC0A5 #x6382)
- (#x8FC0A6 #x6384)
- (#x8FC0A7 #x6387)
- (#x8FC0A8 #x638A)
- (#x8FC0A9 #x6390)
- (#x8FC0AA #x6394)
- (#x8FC0AB #x6395)
- (#x8FC0AC #x6399)
- (#x8FC0AD #x639A)
- (#x8FC0AE #x639E)
- (#x8FC0AF #x63A4)
- (#x8FC0B0 #x63A6)
- (#x8FC0B1 #x63AD)
- (#x8FC0B2 #x63AE)
- (#x8FC0B3 #x63AF)
- (#x8FC0B4 #x63BD)
- (#x8FC0B5 #x63C1)
- (#x8FC0B6 #x63C5)
- (#x8FC0B7 #x63C8)
- (#x8FC0B8 #x63CE)
- (#x8FC0B9 #x63D1)
- (#x8FC0BA #x63D3)
- (#x8FC0BB #x63D4)
- (#x8FC0BC #x63D5)
- (#x8FC0BD #x63DC)
- (#x8FC0BE #x63E0)
- (#x8FC0BF #x63E5)
- (#x8FC0C0 #x63EA)
- (#x8FC0C1 #x63EC)
- (#x8FC0C2 #x63F2)
- (#x8FC0C3 #x63F3)
- (#x8FC0C4 #x63F5)
- (#x8FC0C5 #x63F8)
- (#x8FC0C6 #x63F9)
- (#x8FC0C7 #x6409)
- (#x8FC0C8 #x640A)
- (#x8FC0C9 #x6410)
- (#x8FC0CA #x6412)
- (#x8FC0CB #x6414)
- (#x8FC0CC #x6418)
- (#x8FC0CD #x641E)
- (#x8FC0CE #x6420)
- (#x8FC0CF #x6422)
- (#x8FC0D0 #x6424)
- (#x8FC0D1 #x6425)
- (#x8FC0D2 #x6429)
- (#x8FC0D3 #x642A)
- (#x8FC0D4 #x642F)
- (#x8FC0D5 #x6430)
- (#x8FC0D6 #x6435)
- (#x8FC0D7 #x643D)
- (#x8FC0D8 #x643F)
- (#x8FC0D9 #x644B)
- (#x8FC0DA #x644F)
- (#x8FC0DB #x6451)
- (#x8FC0DC #x6452)
- (#x8FC0DD #x6453)
- (#x8FC0DE #x6454)
- (#x8FC0DF #x645A)
- (#x8FC0E0 #x645B)
- (#x8FC0E1 #x645C)
- (#x8FC0E2 #x645D)
- (#x8FC0E3 #x645F)
- (#x8FC0E4 #x6460)
- (#x8FC0E5 #x6461)
- (#x8FC0E6 #x6463)
- (#x8FC0E7 #x646D)
- (#x8FC0E8 #x6473)
- (#x8FC0E9 #x6474)
- (#x8FC0EA #x647B)
- (#x8FC0EB #x647D)
- (#x8FC0EC #x6485)
- (#x8FC0ED #x6487)
- (#x8FC0EE #x648F)
- (#x8FC0EF #x6490)
- (#x8FC0F0 #x6491)
- (#x8FC0F1 #x6498)
- (#x8FC0F2 #x6499)
- (#x8FC0F3 #x649B)
- (#x8FC0F4 #x649D)
- (#x8FC0F5 #x649F)
- (#x8FC0F6 #x64A1)
- (#x8FC0F7 #x64A3)
- (#x8FC0F8 #x64A6)
- (#x8FC0F9 #x64A8)
- (#x8FC0FA #x64AC)
- (#x8FC0FB #x64B3)
- (#x8FC0FC #x64BD)
- (#x8FC0FD #x64BE)
- (#x8FC0FE #x64BF)
- (#x8FC1A1 #x64C4)
- (#x8FC1A2 #x64C9)
- (#x8FC1A3 #x64CA)
- (#x8FC1A4 #x64CB)
- (#x8FC1A5 #x64CC)
- (#x8FC1A6 #x64CE)
- (#x8FC1A7 #x64D0)
- (#x8FC1A8 #x64D1)
- (#x8FC1A9 #x64D5)
- (#x8FC1AA #x64D7)
- (#x8FC1AB #x64E4)
- (#x8FC1AC #x64E5)
- (#x8FC1AD #x64E9)
- (#x8FC1AE #x64EA)
- (#x8FC1AF #x64ED)
- (#x8FC1B0 #x64F0)
- (#x8FC1B1 #x64F5)
- (#x8FC1B2 #x64F7)
- (#x8FC1B3 #x64FB)
- (#x8FC1B4 #x64FF)
- (#x8FC1B5 #x6501)
- (#x8FC1B6 #x6504)
- (#x8FC1B7 #x6508)
- (#x8FC1B8 #x6509)
- (#x8FC1B9 #x650A)
- (#x8FC1BA #x650F)
- (#x8FC1BB #x6513)
- (#x8FC1BC #x6514)
- (#x8FC1BD #x6516)
- (#x8FC1BE #x6519)
- (#x8FC1BF #x651B)
- (#x8FC1C0 #x651E)
- (#x8FC1C1 #x651F)
- (#x8FC1C2 #x6522)
- (#x8FC1C3 #x6526)
- (#x8FC1C4 #x6529)
- (#x8FC1C5 #x652E)
- (#x8FC1C6 #x6531)
- (#x8FC1C7 #x653A)
- (#x8FC1C8 #x653C)
- (#x8FC1C9 #x653D)
- (#x8FC1CA #x6543)
- (#x8FC1CB #x6547)
- (#x8FC1CC #x6549)
- (#x8FC1CD #x6550)
- (#x8FC1CE #x6552)
- (#x8FC1CF #x6554)
- (#x8FC1D0 #x655F)
- (#x8FC1D1 #x6560)
- (#x8FC1D2 #x6567)
- (#x8FC1D3 #x656B)
- (#x8FC1D4 #x657A)
- (#x8FC1D5 #x657D)
- (#x8FC1D6 #x6581)
- (#x8FC1D7 #x6585)
- (#x8FC1D8 #x658A)
- (#x8FC1D9 #x6592)
- (#x8FC1DA #x6595)
- (#x8FC1DB #x6598)
- (#x8FC1DC #x659D)
- (#x8FC1DD #x65A0)
- (#x8FC1DE #x65A3)
- (#x8FC1DF #x65A6)
- (#x8FC1E0 #x65AE)
- (#x8FC1E1 #x65B2)
- (#x8FC1E2 #x65B3)
- (#x8FC1E3 #x65B4)
- (#x8FC1E4 #x65BF)
- (#x8FC1E5 #x65C2)
- (#x8FC1E6 #x65C8)
- (#x8FC1E7 #x65C9)
- (#x8FC1E8 #x65CE)
- (#x8FC1E9 #x65D0)
- (#x8FC1EA #x65D4)
- (#x8FC1EB #x65D6)
- (#x8FC1EC #x65D8)
- (#x8FC1ED #x65DF)
- (#x8FC1EE #x65F0)
- (#x8FC1EF #x65F2)
- (#x8FC1F0 #x65F4)
- (#x8FC1F1 #x65F5)
- (#x8FC1F2 #x65F9)
- (#x8FC1F3 #x65FE)
- (#x8FC1F4 #x65FF)
- (#x8FC1F5 #x6600)
- (#x8FC1F6 #x6604)
- (#x8FC1F7 #x6608)
- (#x8FC1F8 #x6609)
- (#x8FC1F9 #x660D)
- (#x8FC1FA #x6611)
- (#x8FC1FB #x6612)
- (#x8FC1FC #x6615)
- (#x8FC1FD #x6616)
- (#x8FC1FE #x661D)
- (#x8FC2A1 #x661E)
- (#x8FC2A2 #x6621)
- (#x8FC2A3 #x6622)
- (#x8FC2A4 #x6623)
- (#x8FC2A5 #x6624)
- (#x8FC2A6 #x6626)
- (#x8FC2A7 #x6629)
- (#x8FC2A8 #x662A)
- (#x8FC2A9 #x662B)
- (#x8FC2AA #x662C)
- (#x8FC2AB #x662E)
- (#x8FC2AC #x6630)
- (#x8FC2AD #x6631)
- (#x8FC2AE #x6633)
- (#x8FC2AF #x6639)
- (#x8FC2B0 #x6637)
- (#x8FC2B1 #x6640)
- (#x8FC2B2 #x6645)
- (#x8FC2B3 #x6646)
- (#x8FC2B4 #x664A)
- (#x8FC2B5 #x664C)
- (#x8FC2B6 #x6651)
- (#x8FC2B7 #x664E)
- (#x8FC2B8 #x6657)
- (#x8FC2B9 #x6658)
- (#x8FC2BA #x6659)
- (#x8FC2BB #x665B)
- (#x8FC2BC #x665C)
- (#x8FC2BD #x6660)
- (#x8FC2BE #x6661)
- (#x8FC2BF #x66FB)
- (#x8FC2C0 #x666A)
- (#x8FC2C1 #x666B)
- (#x8FC2C2 #x666C)
- (#x8FC2C3 #x667E)
- (#x8FC2C4 #x6673)
- (#x8FC2C5 #x6675)
- (#x8FC2C6 #x667F)
- (#x8FC2C7 #x6677)
- (#x8FC2C8 #x6678)
- (#x8FC2C9 #x6679)
- (#x8FC2CA #x667B)
- (#x8FC2CB #x6680)
- (#x8FC2CC #x667C)
- (#x8FC2CD #x668B)
- (#x8FC2CE #x668C)
- (#x8FC2CF #x668D)
- (#x8FC2D0 #x6690)
- (#x8FC2D1 #x6692)
- (#x8FC2D2 #x6699)
- (#x8FC2D3 #x669A)
- (#x8FC2D4 #x669B)
- (#x8FC2D5 #x669C)
- (#x8FC2D6 #x669F)
- (#x8FC2D7 #x66A0)
- (#x8FC2D8 #x66A4)
- (#x8FC2D9 #x66AD)
- (#x8FC2DA #x66B1)
- (#x8FC2DB #x66B2)
- (#x8FC2DC #x66B5)
- (#x8FC2DD #x66BB)
- (#x8FC2DE #x66BF)
- (#x8FC2DF #x66C0)
- (#x8FC2E0 #x66C2)
- (#x8FC2E1 #x66C3)
- (#x8FC2E2 #x66C8)
- (#x8FC2E3 #x66CC)
- (#x8FC2E4 #x66CE)
- (#x8FC2E5 #x66CF)
- (#x8FC2E6 #x66D4)
- (#x8FC2E7 #x66DB)
- (#x8FC2E8 #x66DF)
- (#x8FC2E9 #x66E8)
- (#x8FC2EA #x66EB)
- (#x8FC2EB #x66EC)
- (#x8FC2EC #x66EE)
- (#x8FC2ED #x66FA)
- (#x8FC2EE #x6705)
- (#x8FC2EF #x6707)
- (#x8FC2F0 #x670E)
- (#x8FC2F1 #x6713)
- (#x8FC2F2 #x6719)
- (#x8FC2F3 #x671C)
- (#x8FC2F4 #x6720)
- (#x8FC2F5 #x6722)
- (#x8FC2F6 #x6733)
- (#x8FC2F7 #x673E)
- (#x8FC2F8 #x6745)
- (#x8FC2F9 #x6747)
- (#x8FC2FA #x6748)
- (#x8FC2FB #x674C)
- (#x8FC2FC #x6754)
- (#x8FC2FD #x6755)
- (#x8FC2FE #x675D)
- (#x8FC3A1 #x6766)
- (#x8FC3A2 #x676C)
- (#x8FC3A3 #x676E)
- (#x8FC3A4 #x6774)
- (#x8FC3A5 #x6776)
- (#x8FC3A6 #x677B)
- (#x8FC3A7 #x6781)
- (#x8FC3A8 #x6784)
- (#x8FC3A9 #x678E)
- (#x8FC3AA #x678F)
- (#x8FC3AB #x6791)
- (#x8FC3AC #x6793)
- (#x8FC3AD #x6796)
- (#x8FC3AE #x6798)
- (#x8FC3AF #x6799)
- (#x8FC3B0 #x679B)
- (#x8FC3B1 #x67B0)
- (#x8FC3B2 #x67B1)
- (#x8FC3B3 #x67B2)
- (#x8FC3B4 #x67B5)
- (#x8FC3B5 #x67BB)
- (#x8FC3B6 #x67BC)
- (#x8FC3B7 #x67BD)
- (#x8FC3B8 #x67F9)
- (#x8FC3B9 #x67C0)
- (#x8FC3BA #x67C2)
- (#x8FC3BB #x67C3)
- (#x8FC3BC #x67C5)
- (#x8FC3BD #x67C8)
- (#x8FC3BE #x67C9)
- (#x8FC3BF #x67D2)
- (#x8FC3C0 #x67D7)
- (#x8FC3C1 #x67D9)
- (#x8FC3C2 #x67DC)
- (#x8FC3C3 #x67E1)
- (#x8FC3C4 #x67E6)
- (#x8FC3C5 #x67F0)
- (#x8FC3C6 #x67F2)
- (#x8FC3C7 #x67F6)
- (#x8FC3C8 #x67F7)
- (#x8FC3C9 #x6852)
- (#x8FC3CA #x6814)
- (#x8FC3CB #x6819)
- (#x8FC3CC #x681D)
- (#x8FC3CD #x681F)
- (#x8FC3CE #x6828)
- (#x8FC3CF #x6827)
- (#x8FC3D0 #x682C)
- (#x8FC3D1 #x682D)
- (#x8FC3D2 #x682F)
- (#x8FC3D3 #x6830)
- (#x8FC3D4 #x6831)
- (#x8FC3D5 #x6833)
- (#x8FC3D6 #x683B)
- (#x8FC3D7 #x683F)
- (#x8FC3D8 #x6844)
- (#x8FC3D9 #x6845)
- (#x8FC3DA #x684A)
- (#x8FC3DB #x684C)
- (#x8FC3DC #x6855)
- (#x8FC3DD #x6857)
- (#x8FC3DE #x6858)
- (#x8FC3DF #x685B)
- (#x8FC3E0 #x686B)
- (#x8FC3E1 #x686E)
- (#x8FC3E2 #x686F)
- (#x8FC3E3 #x6870)
- (#x8FC3E4 #x6871)
- (#x8FC3E5 #x6872)
- (#x8FC3E6 #x6875)
- (#x8FC3E7 #x6879)
- (#x8FC3E8 #x687A)
- (#x8FC3E9 #x687B)
- (#x8FC3EA #x687C)
- (#x8FC3EB #x6882)
- (#x8FC3EC #x6884)
- (#x8FC3ED #x6886)
- (#x8FC3EE #x6888)
- (#x8FC3EF #x6896)
- (#x8FC3F0 #x6898)
- (#x8FC3F1 #x689A)
- (#x8FC3F2 #x689C)
- (#x8FC3F3 #x68A1)
- (#x8FC3F4 #x68A3)
- (#x8FC3F5 #x68A5)
- (#x8FC3F6 #x68A9)
- (#x8FC3F7 #x68AA)
- (#x8FC3F8 #x68AE)
- (#x8FC3F9 #x68B2)
- (#x8FC3FA #x68BB)
- (#x8FC3FB #x68C5)
- (#x8FC3FC #x68C8)
- (#x8FC3FD #x68CC)
- (#x8FC3FE #x68CF)
- (#x8FC4A1 #x68D0)
- (#x8FC4A2 #x68D1)
- (#x8FC4A3 #x68D3)
- (#x8FC4A4 #x68D6)
- (#x8FC4A5 #x68D9)
- (#x8FC4A6 #x68DC)
- (#x8FC4A7 #x68DD)
- (#x8FC4A8 #x68E5)
- (#x8FC4A9 #x68E8)
- (#x8FC4AA #x68EA)
- (#x8FC4AB #x68EB)
- (#x8FC4AC #x68EC)
- (#x8FC4AD #x68ED)
- (#x8FC4AE #x68F0)
- (#x8FC4AF #x68F1)
- (#x8FC4B0 #x68F5)
- (#x8FC4B1 #x68F6)
- (#x8FC4B2 #x68FB)
- (#x8FC4B3 #x68FC)
- (#x8FC4B4 #x68FD)
- (#x8FC4B5 #x6906)
- (#x8FC4B6 #x6909)
- (#x8FC4B7 #x690A)
- (#x8FC4B8 #x6910)
- (#x8FC4B9 #x6911)
- (#x8FC4BA #x6913)
- (#x8FC4BB #x6916)
- (#x8FC4BC #x6917)
- (#x8FC4BD #x6931)
- (#x8FC4BE #x6933)
- (#x8FC4BF #x6935)
- (#x8FC4C0 #x6938)
- (#x8FC4C1 #x693B)
- (#x8FC4C2 #x6942)
- (#x8FC4C3 #x6945)
- (#x8FC4C4 #x6949)
- (#x8FC4C5 #x694E)
- (#x8FC4C6 #x6957)
- (#x8FC4C7 #x695B)
- (#x8FC4C8 #x6963)
- (#x8FC4C9 #x6964)
- (#x8FC4CA #x6965)
- (#x8FC4CB #x6966)
- (#x8FC4CC #x6968)
- (#x8FC4CD #x6969)
- (#x8FC4CE #x696C)
- (#x8FC4CF #x6970)
- (#x8FC4D0 #x6971)
- (#x8FC4D1 #x6972)
- (#x8FC4D2 #x697A)
- (#x8FC4D3 #x697B)
- (#x8FC4D4 #x697F)
- (#x8FC4D5 #x6980)
- (#x8FC4D6 #x698D)
- (#x8FC4D7 #x6992)
- (#x8FC4D8 #x6996)
- (#x8FC4D9 #x6998)
- (#x8FC4DA #x69A1)
- (#x8FC4DB #x69A5)
- (#x8FC4DC #x69A6)
- (#x8FC4DD #x69A8)
- (#x8FC4DE #x69AB)
- (#x8FC4DF #x69AD)
- (#x8FC4E0 #x69AF)
- (#x8FC4E1 #x69B7)
- (#x8FC4E2 #x69B8)
- (#x8FC4E3 #x69BA)
- (#x8FC4E4 #x69BC)
- (#x8FC4E5 #x69C5)
- (#x8FC4E6 #x69C8)
- (#x8FC4E7 #x69D1)
- (#x8FC4E8 #x69D6)
- (#x8FC4E9 #x69D7)
- (#x8FC4EA #x69E2)
- (#x8FC4EB #x69E5)
- (#x8FC4EC #x69EE)
- (#x8FC4ED #x69EF)
- (#x8FC4EE #x69F1)
- (#x8FC4EF #x69F3)
- (#x8FC4F0 #x69F5)
- (#x8FC4F1 #x69FE)
- (#x8FC4F2 #x6A00)
- (#x8FC4F3 #x6A01)
- (#x8FC4F4 #x6A03)
- (#x8FC4F5 #x6A0F)
- (#x8FC4F6 #x6A11)
- (#x8FC4F7 #x6A15)
- (#x8FC4F8 #x6A1A)
- (#x8FC4F9 #x6A1D)
- (#x8FC4FA #x6A20)
- (#x8FC4FB #x6A24)
- (#x8FC4FC #x6A28)
- (#x8FC4FD #x6A30)
- (#x8FC4FE #x6A32)
- (#x8FC5A1 #x6A34)
- (#x8FC5A2 #x6A37)
- (#x8FC5A3 #x6A3B)
- (#x8FC5A4 #x6A3E)
- (#x8FC5A5 #x6A3F)
- (#x8FC5A6 #x6A45)
- (#x8FC5A7 #x6A46)
- (#x8FC5A8 #x6A49)
- (#x8FC5A9 #x6A4A)
- (#x8FC5AA #x6A4E)
- (#x8FC5AB #x6A50)
- (#x8FC5AC #x6A51)
- (#x8FC5AD #x6A52)
- (#x8FC5AE #x6A55)
- (#x8FC5AF #x6A56)
- (#x8FC5B0 #x6A5B)
- (#x8FC5B1 #x6A64)
- (#x8FC5B2 #x6A67)
- (#x8FC5B3 #x6A6A)
- (#x8FC5B4 #x6A71)
- (#x8FC5B5 #x6A73)
- (#x8FC5B6 #x6A7E)
- (#x8FC5B7 #x6A81)
- (#x8FC5B8 #x6A83)
- (#x8FC5B9 #x6A86)
- (#x8FC5BA #x6A87)
- (#x8FC5BB #x6A89)
- (#x8FC5BC #x6A8B)
- (#x8FC5BD #x6A91)
- (#x8FC5BE #x6A9B)
- (#x8FC5BF #x6A9D)
- (#x8FC5C0 #x6A9E)
- (#x8FC5C1 #x6A9F)
- (#x8FC5C2 #x6AA5)
- (#x8FC5C3 #x6AAB)
- (#x8FC5C4 #x6AAF)
- (#x8FC5C5 #x6AB0)
- (#x8FC5C6 #x6AB1)
- (#x8FC5C7 #x6AB4)
- (#x8FC5C8 #x6ABD)
- (#x8FC5C9 #x6ABE)
- (#x8FC5CA #x6ABF)
- (#x8FC5CB #x6AC6)
- (#x8FC5CC #x6AC9)
- (#x8FC5CD #x6AC8)
- (#x8FC5CE #x6ACC)
- (#x8FC5CF #x6AD0)
- (#x8FC5D0 #x6AD4)
- (#x8FC5D1 #x6AD5)
- (#x8FC5D2 #x6AD6)
- (#x8FC5D3 #x6ADC)
- (#x8FC5D4 #x6ADD)
- (#x8FC5D5 #x6AE4)
- (#x8FC5D6 #x6AE7)
- (#x8FC5D7 #x6AEC)
- (#x8FC5D8 #x6AF0)
- (#x8FC5D9 #x6AF1)
- (#x8FC5DA #x6AF2)
- (#x8FC5DB #x6AFC)
- (#x8FC5DC #x6AFD)
- (#x8FC5DD #x6B02)
- (#x8FC5DE #x6B03)
- (#x8FC5DF #x6B06)
- (#x8FC5E0 #x6B07)
- (#x8FC5E1 #x6B09)
- (#x8FC5E2 #x6B0F)
- (#x8FC5E3 #x6B10)
- (#x8FC5E4 #x6B11)
- (#x8FC5E5 #x6B17)
- (#x8FC5E6 #x6B1B)
- (#x8FC5E7 #x6B1E)
- (#x8FC5E8 #x6B24)
- (#x8FC5E9 #x6B28)
- (#x8FC5EA #x6B2B)
- (#x8FC5EB #x6B2C)
- (#x8FC5EC #x6B2F)
- (#x8FC5ED #x6B35)
- (#x8FC5EE #x6B36)
- (#x8FC5EF #x6B3B)
- (#x8FC5F0 #x6B3F)
- (#x8FC5F1 #x6B46)
- (#x8FC5F2 #x6B4A)
- (#x8FC5F3 #x6B4D)
- (#x8FC5F4 #x6B52)
- (#x8FC5F5 #x6B56)
- (#x8FC5F6 #x6B58)
- (#x8FC5F7 #x6B5D)
- (#x8FC5F8 #x6B60)
- (#x8FC5F9 #x6B67)
- (#x8FC5FA #x6B6B)
- (#x8FC5FB #x6B6E)
- (#x8FC5FC #x6B70)
- (#x8FC5FD #x6B75)
- (#x8FC5FE #x6B7D)
- (#x8FC6A1 #x6B7E)
- (#x8FC6A2 #x6B82)
- (#x8FC6A3 #x6B85)
- (#x8FC6A4 #x6B97)
- (#x8FC6A5 #x6B9B)
- (#x8FC6A6 #x6B9F)
- (#x8FC6A7 #x6BA0)
- (#x8FC6A8 #x6BA2)
- (#x8FC6A9 #x6BA3)
- (#x8FC6AA #x6BA8)
- (#x8FC6AB #x6BA9)
- (#x8FC6AC #x6BAC)
- (#x8FC6AD #x6BAD)
- (#x8FC6AE #x6BAE)
- (#x8FC6AF #x6BB0)
- (#x8FC6B0 #x6BB8)
- (#x8FC6B1 #x6BB9)
- (#x8FC6B2 #x6BBD)
- (#x8FC6B3 #x6BBE)
- (#x8FC6B4 #x6BC3)
- (#x8FC6B5 #x6BC4)
- (#x8FC6B6 #x6BC9)
- (#x8FC6B7 #x6BCC)
- (#x8FC6B8 #x6BD6)
- (#x8FC6B9 #x6BDA)
- (#x8FC6BA #x6BE1)
- (#x8FC6BB #x6BE3)
- (#x8FC6BC #x6BE6)
- (#x8FC6BD #x6BE7)
- (#x8FC6BE #x6BEE)
- (#x8FC6BF #x6BF1)
- (#x8FC6C0 #x6BF7)
- (#x8FC6C1 #x6BF9)
- (#x8FC6C2 #x6BFF)
- (#x8FC6C3 #x6C02)
- (#x8FC6C4 #x6C04)
- (#x8FC6C5 #x6C05)
- (#x8FC6C6 #x6C09)
- (#x8FC6C7 #x6C0D)
- (#x8FC6C8 #x6C0E)
- (#x8FC6C9 #x6C10)
- (#x8FC6CA #x6C12)
- (#x8FC6CB #x6C19)
- (#x8FC6CC #x6C1F)
- (#x8FC6CD #x6C26)
- (#x8FC6CE #x6C27)
- (#x8FC6CF #x6C28)
- (#x8FC6D0 #x6C2C)
- (#x8FC6D1 #x6C2E)
- (#x8FC6D2 #x6C33)
- (#x8FC6D3 #x6C35)
- (#x8FC6D4 #x6C36)
- (#x8FC6D5 #x6C3A)
- (#x8FC6D6 #x6C3B)
- (#x8FC6D7 #x6C3F)
- (#x8FC6D8 #x6C4A)
- (#x8FC6D9 #x6C4B)
- (#x8FC6DA #x6C4D)
- (#x8FC6DB #x6C4F)
- (#x8FC6DC #x6C52)
- (#x8FC6DD #x6C54)
- (#x8FC6DE #x6C59)
- (#x8FC6DF #x6C5B)
- (#x8FC6E0 #x6C5C)
- (#x8FC6E1 #x6C6B)
- (#x8FC6E2 #x6C6D)
- (#x8FC6E3 #x6C6F)
- (#x8FC6E4 #x6C74)
- (#x8FC6E5 #x6C76)
- (#x8FC6E6 #x6C78)
- (#x8FC6E7 #x6C79)
- (#x8FC6E8 #x6C7B)
- (#x8FC6E9 #x6C85)
- (#x8FC6EA #x6C86)
- (#x8FC6EB #x6C87)
- (#x8FC6EC #x6C89)
- (#x8FC6ED #x6C94)
- (#x8FC6EE #x6C95)
- (#x8FC6EF #x6C97)
- (#x8FC6F0 #x6C98)
- (#x8FC6F1 #x6C9C)
- (#x8FC6F2 #x6C9F)
- (#x8FC6F3 #x6CB0)
- (#x8FC6F4 #x6CB2)
- (#x8FC6F5 #x6CB4)
- (#x8FC6F6 #x6CC2)
- (#x8FC6F7 #x6CC6)
- (#x8FC6F8 #x6CCD)
- (#x8FC6F9 #x6CCF)
- (#x8FC6FA #x6CD0)
- (#x8FC6FB #x6CD1)
- (#x8FC6FC #x6CD2)
- (#x8FC6FD #x6CD4)
- (#x8FC6FE #x6CD6)
- (#x8FC7A1 #x6CDA)
- (#x8FC7A2 #x6CDC)
- (#x8FC7A3 #x6CE0)
- (#x8FC7A4 #x6CE7)
- (#x8FC7A5 #x6CE9)
- (#x8FC7A6 #x6CEB)
- (#x8FC7A7 #x6CEC)
- (#x8FC7A8 #x6CEE)
- (#x8FC7A9 #x6CF2)
- (#x8FC7AA #x6CF4)
- (#x8FC7AB #x6D04)
- (#x8FC7AC #x6D07)
- (#x8FC7AD #x6D0A)
- (#x8FC7AE #x6D0E)
- (#x8FC7AF #x6D0F)
- (#x8FC7B0 #x6D11)
- (#x8FC7B1 #x6D13)
- (#x8FC7B2 #x6D1A)
- (#x8FC7B3 #x6D26)
- (#x8FC7B4 #x6D27)
- (#x8FC7B5 #x6D28)
- (#x8FC7B6 #x6C67)
- (#x8FC7B7 #x6D2E)
- (#x8FC7B8 #x6D2F)
- (#x8FC7B9 #x6D31)
- (#x8FC7BA #x6D39)
- (#x8FC7BB #x6D3C)
- (#x8FC7BC #x6D3F)
- (#x8FC7BD #x6D57)
- (#x8FC7BE #x6D5E)
- (#x8FC7BF #x6D5F)
- (#x8FC7C0 #x6D61)
- (#x8FC7C1 #x6D65)
- (#x8FC7C2 #x6D67)
- (#x8FC7C3 #x6D6F)
- (#x8FC7C4 #x6D70)
- (#x8FC7C5 #x6D7C)
- (#x8FC7C6 #x6D82)
- (#x8FC7C7 #x6D87)
- (#x8FC7C8 #x6D91)
- (#x8FC7C9 #x6D92)
- (#x8FC7CA #x6D94)
- (#x8FC7CB #x6D96)
- (#x8FC7CC #x6D97)
- (#x8FC7CD #x6D98)
- (#x8FC7CE #x6DAA)
- (#x8FC7CF #x6DAC)
- (#x8FC7D0 #x6DB4)
- (#x8FC7D1 #x6DB7)
- (#x8FC7D2 #x6DB9)
- (#x8FC7D3 #x6DBD)
- (#x8FC7D4 #x6DBF)
- (#x8FC7D5 #x6DC4)
- (#x8FC7D6 #x6DC8)
- (#x8FC7D7 #x6DCA)
- (#x8FC7D8 #x6DCE)
- (#x8FC7D9 #x6DCF)
- (#x8FC7DA #x6DD6)
- (#x8FC7DB #x6DDB)
- (#x8FC7DC #x6DDD)
- (#x8FC7DD #x6DDF)
- (#x8FC7DE #x6DE0)
- (#x8FC7DF #x6DE2)
- (#x8FC7E0 #x6DE5)
- (#x8FC7E1 #x6DE9)
- (#x8FC7E2 #x6DEF)
- (#x8FC7E3 #x6DF0)
- (#x8FC7E4 #x6DF4)
- (#x8FC7E5 #x6DF6)
- (#x8FC7E6 #x6DFC)
- (#x8FC7E7 #x6E00)
- (#x8FC7E8 #x6E04)
- (#x8FC7E9 #x6E1E)
- (#x8FC7EA #x6E22)
- (#x8FC7EB #x6E27)
- (#x8FC7EC #x6E32)
- (#x8FC7ED #x6E36)
- (#x8FC7EE #x6E39)
- (#x8FC7EF #x6E3B)
- (#x8FC7F0 #x6E3C)
- (#x8FC7F1 #x6E44)
- (#x8FC7F2 #x6E45)
- (#x8FC7F3 #x6E48)
- (#x8FC7F4 #x6E49)
- (#x8FC7F5 #x6E4B)
- (#x8FC7F6 #x6E4F)
- (#x8FC7F7 #x6E51)
- (#x8FC7F8 #x6E52)
- (#x8FC7F9 #x6E53)
- (#x8FC7FA #x6E54)
- (#x8FC7FB #x6E57)
- (#x8FC7FC #x6E5C)
- (#x8FC7FD #x6E5D)
- (#x8FC7FE #x6E5E)
- (#x8FC8A1 #x6E62)
- (#x8FC8A2 #x6E63)
- (#x8FC8A3 #x6E68)
- (#x8FC8A4 #x6E73)
- (#x8FC8A5 #x6E7B)
- (#x8FC8A6 #x6E7D)
- (#x8FC8A7 #x6E8D)
- (#x8FC8A8 #x6E93)
- (#x8FC8A9 #x6E99)
- (#x8FC8AA #x6EA0)
- (#x8FC8AB #x6EA7)
- (#x8FC8AC #x6EAD)
- (#x8FC8AD #x6EAE)
- (#x8FC8AE #x6EB1)
- (#x8FC8AF #x6EB3)
- (#x8FC8B0 #x6EBB)
- (#x8FC8B1 #x6EBF)
- (#x8FC8B2 #x6EC0)
- (#x8FC8B3 #x6EC1)
- (#x8FC8B4 #x6EC3)
- (#x8FC8B5 #x6EC7)
- (#x8FC8B6 #x6EC8)
- (#x8FC8B7 #x6ECA)
- (#x8FC8B8 #x6ECD)
- (#x8FC8B9 #x6ECE)
- (#x8FC8BA #x6ECF)
- (#x8FC8BB #x6EEB)
- (#x8FC8BC #x6EED)
- (#x8FC8BD #x6EEE)
- (#x8FC8BE #x6EF9)
- (#x8FC8BF #x6EFB)
- (#x8FC8C0 #x6EFD)
- (#x8FC8C1 #x6F04)
- (#x8FC8C2 #x6F08)
- (#x8FC8C3 #x6F0A)
- (#x8FC8C4 #x6F0C)
- (#x8FC8C5 #x6F0D)
- (#x8FC8C6 #x6F16)
- (#x8FC8C7 #x6F18)
- (#x8FC8C8 #x6F1A)
- (#x8FC8C9 #x6F1B)
- (#x8FC8CA #x6F26)
- (#x8FC8CB #x6F29)
- (#x8FC8CC #x6F2A)
- (#x8FC8CD #x6F2F)
- (#x8FC8CE #x6F30)
- (#x8FC8CF #x6F33)
- (#x8FC8D0 #x6F36)
- (#x8FC8D1 #x6F3B)
- (#x8FC8D2 #x6F3C)
- (#x8FC8D3 #x6F2D)
- (#x8FC8D4 #x6F4F)
- (#x8FC8D5 #x6F51)
- (#x8FC8D6 #x6F52)
- (#x8FC8D7 #x6F53)
- (#x8FC8D8 #x6F57)
- (#x8FC8D9 #x6F59)
- (#x8FC8DA #x6F5A)
- (#x8FC8DB #x6F5D)
- (#x8FC8DC #x6F5E)
- (#x8FC8DD #x6F61)
- (#x8FC8DE #x6F62)
- (#x8FC8DF #x6F68)
- (#x8FC8E0 #x6F6C)
- (#x8FC8E1 #x6F7D)
- (#x8FC8E2 #x6F7E)
- (#x8FC8E3 #x6F83)
- (#x8FC8E4 #x6F87)
- (#x8FC8E5 #x6F88)
- (#x8FC8E6 #x6F8B)
- (#x8FC8E7 #x6F8C)
- (#x8FC8E8 #x6F8D)
- (#x8FC8E9 #x6F90)
- (#x8FC8EA #x6F92)
- (#x8FC8EB #x6F93)
- (#x8FC8EC #x6F94)
- (#x8FC8ED #x6F96)
- (#x8FC8EE #x6F9A)
- (#x8FC8EF #x6F9F)
- (#x8FC8F0 #x6FA0)
- (#x8FC8F1 #x6FA5)
- (#x8FC8F2 #x6FA6)
- (#x8FC8F3 #x6FA7)
- (#x8FC8F4 #x6FA8)
- (#x8FC8F5 #x6FAE)
- (#x8FC8F6 #x6FAF)
- (#x8FC8F7 #x6FB0)
- (#x8FC8F8 #x6FB5)
- (#x8FC8F9 #x6FB6)
- (#x8FC8FA #x6FBC)
- (#x8FC8FB #x6FC5)
- (#x8FC8FC #x6FC7)
- (#x8FC8FD #x6FC8)
- (#x8FC8FE #x6FCA)
- (#x8FC9A1 #x6FDA)
- (#x8FC9A2 #x6FDE)
- (#x8FC9A3 #x6FE8)
- (#x8FC9A4 #x6FE9)
- (#x8FC9A5 #x6FF0)
- (#x8FC9A6 #x6FF5)
- (#x8FC9A7 #x6FF9)
- (#x8FC9A8 #x6FFC)
- (#x8FC9A9 #x6FFD)
- (#x8FC9AA #x7000)
- (#x8FC9AB #x7005)
- (#x8FC9AC #x7006)
- (#x8FC9AD #x7007)
- (#x8FC9AE #x700D)
- (#x8FC9AF #x7017)
- (#x8FC9B0 #x7020)
- (#x8FC9B1 #x7023)
- (#x8FC9B2 #x702F)
- (#x8FC9B3 #x7034)
- (#x8FC9B4 #x7037)
- (#x8FC9B5 #x7039)
- (#x8FC9B6 #x703C)
- (#x8FC9B7 #x7043)
- (#x8FC9B8 #x7044)
- (#x8FC9B9 #x7048)
- (#x8FC9BA #x7049)
- (#x8FC9BB #x704A)
- (#x8FC9BC #x704B)
- (#x8FC9BD #x7054)
- (#x8FC9BE #x7055)
- (#x8FC9BF #x705D)
- (#x8FC9C0 #x705E)
- (#x8FC9C1 #x704E)
- (#x8FC9C2 #x7064)
- (#x8FC9C3 #x7065)
- (#x8FC9C4 #x706C)
- (#x8FC9C5 #x706E)
- (#x8FC9C6 #x7075)
- (#x8FC9C7 #x7076)
- (#x8FC9C8 #x707E)
- (#x8FC9C9 #x7081)
- (#x8FC9CA #x7085)
- (#x8FC9CB #x7086)
- (#x8FC9CC #x7094)
- (#x8FC9CD #x7095)
- (#x8FC9CE #x7096)
- (#x8FC9CF #x7097)
- (#x8FC9D0 #x7098)
- (#x8FC9D1 #x709B)
- (#x8FC9D2 #x70A4)
- (#x8FC9D3 #x70AB)
- (#x8FC9D4 #x70B0)
- (#x8FC9D5 #x70B1)
- (#x8FC9D6 #x70B4)
- (#x8FC9D7 #x70B7)
- (#x8FC9D8 #x70CA)
- (#x8FC9D9 #x70D1)
- (#x8FC9DA #x70D3)
- (#x8FC9DB #x70D4)
- (#x8FC9DC #x70D5)
- (#x8FC9DD #x70D6)
- (#x8FC9DE #x70D8)
- (#x8FC9DF #x70DC)
- (#x8FC9E0 #x70E4)
- (#x8FC9E1 #x70FA)
- (#x8FC9E2 #x7103)
- (#x8FC9E3 #x7104)
- (#x8FC9E4 #x7105)
- (#x8FC9E5 #x7106)
- (#x8FC9E6 #x7107)
- (#x8FC9E7 #x710B)
- (#x8FC9E8 #x710C)
- (#x8FC9E9 #x710F)
- (#x8FC9EA #x711E)
- (#x8FC9EB #x7120)
- (#x8FC9EC #x712B)
- (#x8FC9ED #x712D)
- (#x8FC9EE #x712F)
- (#x8FC9EF #x7130)
- (#x8FC9F0 #x7131)
- (#x8FC9F1 #x7138)
- (#x8FC9F2 #x7141)
- (#x8FC9F3 #x7145)
- (#x8FC9F4 #x7146)
- (#x8FC9F5 #x7147)
- (#x8FC9F6 #x714A)
- (#x8FC9F7 #x714B)
- (#x8FC9F8 #x7150)
- (#x8FC9F9 #x7152)
- (#x8FC9FA #x7157)
- (#x8FC9FB #x715A)
- (#x8FC9FC #x715C)
- (#x8FC9FD #x715E)
- (#x8FC9FE #x7160)
- (#x8FCAA1 #x7168)
- (#x8FCAA2 #x7179)
- (#x8FCAA3 #x7180)
- (#x8FCAA4 #x7185)
- (#x8FCAA5 #x7187)
- (#x8FCAA6 #x718C)
- (#x8FCAA7 #x7192)
- (#x8FCAA8 #x719A)
- (#x8FCAA9 #x719B)
- (#x8FCAAA #x71A0)
- (#x8FCAAB #x71A2)
- (#x8FCAAC #x71AF)
- (#x8FCAAD #x71B0)
- (#x8FCAAE #x71B2)
- (#x8FCAAF #x71B3)
- (#x8FCAB0 #x71BA)
- (#x8FCAB1 #x71BF)
- (#x8FCAB2 #x71C0)
- (#x8FCAB3 #x71C1)
- (#x8FCAB4 #x71C4)
- (#x8FCAB5 #x71CB)
- (#x8FCAB6 #x71CC)
- (#x8FCAB7 #x71D3)
- (#x8FCAB8 #x71D6)
- (#x8FCAB9 #x71D9)
- (#x8FCABA #x71DA)
- (#x8FCABB #x71DC)
- (#x8FCABC #x71F8)
- (#x8FCABD #x71FE)
- (#x8FCABE #x7200)
- (#x8FCABF #x7207)
- (#x8FCAC0 #x7208)
- (#x8FCAC1 #x7209)
- (#x8FCAC2 #x7213)
- (#x8FCAC3 #x7217)
- (#x8FCAC4 #x721A)
- (#x8FCAC5 #x721D)
- (#x8FCAC6 #x721F)
- (#x8FCAC7 #x7224)
- (#x8FCAC8 #x722B)
- (#x8FCAC9 #x722F)
- (#x8FCACA #x7234)
- (#x8FCACB #x7238)
- (#x8FCACC #x7239)
- (#x8FCACD #x7241)
- (#x8FCACE #x7242)
- (#x8FCACF #x7243)
- (#x8FCAD0 #x7245)
- (#x8FCAD1 #x724E)
- (#x8FCAD2 #x724F)
- (#x8FCAD3 #x7250)
- (#x8FCAD4 #x7253)
- (#x8FCAD5 #x7255)
- (#x8FCAD6 #x7256)
- (#x8FCAD7 #x725A)
- (#x8FCAD8 #x725C)
- (#x8FCAD9 #x725E)
- (#x8FCADA #x7260)
- (#x8FCADB #x7263)
- (#x8FCADC #x7268)
- (#x8FCADD #x726B)
- (#x8FCADE #x726E)
- (#x8FCADF #x726F)
- (#x8FCAE0 #x7271)
- (#x8FCAE1 #x7277)
- (#x8FCAE2 #x7278)
- (#x8FCAE3 #x727B)
- (#x8FCAE4 #x727C)
- (#x8FCAE5 #x727F)
- (#x8FCAE6 #x7284)
- (#x8FCAE7 #x7289)
- (#x8FCAE8 #x728D)
- (#x8FCAE9 #x728E)
- (#x8FCAEA #x7293)
- (#x8FCAEB #x729B)
- (#x8FCAEC #x72A8)
- (#x8FCAED #x72AD)
- (#x8FCAEE #x72AE)
- (#x8FCAEF #x72B1)
- (#x8FCAF0 #x72B4)
- (#x8FCAF1 #x72BE)
- (#x8FCAF2 #x72C1)
- (#x8FCAF3 #x72C7)
- (#x8FCAF4 #x72C9)
- (#x8FCAF5 #x72CC)
- (#x8FCAF6 #x72D5)
- (#x8FCAF7 #x72D6)
- (#x8FCAF8 #x72D8)
- (#x8FCAF9 #x72DF)
- (#x8FCAFA #x72E5)
- (#x8FCAFB #x72F3)
- (#x8FCAFC #x72F4)
- (#x8FCAFD #x72FA)
- (#x8FCAFE #x72FB)
- (#x8FCBA1 #x72FE)
- (#x8FCBA2 #x7302)
- (#x8FCBA3 #x7304)
- (#x8FCBA4 #x7305)
- (#x8FCBA5 #x7307)
- (#x8FCBA6 #x730B)
- (#x8FCBA7 #x730D)
- (#x8FCBA8 #x7312)
- (#x8FCBA9 #x7313)
- (#x8FCBAA #x7318)
- (#x8FCBAB #x7319)
- (#x8FCBAC #x731E)
- (#x8FCBAD #x7322)
- (#x8FCBAE #x7324)
- (#x8FCBAF #x7327)
- (#x8FCBB0 #x7328)
- (#x8FCBB1 #x732C)
- (#x8FCBB2 #x7331)
- (#x8FCBB3 #x7332)
- (#x8FCBB4 #x7335)
- (#x8FCBB5 #x733A)
- (#x8FCBB6 #x733B)
- (#x8FCBB7 #x733D)
- (#x8FCBB8 #x7343)
- (#x8FCBB9 #x734D)
- (#x8FCBBA #x7350)
- (#x8FCBBB #x7352)
- (#x8FCBBC #x7356)
- (#x8FCBBD #x7358)
- (#x8FCBBE #x735D)
- (#x8FCBBF #x735E)
- (#x8FCBC0 #x735F)
- (#x8FCBC1 #x7360)
- (#x8FCBC2 #x7366)
- (#x8FCBC3 #x7367)
- (#x8FCBC4 #x7369)
- (#x8FCBC5 #x736B)
- (#x8FCBC6 #x736C)
- (#x8FCBC7 #x736E)
- (#x8FCBC8 #x736F)
- (#x8FCBC9 #x7371)
- (#x8FCBCA #x7377)
- (#x8FCBCB #x7379)
- (#x8FCBCC #x737C)
- (#x8FCBCD #x7380)
- (#x8FCBCE #x7381)
- (#x8FCBCF #x7383)
- (#x8FCBD0 #x7385)
- (#x8FCBD1 #x7386)
- (#x8FCBD2 #x738E)
- (#x8FCBD3 #x7390)
- (#x8FCBD4 #x7393)
- (#x8FCBD5 #x7395)
- (#x8FCBD6 #x7397)
- (#x8FCBD7 #x7398)
- (#x8FCBD8 #x739C)
- (#x8FCBD9 #x739E)
- (#x8FCBDA #x739F)
- (#x8FCBDB #x73A0)
- (#x8FCBDC #x73A2)
- (#x8FCBDD #x73A5)
- (#x8FCBDE #x73A6)
- (#x8FCBDF #x73AA)
- (#x8FCBE0 #x73AB)
- (#x8FCBE1 #x73AD)
- (#x8FCBE2 #x73B5)
- (#x8FCBE3 #x73B7)
- (#x8FCBE4 #x73B9)
- (#x8FCBE5 #x73BC)
- (#x8FCBE6 #x73BD)
- (#x8FCBE7 #x73BF)
- (#x8FCBE8 #x73C5)
- (#x8FCBE9 #x73C6)
- (#x8FCBEA #x73C9)
- (#x8FCBEB #x73CB)
- (#x8FCBEC #x73CC)
- (#x8FCBED #x73CF)
- (#x8FCBEE #x73D2)
- (#x8FCBEF #x73D3)
- (#x8FCBF0 #x73D6)
- (#x8FCBF1 #x73D9)
- (#x8FCBF2 #x73DD)
- (#x8FCBF3 #x73E1)
- (#x8FCBF4 #x73E3)
- (#x8FCBF5 #x73E6)
- (#x8FCBF6 #x73E7)
- (#x8FCBF7 #x73E9)
- (#x8FCBF8 #x73F4)
- (#x8FCBF9 #x73F5)
- (#x8FCBFA #x73F7)
- (#x8FCBFB #x73F9)
- (#x8FCBFC #x73FA)
- (#x8FCBFD #x73FB)
- (#x8FCBFE #x73FD)
- (#x8FCCA1 #x73FF)
- (#x8FCCA2 #x7400)
- (#x8FCCA3 #x7401)
- (#x8FCCA4 #x7404)
- (#x8FCCA5 #x7407)
- (#x8FCCA6 #x740A)
- (#x8FCCA7 #x7411)
- (#x8FCCA8 #x741A)
- (#x8FCCA9 #x741B)
- (#x8FCCAA #x7424)
- (#x8FCCAB #x7426)
- (#x8FCCAC #x7428)
- (#x8FCCAD #x7429)
- (#x8FCCAE #x742A)
- (#x8FCCAF #x742B)
- (#x8FCCB0 #x742C)
- (#x8FCCB1 #x742D)
- (#x8FCCB2 #x742E)
- (#x8FCCB3 #x742F)
- (#x8FCCB4 #x7430)
- (#x8FCCB5 #x7431)
- (#x8FCCB6 #x7439)
- (#x8FCCB7 #x7440)
- (#x8FCCB8 #x7443)
- (#x8FCCB9 #x7444)
- (#x8FCCBA #x7446)
- (#x8FCCBB #x7447)
- (#x8FCCBC #x744B)
- (#x8FCCBD #x744D)
- (#x8FCCBE #x7451)
- (#x8FCCBF #x7452)
- (#x8FCCC0 #x7457)
- (#x8FCCC1 #x745D)
- (#x8FCCC2 #x7462)
- (#x8FCCC3 #x7466)
- (#x8FCCC4 #x7467)
- (#x8FCCC5 #x7468)
- (#x8FCCC6 #x746B)
- (#x8FCCC7 #x746D)
- (#x8FCCC8 #x746E)
- (#x8FCCC9 #x7471)
- (#x8FCCCA #x7472)
- (#x8FCCCB #x7480)
- (#x8FCCCC #x7481)
- (#x8FCCCD #x7485)
- (#x8FCCCE #x7486)
- (#x8FCCCF #x7487)
- (#x8FCCD0 #x7489)
- (#x8FCCD1 #x748F)
- (#x8FCCD2 #x7490)
- (#x8FCCD3 #x7491)
- (#x8FCCD4 #x7492)
- (#x8FCCD5 #x7498)
- (#x8FCCD6 #x7499)
- (#x8FCCD7 #x749A)
- (#x8FCCD8 #x749C)
- (#x8FCCD9 #x749F)
- (#x8FCCDA #x74A0)
- (#x8FCCDB #x74A1)
- (#x8FCCDC #x74A3)
- (#x8FCCDD #x74A6)
- (#x8FCCDE #x74A8)
- (#x8FCCDF #x74A9)
- (#x8FCCE0 #x74AA)
- (#x8FCCE1 #x74AB)
- (#x8FCCE2 #x74AE)
- (#x8FCCE3 #x74AF)
- (#x8FCCE4 #x74B1)
- (#x8FCCE5 #x74B2)
- (#x8FCCE6 #x74B5)
- (#x8FCCE7 #x74B9)
- (#x8FCCE8 #x74BB)
- (#x8FCCE9 #x74BF)
- (#x8FCCEA #x74C8)
- (#x8FCCEB #x74C9)
- (#x8FCCEC #x74CC)
- (#x8FCCED #x74D0)
- (#x8FCCEE #x74D3)
- (#x8FCCEF #x74D8)
- (#x8FCCF0 #x74DA)
- (#x8FCCF1 #x74DB)
- (#x8FCCF2 #x74DE)
- (#x8FCCF3 #x74DF)
- (#x8FCCF4 #x74E4)
- (#x8FCCF5 #x74E8)
- (#x8FCCF6 #x74EA)
- (#x8FCCF7 #x74EB)
- (#x8FCCF8 #x74EF)
- (#x8FCCF9 #x74F4)
- (#x8FCCFA #x74FA)
- (#x8FCCFB #x74FB)
- (#x8FCCFC #x74FC)
- (#x8FCCFD #x74FF)
- (#x8FCCFE #x7506)
- (#x8FCDA1 #x7512)
- (#x8FCDA2 #x7516)
- (#x8FCDA3 #x7517)
- (#x8FCDA4 #x7520)
- (#x8FCDA5 #x7521)
- (#x8FCDA6 #x7524)
- (#x8FCDA7 #x7527)
- (#x8FCDA8 #x7529)
- (#x8FCDA9 #x752A)
- (#x8FCDAA #x752F)
- (#x8FCDAB #x7536)
- (#x8FCDAC #x7539)
- (#x8FCDAD #x753D)
- (#x8FCDAE #x753E)
- (#x8FCDAF #x753F)
- (#x8FCDB0 #x7540)
- (#x8FCDB1 #x7543)
- (#x8FCDB2 #x7547)
- (#x8FCDB3 #x7548)
- (#x8FCDB4 #x754E)
- (#x8FCDB5 #x7550)
- (#x8FCDB6 #x7552)
- (#x8FCDB7 #x7557)
- (#x8FCDB8 #x755E)
- (#x8FCDB9 #x755F)
- (#x8FCDBA #x7561)
- (#x8FCDBB #x756F)
- (#x8FCDBC #x7571)
- (#x8FCDBD #x7579)
- (#x8FCDBE #x757A)
- (#x8FCDBF #x757B)
- (#x8FCDC0 #x757C)
- (#x8FCDC1 #x757D)
- (#x8FCDC2 #x757E)
- (#x8FCDC3 #x7581)
- (#x8FCDC4 #x7585)
- (#x8FCDC5 #x7590)
- (#x8FCDC6 #x7592)
- (#x8FCDC7 #x7593)
- (#x8FCDC8 #x7595)
- (#x8FCDC9 #x7599)
- (#x8FCDCA #x759C)
- (#x8FCDCB #x75A2)
- (#x8FCDCC #x75A4)
- (#x8FCDCD #x75B4)
- (#x8FCDCE #x75BA)
- (#x8FCDCF #x75BF)
- (#x8FCDD0 #x75C0)
- (#x8FCDD1 #x75C1)
- (#x8FCDD2 #x75C4)
- (#x8FCDD3 #x75C6)
- (#x8FCDD4 #x75CC)
- (#x8FCDD5 #x75CE)
- (#x8FCDD6 #x75CF)
- (#x8FCDD7 #x75D7)
- (#x8FCDD8 #x75DC)
- (#x8FCDD9 #x75DF)
- (#x8FCDDA #x75E0)
- (#x8FCDDB #x75E1)
- (#x8FCDDC #x75E4)
- (#x8FCDDD #x75E7)
- (#x8FCDDE #x75EC)
- (#x8FCDDF #x75EE)
- (#x8FCDE0 #x75EF)
- (#x8FCDE1 #x75F1)
- (#x8FCDE2 #x75F9)
- (#x8FCDE3 #x7600)
- (#x8FCDE4 #x7602)
- (#x8FCDE5 #x7603)
- (#x8FCDE6 #x7604)
- (#x8FCDE7 #x7607)
- (#x8FCDE8 #x7608)
- (#x8FCDE9 #x760A)
- (#x8FCDEA #x760C)
- (#x8FCDEB #x760F)
- (#x8FCDEC #x7612)
- (#x8FCDED #x7613)
- (#x8FCDEE #x7615)
- (#x8FCDEF #x7616)
- (#x8FCDF0 #x7619)
- (#x8FCDF1 #x761B)
- (#x8FCDF2 #x761C)
- (#x8FCDF3 #x761D)
- (#x8FCDF4 #x761E)
- (#x8FCDF5 #x7623)
- (#x8FCDF6 #x7625)
- (#x8FCDF7 #x7626)
- (#x8FCDF8 #x7629)
- (#x8FCDF9 #x762D)
- (#x8FCDFA #x7632)
- (#x8FCDFB #x7633)
- (#x8FCDFC #x7635)
- (#x8FCDFD #x7638)
- (#x8FCDFE #x7639)
- (#x8FCEA1 #x763A)
- (#x8FCEA2 #x763C)
- (#x8FCEA3 #x764A)
- (#x8FCEA4 #x7640)
- (#x8FCEA5 #x7641)
- (#x8FCEA6 #x7643)
- (#x8FCEA7 #x7644)
- (#x8FCEA8 #x7645)
- (#x8FCEA9 #x7649)
- (#x8FCEAA #x764B)
- (#x8FCEAB #x7655)
- (#x8FCEAC #x7659)
- (#x8FCEAD #x765F)
- (#x8FCEAE #x7664)
- (#x8FCEAF #x7665)
- (#x8FCEB0 #x766D)
- (#x8FCEB1 #x766E)
- (#x8FCEB2 #x766F)
- (#x8FCEB3 #x7671)
- (#x8FCEB4 #x7674)
- (#x8FCEB5 #x7681)
- (#x8FCEB6 #x7685)
- (#x8FCEB7 #x768C)
- (#x8FCEB8 #x768D)
- (#x8FCEB9 #x7695)
- (#x8FCEBA #x769B)
- (#x8FCEBB #x769C)
- (#x8FCEBC #x769D)
- (#x8FCEBD #x769F)
- (#x8FCEBE #x76A0)
- (#x8FCEBF #x76A2)
- (#x8FCEC0 #x76A3)
- (#x8FCEC1 #x76A4)
- (#x8FCEC2 #x76A5)
- (#x8FCEC3 #x76A6)
- (#x8FCEC4 #x76A7)
- (#x8FCEC5 #x76A8)
- (#x8FCEC6 #x76AA)
- (#x8FCEC7 #x76AD)
- (#x8FCEC8 #x76BD)
- (#x8FCEC9 #x76C1)
- (#x8FCECA #x76C5)
- (#x8FCECB #x76C9)
- (#x8FCECC #x76CB)
- (#x8FCECD #x76CC)
- (#x8FCECE #x76CE)
- (#x8FCECF #x76D4)
- (#x8FCED0 #x76D9)
- (#x8FCED1 #x76E0)
- (#x8FCED2 #x76E6)
- (#x8FCED3 #x76E8)
- (#x8FCED4 #x76EC)
- (#x8FCED5 #x76F0)
- (#x8FCED6 #x76F1)
- (#x8FCED7 #x76F6)
- (#x8FCED8 #x76F9)
- (#x8FCED9 #x76FC)
- (#x8FCEDA #x7700)
- (#x8FCEDB #x7706)
- (#x8FCEDC #x770A)
- (#x8FCEDD #x770E)
- (#x8FCEDE #x7712)
- (#x8FCEDF #x7714)
- (#x8FCEE0 #x7715)
- (#x8FCEE1 #x7717)
- (#x8FCEE2 #x7719)
- (#x8FCEE3 #x771A)
- (#x8FCEE4 #x771C)
- (#x8FCEE5 #x7722)
- (#x8FCEE6 #x7728)
- (#x8FCEE7 #x772D)
- (#x8FCEE8 #x772E)
- (#x8FCEE9 #x772F)
- (#x8FCEEA #x7734)
- (#x8FCEEB #x7735)
- (#x8FCEEC #x7736)
- (#x8FCEED #x7739)
- (#x8FCEEE #x773D)
- (#x8FCEEF #x773E)
- (#x8FCEF0 #x7742)
- (#x8FCEF1 #x7745)
- (#x8FCEF2 #x7746)
- (#x8FCEF3 #x774A)
- (#x8FCEF4 #x774D)
- (#x8FCEF5 #x774E)
- (#x8FCEF6 #x774F)
- (#x8FCEF7 #x7752)
- (#x8FCEF8 #x7756)
- (#x8FCEF9 #x7757)
- (#x8FCEFA #x775C)
- (#x8FCEFB #x775E)
- (#x8FCEFC #x775F)
- (#x8FCEFD #x7760)
- (#x8FCEFE #x7762)
- (#x8FCFA1 #x7764)
- (#x8FCFA2 #x7767)
- (#x8FCFA3 #x776A)
- (#x8FCFA4 #x776C)
- (#x8FCFA5 #x7770)
- (#x8FCFA6 #x7772)
- (#x8FCFA7 #x7773)
- (#x8FCFA8 #x7774)
- (#x8FCFA9 #x777A)
- (#x8FCFAA #x777D)
- (#x8FCFAB #x7780)
- (#x8FCFAC #x7784)
- (#x8FCFAD #x778C)
- (#x8FCFAE #x778D)
- (#x8FCFAF #x7794)
- (#x8FCFB0 #x7795)
- (#x8FCFB1 #x7796)
- (#x8FCFB2 #x779A)
- (#x8FCFB3 #x779F)
- (#x8FCFB4 #x77A2)
- (#x8FCFB5 #x77A7)
- (#x8FCFB6 #x77AA)
- (#x8FCFB7 #x77AE)
- (#x8FCFB8 #x77AF)
- (#x8FCFB9 #x77B1)
- (#x8FCFBA #x77B5)
- (#x8FCFBB #x77BE)
- (#x8FCFBC #x77C3)
- (#x8FCFBD #x77C9)
- (#x8FCFBE #x77D1)
- (#x8FCFBF #x77D2)
- (#x8FCFC0 #x77D5)
- (#x8FCFC1 #x77D9)
- (#x8FCFC2 #x77DE)
- (#x8FCFC3 #x77DF)
- (#x8FCFC4 #x77E0)
- (#x8FCFC5 #x77E4)
- (#x8FCFC6 #x77E6)
- (#x8FCFC7 #x77EA)
- (#x8FCFC8 #x77EC)
- (#x8FCFC9 #x77F0)
- (#x8FCFCA #x77F1)
- (#x8FCFCB #x77F4)
- (#x8FCFCC #x77F8)
- (#x8FCFCD #x77FB)
- (#x8FCFCE #x7805)
- (#x8FCFCF #x7806)
- (#x8FCFD0 #x7809)
- (#x8FCFD1 #x780D)
- (#x8FCFD2 #x780E)
- (#x8FCFD3 #x7811)
- (#x8FCFD4 #x781D)
- (#x8FCFD5 #x7821)
- (#x8FCFD6 #x7822)
- (#x8FCFD7 #x7823)
- (#x8FCFD8 #x782D)
- (#x8FCFD9 #x782E)
- (#x8FCFDA #x7830)
- (#x8FCFDB #x7835)
- (#x8FCFDC #x7837)
- (#x8FCFDD #x7843)
- (#x8FCFDE #x7844)
- (#x8FCFDF #x7847)
- (#x8FCFE0 #x7848)
- (#x8FCFE1 #x784C)
- (#x8FCFE2 #x784E)
- (#x8FCFE3 #x7852)
- (#x8FCFE4 #x785C)
- (#x8FCFE5 #x785E)
- (#x8FCFE6 #x7860)
- (#x8FCFE7 #x7861)
- (#x8FCFE8 #x7863)
- (#x8FCFE9 #x7864)
- (#x8FCFEA #x7868)
- (#x8FCFEB #x786A)
- (#x8FCFEC #x786E)
- (#x8FCFED #x787A)
- (#x8FCFEE #x787E)
- (#x8FCFEF #x788A)
- (#x8FCFF0 #x788F)
- (#x8FCFF1 #x7894)
- (#x8FCFF2 #x7898)
- (#x8FCFF3 #x78A1)
- (#x8FCFF4 #x789D)
- (#x8FCFF5 #x789E)
- (#x8FCFF6 #x789F)
- (#x8FCFF7 #x78A4)
- (#x8FCFF8 #x78A8)
- (#x8FCFF9 #x78AC)
- (#x8FCFFA #x78AD)
- (#x8FCFFB #x78B0)
- (#x8FCFFC #x78B1)
- (#x8FCFFD #x78B2)
- (#x8FCFFE #x78B3)
- (#x8FD0A1 #x78BB)
- (#x8FD0A2 #x78BD)
- (#x8FD0A3 #x78BF)
- (#x8FD0A4 #x78C7)
- (#x8FD0A5 #x78C8)
- (#x8FD0A6 #x78C9)
- (#x8FD0A7 #x78CC)
- (#x8FD0A8 #x78CE)
- (#x8FD0A9 #x78D2)
- (#x8FD0AA #x78D3)
- (#x8FD0AB #x78D5)
- (#x8FD0AC #x78D6)
- (#x8FD0AD #x78E4)
- (#x8FD0AE #x78DB)
- (#x8FD0AF #x78DF)
- (#x8FD0B0 #x78E0)
- (#x8FD0B1 #x78E1)
- (#x8FD0B2 #x78E6)
- (#x8FD0B3 #x78EA)
- (#x8FD0B4 #x78F2)
- (#x8FD0B5 #x78F3)
- (#x8FD0B6 #x7900)
- (#x8FD0B7 #x78F6)
- (#x8FD0B8 #x78F7)
- (#x8FD0B9 #x78FA)
- (#x8FD0BA #x78FB)
- (#x8FD0BB #x78FF)
- (#x8FD0BC #x7906)
- (#x8FD0BD #x790C)
- (#x8FD0BE #x7910)
- (#x8FD0BF #x791A)
- (#x8FD0C0 #x791C)
- (#x8FD0C1 #x791E)
- (#x8FD0C2 #x791F)
- (#x8FD0C3 #x7920)
- (#x8FD0C4 #x7925)
- (#x8FD0C5 #x7927)
- (#x8FD0C6 #x7929)
- (#x8FD0C7 #x792D)
- (#x8FD0C8 #x7931)
- (#x8FD0C9 #x7934)
- (#x8FD0CA #x7935)
- (#x8FD0CB #x793B)
- (#x8FD0CC #x793D)
- (#x8FD0CD #x793F)
- (#x8FD0CE #x7944)
- (#x8FD0CF #x7945)
- (#x8FD0D0 #x7946)
- (#x8FD0D1 #x794A)
- (#x8FD0D2 #x794B)
- (#x8FD0D3 #x794F)
- (#x8FD0D4 #x7951)
- (#x8FD0D5 #x7954)
- (#x8FD0D6 #x7958)
- (#x8FD0D7 #x795B)
- (#x8FD0D8 #x795C)
- (#x8FD0D9 #x7967)
- (#x8FD0DA #x7969)
- (#x8FD0DB #x796B)
- (#x8FD0DC #x7972)
- (#x8FD0DD #x7979)
- (#x8FD0DE #x797B)
- (#x8FD0DF #x797C)
- (#x8FD0E0 #x797E)
- (#x8FD0E1 #x798B)
- (#x8FD0E2 #x798C)
- (#x8FD0E3 #x7991)
- (#x8FD0E4 #x7993)
- (#x8FD0E5 #x7994)
- (#x8FD0E6 #x7995)
- (#x8FD0E7 #x7996)
- (#x8FD0E8 #x7998)
- (#x8FD0E9 #x799B)
- (#x8FD0EA #x799C)
- (#x8FD0EB #x79A1)
- (#x8FD0EC #x79A8)
- (#x8FD0ED #x79A9)
- (#x8FD0EE #x79AB)
- (#x8FD0EF #x79AF)
- (#x8FD0F0 #x79B1)
- (#x8FD0F1 #x79B4)
- (#x8FD0F2 #x79B8)
- (#x8FD0F3 #x79BB)
- (#x8FD0F4 #x79C2)
- (#x8FD0F5 #x79C4)
- (#x8FD0F6 #x79C7)
- (#x8FD0F7 #x79C8)
- (#x8FD0F8 #x79CA)
- (#x8FD0F9 #x79CF)
- (#x8FD0FA #x79D4)
- (#x8FD0FB #x79D6)
- (#x8FD0FC #x79DA)
- (#x8FD0FD #x79DD)
- (#x8FD0FE #x79DE)
- (#x8FD1A1 #x79E0)
- (#x8FD1A2 #x79E2)
- (#x8FD1A3 #x79E5)
- (#x8FD1A4 #x79EA)
- (#x8FD1A5 #x79EB)
- (#x8FD1A6 #x79ED)
- (#x8FD1A7 #x79F1)
- (#x8FD1A8 #x79F8)
- (#x8FD1A9 #x79FC)
- (#x8FD1AA #x7A02)
- (#x8FD1AB #x7A03)
- (#x8FD1AC #x7A07)
- (#x8FD1AD #x7A09)
- (#x8FD1AE #x7A0A)
- (#x8FD1AF #x7A0C)
- (#x8FD1B0 #x7A11)
- (#x8FD1B1 #x7A15)
- (#x8FD1B2 #x7A1B)
- (#x8FD1B3 #x7A1E)
- (#x8FD1B4 #x7A21)
- (#x8FD1B5 #x7A27)
- (#x8FD1B6 #x7A2B)
- (#x8FD1B7 #x7A2D)
- (#x8FD1B8 #x7A2F)
- (#x8FD1B9 #x7A30)
- (#x8FD1BA #x7A34)
- (#x8FD1BB #x7A35)
- (#x8FD1BC #x7A38)
- (#x8FD1BD #x7A39)
- (#x8FD1BE #x7A3A)
- (#x8FD1BF #x7A44)
- (#x8FD1C0 #x7A45)
- (#x8FD1C1 #x7A47)
- (#x8FD1C2 #x7A48)
- (#x8FD1C3 #x7A4C)
- (#x8FD1C4 #x7A55)
- (#x8FD1C5 #x7A56)
- (#x8FD1C6 #x7A59)
- (#x8FD1C7 #x7A5C)
- (#x8FD1C8 #x7A5D)
- (#x8FD1C9 #x7A5F)
- (#x8FD1CA #x7A60)
- (#x8FD1CB #x7A65)
- (#x8FD1CC #x7A67)
- (#x8FD1CD #x7A6A)
- (#x8FD1CE #x7A6D)
- (#x8FD1CF #x7A75)
- (#x8FD1D0 #x7A78)
- (#x8FD1D1 #x7A7E)
- (#x8FD1D2 #x7A80)
- (#x8FD1D3 #x7A82)
- (#x8FD1D4 #x7A85)
- (#x8FD1D5 #x7A86)
- (#x8FD1D6 #x7A8A)
- (#x8FD1D7 #x7A8B)
- (#x8FD1D8 #x7A90)
- (#x8FD1D9 #x7A91)
- (#x8FD1DA #x7A94)
- (#x8FD1DB #x7A9E)
- (#x8FD1DC #x7AA0)
- (#x8FD1DD #x7AA3)
- (#x8FD1DE #x7AAC)
- (#x8FD1DF #x7AB3)
- (#x8FD1E0 #x7AB5)
- (#x8FD1E1 #x7AB9)
- (#x8FD1E2 #x7ABB)
- (#x8FD1E3 #x7ABC)
- (#x8FD1E4 #x7AC6)
- (#x8FD1E5 #x7AC9)
- (#x8FD1E6 #x7ACC)
- (#x8FD1E7 #x7ACE)
- (#x8FD1E8 #x7AD1)
- (#x8FD1E9 #x7ADB)
- (#x8FD1EA #x7AE8)
- (#x8FD1EB #x7AE9)
- (#x8FD1EC #x7AEB)
- (#x8FD1ED #x7AEC)
- (#x8FD1EE #x7AF1)
- (#x8FD1EF #x7AF4)
- (#x8FD1F0 #x7AFB)
- (#x8FD1F1 #x7AFD)
- (#x8FD1F2 #x7AFE)
- (#x8FD1F3 #x7B07)
- (#x8FD1F4 #x7B14)
- (#x8FD1F5 #x7B1F)
- (#x8FD1F6 #x7B23)
- (#x8FD1F7 #x7B27)
- (#x8FD1F8 #x7B29)
- (#x8FD1F9 #x7B2A)
- (#x8FD1FA #x7B2B)
- (#x8FD1FB #x7B2D)
- (#x8FD1FC #x7B2E)
- (#x8FD1FD #x7B2F)
- (#x8FD1FE #x7B30)
- (#x8FD2A1 #x7B31)
- (#x8FD2A2 #x7B34)
- (#x8FD2A3 #x7B3D)
- (#x8FD2A4 #x7B3F)
- (#x8FD2A5 #x7B40)
- (#x8FD2A6 #x7B41)
- (#x8FD2A7 #x7B47)
- (#x8FD2A8 #x7B4E)
- (#x8FD2A9 #x7B55)
- (#x8FD2AA #x7B60)
- (#x8FD2AB #x7B64)
- (#x8FD2AC #x7B66)
- (#x8FD2AD #x7B69)
- (#x8FD2AE #x7B6A)
- (#x8FD2AF #x7B6D)
- (#x8FD2B0 #x7B6F)
- (#x8FD2B1 #x7B72)
- (#x8FD2B2 #x7B73)
- (#x8FD2B3 #x7B77)
- (#x8FD2B4 #x7B84)
- (#x8FD2B5 #x7B89)
- (#x8FD2B6 #x7B8E)
- (#x8FD2B7 #x7B90)
- (#x8FD2B8 #x7B91)
- (#x8FD2B9 #x7B96)
- (#x8FD2BA #x7B9B)
- (#x8FD2BB #x7B9E)
- (#x8FD2BC #x7BA0)
- (#x8FD2BD #x7BA5)
- (#x8FD2BE #x7BAC)
- (#x8FD2BF #x7BAF)
- (#x8FD2C0 #x7BB0)
- (#x8FD2C1 #x7BB2)
- (#x8FD2C2 #x7BB5)
- (#x8FD2C3 #x7BB6)
- (#x8FD2C4 #x7BBA)
- (#x8FD2C5 #x7BBB)
- (#x8FD2C6 #x7BBC)
- (#x8FD2C7 #x7BBD)
- (#x8FD2C8 #x7BC2)
- (#x8FD2C9 #x7BC5)
- (#x8FD2CA #x7BC8)
- (#x8FD2CB #x7BCA)
- (#x8FD2CC #x7BD4)
- (#x8FD2CD #x7BD6)
- (#x8FD2CE #x7BD7)
- (#x8FD2CF #x7BD9)
- (#x8FD2D0 #x7BDA)
- (#x8FD2D1 #x7BDB)
- (#x8FD2D2 #x7BE8)
- (#x8FD2D3 #x7BEA)
- (#x8FD2D4 #x7BF2)
- (#x8FD2D5 #x7BF4)
- (#x8FD2D6 #x7BF5)
- (#x8FD2D7 #x7BF8)
- (#x8FD2D8 #x7BF9)
- (#x8FD2D9 #x7BFA)
- (#x8FD2DA #x7BFC)
- (#x8FD2DB #x7BFE)
- (#x8FD2DC #x7C01)
- (#x8FD2DD #x7C02)
- (#x8FD2DE #x7C03)
- (#x8FD2DF #x7C04)
- (#x8FD2E0 #x7C06)
- (#x8FD2E1 #x7C09)
- (#x8FD2E2 #x7C0B)
- (#x8FD2E3 #x7C0C)
- (#x8FD2E4 #x7C0E)
- (#x8FD2E5 #x7C0F)
- (#x8FD2E6 #x7C19)
- (#x8FD2E7 #x7C1B)
- (#x8FD2E8 #x7C20)
- (#x8FD2E9 #x7C25)
- (#x8FD2EA #x7C26)
- (#x8FD2EB #x7C28)
- (#x8FD2EC #x7C2C)
- (#x8FD2ED #x7C31)
- (#x8FD2EE #x7C33)
- (#x8FD2EF #x7C34)
- (#x8FD2F0 #x7C36)
- (#x8FD2F1 #x7C39)
- (#x8FD2F2 #x7C3A)
- (#x8FD2F3 #x7C46)
- (#x8FD2F4 #x7C4A)
- (#x8FD2F5 #x7C55)
- (#x8FD2F6 #x7C51)
- (#x8FD2F7 #x7C52)
- (#x8FD2F8 #x7C53)
- (#x8FD2F9 #x7C59)
- (#x8FD2FA #x7C5A)
- (#x8FD2FB #x7C5B)
- (#x8FD2FC #x7C5C)
- (#x8FD2FD #x7C5D)
- (#x8FD2FE #x7C5E)
- (#x8FD3A1 #x7C61)
- (#x8FD3A2 #x7C63)
- (#x8FD3A3 #x7C67)
- (#x8FD3A4 #x7C69)
- (#x8FD3A5 #x7C6D)
- (#x8FD3A6 #x7C6E)
- (#x8FD3A7 #x7C70)
- (#x8FD3A8 #x7C72)
- (#x8FD3A9 #x7C79)
- (#x8FD3AA #x7C7C)
- (#x8FD3AB #x7C7D)
- (#x8FD3AC #x7C86)
- (#x8FD3AD #x7C87)
- (#x8FD3AE #x7C8F)
- (#x8FD3AF #x7C94)
- (#x8FD3B0 #x7C9E)
- (#x8FD3B1 #x7CA0)
- (#x8FD3B2 #x7CA6)
- (#x8FD3B3 #x7CB0)
- (#x8FD3B4 #x7CB6)
- (#x8FD3B5 #x7CB7)
- (#x8FD3B6 #x7CBA)
- (#x8FD3B7 #x7CBB)
- (#x8FD3B8 #x7CBC)
- (#x8FD3B9 #x7CBF)
- (#x8FD3BA #x7CC4)
- (#x8FD3BB #x7CC7)
- (#x8FD3BC #x7CC8)
- (#x8FD3BD #x7CC9)
- (#x8FD3BE #x7CCD)
- (#x8FD3BF #x7CCF)
- (#x8FD3C0 #x7CD3)
- (#x8FD3C1 #x7CD4)
- (#x8FD3C2 #x7CD5)
- (#x8FD3C3 #x7CD7)
- (#x8FD3C4 #x7CD9)
- (#x8FD3C5 #x7CDA)
- (#x8FD3C6 #x7CDD)
- (#x8FD3C7 #x7CE6)
- (#x8FD3C8 #x7CE9)
- (#x8FD3C9 #x7CEB)
- (#x8FD3CA #x7CF5)
- (#x8FD3CB #x7D03)
- (#x8FD3CC #x7D07)
- (#x8FD3CD #x7D08)
- (#x8FD3CE #x7D09)
- (#x8FD3CF #x7D0F)
- (#x8FD3D0 #x7D11)
- (#x8FD3D1 #x7D12)
- (#x8FD3D2 #x7D13)
- (#x8FD3D3 #x7D16)
- (#x8FD3D4 #x7D1D)
- (#x8FD3D5 #x7D1E)
- (#x8FD3D6 #x7D23)
- (#x8FD3D7 #x7D26)
- (#x8FD3D8 #x7D2A)
- (#x8FD3D9 #x7D2D)
- (#x8FD3DA #x7D31)
- (#x8FD3DB #x7D3C)
- (#x8FD3DC #x7D3D)
- (#x8FD3DD #x7D3E)
- (#x8FD3DE #x7D40)
- (#x8FD3DF #x7D41)
- (#x8FD3E0 #x7D47)
- (#x8FD3E1 #x7D48)
- (#x8FD3E2 #x7D4D)
- (#x8FD3E3 #x7D51)
- (#x8FD3E4 #x7D53)
- (#x8FD3E5 #x7D57)
- (#x8FD3E6 #x7D59)
- (#x8FD3E7 #x7D5A)
- (#x8FD3E8 #x7D5C)
- (#x8FD3E9 #x7D5D)
- (#x8FD3EA #x7D65)
- (#x8FD3EB #x7D67)
- (#x8FD3EC #x7D6A)
- (#x8FD3ED #x7D70)
- (#x8FD3EE #x7D78)
- (#x8FD3EF #x7D7A)
- (#x8FD3F0 #x7D7B)
- (#x8FD3F1 #x7D7F)
- (#x8FD3F2 #x7D81)
- (#x8FD3F3 #x7D82)
- (#x8FD3F4 #x7D83)
- (#x8FD3F5 #x7D85)
- (#x8FD3F6 #x7D86)
- (#x8FD3F7 #x7D88)
- (#x8FD3F8 #x7D8B)
- (#x8FD3F9 #x7D8C)
- (#x8FD3FA #x7D8D)
- (#x8FD3FB #x7D91)
- (#x8FD3FC #x7D96)
- (#x8FD3FD #x7D97)
- (#x8FD3FE #x7D9D)
- (#x8FD4A1 #x7D9E)
- (#x8FD4A2 #x7DA6)
- (#x8FD4A3 #x7DA7)
- (#x8FD4A4 #x7DAA)
- (#x8FD4A5 #x7DB3)
- (#x8FD4A6 #x7DB6)
- (#x8FD4A7 #x7DB7)
- (#x8FD4A8 #x7DB9)
- (#x8FD4A9 #x7DC2)
- (#x8FD4AA #x7DC3)
- (#x8FD4AB #x7DC4)
- (#x8FD4AC #x7DC5)
- (#x8FD4AD #x7DC6)
- (#x8FD4AE #x7DCC)
- (#x8FD4AF #x7DCD)
- (#x8FD4B0 #x7DCE)
- (#x8FD4B1 #x7DD7)
- (#x8FD4B2 #x7DD9)
- (#x8FD4B3 #x7E00)
- (#x8FD4B4 #x7DE2)
- (#x8FD4B5 #x7DE5)
- (#x8FD4B6 #x7DE6)
- (#x8FD4B7 #x7DEA)
- (#x8FD4B8 #x7DEB)
- (#x8FD4B9 #x7DED)
- (#x8FD4BA #x7DF1)
- (#x8FD4BB #x7DF5)
- (#x8FD4BC #x7DF6)
- (#x8FD4BD #x7DF9)
- (#x8FD4BE #x7DFA)
- (#x8FD4BF #x7E08)
- (#x8FD4C0 #x7E10)
- (#x8FD4C1 #x7E11)
- (#x8FD4C2 #x7E15)
- (#x8FD4C3 #x7E17)
- (#x8FD4C4 #x7E1C)
- (#x8FD4C5 #x7E1D)
- (#x8FD4C6 #x7E20)
- (#x8FD4C7 #x7E27)
- (#x8FD4C8 #x7E28)
- (#x8FD4C9 #x7E2C)
- (#x8FD4CA #x7E2D)
- (#x8FD4CB #x7E2F)
- (#x8FD4CC #x7E33)
- (#x8FD4CD #x7E36)
- (#x8FD4CE #x7E3F)
- (#x8FD4CF #x7E44)
- (#x8FD4D0 #x7E45)
- (#x8FD4D1 #x7E47)
- (#x8FD4D2 #x7E4E)
- (#x8FD4D3 #x7E50)
- (#x8FD4D4 #x7E52)
- (#x8FD4D5 #x7E58)
- (#x8FD4D6 #x7E5F)
- (#x8FD4D7 #x7E61)
- (#x8FD4D8 #x7E62)
- (#x8FD4D9 #x7E65)
- (#x8FD4DA #x7E6B)
- (#x8FD4DB #x7E6E)
- (#x8FD4DC #x7E6F)
- (#x8FD4DD #x7E73)
- (#x8FD4DE #x7E78)
- (#x8FD4DF #x7E7E)
- (#x8FD4E0 #x7E81)
- (#x8FD4E1 #x7E86)
- (#x8FD4E2 #x7E87)
- (#x8FD4E3 #x7E8A)
- (#x8FD4E4 #x7E8D)
- (#x8FD4E5 #x7E91)
- (#x8FD4E6 #x7E95)
- (#x8FD4E7 #x7E98)
- (#x8FD4E8 #x7E9A)
- (#x8FD4E9 #x7E9D)
- (#x8FD4EA #x7E9E)
- (#x8FD4EB #x7F3C)
- (#x8FD4EC #x7F3B)
- (#x8FD4ED #x7F3D)
- (#x8FD4EE #x7F3E)
- (#x8FD4EF #x7F3F)
- (#x8FD4F0 #x7F43)
- (#x8FD4F1 #x7F44)
- (#x8FD4F2 #x7F47)
- (#x8FD4F3 #x7F4F)
- (#x8FD4F4 #x7F52)
- (#x8FD4F5 #x7F53)
- (#x8FD4F6 #x7F5B)
- (#x8FD4F7 #x7F5C)
- (#x8FD4F8 #x7F5D)
- (#x8FD4F9 #x7F61)
- (#x8FD4FA #x7F63)
- (#x8FD4FB #x7F64)
- (#x8FD4FC #x7F65)
- (#x8FD4FD #x7F66)
- (#x8FD4FE #x7F6D)
- (#x8FD5A1 #x7F71)
- (#x8FD5A2 #x7F7D)
- (#x8FD5A3 #x7F7E)
- (#x8FD5A4 #x7F7F)
- (#x8FD5A5 #x7F80)
- (#x8FD5A6 #x7F8B)
- (#x8FD5A7 #x7F8D)
- (#x8FD5A8 #x7F8F)
- (#x8FD5A9 #x7F90)
- (#x8FD5AA #x7F91)
- (#x8FD5AB #x7F96)
- (#x8FD5AC #x7F97)
- (#x8FD5AD #x7F9C)
- (#x8FD5AE #x7FA1)
- (#x8FD5AF #x7FA2)
- (#x8FD5B0 #x7FA6)
- (#x8FD5B1 #x7FAA)
- (#x8FD5B2 #x7FAD)
- (#x8FD5B3 #x7FB4)
- (#x8FD5B4 #x7FBC)
- (#x8FD5B5 #x7FBF)
- (#x8FD5B6 #x7FC0)
- (#x8FD5B7 #x7FC3)
- (#x8FD5B8 #x7FC8)
- (#x8FD5B9 #x7FCE)
- (#x8FD5BA #x7FCF)
- (#x8FD5BB #x7FDB)
- (#x8FD5BC #x7FDF)
- (#x8FD5BD #x7FE3)
- (#x8FD5BE #x7FE5)
- (#x8FD5BF #x7FE8)
- (#x8FD5C0 #x7FEC)
- (#x8FD5C1 #x7FEE)
- (#x8FD5C2 #x7FEF)
- (#x8FD5C3 #x7FF2)
- (#x8FD5C4 #x7FFA)
- (#x8FD5C5 #x7FFD)
- (#x8FD5C6 #x7FFE)
- (#x8FD5C7 #x7FFF)
- (#x8FD5C8 #x8007)
- (#x8FD5C9 #x8008)
- (#x8FD5CA #x800A)
- (#x8FD5CB #x800D)
- (#x8FD5CC #x800E)
- (#x8FD5CD #x800F)
- (#x8FD5CE #x8011)
- (#x8FD5CF #x8013)
- (#x8FD5D0 #x8014)
- (#x8FD5D1 #x8016)
- (#x8FD5D2 #x801D)
- (#x8FD5D3 #x801E)
- (#x8FD5D4 #x801F)
- (#x8FD5D5 #x8020)
- (#x8FD5D6 #x8024)
- (#x8FD5D7 #x8026)
- (#x8FD5D8 #x802C)
- (#x8FD5D9 #x802E)
- (#x8FD5DA #x8030)
- (#x8FD5DB #x8034)
- (#x8FD5DC #x8035)
- (#x8FD5DD #x8037)
- (#x8FD5DE #x8039)
- (#x8FD5DF #x803A)
- (#x8FD5E0 #x803C)
- (#x8FD5E1 #x803E)
- (#x8FD5E2 #x8040)
- (#x8FD5E3 #x8044)
- (#x8FD5E4 #x8060)
- (#x8FD5E5 #x8064)
- (#x8FD5E6 #x8066)
- (#x8FD5E7 #x806D)
- (#x8FD5E8 #x8071)
- (#x8FD5E9 #x8075)
- (#x8FD5EA #x8081)
- (#x8FD5EB #x8088)
- (#x8FD5EC #x808E)
- (#x8FD5ED #x809C)
- (#x8FD5EE #x809E)
- (#x8FD5EF #x80A6)
- (#x8FD5F0 #x80A7)
- (#x8FD5F1 #x80AB)
- (#x8FD5F2 #x80B8)
- (#x8FD5F3 #x80B9)
- (#x8FD5F4 #x80C8)
- (#x8FD5F5 #x80CD)
- (#x8FD5F6 #x80CF)
- (#x8FD5F7 #x80D2)
- (#x8FD5F8 #x80D4)
- (#x8FD5F9 #x80D5)
- (#x8FD5FA #x80D7)
- (#x8FD5FB #x80D8)
- (#x8FD5FC #x80E0)
- (#x8FD5FD #x80ED)
- (#x8FD5FE #x80EE)
- (#x8FD6A1 #x80F0)
- (#x8FD6A2 #x80F2)
- (#x8FD6A3 #x80F3)
- (#x8FD6A4 #x80F6)
- (#x8FD6A5 #x80F9)
- (#x8FD6A6 #x80FA)
- (#x8FD6A7 #x80FE)
- (#x8FD6A8 #x8103)
- (#x8FD6A9 #x810B)
- (#x8FD6AA #x8116)
- (#x8FD6AB #x8117)
- (#x8FD6AC #x8118)
- (#x8FD6AD #x811C)
- (#x8FD6AE #x811E)
- (#x8FD6AF #x8120)
- (#x8FD6B0 #x8124)
- (#x8FD6B1 #x8127)
- (#x8FD6B2 #x812C)
- (#x8FD6B3 #x8130)
- (#x8FD6B4 #x8135)
- (#x8FD6B5 #x813A)
- (#x8FD6B6 #x813C)
- (#x8FD6B7 #x8145)
- (#x8FD6B8 #x8147)
- (#x8FD6B9 #x814A)
- (#x8FD6BA #x814C)
- (#x8FD6BB #x8152)
- (#x8FD6BC #x8157)
- (#x8FD6BD #x8160)
- (#x8FD6BE #x8161)
- (#x8FD6BF #x8167)
- (#x8FD6C0 #x8168)
- (#x8FD6C1 #x8169)
- (#x8FD6C2 #x816D)
- (#x8FD6C3 #x816F)
- (#x8FD6C4 #x8177)
- (#x8FD6C5 #x8181)
- (#x8FD6C6 #x8190)
- (#x8FD6C7 #x8184)
- (#x8FD6C8 #x8185)
- (#x8FD6C9 #x8186)
- (#x8FD6CA #x818B)
- (#x8FD6CB #x818E)
- (#x8FD6CC #x8196)
- (#x8FD6CD #x8198)
- (#x8FD6CE #x819B)
- (#x8FD6CF #x819E)
- (#x8FD6D0 #x81A2)
- (#x8FD6D1 #x81AE)
- (#x8FD6D2 #x81B2)
- (#x8FD6D3 #x81B4)
- (#x8FD6D4 #x81BB)
- (#x8FD6D5 #x81CB)
- (#x8FD6D6 #x81C3)
- (#x8FD6D7 #x81C5)
- (#x8FD6D8 #x81CA)
- (#x8FD6D9 #x81CE)
- (#x8FD6DA #x81CF)
- (#x8FD6DB #x81D5)
- (#x8FD6DC #x81D7)
- (#x8FD6DD #x81DB)
- (#x8FD6DE #x81DD)
- (#x8FD6DF #x81DE)
- (#x8FD6E0 #x81E1)
- (#x8FD6E1 #x81E4)
- (#x8FD6E2 #x81EB)
- (#x8FD6E3 #x81EC)
- (#x8FD6E4 #x81F0)
- (#x8FD6E5 #x81F1)
- (#x8FD6E6 #x81F2)
- (#x8FD6E7 #x81F5)
- (#x8FD6E8 #x81F6)
- (#x8FD6E9 #x81F8)
- (#x8FD6EA #x81F9)
- (#x8FD6EB #x81FD)
- (#x8FD6EC #x81FF)
- (#x8FD6ED #x8200)
- (#x8FD6EE #x8203)
- (#x8FD6EF #x820F)
- (#x8FD6F0 #x8213)
- (#x8FD6F1 #x8214)
- (#x8FD6F2 #x8219)
- (#x8FD6F3 #x821A)
- (#x8FD6F4 #x821D)
- (#x8FD6F5 #x8221)
- (#x8FD6F6 #x8222)
- (#x8FD6F7 #x8228)
- (#x8FD6F8 #x8232)
- (#x8FD6F9 #x8234)
- (#x8FD6FA #x823A)
- (#x8FD6FB #x8243)
- (#x8FD6FC #x8244)
- (#x8FD6FD #x8245)
- (#x8FD6FE #x8246)
- (#x8FD7A1 #x824B)
- (#x8FD7A2 #x824E)
- (#x8FD7A3 #x824F)
- (#x8FD7A4 #x8251)
- (#x8FD7A5 #x8256)
- (#x8FD7A6 #x825C)
- (#x8FD7A7 #x8260)
- (#x8FD7A8 #x8263)
- (#x8FD7A9 #x8267)
- (#x8FD7AA #x826D)
- (#x8FD7AB #x8274)
- (#x8FD7AC #x827B)
- (#x8FD7AD #x827D)
- (#x8FD7AE #x827F)
- (#x8FD7AF #x8280)
- (#x8FD7B0 #x8281)
- (#x8FD7B1 #x8283)
- (#x8FD7B2 #x8284)
- (#x8FD7B3 #x8287)
- (#x8FD7B4 #x8289)
- (#x8FD7B5 #x828A)
- (#x8FD7B6 #x828E)
- (#x8FD7B7 #x8291)
- (#x8FD7B8 #x8294)
- (#x8FD7B9 #x8296)
- (#x8FD7BA #x8298)
- (#x8FD7BB #x829A)
- (#x8FD7BC #x829B)
- (#x8FD7BD #x82A0)
- (#x8FD7BE #x82A1)
- (#x8FD7BF #x82A3)
- (#x8FD7C0 #x82A4)
- (#x8FD7C1 #x82A7)
- (#x8FD7C2 #x82A8)
- (#x8FD7C3 #x82A9)
- (#x8FD7C4 #x82AA)
- (#x8FD7C5 #x82AE)
- (#x8FD7C6 #x82B0)
- (#x8FD7C7 #x82B2)
- (#x8FD7C8 #x82B4)
- (#x8FD7C9 #x82B7)
- (#x8FD7CA #x82BA)
- (#x8FD7CB #x82BC)
- (#x8FD7CC #x82BE)
- (#x8FD7CD #x82BF)
- (#x8FD7CE #x82C6)
- (#x8FD7CF #x82D0)
- (#x8FD7D0 #x82D5)
- (#x8FD7D1 #x82DA)
- (#x8FD7D2 #x82E0)
- (#x8FD7D3 #x82E2)
- (#x8FD7D4 #x82E4)
- (#x8FD7D5 #x82E8)
- (#x8FD7D6 #x82EA)
- (#x8FD7D7 #x82ED)
- (#x8FD7D8 #x82EF)
- (#x8FD7D9 #x82F6)
- (#x8FD7DA #x82F7)
- (#x8FD7DB #x82FD)
- (#x8FD7DC #x82FE)
- (#x8FD7DD #x8300)
- (#x8FD7DE #x8301)
- (#x8FD7DF #x8307)
- (#x8FD7E0 #x8308)
- (#x8FD7E1 #x830A)
- (#x8FD7E2 #x830B)
- (#x8FD7E3 #x8354)
- (#x8FD7E4 #x831B)
- (#x8FD7E5 #x831D)
- (#x8FD7E6 #x831E)
- (#x8FD7E7 #x831F)
- (#x8FD7E8 #x8321)
- (#x8FD7E9 #x8322)
- (#x8FD7EA #x832C)
- (#x8FD7EB #x832D)
- (#x8FD7EC #x832E)
- (#x8FD7ED #x8330)
- (#x8FD7EE #x8333)
- (#x8FD7EF #x8337)
- (#x8FD7F0 #x833A)
- (#x8FD7F1 #x833C)
- (#x8FD7F2 #x833D)
- (#x8FD7F3 #x8342)
- (#x8FD7F4 #x8343)
- (#x8FD7F5 #x8344)
- (#x8FD7F6 #x8347)
- (#x8FD7F7 #x834D)
- (#x8FD7F8 #x834E)
- (#x8FD7F9 #x8351)
- (#x8FD7FA #x8355)
- (#x8FD7FB #x8356)
- (#x8FD7FC #x8357)
- (#x8FD7FD #x8370)
- (#x8FD7FE #x8378)
- (#x8FD8A1 #x837D)
- (#x8FD8A2 #x837F)
- (#x8FD8A3 #x8380)
- (#x8FD8A4 #x8382)
- (#x8FD8A5 #x8384)
- (#x8FD8A6 #x8386)
- (#x8FD8A7 #x838D)
- (#x8FD8A8 #x8392)
- (#x8FD8A9 #x8394)
- (#x8FD8AA #x8395)
- (#x8FD8AB #x8398)
- (#x8FD8AC #x8399)
- (#x8FD8AD #x839B)
- (#x8FD8AE #x839C)
- (#x8FD8AF #x839D)
- (#x8FD8B0 #x83A6)
- (#x8FD8B1 #x83A7)
- (#x8FD8B2 #x83A9)
- (#x8FD8B3 #x83AC)
- (#x8FD8B4 #x83BE)
- (#x8FD8B5 #x83BF)
- (#x8FD8B6 #x83C0)
- (#x8FD8B7 #x83C7)
- (#x8FD8B8 #x83C9)
- (#x8FD8B9 #x83CF)
- (#x8FD8BA #x83D0)
- (#x8FD8BB #x83D1)
- (#x8FD8BC #x83D4)
- (#x8FD8BD #x83DD)
- (#x8FD8BE #x8353)
- (#x8FD8BF #x83E8)
- (#x8FD8C0 #x83EA)
- (#x8FD8C1 #x83F6)
- (#x8FD8C2 #x83F8)
- (#x8FD8C3 #x83F9)
- (#x8FD8C4 #x83FC)
- (#x8FD8C5 #x8401)
- (#x8FD8C6 #x8406)
- (#x8FD8C7 #x840A)
- (#x8FD8C8 #x840F)
- (#x8FD8C9 #x8411)
- (#x8FD8CA #x8415)
- (#x8FD8CB #x8419)
- (#x8FD8CC #x83AD)
- (#x8FD8CD #x842F)
- (#x8FD8CE #x8439)
- (#x8FD8CF #x8445)
- (#x8FD8D0 #x8447)
- (#x8FD8D1 #x8448)
- (#x8FD8D2 #x844A)
- (#x8FD8D3 #x844D)
- (#x8FD8D4 #x844F)
- (#x8FD8D5 #x8451)
- (#x8FD8D6 #x8452)
- (#x8FD8D7 #x8456)
- (#x8FD8D8 #x8458)
- (#x8FD8D9 #x8459)
- (#x8FD8DA #x845A)
- (#x8FD8DB #x845C)
- (#x8FD8DC #x8460)
- (#x8FD8DD #x8464)
- (#x8FD8DE #x8465)
- (#x8FD8DF #x8467)
- (#x8FD8E0 #x846A)
- (#x8FD8E1 #x8470)
- (#x8FD8E2 #x8473)
- (#x8FD8E3 #x8474)
- (#x8FD8E4 #x8476)
- (#x8FD8E5 #x8478)
- (#x8FD8E6 #x847C)
- (#x8FD8E7 #x847D)
- (#x8FD8E8 #x8481)
- (#x8FD8E9 #x8485)
- (#x8FD8EA #x8492)
- (#x8FD8EB #x8493)
- (#x8FD8EC #x8495)
- (#x8FD8ED #x849E)
- (#x8FD8EE #x84A6)
- (#x8FD8EF #x84A8)
- (#x8FD8F0 #x84A9)
- (#x8FD8F1 #x84AA)
- (#x8FD8F2 #x84AF)
- (#x8FD8F3 #x84B1)
- (#x8FD8F4 #x84B4)
- (#x8FD8F5 #x84BA)
- (#x8FD8F6 #x84BD)
- (#x8FD8F7 #x84BE)
- (#x8FD8F8 #x84C0)
- (#x8FD8F9 #x84C2)
- (#x8FD8FA #x84C7)
- (#x8FD8FB #x84C8)
- (#x8FD8FC #x84CC)
- (#x8FD8FD #x84CF)
- (#x8FD8FE #x84D3)
- (#x8FD9A1 #x84DC)
- (#x8FD9A2 #x84E7)
- (#x8FD9A3 #x84EA)
- (#x8FD9A4 #x84EF)
- (#x8FD9A5 #x84F0)
- (#x8FD9A6 #x84F1)
- (#x8FD9A7 #x84F2)
- (#x8FD9A8 #x84F7)
- (#x8FD9A9 #x8532)
- (#x8FD9AA #x84FA)
- (#x8FD9AB #x84FB)
- (#x8FD9AC #x84FD)
- (#x8FD9AD #x8502)
- (#x8FD9AE #x8503)
- (#x8FD9AF #x8507)
- (#x8FD9B0 #x850C)
- (#x8FD9B1 #x850E)
- (#x8FD9B2 #x8510)
- (#x8FD9B3 #x851C)
- (#x8FD9B4 #x851E)
- (#x8FD9B5 #x8522)
- (#x8FD9B6 #x8523)
- (#x8FD9B7 #x8524)
- (#x8FD9B8 #x8525)
- (#x8FD9B9 #x8527)
- (#x8FD9BA #x852A)
- (#x8FD9BB #x852B)
- (#x8FD9BC #x852F)
- (#x8FD9BD #x8533)
- (#x8FD9BE #x8534)
- (#x8FD9BF #x8536)
- (#x8FD9C0 #x853F)
- (#x8FD9C1 #x8546)
- (#x8FD9C2 #x854F)
- (#x8FD9C3 #x8550)
- (#x8FD9C4 #x8551)
- (#x8FD9C5 #x8552)
- (#x8FD9C6 #x8553)
- (#x8FD9C7 #x8556)
- (#x8FD9C8 #x8559)
- (#x8FD9C9 #x855C)
- (#x8FD9CA #x855D)
- (#x8FD9CB #x855E)
- (#x8FD9CC #x855F)
- (#x8FD9CD #x8560)
- (#x8FD9CE #x8561)
- (#x8FD9CF #x8562)
- (#x8FD9D0 #x8564)
- (#x8FD9D1 #x856B)
- (#x8FD9D2 #x856F)
- (#x8FD9D3 #x8579)
- (#x8FD9D4 #x857A)
- (#x8FD9D5 #x857B)
- (#x8FD9D6 #x857D)
- (#x8FD9D7 #x857F)
- (#x8FD9D8 #x8581)
- (#x8FD9D9 #x8585)
- (#x8FD9DA #x8586)
- (#x8FD9DB #x8589)
- (#x8FD9DC #x858B)
- (#x8FD9DD #x858C)
- (#x8FD9DE #x858F)
- (#x8FD9DF #x8593)
- (#x8FD9E0 #x8598)
- (#x8FD9E1 #x859D)
- (#x8FD9E2 #x859F)
- (#x8FD9E3 #x85A0)
- (#x8FD9E4 #x85A2)
- (#x8FD9E5 #x85A5)
- (#x8FD9E6 #x85A7)
- (#x8FD9E7 #x85B4)
- (#x8FD9E8 #x85B6)
- (#x8FD9E9 #x85B7)
- (#x8FD9EA #x85B8)
- (#x8FD9EB #x85BC)
- (#x8FD9EC #x85BD)
- (#x8FD9ED #x85BE)
- (#x8FD9EE #x85BF)
- (#x8FD9EF #x85C2)
- (#x8FD9F0 #x85C7)
- (#x8FD9F1 #x85CA)
- (#x8FD9F2 #x85CB)
- (#x8FD9F3 #x85CE)
- (#x8FD9F4 #x85AD)
- (#x8FD9F5 #x85D8)
- (#x8FD9F6 #x85DA)
- (#x8FD9F7 #x85DF)
- (#x8FD9F8 #x85E0)
- (#x8FD9F9 #x85E6)
- (#x8FD9FA #x85E8)
- (#x8FD9FB #x85ED)
- (#x8FD9FC #x85F3)
- (#x8FD9FD #x85F6)
- (#x8FD9FE #x85FC)
- (#x8FDAA1 #x85FF)
- (#x8FDAA2 #x8600)
- (#x8FDAA3 #x8604)
- (#x8FDAA4 #x8605)
- (#x8FDAA5 #x860D)
- (#x8FDAA6 #x860E)
- (#x8FDAA7 #x8610)
- (#x8FDAA8 #x8611)
- (#x8FDAA9 #x8612)
- (#x8FDAAA #x8618)
- (#x8FDAAB #x8619)
- (#x8FDAAC #x861B)
- (#x8FDAAD #x861E)
- (#x8FDAAE #x8621)
- (#x8FDAAF #x8627)
- (#x8FDAB0 #x8629)
- (#x8FDAB1 #x8636)
- (#x8FDAB2 #x8638)
- (#x8FDAB3 #x863A)
- (#x8FDAB4 #x863C)
- (#x8FDAB5 #x863D)
- (#x8FDAB6 #x8640)
- (#x8FDAB7 #x8642)
- (#x8FDAB8 #x8646)
- (#x8FDAB9 #x8652)
- (#x8FDABA #x8653)
- (#x8FDABB #x8656)
- (#x8FDABC #x8657)
- (#x8FDABD #x8658)
- (#x8FDABE #x8659)
- (#x8FDABF #x865D)
- (#x8FDAC0 #x8660)
- (#x8FDAC1 #x8661)
- (#x8FDAC2 #x8662)
- (#x8FDAC3 #x8663)
- (#x8FDAC4 #x8664)
- (#x8FDAC5 #x8669)
- (#x8FDAC6 #x866C)
- (#x8FDAC7 #x866F)
- (#x8FDAC8 #x8675)
- (#x8FDAC9 #x8676)
- (#x8FDACA #x8677)
- (#x8FDACB #x867A)
- (#x8FDACC #x868D)
- (#x8FDACD #x8691)
- (#x8FDACE #x8696)
- (#x8FDACF #x8698)
- (#x8FDAD0 #x869A)
- (#x8FDAD1 #x869C)
- (#x8FDAD2 #x86A1)
- (#x8FDAD3 #x86A6)
- (#x8FDAD4 #x86A7)
- (#x8FDAD5 #x86A8)
- (#x8FDAD6 #x86AD)
- (#x8FDAD7 #x86B1)
- (#x8FDAD8 #x86B3)
- (#x8FDAD9 #x86B4)
- (#x8FDADA #x86B5)
- (#x8FDADB #x86B7)
- (#x8FDADC #x86B8)
- (#x8FDADD #x86B9)
- (#x8FDADE #x86BF)
- (#x8FDADF #x86C0)
- (#x8FDAE0 #x86C1)
- (#x8FDAE1 #x86C3)
- (#x8FDAE2 #x86C5)
- (#x8FDAE3 #x86D1)
- (#x8FDAE4 #x86D2)
- (#x8FDAE5 #x86D5)
- (#x8FDAE6 #x86D7)
- (#x8FDAE7 #x86DA)
- (#x8FDAE8 #x86DC)
- (#x8FDAE9 #x86E0)
- (#x8FDAEA #x86E3)
- (#x8FDAEB #x86E5)
- (#x8FDAEC #x86E7)
- (#x8FDAED #x8688)
- (#x8FDAEE #x86FA)
- (#x8FDAEF #x86FC)
- (#x8FDAF0 #x86FD)
- (#x8FDAF1 #x8704)
- (#x8FDAF2 #x8705)
- (#x8FDAF3 #x8707)
- (#x8FDAF4 #x870B)
- (#x8FDAF5 #x870E)
- (#x8FDAF6 #x870F)
- (#x8FDAF7 #x8710)
- (#x8FDAF8 #x8713)
- (#x8FDAF9 #x8714)
- (#x8FDAFA #x8719)
- (#x8FDAFB #x871E)
- (#x8FDAFC #x871F)
- (#x8FDAFD #x8721)
- (#x8FDAFE #x8723)
- (#x8FDBA1 #x8728)
- (#x8FDBA2 #x872E)
- (#x8FDBA3 #x872F)
- (#x8FDBA4 #x8731)
- (#x8FDBA5 #x8732)
- (#x8FDBA6 #x8739)
- (#x8FDBA7 #x873A)
- (#x8FDBA8 #x873C)
- (#x8FDBA9 #x873D)
- (#x8FDBAA #x873E)
- (#x8FDBAB #x8740)
- (#x8FDBAC #x8743)
- (#x8FDBAD #x8745)
- (#x8FDBAE #x874D)
- (#x8FDBAF #x8758)
- (#x8FDBB0 #x875D)
- (#x8FDBB1 #x8761)
- (#x8FDBB2 #x8764)
- (#x8FDBB3 #x8765)
- (#x8FDBB4 #x876F)
- (#x8FDBB5 #x8771)
- (#x8FDBB6 #x8772)
- (#x8FDBB7 #x877B)
- (#x8FDBB8 #x8783)
- (#x8FDBB9 #x8784)
- (#x8FDBBA #x8785)
- (#x8FDBBB #x8786)
- (#x8FDBBC #x8787)
- (#x8FDBBD #x8788)
- (#x8FDBBE #x8789)
- (#x8FDBBF #x878B)
- (#x8FDBC0 #x878C)
- (#x8FDBC1 #x8790)
- (#x8FDBC2 #x8793)
- (#x8FDBC3 #x8795)
- (#x8FDBC4 #x8797)
- (#x8FDBC5 #x8798)
- (#x8FDBC6 #x8799)
- (#x8FDBC7 #x879E)
- (#x8FDBC8 #x87A0)
- (#x8FDBC9 #x87A3)
- (#x8FDBCA #x87A7)
- (#x8FDBCB #x87AC)
- (#x8FDBCC #x87AD)
- (#x8FDBCD #x87AE)
- (#x8FDBCE #x87B1)
- (#x8FDBCF #x87B5)
- (#x8FDBD0 #x87BE)
- (#x8FDBD1 #x87BF)
- (#x8FDBD2 #x87C1)
- (#x8FDBD3 #x87C8)
- (#x8FDBD4 #x87C9)
- (#x8FDBD5 #x87CA)
- (#x8FDBD6 #x87CE)
- (#x8FDBD7 #x87D5)
- (#x8FDBD8 #x87D6)
- (#x8FDBD9 #x87D9)
- (#x8FDBDA #x87DA)
- (#x8FDBDB #x87DC)
- (#x8FDBDC #x87DF)
- (#x8FDBDD #x87E2)
- (#x8FDBDE #x87E3)
- (#x8FDBDF #x87E4)
- (#x8FDBE0 #x87EA)
- (#x8FDBE1 #x87EB)
- (#x8FDBE2 #x87ED)
- (#x8FDBE3 #x87F1)
- (#x8FDBE4 #x87F3)
- (#x8FDBE5 #x87F8)
- (#x8FDBE6 #x87FA)
- (#x8FDBE7 #x87FF)
- (#x8FDBE8 #x8801)
- (#x8FDBE9 #x8803)
- (#x8FDBEA #x8806)
- (#x8FDBEB #x8809)
- (#x8FDBEC #x880A)
- (#x8FDBED #x880B)
- (#x8FDBEE #x8810)
- (#x8FDBEF #x8819)
- (#x8FDBF0 #x8812)
- (#x8FDBF1 #x8813)
- (#x8FDBF2 #x8814)
- (#x8FDBF3 #x8818)
- (#x8FDBF4 #x881A)
- (#x8FDBF5 #x881B)
- (#x8FDBF6 #x881C)
- (#x8FDBF7 #x881E)
- (#x8FDBF8 #x881F)
- (#x8FDBF9 #x8828)
- (#x8FDBFA #x882D)
- (#x8FDBFB #x882E)
- (#x8FDBFC #x8830)
- (#x8FDBFD #x8832)
- (#x8FDBFE #x8835)
- (#x8FDCA1 #x883A)
- (#x8FDCA2 #x883C)
- (#x8FDCA3 #x8841)
- (#x8FDCA4 #x8843)
- (#x8FDCA5 #x8845)
- (#x8FDCA6 #x8848)
- (#x8FDCA7 #x8849)
- (#x8FDCA8 #x884A)
- (#x8FDCA9 #x884B)
- (#x8FDCAA #x884E)
- (#x8FDCAB #x8851)
- (#x8FDCAC #x8855)
- (#x8FDCAD #x8856)
- (#x8FDCAE #x8858)
- (#x8FDCAF #x885A)
- (#x8FDCB0 #x885C)
- (#x8FDCB1 #x885F)
- (#x8FDCB2 #x8860)
- (#x8FDCB3 #x8864)
- (#x8FDCB4 #x8869)
- (#x8FDCB5 #x8871)
- (#x8FDCB6 #x8879)
- (#x8FDCB7 #x887B)
- (#x8FDCB8 #x8880)
- (#x8FDCB9 #x8898)
- (#x8FDCBA #x889A)
- (#x8FDCBB #x889B)
- (#x8FDCBC #x889C)
- (#x8FDCBD #x889F)
- (#x8FDCBE #x88A0)
- (#x8FDCBF #x88A8)
- (#x8FDCC0 #x88AA)
- (#x8FDCC1 #x88BA)
- (#x8FDCC2 #x88BD)
- (#x8FDCC3 #x88BE)
- (#x8FDCC4 #x88C0)
- (#x8FDCC5 #x88CA)
- (#x8FDCC6 #x88CB)
- (#x8FDCC7 #x88CC)
- (#x8FDCC8 #x88CD)
- (#x8FDCC9 #x88CE)
- (#x8FDCCA #x88D1)
- (#x8FDCCB #x88D2)
- (#x8FDCCC #x88D3)
- (#x8FDCCD #x88DB)
- (#x8FDCCE #x88DE)
- (#x8FDCCF #x88E7)
- (#x8FDCD0 #x88EF)
- (#x8FDCD1 #x88F0)
- (#x8FDCD2 #x88F1)
- (#x8FDCD3 #x88F5)
- (#x8FDCD4 #x88F7)
- (#x8FDCD5 #x8901)
- (#x8FDCD6 #x8906)
- (#x8FDCD7 #x890D)
- (#x8FDCD8 #x890E)
- (#x8FDCD9 #x890F)
- (#x8FDCDA #x8915)
- (#x8FDCDB #x8916)
- (#x8FDCDC #x8918)
- (#x8FDCDD #x8919)
- (#x8FDCDE #x891A)
- (#x8FDCDF #x891C)
- (#x8FDCE0 #x8920)
- (#x8FDCE1 #x8926)
- (#x8FDCE2 #x8927)
- (#x8FDCE3 #x8928)
- (#x8FDCE4 #x8930)
- (#x8FDCE5 #x8931)
- (#x8FDCE6 #x8932)
- (#x8FDCE7 #x8935)
- (#x8FDCE8 #x8939)
- (#x8FDCE9 #x893A)
- (#x8FDCEA #x893E)
- (#x8FDCEB #x8940)
- (#x8FDCEC #x8942)
- (#x8FDCED #x8945)
- (#x8FDCEE #x8946)
- (#x8FDCEF #x8949)
- (#x8FDCF0 #x894F)
- (#x8FDCF1 #x8952)
- (#x8FDCF2 #x8957)
- (#x8FDCF3 #x895A)
- (#x8FDCF4 #x895B)
- (#x8FDCF5 #x895C)
- (#x8FDCF6 #x8961)
- (#x8FDCF7 #x8962)
- (#x8FDCF8 #x8963)
- (#x8FDCF9 #x896B)
- (#x8FDCFA #x896E)
- (#x8FDCFB #x8970)
- (#x8FDCFC #x8973)
- (#x8FDCFD #x8975)
- (#x8FDCFE #x897A)
- (#x8FDDA1 #x897B)
- (#x8FDDA2 #x897C)
- (#x8FDDA3 #x897D)
- (#x8FDDA4 #x8989)
- (#x8FDDA5 #x898D)
- (#x8FDDA6 #x8990)
- (#x8FDDA7 #x8994)
- (#x8FDDA8 #x8995)
- (#x8FDDA9 #x899B)
- (#x8FDDAA #x899C)
- (#x8FDDAB #x899F)
- (#x8FDDAC #x89A0)
- (#x8FDDAD #x89A5)
- (#x8FDDAE #x89B0)
- (#x8FDDAF #x89B4)
- (#x8FDDB0 #x89B5)
- (#x8FDDB1 #x89B6)
- (#x8FDDB2 #x89B7)
- (#x8FDDB3 #x89BC)
- (#x8FDDB4 #x89D4)
- (#x8FDDB5 #x89D5)
- (#x8FDDB6 #x89D6)
- (#x8FDDB7 #x89D7)
- (#x8FDDB8 #x89D8)
- (#x8FDDB9 #x89E5)
- (#x8FDDBA #x89E9)
- (#x8FDDBB #x89EB)
- (#x8FDDBC #x89ED)
- (#x8FDDBD #x89F1)
- (#x8FDDBE #x89F3)
- (#x8FDDBF #x89F6)
- (#x8FDDC0 #x89F9)
- (#x8FDDC1 #x89FD)
- (#x8FDDC2 #x89FF)
- (#x8FDDC3 #x8A04)
- (#x8FDDC4 #x8A05)
- (#x8FDDC5 #x8A07)
- (#x8FDDC6 #x8A0F)
- (#x8FDDC7 #x8A11)
- (#x8FDDC8 #x8A12)
- (#x8FDDC9 #x8A14)
- (#x8FDDCA #x8A15)
- (#x8FDDCB #x8A1E)
- (#x8FDDCC #x8A20)
- (#x8FDDCD #x8A22)
- (#x8FDDCE #x8A24)
- (#x8FDDCF #x8A26)
- (#x8FDDD0 #x8A2B)
- (#x8FDDD1 #x8A2C)
- (#x8FDDD2 #x8A2F)
- (#x8FDDD3 #x8A35)
- (#x8FDDD4 #x8A37)
- (#x8FDDD5 #x8A3D)
- (#x8FDDD6 #x8A3E)
- (#x8FDDD7 #x8A40)
- (#x8FDDD8 #x8A43)
- (#x8FDDD9 #x8A45)
- (#x8FDDDA #x8A47)
- (#x8FDDDB #x8A49)
- (#x8FDDDC #x8A4D)
- (#x8FDDDD #x8A4E)
- (#x8FDDDE #x8A53)
- (#x8FDDDF #x8A56)
- (#x8FDDE0 #x8A57)
- (#x8FDDE1 #x8A58)
- (#x8FDDE2 #x8A5C)
- (#x8FDDE3 #x8A5D)
- (#x8FDDE4 #x8A61)
- (#x8FDDE5 #x8A65)
- (#x8FDDE6 #x8A67)
- (#x8FDDE7 #x8A75)
- (#x8FDDE8 #x8A76)
- (#x8FDDE9 #x8A77)
- (#x8FDDEA #x8A79)
- (#x8FDDEB #x8A7A)
- (#x8FDDEC #x8A7B)
- (#x8FDDED #x8A7E)
- (#x8FDDEE #x8A7F)
- (#x8FDDEF #x8A80)
- (#x8FDDF0 #x8A83)
- (#x8FDDF1 #x8A86)
- (#x8FDDF2 #x8A8B)
- (#x8FDDF3 #x8A8F)
- (#x8FDDF4 #x8A90)
- (#x8FDDF5 #x8A92)
- (#x8FDDF6 #x8A96)
- (#x8FDDF7 #x8A97)
- (#x8FDDF8 #x8A99)
- (#x8FDDF9 #x8A9F)
- (#x8FDDFA #x8AA7)
- (#x8FDDFB #x8AA9)
- (#x8FDDFC #x8AAE)
- (#x8FDDFD #x8AAF)
- (#x8FDDFE #x8AB3)
- (#x8FDEA1 #x8AB6)
- (#x8FDEA2 #x8AB7)
- (#x8FDEA3 #x8ABB)
- (#x8FDEA4 #x8ABE)
- (#x8FDEA5 #x8AC3)
- (#x8FDEA6 #x8AC6)
- (#x8FDEA7 #x8AC8)
- (#x8FDEA8 #x8AC9)
- (#x8FDEA9 #x8ACA)
- (#x8FDEAA #x8AD1)
- (#x8FDEAB #x8AD3)
- (#x8FDEAC #x8AD4)
- (#x8FDEAD #x8AD5)
- (#x8FDEAE #x8AD7)
- (#x8FDEAF #x8ADD)
- (#x8FDEB0 #x8ADF)
- (#x8FDEB1 #x8AEC)
- (#x8FDEB2 #x8AF0)
- (#x8FDEB3 #x8AF4)
- (#x8FDEB4 #x8AF5)
- (#x8FDEB5 #x8AF6)
- (#x8FDEB6 #x8AFC)
- (#x8FDEB7 #x8AFF)
- (#x8FDEB8 #x8B05)
- (#x8FDEB9 #x8B06)
- (#x8FDEBA #x8B0B)
- (#x8FDEBB #x8B11)
- (#x8FDEBC #x8B1C)
- (#x8FDEBD #x8B1E)
- (#x8FDEBE #x8B1F)
- (#x8FDEBF #x8B0A)
- (#x8FDEC0 #x8B2D)
- (#x8FDEC1 #x8B30)
- (#x8FDEC2 #x8B37)
- (#x8FDEC3 #x8B3C)
- (#x8FDEC4 #x8B42)
- (#x8FDEC5 #x8B43)
- (#x8FDEC6 #x8B44)
- (#x8FDEC7 #x8B45)
- (#x8FDEC8 #x8B46)
- (#x8FDEC9 #x8B48)
- (#x8FDECA #x8B52)
- (#x8FDECB #x8B53)
- (#x8FDECC #x8B54)
- (#x8FDECD #x8B59)
- (#x8FDECE #x8B4D)
- (#x8FDECF #x8B5E)
- (#x8FDED0 #x8B63)
- (#x8FDED1 #x8B6D)
- (#x8FDED2 #x8B76)
- (#x8FDED3 #x8B78)
- (#x8FDED4 #x8B79)
- (#x8FDED5 #x8B7C)
- (#x8FDED6 #x8B7E)
- (#x8FDED7 #x8B81)
- (#x8FDED8 #x8B84)
- (#x8FDED9 #x8B85)
- (#x8FDEDA #x8B8B)
- (#x8FDEDB #x8B8D)
- (#x8FDEDC #x8B8F)
- (#x8FDEDD #x8B94)
- (#x8FDEDE #x8B95)
- (#x8FDEDF #x8B9C)
- (#x8FDEE0 #x8B9E)
- (#x8FDEE1 #x8B9F)
- (#x8FDEE2 #x8C38)
- (#x8FDEE3 #x8C39)
- (#x8FDEE4 #x8C3D)
- (#x8FDEE5 #x8C3E)
- (#x8FDEE6 #x8C45)
- (#x8FDEE7 #x8C47)
- (#x8FDEE8 #x8C49)
- (#x8FDEE9 #x8C4B)
- (#x8FDEEA #x8C4F)
- (#x8FDEEB #x8C51)
- (#x8FDEEC #x8C53)
- (#x8FDEED #x8C54)
- (#x8FDEEE #x8C57)
- (#x8FDEEF #x8C58)
- (#x8FDEF0 #x8C5B)
- (#x8FDEF1 #x8C5D)
- (#x8FDEF2 #x8C59)
- (#x8FDEF3 #x8C63)
- (#x8FDEF4 #x8C64)
- (#x8FDEF5 #x8C66)
- (#x8FDEF6 #x8C68)
- (#x8FDEF7 #x8C69)
- (#x8FDEF8 #x8C6D)
- (#x8FDEF9 #x8C73)
- (#x8FDEFA #x8C75)
- (#x8FDEFB #x8C76)
- (#x8FDEFC #x8C7B)
- (#x8FDEFD #x8C7E)
- (#x8FDEFE #x8C86)
- (#x8FDFA1 #x8C87)
- (#x8FDFA2 #x8C8B)
- (#x8FDFA3 #x8C90)
- (#x8FDFA4 #x8C92)
- (#x8FDFA5 #x8C93)
- (#x8FDFA6 #x8C99)
- (#x8FDFA7 #x8C9B)
- (#x8FDFA8 #x8C9C)
- (#x8FDFA9 #x8CA4)
- (#x8FDFAA #x8CB9)
- (#x8FDFAB #x8CBA)
- (#x8FDFAC #x8CC5)
- (#x8FDFAD #x8CC6)
- (#x8FDFAE #x8CC9)
- (#x8FDFAF #x8CCB)
- (#x8FDFB0 #x8CCF)
- (#x8FDFB1 #x8CD6)
- (#x8FDFB2 #x8CD5)
- (#x8FDFB3 #x8CD9)
- (#x8FDFB4 #x8CDD)
- (#x8FDFB5 #x8CE1)
- (#x8FDFB6 #x8CE8)
- (#x8FDFB7 #x8CEC)
- (#x8FDFB8 #x8CEF)
- (#x8FDFB9 #x8CF0)
- (#x8FDFBA #x8CF2)
- (#x8FDFBB #x8CF5)
- (#x8FDFBC #x8CF7)
- (#x8FDFBD #x8CF8)
- (#x8FDFBE #x8CFE)
- (#x8FDFBF #x8CFF)
- (#x8FDFC0 #x8D01)
- (#x8FDFC1 #x8D03)
- (#x8FDFC2 #x8D09)
- (#x8FDFC3 #x8D12)
- (#x8FDFC4 #x8D17)
- (#x8FDFC5 #x8D1B)
- (#x8FDFC6 #x8D65)
- (#x8FDFC7 #x8D69)
- (#x8FDFC8 #x8D6C)
- (#x8FDFC9 #x8D6E)
- (#x8FDFCA #x8D7F)
- (#x8FDFCB #x8D82)
- (#x8FDFCC #x8D84)
- (#x8FDFCD #x8D88)
- (#x8FDFCE #x8D8D)
- (#x8FDFCF #x8D90)
- (#x8FDFD0 #x8D91)
- (#x8FDFD1 #x8D95)
- (#x8FDFD2 #x8D9E)
- (#x8FDFD3 #x8D9F)
- (#x8FDFD4 #x8DA0)
- (#x8FDFD5 #x8DA6)
- (#x8FDFD6 #x8DAB)
- (#x8FDFD7 #x8DAC)
- (#x8FDFD8 #x8DAF)
- (#x8FDFD9 #x8DB2)
- (#x8FDFDA #x8DB5)
- (#x8FDFDB #x8DB7)
- (#x8FDFDC #x8DB9)
- (#x8FDFDD #x8DBB)
- (#x8FDFDE #x8DC0)
- (#x8FDFDF #x8DC5)
- (#x8FDFE0 #x8DC6)
- (#x8FDFE1 #x8DC7)
- (#x8FDFE2 #x8DC8)
- (#x8FDFE3 #x8DCA)
- (#x8FDFE4 #x8DCE)
- (#x8FDFE5 #x8DD1)
- (#x8FDFE6 #x8DD4)
- (#x8FDFE7 #x8DD5)
- (#x8FDFE8 #x8DD7)
- (#x8FDFE9 #x8DD9)
- (#x8FDFEA #x8DE4)
- (#x8FDFEB #x8DE5)
- (#x8FDFEC #x8DE7)
- (#x8FDFED #x8DEC)
- (#x8FDFEE #x8DF0)
- (#x8FDFEF #x8DBC)
- (#x8FDFF0 #x8DF1)
- (#x8FDFF1 #x8DF2)
- (#x8FDFF2 #x8DF4)
- (#x8FDFF3 #x8DFD)
- (#x8FDFF4 #x8E01)
- (#x8FDFF5 #x8E04)
- (#x8FDFF6 #x8E05)
- (#x8FDFF7 #x8E06)
- (#x8FDFF8 #x8E0B)
- (#x8FDFF9 #x8E11)
- (#x8FDFFA #x8E14)
- (#x8FDFFB #x8E16)
- (#x8FDFFC #x8E20)
- (#x8FDFFD #x8E21)
- (#x8FDFFE #x8E22)
- (#x8FE0A1 #x8E23)
- (#x8FE0A2 #x8E26)
- (#x8FE0A3 #x8E27)
- (#x8FE0A4 #x8E31)
- (#x8FE0A5 #x8E33)
- (#x8FE0A6 #x8E36)
- (#x8FE0A7 #x8E37)
- (#x8FE0A8 #x8E38)
- (#x8FE0A9 #x8E39)
- (#x8FE0AA #x8E3D)
- (#x8FE0AB #x8E40)
- (#x8FE0AC #x8E41)
- (#x8FE0AD #x8E4B)
- (#x8FE0AE #x8E4D)
- (#x8FE0AF #x8E4E)
- (#x8FE0B0 #x8E4F)
- (#x8FE0B1 #x8E54)
- (#x8FE0B2 #x8E5B)
- (#x8FE0B3 #x8E5C)
- (#x8FE0B4 #x8E5D)
- (#x8FE0B5 #x8E5E)
- (#x8FE0B6 #x8E61)
- (#x8FE0B7 #x8E62)
- (#x8FE0B8 #x8E69)
- (#x8FE0B9 #x8E6C)
- (#x8FE0BA #x8E6D)
- (#x8FE0BB #x8E6F)
- (#x8FE0BC #x8E70)
- (#x8FE0BD #x8E71)
- (#x8FE0BE #x8E79)
- (#x8FE0BF #x8E7A)
- (#x8FE0C0 #x8E7B)
- (#x8FE0C1 #x8E82)
- (#x8FE0C2 #x8E83)
- (#x8FE0C3 #x8E89)
- (#x8FE0C4 #x8E90)
- (#x8FE0C5 #x8E92)
- (#x8FE0C6 #x8E95)
- (#x8FE0C7 #x8E9A)
- (#x8FE0C8 #x8E9B)
- (#x8FE0C9 #x8E9D)
- (#x8FE0CA #x8E9E)
- (#x8FE0CB #x8EA2)
- (#x8FE0CC #x8EA7)
- (#x8FE0CD #x8EA9)
- (#x8FE0CE #x8EAD)
- (#x8FE0CF #x8EAE)
- (#x8FE0D0 #x8EB3)
- (#x8FE0D1 #x8EB5)
- (#x8FE0D2 #x8EBA)
- (#x8FE0D3 #x8EBB)
- (#x8FE0D4 #x8EC0)
- (#x8FE0D5 #x8EC1)
- (#x8FE0D6 #x8EC3)
- (#x8FE0D7 #x8EC4)
- (#x8FE0D8 #x8EC7)
- (#x8FE0D9 #x8ECF)
- (#x8FE0DA #x8ED1)
- (#x8FE0DB #x8ED4)
- (#x8FE0DC #x8EDC)
- (#x8FE0DD #x8EE8)
- (#x8FE0DE #x8EEE)
- (#x8FE0DF #x8EF0)
- (#x8FE0E0 #x8EF1)
- (#x8FE0E1 #x8EF7)
- (#x8FE0E2 #x8EF9)
- (#x8FE0E3 #x8EFA)
- (#x8FE0E4 #x8EED)
- (#x8FE0E5 #x8F00)
- (#x8FE0E6 #x8F02)
- (#x8FE0E7 #x8F07)
- (#x8FE0E8 #x8F08)
- (#x8FE0E9 #x8F0F)
- (#x8FE0EA #x8F10)
- (#x8FE0EB #x8F16)
- (#x8FE0EC #x8F17)
- (#x8FE0ED #x8F18)
- (#x8FE0EE #x8F1E)
- (#x8FE0EF #x8F20)
- (#x8FE0F0 #x8F21)
- (#x8FE0F1 #x8F23)
- (#x8FE0F2 #x8F25)
- (#x8FE0F3 #x8F27)
- (#x8FE0F4 #x8F28)
- (#x8FE0F5 #x8F2C)
- (#x8FE0F6 #x8F2D)
- (#x8FE0F7 #x8F2E)
- (#x8FE0F8 #x8F34)
- (#x8FE0F9 #x8F35)
- (#x8FE0FA #x8F36)
- (#x8FE0FB #x8F37)
- (#x8FE0FC #x8F3A)
- (#x8FE0FD #x8F40)
- (#x8FE0FE #x8F41)
- (#x8FE1A1 #x8F43)
- (#x8FE1A2 #x8F47)
- (#x8FE1A3 #x8F4F)
- (#x8FE1A4 #x8F51)
- (#x8FE1A5 #x8F52)
- (#x8FE1A6 #x8F53)
- (#x8FE1A7 #x8F54)
- (#x8FE1A8 #x8F55)
- (#x8FE1A9 #x8F58)
- (#x8FE1AA #x8F5D)
- (#x8FE1AB #x8F5E)
- (#x8FE1AC #x8F65)
- (#x8FE1AD #x8F9D)
- (#x8FE1AE #x8FA0)
- (#x8FE1AF #x8FA1)
- (#x8FE1B0 #x8FA4)
- (#x8FE1B1 #x8FA5)
- (#x8FE1B2 #x8FA6)
- (#x8FE1B3 #x8FB5)
- (#x8FE1B4 #x8FB6)
- (#x8FE1B5 #x8FB8)
- (#x8FE1B6 #x8FBE)
- (#x8FE1B7 #x8FC0)
- (#x8FE1B8 #x8FC1)
- (#x8FE1B9 #x8FC6)
- (#x8FE1BA #x8FCA)
- (#x8FE1BB #x8FCB)
- (#x8FE1BC #x8FCD)
- (#x8FE1BD #x8FD0)
- (#x8FE1BE #x8FD2)
- (#x8FE1BF #x8FD3)
- (#x8FE1C0 #x8FD5)
- (#x8FE1C1 #x8FE0)
- (#x8FE1C2 #x8FE3)
- (#x8FE1C3 #x8FE4)
- (#x8FE1C4 #x8FE8)
- (#x8FE1C5 #x8FEE)
- (#x8FE1C6 #x8FF1)
- (#x8FE1C7 #x8FF5)
- (#x8FE1C8 #x8FF6)
- (#x8FE1C9 #x8FFB)
- (#x8FE1CA #x8FFE)
- (#x8FE1CB #x9002)
- (#x8FE1CC #x9004)
- (#x8FE1CD #x9008)
- (#x8FE1CE #x900C)
- (#x8FE1CF #x9018)
- (#x8FE1D0 #x901B)
- (#x8FE1D1 #x9028)
- (#x8FE1D2 #x9029)
- (#x8FE1D3 #x902F)
- (#x8FE1D4 #x902A)
- (#x8FE1D5 #x902C)
- (#x8FE1D6 #x902D)
- (#x8FE1D7 #x9033)
- (#x8FE1D8 #x9034)
- (#x8FE1D9 #x9037)
- (#x8FE1DA #x903F)
- (#x8FE1DB #x9043)
- (#x8FE1DC #x9044)
- (#x8FE1DD #x904C)
- (#x8FE1DE #x905B)
- (#x8FE1DF #x905D)
- (#x8FE1E0 #x9062)
- (#x8FE1E1 #x9066)
- (#x8FE1E2 #x9067)
- (#x8FE1E3 #x906C)
- (#x8FE1E4 #x9070)
- (#x8FE1E5 #x9074)
- (#x8FE1E6 #x9079)
- (#x8FE1E7 #x9085)
- (#x8FE1E8 #x9088)
- (#x8FE1E9 #x908B)
- (#x8FE1EA #x908C)
- (#x8FE1EB #x908E)
- (#x8FE1EC #x9090)
- (#x8FE1ED #x9095)
- (#x8FE1EE #x9097)
- (#x8FE1EF #x9098)
- (#x8FE1F0 #x9099)
- (#x8FE1F1 #x909B)
- (#x8FE1F2 #x90A0)
- (#x8FE1F3 #x90A1)
- (#x8FE1F4 #x90A2)
- (#x8FE1F5 #x90A5)
- (#x8FE1F6 #x90B0)
- (#x8FE1F7 #x90B2)
- (#x8FE1F8 #x90B3)
- (#x8FE1F9 #x90B4)
- (#x8FE1FA #x90B6)
- (#x8FE1FB #x90BD)
- (#x8FE1FC #x90CC)
- (#x8FE1FD #x90BE)
- (#x8FE1FE #x90C3)
- (#x8FE2A1 #x90C4)
- (#x8FE2A2 #x90C5)
- (#x8FE2A3 #x90C7)
- (#x8FE2A4 #x90C8)
- (#x8FE2A5 #x90D5)
- (#x8FE2A6 #x90D7)
- (#x8FE2A7 #x90D8)
- (#x8FE2A8 #x90D9)
- (#x8FE2A9 #x90DC)
- (#x8FE2AA #x90DD)
- (#x8FE2AB #x90DF)
- (#x8FE2AC #x90E5)
- (#x8FE2AD #x90D2)
- (#x8FE2AE #x90F6)
- (#x8FE2AF #x90EB)
- (#x8FE2B0 #x90EF)
- (#x8FE2B1 #x90F0)
- (#x8FE2B2 #x90F4)
- (#x8FE2B3 #x90FE)
- (#x8FE2B4 #x90FF)
- (#x8FE2B5 #x9100)
- (#x8FE2B6 #x9104)
- (#x8FE2B7 #x9105)
- (#x8FE2B8 #x9106)
- (#x8FE2B9 #x9108)
- (#x8FE2BA #x910D)
- (#x8FE2BB #x9110)
- (#x8FE2BC #x9114)
- (#x8FE2BD #x9116)
- (#x8FE2BE #x9117)
- (#x8FE2BF #x9118)
- (#x8FE2C0 #x911A)
- (#x8FE2C1 #x911C)
- (#x8FE2C2 #x911E)
- (#x8FE2C3 #x9120)
- (#x8FE2C4 #x9125)
- (#x8FE2C5 #x9122)
- (#x8FE2C6 #x9123)
- (#x8FE2C7 #x9127)
- (#x8FE2C8 #x9129)
- (#x8FE2C9 #x912E)
- (#x8FE2CA #x912F)
- (#x8FE2CB #x9131)
- (#x8FE2CC #x9134)
- (#x8FE2CD #x9136)
- (#x8FE2CE #x9137)
- (#x8FE2CF #x9139)
- (#x8FE2D0 #x913A)
- (#x8FE2D1 #x913C)
- (#x8FE2D2 #x913D)
- (#x8FE2D3 #x9143)
- (#x8FE2D4 #x9147)
- (#x8FE2D5 #x9148)
- (#x8FE2D6 #x914F)
- (#x8FE2D7 #x9153)
- (#x8FE2D8 #x9157)
- (#x8FE2D9 #x9159)
- (#x8FE2DA #x915A)
- (#x8FE2DB #x915B)
- (#x8FE2DC #x9161)
- (#x8FE2DD #x9164)
- (#x8FE2DE #x9167)
- (#x8FE2DF #x916D)
- (#x8FE2E0 #x9174)
- (#x8FE2E1 #x9179)
- (#x8FE2E2 #x917A)
- (#x8FE2E3 #x917B)
- (#x8FE2E4 #x9181)
- (#x8FE2E5 #x9183)
- (#x8FE2E6 #x9185)
- (#x8FE2E7 #x9186)
- (#x8FE2E8 #x918A)
- (#x8FE2E9 #x918E)
- (#x8FE2EA #x9191)
- (#x8FE2EB #x9193)
- (#x8FE2EC #x9194)
- (#x8FE2ED #x9195)
- (#x8FE2EE #x9198)
- (#x8FE2EF #x919E)
- (#x8FE2F0 #x91A1)
- (#x8FE2F1 #x91A6)
- (#x8FE2F2 #x91A8)
- (#x8FE2F3 #x91AC)
- (#x8FE2F4 #x91AD)
- (#x8FE2F5 #x91AE)
- (#x8FE2F6 #x91B0)
- (#x8FE2F7 #x91B1)
- (#x8FE2F8 #x91B2)
- (#x8FE2F9 #x91B3)
- (#x8FE2FA #x91B6)
- (#x8FE2FB #x91BB)
- (#x8FE2FC #x91BC)
- (#x8FE2FD #x91BD)
- (#x8FE2FE #x91BF)
- (#x8FE3A1 #x91C2)
- (#x8FE3A2 #x91C3)
- (#x8FE3A3 #x91C5)
- (#x8FE3A4 #x91D3)
- (#x8FE3A5 #x91D4)
- (#x8FE3A6 #x91D7)
- (#x8FE3A7 #x91D9)
- (#x8FE3A8 #x91DA)
- (#x8FE3A9 #x91DE)
- (#x8FE3AA #x91E4)
- (#x8FE3AB #x91E5)
- (#x8FE3AC #x91E9)
- (#x8FE3AD #x91EA)
- (#x8FE3AE #x91EC)
- (#x8FE3AF #x91ED)
- (#x8FE3B0 #x91EE)
- (#x8FE3B1 #x91EF)
- (#x8FE3B2 #x91F0)
- (#x8FE3B3 #x91F1)
- (#x8FE3B4 #x91F7)
- (#x8FE3B5 #x91F9)
- (#x8FE3B6 #x91FB)
- (#x8FE3B7 #x91FD)
- (#x8FE3B8 #x9200)
- (#x8FE3B9 #x9201)
- (#x8FE3BA #x9204)
- (#x8FE3BB #x9205)
- (#x8FE3BC #x9206)
- (#x8FE3BD #x9207)
- (#x8FE3BE #x9209)
- (#x8FE3BF #x920A)
- (#x8FE3C0 #x920C)
- (#x8FE3C1 #x9210)
- (#x8FE3C2 #x9212)
- (#x8FE3C3 #x9213)
- (#x8FE3C4 #x9216)
- (#x8FE3C5 #x9218)
- (#x8FE3C6 #x921C)
- (#x8FE3C7 #x921D)
- (#x8FE3C8 #x9223)
- (#x8FE3C9 #x9224)
- (#x8FE3CA #x9225)
- (#x8FE3CB #x9226)
- (#x8FE3CC #x9228)
- (#x8FE3CD #x922E)
- (#x8FE3CE #x922F)
- (#x8FE3CF #x9230)
- (#x8FE3D0 #x9233)
- (#x8FE3D1 #x9235)
- (#x8FE3D2 #x9236)
- (#x8FE3D3 #x9238)
- (#x8FE3D4 #x9239)
- (#x8FE3D5 #x923A)
- (#x8FE3D6 #x923C)
- (#x8FE3D7 #x923E)
- (#x8FE3D8 #x9240)
- (#x8FE3D9 #x9242)
- (#x8FE3DA #x9243)
- (#x8FE3DB #x9246)
- (#x8FE3DC #x9247)
- (#x8FE3DD #x924A)
- (#x8FE3DE #x924D)
- (#x8FE3DF #x924E)
- (#x8FE3E0 #x924F)
- (#x8FE3E1 #x9251)
- (#x8FE3E2 #x9258)
- (#x8FE3E3 #x9259)
- (#x8FE3E4 #x925C)
- (#x8FE3E5 #x925D)
- (#x8FE3E6 #x9260)
- (#x8FE3E7 #x9261)
- (#x8FE3E8 #x9265)
- (#x8FE3E9 #x9267)
- (#x8FE3EA #x9268)
- (#x8FE3EB #x9269)
- (#x8FE3EC #x926E)
- (#x8FE3ED #x926F)
- (#x8FE3EE #x9270)
- (#x8FE3EF #x9275)
- (#x8FE3F0 #x9276)
- (#x8FE3F1 #x9277)
- (#x8FE3F2 #x9278)
- (#x8FE3F3 #x9279)
- (#x8FE3F4 #x927B)
- (#x8FE3F5 #x927C)
- (#x8FE3F6 #x927D)
- (#x8FE3F7 #x927F)
- (#x8FE3F8 #x9288)
- (#x8FE3F9 #x9289)
- (#x8FE3FA #x928A)
- (#x8FE3FB #x928D)
- (#x8FE3FC #x928E)
- (#x8FE3FD #x9292)
- (#x8FE3FE #x9297)
- (#x8FE4A1 #x9299)
- (#x8FE4A2 #x929F)
- (#x8FE4A3 #x92A0)
- (#x8FE4A4 #x92A4)
- (#x8FE4A5 #x92A5)
- (#x8FE4A6 #x92A7)
- (#x8FE4A7 #x92A8)
- (#x8FE4A8 #x92AB)
- (#x8FE4A9 #x92AF)
- (#x8FE4AA #x92B2)
- (#x8FE4AB #x92B6)
- (#x8FE4AC #x92B8)
- (#x8FE4AD #x92BA)
- (#x8FE4AE #x92BB)
- (#x8FE4AF #x92BC)
- (#x8FE4B0 #x92BD)
- (#x8FE4B1 #x92BF)
- (#x8FE4B2 #x92C0)
- (#x8FE4B3 #x92C1)
- (#x8FE4B4 #x92C2)
- (#x8FE4B5 #x92C3)
- (#x8FE4B6 #x92C5)
- (#x8FE4B7 #x92C6)
- (#x8FE4B8 #x92C7)
- (#x8FE4B9 #x92C8)
- (#x8FE4BA #x92CB)
- (#x8FE4BB #x92CC)
- (#x8FE4BC #x92CD)
- (#x8FE4BD #x92CE)
- (#x8FE4BE #x92D0)
- (#x8FE4BF #x92D3)
- (#x8FE4C0 #x92D5)
- (#x8FE4C1 #x92D7)
- (#x8FE4C2 #x92D8)
- (#x8FE4C3 #x92D9)
- (#x8FE4C4 #x92DC)
- (#x8FE4C5 #x92DD)
- (#x8FE4C6 #x92DF)
- (#x8FE4C7 #x92E0)
- (#x8FE4C8 #x92E1)
- (#x8FE4C9 #x92E3)
- (#x8FE4CA #x92E5)
- (#x8FE4CB #x92E7)
- (#x8FE4CC #x92E8)
- (#x8FE4CD #x92EC)
- (#x8FE4CE #x92EE)
- (#x8FE4CF #x92F0)
- (#x8FE4D0 #x92F9)
- (#x8FE4D1 #x92FB)
- (#x8FE4D2 #x92FF)
- (#x8FE4D3 #x9300)
- (#x8FE4D4 #x9302)
- (#x8FE4D5 #x9308)
- (#x8FE4D6 #x930D)
- (#x8FE4D7 #x9311)
- (#x8FE4D8 #x9314)
- (#x8FE4D9 #x9315)
- (#x8FE4DA #x931C)
- (#x8FE4DB #x931D)
- (#x8FE4DC #x931E)
- (#x8FE4DD #x931F)
- (#x8FE4DE #x9321)
- (#x8FE4DF #x9324)
- (#x8FE4E0 #x9325)
- (#x8FE4E1 #x9327)
- (#x8FE4E2 #x9329)
- (#x8FE4E3 #x932A)
- (#x8FE4E4 #x9333)
- (#x8FE4E5 #x9334)
- (#x8FE4E6 #x9336)
- (#x8FE4E7 #x9337)
- (#x8FE4E8 #x9347)
- (#x8FE4E9 #x9348)
- (#x8FE4EA #x9349)
- (#x8FE4EB #x9350)
- (#x8FE4EC #x9351)
- (#x8FE4ED #x9352)
- (#x8FE4EE #x9355)
- (#x8FE4EF #x9357)
- (#x8FE4F0 #x9358)
- (#x8FE4F1 #x935A)
- (#x8FE4F2 #x935E)
- (#x8FE4F3 #x9364)
- (#x8FE4F4 #x9365)
- (#x8FE4F5 #x9367)
- (#x8FE4F6 #x9369)
- (#x8FE4F7 #x936A)
- (#x8FE4F8 #x936D)
- (#x8FE4F9 #x936F)
- (#x8FE4FA #x9370)
- (#x8FE4FB #x9371)
- (#x8FE4FC #x9373)
- (#x8FE4FD #x9374)
- (#x8FE4FE #x9376)
- (#x8FE5A1 #x937A)
- (#x8FE5A2 #x937D)
- (#x8FE5A3 #x937F)
- (#x8FE5A4 #x9380)
- (#x8FE5A5 #x9381)
- (#x8FE5A6 #x9382)
- (#x8FE5A7 #x9388)
- (#x8FE5A8 #x938A)
- (#x8FE5A9 #x938B)
- (#x8FE5AA #x938D)
- (#x8FE5AB #x938F)
- (#x8FE5AC #x9392)
- (#x8FE5AD #x9395)
- (#x8FE5AE #x9398)
- (#x8FE5AF #x939B)
- (#x8FE5B0 #x939E)
- (#x8FE5B1 #x93A1)
- (#x8FE5B2 #x93A3)
- (#x8FE5B3 #x93A4)
- (#x8FE5B4 #x93A6)
- (#x8FE5B5 #x93A8)
- (#x8FE5B6 #x93AB)
- (#x8FE5B7 #x93B4)
- (#x8FE5B8 #x93B5)
- (#x8FE5B9 #x93B6)
- (#x8FE5BA #x93BA)
- (#x8FE5BB #x93A9)
- (#x8FE5BC #x93C1)
- (#x8FE5BD #x93C4)
- (#x8FE5BE #x93C5)
- (#x8FE5BF #x93C6)
- (#x8FE5C0 #x93C7)
- (#x8FE5C1 #x93C9)
- (#x8FE5C2 #x93CA)
- (#x8FE5C3 #x93CB)
- (#x8FE5C4 #x93CC)
- (#x8FE5C5 #x93CD)
- (#x8FE5C6 #x93D3)
- (#x8FE5C7 #x93D9)
- (#x8FE5C8 #x93DC)
- (#x8FE5C9 #x93DE)
- (#x8FE5CA #x93DF)
- (#x8FE5CB #x93E2)
- (#x8FE5CC #x93E6)
- (#x8FE5CD #x93E7)
- (#x8FE5CE #x93F9)
- (#x8FE5CF #x93F7)
- (#x8FE5D0 #x93F8)
- (#x8FE5D1 #x93FA)
- (#x8FE5D2 #x93FB)
- (#x8FE5D3 #x93FD)
- (#x8FE5D4 #x9401)
- (#x8FE5D5 #x9402)
- (#x8FE5D6 #x9404)
- (#x8FE5D7 #x9408)
- (#x8FE5D8 #x9409)
- (#x8FE5D9 #x940D)
- (#x8FE5DA #x940E)
- (#x8FE5DB #x940F)
- (#x8FE5DC #x9415)
- (#x8FE5DD #x9416)
- (#x8FE5DE #x9417)
- (#x8FE5DF #x941F)
- (#x8FE5E0 #x942E)
- (#x8FE5E1 #x942F)
- (#x8FE5E2 #x9431)
- (#x8FE5E3 #x9432)
- (#x8FE5E4 #x9433)
- (#x8FE5E5 #x9434)
- (#x8FE5E6 #x943B)
- (#x8FE5E7 #x943F)
- (#x8FE5E8 #x943D)
- (#x8FE5E9 #x9443)
- (#x8FE5EA #x9445)
- (#x8FE5EB #x9448)
- (#x8FE5EC #x944A)
- (#x8FE5ED #x944C)
- (#x8FE5EE #x9455)
- (#x8FE5EF #x9459)
- (#x8FE5F0 #x945C)
- (#x8FE5F1 #x945F)
- (#x8FE5F2 #x9461)
- (#x8FE5F3 #x9463)
- (#x8FE5F4 #x9468)
- (#x8FE5F5 #x946B)
- (#x8FE5F6 #x946D)
- (#x8FE5F7 #x946E)
- (#x8FE5F8 #x946F)
- (#x8FE5F9 #x9471)
- (#x8FE5FA #x9472)
- (#x8FE5FB #x9484)
- (#x8FE5FC #x9483)
- (#x8FE5FD #x9578)
- (#x8FE5FE #x9579)
- (#x8FE6A1 #x957E)
- (#x8FE6A2 #x9584)
- (#x8FE6A3 #x9588)
- (#x8FE6A4 #x958C)
- (#x8FE6A5 #x958D)
- (#x8FE6A6 #x958E)
- (#x8FE6A7 #x959D)
- (#x8FE6A8 #x959E)
- (#x8FE6A9 #x959F)
- (#x8FE6AA #x95A1)
- (#x8FE6AB #x95A6)
- (#x8FE6AC #x95A9)
- (#x8FE6AD #x95AB)
- (#x8FE6AE #x95AC)
- (#x8FE6AF #x95B4)
- (#x8FE6B0 #x95B6)
- (#x8FE6B1 #x95BA)
- (#x8FE6B2 #x95BD)
- (#x8FE6B3 #x95BF)
- (#x8FE6B4 #x95C6)
- (#x8FE6B5 #x95C8)
- (#x8FE6B6 #x95C9)
- (#x8FE6B7 #x95CB)
- (#x8FE6B8 #x95D0)
- (#x8FE6B9 #x95D1)
- (#x8FE6BA #x95D2)
- (#x8FE6BB #x95D3)
- (#x8FE6BC #x95D9)
- (#x8FE6BD #x95DA)
- (#x8FE6BE #x95DD)
- (#x8FE6BF #x95DE)
- (#x8FE6C0 #x95DF)
- (#x8FE6C1 #x95E0)
- (#x8FE6C2 #x95E4)
- (#x8FE6C3 #x95E6)
- (#x8FE6C4 #x961D)
- (#x8FE6C5 #x961E)
- (#x8FE6C6 #x9622)
- (#x8FE6C7 #x9624)
- (#x8FE6C8 #x9625)
- (#x8FE6C9 #x9626)
- (#x8FE6CA #x962C)
- (#x8FE6CB #x9631)
- (#x8FE6CC #x9633)
- (#x8FE6CD #x9637)
- (#x8FE6CE #x9638)
- (#x8FE6CF #x9639)
- (#x8FE6D0 #x963A)
- (#x8FE6D1 #x963C)
- (#x8FE6D2 #x963D)
- (#x8FE6D3 #x9641)
- (#x8FE6D4 #x9652)
- (#x8FE6D5 #x9654)
- (#x8FE6D6 #x9656)
- (#x8FE6D7 #x9657)
- (#x8FE6D8 #x9658)
- (#x8FE6D9 #x9661)
- (#x8FE6DA #x966E)
- (#x8FE6DB #x9674)
- (#x8FE6DC #x967B)
- (#x8FE6DD #x967C)
- (#x8FE6DE #x967E)
- (#x8FE6DF #x967F)
- (#x8FE6E0 #x9681)
- (#x8FE6E1 #x9682)
- (#x8FE6E2 #x9683)
- (#x8FE6E3 #x9684)
- (#x8FE6E4 #x9689)
- (#x8FE6E5 #x9691)
- (#x8FE6E6 #x9696)
- (#x8FE6E7 #x969A)
- (#x8FE6E8 #x969D)
- (#x8FE6E9 #x969F)
- (#x8FE6EA #x96A4)
- (#x8FE6EB #x96A5)
- (#x8FE6EC #x96A6)
- (#x8FE6ED #x96A9)
- (#x8FE6EE #x96AE)
- (#x8FE6EF #x96AF)
- (#x8FE6F0 #x96B3)
- (#x8FE6F1 #x96BA)
- (#x8FE6F2 #x96CA)
- (#x8FE6F3 #x96D2)
- (#x8FE6F4 #x5DB2)
- (#x8FE6F5 #x96D8)
- (#x8FE6F6 #x96DA)
- (#x8FE6F7 #x96DD)
- (#x8FE6F8 #x96DE)
- (#x8FE6F9 #x96DF)
- (#x8FE6FA #x96E9)
- (#x8FE6FB #x96EF)
- (#x8FE6FC #x96F1)
- (#x8FE6FD #x96FA)
- (#x8FE6FE #x9702)
- (#x8FE7A1 #x9703)
- (#x8FE7A2 #x9705)
- (#x8FE7A3 #x9709)
- (#x8FE7A4 #x971A)
- (#x8FE7A5 #x971B)
- (#x8FE7A6 #x971D)
- (#x8FE7A7 #x9721)
- (#x8FE7A8 #x9722)
- (#x8FE7A9 #x9723)
- (#x8FE7AA #x9728)
- (#x8FE7AB #x9731)
- (#x8FE7AC #x9733)
- (#x8FE7AD #x9741)
- (#x8FE7AE #x9743)
- (#x8FE7AF #x974A)
- (#x8FE7B0 #x974E)
- (#x8FE7B1 #x974F)
- (#x8FE7B2 #x9755)
- (#x8FE7B3 #x9757)
- (#x8FE7B4 #x9758)
- (#x8FE7B5 #x975A)
- (#x8FE7B6 #x975B)
- (#x8FE7B7 #x9763)
- (#x8FE7B8 #x9767)
- (#x8FE7B9 #x976A)
- (#x8FE7BA #x976E)
- (#x8FE7BB #x9773)
- (#x8FE7BC #x9776)
- (#x8FE7BD #x9777)
- (#x8FE7BE #x9778)
- (#x8FE7BF #x977B)
- (#x8FE7C0 #x977D)
- (#x8FE7C1 #x977F)
- (#x8FE7C2 #x9780)
- (#x8FE7C3 #x9789)
- (#x8FE7C4 #x9795)
- (#x8FE7C5 #x9796)
- (#x8FE7C6 #x9797)
- (#x8FE7C7 #x9799)
- (#x8FE7C8 #x979A)
- (#x8FE7C9 #x979E)
- (#x8FE7CA #x979F)
- (#x8FE7CB #x97A2)
- (#x8FE7CC #x97AC)
- (#x8FE7CD #x97AE)
- (#x8FE7CE #x97B1)
- (#x8FE7CF #x97B2)
- (#x8FE7D0 #x97B5)
- (#x8FE7D1 #x97B6)
- (#x8FE7D2 #x97B8)
- (#x8FE7D3 #x97B9)
- (#x8FE7D4 #x97BA)
- (#x8FE7D5 #x97BC)
- (#x8FE7D6 #x97BE)
- (#x8FE7D7 #x97BF)
- (#x8FE7D8 #x97C1)
- (#x8FE7D9 #x97C4)
- (#x8FE7DA #x97C5)
- (#x8FE7DB #x97C7)
- (#x8FE7DC #x97C9)
- (#x8FE7DD #x97CA)
- (#x8FE7DE #x97CC)
- (#x8FE7DF #x97CD)
- (#x8FE7E0 #x97CE)
- (#x8FE7E1 #x97D0)
- (#x8FE7E2 #x97D1)
- (#x8FE7E3 #x97D4)
- (#x8FE7E4 #x97D7)
- (#x8FE7E5 #x97D8)
- (#x8FE7E6 #x97D9)
- (#x8FE7E7 #x97DD)
- (#x8FE7E8 #x97DE)
- (#x8FE7E9 #x97E0)
- (#x8FE7EA #x97DB)
- (#x8FE7EB #x97E1)
- (#x8FE7EC #x97E4)
- (#x8FE7ED #x97EF)
- (#x8FE7EE #x97F1)
- (#x8FE7EF #x97F4)
- (#x8FE7F0 #x97F7)
- (#x8FE7F1 #x97F8)
- (#x8FE7F2 #x97FA)
- (#x8FE7F3 #x9807)
- (#x8FE7F4 #x980A)
- (#x8FE7F5 #x9819)
- (#x8FE7F6 #x980D)
- (#x8FE7F7 #x980E)
- (#x8FE7F8 #x9814)
- (#x8FE7F9 #x9816)
- (#x8FE7FA #x981C)
- (#x8FE7FB #x981E)
- (#x8FE7FC #x9820)
- (#x8FE7FD #x9823)
- (#x8FE7FE #x9826)
- (#x8FE8A1 #x982B)
- (#x8FE8A2 #x982E)
- (#x8FE8A3 #x982F)
- (#x8FE8A4 #x9830)
- (#x8FE8A5 #x9832)
- (#x8FE8A6 #x9833)
- (#x8FE8A7 #x9835)
- (#x8FE8A8 #x9825)
- (#x8FE8A9 #x983E)
- (#x8FE8AA #x9844)
- (#x8FE8AB #x9847)
- (#x8FE8AC #x984A)
- (#x8FE8AD #x9851)
- (#x8FE8AE #x9852)
- (#x8FE8AF #x9853)
- (#x8FE8B0 #x9856)
- (#x8FE8B1 #x9857)
- (#x8FE8B2 #x9859)
- (#x8FE8B3 #x985A)
- (#x8FE8B4 #x9862)
- (#x8FE8B5 #x9863)
- (#x8FE8B6 #x9865)
- (#x8FE8B7 #x9866)
- (#x8FE8B8 #x986A)
- (#x8FE8B9 #x986C)
- (#x8FE8BA #x98AB)
- (#x8FE8BB #x98AD)
- (#x8FE8BC #x98AE)
- (#x8FE8BD #x98B0)
- (#x8FE8BE #x98B4)
- (#x8FE8BF #x98B7)
- (#x8FE8C0 #x98B8)
- (#x8FE8C1 #x98BA)
- (#x8FE8C2 #x98BB)
- (#x8FE8C3 #x98BF)
- (#x8FE8C4 #x98C2)
- (#x8FE8C5 #x98C5)
- (#x8FE8C6 #x98C8)
- (#x8FE8C7 #x98CC)
- (#x8FE8C8 #x98E1)
- (#x8FE8C9 #x98E3)
- (#x8FE8CA #x98E5)
- (#x8FE8CB #x98E6)
- (#x8FE8CC #x98E7)
- (#x8FE8CD #x98EA)
- (#x8FE8CE #x98F3)
- (#x8FE8CF #x98F6)
- (#x8FE8D0 #x9902)
- (#x8FE8D1 #x9907)
- (#x8FE8D2 #x9908)
- (#x8FE8D3 #x9911)
- (#x8FE8D4 #x9915)
- (#x8FE8D5 #x9916)
- (#x8FE8D6 #x9917)
- (#x8FE8D7 #x991A)
- (#x8FE8D8 #x991B)
- (#x8FE8D9 #x991C)
- (#x8FE8DA #x991F)
- (#x8FE8DB #x9922)
- (#x8FE8DC #x9926)
- (#x8FE8DD #x9927)
- (#x8FE8DE #x992B)
- (#x8FE8DF #x9931)
- (#x8FE8E0 #x9932)
- (#x8FE8E1 #x9933)
- (#x8FE8E2 #x9934)
- (#x8FE8E3 #x9935)
- (#x8FE8E4 #x9939)
- (#x8FE8E5 #x993A)
- (#x8FE8E6 #x993B)
- (#x8FE8E7 #x993C)
- (#x8FE8E8 #x9940)
- (#x8FE8E9 #x9941)
- (#x8FE8EA #x9946)
- (#x8FE8EB #x9947)
- (#x8FE8EC #x9948)
- (#x8FE8ED #x994D)
- (#x8FE8EE #x994E)
- (#x8FE8EF #x9954)
- (#x8FE8F0 #x9958)
- (#x8FE8F1 #x9959)
- (#x8FE8F2 #x995B)
- (#x8FE8F3 #x995C)
- (#x8FE8F4 #x995E)
- (#x8FE8F5 #x995F)
- (#x8FE8F6 #x9960)
- (#x8FE8F7 #x999B)
- (#x8FE8F8 #x999D)
- (#x8FE8F9 #x999F)
- (#x8FE8FA #x99A6)
- (#x8FE8FB #x99B0)
- (#x8FE8FC #x99B1)
- (#x8FE8FD #x99B2)
- (#x8FE8FE #x99B5)
- (#x8FE9A1 #x99B9)
- (#x8FE9A2 #x99BA)
- (#x8FE9A3 #x99BD)
- (#x8FE9A4 #x99BF)
- (#x8FE9A5 #x99C3)
- (#x8FE9A6 #x99C9)
- (#x8FE9A7 #x99D3)
- (#x8FE9A8 #x99D4)
- (#x8FE9A9 #x99D9)
- (#x8FE9AA #x99DA)
- (#x8FE9AB #x99DC)
- (#x8FE9AC #x99DE)
- (#x8FE9AD #x99E7)
- (#x8FE9AE #x99EA)
- (#x8FE9AF #x99EB)
- (#x8FE9B0 #x99EC)
- (#x8FE9B1 #x99F0)
- (#x8FE9B2 #x99F4)
- (#x8FE9B3 #x99F5)
- (#x8FE9B4 #x99F9)
- (#x8FE9B5 #x99FD)
- (#x8FE9B6 #x99FE)
- (#x8FE9B7 #x9A02)
- (#x8FE9B8 #x9A03)
- (#x8FE9B9 #x9A04)
- (#x8FE9BA #x9A0B)
- (#x8FE9BB #x9A0C)
- (#x8FE9BC #x9A10)
- (#x8FE9BD #x9A11)
- (#x8FE9BE #x9A16)
- (#x8FE9BF #x9A1E)
- (#x8FE9C0 #x9A20)
- (#x8FE9C1 #x9A22)
- (#x8FE9C2 #x9A23)
- (#x8FE9C3 #x9A24)
- (#x8FE9C4 #x9A27)
- (#x8FE9C5 #x9A2D)
- (#x8FE9C6 #x9A2E)
- (#x8FE9C7 #x9A33)
- (#x8FE9C8 #x9A35)
- (#x8FE9C9 #x9A36)
- (#x8FE9CA #x9A38)
- (#x8FE9CB #x9A47)
- (#x8FE9CC #x9A41)
- (#x8FE9CD #x9A44)
- (#x8FE9CE #x9A4A)
- (#x8FE9CF #x9A4B)
- (#x8FE9D0 #x9A4C)
- (#x8FE9D1 #x9A4E)
- (#x8FE9D2 #x9A51)
- (#x8FE9D3 #x9A54)
- (#x8FE9D4 #x9A56)
- (#x8FE9D5 #x9A5D)
- (#x8FE9D6 #x9AAA)
- (#x8FE9D7 #x9AAC)
- (#x8FE9D8 #x9AAE)
- (#x8FE9D9 #x9AAF)
- (#x8FE9DA #x9AB2)
- (#x8FE9DB #x9AB4)
- (#x8FE9DC #x9AB5)
- (#x8FE9DD #x9AB6)
- (#x8FE9DE #x9AB9)
- (#x8FE9DF #x9ABB)
- (#x8FE9E0 #x9ABE)
- (#x8FE9E1 #x9ABF)
- (#x8FE9E2 #x9AC1)
- (#x8FE9E3 #x9AC3)
- (#x8FE9E4 #x9AC6)
- (#x8FE9E5 #x9AC8)
- (#x8FE9E6 #x9ACE)
- (#x8FE9E7 #x9AD0)
- (#x8FE9E8 #x9AD2)
- (#x8FE9E9 #x9AD5)
- (#x8FE9EA #x9AD6)
- (#x8FE9EB #x9AD7)
- (#x8FE9EC #x9ADB)
- (#x8FE9ED #x9ADC)
- (#x8FE9EE #x9AE0)
- (#x8FE9EF #x9AE4)
- (#x8FE9F0 #x9AE5)
- (#x8FE9F1 #x9AE7)
- (#x8FE9F2 #x9AE9)
- (#x8FE9F3 #x9AEC)
- (#x8FE9F4 #x9AF2)
- (#x8FE9F5 #x9AF3)
- (#x8FE9F6 #x9AF5)
- (#x8FE9F7 #x9AF9)
- (#x8FE9F8 #x9AFA)
- (#x8FE9F9 #x9AFD)
- (#x8FE9FA #x9AFF)
- (#x8FE9FB #x9B00)
- (#x8FE9FC #x9B01)
- (#x8FE9FD #x9B02)
- (#x8FE9FE #x9B03)
- (#x8FEAA1 #x9B04)
- (#x8FEAA2 #x9B05)
- (#x8FEAA3 #x9B08)
- (#x8FEAA4 #x9B09)
- (#x8FEAA5 #x9B0B)
- (#x8FEAA6 #x9B0C)
- (#x8FEAA7 #x9B0D)
- (#x8FEAA8 #x9B0E)
- (#x8FEAA9 #x9B10)
- (#x8FEAAA #x9B12)
- (#x8FEAAB #x9B16)
- (#x8FEAAC #x9B19)
- (#x8FEAAD #x9B1B)
- (#x8FEAAE #x9B1C)
- (#x8FEAAF #x9B20)
- (#x8FEAB0 #x9B26)
- (#x8FEAB1 #x9B2B)
- (#x8FEAB2 #x9B2D)
- (#x8FEAB3 #x9B33)
- (#x8FEAB4 #x9B34)
- (#x8FEAB5 #x9B35)
- (#x8FEAB6 #x9B37)
- (#x8FEAB7 #x9B39)
- (#x8FEAB8 #x9B3A)
- (#x8FEAB9 #x9B3D)
- (#x8FEABA #x9B48)
- (#x8FEABB #x9B4B)
- (#x8FEABC #x9B4C)
- (#x8FEABD #x9B55)
- (#x8FEABE #x9B56)
- (#x8FEABF #x9B57)
- (#x8FEAC0 #x9B5B)
- (#x8FEAC1 #x9B5E)
- (#x8FEAC2 #x9B61)
- (#x8FEAC3 #x9B63)
- (#x8FEAC4 #x9B65)
- (#x8FEAC5 #x9B66)
- (#x8FEAC6 #x9B68)
- (#x8FEAC7 #x9B6A)
- (#x8FEAC8 #x9B6B)
- (#x8FEAC9 #x9B6C)
- (#x8FEACA #x9B6D)
- (#x8FEACB #x9B6E)
- (#x8FEACC #x9B73)
- (#x8FEACD #x9B75)
- (#x8FEACE #x9B77)
- (#x8FEACF #x9B78)
- (#x8FEAD0 #x9B79)
- (#x8FEAD1 #x9B7F)
- (#x8FEAD2 #x9B80)
- (#x8FEAD3 #x9B84)
- (#x8FEAD4 #x9B85)
- (#x8FEAD5 #x9B86)
- (#x8FEAD6 #x9B87)
- (#x8FEAD7 #x9B89)
- (#x8FEAD8 #x9B8A)
- (#x8FEAD9 #x9B8B)
- (#x8FEADA #x9B8D)
- (#x8FEADB #x9B8F)
- (#x8FEADC #x9B90)
- (#x8FEADD #x9B94)
- (#x8FEADE #x9B9A)
- (#x8FEADF #x9B9D)
- (#x8FEAE0 #x9B9E)
- (#x8FEAE1 #x9BA6)
- (#x8FEAE2 #x9BA7)
- (#x8FEAE3 #x9BA9)
- (#x8FEAE4 #x9BAC)
- (#x8FEAE5 #x9BB0)
- (#x8FEAE6 #x9BB1)
- (#x8FEAE7 #x9BB2)
- (#x8FEAE8 #x9BB7)
- (#x8FEAE9 #x9BB8)
- (#x8FEAEA #x9BBB)
- (#x8FEAEB #x9BBC)
- (#x8FEAEC #x9BBE)
- (#x8FEAED #x9BBF)
- (#x8FEAEE #x9BC1)
- (#x8FEAEF #x9BC7)
- (#x8FEAF0 #x9BC8)
- (#x8FEAF1 #x9BCE)
- (#x8FEAF2 #x9BD0)
- (#x8FEAF3 #x9BD7)
- (#x8FEAF4 #x9BD8)
- (#x8FEAF5 #x9BDD)
- (#x8FEAF6 #x9BDF)
- (#x8FEAF7 #x9BE5)
- (#x8FEAF8 #x9BE7)
- (#x8FEAF9 #x9BEA)
- (#x8FEAFA #x9BEB)
- (#x8FEAFB #x9BEF)
- (#x8FEAFC #x9BF3)
- (#x8FEAFD #x9BF7)
- (#x8FEAFE #x9BF8)
- (#x8FEBA1 #x9BF9)
- (#x8FEBA2 #x9BFA)
- (#x8FEBA3 #x9BFD)
- (#x8FEBA4 #x9BFF)
- (#x8FEBA5 #x9C00)
- (#x8FEBA6 #x9C02)
- (#x8FEBA7 #x9C0B)
- (#x8FEBA8 #x9C0F)
- (#x8FEBA9 #x9C11)
- (#x8FEBAA #x9C16)
- (#x8FEBAB #x9C18)
- (#x8FEBAC #x9C19)
- (#x8FEBAD #x9C1A)
- (#x8FEBAE #x9C1C)
- (#x8FEBAF #x9C1E)
- (#x8FEBB0 #x9C22)
- (#x8FEBB1 #x9C23)
- (#x8FEBB2 #x9C26)
- (#x8FEBB3 #x9C27)
- (#x8FEBB4 #x9C28)
- (#x8FEBB5 #x9C29)
- (#x8FEBB6 #x9C2A)
- (#x8FEBB7 #x9C31)
- (#x8FEBB8 #x9C35)
- (#x8FEBB9 #x9C36)
- (#x8FEBBA #x9C37)
- (#x8FEBBB #x9C3D)
- (#x8FEBBC #x9C41)
- (#x8FEBBD #x9C43)
- (#x8FEBBE #x9C44)
- (#x8FEBBF #x9C45)
- (#x8FEBC0 #x9C49)
- (#x8FEBC1 #x9C4A)
- (#x8FEBC2 #x9C4E)
- (#x8FEBC3 #x9C4F)
- (#x8FEBC4 #x9C50)
- (#x8FEBC5 #x9C53)
- (#x8FEBC6 #x9C54)
- (#x8FEBC7 #x9C56)
- (#x8FEBC8 #x9C58)
- (#x8FEBC9 #x9C5B)
- (#x8FEBCA #x9C5D)
- (#x8FEBCB #x9C5E)
- (#x8FEBCC #x9C5F)
- (#x8FEBCD #x9C63)
- (#x8FEBCE #x9C69)
- (#x8FEBCF #x9C6A)
- (#x8FEBD0 #x9C5C)
- (#x8FEBD1 #x9C6B)
- (#x8FEBD2 #x9C68)
- (#x8FEBD3 #x9C6E)
- (#x8FEBD4 #x9C70)
- (#x8FEBD5 #x9C72)
- (#x8FEBD6 #x9C75)
- (#x8FEBD7 #x9C77)
- (#x8FEBD8 #x9C7B)
- (#x8FEBD9 #x9CE6)
- (#x8FEBDA #x9CF2)
- (#x8FEBDB #x9CF7)
- (#x8FEBDC #x9CF9)
- (#x8FEBDD #x9D0B)
- (#x8FEBDE #x9D02)
- (#x8FEBDF #x9D11)
- (#x8FEBE0 #x9D17)
- (#x8FEBE1 #x9D18)
- (#x8FEBE2 #x9D1C)
- (#x8FEBE3 #x9D1D)
- (#x8FEBE4 #x9D1E)
- (#x8FEBE5 #x9D2F)
- (#x8FEBE6 #x9D30)
- (#x8FEBE7 #x9D32)
- (#x8FEBE8 #x9D33)
- (#x8FEBE9 #x9D34)
- (#x8FEBEA #x9D3A)
- (#x8FEBEB #x9D3C)
- (#x8FEBEC #x9D45)
- (#x8FEBED #x9D3D)
- (#x8FEBEE #x9D42)
- (#x8FEBEF #x9D43)
- (#x8FEBF0 #x9D47)
- (#x8FEBF1 #x9D4A)
- (#x8FEBF2 #x9D53)
- (#x8FEBF3 #x9D54)
- (#x8FEBF4 #x9D5F)
- (#x8FEBF5 #x9D63)
- (#x8FEBF6 #x9D62)
- (#x8FEBF7 #x9D65)
- (#x8FEBF8 #x9D69)
- (#x8FEBF9 #x9D6A)
- (#x8FEBFA #x9D6B)
- (#x8FEBFB #x9D70)
- (#x8FEBFC #x9D76)
- (#x8FEBFD #x9D77)
- (#x8FEBFE #x9D7B)
- (#x8FECA1 #x9D7C)
- (#x8FECA2 #x9D7E)
- (#x8FECA3 #x9D83)
- (#x8FECA4 #x9D84)
- (#x8FECA5 #x9D86)
- (#x8FECA6 #x9D8A)
- (#x8FECA7 #x9D8D)
- (#x8FECA8 #x9D8E)
- (#x8FECA9 #x9D92)
- (#x8FECAA #x9D93)
- (#x8FECAB #x9D95)
- (#x8FECAC #x9D96)
- (#x8FECAD #x9D97)
- (#x8FECAE #x9D98)
- (#x8FECAF #x9DA1)
- (#x8FECB0 #x9DAA)
- (#x8FECB1 #x9DAC)
- (#x8FECB2 #x9DAE)
- (#x8FECB3 #x9DB1)
- (#x8FECB4 #x9DB5)
- (#x8FECB5 #x9DB9)
- (#x8FECB6 #x9DBC)
- (#x8FECB7 #x9DBF)
- (#x8FECB8 #x9DC3)
- (#x8FECB9 #x9DC7)
- (#x8FECBA #x9DC9)
- (#x8FECBB #x9DCA)
- (#x8FECBC #x9DD4)
- (#x8FECBD #x9DD5)
- (#x8FECBE #x9DD6)
- (#x8FECBF #x9DD7)
- (#x8FECC0 #x9DDA)
- (#x8FECC1 #x9DDE)
- (#x8FECC2 #x9DDF)
- (#x8FECC3 #x9DE0)
- (#x8FECC4 #x9DE5)
- (#x8FECC5 #x9DE7)
- (#x8FECC6 #x9DE9)
- (#x8FECC7 #x9DEB)
- (#x8FECC8 #x9DEE)
- (#x8FECC9 #x9DF0)
- (#x8FECCA #x9DF3)
- (#x8FECCB #x9DF4)
- (#x8FECCC #x9DFE)
- (#x8FECCD #x9E0A)
- (#x8FECCE #x9E02)
- (#x8FECCF #x9E07)
- (#x8FECD0 #x9E0E)
- (#x8FECD1 #x9E10)
- (#x8FECD2 #x9E11)
- (#x8FECD3 #x9E12)
- (#x8FECD4 #x9E15)
- (#x8FECD5 #x9E16)
- (#x8FECD6 #x9E19)
- (#x8FECD7 #x9E1C)
- (#x8FECD8 #x9E1D)
- (#x8FECD9 #x9E7A)
- (#x8FECDA #x9E7B)
- (#x8FECDB #x9E7C)
- (#x8FECDC #x9E80)
- (#x8FECDD #x9E82)
- (#x8FECDE #x9E83)
- (#x8FECDF #x9E84)
- (#x8FECE0 #x9E85)
- (#x8FECE1 #x9E87)
- (#x8FECE2 #x9E8E)
- (#x8FECE3 #x9E8F)
- (#x8FECE4 #x9E96)
- (#x8FECE5 #x9E98)
- (#x8FECE6 #x9E9B)
- (#x8FECE7 #x9E9E)
- (#x8FECE8 #x9EA4)
- (#x8FECE9 #x9EA8)
- (#x8FECEA #x9EAC)
- (#x8FECEB #x9EAE)
- (#x8FECEC #x9EAF)
- (#x8FECED #x9EB0)
- (#x8FECEE #x9EB3)
- (#x8FECEF #x9EB4)
- (#x8FECF0 #x9EB5)
- (#x8FECF1 #x9EC6)
- (#x8FECF2 #x9EC8)
- (#x8FECF3 #x9ECB)
- (#x8FECF4 #x9ED5)
- (#x8FECF5 #x9EDF)
- (#x8FECF6 #x9EE4)
- (#x8FECF7 #x9EE7)
- (#x8FECF8 #x9EEC)
- (#x8FECF9 #x9EED)
- (#x8FECFA #x9EEE)
- (#x8FECFB #x9EF0)
- (#x8FECFC #x9EF1)
- (#x8FECFD #x9EF2)
- (#x8FECFE #x9EF5)
- (#x8FEDA1 #x9EF8)
- (#x8FEDA2 #x9EFF)
- (#x8FEDA3 #x9F02)
- (#x8FEDA4 #x9F03)
- (#x8FEDA5 #x9F09)
- (#x8FEDA6 #x9F0F)
- (#x8FEDA7 #x9F10)
- (#x8FEDA8 #x9F11)
- (#x8FEDA9 #x9F12)
- (#x8FEDAA #x9F14)
- (#x8FEDAB #x9F16)
- (#x8FEDAC #x9F17)
- (#x8FEDAD #x9F19)
- (#x8FEDAE #x9F1A)
- (#x8FEDAF #x9F1B)
- (#x8FEDB0 #x9F1F)
- (#x8FEDB1 #x9F22)
- (#x8FEDB2 #x9F26)
- (#x8FEDB3 #x9F2A)
- (#x8FEDB4 #x9F2B)
- (#x8FEDB5 #x9F2F)
- (#x8FEDB6 #x9F31)
- (#x8FEDB7 #x9F32)
- (#x8FEDB8 #x9F34)
- (#x8FEDB9 #x9F37)
- (#x8FEDBA #x9F39)
- (#x8FEDBB #x9F3A)
- (#x8FEDBC #x9F3C)
- (#x8FEDBD #x9F3D)
- (#x8FEDBE #x9F3F)
- (#x8FEDBF #x9F41)
- (#x8FEDC0 #x9F43)
- (#x8FEDC1 #x9F44)
- (#x8FEDC2 #x9F45)
- (#x8FEDC3 #x9F46)
- (#x8FEDC4 #x9F47)
- (#x8FEDC5 #x9F53)
- (#x8FEDC6 #x9F55)
- (#x8FEDC7 #x9F56)
- (#x8FEDC8 #x9F57)
- (#x8FEDC9 #x9F58)
- (#x8FEDCA #x9F5A)
- (#x8FEDCB #x9F5D)
- (#x8FEDCC #x9F5E)
- (#x8FEDCD #x9F68)
- (#x8FEDCE #x9F69)
- (#x8FEDCF #x9F6D)
- (#x8FEDD0 #x9F6E)
- (#x8FEDD1 #x9F6F)
- (#x8FEDD2 #x9F70)
- (#x8FEDD3 #x9F71)
- (#x8FEDD4 #x9F73)
- (#x8FEDD5 #x9F75)
- (#x8FEDD6 #x9F7A)
- (#x8FEDD7 #x9F7D)
- (#x8FEDD8 #x9F8F)
- (#x8FEDD9 #x9F90)
- (#x8FEDDA #x9F91)
- (#x8FEDDB #x9F92)
- (#x8FEDDC #x9F94)
- (#x8FEDDD #x9F96)
- (#x8FEDDE #x9F97)
- (#x8FEDDF #x9F9E)
- (#x8FEDE0 #x9FA1)
- (#x8FEDE1 #x9FA2)
- (#x8FEDE2 #x9FA3)
- (#x8FEDE3 #x9FA5)
- (#x8FF5A1 #xE3AC)
- (#x8FF5A2 #xE3AD)
- (#x8FF5A3 #xE3AE)
- (#x8FF5A4 #xE3AF)
- (#x8FF5A5 #xE3B0)
- (#x8FF5A6 #xE3B1)
- (#x8FF5A7 #xE3B2)
- (#x8FF5A8 #xE3B3)
- (#x8FF5A9 #xE3B4)
- (#x8FF5AA #xE3B5)
- (#x8FF5AB #xE3B6)
- (#x8FF5AC #xE3B7)
- (#x8FF5AD #xE3B8)
- (#x8FF5AE #xE3B9)
- (#x8FF5AF #xE3BA)
- (#x8FF5B0 #xE3BB)
- (#x8FF5B1 #xE3BC)
- (#x8FF5B2 #xE3BD)
- (#x8FF5B3 #xE3BE)
- (#x8FF5B4 #xE3BF)
- (#x8FF5B5 #xE3C0)
- (#x8FF5B6 #xE3C1)
- (#x8FF5B7 #xE3C2)
- (#x8FF5B8 #xE3C3)
- (#x8FF5B9 #xE3C4)
- (#x8FF5BA #xE3C5)
- (#x8FF5BB #xE3C6)
- (#x8FF5BC #xE3C7)
- (#x8FF5BD #xE3C8)
- (#x8FF5BE #xE3C9)
- (#x8FF5BF #xE3CA)
- (#x8FF5C0 #xE3CB)
- (#x8FF5C1 #xE3CC)
- (#x8FF5C2 #xE3CD)
- (#x8FF5C3 #xE3CE)
- (#x8FF5C4 #xE3CF)
- (#x8FF5C5 #xE3D0)
- (#x8FF5C6 #xE3D1)
- (#x8FF5C7 #xE3D2)
- (#x8FF5C8 #xE3D3)
- (#x8FF5C9 #xE3D4)
- (#x8FF5CA #xE3D5)
- (#x8FF5CB #xE3D6)
- (#x8FF5CC #xE3D7)
- (#x8FF5CD #xE3D8)
- (#x8FF5CE #xE3D9)
- (#x8FF5CF #xE3DA)
- (#x8FF5D0 #xE3DB)
- (#x8FF5D1 #xE3DC)
- (#x8FF5D2 #xE3DD)
- (#x8FF5D3 #xE3DE)
- (#x8FF5D4 #xE3DF)
- (#x8FF5D5 #xE3E0)
- (#x8FF5D6 #xE3E1)
- (#x8FF5D7 #xE3E2)
- (#x8FF5D8 #xE3E3)
- (#x8FF5D9 #xE3E4)
- (#x8FF5DA #xE3E5)
- (#x8FF5DB #xE3E6)
- (#x8FF5DC #xE3E7)
- (#x8FF5DD #xE3E8)
- (#x8FF5DE #xE3E9)
- (#x8FF5DF #xE3EA)
- (#x8FF5E0 #xE3EB)
- (#x8FF5E1 #xE3EC)
- (#x8FF5E2 #xE3ED)
- (#x8FF5E3 #xE3EE)
- (#x8FF5E4 #xE3EF)
- (#x8FF5E5 #xE3F0)
- (#x8FF5E6 #xE3F1)
- (#x8FF5E7 #xE3F2)
- (#x8FF5E8 #xE3F3)
- (#x8FF5E9 #xE3F4)
- (#x8FF5EA #xE3F5)
- (#x8FF5EB #xE3F6)
- (#x8FF5EC #xE3F7)
- (#x8FF5ED #xE3F8)
- (#x8FF5EE #xE3F9)
- (#x8FF5EF #xE3FA)
- (#x8FF5F0 #xE3FB)
- (#x8FF5F1 #xE3FC)
- (#x8FF5F2 #xE3FD)
- (#x8FF5F3 #xE3FE)
- (#x8FF5F4 #xE3FF)
- (#x8FF5F5 #xE400)
- (#x8FF5F6 #xE401)
- (#x8FF5F7 #xE402)
- (#x8FF5F8 #xE403)
- (#x8FF5F9 #xE404)
- (#x8FF5FA #xE405)
- (#x8FF5FB #xE406)
- (#x8FF5FC #xE407)
- (#x8FF5FD #xE408)
- (#x8FF5FE #xE409)
- (#x8FF6A1 #xE40A)
- (#x8FF6A2 #xE40B)
- (#x8FF6A3 #xE40C)
- (#x8FF6A4 #xE40D)
- (#x8FF6A5 #xE40E)
- (#x8FF6A6 #xE40F)
- (#x8FF6A7 #xE410)
- (#x8FF6A8 #xE411)
- (#x8FF6A9 #xE412)
- (#x8FF6AA #xE413)
- (#x8FF6AB #xE414)
- (#x8FF6AC #xE415)
- (#x8FF6AD #xE416)
- (#x8FF6AE #xE417)
- (#x8FF6AF #xE418)
- (#x8FF6B0 #xE419)
- (#x8FF6B1 #xE41A)
- (#x8FF6B2 #xE41B)
- (#x8FF6B3 #xE41C)
- (#x8FF6B4 #xE41D)
- (#x8FF6B5 #xE41E)
- (#x8FF6B6 #xE41F)
- (#x8FF6B7 #xE420)
- (#x8FF6B8 #xE421)
- (#x8FF6B9 #xE422)
- (#x8FF6BA #xE423)
- (#x8FF6BB #xE424)
- (#x8FF6BC #xE425)
- (#x8FF6BD #xE426)
- (#x8FF6BE #xE427)
- (#x8FF6BF #xE428)
- (#x8FF6C0 #xE429)
- (#x8FF6C1 #xE42A)
- (#x8FF6C2 #xE42B)
- (#x8FF6C3 #xE42C)
- (#x8FF6C4 #xE42D)
- (#x8FF6C5 #xE42E)
- (#x8FF6C6 #xE42F)
- (#x8FF6C7 #xE430)
- (#x8FF6C8 #xE431)
- (#x8FF6C9 #xE432)
- (#x8FF6CA #xE433)
- (#x8FF6CB #xE434)
- (#x8FF6CC #xE435)
- (#x8FF6CD #xE436)
- (#x8FF6CE #xE437)
- (#x8FF6CF #xE438)
- (#x8FF6D0 #xE439)
- (#x8FF6D1 #xE43A)
- (#x8FF6D2 #xE43B)
- (#x8FF6D3 #xE43C)
- (#x8FF6D4 #xE43D)
- (#x8FF6D5 #xE43E)
- (#x8FF6D6 #xE43F)
- (#x8FF6D7 #xE440)
- (#x8FF6D8 #xE441)
- (#x8FF6D9 #xE442)
- (#x8FF6DA #xE443)
- (#x8FF6DB #xE444)
- (#x8FF6DC #xE445)
- (#x8FF6DD #xE446)
- (#x8FF6DE #xE447)
- (#x8FF6DF #xE448)
- (#x8FF6E0 #xE449)
- (#x8FF6E1 #xE44A)
- (#x8FF6E2 #xE44B)
- (#x8FF6E3 #xE44C)
- (#x8FF6E4 #xE44D)
- (#x8FF6E5 #xE44E)
- (#x8FF6E6 #xE44F)
- (#x8FF6E7 #xE450)
- (#x8FF6E8 #xE451)
- (#x8FF6E9 #xE452)
- (#x8FF6EA #xE453)
- (#x8FF6EB #xE454)
- (#x8FF6EC #xE455)
- (#x8FF6ED #xE456)
- (#x8FF6EE #xE457)
- (#x8FF6EF #xE458)
- (#x8FF6F0 #xE459)
- (#x8FF6F1 #xE45A)
- (#x8FF6F2 #xE45B)
- (#x8FF6F3 #xE45C)
- (#x8FF6F4 #xE45D)
- (#x8FF6F5 #xE45E)
- (#x8FF6F6 #xE45F)
- (#x8FF6F7 #xE460)
- (#x8FF6F8 #xE461)
- (#x8FF6F9 #xE462)
- (#x8FF6FA #xE463)
- (#x8FF6FB #xE464)
- (#x8FF6FC #xE465)
- (#x8FF6FD #xE466)
- (#x8FF6FE #xE467)
- (#x8FF7A1 #xE468)
- (#x8FF7A2 #xE469)
- (#x8FF7A3 #xE46A)
- (#x8FF7A4 #xE46B)
- (#x8FF7A5 #xE46C)
- (#x8FF7A6 #xE46D)
- (#x8FF7A7 #xE46E)
- (#x8FF7A8 #xE46F)
- (#x8FF7A9 #xE470)
- (#x8FF7AA #xE471)
- (#x8FF7AB #xE472)
- (#x8FF7AC #xE473)
- (#x8FF7AD #xE474)
- (#x8FF7AE #xE475)
- (#x8FF7AF #xE476)
- (#x8FF7B0 #xE477)
- (#x8FF7B1 #xE478)
- (#x8FF7B2 #xE479)
- (#x8FF7B3 #xE47A)
- (#x8FF7B4 #xE47B)
- (#x8FF7B5 #xE47C)
- (#x8FF7B6 #xE47D)
- (#x8FF7B7 #xE47E)
- (#x8FF7B8 #xE47F)
- (#x8FF7B9 #xE480)
- (#x8FF7BA #xE481)
- (#x8FF7BB #xE482)
- (#x8FF7BC #xE483)
- (#x8FF7BD #xE484)
- (#x8FF7BE #xE485)
- (#x8FF7BF #xE486)
- (#x8FF7C0 #xE487)
- (#x8FF7C1 #xE488)
- (#x8FF7C2 #xE489)
- (#x8FF7C3 #xE48A)
- (#x8FF7C4 #xE48B)
- (#x8FF7C5 #xE48C)
- (#x8FF7C6 #xE48D)
- (#x8FF7C7 #xE48E)
- (#x8FF7C8 #xE48F)
- (#x8FF7C9 #xE490)
- (#x8FF7CA #xE491)
- (#x8FF7CB #xE492)
- (#x8FF7CC #xE493)
- (#x8FF7CD #xE494)
- (#x8FF7CE #xE495)
- (#x8FF7CF #xE496)
- (#x8FF7D0 #xE497)
- (#x8FF7D1 #xE498)
- (#x8FF7D2 #xE499)
- (#x8FF7D3 #xE49A)
- (#x8FF7D4 #xE49B)
- (#x8FF7D5 #xE49C)
- (#x8FF7D6 #xE49D)
- (#x8FF7D7 #xE49E)
- (#x8FF7D8 #xE49F)
- (#x8FF7D9 #xE4A0)
- (#x8FF7DA #xE4A1)
- (#x8FF7DB #xE4A2)
- (#x8FF7DC #xE4A3)
- (#x8FF7DD #xE4A4)
- (#x8FF7DE #xE4A5)
- (#x8FF7DF #xE4A6)
- (#x8FF7E0 #xE4A7)
- (#x8FF7E1 #xE4A8)
- (#x8FF7E2 #xE4A9)
- (#x8FF7E3 #xE4AA)
- (#x8FF7E4 #xE4AB)
- (#x8FF7E5 #xE4AC)
- (#x8FF7E6 #xE4AD)
- (#x8FF7E7 #xE4AE)
- (#x8FF7E8 #xE4AF)
- (#x8FF7E9 #xE4B0)
- (#x8FF7EA #xE4B1)
- (#x8FF7EB #xE4B2)
- (#x8FF7EC #xE4B3)
- (#x8FF7ED #xE4B4)
- (#x8FF7EE #xE4B5)
- (#x8FF7EF #xE4B6)
- (#x8FF7F0 #xE4B7)
- (#x8FF7F1 #xE4B8)
- (#x8FF7F2 #xE4B9)
- (#x8FF7F3 #xE4BA)
- (#x8FF7F4 #xE4BB)
- (#x8FF7F5 #xE4BC)
- (#x8FF7F6 #xE4BD)
- (#x8FF7F7 #xE4BE)
- (#x8FF7F8 #xE4BF)
- (#x8FF7F9 #xE4C0)
- (#x8FF7FA #xE4C1)
- (#x8FF7FB #xE4C2)
- (#x8FF7FC #xE4C3)
- (#x8FF7FD #xE4C4)
- (#x8FF7FE #xE4C5)
- (#x8FF8A1 #xE4C6)
- (#x8FF8A2 #xE4C7)
- (#x8FF8A3 #xE4C8)
- (#x8FF8A4 #xE4C9)
- (#x8FF8A5 #xE4CA)
- (#x8FF8A6 #xE4CB)
- (#x8FF8A7 #xE4CC)
- (#x8FF8A8 #xE4CD)
- (#x8FF8A9 #xE4CE)
- (#x8FF8AA #xE4CF)
- (#x8FF8AB #xE4D0)
- (#x8FF8AC #xE4D1)
- (#x8FF8AD #xE4D2)
- (#x8FF8AE #xE4D3)
- (#x8FF8AF #xE4D4)
- (#x8FF8B0 #xE4D5)
- (#x8FF8B1 #xE4D6)
- (#x8FF8B2 #xE4D7)
- (#x8FF8B3 #xE4D8)
- (#x8FF8B4 #xE4D9)
- (#x8FF8B5 #xE4DA)
- (#x8FF8B6 #xE4DB)
- (#x8FF8B7 #xE4DC)
- (#x8FF8B8 #xE4DD)
- (#x8FF8B9 #xE4DE)
- (#x8FF8BA #xE4DF)
- (#x8FF8BB #xE4E0)
- (#x8FF8BC #xE4E1)
- (#x8FF8BD #xE4E2)
- (#x8FF8BE #xE4E3)
- (#x8FF8BF #xE4E4)
- (#x8FF8C0 #xE4E5)
- (#x8FF8C1 #xE4E6)
- (#x8FF8C2 #xE4E7)
- (#x8FF8C3 #xE4E8)
- (#x8FF8C4 #xE4E9)
- (#x8FF8C5 #xE4EA)
- (#x8FF8C6 #xE4EB)
- (#x8FF8C7 #xE4EC)
- (#x8FF8C8 #xE4ED)
- (#x8FF8C9 #xE4EE)
- (#x8FF8CA #xE4EF)
- (#x8FF8CB #xE4F0)
- (#x8FF8CC #xE4F1)
- (#x8FF8CD #xE4F2)
- (#x8FF8CE #xE4F3)
- (#x8FF8CF #xE4F4)
- (#x8FF8D0 #xE4F5)
- (#x8FF8D1 #xE4F6)
- (#x8FF8D2 #xE4F7)
- (#x8FF8D3 #xE4F8)
- (#x8FF8D4 #xE4F9)
- (#x8FF8D5 #xE4FA)
- (#x8FF8D6 #xE4FB)
- (#x8FF8D7 #xE4FC)
- (#x8FF8D8 #xE4FD)
- (#x8FF8D9 #xE4FE)
- (#x8FF8DA #xE4FF)
- (#x8FF8DB #xE500)
- (#x8FF8DC #xE501)
- (#x8FF8DD #xE502)
- (#x8FF8DE #xE503)
- (#x8FF8DF #xE504)
- (#x8FF8E0 #xE505)
- (#x8FF8E1 #xE506)
- (#x8FF8E2 #xE507)
- (#x8FF8E3 #xE508)
- (#x8FF8E4 #xE509)
- (#x8FF8E5 #xE50A)
- (#x8FF8E6 #xE50B)
- (#x8FF8E7 #xE50C)
- (#x8FF8E8 #xE50D)
- (#x8FF8E9 #xE50E)
- (#x8FF8EA #xE50F)
- (#x8FF8EB #xE510)
- (#x8FF8EC #xE511)
- (#x8FF8ED #xE512)
- (#x8FF8EE #xE513)
- (#x8FF8EF #xE514)
- (#x8FF8F0 #xE515)
- (#x8FF8F1 #xE516)
- (#x8FF8F2 #xE517)
- (#x8FF8F3 #xE518)
- (#x8FF8F4 #xE519)
- (#x8FF8F5 #xE51A)
- (#x8FF8F6 #xE51B)
- (#x8FF8F7 #xE51C)
- (#x8FF8F8 #xE51D)
- (#x8FF8F9 #xE51E)
- (#x8FF8FA #xE51F)
- (#x8FF8FB #xE520)
- (#x8FF8FC #xE521)
- (#x8FF8FD #xE522)
- (#x8FF8FE #xE523)
- (#x8FF9A1 #xE524)
- (#x8FF9A2 #xE525)
- (#x8FF9A3 #xE526)
- (#x8FF9A4 #xE527)
- (#x8FF9A5 #xE528)
- (#x8FF9A6 #xE529)
- (#x8FF9A7 #xE52A)
- (#x8FF9A8 #xE52B)
- (#x8FF9A9 #xE52C)
- (#x8FF9AA #xE52D)
- (#x8FF9AB #xE52E)
- (#x8FF9AC #xE52F)
- (#x8FF9AD #xE530)
- (#x8FF9AE #xE531)
- (#x8FF9AF #xE532)
- (#x8FF9B0 #xE533)
- (#x8FF9B1 #xE534)
- (#x8FF9B2 #xE535)
- (#x8FF9B3 #xE536)
- (#x8FF9B4 #xE537)
- (#x8FF9B5 #xE538)
- (#x8FF9B6 #xE539)
- (#x8FF9B7 #xE53A)
- (#x8FF9B8 #xE53B)
- (#x8FF9B9 #xE53C)
- (#x8FF9BA #xE53D)
- (#x8FF9BB #xE53E)
- (#x8FF9BC #xE53F)
- (#x8FF9BD #xE540)
- (#x8FF9BE #xE541)
- (#x8FF9BF #xE542)
- (#x8FF9C0 #xE543)
- (#x8FF9C1 #xE544)
- (#x8FF9C2 #xE545)
- (#x8FF9C3 #xE546)
- (#x8FF9C4 #xE547)
- (#x8FF9C5 #xE548)
- (#x8FF9C6 #xE549)
- (#x8FF9C7 #xE54A)
- (#x8FF9C8 #xE54B)
- (#x8FF9C9 #xE54C)
- (#x8FF9CA #xE54D)
- (#x8FF9CB #xE54E)
- (#x8FF9CC #xE54F)
- (#x8FF9CD #xE550)
- (#x8FF9CE #xE551)
- (#x8FF9CF #xE552)
- (#x8FF9D0 #xE553)
- (#x8FF9D1 #xE554)
- (#x8FF9D2 #xE555)
- (#x8FF9D3 #xE556)
- (#x8FF9D4 #xE557)
- (#x8FF9D5 #xE558)
- (#x8FF9D6 #xE559)
- (#x8FF9D7 #xE55A)
- (#x8FF9D8 #xE55B)
- (#x8FF9D9 #xE55C)
- (#x8FF9DA #xE55D)
- (#x8FF9DB #xE55E)
- (#x8FF9DC #xE55F)
- (#x8FF9DD #xE560)
- (#x8FF9DE #xE561)
- (#x8FF9DF #xE562)
- (#x8FF9E0 #xE563)
- (#x8FF9E1 #xE564)
- (#x8FF9E2 #xE565)
- (#x8FF9E3 #xE566)
- (#x8FF9E4 #xE567)
- (#x8FF9E5 #xE568)
- (#x8FF9E6 #xE569)
- (#x8FF9E7 #xE56A)
- (#x8FF9E8 #xE56B)
- (#x8FF9E9 #xE56C)
- (#x8FF9EA #xE56D)
- (#x8FF9EB #xE56E)
- (#x8FF9EC #xE56F)
- (#x8FF9ED #xE570)
- (#x8FF9EE #xE571)
- (#x8FF9EF #xE572)
- (#x8FF9F0 #xE573)
- (#x8FF9F1 #xE574)
- (#x8FF9F2 #xE575)
- (#x8FF9F3 #xE576)
- (#x8FF9F4 #xE577)
- (#x8FF9F5 #xE578)
- (#x8FF9F6 #xE579)
- (#x8FF9F7 #xE57A)
- (#x8FF9F8 #xE57B)
- (#x8FF9F9 #xE57C)
- (#x8FF9FA #xE57D)
- (#x8FF9FB #xE57E)
- (#x8FF9FC #xE57F)
- (#x8FF9FD #xE580)
- (#x8FF9FE #xE581)
- (#x8FFAA1 #xE582)
- (#x8FFAA2 #xE583)
- (#x8FFAA3 #xE584)
- (#x8FFAA4 #xE585)
- (#x8FFAA5 #xE586)
- (#x8FFAA6 #xE587)
- (#x8FFAA7 #xE588)
- (#x8FFAA8 #xE589)
- (#x8FFAA9 #xE58A)
- (#x8FFAAA #xE58B)
- (#x8FFAAB #xE58C)
- (#x8FFAAC #xE58D)
- (#x8FFAAD #xE58E)
- (#x8FFAAE #xE58F)
- (#x8FFAAF #xE590)
- (#x8FFAB0 #xE591)
- (#x8FFAB1 #xE592)
- (#x8FFAB2 #xE593)
- (#x8FFAB3 #xE594)
- (#x8FFAB4 #xE595)
- (#x8FFAB5 #xE596)
- (#x8FFAB6 #xE597)
- (#x8FFAB7 #xE598)
- (#x8FFAB8 #xE599)
- (#x8FFAB9 #xE59A)
- (#x8FFABA #xE59B)
- (#x8FFABB #xE59C)
- (#x8FFABC #xE59D)
- (#x8FFABD #xE59E)
- (#x8FFABE #xE59F)
- (#x8FFABF #xE5A0)
- (#x8FFAC0 #xE5A1)
- (#x8FFAC1 #xE5A2)
- (#x8FFAC2 #xE5A3)
- (#x8FFAC3 #xE5A4)
- (#x8FFAC4 #xE5A5)
- (#x8FFAC5 #xE5A6)
- (#x8FFAC6 #xE5A7)
- (#x8FFAC7 #xE5A8)
- (#x8FFAC8 #xE5A9)
- (#x8FFAC9 #xE5AA)
- (#x8FFACA #xE5AB)
- (#x8FFACB #xE5AC)
- (#x8FFACC #xE5AD)
- (#x8FFACD #xE5AE)
- (#x8FFACE #xE5AF)
- (#x8FFACF #xE5B0)
- (#x8FFAD0 #xE5B1)
- (#x8FFAD1 #xE5B2)
- (#x8FFAD2 #xE5B3)
- (#x8FFAD3 #xE5B4)
- (#x8FFAD4 #xE5B5)
- (#x8FFAD5 #xE5B6)
- (#x8FFAD6 #xE5B7)
- (#x8FFAD7 #xE5B8)
- (#x8FFAD8 #xE5B9)
- (#x8FFAD9 #xE5BA)
- (#x8FFADA #xE5BB)
- (#x8FFADB #xE5BC)
- (#x8FFADC #xE5BD)
- (#x8FFADD #xE5BE)
- (#x8FFADE #xE5BF)
- (#x8FFADF #xE5C0)
- (#x8FFAE0 #xE5C1)
- (#x8FFAE1 #xE5C2)
- (#x8FFAE2 #xE5C3)
- (#x8FFAE3 #xE5C4)
- (#x8FFAE4 #xE5C5)
- (#x8FFAE5 #xE5C6)
- (#x8FFAE6 #xE5C7)
- (#x8FFAE7 #xE5C8)
- (#x8FFAE8 #xE5C9)
- (#x8FFAE9 #xE5CA)
- (#x8FFAEA #xE5CB)
- (#x8FFAEB #xE5CC)
- (#x8FFAEC #xE5CD)
- (#x8FFAED #xE5CE)
- (#x8FFAEE #xE5CF)
- (#x8FFAEF #xE5D0)
- (#x8FFAF0 #xE5D1)
- (#x8FFAF1 #xE5D2)
- (#x8FFAF2 #xE5D3)
- (#x8FFAF3 #xE5D4)
- (#x8FFAF4 #xE5D5)
- (#x8FFAF5 #xE5D6)
- (#x8FFAF6 #xE5D7)
- (#x8FFAF7 #xE5D8)
- (#x8FFAF8 #xE5D9)
- (#x8FFAF9 #xE5DA)
- (#x8FFAFA #xE5DB)
- (#x8FFAFB #xE5DC)
- (#x8FFAFC #xE5DD)
- (#x8FFAFD #xE5DE)
- (#x8FFAFE #xE5DF)
- (#x8FFBA1 #xE5E0)
- (#x8FFBA2 #xE5E1)
- (#x8FFBA3 #xE5E2)
- (#x8FFBA4 #xE5E3)
- (#x8FFBA5 #xE5E4)
- (#x8FFBA6 #xE5E5)
- (#x8FFBA7 #xE5E6)
- (#x8FFBA8 #xE5E7)
- (#x8FFBA9 #xE5E8)
- (#x8FFBAA #xE5E9)
- (#x8FFBAB #xE5EA)
- (#x8FFBAC #xE5EB)
- (#x8FFBAD #xE5EC)
- (#x8FFBAE #xE5ED)
- (#x8FFBAF #xE5EE)
- (#x8FFBB0 #xE5EF)
- (#x8FFBB1 #xE5F0)
- (#x8FFBB2 #xE5F1)
- (#x8FFBB3 #xE5F2)
- (#x8FFBB4 #xE5F3)
- (#x8FFBB5 #xE5F4)
- (#x8FFBB6 #xE5F5)
- (#x8FFBB7 #xE5F6)
- (#x8FFBB8 #xE5F7)
- (#x8FFBB9 #xE5F8)
- (#x8FFBBA #xE5F9)
- (#x8FFBBB #xE5FA)
- (#x8FFBBC #xE5FB)
- (#x8FFBBD #xE5FC)
- (#x8FFBBE #xE5FD)
- (#x8FFBBF #xE5FE)
- (#x8FFBC0 #xE5FF)
- (#x8FFBC1 #xE600)
- (#x8FFBC2 #xE601)
- (#x8FFBC3 #xE602)
- (#x8FFBC4 #xE603)
- (#x8FFBC5 #xE604)
- (#x8FFBC6 #xE605)
- (#x8FFBC7 #xE606)
- (#x8FFBC8 #xE607)
- (#x8FFBC9 #xE608)
- (#x8FFBCA #xE609)
- (#x8FFBCB #xE60A)
- (#x8FFBCC #xE60B)
- (#x8FFBCD #xE60C)
- (#x8FFBCE #xE60D)
- (#x8FFBCF #xE60E)
- (#x8FFBD0 #xE60F)
- (#x8FFBD1 #xE610)
- (#x8FFBD2 #xE611)
- (#x8FFBD3 #xE612)
- (#x8FFBD4 #xE613)
- (#x8FFBD5 #xE614)
- (#x8FFBD6 #xE615)
- (#x8FFBD7 #xE616)
- (#x8FFBD8 #xE617)
- (#x8FFBD9 #xE618)
- (#x8FFBDA #xE619)
- (#x8FFBDB #xE61A)
- (#x8FFBDC #xE61B)
- (#x8FFBDD #xE61C)
- (#x8FFBDE #xE61D)
- (#x8FFBDF #xE61E)
- (#x8FFBE0 #xE61F)
- (#x8FFBE1 #xE620)
- (#x8FFBE2 #xE621)
- (#x8FFBE3 #xE622)
- (#x8FFBE4 #xE623)
- (#x8FFBE5 #xE624)
- (#x8FFBE6 #xE625)
- (#x8FFBE7 #xE626)
- (#x8FFBE8 #xE627)
- (#x8FFBE9 #xE628)
- (#x8FFBEA #xE629)
- (#x8FFBEB #xE62A)
- (#x8FFBEC #xE62B)
- (#x8FFBED #xE62C)
- (#x8FFBEE #xE62D)
- (#x8FFBEF #xE62E)
- (#x8FFBF0 #xE62F)
- (#x8FFBF1 #xE630)
- (#x8FFBF2 #xE631)
- (#x8FFBF3 #xE632)
- (#x8FFBF4 #xE633)
- (#x8FFBF5 #xE634)
- (#x8FFBF6 #xE635)
- (#x8FFBF7 #xE636)
- (#x8FFBF8 #xE637)
- (#x8FFBF9 #xE638)
- (#x8FFBFA #xE639)
- (#x8FFBFB #xE63A)
- (#x8FFBFC #xE63B)
- (#x8FFBFD #xE63C)
- (#x8FFBFE #xE63D)
- (#x8FFCA1 #xE63E)
- (#x8FFCA2 #xE63F)
- (#x8FFCA3 #xE640)
- (#x8FFCA4 #xE641)
- (#x8FFCA5 #xE642)
- (#x8FFCA6 #xE643)
- (#x8FFCA7 #xE644)
- (#x8FFCA8 #xE645)
- (#x8FFCA9 #xE646)
- (#x8FFCAA #xE647)
- (#x8FFCAB #xE648)
- (#x8FFCAC #xE649)
- (#x8FFCAD #xE64A)
- (#x8FFCAE #xE64B)
- (#x8FFCAF #xE64C)
- (#x8FFCB0 #xE64D)
- (#x8FFCB1 #xE64E)
- (#x8FFCB2 #xE64F)
- (#x8FFCB3 #xE650)
- (#x8FFCB4 #xE651)
- (#x8FFCB5 #xE652)
- (#x8FFCB6 #xE653)
- (#x8FFCB7 #xE654)
- (#x8FFCB8 #xE655)
- (#x8FFCB9 #xE656)
- (#x8FFCBA #xE657)
- (#x8FFCBB #xE658)
- (#x8FFCBC #xE659)
- (#x8FFCBD #xE65A)
- (#x8FFCBE #xE65B)
- (#x8FFCBF #xE65C)
- (#x8FFCC0 #xE65D)
- (#x8FFCC1 #xE65E)
- (#x8FFCC2 #xE65F)
- (#x8FFCC3 #xE660)
- (#x8FFCC4 #xE661)
- (#x8FFCC5 #xE662)
- (#x8FFCC6 #xE663)
- (#x8FFCC7 #xE664)
- (#x8FFCC8 #xE665)
- (#x8FFCC9 #xE666)
- (#x8FFCCA #xE667)
- (#x8FFCCB #xE668)
- (#x8FFCCC #xE669)
- (#x8FFCCD #xE66A)
- (#x8FFCCE #xE66B)
- (#x8FFCCF #xE66C)
- (#x8FFCD0 #xE66D)
- (#x8FFCD1 #xE66E)
- (#x8FFCD2 #xE66F)
- (#x8FFCD3 #xE670)
- (#x8FFCD4 #xE671)
- (#x8FFCD5 #xE672)
- (#x8FFCD6 #xE673)
- (#x8FFCD7 #xE674)
- (#x8FFCD8 #xE675)
- (#x8FFCD9 #xE676)
- (#x8FFCDA #xE677)
- (#x8FFCDB #xE678)
- (#x8FFCDC #xE679)
- (#x8FFCDD #xE67A)
- (#x8FFCDE #xE67B)
- (#x8FFCDF #xE67C)
- (#x8FFCE0 #xE67D)
- (#x8FFCE1 #xE67E)
- (#x8FFCE2 #xE67F)
- (#x8FFCE3 #xE680)
- (#x8FFCE4 #xE681)
- (#x8FFCE5 #xE682)
- (#x8FFCE6 #xE683)
- (#x8FFCE7 #xE684)
- (#x8FFCE8 #xE685)
- (#x8FFCE9 #xE686)
- (#x8FFCEA #xE687)
- (#x8FFCEB #xE688)
- (#x8FFCEC #xE689)
- (#x8FFCED #xE68A)
- (#x8FFCEE #xE68B)
- (#x8FFCEF #xE68C)
- (#x8FFCF0 #xE68D)
- (#x8FFCF1 #xE68E)
- (#x8FFCF2 #xE68F)
- (#x8FFCF3 #xE690)
- (#x8FFCF4 #xE691)
- (#x8FFCF5 #xE692)
- (#x8FFCF6 #xE693)
- (#x8FFCF7 #xE694)
- (#x8FFCF8 #xE695)
- (#x8FFCF9 #xE696)
- (#x8FFCFA #xE697)
- (#x8FFCFB #xE698)
- (#x8FFCFC #xE699)
- (#x8FFCFD #xE69A)
- (#x8FFCFE #xE69B)
- (#x8FFDA1 #xE69C)
- (#x8FFDA2 #xE69D)
- (#x8FFDA3 #xE69E)
- (#x8FFDA4 #xE69F)
- (#x8FFDA5 #xE6A0)
- (#x8FFDA6 #xE6A1)
- (#x8FFDA7 #xE6A2)
- (#x8FFDA8 #xE6A3)
- (#x8FFDA9 #xE6A4)
- (#x8FFDAA #xE6A5)
- (#x8FFDAB #xE6A6)
- (#x8FFDAC #xE6A7)
- (#x8FFDAD #xE6A8)
- (#x8FFDAE #xE6A9)
- (#x8FFDAF #xE6AA)
- (#x8FFDB0 #xE6AB)
- (#x8FFDB1 #xE6AC)
- (#x8FFDB2 #xE6AD)
- (#x8FFDB3 #xE6AE)
- (#x8FFDB4 #xE6AF)
- (#x8FFDB5 #xE6B0)
- (#x8FFDB6 #xE6B1)
- (#x8FFDB7 #xE6B2)
- (#x8FFDB8 #xE6B3)
- (#x8FFDB9 #xE6B4)
- (#x8FFDBA #xE6B5)
- (#x8FFDBB #xE6B6)
- (#x8FFDBC #xE6B7)
- (#x8FFDBD #xE6B8)
- (#x8FFDBE #xE6B9)
- (#x8FFDBF #xE6BA)
- (#x8FFDC0 #xE6BB)
- (#x8FFDC1 #xE6BC)
- (#x8FFDC2 #xE6BD)
- (#x8FFDC3 #xE6BE)
- (#x8FFDC4 #xE6BF)
- (#x8FFDC5 #xE6C0)
- (#x8FFDC6 #xE6C1)
- (#x8FFDC7 #xE6C2)
- (#x8FFDC8 #xE6C3)
- (#x8FFDC9 #xE6C4)
- (#x8FFDCA #xE6C5)
- (#x8FFDCB #xE6C6)
- (#x8FFDCC #xE6C7)
- (#x8FFDCD #xE6C8)
- (#x8FFDCE #xE6C9)
- (#x8FFDCF #xE6CA)
- (#x8FFDD0 #xE6CB)
- (#x8FFDD1 #xE6CC)
- (#x8FFDD2 #xE6CD)
- (#x8FFDD3 #xE6CE)
- (#x8FFDD4 #xE6CF)
- (#x8FFDD5 #xE6D0)
- (#x8FFDD6 #xE6D1)
- (#x8FFDD7 #xE6D2)
- (#x8FFDD8 #xE6D3)
- (#x8FFDD9 #xE6D4)
- (#x8FFDDA #xE6D5)
- (#x8FFDDB #xE6D6)
- (#x8FFDDC #xE6D7)
- (#x8FFDDD #xE6D8)
- (#x8FFDDE #xE6D9)
- (#x8FFDDF #xE6DA)
- (#x8FFDE0 #xE6DB)
- (#x8FFDE1 #xE6DC)
- (#x8FFDE2 #xE6DD)
- (#x8FFDE3 #xE6DE)
- (#x8FFDE4 #xE6DF)
- (#x8FFDE5 #xE6E0)
- (#x8FFDE6 #xE6E1)
- (#x8FFDE7 #xE6E2)
- (#x8FFDE8 #xE6E3)
- (#x8FFDE9 #xE6E4)
- (#x8FFDEA #xE6E5)
- (#x8FFDEB #xE6E6)
- (#x8FFDEC #xE6E7)
- (#x8FFDED #xE6E8)
- (#x8FFDEE #xE6E9)
- (#x8FFDEF #xE6EA)
- (#x8FFDF0 #xE6EB)
- (#x8FFDF1 #xE6EC)
- (#x8FFDF2 #xE6ED)
- (#x8FFDF3 #xE6EE)
- (#x8FFDF4 #xE6EF)
- (#x8FFDF5 #xE6F0)
- (#x8FFDF6 #xE6F1)
- (#x8FFDF7 #xE6F2)
- (#x8FFDF8 #xE6F3)
- (#x8FFDF9 #xE6F4)
- (#x8FFDFA #xE6F5)
- (#x8FFDFB #xE6F6)
- (#x8FFDFC #xE6F7)
- (#x8FFDFD #xE6F8)
- (#x8FFDFE #xE6F9)
- (#x8FFEA1 #xE6FA)
- (#x8FFEA2 #xE6FB)
- (#x8FFEA3 #xE6FC)
- (#x8FFEA4 #xE6FD)
- (#x8FFEA5 #xE6FE)
- (#x8FFEA6 #xE6FF)
- (#x8FFEA7 #xE700)
- (#x8FFEA8 #xE701)
- (#x8FFEA9 #xE702)
- (#x8FFEAA #xE703)
- (#x8FFEAB #xE704)
- (#x8FFEAC #xE705)
- (#x8FFEAD #xE706)
- (#x8FFEAE #xE707)
- (#x8FFEAF #xE708)
- (#x8FFEB0 #xE709)
- (#x8FFEB1 #xE70A)
- (#x8FFEB2 #xE70B)
- (#x8FFEB3 #xE70C)
- (#x8FFEB4 #xE70D)
- (#x8FFEB5 #xE70E)
- (#x8FFEB6 #xE70F)
- (#x8FFEB7 #xE710)
- (#x8FFEB8 #xE711)
- (#x8FFEB9 #xE712)
- (#x8FFEBA #xE713)
- (#x8FFEBB #xE714)
- (#x8FFEBC #xE715)
- (#x8FFEBD #xE716)
- (#x8FFEBE #xE717)
- (#x8FFEBF #xE718)
- (#x8FFEC0 #xE719)
- (#x8FFEC1 #xE71A)
- (#x8FFEC2 #xE71B)
- (#x8FFEC3 #xE71C)
- (#x8FFEC4 #xE71D)
- (#x8FFEC5 #xE71E)
- (#x8FFEC6 #xE71F)
- (#x8FFEC7 #xE720)
- (#x8FFEC8 #xE721)
- (#x8FFEC9 #xE722)
- (#x8FFECA #xE723)
- (#x8FFECB #xE724)
- (#x8FFECC #xE725)
- (#x8FFECD #xE726)
- (#x8FFECE #xE727)
- (#x8FFECF #xE728)
- (#x8FFED0 #xE729)
- (#x8FFED1 #xE72A)
- (#x8FFED2 #xE72B)
- (#x8FFED3 #xE72C)
- (#x8FFED4 #xE72D)
- (#x8FFED5 #xE72E)
- (#x8FFED6 #xE72F)
- (#x8FFED7 #xE730)
- (#x8FFED8 #xE731)
- (#x8FFED9 #xE732)
- (#x8FFEDA #xE733)
- (#x8FFEDB #xE734)
- (#x8FFEDC #xE735)
- (#x8FFEDD #xE736)
- (#x8FFEDE #xE737)
- (#x8FFEDF #xE738)
- (#x8FFEE0 #xE739)
- (#x8FFEE1 #xE73A)
- (#x8FFEE2 #xE73B)
- (#x8FFEE3 #xE73C)
- (#x8FFEE4 #xE73D)
- (#x8FFEE5 #xE73E)
- (#x8FFEE6 #xE73F)
- (#x8FFEE7 #xE740)
- (#x8FFEE8 #xE741)
- (#x8FFEE9 #xE742)
- (#x8FFEEA #xE743)
- (#x8FFEEB #xE744)
- (#x8FFEEC #xE745)
- (#x8FFEED #xE746)
- (#x8FFEEE #xE747)
- (#x8FFEEF #xE748)
- (#x8FFEF0 #xE749)
- (#x8FFEF1 #xE74A)
- (#x8FFEF2 #xE74B)
- (#x8FFEF3 #xE74C)
- (#x8FFEF4 #xE74D)
- (#x8FFEF5 #xE74E)
- (#x8FFEF6 #xE74F)
- (#x8FFEF7 #xE750)
- (#x8FFEF8 #xE751)
- (#x8FFEF9 #xE752)
- (#x8FFEFA #xE753)
- (#x8FFEFB #xE754)
- (#x8FFEFC #xE755)
- (#x8FFEFD #xE756)
- (#x8FFEFE #xE757)
- (#xA1A1 #x3000)
- (#xA1A2 #x3001)
- (#xA1A3 #x3002)
- (#xA1A4 #xFF0C)
- (#xA1A5 #xFF0E)
- (#xA1A6 #x30FB)
- (#xA1A7 #xFF1A)
- (#xA1A8 #xFF1B)
- (#xA1A9 #xFF1F)
- (#xA1AA #xFF01)
- (#xA1AB #x309B)
- (#xA1AC #x309C)
- (#xA1AD #xB4)
- (#xA1AE #xFF40)
- (#xA1AF #xA8)
- (#xA1B0 #xFF3E)
- (#xA1B1 #xFFE3)
- (#xA1B2 #xFF3F)
- (#xA1B3 #x30FD)
- (#xA1B4 #x30FE)
- (#xA1B5 #x309D)
- (#xA1B6 #x309E)
- (#xA1B7 #x3003)
- (#xA1B8 #x4EDD)
- (#xA1B9 #x3005)
- (#xA1BA #x3006)
- (#xA1BB #x3007)
- (#xA1BC #x30FC)
- (#xA1BD #x2015)
- (#xA1BE #x2010)
- (#xA1BF #xFF0F)
- (#xA1C0 #xFF3C)
- (#xA1C1 #x301C)
- (#xA1C2 #x2016)
- (#xA1C3 #xFF5C)
- (#xA1C4 #x2026)
- (#xA1C5 #x2025)
- (#xA1C6 #x2018)
- (#xA1C7 #x2019)
- (#xA1C8 #x201C)
- (#xA1C9 #x201D)
- (#xA1CA #xFF08)
- (#xA1CB #xFF09)
- (#xA1CC #x3014)
- (#xA1CD #x3015)
- (#xA1CE #xFF3B)
- (#xA1CF #xFF3D)
- (#xA1D0 #xFF5B)
- (#xA1D1 #xFF5D)
- (#xA1D2 #x3008)
- (#xA1D3 #x3009)
- (#xA1D4 #x300A)
- (#xA1D5 #x300B)
- (#xA1D6 #x300C)
- (#xA1D7 #x300D)
- (#xA1D8 #x300E)
- (#xA1D9 #x300F)
- (#xA1DA #x3010)
- (#xA1DB #x3011)
- (#xA1DC #xFF0B)
- (#xA1DD #x2212)
- (#xA1DE #xB1)
- (#xA1DF #xD7)
- (#xA1E0 #xF7)
- (#xA1E1 #xFF1D)
- (#xA1E2 #x2260)
- (#xA1E3 #xFF1C)
- (#xA1E4 #xFF1E)
- (#xA1E5 #x2266)
- (#xA1E6 #x2267)
- (#xA1E7 #x221E)
- (#xA1E8 #x2234)
- (#xA1E9 #x2642)
- (#xA1EA #x2640)
- (#xA1EB #xB0)
- (#xA1EC #x2032)
- (#xA1ED #x2033)
- (#xA1EE #x2103)
- (#xA1EF #xFFE5)
- (#xA1F0 #xFF04)
- (#xA1F1 #xA2)
- (#xA1F2 #xA3)
- (#xA1F3 #xFF05)
- (#xA1F4 #xFF03)
- (#xA1F5 #xFF06)
- (#xA1F6 #xFF0A)
- (#xA1F7 #xFF20)
- (#xA1F8 #xA7)
- (#xA1F9 #x2606)
- (#xA1FA #x2605)
- (#xA1FB #x25CB)
- (#xA1FC #x25CF)
- (#xA1FD #x25CE)
- (#xA1FE #x25C7)
- (#xA2A1 #x25C6)
- (#xA2A2 #x25A1)
- (#xA2A3 #x25A0)
- (#xA2A4 #x25B3)
- (#xA2A5 #x25B2)
- (#xA2A6 #x25BD)
- (#xA2A7 #x25BC)
- (#xA2A8 #x203B)
- (#xA2A9 #x3012)
- (#xA2AA #x2192)
- (#xA2AB #x2190)
- (#xA2AC #x2191)
- (#xA2AD #x2193)
- (#xA2AE #x3013)
- (#xA2BA #x2208)
- (#xA2BB #x220B)
- (#xA2BC #x2286)
- (#xA2BD #x2287)
- (#xA2BE #x2282)
- (#xA2BF #x2283)
- (#xA2C0 #x222A)
- (#xA2C1 #x2229)
- (#xA2CA #x2227)
- (#xA2CB #x2228)
- (#xA2CC #xAC)
- (#xA2CD #x21D2)
- (#xA2CE #x21D4)
- (#xA2CF #x2200)
- (#xA2D0 #x2203)
- (#xA2DC #x2220)
- (#xA2DD #x22A5)
- (#xA2DE #x2312)
- (#xA2DF #x2202)
- (#xA2E0 #x2207)
- (#xA2E1 #x2261)
- (#xA2E2 #x2252)
- (#xA2E3 #x226A)
- (#xA2E4 #x226B)
- (#xA2E5 #x221A)
- (#xA2E6 #x223D)
- (#xA2E7 #x221D)
- (#xA2E8 #x2235)
- (#xA2E9 #x222B)
- (#xA2EA #x222C)
- (#xA2F2 #x212B)
- (#xA2F3 #x2030)
- (#xA2F4 #x266F)
- (#xA2F5 #x266D)
- (#xA2F6 #x266A)
- (#xA2F7 #x2020)
- (#xA2F8 #x2021)
- (#xA2F9 #xB6)
- (#xA2FE #x25EF)
- (#xA3B0 #xFF10)
- (#xA3B1 #xFF11)
- (#xA3B2 #xFF12)
- (#xA3B3 #xFF13)
- (#xA3B4 #xFF14)
- (#xA3B5 #xFF15)
- (#xA3B6 #xFF16)
- (#xA3B7 #xFF17)
- (#xA3B8 #xFF18)
- (#xA3B9 #xFF19)
- (#xA3C1 #xFF21)
- (#xA3C2 #xFF22)
- (#xA3C3 #xFF23)
- (#xA3C4 #xFF24)
- (#xA3C5 #xFF25)
- (#xA3C6 #xFF26)
- (#xA3C7 #xFF27)
- (#xA3C8 #xFF28)
- (#xA3C9 #xFF29)
- (#xA3CA #xFF2A)
- (#xA3CB #xFF2B)
- (#xA3CC #xFF2C)
- (#xA3CD #xFF2D)
- (#xA3CE #xFF2E)
- (#xA3CF #xFF2F)
- (#xA3D0 #xFF30)
- (#xA3D1 #xFF31)
- (#xA3D2 #xFF32)
- (#xA3D3 #xFF33)
- (#xA3D4 #xFF34)
- (#xA3D5 #xFF35)
- (#xA3D6 #xFF36)
- (#xA3D7 #xFF37)
- (#xA3D8 #xFF38)
- (#xA3D9 #xFF39)
- (#xA3DA #xFF3A)
- (#xA3E1 #xFF41)
- (#xA3E2 #xFF42)
- (#xA3E3 #xFF43)
- (#xA3E4 #xFF44)
- (#xA3E5 #xFF45)
- (#xA3E6 #xFF46)
- (#xA3E7 #xFF47)
- (#xA3E8 #xFF48)
- (#xA3E9 #xFF49)
- (#xA3EA #xFF4A)
- (#xA3EB #xFF4B)
- (#xA3EC #xFF4C)
- (#xA3ED #xFF4D)
- (#xA3EE #xFF4E)
- (#xA3EF #xFF4F)
- (#xA3F0 #xFF50)
- (#xA3F1 #xFF51)
- (#xA3F2 #xFF52)
- (#xA3F3 #xFF53)
- (#xA3F4 #xFF54)
- (#xA3F5 #xFF55)
- (#xA3F6 #xFF56)
- (#xA3F7 #xFF57)
- (#xA3F8 #xFF58)
- (#xA3F9 #xFF59)
- (#xA3FA #xFF5A)
- (#xA4A1 #x3041)
- (#xA4A2 #x3042)
- (#xA4A3 #x3043)
- (#xA4A4 #x3044)
- (#xA4A5 #x3045)
- (#xA4A6 #x3046)
- (#xA4A7 #x3047)
- (#xA4A8 #x3048)
- (#xA4A9 #x3049)
- (#xA4AA #x304A)
- (#xA4AB #x304B)
- (#xA4AC #x304C)
- (#xA4AD #x304D)
- (#xA4AE #x304E)
- (#xA4AF #x304F)
- (#xA4B0 #x3050)
- (#xA4B1 #x3051)
- (#xA4B2 #x3052)
- (#xA4B3 #x3053)
- (#xA4B4 #x3054)
- (#xA4B5 #x3055)
- (#xA4B6 #x3056)
- (#xA4B7 #x3057)
- (#xA4B8 #x3058)
- (#xA4B9 #x3059)
- (#xA4BA #x305A)
- (#xA4BB #x305B)
- (#xA4BC #x305C)
- (#xA4BD #x305D)
- (#xA4BE #x305E)
- (#xA4BF #x305F)
- (#xA4C0 #x3060)
- (#xA4C1 #x3061)
- (#xA4C2 #x3062)
- (#xA4C3 #x3063)
- (#xA4C4 #x3064)
- (#xA4C5 #x3065)
- (#xA4C6 #x3066)
- (#xA4C7 #x3067)
- (#xA4C8 #x3068)
- (#xA4C9 #x3069)
- (#xA4CA #x306A)
- (#xA4CB #x306B)
- (#xA4CC #x306C)
- (#xA4CD #x306D)
- (#xA4CE #x306E)
- (#xA4CF #x306F)
- (#xA4D0 #x3070)
- (#xA4D1 #x3071)
- (#xA4D2 #x3072)
- (#xA4D3 #x3073)
- (#xA4D4 #x3074)
- (#xA4D5 #x3075)
- (#xA4D6 #x3076)
- (#xA4D7 #x3077)
- (#xA4D8 #x3078)
- (#xA4D9 #x3079)
- (#xA4DA #x307A)
- (#xA4DB #x307B)
- (#xA4DC #x307C)
- (#xA4DD #x307D)
- (#xA4DE #x307E)
- (#xA4DF #x307F)
- (#xA4E0 #x3080)
- (#xA4E1 #x3081)
- (#xA4E2 #x3082)
- (#xA4E3 #x3083)
- (#xA4E4 #x3084)
- (#xA4E5 #x3085)
- (#xA4E6 #x3086)
- (#xA4E7 #x3087)
- (#xA4E8 #x3088)
- (#xA4E9 #x3089)
- (#xA4EA #x308A)
- (#xA4EB #x308B)
- (#xA4EC #x308C)
- (#xA4ED #x308D)
- (#xA4EE #x308E)
- (#xA4EF #x308F)
- (#xA4F0 #x3090)
- (#xA4F1 #x3091)
- (#xA4F2 #x3092)
- (#xA4F3 #x3093)
- (#xA5A1 #x30A1)
- (#xA5A2 #x30A2)
- (#xA5A3 #x30A3)
- (#xA5A4 #x30A4)
- (#xA5A5 #x30A5)
- (#xA5A6 #x30A6)
- (#xA5A7 #x30A7)
- (#xA5A8 #x30A8)
- (#xA5A9 #x30A9)
- (#xA5AA #x30AA)
- (#xA5AB #x30AB)
- (#xA5AC #x30AC)
- (#xA5AD #x30AD)
- (#xA5AE #x30AE)
- (#xA5AF #x30AF)
- (#xA5B0 #x30B0)
- (#xA5B1 #x30B1)
- (#xA5B2 #x30B2)
- (#xA5B3 #x30B3)
- (#xA5B4 #x30B4)
- (#xA5B5 #x30B5)
- (#xA5B6 #x30B6)
- (#xA5B7 #x30B7)
- (#xA5B8 #x30B8)
- (#xA5B9 #x30B9)
- (#xA5BA #x30BA)
- (#xA5BB #x30BB)
- (#xA5BC #x30BC)
- (#xA5BD #x30BD)
- (#xA5BE #x30BE)
- (#xA5BF #x30BF)
- (#xA5C0 #x30C0)
- (#xA5C1 #x30C1)
- (#xA5C2 #x30C2)
- (#xA5C3 #x30C3)
- (#xA5C4 #x30C4)
- (#xA5C5 #x30C5)
- (#xA5C6 #x30C6)
- (#xA5C7 #x30C7)
- (#xA5C8 #x30C8)
- (#xA5C9 #x30C9)
- (#xA5CA #x30CA)
- (#xA5CB #x30CB)
- (#xA5CC #x30CC)
- (#xA5CD #x30CD)
- (#xA5CE #x30CE)
- (#xA5CF #x30CF)
- (#xA5D0 #x30D0)
- (#xA5D1 #x30D1)
- (#xA5D2 #x30D2)
- (#xA5D3 #x30D3)
- (#xA5D4 #x30D4)
- (#xA5D5 #x30D5)
- (#xA5D6 #x30D6)
- (#xA5D7 #x30D7)
- (#xA5D8 #x30D8)
- (#xA5D9 #x30D9)
- (#xA5DA #x30DA)
- (#xA5DB #x30DB)
- (#xA5DC #x30DC)
- (#xA5DD #x30DD)
- (#xA5DE #x30DE)
- (#xA5DF #x30DF)
- (#xA5E0 #x30E0)
- (#xA5E1 #x30E1)
- (#xA5E2 #x30E2)
- (#xA5E3 #x30E3)
- (#xA5E4 #x30E4)
- (#xA5E5 #x30E5)
- (#xA5E6 #x30E6)
- (#xA5E7 #x30E7)
- (#xA5E8 #x30E8)
- (#xA5E9 #x30E9)
- (#xA5EA #x30EA)
- (#xA5EB #x30EB)
- (#xA5EC #x30EC)
- (#xA5ED #x30ED)
- (#xA5EE #x30EE)
- (#xA5EF #x30EF)
- (#xA5F0 #x30F0)
- (#xA5F1 #x30F1)
- (#xA5F2 #x30F2)
- (#xA5F3 #x30F3)
- (#xA5F4 #x30F4)
- (#xA5F5 #x30F5)
- (#xA5F6 #x30F6)
- (#xA6A1 #x391)
- (#xA6A2 #x392)
- (#xA6A3 #x393)
- (#xA6A4 #x394)
- (#xA6A5 #x395)
- (#xA6A6 #x396)
- (#xA6A7 #x397)
- (#xA6A8 #x398)
- (#xA6A9 #x399)
- (#xA6AA #x39A)
- (#xA6AB #x39B)
- (#xA6AC #x39C)
- (#xA6AD #x39D)
- (#xA6AE #x39E)
- (#xA6AF #x39F)
- (#xA6B0 #x3A0)
- (#xA6B1 #x3A1)
- (#xA6B2 #x3A3)
- (#xA6B3 #x3A4)
- (#xA6B4 #x3A5)
- (#xA6B5 #x3A6)
- (#xA6B6 #x3A7)
- (#xA6B7 #x3A8)
- (#xA6B8 #x3A9)
- (#xA6C1 #x3B1)
- (#xA6C2 #x3B2)
- (#xA6C3 #x3B3)
- (#xA6C4 #x3B4)
- (#xA6C5 #x3B5)
- (#xA6C6 #x3B6)
- (#xA6C7 #x3B7)
- (#xA6C8 #x3B8)
- (#xA6C9 #x3B9)
- (#xA6CA #x3BA)
- (#xA6CB #x3BB)
- (#xA6CC #x3BC)
- (#xA6CD #x3BD)
- (#xA6CE #x3BE)
- (#xA6CF #x3BF)
- (#xA6D0 #x3C0)
- (#xA6D1 #x3C1)
- (#xA6D2 #x3C3)
- (#xA6D3 #x3C4)
- (#xA6D4 #x3C5)
- (#xA6D5 #x3C6)
- (#xA6D6 #x3C7)
- (#xA6D7 #x3C8)
- (#xA6D8 #x3C9)
- (#xA7A1 #x410)
- (#xA7A2 #x411)
- (#xA7A3 #x412)
- (#xA7A4 #x413)
- (#xA7A5 #x414)
- (#xA7A6 #x415)
- (#xA7A7 #x401)
- (#xA7A8 #x416)
- (#xA7A9 #x417)
- (#xA7AA #x418)
- (#xA7AB #x419)
- (#xA7AC #x41A)
- (#xA7AD #x41B)
- (#xA7AE #x41C)
- (#xA7AF #x41D)
- (#xA7B0 #x41E)
- (#xA7B1 #x41F)
- (#xA7B2 #x420)
- (#xA7B3 #x421)
- (#xA7B4 #x422)
- (#xA7B5 #x423)
- (#xA7B6 #x424)
- (#xA7B7 #x425)
- (#xA7B8 #x426)
- (#xA7B9 #x427)
- (#xA7BA #x428)
- (#xA7BB #x429)
- (#xA7BC #x42A)
- (#xA7BD #x42B)
- (#xA7BE #x42C)
- (#xA7BF #x42D)
- (#xA7C0 #x42E)
- (#xA7C1 #x42F)
- (#xA7D1 #x430)
- (#xA7D2 #x431)
- (#xA7D3 #x432)
- (#xA7D4 #x433)
- (#xA7D5 #x434)
- (#xA7D6 #x435)
- (#xA7D7 #x451)
- (#xA7D8 #x436)
- (#xA7D9 #x437)
- (#xA7DA #x438)
- (#xA7DB #x439)
- (#xA7DC #x43A)
- (#xA7DD #x43B)
- (#xA7DE #x43C)
- (#xA7DF #x43D)
- (#xA7E0 #x43E)
- (#xA7E1 #x43F)
- (#xA7E2 #x440)
- (#xA7E3 #x441)
- (#xA7E4 #x442)
- (#xA7E5 #x443)
- (#xA7E6 #x444)
- (#xA7E7 #x445)
- (#xA7E8 #x446)
- (#xA7E9 #x447)
- (#xA7EA #x448)
- (#xA7EB #x449)
- (#xA7EC #x44A)
- (#xA7ED #x44B)
- (#xA7EE #x44C)
- (#xA7EF #x44D)
- (#xA7F0 #x44E)
- (#xA7F1 #x44F)
- (#xA8A1 #x2500)
- (#xA8A2 #x2502)
- (#xA8A3 #x250C)
- (#xA8A4 #x2510)
- (#xA8A5 #x2518)
- (#xA8A6 #x2514)
- (#xA8A7 #x251C)
- (#xA8A8 #x252C)
- (#xA8A9 #x2524)
- (#xA8AA #x2534)
- (#xA8AB #x253C)
- (#xA8AC #x2501)
- (#xA8AD #x2503)
- (#xA8AE #x250F)
- (#xA8AF #x2513)
- (#xA8B0 #x251B)
- (#xA8B1 #x2517)
- (#xA8B2 #x2523)
- (#xA8B3 #x2533)
- (#xA8B4 #x252B)
- (#xA8B5 #x253B)
- (#xA8B6 #x254B)
- (#xA8B7 #x2520)
- (#xA8B8 #x252F)
- (#xA8B9 #x2528)
- (#xA8BA #x2537)
- (#xA8BB #x253F)
- (#xA8BC #x251D)
- (#xA8BD #x2530)
- (#xA8BE #x2525)
- (#xA8BF #x2538)
- (#xA8C0 #x2542)
- (#xB0A1 #x4E9C)
- (#xB0A2 #x5516)
- (#xB0A3 #x5A03)
- (#xB0A4 #x963F)
- (#xB0A5 #x54C0)
- (#xB0A6 #x611B)
- (#xB0A7 #x6328)
- (#xB0A8 #x59F6)
- (#xB0A9 #x9022)
- (#xB0AA #x8475)
- (#xB0AB #x831C)
- (#xB0AC #x7A50)
- (#xB0AD #x60AA)
- (#xB0AE #x63E1)
- (#xB0AF #x6E25)
- (#xB0B0 #x65ED)
- (#xB0B1 #x8466)
- (#xB0B2 #x82A6)
- (#xB0B3 #x9BF5)
- (#xB0B4 #x6893)
- (#xB0B5 #x5727)
- (#xB0B6 #x65A1)
- (#xB0B7 #x6271)
- (#xB0B8 #x5B9B)
- (#xB0B9 #x59D0)
- (#xB0BA #x867B)
- (#xB0BB #x98F4)
- (#xB0BC #x7D62)
- (#xB0BD #x7DBE)
- (#xB0BE #x9B8E)
- (#xB0BF #x6216)
- (#xB0C0 #x7C9F)
- (#xB0C1 #x88B7)
- (#xB0C2 #x5B89)
- (#xB0C3 #x5EB5)
- (#xB0C4 #x6309)
- (#xB0C5 #x6697)
- (#xB0C6 #x6848)
- (#xB0C7 #x95C7)
- (#xB0C8 #x978D)
- (#xB0C9 #x674F)
- (#xB0CA #x4EE5)
- (#xB0CB #x4F0A)
- (#xB0CC #x4F4D)
- (#xB0CD #x4F9D)
- (#xB0CE #x5049)
- (#xB0CF #x56F2)
- (#xB0D0 #x5937)
- (#xB0D1 #x59D4)
- (#xB0D2 #x5A01)
- (#xB0D3 #x5C09)
- (#xB0D4 #x60DF)
- (#xB0D5 #x610F)
- (#xB0D6 #x6170)
- (#xB0D7 #x6613)
- (#xB0D8 #x6905)
- (#xB0D9 #x70BA)
- (#xB0DA #x754F)
- (#xB0DB #x7570)
- (#xB0DC #x79FB)
- (#xB0DD #x7DAD)
- (#xB0DE #x7DEF)
- (#xB0DF #x80C3)
- (#xB0E0 #x840E)
- (#xB0E1 #x8863)
- (#xB0E2 #x8B02)
- (#xB0E3 #x9055)
- (#xB0E4 #x907A)
- (#xB0E5 #x533B)
- (#xB0E6 #x4E95)
- (#xB0E7 #x4EA5)
- (#xB0E8 #x57DF)
- (#xB0E9 #x80B2)
- (#xB0EA #x90C1)
- (#xB0EB #x78EF)
- (#xB0EC #x4E00)
- (#xB0ED #x58F1)
- (#xB0EE #x6EA2)
- (#xB0EF #x9038)
- (#xB0F0 #x7A32)
- (#xB0F1 #x8328)
- (#xB0F2 #x828B)
- (#xB0F3 #x9C2F)
- (#xB0F4 #x5141)
- (#xB0F5 #x5370)
- (#xB0F6 #x54BD)
- (#xB0F7 #x54E1)
- (#xB0F8 #x56E0)
- (#xB0F9 #x59FB)
- (#xB0FA #x5F15)
- (#xB0FB #x98F2)
- (#xB0FC #x6DEB)
- (#xB0FD #x80E4)
- (#xB0FE #x852D)
- (#xB1A1 #x9662)
- (#xB1A2 #x9670)
- (#xB1A3 #x96A0)
- (#xB1A4 #x97FB)
- (#xB1A5 #x540B)
- (#xB1A6 #x53F3)
- (#xB1A7 #x5B87)
- (#xB1A8 #x70CF)
- (#xB1A9 #x7FBD)
- (#xB1AA #x8FC2)
- (#xB1AB #x96E8)
- (#xB1AC #x536F)
- (#xB1AD #x9D5C)
- (#xB1AE #x7ABA)
- (#xB1AF #x4E11)
- (#xB1B0 #x7893)
- (#xB1B1 #x81FC)
- (#xB1B2 #x6E26)
- (#xB1B3 #x5618)
- (#xB1B4 #x5504)
- (#xB1B5 #x6B1D)
- (#xB1B6 #x851A)
- (#xB1B7 #x9C3B)
- (#xB1B8 #x59E5)
- (#xB1B9 #x53A9)
- (#xB1BA #x6D66)
- (#xB1BB #x74DC)
- (#xB1BC #x958F)
- (#xB1BD #x5642)
- (#xB1BE #x4E91)
- (#xB1BF #x904B)
- (#xB1C0 #x96F2)
- (#xB1C1 #x834F)
- (#xB1C2 #x990C)
- (#xB1C3 #x53E1)
- (#xB1C4 #x55B6)
- (#xB1C5 #x5B30)
- (#xB1C6 #x5F71)
- (#xB1C7 #x6620)
- (#xB1C8 #x66F3)
- (#xB1C9 #x6804)
- (#xB1CA #x6C38)
- (#xB1CB #x6CF3)
- (#xB1CC #x6D29)
- (#xB1CD #x745B)
- (#xB1CE #x76C8)
- (#xB1CF #x7A4E)
- (#xB1D0 #x9834)
- (#xB1D1 #x82F1)
- (#xB1D2 #x885B)
- (#xB1D3 #x8A60)
- (#xB1D4 #x92ED)
- (#xB1D5 #x6DB2)
- (#xB1D6 #x75AB)
- (#xB1D7 #x76CA)
- (#xB1D8 #x99C5)
- (#xB1D9 #x60A6)
- (#xB1DA #x8B01)
- (#xB1DB #x8D8A)
- (#xB1DC #x95B2)
- (#xB1DD #x698E)
- (#xB1DE #x53AD)
- (#xB1DF #x5186)
- (#xB1E0 #x5712)
- (#xB1E1 #x5830)
- (#xB1E2 #x5944)
- (#xB1E3 #x5BB4)
- (#xB1E4 #x5EF6)
- (#xB1E5 #x6028)
- (#xB1E6 #x63A9)
- (#xB1E7 #x63F4)
- (#xB1E8 #x6CBF)
- (#xB1E9 #x6F14)
- (#xB1EA #x708E)
- (#xB1EB #x7114)
- (#xB1EC #x7159)
- (#xB1ED #x71D5)
- (#xB1EE #x733F)
- (#xB1EF #x7E01)
- (#xB1F0 #x8276)
- (#xB1F1 #x82D1)
- (#xB1F2 #x8597)
- (#xB1F3 #x9060)
- (#xB1F4 #x925B)
- (#xB1F5 #x9D1B)
- (#xB1F6 #x5869)
- (#xB1F7 #x65BC)
- (#xB1F8 #x6C5A)
- (#xB1F9 #x7525)
- (#xB1FA #x51F9)
- (#xB1FB #x592E)
- (#xB1FC #x5965)
- (#xB1FD #x5F80)
- (#xB1FE #x5FDC)
- (#xB2A1 #x62BC)
- (#xB2A2 #x65FA)
- (#xB2A3 #x6A2A)
- (#xB2A4 #x6B27)
- (#xB2A5 #x6BB4)
- (#xB2A6 #x738B)
- (#xB2A7 #x7FC1)
- (#xB2A8 #x8956)
- (#xB2A9 #x9D2C)
- (#xB2AA #x9D0E)
- (#xB2AB #x9EC4)
- (#xB2AC #x5CA1)
- (#xB2AD #x6C96)
- (#xB2AE #x837B)
- (#xB2AF #x5104)
- (#xB2B0 #x5C4B)
- (#xB2B1 #x61B6)
- (#xB2B2 #x81C6)
- (#xB2B3 #x6876)
- (#xB2B4 #x7261)
- (#xB2B5 #x4E59)
- (#xB2B6 #x4FFA)
- (#xB2B7 #x5378)
- (#xB2B8 #x6069)
- (#xB2B9 #x6E29)
- (#xB2BA #x7A4F)
- (#xB2BB #x97F3)
- (#xB2BC #x4E0B)
- (#xB2BD #x5316)
- (#xB2BE #x4EEE)
- (#xB2BF #x4F55)
- (#xB2C0 #x4F3D)
- (#xB2C1 #x4FA1)
- (#xB2C2 #x4F73)
- (#xB2C3 #x52A0)
- (#xB2C4 #x53EF)
- (#xB2C5 #x5609)
- (#xB2C6 #x590F)
- (#xB2C7 #x5AC1)
- (#xB2C8 #x5BB6)
- (#xB2C9 #x5BE1)
- (#xB2CA #x79D1)
- (#xB2CB #x6687)
- (#xB2CC #x679C)
- (#xB2CD #x67B6)
- (#xB2CE #x6B4C)
- (#xB2CF #x6CB3)
- (#xB2D0 #x706B)
- (#xB2D1 #x73C2)
- (#xB2D2 #x798D)
- (#xB2D3 #x79BE)
- (#xB2D4 #x7A3C)
- (#xB2D5 #x7B87)
- (#xB2D6 #x82B1)
- (#xB2D7 #x82DB)
- (#xB2D8 #x8304)
- (#xB2D9 #x8377)
- (#xB2DA #x83EF)
- (#xB2DB #x83D3)
- (#xB2DC #x8766)
- (#xB2DD #x8AB2)
- (#xB2DE #x5629)
- (#xB2DF #x8CA8)
- (#xB2E0 #x8FE6)
- (#xB2E1 #x904E)
- (#xB2E2 #x971E)
- (#xB2E3 #x868A)
- (#xB2E4 #x4FC4)
- (#xB2E5 #x5CE8)
- (#xB2E6 #x6211)
- (#xB2E7 #x7259)
- (#xB2E8 #x753B)
- (#xB2E9 #x81E5)
- (#xB2EA #x82BD)
- (#xB2EB #x86FE)
- (#xB2EC #x8CC0)
- (#xB2ED #x96C5)
- (#xB2EE #x9913)
- (#xB2EF #x99D5)
- (#xB2F0 #x4ECB)
- (#xB2F1 #x4F1A)
- (#xB2F2 #x89E3)
- (#xB2F3 #x56DE)
- (#xB2F4 #x584A)
- (#xB2F5 #x58CA)
- (#xB2F6 #x5EFB)
- (#xB2F7 #x5FEB)
- (#xB2F8 #x602A)
- (#xB2F9 #x6094)
- (#xB2FA #x6062)
- (#xB2FB #x61D0)
- (#xB2FC #x6212)
- (#xB2FD #x62D0)
- (#xB2FE #x6539)
- (#xB3A1 #x9B41)
- (#xB3A2 #x6666)
- (#xB3A3 #x68B0)
- (#xB3A4 #x6D77)
- (#xB3A5 #x7070)
- (#xB3A6 #x754C)
- (#xB3A7 #x7686)
- (#xB3A8 #x7D75)
- (#xB3A9 #x82A5)
- (#xB3AA #x87F9)
- (#xB3AB #x958B)
- (#xB3AC #x968E)
- (#xB3AD #x8C9D)
- (#xB3AE #x51F1)
- (#xB3AF #x52BE)
- (#xB3B0 #x5916)
- (#xB3B1 #x54B3)
- (#xB3B2 #x5BB3)
- (#xB3B3 #x5D16)
- (#xB3B4 #x6168)
- (#xB3B5 #x6982)
- (#xB3B6 #x6DAF)
- (#xB3B7 #x788D)
- (#xB3B8 #x84CB)
- (#xB3B9 #x8857)
- (#xB3BA #x8A72)
- (#xB3BB #x93A7)
- (#xB3BC #x9AB8)
- (#xB3BD #x6D6C)
- (#xB3BE #x99A8)
- (#xB3BF #x86D9)
- (#xB3C0 #x57A3)
- (#xB3C1 #x67FF)
- (#xB3C2 #x86CE)
- (#xB3C3 #x920E)
- (#xB3C4 #x5283)
- (#xB3C5 #x5687)
- (#xB3C6 #x5404)
- (#xB3C7 #x5ED3)
- (#xB3C8 #x62E1)
- (#xB3C9 #x64B9)
- (#xB3CA #x683C)
- (#xB3CB #x6838)
- (#xB3CC #x6BBB)
- (#xB3CD #x7372)
- (#xB3CE #x78BA)
- (#xB3CF #x7A6B)
- (#xB3D0 #x899A)
- (#xB3D1 #x89D2)
- (#xB3D2 #x8D6B)
- (#xB3D3 #x8F03)
- (#xB3D4 #x90ED)
- (#xB3D5 #x95A3)
- (#xB3D6 #x9694)
- (#xB3D7 #x9769)
- (#xB3D8 #x5B66)
- (#xB3D9 #x5CB3)
- (#xB3DA #x697D)
- (#xB3DB #x984D)
- (#xB3DC #x984E)
- (#xB3DD #x639B)
- (#xB3DE #x7B20)
- (#xB3DF #x6A2B)
- (#xB3E0 #x6A7F)
- (#xB3E1 #x68B6)
- (#xB3E2 #x9C0D)
- (#xB3E3 #x6F5F)
- (#xB3E4 #x5272)
- (#xB3E5 #x559D)
- (#xB3E6 #x6070)
- (#xB3E7 #x62EC)
- (#xB3E8 #x6D3B)
- (#xB3E9 #x6E07)
- (#xB3EA #x6ED1)
- (#xB3EB #x845B)
- (#xB3EC #x8910)
- (#xB3ED #x8F44)
- (#xB3EE #x4E14)
- (#xB3EF #x9C39)
- (#xB3F0 #x53F6)
- (#xB3F1 #x691B)
- (#xB3F2 #x6A3A)
- (#xB3F3 #x9784)
- (#xB3F4 #x682A)
- (#xB3F5 #x515C)
- (#xB3F6 #x7AC3)
- (#xB3F7 #x84B2)
- (#xB3F8 #x91DC)
- (#xB3F9 #x938C)
- (#xB3FA #x565B)
- (#xB3FB #x9D28)
- (#xB3FC #x6822)
- (#xB3FD #x8305)
- (#xB3FE #x8431)
- (#xB4A1 #x7CA5)
- (#xB4A2 #x5208)
- (#xB4A3 #x82C5)
- (#xB4A4 #x74E6)
- (#xB4A5 #x4E7E)
- (#xB4A6 #x4F83)
- (#xB4A7 #x51A0)
- (#xB4A8 #x5BD2)
- (#xB4A9 #x520A)
- (#xB4AA #x52D8)
- (#xB4AB #x52E7)
- (#xB4AC #x5DFB)
- (#xB4AD #x559A)
- (#xB4AE #x582A)
- (#xB4AF #x59E6)
- (#xB4B0 #x5B8C)
- (#xB4B1 #x5B98)
- (#xB4B2 #x5BDB)
- (#xB4B3 #x5E72)
- (#xB4B4 #x5E79)
- (#xB4B5 #x60A3)
- (#xB4B6 #x611F)
- (#xB4B7 #x6163)
- (#xB4B8 #x61BE)
- (#xB4B9 #x63DB)
- (#xB4BA #x6562)
- (#xB4BB #x67D1)
- (#xB4BC #x6853)
- (#xB4BD #x68FA)
- (#xB4BE #x6B3E)
- (#xB4BF #x6B53)
- (#xB4C0 #x6C57)
- (#xB4C1 #x6F22)
- (#xB4C2 #x6F97)
- (#xB4C3 #x6F45)
- (#xB4C4 #x74B0)
- (#xB4C5 #x7518)
- (#xB4C6 #x76E3)
- (#xB4C7 #x770B)
- (#xB4C8 #x7AFF)
- (#xB4C9 #x7BA1)
- (#xB4CA #x7C21)
- (#xB4CB #x7DE9)
- (#xB4CC #x7F36)
- (#xB4CD #x7FF0)
- (#xB4CE #x809D)
- (#xB4CF #x8266)
- (#xB4D0 #x839E)
- (#xB4D1 #x89B3)
- (#xB4D2 #x8ACC)
- (#xB4D3 #x8CAB)
- (#xB4D4 #x9084)
- (#xB4D5 #x9451)
- (#xB4D6 #x9593)
- (#xB4D7 #x9591)
- (#xB4D8 #x95A2)
- (#xB4D9 #x9665)
- (#xB4DA #x97D3)
- (#xB4DB #x9928)
- (#xB4DC #x8218)
- (#xB4DD #x4E38)
- (#xB4DE #x542B)
- (#xB4DF #x5CB8)
- (#xB4E0 #x5DCC)
- (#xB4E1 #x73A9)
- (#xB4E2 #x764C)
- (#xB4E3 #x773C)
- (#xB4E4 #x5CA9)
- (#xB4E5 #x7FEB)
- (#xB4E6 #x8D0B)
- (#xB4E7 #x96C1)
- (#xB4E8 #x9811)
- (#xB4E9 #x9854)
- (#xB4EA #x9858)
- (#xB4EB #x4F01)
- (#xB4EC #x4F0E)
- (#xB4ED #x5371)
- (#xB4EE #x559C)
- (#xB4EF #x5668)
- (#xB4F0 #x57FA)
- (#xB4F1 #x5947)
- (#xB4F2 #x5B09)
- (#xB4F3 #x5BC4)
- (#xB4F4 #x5C90)
- (#xB4F5 #x5E0C)
- (#xB4F6 #x5E7E)
- (#xB4F7 #x5FCC)
- (#xB4F8 #x63EE)
- (#xB4F9 #x673A)
- (#xB4FA #x65D7)
- (#xB4FB #x65E2)
- (#xB4FC #x671F)
- (#xB4FD #x68CB)
- (#xB4FE #x68C4)
- (#xB5A1 #x6A5F)
- (#xB5A2 #x5E30)
- (#xB5A3 #x6BC5)
- (#xB5A4 #x6C17)
- (#xB5A5 #x6C7D)
- (#xB5A6 #x757F)
- (#xB5A7 #x7948)
- (#xB5A8 #x5B63)
- (#xB5A9 #x7A00)
- (#xB5AA #x7D00)
- (#xB5AB #x5FBD)
- (#xB5AC #x898F)
- (#xB5AD #x8A18)
- (#xB5AE #x8CB4)
- (#xB5AF #x8D77)
- (#xB5B0 #x8ECC)
- (#xB5B1 #x8F1D)
- (#xB5B2 #x98E2)
- (#xB5B3 #x9A0E)
- (#xB5B4 #x9B3C)
- (#xB5B5 #x4E80)
- (#xB5B6 #x507D)
- (#xB5B7 #x5100)
- (#xB5B8 #x5993)
- (#xB5B9 #x5B9C)
- (#xB5BA #x622F)
- (#xB5BB #x6280)
- (#xB5BC #x64EC)
- (#xB5BD #x6B3A)
- (#xB5BE #x72A0)
- (#xB5BF #x7591)
- (#xB5C0 #x7947)
- (#xB5C1 #x7FA9)
- (#xB5C2 #x87FB)
- (#xB5C3 #x8ABC)
- (#xB5C4 #x8B70)
- (#xB5C5 #x63AC)
- (#xB5C6 #x83CA)
- (#xB5C7 #x97A0)
- (#xB5C8 #x5409)
- (#xB5C9 #x5403)
- (#xB5CA #x55AB)
- (#xB5CB #x6854)
- (#xB5CC #x6A58)
- (#xB5CD #x8A70)
- (#xB5CE #x7827)
- (#xB5CF #x6775)
- (#xB5D0 #x9ECD)
- (#xB5D1 #x5374)
- (#xB5D2 #x5BA2)
- (#xB5D3 #x811A)
- (#xB5D4 #x8650)
- (#xB5D5 #x9006)
- (#xB5D6 #x4E18)
- (#xB5D7 #x4E45)
- (#xB5D8 #x4EC7)
- (#xB5D9 #x4F11)
- (#xB5DA #x53CA)
- (#xB5DB #x5438)
- (#xB5DC #x5BAE)
- (#xB5DD #x5F13)
- (#xB5DE #x6025)
- (#xB5DF #x6551)
- (#xB5E0 #x673D)
- (#xB5E1 #x6C42)
- (#xB5E2 #x6C72)
- (#xB5E3 #x6CE3)
- (#xB5E4 #x7078)
- (#xB5E5 #x7403)
- (#xB5E6 #x7A76)
- (#xB5E7 #x7AAE)
- (#xB5E8 #x7B08)
- (#xB5E9 #x7D1A)
- (#xB5EA #x7CFE)
- (#xB5EB #x7D66)
- (#xB5EC #x65E7)
- (#xB5ED #x725B)
- (#xB5EE #x53BB)
- (#xB5EF #x5C45)
- (#xB5F0 #x5DE8)
- (#xB5F1 #x62D2)
- (#xB5F2 #x62E0)
- (#xB5F3 #x6319)
- (#xB5F4 #x6E20)
- (#xB5F5 #x865A)
- (#xB5F6 #x8A31)
- (#xB5F7 #x8DDD)
- (#xB5F8 #x92F8)
- (#xB5F9 #x6F01)
- (#xB5FA #x79A6)
- (#xB5FB #x9B5A)
- (#xB5FC #x4EA8)
- (#xB5FD #x4EAB)
- (#xB5FE #x4EAC)
- (#xB6A1 #x4F9B)
- (#xB6A2 #x4FA0)
- (#xB6A3 #x50D1)
- (#xB6A4 #x5147)
- (#xB6A5 #x7AF6)
- (#xB6A6 #x5171)
- (#xB6A7 #x51F6)
- (#xB6A8 #x5354)
- (#xB6A9 #x5321)
- (#xB6AA #x537F)
- (#xB6AB #x53EB)
- (#xB6AC #x55AC)
- (#xB6AD #x5883)
- (#xB6AE #x5CE1)
- (#xB6AF #x5F37)
- (#xB6B0 #x5F4A)
- (#xB6B1 #x602F)
- (#xB6B2 #x6050)
- (#xB6B3 #x606D)
- (#xB6B4 #x631F)
- (#xB6B5 #x6559)
- (#xB6B6 #x6A4B)
- (#xB6B7 #x6CC1)
- (#xB6B8 #x72C2)
- (#xB6B9 #x72ED)
- (#xB6BA #x77EF)
- (#xB6BB #x80F8)
- (#xB6BC #x8105)
- (#xB6BD #x8208)
- (#xB6BE #x854E)
- (#xB6BF #x90F7)
- (#xB6C0 #x93E1)
- (#xB6C1 #x97FF)
- (#xB6C2 #x9957)
- (#xB6C3 #x9A5A)
- (#xB6C4 #x4EF0)
- (#xB6C5 #x51DD)
- (#xB6C6 #x5C2D)
- (#xB6C7 #x6681)
- (#xB6C8 #x696D)
- (#xB6C9 #x5C40)
- (#xB6CA #x66F2)
- (#xB6CB #x6975)
- (#xB6CC #x7389)
- (#xB6CD #x6850)
- (#xB6CE #x7C81)
- (#xB6CF #x50C5)
- (#xB6D0 #x52E4)
- (#xB6D1 #x5747)
- (#xB6D2 #x5DFE)
- (#xB6D3 #x9326)
- (#xB6D4 #x65A4)
- (#xB6D5 #x6B23)
- (#xB6D6 #x6B3D)
- (#xB6D7 #x7434)
- (#xB6D8 #x7981)
- (#xB6D9 #x79BD)
- (#xB6DA #x7B4B)
- (#xB6DB #x7DCA)
- (#xB6DC #x82B9)
- (#xB6DD #x83CC)
- (#xB6DE #x887F)
- (#xB6DF #x895F)
- (#xB6E0 #x8B39)
- (#xB6E1 #x8FD1)
- (#xB6E2 #x91D1)
- (#xB6E3 #x541F)
- (#xB6E4 #x9280)
- (#xB6E5 #x4E5D)
- (#xB6E6 #x5036)
- (#xB6E7 #x53E5)
- (#xB6E8 #x533A)
- (#xB6E9 #x72D7)
- (#xB6EA #x7396)
- (#xB6EB #x77E9)
- (#xB6EC #x82E6)
- (#xB6ED #x8EAF)
- (#xB6EE #x99C6)
- (#xB6EF #x99C8)
- (#xB6F0 #x99D2)
- (#xB6F1 #x5177)
- (#xB6F2 #x611A)
- (#xB6F3 #x865E)
- (#xB6F4 #x55B0)
- (#xB6F5 #x7A7A)
- (#xB6F6 #x5076)
- (#xB6F7 #x5BD3)
- (#xB6F8 #x9047)
- (#xB6F9 #x9685)
- (#xB6FA #x4E32)
- (#xB6FB #x6ADB)
- (#xB6FC #x91E7)
- (#xB6FD #x5C51)
- (#xB6FE #x5C48)
- (#xB7A1 #x6398)
- (#xB7A2 #x7A9F)
- (#xB7A3 #x6C93)
- (#xB7A4 #x9774)
- (#xB7A5 #x8F61)
- (#xB7A6 #x7AAA)
- (#xB7A7 #x718A)
- (#xB7A8 #x9688)
- (#xB7A9 #x7C82)
- (#xB7AA #x6817)
- (#xB7AB #x7E70)
- (#xB7AC #x6851)
- (#xB7AD #x936C)
- (#xB7AE #x52F2)
- (#xB7AF #x541B)
- (#xB7B0 #x85AB)
- (#xB7B1 #x8A13)
- (#xB7B2 #x7FA4)
- (#xB7B3 #x8ECD)
- (#xB7B4 #x90E1)
- (#xB7B5 #x5366)
- (#xB7B6 #x8888)
- (#xB7B7 #x7941)
- (#xB7B8 #x4FC2)
- (#xB7B9 #x50BE)
- (#xB7BA #x5211)
- (#xB7BB #x5144)
- (#xB7BC #x5553)
- (#xB7BD #x572D)
- (#xB7BE #x73EA)
- (#xB7BF #x578B)
- (#xB7C0 #x5951)
- (#xB7C1 #x5F62)
- (#xB7C2 #x5F84)
- (#xB7C3 #x6075)
- (#xB7C4 #x6176)
- (#xB7C5 #x6167)
- (#xB7C6 #x61A9)
- (#xB7C7 #x63B2)
- (#xB7C8 #x643A)
- (#xB7C9 #x656C)
- (#xB7CA #x666F)
- (#xB7CB #x6842)
- (#xB7CC #x6E13)
- (#xB7CD #x7566)
- (#xB7CE #x7A3D)
- (#xB7CF #x7CFB)
- (#xB7D0 #x7D4C)
- (#xB7D1 #x7D99)
- (#xB7D2 #x7E4B)
- (#xB7D3 #x7F6B)
- (#xB7D4 #x830E)
- (#xB7D5 #x834A)
- (#xB7D6 #x86CD)
- (#xB7D7 #x8A08)
- (#xB7D8 #x8A63)
- (#xB7D9 #x8B66)
- (#xB7DA #x8EFD)
- (#xB7DB #x981A)
- (#xB7DC #x9D8F)
- (#xB7DD #x82B8)
- (#xB7DE #x8FCE)
- (#xB7DF #x9BE8)
- (#xB7E0 #x5287)
- (#xB7E1 #x621F)
- (#xB7E2 #x6483)
- (#xB7E3 #x6FC0)
- (#xB7E4 #x9699)
- (#xB7E5 #x6841)
- (#xB7E6 #x5091)
- (#xB7E7 #x6B20)
- (#xB7E8 #x6C7A)
- (#xB7E9 #x6F54)
- (#xB7EA #x7A74)
- (#xB7EB #x7D50)
- (#xB7EC #x8840)
- (#xB7ED #x8A23)
- (#xB7EE #x6708)
- (#xB7EF #x4EF6)
- (#xB7F0 #x5039)
- (#xB7F1 #x5026)
- (#xB7F2 #x5065)
- (#xB7F3 #x517C)
- (#xB7F4 #x5238)
- (#xB7F5 #x5263)
- (#xB7F6 #x55A7)
- (#xB7F7 #x570F)
- (#xB7F8 #x5805)
- (#xB7F9 #x5ACC)
- (#xB7FA #x5EFA)
- (#xB7FB #x61B2)
- (#xB7FC #x61F8)
- (#xB7FD #x62F3)
- (#xB7FE #x6372)
- (#xB8A1 #x691C)
- (#xB8A2 #x6A29)
- (#xB8A3 #x727D)
- (#xB8A4 #x72AC)
- (#xB8A5 #x732E)
- (#xB8A6 #x7814)
- (#xB8A7 #x786F)
- (#xB8A8 #x7D79)
- (#xB8A9 #x770C)
- (#xB8AA #x80A9)
- (#xB8AB #x898B)
- (#xB8AC #x8B19)
- (#xB8AD #x8CE2)
- (#xB8AE #x8ED2)
- (#xB8AF #x9063)
- (#xB8B0 #x9375)
- (#xB8B1 #x967A)
- (#xB8B2 #x9855)
- (#xB8B3 #x9A13)
- (#xB8B4 #x9E78)
- (#xB8B5 #x5143)
- (#xB8B6 #x539F)
- (#xB8B7 #x53B3)
- (#xB8B8 #x5E7B)
- (#xB8B9 #x5F26)
- (#xB8BA #x6E1B)
- (#xB8BB #x6E90)
- (#xB8BC #x7384)
- (#xB8BD #x73FE)
- (#xB8BE #x7D43)
- (#xB8BF #x8237)
- (#xB8C0 #x8A00)
- (#xB8C1 #x8AFA)
- (#xB8C2 #x9650)
- (#xB8C3 #x4E4E)
- (#xB8C4 #x500B)
- (#xB8C5 #x53E4)
- (#xB8C6 #x547C)
- (#xB8C7 #x56FA)
- (#xB8C8 #x59D1)
- (#xB8C9 #x5B64)
- (#xB8CA #x5DF1)
- (#xB8CB #x5EAB)
- (#xB8CC #x5F27)
- (#xB8CD #x6238)
- (#xB8CE #x6545)
- (#xB8CF #x67AF)
- (#xB8D0 #x6E56)
- (#xB8D1 #x72D0)
- (#xB8D2 #x7CCA)
- (#xB8D3 #x88B4)
- (#xB8D4 #x80A1)
- (#xB8D5 #x80E1)
- (#xB8D6 #x83F0)
- (#xB8D7 #x864E)
- (#xB8D8 #x8A87)
- (#xB8D9 #x8DE8)
- (#xB8DA #x9237)
- (#xB8DB #x96C7)
- (#xB8DC #x9867)
- (#xB8DD #x9F13)
- (#xB8DE #x4E94)
- (#xB8DF #x4E92)
- (#xB8E0 #x4F0D)
- (#xB8E1 #x5348)
- (#xB8E2 #x5449)
- (#xB8E3 #x543E)
- (#xB8E4 #x5A2F)
- (#xB8E5 #x5F8C)
- (#xB8E6 #x5FA1)
- (#xB8E7 #x609F)
- (#xB8E8 #x68A7)
- (#xB8E9 #x6A8E)
- (#xB8EA #x745A)
- (#xB8EB #x7881)
- (#xB8EC #x8A9E)
- (#xB8ED #x8AA4)
- (#xB8EE #x8B77)
- (#xB8EF #x9190)
- (#xB8F0 #x4E5E)
- (#xB8F1 #x9BC9)
- (#xB8F2 #x4EA4)
- (#xB8F3 #x4F7C)
- (#xB8F4 #x4FAF)
- (#xB8F5 #x5019)
- (#xB8F6 #x5016)
- (#xB8F7 #x5149)
- (#xB8F8 #x516C)
- (#xB8F9 #x529F)
- (#xB8FA #x52B9)
- (#xB8FB #x52FE)
- (#xB8FC #x539A)
- (#xB8FD #x53E3)
- (#xB8FE #x5411)
- (#xB9A1 #x540E)
- (#xB9A2 #x5589)
- (#xB9A3 #x5751)
- (#xB9A4 #x57A2)
- (#xB9A5 #x597D)
- (#xB9A6 #x5B54)
- (#xB9A7 #x5B5D)
- (#xB9A8 #x5B8F)
- (#xB9A9 #x5DE5)
- (#xB9AA #x5DE7)
- (#xB9AB #x5DF7)
- (#xB9AC #x5E78)
- (#xB9AD #x5E83)
- (#xB9AE #x5E9A)
- (#xB9AF #x5EB7)
- (#xB9B0 #x5F18)
- (#xB9B1 #x6052)
- (#xB9B2 #x614C)
- (#xB9B3 #x6297)
- (#xB9B4 #x62D8)
- (#xB9B5 #x63A7)
- (#xB9B6 #x653B)
- (#xB9B7 #x6602)
- (#xB9B8 #x6643)
- (#xB9B9 #x66F4)
- (#xB9BA #x676D)
- (#xB9BB #x6821)
- (#xB9BC #x6897)
- (#xB9BD #x69CB)
- (#xB9BE #x6C5F)
- (#xB9BF #x6D2A)
- (#xB9C0 #x6D69)
- (#xB9C1 #x6E2F)
- (#xB9C2 #x6E9D)
- (#xB9C3 #x7532)
- (#xB9C4 #x7687)
- (#xB9C5 #x786C)
- (#xB9C6 #x7A3F)
- (#xB9C7 #x7CE0)
- (#xB9C8 #x7D05)
- (#xB9C9 #x7D18)
- (#xB9CA #x7D5E)
- (#xB9CB #x7DB1)
- (#xB9CC #x8015)
- (#xB9CD #x8003)
- (#xB9CE #x80AF)
- (#xB9CF #x80B1)
- (#xB9D0 #x8154)
- (#xB9D1 #x818F)
- (#xB9D2 #x822A)
- (#xB9D3 #x8352)
- (#xB9D4 #x884C)
- (#xB9D5 #x8861)
- (#xB9D6 #x8B1B)
- (#xB9D7 #x8CA2)
- (#xB9D8 #x8CFC)
- (#xB9D9 #x90CA)
- (#xB9DA #x9175)
- (#xB9DB #x9271)
- (#xB9DC #x783F)
- (#xB9DD #x92FC)
- (#xB9DE #x95A4)
- (#xB9DF #x964D)
- (#xB9E0 #x9805)
- (#xB9E1 #x9999)
- (#xB9E2 #x9AD8)
- (#xB9E3 #x9D3B)
- (#xB9E4 #x525B)
- (#xB9E5 #x52AB)
- (#xB9E6 #x53F7)
- (#xB9E7 #x5408)
- (#xB9E8 #x58D5)
- (#xB9E9 #x62F7)
- (#xB9EA #x6FE0)
- (#xB9EB #x8C6A)
- (#xB9EC #x8F5F)
- (#xB9ED #x9EB9)
- (#xB9EE #x514B)
- (#xB9EF #x523B)
- (#xB9F0 #x544A)
- (#xB9F1 #x56FD)
- (#xB9F2 #x7A40)
- (#xB9F3 #x9177)
- (#xB9F4 #x9D60)
- (#xB9F5 #x9ED2)
- (#xB9F6 #x7344)
- (#xB9F7 #x6F09)
- (#xB9F8 #x8170)
- (#xB9F9 #x7511)
- (#xB9FA #x5FFD)
- (#xB9FB #x60DA)
- (#xB9FC #x9AA8)
- (#xB9FD #x72DB)
- (#xB9FE #x8FBC)
- (#xBAA1 #x6B64)
- (#xBAA2 #x9803)
- (#xBAA3 #x4ECA)
- (#xBAA4 #x56F0)
- (#xBAA5 #x5764)
- (#xBAA6 #x58BE)
- (#xBAA7 #x5A5A)
- (#xBAA8 #x6068)
- (#xBAA9 #x61C7)
- (#xBAAA #x660F)
- (#xBAAB #x6606)
- (#xBAAC #x6839)
- (#xBAAD #x68B1)
- (#xBAAE #x6DF7)
- (#xBAAF #x75D5)
- (#xBAB0 #x7D3A)
- (#xBAB1 #x826E)
- (#xBAB2 #x9B42)
- (#xBAB3 #x4E9B)
- (#xBAB4 #x4F50)
- (#xBAB5 #x53C9)
- (#xBAB6 #x5506)
- (#xBAB7 #x5D6F)
- (#xBAB8 #x5DE6)
- (#xBAB9 #x5DEE)
- (#xBABA #x67FB)
- (#xBABB #x6C99)
- (#xBABC #x7473)
- (#xBABD #x7802)
- (#xBABE #x8A50)
- (#xBABF #x9396)
- (#xBAC0 #x88DF)
- (#xBAC1 #x5750)
- (#xBAC2 #x5EA7)
- (#xBAC3 #x632B)
- (#xBAC4 #x50B5)
- (#xBAC5 #x50AC)
- (#xBAC6 #x518D)
- (#xBAC7 #x6700)
- (#xBAC8 #x54C9)
- (#xBAC9 #x585E)
- (#xBACA #x59BB)
- (#xBACB #x5BB0)
- (#xBACC #x5F69)
- (#xBACD #x624D)
- (#xBACE #x63A1)
- (#xBACF #x683D)
- (#xBAD0 #x6B73)
- (#xBAD1 #x6E08)
- (#xBAD2 #x707D)
- (#xBAD3 #x91C7)
- (#xBAD4 #x7280)
- (#xBAD5 #x7815)
- (#xBAD6 #x7826)
- (#xBAD7 #x796D)
- (#xBAD8 #x658E)
- (#xBAD9 #x7D30)
- (#xBADA #x83DC)
- (#xBADB #x88C1)
- (#xBADC #x8F09)
- (#xBADD #x969B)
- (#xBADE #x5264)
- (#xBADF #x5728)
- (#xBAE0 #x6750)
- (#xBAE1 #x7F6A)
- (#xBAE2 #x8CA1)
- (#xBAE3 #x51B4)
- (#xBAE4 #x5742)
- (#xBAE5 #x962A)
- (#xBAE6 #x583A)
- (#xBAE7 #x698A)
- (#xBAE8 #x80B4)
- (#xBAE9 #x54B2)
- (#xBAEA #x5D0E)
- (#xBAEB #x57FC)
- (#xBAEC #x7895)
- (#xBAED #x9DFA)
- (#xBAEE #x4F5C)
- (#xBAEF #x524A)
- (#xBAF0 #x548B)
- (#xBAF1 #x643E)
- (#xBAF2 #x6628)
- (#xBAF3 #x6714)
- (#xBAF4 #x67F5)
- (#xBAF5 #x7A84)
- (#xBAF6 #x7B56)
- (#xBAF7 #x7D22)
- (#xBAF8 #x932F)
- (#xBAF9 #x685C)
- (#xBAFA #x9BAD)
- (#xBAFB #x7B39)
- (#xBAFC #x5319)
- (#xBAFD #x518A)
- (#xBAFE #x5237)
- (#xBBA1 #x5BDF)
- (#xBBA2 #x62F6)
- (#xBBA3 #x64AE)
- (#xBBA4 #x64E6)
- (#xBBA5 #x672D)
- (#xBBA6 #x6BBA)
- (#xBBA7 #x85A9)
- (#xBBA8 #x96D1)
- (#xBBA9 #x7690)
- (#xBBAA #x9BD6)
- (#xBBAB #x634C)
- (#xBBAC #x9306)
- (#xBBAD #x9BAB)
- (#xBBAE #x76BF)
- (#xBBAF #x6652)
- (#xBBB0 #x4E09)
- (#xBBB1 #x5098)
- (#xBBB2 #x53C2)
- (#xBBB3 #x5C71)
- (#xBBB4 #x60E8)
- (#xBBB5 #x6492)
- (#xBBB6 #x6563)
- (#xBBB7 #x685F)
- (#xBBB8 #x71E6)
- (#xBBB9 #x73CA)
- (#xBBBA #x7523)
- (#xBBBB #x7B97)
- (#xBBBC #x7E82)
- (#xBBBD #x8695)
- (#xBBBE #x8B83)
- (#xBBBF #x8CDB)
- (#xBBC0 #x9178)
- (#xBBC1 #x9910)
- (#xBBC2 #x65AC)
- (#xBBC3 #x66AB)
- (#xBBC4 #x6B8B)
- (#xBBC5 #x4ED5)
- (#xBBC6 #x4ED4)
- (#xBBC7 #x4F3A)
- (#xBBC8 #x4F7F)
- (#xBBC9 #x523A)
- (#xBBCA #x53F8)
- (#xBBCB #x53F2)
- (#xBBCC #x55E3)
- (#xBBCD #x56DB)
- (#xBBCE #x58EB)
- (#xBBCF #x59CB)
- (#xBBD0 #x59C9)
- (#xBBD1 #x59FF)
- (#xBBD2 #x5B50)
- (#xBBD3 #x5C4D)
- (#xBBD4 #x5E02)
- (#xBBD5 #x5E2B)
- (#xBBD6 #x5FD7)
- (#xBBD7 #x601D)
- (#xBBD8 #x6307)
- (#xBBD9 #x652F)
- (#xBBDA #x5B5C)
- (#xBBDB #x65AF)
- (#xBBDC #x65BD)
- (#xBBDD #x65E8)
- (#xBBDE #x679D)
- (#xBBDF #x6B62)
- (#xBBE0 #x6B7B)
- (#xBBE1 #x6C0F)
- (#xBBE2 #x7345)
- (#xBBE3 #x7949)
- (#xBBE4 #x79C1)
- (#xBBE5 #x7CF8)
- (#xBBE6 #x7D19)
- (#xBBE7 #x7D2B)
- (#xBBE8 #x80A2)
- (#xBBE9 #x8102)
- (#xBBEA #x81F3)
- (#xBBEB #x8996)
- (#xBBEC #x8A5E)
- (#xBBED #x8A69)
- (#xBBEE #x8A66)
- (#xBBEF #x8A8C)
- (#xBBF0 #x8AEE)
- (#xBBF1 #x8CC7)
- (#xBBF2 #x8CDC)
- (#xBBF3 #x96CC)
- (#xBBF4 #x98FC)
- (#xBBF5 #x6B6F)
- (#xBBF6 #x4E8B)
- (#xBBF7 #x4F3C)
- (#xBBF8 #x4F8D)
- (#xBBF9 #x5150)
- (#xBBFA #x5B57)
- (#xBBFB #x5BFA)
- (#xBBFC #x6148)
- (#xBBFD #x6301)
- (#xBBFE #x6642)
- (#xBCA1 #x6B21)
- (#xBCA2 #x6ECB)
- (#xBCA3 #x6CBB)
- (#xBCA4 #x723E)
- (#xBCA5 #x74BD)
- (#xBCA6 #x75D4)
- (#xBCA7 #x78C1)
- (#xBCA8 #x793A)
- (#xBCA9 #x800C)
- (#xBCAA #x8033)
- (#xBCAB #x81EA)
- (#xBCAC #x8494)
- (#xBCAD #x8F9E)
- (#xBCAE #x6C50)
- (#xBCAF #x9E7F)
- (#xBCB0 #x5F0F)
- (#xBCB1 #x8B58)
- (#xBCB2 #x9D2B)
- (#xBCB3 #x7AFA)
- (#xBCB4 #x8EF8)
- (#xBCB5 #x5B8D)
- (#xBCB6 #x96EB)
- (#xBCB7 #x4E03)
- (#xBCB8 #x53F1)
- (#xBCB9 #x57F7)
- (#xBCBA #x5931)
- (#xBCBB #x5AC9)
- (#xBCBC #x5BA4)
- (#xBCBD #x6089)
- (#xBCBE #x6E7F)
- (#xBCBF #x6F06)
- (#xBCC0 #x75BE)
- (#xBCC1 #x8CEA)
- (#xBCC2 #x5B9F)
- (#xBCC3 #x8500)
- (#xBCC4 #x7BE0)
- (#xBCC5 #x5072)
- (#xBCC6 #x67F4)
- (#xBCC7 #x829D)
- (#xBCC8 #x5C61)
- (#xBCC9 #x854A)
- (#xBCCA #x7E1E)
- (#xBCCB #x820E)
- (#xBCCC #x5199)
- (#xBCCD #x5C04)
- (#xBCCE #x6368)
- (#xBCCF #x8D66)
- (#xBCD0 #x659C)
- (#xBCD1 #x716E)
- (#xBCD2 #x793E)
- (#xBCD3 #x7D17)
- (#xBCD4 #x8005)
- (#xBCD5 #x8B1D)
- (#xBCD6 #x8ECA)
- (#xBCD7 #x906E)
- (#xBCD8 #x86C7)
- (#xBCD9 #x90AA)
- (#xBCDA #x501F)
- (#xBCDB #x52FA)
- (#xBCDC #x5C3A)
- (#xBCDD #x6753)
- (#xBCDE #x707C)
- (#xBCDF #x7235)
- (#xBCE0 #x914C)
- (#xBCE1 #x91C8)
- (#xBCE2 #x932B)
- (#xBCE3 #x82E5)
- (#xBCE4 #x5BC2)
- (#xBCE5 #x5F31)
- (#xBCE6 #x60F9)
- (#xBCE7 #x4E3B)
- (#xBCE8 #x53D6)
- (#xBCE9 #x5B88)
- (#xBCEA #x624B)
- (#xBCEB #x6731)
- (#xBCEC #x6B8A)
- (#xBCED #x72E9)
- (#xBCEE #x73E0)
- (#xBCEF #x7A2E)
- (#xBCF0 #x816B)
- (#xBCF1 #x8DA3)
- (#xBCF2 #x9152)
- (#xBCF3 #x9996)
- (#xBCF4 #x5112)
- (#xBCF5 #x53D7)
- (#xBCF6 #x546A)
- (#xBCF7 #x5BFF)
- (#xBCF8 #x6388)
- (#xBCF9 #x6A39)
- (#xBCFA #x7DAC)
- (#xBCFB #x9700)
- (#xBCFC #x56DA)
- (#xBCFD #x53CE)
- (#xBCFE #x5468)
- (#xBDA1 #x5B97)
- (#xBDA2 #x5C31)
- (#xBDA3 #x5DDE)
- (#xBDA4 #x4FEE)
- (#xBDA5 #x6101)
- (#xBDA6 #x62FE)
- (#xBDA7 #x6D32)
- (#xBDA8 #x79C0)
- (#xBDA9 #x79CB)
- (#xBDAA #x7D42)
- (#xBDAB #x7E4D)
- (#xBDAC #x7FD2)
- (#xBDAD #x81ED)
- (#xBDAE #x821F)
- (#xBDAF #x8490)
- (#xBDB0 #x8846)
- (#xBDB1 #x8972)
- (#xBDB2 #x8B90)
- (#xBDB3 #x8E74)
- (#xBDB4 #x8F2F)
- (#xBDB5 #x9031)
- (#xBDB6 #x914B)
- (#xBDB7 #x916C)
- (#xBDB8 #x96C6)
- (#xBDB9 #x919C)
- (#xBDBA #x4EC0)
- (#xBDBB #x4F4F)
- (#xBDBC #x5145)
- (#xBDBD #x5341)
- (#xBDBE #x5F93)
- (#xBDBF #x620E)
- (#xBDC0 #x67D4)
- (#xBDC1 #x6C41)
- (#xBDC2 #x6E0B)
- (#xBDC3 #x7363)
- (#xBDC4 #x7E26)
- (#xBDC5 #x91CD)
- (#xBDC6 #x9283)
- (#xBDC7 #x53D4)
- (#xBDC8 #x5919)
- (#xBDC9 #x5BBF)
- (#xBDCA #x6DD1)
- (#xBDCB #x795D)
- (#xBDCC #x7E2E)
- (#xBDCD #x7C9B)
- (#xBDCE #x587E)
- (#xBDCF #x719F)
- (#xBDD0 #x51FA)
- (#xBDD1 #x8853)
- (#xBDD2 #x8FF0)
- (#xBDD3 #x4FCA)
- (#xBDD4 #x5CFB)
- (#xBDD5 #x6625)
- (#xBDD6 #x77AC)
- (#xBDD7 #x7AE3)
- (#xBDD8 #x821C)
- (#xBDD9 #x99FF)
- (#xBDDA #x51C6)
- (#xBDDB #x5FAA)
- (#xBDDC #x65EC)
- (#xBDDD #x696F)
- (#xBDDE #x6B89)
- (#xBDDF #x6DF3)
- (#xBDE0 #x6E96)
- (#xBDE1 #x6F64)
- (#xBDE2 #x76FE)
- (#xBDE3 #x7D14)
- (#xBDE4 #x5DE1)
- (#xBDE5 #x9075)
- (#xBDE6 #x9187)
- (#xBDE7 #x9806)
- (#xBDE8 #x51E6)
- (#xBDE9 #x521D)
- (#xBDEA #x6240)
- (#xBDEB #x6691)
- (#xBDEC #x66D9)
- (#xBDED #x6E1A)
- (#xBDEE #x5EB6)
- (#xBDEF #x7DD2)
- (#xBDF0 #x7F72)
- (#xBDF1 #x66F8)
- (#xBDF2 #x85AF)
- (#xBDF3 #x85F7)
- (#xBDF4 #x8AF8)
- (#xBDF5 #x52A9)
- (#xBDF6 #x53D9)
- (#xBDF7 #x5973)
- (#xBDF8 #x5E8F)
- (#xBDF9 #x5F90)
- (#xBDFA #x6055)
- (#xBDFB #x92E4)
- (#xBDFC #x9664)
- (#xBDFD #x50B7)
- (#xBDFE #x511F)
- (#xBEA1 #x52DD)
- (#xBEA2 #x5320)
- (#xBEA3 #x5347)
- (#xBEA4 #x53EC)
- (#xBEA5 #x54E8)
- (#xBEA6 #x5546)
- (#xBEA7 #x5531)
- (#xBEA8 #x5617)
- (#xBEA9 #x5968)
- (#xBEAA #x59BE)
- (#xBEAB #x5A3C)
- (#xBEAC #x5BB5)
- (#xBEAD #x5C06)
- (#xBEAE #x5C0F)
- (#xBEAF #x5C11)
- (#xBEB0 #x5C1A)
- (#xBEB1 #x5E84)
- (#xBEB2 #x5E8A)
- (#xBEB3 #x5EE0)
- (#xBEB4 #x5F70)
- (#xBEB5 #x627F)
- (#xBEB6 #x6284)
- (#xBEB7 #x62DB)
- (#xBEB8 #x638C)
- (#xBEB9 #x6377)
- (#xBEBA #x6607)
- (#xBEBB #x660C)
- (#xBEBC #x662D)
- (#xBEBD #x6676)
- (#xBEBE #x677E)
- (#xBEBF #x68A2)
- (#xBEC0 #x6A1F)
- (#xBEC1 #x6A35)
- (#xBEC2 #x6CBC)
- (#xBEC3 #x6D88)
- (#xBEC4 #x6E09)
- (#xBEC5 #x6E58)
- (#xBEC6 #x713C)
- (#xBEC7 #x7126)
- (#xBEC8 #x7167)
- (#xBEC9 #x75C7)
- (#xBECA #x7701)
- (#xBECB #x785D)
- (#xBECC #x7901)
- (#xBECD #x7965)
- (#xBECE #x79F0)
- (#xBECF #x7AE0)
- (#xBED0 #x7B11)
- (#xBED1 #x7CA7)
- (#xBED2 #x7D39)
- (#xBED3 #x8096)
- (#xBED4 #x83D6)
- (#xBED5 #x848B)
- (#xBED6 #x8549)
- (#xBED7 #x885D)
- (#xBED8 #x88F3)
- (#xBED9 #x8A1F)
- (#xBEDA #x8A3C)
- (#xBEDB #x8A54)
- (#xBEDC #x8A73)
- (#xBEDD #x8C61)
- (#xBEDE #x8CDE)
- (#xBEDF #x91A4)
- (#xBEE0 #x9266)
- (#xBEE1 #x937E)
- (#xBEE2 #x9418)
- (#xBEE3 #x969C)
- (#xBEE4 #x9798)
- (#xBEE5 #x4E0A)
- (#xBEE6 #x4E08)
- (#xBEE7 #x4E1E)
- (#xBEE8 #x4E57)
- (#xBEE9 #x5197)
- (#xBEEA #x5270)
- (#xBEEB #x57CE)
- (#xBEEC #x5834)
- (#xBEED #x58CC)
- (#xBEEE #x5B22)
- (#xBEEF #x5E38)
- (#xBEF0 #x60C5)
- (#xBEF1 #x64FE)
- (#xBEF2 #x6761)
- (#xBEF3 #x6756)
- (#xBEF4 #x6D44)
- (#xBEF5 #x72B6)
- (#xBEF6 #x7573)
- (#xBEF7 #x7A63)
- (#xBEF8 #x84B8)
- (#xBEF9 #x8B72)
- (#xBEFA #x91B8)
- (#xBEFB #x9320)
- (#xBEFC #x5631)
- (#xBEFD #x57F4)
- (#xBEFE #x98FE)
- (#xBFA1 #x62ED)
- (#xBFA2 #x690D)
- (#xBFA3 #x6B96)
- (#xBFA4 #x71ED)
- (#xBFA5 #x7E54)
- (#xBFA6 #x8077)
- (#xBFA7 #x8272)
- (#xBFA8 #x89E6)
- (#xBFA9 #x98DF)
- (#xBFAA #x8755)
- (#xBFAB #x8FB1)
- (#xBFAC #x5C3B)
- (#xBFAD #x4F38)
- (#xBFAE #x4FE1)
- (#xBFAF #x4FB5)
- (#xBFB0 #x5507)
- (#xBFB1 #x5A20)
- (#xBFB2 #x5BDD)
- (#xBFB3 #x5BE9)
- (#xBFB4 #x5FC3)
- (#xBFB5 #x614E)
- (#xBFB6 #x632F)
- (#xBFB7 #x65B0)
- (#xBFB8 #x664B)
- (#xBFB9 #x68EE)
- (#xBFBA #x699B)
- (#xBFBB #x6D78)
- (#xBFBC #x6DF1)
- (#xBFBD #x7533)
- (#xBFBE #x75B9)
- (#xBFBF #x771F)
- (#xBFC0 #x795E)
- (#xBFC1 #x79E6)
- (#xBFC2 #x7D33)
- (#xBFC3 #x81E3)
- (#xBFC4 #x82AF)
- (#xBFC5 #x85AA)
- (#xBFC6 #x89AA)
- (#xBFC7 #x8A3A)
- (#xBFC8 #x8EAB)
- (#xBFC9 #x8F9B)
- (#xBFCA #x9032)
- (#xBFCB #x91DD)
- (#xBFCC #x9707)
- (#xBFCD #x4EBA)
- (#xBFCE #x4EC1)
- (#xBFCF #x5203)
- (#xBFD0 #x5875)
- (#xBFD1 #x58EC)
- (#xBFD2 #x5C0B)
- (#xBFD3 #x751A)
- (#xBFD4 #x5C3D)
- (#xBFD5 #x814E)
- (#xBFD6 #x8A0A)
- (#xBFD7 #x8FC5)
- (#xBFD8 #x9663)
- (#xBFD9 #x976D)
- (#xBFDA #x7B25)
- (#xBFDB #x8ACF)
- (#xBFDC #x9808)
- (#xBFDD #x9162)
- (#xBFDE #x56F3)
- (#xBFDF #x53A8)
- (#xBFE0 #x9017)
- (#xBFE1 #x5439)
- (#xBFE2 #x5782)
- (#xBFE3 #x5E25)
- (#xBFE4 #x63A8)
- (#xBFE5 #x6C34)
- (#xBFE6 #x708A)
- (#xBFE7 #x7761)
- (#xBFE8 #x7C8B)
- (#xBFE9 #x7FE0)
- (#xBFEA #x8870)
- (#xBFEB #x9042)
- (#xBFEC #x9154)
- (#xBFED #x9310)
- (#xBFEE #x9318)
- (#xBFEF #x968F)
- (#xBFF0 #x745E)
- (#xBFF1 #x9AC4)
- (#xBFF2 #x5D07)
- (#xBFF3 #x5D69)
- (#xBFF4 #x6570)
- (#xBFF5 #x67A2)
- (#xBFF6 #x8DA8)
- (#xBFF7 #x96DB)
- (#xBFF8 #x636E)
- (#xBFF9 #x6749)
- (#xBFFA #x6919)
- (#xBFFB #x83C5)
- (#xBFFC #x9817)
- (#xBFFD #x96C0)
- (#xBFFE #x88FE)
- (#xC0A1 #x6F84)
- (#xC0A2 #x647A)
- (#xC0A3 #x5BF8)
- (#xC0A4 #x4E16)
- (#xC0A5 #x702C)
- (#xC0A6 #x755D)
- (#xC0A7 #x662F)
- (#xC0A8 #x51C4)
- (#xC0A9 #x5236)
- (#xC0AA #x52E2)
- (#xC0AB #x59D3)
- (#xC0AC #x5F81)
- (#xC0AD #x6027)
- (#xC0AE #x6210)
- (#xC0AF #x653F)
- (#xC0B0 #x6574)
- (#xC0B1 #x661F)
- (#xC0B2 #x6674)
- (#xC0B3 #x68F2)
- (#xC0B4 #x6816)
- (#xC0B5 #x6B63)
- (#xC0B6 #x6E05)
- (#xC0B7 #x7272)
- (#xC0B8 #x751F)
- (#xC0B9 #x76DB)
- (#xC0BA #x7CBE)
- (#xC0BB #x8056)
- (#xC0BC #x58F0)
- (#xC0BD #x88FD)
- (#xC0BE #x897F)
- (#xC0BF #x8AA0)
- (#xC0C0 #x8A93)
- (#xC0C1 #x8ACB)
- (#xC0C2 #x901D)
- (#xC0C3 #x9192)
- (#xC0C4 #x9752)
- (#xC0C5 #x9759)
- (#xC0C6 #x6589)
- (#xC0C7 #x7A0E)
- (#xC0C8 #x8106)
- (#xC0C9 #x96BB)
- (#xC0CA #x5E2D)
- (#xC0CB #x60DC)
- (#xC0CC #x621A)
- (#xC0CD #x65A5)
- (#xC0CE #x6614)
- (#xC0CF #x6790)
- (#xC0D0 #x77F3)
- (#xC0D1 #x7A4D)
- (#xC0D2 #x7C4D)
- (#xC0D3 #x7E3E)
- (#xC0D4 #x810A)
- (#xC0D5 #x8CAC)
- (#xC0D6 #x8D64)
- (#xC0D7 #x8DE1)
- (#xC0D8 #x8E5F)
- (#xC0D9 #x78A9)
- (#xC0DA #x5207)
- (#xC0DB #x62D9)
- (#xC0DC #x63A5)
- (#xC0DD #x6442)
- (#xC0DE #x6298)
- (#xC0DF #x8A2D)
- (#xC0E0 #x7A83)
- (#xC0E1 #x7BC0)
- (#xC0E2 #x8AAC)
- (#xC0E3 #x96EA)
- (#xC0E4 #x7D76)
- (#xC0E5 #x820C)
- (#xC0E6 #x8749)
- (#xC0E7 #x4ED9)
- (#xC0E8 #x5148)
- (#xC0E9 #x5343)
- (#xC0EA #x5360)
- (#xC0EB #x5BA3)
- (#xC0EC #x5C02)
- (#xC0ED #x5C16)
- (#xC0EE #x5DDD)
- (#xC0EF #x6226)
- (#xC0F0 #x6247)
- (#xC0F1 #x64B0)
- (#xC0F2 #x6813)
- (#xC0F3 #x6834)
- (#xC0F4 #x6CC9)
- (#xC0F5 #x6D45)
- (#xC0F6 #x6D17)
- (#xC0F7 #x67D3)
- (#xC0F8 #x6F5C)
- (#xC0F9 #x714E)
- (#xC0FA #x717D)
- (#xC0FB #x65CB)
- (#xC0FC #x7A7F)
- (#xC0FD #x7BAD)
- (#xC0FE #x7DDA)
- (#xC1A1 #x7E4A)
- (#xC1A2 #x7FA8)
- (#xC1A3 #x817A)
- (#xC1A4 #x821B)
- (#xC1A5 #x8239)
- (#xC1A6 #x85A6)
- (#xC1A7 #x8A6E)
- (#xC1A8 #x8CCE)
- (#xC1A9 #x8DF5)
- (#xC1AA #x9078)
- (#xC1AB #x9077)
- (#xC1AC #x92AD)
- (#xC1AD #x9291)
- (#xC1AE #x9583)
- (#xC1AF #x9BAE)
- (#xC1B0 #x524D)
- (#xC1B1 #x5584)
- (#xC1B2 #x6F38)
- (#xC1B3 #x7136)
- (#xC1B4 #x5168)
- (#xC1B5 #x7985)
- (#xC1B6 #x7E55)
- (#xC1B7 #x81B3)
- (#xC1B8 #x7CCE)
- (#xC1B9 #x564C)
- (#xC1BA #x5851)
- (#xC1BB #x5CA8)
- (#xC1BC #x63AA)
- (#xC1BD #x66FE)
- (#xC1BE #x66FD)
- (#xC1BF #x695A)
- (#xC1C0 #x72D9)
- (#xC1C1 #x758F)
- (#xC1C2 #x758E)
- (#xC1C3 #x790E)
- (#xC1C4 #x7956)
- (#xC1C5 #x79DF)
- (#xC1C6 #x7C97)
- (#xC1C7 #x7D20)
- (#xC1C8 #x7D44)
- (#xC1C9 #x8607)
- (#xC1CA #x8A34)
- (#xC1CB #x963B)
- (#xC1CC #x9061)
- (#xC1CD #x9F20)
- (#xC1CE #x50E7)
- (#xC1CF #x5275)
- (#xC1D0 #x53CC)
- (#xC1D1 #x53E2)
- (#xC1D2 #x5009)
- (#xC1D3 #x55AA)
- (#xC1D4 #x58EE)
- (#xC1D5 #x594F)
- (#xC1D6 #x723D)
- (#xC1D7 #x5B8B)
- (#xC1D8 #x5C64)
- (#xC1D9 #x531D)
- (#xC1DA #x60E3)
- (#xC1DB #x60F3)
- (#xC1DC #x635C)
- (#xC1DD #x6383)
- (#xC1DE #x633F)
- (#xC1DF #x63BB)
- (#xC1E0 #x64CD)
- (#xC1E1 #x65E9)
- (#xC1E2 #x66F9)
- (#xC1E3 #x5DE3)
- (#xC1E4 #x69CD)
- (#xC1E5 #x69FD)
- (#xC1E6 #x6F15)
- (#xC1E7 #x71E5)
- (#xC1E8 #x4E89)
- (#xC1E9 #x75E9)
- (#xC1EA #x76F8)
- (#xC1EB #x7A93)
- (#xC1EC #x7CDF)
- (#xC1ED #x7DCF)
- (#xC1EE #x7D9C)
- (#xC1EF #x8061)
- (#xC1F0 #x8349)
- (#xC1F1 #x8358)
- (#xC1F2 #x846C)
- (#xC1F3 #x84BC)
- (#xC1F4 #x85FB)
- (#xC1F5 #x88C5)
- (#xC1F6 #x8D70)
- (#xC1F7 #x9001)
- (#xC1F8 #x906D)
- (#xC1F9 #x9397)
- (#xC1FA #x971C)
- (#xC1FB #x9A12)
- (#xC1FC #x50CF)
- (#xC1FD #x5897)
- (#xC1FE #x618E)
- (#xC2A1 #x81D3)
- (#xC2A2 #x8535)
- (#xC2A3 #x8D08)
- (#xC2A4 #x9020)
- (#xC2A5 #x4FC3)
- (#xC2A6 #x5074)
- (#xC2A7 #x5247)
- (#xC2A8 #x5373)
- (#xC2A9 #x606F)
- (#xC2AA #x6349)
- (#xC2AB #x675F)
- (#xC2AC #x6E2C)
- (#xC2AD #x8DB3)
- (#xC2AE #x901F)
- (#xC2AF #x4FD7)
- (#xC2B0 #x5C5E)
- (#xC2B1 #x8CCA)
- (#xC2B2 #x65CF)
- (#xC2B3 #x7D9A)
- (#xC2B4 #x5352)
- (#xC2B5 #x8896)
- (#xC2B6 #x5176)
- (#xC2B7 #x63C3)
- (#xC2B8 #x5B58)
- (#xC2B9 #x5B6B)
- (#xC2BA #x5C0A)
- (#xC2BB #x640D)
- (#xC2BC #x6751)
- (#xC2BD #x905C)
- (#xC2BE #x4ED6)
- (#xC2BF #x591A)
- (#xC2C0 #x592A)
- (#xC2C1 #x6C70)
- (#xC2C2 #x8A51)
- (#xC2C3 #x553E)
- (#xC2C4 #x5815)
- (#xC2C5 #x59A5)
- (#xC2C6 #x60F0)
- (#xC2C7 #x6253)
- (#xC2C8 #x67C1)
- (#xC2C9 #x8235)
- (#xC2CA #x6955)
- (#xC2CB #x9640)
- (#xC2CC #x99C4)
- (#xC2CD #x9A28)
- (#xC2CE #x4F53)
- (#xC2CF #x5806)
- (#xC2D0 #x5BFE)
- (#xC2D1 #x8010)
- (#xC2D2 #x5CB1)
- (#xC2D3 #x5E2F)
- (#xC2D4 #x5F85)
- (#xC2D5 #x6020)
- (#xC2D6 #x614B)
- (#xC2D7 #x6234)
- (#xC2D8 #x66FF)
- (#xC2D9 #x6CF0)
- (#xC2DA #x6EDE)
- (#xC2DB #x80CE)
- (#xC2DC #x817F)
- (#xC2DD #x82D4)
- (#xC2DE #x888B)
- (#xC2DF #x8CB8)
- (#xC2E0 #x9000)
- (#xC2E1 #x902E)
- (#xC2E2 #x968A)
- (#xC2E3 #x9EDB)
- (#xC2E4 #x9BDB)
- (#xC2E5 #x4EE3)
- (#xC2E6 #x53F0)
- (#xC2E7 #x5927)
- (#xC2E8 #x7B2C)
- (#xC2E9 #x918D)
- (#xC2EA #x984C)
- (#xC2EB #x9DF9)
- (#xC2EC #x6EDD)
- (#xC2ED #x7027)
- (#xC2EE #x5353)
- (#xC2EF #x5544)
- (#xC2F0 #x5B85)
- (#xC2F1 #x6258)
- (#xC2F2 #x629E)
- (#xC2F3 #x62D3)
- (#xC2F4 #x6CA2)
- (#xC2F5 #x6FEF)
- (#xC2F6 #x7422)
- (#xC2F7 #x8A17)
- (#xC2F8 #x9438)
- (#xC2F9 #x6FC1)
- (#xC2FA #x8AFE)
- (#xC2FB #x8338)
- (#xC2FC #x51E7)
- (#xC2FD #x86F8)
- (#xC2FE #x53EA)
- (#xC3A1 #x53E9)
- (#xC3A2 #x4F46)
- (#xC3A3 #x9054)
- (#xC3A4 #x8FB0)
- (#xC3A5 #x596A)
- (#xC3A6 #x8131)
- (#xC3A7 #x5DFD)
- (#xC3A8 #x7AEA)
- (#xC3A9 #x8FBF)
- (#xC3AA #x68DA)
- (#xC3AB #x8C37)
- (#xC3AC #x72F8)
- (#xC3AD #x9C48)
- (#xC3AE #x6A3D)
- (#xC3AF #x8AB0)
- (#xC3B0 #x4E39)
- (#xC3B1 #x5358)
- (#xC3B2 #x5606)
- (#xC3B3 #x5766)
- (#xC3B4 #x62C5)
- (#xC3B5 #x63A2)
- (#xC3B6 #x65E6)
- (#xC3B7 #x6B4E)
- (#xC3B8 #x6DE1)
- (#xC3B9 #x6E5B)
- (#xC3BA #x70AD)
- (#xC3BB #x77ED)
- (#xC3BC #x7AEF)
- (#xC3BD #x7BAA)
- (#xC3BE #x7DBB)
- (#xC3BF #x803D)
- (#xC3C0 #x80C6)
- (#xC3C1 #x86CB)
- (#xC3C2 #x8A95)
- (#xC3C3 #x935B)
- (#xC3C4 #x56E3)
- (#xC3C5 #x58C7)
- (#xC3C6 #x5F3E)
- (#xC3C7 #x65AD)
- (#xC3C8 #x6696)
- (#xC3C9 #x6A80)
- (#xC3CA #x6BB5)
- (#xC3CB #x7537)
- (#xC3CC #x8AC7)
- (#xC3CD #x5024)
- (#xC3CE #x77E5)
- (#xC3CF #x5730)
- (#xC3D0 #x5F1B)
- (#xC3D1 #x6065)
- (#xC3D2 #x667A)
- (#xC3D3 #x6C60)
- (#xC3D4 #x75F4)
- (#xC3D5 #x7A1A)
- (#xC3D6 #x7F6E)
- (#xC3D7 #x81F4)
- (#xC3D8 #x8718)
- (#xC3D9 #x9045)
- (#xC3DA #x99B3)
- (#xC3DB #x7BC9)
- (#xC3DC #x755C)
- (#xC3DD #x7AF9)
- (#xC3DE #x7B51)
- (#xC3DF #x84C4)
- (#xC3E0 #x9010)
- (#xC3E1 #x79E9)
- (#xC3E2 #x7A92)
- (#xC3E3 #x8336)
- (#xC3E4 #x5AE1)
- (#xC3E5 #x7740)
- (#xC3E6 #x4E2D)
- (#xC3E7 #x4EF2)
- (#xC3E8 #x5B99)
- (#xC3E9 #x5FE0)
- (#xC3EA #x62BD)
- (#xC3EB #x663C)
- (#xC3EC #x67F1)
- (#xC3ED #x6CE8)
- (#xC3EE #x866B)
- (#xC3EF #x8877)
- (#xC3F0 #x8A3B)
- (#xC3F1 #x914E)
- (#xC3F2 #x92F3)
- (#xC3F3 #x99D0)
- (#xC3F4 #x6A17)
- (#xC3F5 #x7026)
- (#xC3F6 #x732A)
- (#xC3F7 #x82E7)
- (#xC3F8 #x8457)
- (#xC3F9 #x8CAF)
- (#xC3FA #x4E01)
- (#xC3FB #x5146)
- (#xC3FC #x51CB)
- (#xC3FD #x558B)
- (#xC3FE #x5BF5)
- (#xC4A1 #x5E16)
- (#xC4A2 #x5E33)
- (#xC4A3 #x5E81)
- (#xC4A4 #x5F14)
- (#xC4A5 #x5F35)
- (#xC4A6 #x5F6B)
- (#xC4A7 #x5FB4)
- (#xC4A8 #x61F2)
- (#xC4A9 #x6311)
- (#xC4AA #x66A2)
- (#xC4AB #x671D)
- (#xC4AC #x6F6E)
- (#xC4AD #x7252)
- (#xC4AE #x753A)
- (#xC4AF #x773A)
- (#xC4B0 #x8074)
- (#xC4B1 #x8139)
- (#xC4B2 #x8178)
- (#xC4B3 #x8776)
- (#xC4B4 #x8ABF)
- (#xC4B5 #x8ADC)
- (#xC4B6 #x8D85)
- (#xC4B7 #x8DF3)
- (#xC4B8 #x929A)
- (#xC4B9 #x9577)
- (#xC4BA #x9802)
- (#xC4BB #x9CE5)
- (#xC4BC #x52C5)
- (#xC4BD #x6357)
- (#xC4BE #x76F4)
- (#xC4BF #x6715)
- (#xC4C0 #x6C88)
- (#xC4C1 #x73CD)
- (#xC4C2 #x8CC3)
- (#xC4C3 #x93AE)
- (#xC4C4 #x9673)
- (#xC4C5 #x6D25)
- (#xC4C6 #x589C)
- (#xC4C7 #x690E)
- (#xC4C8 #x69CC)
- (#xC4C9 #x8FFD)
- (#xC4CA #x939A)
- (#xC4CB #x75DB)
- (#xC4CC #x901A)
- (#xC4CD #x585A)
- (#xC4CE #x6802)
- (#xC4CF #x63B4)
- (#xC4D0 #x69FB)
- (#xC4D1 #x4F43)
- (#xC4D2 #x6F2C)
- (#xC4D3 #x67D8)
- (#xC4D4 #x8FBB)
- (#xC4D5 #x8526)
- (#xC4D6 #x7DB4)
- (#xC4D7 #x9354)
- (#xC4D8 #x693F)
- (#xC4D9 #x6F70)
- (#xC4DA #x576A)
- (#xC4DB #x58F7)
- (#xC4DC #x5B2C)
- (#xC4DD #x7D2C)
- (#xC4DE #x722A)
- (#xC4DF #x540A)
- (#xC4E0 #x91E3)
- (#xC4E1 #x9DB4)
- (#xC4E2 #x4EAD)
- (#xC4E3 #x4F4E)
- (#xC4E4 #x505C)
- (#xC4E5 #x5075)
- (#xC4E6 #x5243)
- (#xC4E7 #x8C9E)
- (#xC4E8 #x5448)
- (#xC4E9 #x5824)
- (#xC4EA #x5B9A)
- (#xC4EB #x5E1D)
- (#xC4EC #x5E95)
- (#xC4ED #x5EAD)
- (#xC4EE #x5EF7)
- (#xC4EF #x5F1F)
- (#xC4F0 #x608C)
- (#xC4F1 #x62B5)
- (#xC4F2 #x633A)
- (#xC4F3 #x63D0)
- (#xC4F4 #x68AF)
- (#xC4F5 #x6C40)
- (#xC4F6 #x7887)
- (#xC4F7 #x798E)
- (#xC4F8 #x7A0B)
- (#xC4F9 #x7DE0)
- (#xC4FA #x8247)
- (#xC4FB #x8A02)
- (#xC4FC #x8AE6)
- (#xC4FD #x8E44)
- (#xC4FE #x9013)
- (#xC5A1 #x90B8)
- (#xC5A2 #x912D)
- (#xC5A3 #x91D8)
- (#xC5A4 #x9F0E)
- (#xC5A5 #x6CE5)
- (#xC5A6 #x6458)
- (#xC5A7 #x64E2)
- (#xC5A8 #x6575)
- (#xC5A9 #x6EF4)
- (#xC5AA #x7684)
- (#xC5AB #x7B1B)
- (#xC5AC #x9069)
- (#xC5AD #x93D1)
- (#xC5AE #x6EBA)
- (#xC5AF #x54F2)
- (#xC5B0 #x5FB9)
- (#xC5B1 #x64A4)
- (#xC5B2 #x8F4D)
- (#xC5B3 #x8FED)
- (#xC5B4 #x9244)
- (#xC5B5 #x5178)
- (#xC5B6 #x586B)
- (#xC5B7 #x5929)
- (#xC5B8 #x5C55)
- (#xC5B9 #x5E97)
- (#xC5BA #x6DFB)
- (#xC5BB #x7E8F)
- (#xC5BC #x751C)
- (#xC5BD #x8CBC)
- (#xC5BE #x8EE2)
- (#xC5BF #x985B)
- (#xC5C0 #x70B9)
- (#xC5C1 #x4F1D)
- (#xC5C2 #x6BBF)
- (#xC5C3 #x6FB1)
- (#xC5C4 #x7530)
- (#xC5C5 #x96FB)
- (#xC5C6 #x514E)
- (#xC5C7 #x5410)
- (#xC5C8 #x5835)
- (#xC5C9 #x5857)
- (#xC5CA #x59AC)
- (#xC5CB #x5C60)
- (#xC5CC #x5F92)
- (#xC5CD #x6597)
- (#xC5CE #x675C)
- (#xC5CF #x6E21)
- (#xC5D0 #x767B)
- (#xC5D1 #x83DF)
- (#xC5D2 #x8CED)
- (#xC5D3 #x9014)
- (#xC5D4 #x90FD)
- (#xC5D5 #x934D)
- (#xC5D6 #x7825)
- (#xC5D7 #x783A)
- (#xC5D8 #x52AA)
- (#xC5D9 #x5EA6)
- (#xC5DA #x571F)
- (#xC5DB #x5974)
- (#xC5DC #x6012)
- (#xC5DD #x5012)
- (#xC5DE #x515A)
- (#xC5DF #x51AC)
- (#xC5E0 #x51CD)
- (#xC5E1 #x5200)
- (#xC5E2 #x5510)
- (#xC5E3 #x5854)
- (#xC5E4 #x5858)
- (#xC5E5 #x5957)
- (#xC5E6 #x5B95)
- (#xC5E7 #x5CF6)
- (#xC5E8 #x5D8B)
- (#xC5E9 #x60BC)
- (#xC5EA #x6295)
- (#xC5EB #x642D)
- (#xC5EC #x6771)
- (#xC5ED #x6843)
- (#xC5EE #x68BC)
- (#xC5EF #x68DF)
- (#xC5F0 #x76D7)
- (#xC5F1 #x6DD8)
- (#xC5F2 #x6E6F)
- (#xC5F3 #x6D9B)
- (#xC5F4 #x706F)
- (#xC5F5 #x71C8)
- (#xC5F6 #x5F53)
- (#xC5F7 #x75D8)
- (#xC5F8 #x7977)
- (#xC5F9 #x7B49)
- (#xC5FA #x7B54)
- (#xC5FB #x7B52)
- (#xC5FC #x7CD6)
- (#xC5FD #x7D71)
- (#xC5FE #x5230)
- (#xC6A1 #x8463)
- (#xC6A2 #x8569)
- (#xC6A3 #x85E4)
- (#xC6A4 #x8A0E)
- (#xC6A5 #x8B04)
- (#xC6A6 #x8C46)
- (#xC6A7 #x8E0F)
- (#xC6A8 #x9003)
- (#xC6A9 #x900F)
- (#xC6AA #x9419)
- (#xC6AB #x9676)
- (#xC6AC #x982D)
- (#xC6AD #x9A30)
- (#xC6AE #x95D8)
- (#xC6AF #x50CD)
- (#xC6B0 #x52D5)
- (#xC6B1 #x540C)
- (#xC6B2 #x5802)
- (#xC6B3 #x5C0E)
- (#xC6B4 #x61A7)
- (#xC6B5 #x649E)
- (#xC6B6 #x6D1E)
- (#xC6B7 #x77B3)
- (#xC6B8 #x7AE5)
- (#xC6B9 #x80F4)
- (#xC6BA #x8404)
- (#xC6BB #x9053)
- (#xC6BC #x9285)
- (#xC6BD #x5CE0)
- (#xC6BE #x9D07)
- (#xC6BF #x533F)
- (#xC6C0 #x5F97)
- (#xC6C1 #x5FB3)
- (#xC6C2 #x6D9C)
- (#xC6C3 #x7279)
- (#xC6C4 #x7763)
- (#xC6C5 #x79BF)
- (#xC6C6 #x7BE4)
- (#xC6C7 #x6BD2)
- (#xC6C8 #x72EC)
- (#xC6C9 #x8AAD)
- (#xC6CA #x6803)
- (#xC6CB #x6A61)
- (#xC6CC #x51F8)
- (#xC6CD #x7A81)
- (#xC6CE #x6934)
- (#xC6CF #x5C4A)
- (#xC6D0 #x9CF6)
- (#xC6D1 #x82EB)
- (#xC6D2 #x5BC5)
- (#xC6D3 #x9149)
- (#xC6D4 #x701E)
- (#xC6D5 #x5678)
- (#xC6D6 #x5C6F)
- (#xC6D7 #x60C7)
- (#xC6D8 #x6566)
- (#xC6D9 #x6C8C)
- (#xC6DA #x8C5A)
- (#xC6DB #x9041)
- (#xC6DC #x9813)
- (#xC6DD #x5451)
- (#xC6DE #x66C7)
- (#xC6DF #x920D)
- (#xC6E0 #x5948)
- (#xC6E1 #x90A3)
- (#xC6E2 #x5185)
- (#xC6E3 #x4E4D)
- (#xC6E4 #x51EA)
- (#xC6E5 #x8599)
- (#xC6E6 #x8B0E)
- (#xC6E7 #x7058)
- (#xC6E8 #x637A)
- (#xC6E9 #x934B)
- (#xC6EA #x6962)
- (#xC6EB #x99B4)
- (#xC6EC #x7E04)
- (#xC6ED #x7577)
- (#xC6EE #x5357)
- (#xC6EF #x6960)
- (#xC6F0 #x8EDF)
- (#xC6F1 #x96E3)
- (#xC6F2 #x6C5D)
- (#xC6F3 #x4E8C)
- (#xC6F4 #x5C3C)
- (#xC6F5 #x5F10)
- (#xC6F6 #x8FE9)
- (#xC6F7 #x5302)
- (#xC6F8 #x8CD1)
- (#xC6F9 #x8089)
- (#xC6FA #x8679)
- (#xC6FB #x5EFF)
- (#xC6FC #x65E5)
- (#xC6FD #x4E73)
- (#xC6FE #x5165)
- (#xC7A1 #x5982)
- (#xC7A2 #x5C3F)
- (#xC7A3 #x97EE)
- (#xC7A4 #x4EFB)
- (#xC7A5 #x598A)
- (#xC7A6 #x5FCD)
- (#xC7A7 #x8A8D)
- (#xC7A8 #x6FE1)
- (#xC7A9 #x79B0)
- (#xC7AA #x7962)
- (#xC7AB #x5BE7)
- (#xC7AC #x8471)
- (#xC7AD #x732B)
- (#xC7AE #x71B1)
- (#xC7AF #x5E74)
- (#xC7B0 #x5FF5)
- (#xC7B1 #x637B)
- (#xC7B2 #x649A)
- (#xC7B3 #x71C3)
- (#xC7B4 #x7C98)
- (#xC7B5 #x4E43)
- (#xC7B6 #x5EFC)
- (#xC7B7 #x4E4B)
- (#xC7B8 #x57DC)
- (#xC7B9 #x56A2)
- (#xC7BA #x60A9)
- (#xC7BB #x6FC3)
- (#xC7BC #x7D0D)
- (#xC7BD #x80FD)
- (#xC7BE #x8133)
- (#xC7BF #x81BF)
- (#xC7C0 #x8FB2)
- (#xC7C1 #x8997)
- (#xC7C2 #x86A4)
- (#xC7C3 #x5DF4)
- (#xC7C4 #x628A)
- (#xC7C5 #x64AD)
- (#xC7C6 #x8987)
- (#xC7C7 #x6777)
- (#xC7C8 #x6CE2)
- (#xC7C9 #x6D3E)
- (#xC7CA #x7436)
- (#xC7CB #x7834)
- (#xC7CC #x5A46)
- (#xC7CD #x7F75)
- (#xC7CE #x82AD)
- (#xC7CF #x99AC)
- (#xC7D0 #x4FF3)
- (#xC7D1 #x5EC3)
- (#xC7D2 #x62DD)
- (#xC7D3 #x6392)
- (#xC7D4 #x6557)
- (#xC7D5 #x676F)
- (#xC7D6 #x76C3)
- (#xC7D7 #x724C)
- (#xC7D8 #x80CC)
- (#xC7D9 #x80BA)
- (#xC7DA #x8F29)
- (#xC7DB #x914D)
- (#xC7DC #x500D)
- (#xC7DD #x57F9)
- (#xC7DE #x5A92)
- (#xC7DF #x6885)
- (#xC7E0 #x6973)
- (#xC7E1 #x7164)
- (#xC7E2 #x72FD)
- (#xC7E3 #x8CB7)
- (#xC7E4 #x58F2)
- (#xC7E5 #x8CE0)
- (#xC7E6 #x966A)
- (#xC7E7 #x9019)
- (#xC7E8 #x877F)
- (#xC7E9 #x79E4)
- (#xC7EA #x77E7)
- (#xC7EB #x8429)
- (#xC7EC #x4F2F)
- (#xC7ED #x5265)
- (#xC7EE #x535A)
- (#xC7EF #x62CD)
- (#xC7F0 #x67CF)
- (#xC7F1 #x6CCA)
- (#xC7F2 #x767D)
- (#xC7F3 #x7B94)
- (#xC7F4 #x7C95)
- (#xC7F5 #x8236)
- (#xC7F6 #x8584)
- (#xC7F7 #x8FEB)
- (#xC7F8 #x66DD)
- (#xC7F9 #x6F20)
- (#xC7FA #x7206)
- (#xC7FB #x7E1B)
- (#xC7FC #x83AB)
- (#xC7FD #x99C1)
- (#xC7FE #x9EA6)
- (#xC8A1 #x51FD)
- (#xC8A2 #x7BB1)
- (#xC8A3 #x7872)
- (#xC8A4 #x7BB8)
- (#xC8A5 #x8087)
- (#xC8A6 #x7B48)
- (#xC8A7 #x6AE8)
- (#xC8A8 #x5E61)
- (#xC8A9 #x808C)
- (#xC8AA #x7551)
- (#xC8AB #x7560)
- (#xC8AC #x516B)
- (#xC8AD #x9262)
- (#xC8AE #x6E8C)
- (#xC8AF #x767A)
- (#xC8B0 #x9197)
- (#xC8B1 #x9AEA)
- (#xC8B2 #x4F10)
- (#xC8B3 #x7F70)
- (#xC8B4 #x629C)
- (#xC8B5 #x7B4F)
- (#xC8B6 #x95A5)
- (#xC8B7 #x9CE9)
- (#xC8B8 #x567A)
- (#xC8B9 #x5859)
- (#xC8BA #x86E4)
- (#xC8BB #x96BC)
- (#xC8BC #x4F34)
- (#xC8BD #x5224)
- (#xC8BE #x534A)
- (#xC8BF #x53CD)
- (#xC8C0 #x53DB)
- (#xC8C1 #x5E06)
- (#xC8C2 #x642C)
- (#xC8C3 #x6591)
- (#xC8C4 #x677F)
- (#xC8C5 #x6C3E)
- (#xC8C6 #x6C4E)
- (#xC8C7 #x7248)
- (#xC8C8 #x72AF)
- (#xC8C9 #x73ED)
- (#xC8CA #x7554)
- (#xC8CB #x7E41)
- (#xC8CC #x822C)
- (#xC8CD #x85E9)
- (#xC8CE #x8CA9)
- (#xC8CF #x7BC4)
- (#xC8D0 #x91C6)
- (#xC8D1 #x7169)
- (#xC8D2 #x9812)
- (#xC8D3 #x98EF)
- (#xC8D4 #x633D)
- (#xC8D5 #x6669)
- (#xC8D6 #x756A)
- (#xC8D7 #x76E4)
- (#xC8D8 #x78D0)
- (#xC8D9 #x8543)
- (#xC8DA #x86EE)
- (#xC8DB #x532A)
- (#xC8DC #x5351)
- (#xC8DD #x5426)
- (#xC8DE #x5983)
- (#xC8DF #x5E87)
- (#xC8E0 #x5F7C)
- (#xC8E1 #x60B2)
- (#xC8E2 #x6249)
- (#xC8E3 #x6279)
- (#xC8E4 #x62AB)
- (#xC8E5 #x6590)
- (#xC8E6 #x6BD4)
- (#xC8E7 #x6CCC)
- (#xC8E8 #x75B2)
- (#xC8E9 #x76AE)
- (#xC8EA #x7891)
- (#xC8EB #x79D8)
- (#xC8EC #x7DCB)
- (#xC8ED #x7F77)
- (#xC8EE #x80A5)
- (#xC8EF #x88AB)
- (#xC8F0 #x8AB9)
- (#xC8F1 #x8CBB)
- (#xC8F2 #x907F)
- (#xC8F3 #x975E)
- (#xC8F4 #x98DB)
- (#xC8F5 #x6A0B)
- (#xC8F6 #x7C38)
- (#xC8F7 #x5099)
- (#xC8F8 #x5C3E)
- (#xC8F9 #x5FAE)
- (#xC8FA #x6787)
- (#xC8FB #x6BD8)
- (#xC8FC #x7435)
- (#xC8FD #x7709)
- (#xC8FE #x7F8E)
- (#xC9A1 #x9F3B)
- (#xC9A2 #x67CA)
- (#xC9A3 #x7A17)
- (#xC9A4 #x5339)
- (#xC9A5 #x758B)
- (#xC9A6 #x9AED)
- (#xC9A7 #x5F66)
- (#xC9A8 #x819D)
- (#xC9A9 #x83F1)
- (#xC9AA #x8098)
- (#xC9AB #x5F3C)
- (#xC9AC #x5FC5)
- (#xC9AD #x7562)
- (#xC9AE #x7B46)
- (#xC9AF #x903C)
- (#xC9B0 #x6867)
- (#xC9B1 #x59EB)
- (#xC9B2 #x5A9B)
- (#xC9B3 #x7D10)
- (#xC9B4 #x767E)
- (#xC9B5 #x8B2C)
- (#xC9B6 #x4FF5)
- (#xC9B7 #x5F6A)
- (#xC9B8 #x6A19)
- (#xC9B9 #x6C37)
- (#xC9BA #x6F02)
- (#xC9BB #x74E2)
- (#xC9BC #x7968)
- (#xC9BD #x8868)
- (#xC9BE #x8A55)
- (#xC9BF #x8C79)
- (#xC9C0 #x5EDF)
- (#xC9C1 #x63CF)
- (#xC9C2 #x75C5)
- (#xC9C3 #x79D2)
- (#xC9C4 #x82D7)
- (#xC9C5 #x9328)
- (#xC9C6 #x92F2)
- (#xC9C7 #x849C)
- (#xC9C8 #x86ED)
- (#xC9C9 #x9C2D)
- (#xC9CA #x54C1)
- (#xC9CB #x5F6C)
- (#xC9CC #x658C)
- (#xC9CD #x6D5C)
- (#xC9CE #x7015)
- (#xC9CF #x8CA7)
- (#xC9D0 #x8CD3)
- (#xC9D1 #x983B)
- (#xC9D2 #x654F)
- (#xC9D3 #x74F6)
- (#xC9D4 #x4E0D)
- (#xC9D5 #x4ED8)
- (#xC9D6 #x57E0)
- (#xC9D7 #x592B)
- (#xC9D8 #x5A66)
- (#xC9D9 #x5BCC)
- (#xC9DA #x51A8)
- (#xC9DB #x5E03)
- (#xC9DC #x5E9C)
- (#xC9DD #x6016)
- (#xC9DE #x6276)
- (#xC9DF #x6577)
- (#xC9E0 #x65A7)
- (#xC9E1 #x666E)
- (#xC9E2 #x6D6E)
- (#xC9E3 #x7236)
- (#xC9E4 #x7B26)
- (#xC9E5 #x8150)
- (#xC9E6 #x819A)
- (#xC9E7 #x8299)
- (#xC9E8 #x8B5C)
- (#xC9E9 #x8CA0)
- (#xC9EA #x8CE6)
- (#xC9EB #x8D74)
- (#xC9EC #x961C)
- (#xC9ED #x9644)
- (#xC9EE #x4FAE)
- (#xC9EF #x64AB)
- (#xC9F0 #x6B66)
- (#xC9F1 #x821E)
- (#xC9F2 #x8461)
- (#xC9F3 #x856A)
- (#xC9F4 #x90E8)
- (#xC9F5 #x5C01)
- (#xC9F6 #x6953)
- (#xC9F7 #x98A8)
- (#xC9F8 #x847A)
- (#xC9F9 #x8557)
- (#xC9FA #x4F0F)
- (#xC9FB #x526F)
- (#xC9FC #x5FA9)
- (#xC9FD #x5E45)
- (#xC9FE #x670D)
- (#xCAA1 #x798F)
- (#xCAA2 #x8179)
- (#xCAA3 #x8907)
- (#xCAA4 #x8986)
- (#xCAA5 #x6DF5)
- (#xCAA6 #x5F17)
- (#xCAA7 #x6255)
- (#xCAA8 #x6CB8)
- (#xCAA9 #x4ECF)
- (#xCAAA #x7269)
- (#xCAAB #x9B92)
- (#xCAAC #x5206)
- (#xCAAD #x543B)
- (#xCAAE #x5674)
- (#xCAAF #x58B3)
- (#xCAB0 #x61A4)
- (#xCAB1 #x626E)
- (#xCAB2 #x711A)
- (#xCAB3 #x596E)
- (#xCAB4 #x7C89)
- (#xCAB5 #x7CDE)
- (#xCAB6 #x7D1B)
- (#xCAB7 #x96F0)
- (#xCAB8 #x6587)
- (#xCAB9 #x805E)
- (#xCABA #x4E19)
- (#xCABB #x4F75)
- (#xCABC #x5175)
- (#xCABD #x5840)
- (#xCABE #x5E63)
- (#xCABF #x5E73)
- (#xCAC0 #x5F0A)
- (#xCAC1 #x67C4)
- (#xCAC2 #x4E26)
- (#xCAC3 #x853D)
- (#xCAC4 #x9589)
- (#xCAC5 #x965B)
- (#xCAC6 #x7C73)
- (#xCAC7 #x9801)
- (#xCAC8 #x50FB)
- (#xCAC9 #x58C1)
- (#xCACA #x7656)
- (#xCACB #x78A7)
- (#xCACC #x5225)
- (#xCACD #x77A5)
- (#xCACE #x8511)
- (#xCACF #x7B86)
- (#xCAD0 #x504F)
- (#xCAD1 #x5909)
- (#xCAD2 #x7247)
- (#xCAD3 #x7BC7)
- (#xCAD4 #x7DE8)
- (#xCAD5 #x8FBA)
- (#xCAD6 #x8FD4)
- (#xCAD7 #x904D)
- (#xCAD8 #x4FBF)
- (#xCAD9 #x52C9)
- (#xCADA #x5A29)
- (#xCADB #x5F01)
- (#xCADC #x97AD)
- (#xCADD #x4FDD)
- (#xCADE #x8217)
- (#xCADF #x92EA)
- (#xCAE0 #x5703)
- (#xCAE1 #x6355)
- (#xCAE2 #x6B69)
- (#xCAE3 #x752B)
- (#xCAE4 #x88DC)
- (#xCAE5 #x8F14)
- (#xCAE6 #x7A42)
- (#xCAE7 #x52DF)
- (#xCAE8 #x5893)
- (#xCAE9 #x6155)
- (#xCAEA #x620A)
- (#xCAEB #x66AE)
- (#xCAEC #x6BCD)
- (#xCAED #x7C3F)
- (#xCAEE #x83E9)
- (#xCAEF #x5023)
- (#xCAF0 #x4FF8)
- (#xCAF1 #x5305)
- (#xCAF2 #x5446)
- (#xCAF3 #x5831)
- (#xCAF4 #x5949)
- (#xCAF5 #x5B9D)
- (#xCAF6 #x5CF0)
- (#xCAF7 #x5CEF)
- (#xCAF8 #x5D29)
- (#xCAF9 #x5E96)
- (#xCAFA #x62B1)
- (#xCAFB #x6367)
- (#xCAFC #x653E)
- (#xCAFD #x65B9)
- (#xCAFE #x670B)
- (#xCBA1 #x6CD5)
- (#xCBA2 #x6CE1)
- (#xCBA3 #x70F9)
- (#xCBA4 #x7832)
- (#xCBA5 #x7E2B)
- (#xCBA6 #x80DE)
- (#xCBA7 #x82B3)
- (#xCBA8 #x840C)
- (#xCBA9 #x84EC)
- (#xCBAA #x8702)
- (#xCBAB #x8912)
- (#xCBAC #x8A2A)
- (#xCBAD #x8C4A)
- (#xCBAE #x90A6)
- (#xCBAF #x92D2)
- (#xCBB0 #x98FD)
- (#xCBB1 #x9CF3)
- (#xCBB2 #x9D6C)
- (#xCBB3 #x4E4F)
- (#xCBB4 #x4EA1)
- (#xCBB5 #x508D)
- (#xCBB6 #x5256)
- (#xCBB7 #x574A)
- (#xCBB8 #x59A8)
- (#xCBB9 #x5E3D)
- (#xCBBA #x5FD8)
- (#xCBBB #x5FD9)
- (#xCBBC #x623F)
- (#xCBBD #x66B4)
- (#xCBBE #x671B)
- (#xCBBF #x67D0)
- (#xCBC0 #x68D2)
- (#xCBC1 #x5192)
- (#xCBC2 #x7D21)
- (#xCBC3 #x80AA)
- (#xCBC4 #x81A8)
- (#xCBC5 #x8B00)
- (#xCBC6 #x8C8C)
- (#xCBC7 #x8CBF)
- (#xCBC8 #x927E)
- (#xCBC9 #x9632)
- (#xCBCA #x5420)
- (#xCBCB #x982C)
- (#xCBCC #x5317)
- (#xCBCD #x50D5)
- (#xCBCE #x535C)
- (#xCBCF #x58A8)
- (#xCBD0 #x64B2)
- (#xCBD1 #x6734)
- (#xCBD2 #x7267)
- (#xCBD3 #x7766)
- (#xCBD4 #x7A46)
- (#xCBD5 #x91E6)
- (#xCBD6 #x52C3)
- (#xCBD7 #x6CA1)
- (#xCBD8 #x6B86)
- (#xCBD9 #x5800)
- (#xCBDA #x5E4C)
- (#xCBDB #x5954)
- (#xCBDC #x672C)
- (#xCBDD #x7FFB)
- (#xCBDE #x51E1)
- (#xCBDF #x76C6)
- (#xCBE0 #x6469)
- (#xCBE1 #x78E8)
- (#xCBE2 #x9B54)
- (#xCBE3 #x9EBB)
- (#xCBE4 #x57CB)
- (#xCBE5 #x59B9)
- (#xCBE6 #x6627)
- (#xCBE7 #x679A)
- (#xCBE8 #x6BCE)
- (#xCBE9 #x54E9)
- (#xCBEA #x69D9)
- (#xCBEB #x5E55)
- (#xCBEC #x819C)
- (#xCBED #x6795)
- (#xCBEE #x9BAA)
- (#xCBEF #x67FE)
- (#xCBF0 #x9C52)
- (#xCBF1 #x685D)
- (#xCBF2 #x4EA6)
- (#xCBF3 #x4FE3)
- (#xCBF4 #x53C8)
- (#xCBF5 #x62B9)
- (#xCBF6 #x672B)
- (#xCBF7 #x6CAB)
- (#xCBF8 #x8FC4)
- (#xCBF9 #x4FAD)
- (#xCBFA #x7E6D)
- (#xCBFB #x9EBF)
- (#xCBFC #x4E07)
- (#xCBFD #x6162)
- (#xCBFE #x6E80)
- (#xCCA1 #x6F2B)
- (#xCCA2 #x8513)
- (#xCCA3 #x5473)
- (#xCCA4 #x672A)
- (#xCCA5 #x9B45)
- (#xCCA6 #x5DF3)
- (#xCCA7 #x7B95)
- (#xCCA8 #x5CAC)
- (#xCCA9 #x5BC6)
- (#xCCAA #x871C)
- (#xCCAB #x6E4A)
- (#xCCAC #x84D1)
- (#xCCAD #x7A14)
- (#xCCAE #x8108)
- (#xCCAF #x5999)
- (#xCCB0 #x7C8D)
- (#xCCB1 #x6C11)
- (#xCCB2 #x7720)
- (#xCCB3 #x52D9)
- (#xCCB4 #x5922)
- (#xCCB5 #x7121)
- (#xCCB6 #x725F)
- (#xCCB7 #x77DB)
- (#xCCB8 #x9727)
- (#xCCB9 #x9D61)
- (#xCCBA #x690B)
- (#xCCBB #x5A7F)
- (#xCCBC #x5A18)
- (#xCCBD #x51A5)
- (#xCCBE #x540D)
- (#xCCBF #x547D)
- (#xCCC0 #x660E)
- (#xCCC1 #x76DF)
- (#xCCC2 #x8FF7)
- (#xCCC3 #x9298)
- (#xCCC4 #x9CF4)
- (#xCCC5 #x59EA)
- (#xCCC6 #x725D)
- (#xCCC7 #x6EC5)
- (#xCCC8 #x514D)
- (#xCCC9 #x68C9)
- (#xCCCA #x7DBF)
- (#xCCCB #x7DEC)
- (#xCCCC #x9762)
- (#xCCCD #x9EBA)
- (#xCCCE #x6478)
- (#xCCCF #x6A21)
- (#xCCD0 #x8302)
- (#xCCD1 #x5984)
- (#xCCD2 #x5B5F)
- (#xCCD3 #x6BDB)
- (#xCCD4 #x731B)
- (#xCCD5 #x76F2)
- (#xCCD6 #x7DB2)
- (#xCCD7 #x8017)
- (#xCCD8 #x8499)
- (#xCCD9 #x5132)
- (#xCCDA #x6728)
- (#xCCDB #x9ED9)
- (#xCCDC #x76EE)
- (#xCCDD #x6762)
- (#xCCDE #x52FF)
- (#xCCDF #x9905)
- (#xCCE0 #x5C24)
- (#xCCE1 #x623B)
- (#xCCE2 #x7C7E)
- (#xCCE3 #x8CB0)
- (#xCCE4 #x554F)
- (#xCCE5 #x60B6)
- (#xCCE6 #x7D0B)
- (#xCCE7 #x9580)
- (#xCCE8 #x5301)
- (#xCCE9 #x4E5F)
- (#xCCEA #x51B6)
- (#xCCEB #x591C)
- (#xCCEC #x723A)
- (#xCCED #x8036)
- (#xCCEE #x91CE)
- (#xCCEF #x5F25)
- (#xCCF0 #x77E2)
- (#xCCF1 #x5384)
- (#xCCF2 #x5F79)
- (#xCCF3 #x7D04)
- (#xCCF4 #x85AC)
- (#xCCF5 #x8A33)
- (#xCCF6 #x8E8D)
- (#xCCF7 #x9756)
- (#xCCF8 #x67F3)
- (#xCCF9 #x85AE)
- (#xCCFA #x9453)
- (#xCCFB #x6109)
- (#xCCFC #x6108)
- (#xCCFD #x6CB9)
- (#xCCFE #x7652)
- (#xCDA1 #x8AED)
- (#xCDA2 #x8F38)
- (#xCDA3 #x552F)
- (#xCDA4 #x4F51)
- (#xCDA5 #x512A)
- (#xCDA6 #x52C7)
- (#xCDA7 #x53CB)
- (#xCDA8 #x5BA5)
- (#xCDA9 #x5E7D)
- (#xCDAA #x60A0)
- (#xCDAB #x6182)
- (#xCDAC #x63D6)
- (#xCDAD #x6709)
- (#xCDAE #x67DA)
- (#xCDAF #x6E67)
- (#xCDB0 #x6D8C)
- (#xCDB1 #x7336)
- (#xCDB2 #x7337)
- (#xCDB3 #x7531)
- (#xCDB4 #x7950)
- (#xCDB5 #x88D5)
- (#xCDB6 #x8A98)
- (#xCDB7 #x904A)
- (#xCDB8 #x9091)
- (#xCDB9 #x90F5)
- (#xCDBA #x96C4)
- (#xCDBB #x878D)
- (#xCDBC #x5915)
- (#xCDBD #x4E88)
- (#xCDBE #x4F59)
- (#xCDBF #x4E0E)
- (#xCDC0 #x8A89)
- (#xCDC1 #x8F3F)
- (#xCDC2 #x9810)
- (#xCDC3 #x50AD)
- (#xCDC4 #x5E7C)
- (#xCDC5 #x5996)
- (#xCDC6 #x5BB9)
- (#xCDC7 #x5EB8)
- (#xCDC8 #x63DA)
- (#xCDC9 #x63FA)
- (#xCDCA #x64C1)
- (#xCDCB #x66DC)
- (#xCDCC #x694A)
- (#xCDCD #x69D8)
- (#xCDCE #x6D0B)
- (#xCDCF #x6EB6)
- (#xCDD0 #x7194)
- (#xCDD1 #x7528)
- (#xCDD2 #x7AAF)
- (#xCDD3 #x7F8A)
- (#xCDD4 #x8000)
- (#xCDD5 #x8449)
- (#xCDD6 #x84C9)
- (#xCDD7 #x8981)
- (#xCDD8 #x8B21)
- (#xCDD9 #x8E0A)
- (#xCDDA #x9065)
- (#xCDDB #x967D)
- (#xCDDC #x990A)
- (#xCDDD #x617E)
- (#xCDDE #x6291)
- (#xCDDF #x6B32)
- (#xCDE0 #x6C83)
- (#xCDE1 #x6D74)
- (#xCDE2 #x7FCC)
- (#xCDE3 #x7FFC)
- (#xCDE4 #x6DC0)
- (#xCDE5 #x7F85)
- (#xCDE6 #x87BA)
- (#xCDE7 #x88F8)
- (#xCDE8 #x6765)
- (#xCDE9 #x83B1)
- (#xCDEA #x983C)
- (#xCDEB #x96F7)
- (#xCDEC #x6D1B)
- (#xCDED #x7D61)
- (#xCDEE #x843D)
- (#xCDEF #x916A)
- (#xCDF0 #x4E71)
- (#xCDF1 #x5375)
- (#xCDF2 #x5D50)
- (#xCDF3 #x6B04)
- (#xCDF4 #x6FEB)
- (#xCDF5 #x85CD)
- (#xCDF6 #x862D)
- (#xCDF7 #x89A7)
- (#xCDF8 #x5229)
- (#xCDF9 #x540F)
- (#xCDFA #x5C65)
- (#xCDFB #x674E)
- (#xCDFC #x68A8)
- (#xCDFD #x7406)
- (#xCDFE #x7483)
- (#xCEA1 #x75E2)
- (#xCEA2 #x88CF)
- (#xCEA3 #x88E1)
- (#xCEA4 #x91CC)
- (#xCEA5 #x96E2)
- (#xCEA6 #x9678)
- (#xCEA7 #x5F8B)
- (#xCEA8 #x7387)
- (#xCEA9 #x7ACB)
- (#xCEAA #x844E)
- (#xCEAB #x63A0)
- (#xCEAC #x7565)
- (#xCEAD #x5289)
- (#xCEAE #x6D41)
- (#xCEAF #x6E9C)
- (#xCEB0 #x7409)
- (#xCEB1 #x7559)
- (#xCEB2 #x786B)
- (#xCEB3 #x7C92)
- (#xCEB4 #x9686)
- (#xCEB5 #x7ADC)
- (#xCEB6 #x9F8D)
- (#xCEB7 #x4FB6)
- (#xCEB8 #x616E)
- (#xCEB9 #x65C5)
- (#xCEBA #x865C)
- (#xCEBB #x4E86)
- (#xCEBC #x4EAE)
- (#xCEBD #x50DA)
- (#xCEBE #x4E21)
- (#xCEBF #x51CC)
- (#xCEC0 #x5BEE)
- (#xCEC1 #x6599)
- (#xCEC2 #x6881)
- (#xCEC3 #x6DBC)
- (#xCEC4 #x731F)
- (#xCEC5 #x7642)
- (#xCEC6 #x77AD)
- (#xCEC7 #x7A1C)
- (#xCEC8 #x7CE7)
- (#xCEC9 #x826F)
- (#xCECA #x8AD2)
- (#xCECB #x907C)
- (#xCECC #x91CF)
- (#xCECD #x9675)
- (#xCECE #x9818)
- (#xCECF #x529B)
- (#xCED0 #x7DD1)
- (#xCED1 #x502B)
- (#xCED2 #x5398)
- (#xCED3 #x6797)
- (#xCED4 #x6DCB)
- (#xCED5 #x71D0)
- (#xCED6 #x7433)
- (#xCED7 #x81E8)
- (#xCED8 #x8F2A)
- (#xCED9 #x96A3)
- (#xCEDA #x9C57)
- (#xCEDB #x9E9F)
- (#xCEDC #x7460)
- (#xCEDD #x5841)
- (#xCEDE #x6D99)
- (#xCEDF #x7D2F)
- (#xCEE0 #x985E)
- (#xCEE1 #x4EE4)
- (#xCEE2 #x4F36)
- (#xCEE3 #x4F8B)
- (#xCEE4 #x51B7)
- (#xCEE5 #x52B1)
- (#xCEE6 #x5DBA)
- (#xCEE7 #x601C)
- (#xCEE8 #x73B2)
- (#xCEE9 #x793C)
- (#xCEEA #x82D3)
- (#xCEEB #x9234)
- (#xCEEC #x96B7)
- (#xCEED #x96F6)
- (#xCEEE #x970A)
- (#xCEEF #x9E97)
- (#xCEF0 #x9F62)
- (#xCEF1 #x66A6)
- (#xCEF2 #x6B74)
- (#xCEF3 #x5217)
- (#xCEF4 #x52A3)
- (#xCEF5 #x70C8)
- (#xCEF6 #x88C2)
- (#xCEF7 #x5EC9)
- (#xCEF8 #x604B)
- (#xCEF9 #x6190)
- (#xCEFA #x6F23)
- (#xCEFB #x7149)
- (#xCEFC #x7C3E)
- (#xCEFD #x7DF4)
- (#xCEFE #x806F)
- (#xCFA1 #x84EE)
- (#xCFA2 #x9023)
- (#xCFA3 #x932C)
- (#xCFA4 #x5442)
- (#xCFA5 #x9B6F)
- (#xCFA6 #x6AD3)
- (#xCFA7 #x7089)
- (#xCFA8 #x8CC2)
- (#xCFA9 #x8DEF)
- (#xCFAA #x9732)
- (#xCFAB #x52B4)
- (#xCFAC #x5A41)
- (#xCFAD #x5ECA)
- (#xCFAE #x5F04)
- (#xCFAF #x6717)
- (#xCFB0 #x697C)
- (#xCFB1 #x6994)
- (#xCFB2 #x6D6A)
- (#xCFB3 #x6F0F)
- (#xCFB4 #x7262)
- (#xCFB5 #x72FC)
- (#xCFB6 #x7BED)
- (#xCFB7 #x8001)
- (#xCFB8 #x807E)
- (#xCFB9 #x874B)
- (#xCFBA #x90CE)
- (#xCFBB #x516D)
- (#xCFBC #x9E93)
- (#xCFBD #x7984)
- (#xCFBE #x808B)
- (#xCFBF #x9332)
- (#xCFC0 #x8AD6)
- (#xCFC1 #x502D)
- (#xCFC2 #x548C)
- (#xCFC3 #x8A71)
- (#xCFC4 #x6B6A)
- (#xCFC5 #x8CC4)
- (#xCFC6 #x8107)
- (#xCFC7 #x60D1)
- (#xCFC8 #x67A0)
- (#xCFC9 #x9DF2)
- (#xCFCA #x4E99)
- (#xCFCB #x4E98)
- (#xCFCC #x9C10)
- (#xCFCD #x8A6B)
- (#xCFCE #x85C1)
- (#xCFCF #x8568)
- (#xCFD0 #x6900)
- (#xCFD1 #x6E7E)
- (#xCFD2 #x7897)
- (#xCFD3 #x8155)
- (#xD0A1 #x5F0C)
- (#xD0A2 #x4E10)
- (#xD0A3 #x4E15)
- (#xD0A4 #x4E2A)
- (#xD0A5 #x4E31)
- (#xD0A6 #x4E36)
- (#xD0A7 #x4E3C)
- (#xD0A8 #x4E3F)
- (#xD0A9 #x4E42)
- (#xD0AA #x4E56)
- (#xD0AB #x4E58)
- (#xD0AC #x4E82)
- (#xD0AD #x4E85)
- (#xD0AE #x8C6B)
- (#xD0AF #x4E8A)
- (#xD0B0 #x8212)
- (#xD0B1 #x5F0D)
- (#xD0B2 #x4E8E)
- (#xD0B3 #x4E9E)
- (#xD0B4 #x4E9F)
- (#xD0B5 #x4EA0)
- (#xD0B6 #x4EA2)
- (#xD0B7 #x4EB0)
- (#xD0B8 #x4EB3)
- (#xD0B9 #x4EB6)
- (#xD0BA #x4ECE)
- (#xD0BB #x4ECD)
- (#xD0BC #x4EC4)
- (#xD0BD #x4EC6)
- (#xD0BE #x4EC2)
- (#xD0BF #x4ED7)
- (#xD0C0 #x4EDE)
- (#xD0C1 #x4EED)
- (#xD0C2 #x4EDF)
- (#xD0C3 #x4EF7)
- (#xD0C4 #x4F09)
- (#xD0C5 #x4F5A)
- (#xD0C6 #x4F30)
- (#xD0C7 #x4F5B)
- (#xD0C8 #x4F5D)
- (#xD0C9 #x4F57)
- (#xD0CA #x4F47)
- (#xD0CB #x4F76)
- (#xD0CC #x4F88)
- (#xD0CD #x4F8F)
- (#xD0CE #x4F98)
- (#xD0CF #x4F7B)
- (#xD0D0 #x4F69)
- (#xD0D1 #x4F70)
- (#xD0D2 #x4F91)
- (#xD0D3 #x4F6F)
- (#xD0D4 #x4F86)
- (#xD0D5 #x4F96)
- (#xD0D6 #x5118)
- (#xD0D7 #x4FD4)
- (#xD0D8 #x4FDF)
- (#xD0D9 #x4FCE)
- (#xD0DA #x4FD8)
- (#xD0DB #x4FDB)
- (#xD0DC #x4FD1)
- (#xD0DD #x4FDA)
- (#xD0DE #x4FD0)
- (#xD0DF #x4FE4)
- (#xD0E0 #x4FE5)
- (#xD0E1 #x501A)
- (#xD0E2 #x5028)
- (#xD0E3 #x5014)
- (#xD0E4 #x502A)
- (#xD0E5 #x5025)
- (#xD0E6 #x5005)
- (#xD0E7 #x4F1C)
- (#xD0E8 #x4FF6)
- (#xD0E9 #x5021)
- (#xD0EA #x5029)
- (#xD0EB #x502C)
- (#xD0EC #x4FFE)
- (#xD0ED #x4FEF)
- (#xD0EE #x5011)
- (#xD0EF #x5006)
- (#xD0F0 #x5043)
- (#xD0F1 #x5047)
- (#xD0F2 #x6703)
- (#xD0F3 #x5055)
- (#xD0F4 #x5050)
- (#xD0F5 #x5048)
- (#xD0F6 #x505A)
- (#xD0F7 #x5056)
- (#xD0F8 #x506C)
- (#xD0F9 #x5078)
- (#xD0FA #x5080)
- (#xD0FB #x509A)
- (#xD0FC #x5085)
- (#xD0FD #x50B4)
- (#xD0FE #x50B2)
- (#xD1A1 #x50C9)
- (#xD1A2 #x50CA)
- (#xD1A3 #x50B3)
- (#xD1A4 #x50C2)
- (#xD1A5 #x50D6)
- (#xD1A6 #x50DE)
- (#xD1A7 #x50E5)
- (#xD1A8 #x50ED)
- (#xD1A9 #x50E3)
- (#xD1AA #x50EE)
- (#xD1AB #x50F9)
- (#xD1AC #x50F5)
- (#xD1AD #x5109)
- (#xD1AE #x5101)
- (#xD1AF #x5102)
- (#xD1B0 #x5116)
- (#xD1B1 #x5115)
- (#xD1B2 #x5114)
- (#xD1B3 #x511A)
- (#xD1B4 #x5121)
- (#xD1B5 #x513A)
- (#xD1B6 #x5137)
- (#xD1B7 #x513C)
- (#xD1B8 #x513B)
- (#xD1B9 #x513F)
- (#xD1BA #x5140)
- (#xD1BB #x5152)
- (#xD1BC #x514C)
- (#xD1BD #x5154)
- (#xD1BE #x5162)
- (#xD1BF #x7AF8)
- (#xD1C0 #x5169)
- (#xD1C1 #x516A)
- (#xD1C2 #x516E)
- (#xD1C3 #x5180)
- (#xD1C4 #x5182)
- (#xD1C5 #x56D8)
- (#xD1C6 #x518C)
- (#xD1C7 #x5189)
- (#xD1C8 #x518F)
- (#xD1C9 #x5191)
- (#xD1CA #x5193)
- (#xD1CB #x5195)
- (#xD1CC #x5196)
- (#xD1CD #x51A4)
- (#xD1CE #x51A6)
- (#xD1CF #x51A2)
- (#xD1D0 #x51A9)
- (#xD1D1 #x51AA)
- (#xD1D2 #x51AB)
- (#xD1D3 #x51B3)
- (#xD1D4 #x51B1)
- (#xD1D5 #x51B2)
- (#xD1D6 #x51B0)
- (#xD1D7 #x51B5)
- (#xD1D8 #x51BD)
- (#xD1D9 #x51C5)
- (#xD1DA #x51C9)
- (#xD1DB #x51DB)
- (#xD1DC #x51E0)
- (#xD1DD #x8655)
- (#xD1DE #x51E9)
- (#xD1DF #x51ED)
- (#xD1E0 #x51F0)
- (#xD1E1 #x51F5)
- (#xD1E2 #x51FE)
- (#xD1E3 #x5204)
- (#xD1E4 #x520B)
- (#xD1E5 #x5214)
- (#xD1E6 #x520E)
- (#xD1E7 #x5227)
- (#xD1E8 #x522A)
- (#xD1E9 #x522E)
- (#xD1EA #x5233)
- (#xD1EB #x5239)
- (#xD1EC #x524F)
- (#xD1ED #x5244)
- (#xD1EE #x524B)
- (#xD1EF #x524C)
- (#xD1F0 #x525E)
- (#xD1F1 #x5254)
- (#xD1F2 #x526A)
- (#xD1F3 #x5274)
- (#xD1F4 #x5269)
- (#xD1F5 #x5273)
- (#xD1F6 #x527F)
- (#xD1F7 #x527D)
- (#xD1F8 #x528D)
- (#xD1F9 #x5294)
- (#xD1FA #x5292)
- (#xD1FB #x5271)
- (#xD1FC #x5288)
- (#xD1FD #x5291)
- (#xD1FE #x8FA8)
- (#xD2A1 #x8FA7)
- (#xD2A2 #x52AC)
- (#xD2A3 #x52AD)
- (#xD2A4 #x52BC)
- (#xD2A5 #x52B5)
- (#xD2A6 #x52C1)
- (#xD2A7 #x52CD)
- (#xD2A8 #x52D7)
- (#xD2A9 #x52DE)
- (#xD2AA #x52E3)
- (#xD2AB #x52E6)
- (#xD2AC #x98ED)
- (#xD2AD #x52E0)
- (#xD2AE #x52F3)
- (#xD2AF #x52F5)
- (#xD2B0 #x52F8)
- (#xD2B1 #x52F9)
- (#xD2B2 #x5306)
- (#xD2B3 #x5308)
- (#xD2B4 #x7538)
- (#xD2B5 #x530D)
- (#xD2B6 #x5310)
- (#xD2B7 #x530F)
- (#xD2B8 #x5315)
- (#xD2B9 #x531A)
- (#xD2BA #x5323)
- (#xD2BB #x532F)
- (#xD2BC #x5331)
- (#xD2BD #x5333)
- (#xD2BE #x5338)
- (#xD2BF #x5340)
- (#xD2C0 #x5346)
- (#xD2C1 #x5345)
- (#xD2C2 #x4E17)
- (#xD2C3 #x5349)
- (#xD2C4 #x534D)
- (#xD2C5 #x51D6)
- (#xD2C6 #x535E)
- (#xD2C7 #x5369)
- (#xD2C8 #x536E)
- (#xD2C9 #x5918)
- (#xD2CA #x537B)
- (#xD2CB #x5377)
- (#xD2CC #x5382)
- (#xD2CD #x5396)
- (#xD2CE #x53A0)
- (#xD2CF #x53A6)
- (#xD2D0 #x53A5)
- (#xD2D1 #x53AE)
- (#xD2D2 #x53B0)
- (#xD2D3 #x53B6)
- (#xD2D4 #x53C3)
- (#xD2D5 #x7C12)
- (#xD2D6 #x96D9)
- (#xD2D7 #x53DF)
- (#xD2D8 #x66FC)
- (#xD2D9 #x71EE)
- (#xD2DA #x53EE)
- (#xD2DB #x53E8)
- (#xD2DC #x53ED)
- (#xD2DD #x53FA)
- (#xD2DE #x5401)
- (#xD2DF #x543D)
- (#xD2E0 #x5440)
- (#xD2E1 #x542C)
- (#xD2E2 #x542D)
- (#xD2E3 #x543C)
- (#xD2E4 #x542E)
- (#xD2E5 #x5436)
- (#xD2E6 #x5429)
- (#xD2E7 #x541D)
- (#xD2E8 #x544E)
- (#xD2E9 #x548F)
- (#xD2EA #x5475)
- (#xD2EB #x548E)
- (#xD2EC #x545F)
- (#xD2ED #x5471)
- (#xD2EE #x5477)
- (#xD2EF #x5470)
- (#xD2F0 #x5492)
- (#xD2F1 #x547B)
- (#xD2F2 #x5480)
- (#xD2F3 #x5476)
- (#xD2F4 #x5484)
- (#xD2F5 #x5490)
- (#xD2F6 #x5486)
- (#xD2F7 #x54C7)
- (#xD2F8 #x54A2)
- (#xD2F9 #x54B8)
- (#xD2FA #x54A5)
- (#xD2FB #x54AC)
- (#xD2FC #x54C4)
- (#xD2FD #x54C8)
- (#xD2FE #x54A8)
- (#xD3A1 #x54AB)
- (#xD3A2 #x54C2)
- (#xD3A3 #x54A4)
- (#xD3A4 #x54BE)
- (#xD3A5 #x54BC)
- (#xD3A6 #x54D8)
- (#xD3A7 #x54E5)
- (#xD3A8 #x54E6)
- (#xD3A9 #x550F)
- (#xD3AA #x5514)
- (#xD3AB #x54FD)
- (#xD3AC #x54EE)
- (#xD3AD #x54ED)
- (#xD3AE #x54FA)
- (#xD3AF #x54E2)
- (#xD3B0 #x5539)
- (#xD3B1 #x5540)
- (#xD3B2 #x5563)
- (#xD3B3 #x554C)
- (#xD3B4 #x552E)
- (#xD3B5 #x555C)
- (#xD3B6 #x5545)
- (#xD3B7 #x5556)
- (#xD3B8 #x5557)
- (#xD3B9 #x5538)
- (#xD3BA #x5533)
- (#xD3BB #x555D)
- (#xD3BC #x5599)
- (#xD3BD #x5580)
- (#xD3BE #x54AF)
- (#xD3BF #x558A)
- (#xD3C0 #x559F)
- (#xD3C1 #x557B)
- (#xD3C2 #x557E)
- (#xD3C3 #x5598)
- (#xD3C4 #x559E)
- (#xD3C5 #x55AE)
- (#xD3C6 #x557C)
- (#xD3C7 #x5583)
- (#xD3C8 #x55A9)
- (#xD3C9 #x5587)
- (#xD3CA #x55A8)
- (#xD3CB #x55DA)
- (#xD3CC #x55C5)
- (#xD3CD #x55DF)
- (#xD3CE #x55C4)
- (#xD3CF #x55DC)
- (#xD3D0 #x55E4)
- (#xD3D1 #x55D4)
- (#xD3D2 #x5614)
- (#xD3D3 #x55F7)
- (#xD3D4 #x5616)
- (#xD3D5 #x55FE)
- (#xD3D6 #x55FD)
- (#xD3D7 #x561B)
- (#xD3D8 #x55F9)
- (#xD3D9 #x564E)
- (#xD3DA #x5650)
- (#xD3DB #x71DF)
- (#xD3DC #x5634)
- (#xD3DD #x5636)
- (#xD3DE #x5632)
- (#xD3DF #x5638)
- (#xD3E0 #x566B)
- (#xD3E1 #x5664)
- (#xD3E2 #x562F)
- (#xD3E3 #x566C)
- (#xD3E4 #x566A)
- (#xD3E5 #x5686)
- (#xD3E6 #x5680)
- (#xD3E7 #x568A)
- (#xD3E8 #x56A0)
- (#xD3E9 #x5694)
- (#xD3EA #x568F)
- (#xD3EB #x56A5)
- (#xD3EC #x56AE)
- (#xD3ED #x56B6)
- (#xD3EE #x56B4)
- (#xD3EF #x56C2)
- (#xD3F0 #x56BC)
- (#xD3F1 #x56C1)
- (#xD3F2 #x56C3)
- (#xD3F3 #x56C0)
- (#xD3F4 #x56C8)
- (#xD3F5 #x56CE)
- (#xD3F6 #x56D1)
- (#xD3F7 #x56D3)
- (#xD3F8 #x56D7)
- (#xD3F9 #x56EE)
- (#xD3FA #x56F9)
- (#xD3FB #x5700)
- (#xD3FC #x56FF)
- (#xD3FD #x5704)
- (#xD3FE #x5709)
- (#xD4A1 #x5708)
- (#xD4A2 #x570B)
- (#xD4A3 #x570D)
- (#xD4A4 #x5713)
- (#xD4A5 #x5718)
- (#xD4A6 #x5716)
- (#xD4A7 #x55C7)
- (#xD4A8 #x571C)
- (#xD4A9 #x5726)
- (#xD4AA #x5737)
- (#xD4AB #x5738)
- (#xD4AC #x574E)
- (#xD4AD #x573B)
- (#xD4AE #x5740)
- (#xD4AF #x574F)
- (#xD4B0 #x5769)
- (#xD4B1 #x57C0)
- (#xD4B2 #x5788)
- (#xD4B3 #x5761)
- (#xD4B4 #x577F)
- (#xD4B5 #x5789)
- (#xD4B6 #x5793)
- (#xD4B7 #x57A0)
- (#xD4B8 #x57B3)
- (#xD4B9 #x57A4)
- (#xD4BA #x57AA)
- (#xD4BB #x57B0)
- (#xD4BC #x57C3)
- (#xD4BD #x57C6)
- (#xD4BE #x57D4)
- (#xD4BF #x57D2)
- (#xD4C0 #x57D3)
- (#xD4C1 #x580A)
- (#xD4C2 #x57D6)
- (#xD4C3 #x57E3)
- (#xD4C4 #x580B)
- (#xD4C5 #x5819)
- (#xD4C6 #x581D)
- (#xD4C7 #x5872)
- (#xD4C8 #x5821)
- (#xD4C9 #x5862)
- (#xD4CA #x584B)
- (#xD4CB #x5870)
- (#xD4CC #x6BC0)
- (#xD4CD #x5852)
- (#xD4CE #x583D)
- (#xD4CF #x5879)
- (#xD4D0 #x5885)
- (#xD4D1 #x58B9)
- (#xD4D2 #x589F)
- (#xD4D3 #x58AB)
- (#xD4D4 #x58BA)
- (#xD4D5 #x58DE)
- (#xD4D6 #x58BB)
- (#xD4D7 #x58B8)
- (#xD4D8 #x58AE)
- (#xD4D9 #x58C5)
- (#xD4DA #x58D3)
- (#xD4DB #x58D1)
- (#xD4DC #x58D7)
- (#xD4DD #x58D9)
- (#xD4DE #x58D8)
- (#xD4DF #x58E5)
- (#xD4E0 #x58DC)
- (#xD4E1 #x58E4)
- (#xD4E2 #x58DF)
- (#xD4E3 #x58EF)
- (#xD4E4 #x58FA)
- (#xD4E5 #x58F9)
- (#xD4E6 #x58FB)
- (#xD4E7 #x58FC)
- (#xD4E8 #x58FD)
- (#xD4E9 #x5902)
- (#xD4EA #x590A)
- (#xD4EB #x5910)
- (#xD4EC #x591B)
- (#xD4ED #x68A6)
- (#xD4EE #x5925)
- (#xD4EF #x592C)
- (#xD4F0 #x592D)
- (#xD4F1 #x5932)
- (#xD4F2 #x5938)
- (#xD4F3 #x593E)
- (#xD4F4 #x7AD2)
- (#xD4F5 #x5955)
- (#xD4F6 #x5950)
- (#xD4F7 #x594E)
- (#xD4F8 #x595A)
- (#xD4F9 #x5958)
- (#xD4FA #x5962)
- (#xD4FB #x5960)
- (#xD4FC #x5967)
- (#xD4FD #x596C)
- (#xD4FE #x5969)
- (#xD5A1 #x5978)
- (#xD5A2 #x5981)
- (#xD5A3 #x599D)
- (#xD5A4 #x4F5E)
- (#xD5A5 #x4FAB)
- (#xD5A6 #x59A3)
- (#xD5A7 #x59B2)
- (#xD5A8 #x59C6)
- (#xD5A9 #x59E8)
- (#xD5AA #x59DC)
- (#xD5AB #x598D)
- (#xD5AC #x59D9)
- (#xD5AD #x59DA)
- (#xD5AE #x5A25)
- (#xD5AF #x5A1F)
- (#xD5B0 #x5A11)
- (#xD5B1 #x5A1C)
- (#xD5B2 #x5A09)
- (#xD5B3 #x5A1A)
- (#xD5B4 #x5A40)
- (#xD5B5 #x5A6C)
- (#xD5B6 #x5A49)
- (#xD5B7 #x5A35)
- (#xD5B8 #x5A36)
- (#xD5B9 #x5A62)
- (#xD5BA #x5A6A)
- (#xD5BB #x5A9A)
- (#xD5BC #x5ABC)
- (#xD5BD #x5ABE)
- (#xD5BE #x5ACB)
- (#xD5BF #x5AC2)
- (#xD5C0 #x5ABD)
- (#xD5C1 #x5AE3)
- (#xD5C2 #x5AD7)
- (#xD5C3 #x5AE6)
- (#xD5C4 #x5AE9)
- (#xD5C5 #x5AD6)
- (#xD5C6 #x5AFA)
- (#xD5C7 #x5AFB)
- (#xD5C8 #x5B0C)
- (#xD5C9 #x5B0B)
- (#xD5CA #x5B16)
- (#xD5CB #x5B32)
- (#xD5CC #x5AD0)
- (#xD5CD #x5B2A)
- (#xD5CE #x5B36)
- (#xD5CF #x5B3E)
- (#xD5D0 #x5B43)
- (#xD5D1 #x5B45)
- (#xD5D2 #x5B40)
- (#xD5D3 #x5B51)
- (#xD5D4 #x5B55)
- (#xD5D5 #x5B5A)
- (#xD5D6 #x5B5B)
- (#xD5D7 #x5B65)
- (#xD5D8 #x5B69)
- (#xD5D9 #x5B70)
- (#xD5DA #x5B73)
- (#xD5DB #x5B75)
- (#xD5DC #x5B78)
- (#xD5DD #x6588)
- (#xD5DE #x5B7A)
- (#xD5DF #x5B80)
- (#xD5E0 #x5B83)
- (#xD5E1 #x5BA6)
- (#xD5E2 #x5BB8)
- (#xD5E3 #x5BC3)
- (#xD5E4 #x5BC7)
- (#xD5E5 #x5BC9)
- (#xD5E6 #x5BD4)
- (#xD5E7 #x5BD0)
- (#xD5E8 #x5BE4)
- (#xD5E9 #x5BE6)
- (#xD5EA #x5BE2)
- (#xD5EB #x5BDE)
- (#xD5EC #x5BE5)
- (#xD5ED #x5BEB)
- (#xD5EE #x5BF0)
- (#xD5EF #x5BF6)
- (#xD5F0 #x5BF3)
- (#xD5F1 #x5C05)
- (#xD5F2 #x5C07)
- (#xD5F3 #x5C08)
- (#xD5F4 #x5C0D)
- (#xD5F5 #x5C13)
- (#xD5F6 #x5C20)
- (#xD5F7 #x5C22)
- (#xD5F8 #x5C28)
- (#xD5F9 #x5C38)
- (#xD5FA #x5C39)
- (#xD5FB #x5C41)
- (#xD5FC #x5C46)
- (#xD5FD #x5C4E)
- (#xD5FE #x5C53)
- (#xD6A1 #x5C50)
- (#xD6A2 #x5C4F)
- (#xD6A3 #x5B71)
- (#xD6A4 #x5C6C)
- (#xD6A5 #x5C6E)
- (#xD6A6 #x4E62)
- (#xD6A7 #x5C76)
- (#xD6A8 #x5C79)
- (#xD6A9 #x5C8C)
- (#xD6AA #x5C91)
- (#xD6AB #x5C94)
- (#xD6AC #x599B)
- (#xD6AD #x5CAB)
- (#xD6AE #x5CBB)
- (#xD6AF #x5CB6)
- (#xD6B0 #x5CBC)
- (#xD6B1 #x5CB7)
- (#xD6B2 #x5CC5)
- (#xD6B3 #x5CBE)
- (#xD6B4 #x5CC7)
- (#xD6B5 #x5CD9)
- (#xD6B6 #x5CE9)
- (#xD6B7 #x5CFD)
- (#xD6B8 #x5CFA)
- (#xD6B9 #x5CED)
- (#xD6BA #x5D8C)
- (#xD6BB #x5CEA)
- (#xD6BC #x5D0B)
- (#xD6BD #x5D15)
- (#xD6BE #x5D17)
- (#xD6BF #x5D5C)
- (#xD6C0 #x5D1F)
- (#xD6C1 #x5D1B)
- (#xD6C2 #x5D11)
- (#xD6C3 #x5D14)
- (#xD6C4 #x5D22)
- (#xD6C5 #x5D1A)
- (#xD6C6 #x5D19)
- (#xD6C7 #x5D18)
- (#xD6C8 #x5D4C)
- (#xD6C9 #x5D52)
- (#xD6CA #x5D4E)
- (#xD6CB #x5D4B)
- (#xD6CC #x5D6C)
- (#xD6CD #x5D73)
- (#xD6CE #x5D76)
- (#xD6CF #x5D87)
- (#xD6D0 #x5D84)
- (#xD6D1 #x5D82)
- (#xD6D2 #x5DA2)
- (#xD6D3 #x5D9D)
- (#xD6D4 #x5DAC)
- (#xD6D5 #x5DAE)
- (#xD6D6 #x5DBD)
- (#xD6D7 #x5D90)
- (#xD6D8 #x5DB7)
- (#xD6D9 #x5DBC)
- (#xD6DA #x5DC9)
- (#xD6DB #x5DCD)
- (#xD6DC #x5DD3)
- (#xD6DD #x5DD2)
- (#xD6DE #x5DD6)
- (#xD6DF #x5DDB)
- (#xD6E0 #x5DEB)
- (#xD6E1 #x5DF2)
- (#xD6E2 #x5DF5)
- (#xD6E3 #x5E0B)
- (#xD6E4 #x5E1A)
- (#xD6E5 #x5E19)
- (#xD6E6 #x5E11)
- (#xD6E7 #x5E1B)
- (#xD6E8 #x5E36)
- (#xD6E9 #x5E37)
- (#xD6EA #x5E44)
- (#xD6EB #x5E43)
- (#xD6EC #x5E40)
- (#xD6ED #x5E4E)
- (#xD6EE #x5E57)
- (#xD6EF #x5E54)
- (#xD6F0 #x5E5F)
- (#xD6F1 #x5E62)
- (#xD6F2 #x5E64)
- (#xD6F3 #x5E47)
- (#xD6F4 #x5E75)
- (#xD6F5 #x5E76)
- (#xD6F6 #x5E7A)
- (#xD6F7 #x9EBC)
- (#xD6F8 #x5E7F)
- (#xD6F9 #x5EA0)
- (#xD6FA #x5EC1)
- (#xD6FB #x5EC2)
- (#xD6FC #x5EC8)
- (#xD6FD #x5ED0)
- (#xD6FE #x5ECF)
- (#xD7A1 #x5ED6)
- (#xD7A2 #x5EE3)
- (#xD7A3 #x5EDD)
- (#xD7A4 #x5EDA)
- (#xD7A5 #x5EDB)
- (#xD7A6 #x5EE2)
- (#xD7A7 #x5EE1)
- (#xD7A8 #x5EE8)
- (#xD7A9 #x5EE9)
- (#xD7AA #x5EEC)
- (#xD7AB #x5EF1)
- (#xD7AC #x5EF3)
- (#xD7AD #x5EF0)
- (#xD7AE #x5EF4)
- (#xD7AF #x5EF8)
- (#xD7B0 #x5EFE)
- (#xD7B1 #x5F03)
- (#xD7B2 #x5F09)
- (#xD7B3 #x5F5D)
- (#xD7B4 #x5F5C)
- (#xD7B5 #x5F0B)
- (#xD7B6 #x5F11)
- (#xD7B7 #x5F16)
- (#xD7B8 #x5F29)
- (#xD7B9 #x5F2D)
- (#xD7BA #x5F38)
- (#xD7BB #x5F41)
- (#xD7BC #x5F48)
- (#xD7BD #x5F4C)
- (#xD7BE #x5F4E)
- (#xD7BF #x5F2F)
- (#xD7C0 #x5F51)
- (#xD7C1 #x5F56)
- (#xD7C2 #x5F57)
- (#xD7C3 #x5F59)
- (#xD7C4 #x5F61)
- (#xD7C5 #x5F6D)
- (#xD7C6 #x5F73)
- (#xD7C7 #x5F77)
- (#xD7C8 #x5F83)
- (#xD7C9 #x5F82)
- (#xD7CA #x5F7F)
- (#xD7CB #x5F8A)
- (#xD7CC #x5F88)
- (#xD7CD #x5F91)
- (#xD7CE #x5F87)
- (#xD7CF #x5F9E)
- (#xD7D0 #x5F99)
- (#xD7D1 #x5F98)
- (#xD7D2 #x5FA0)
- (#xD7D3 #x5FA8)
- (#xD7D4 #x5FAD)
- (#xD7D5 #x5FBC)
- (#xD7D6 #x5FD6)
- (#xD7D7 #x5FFB)
- (#xD7D8 #x5FE4)
- (#xD7D9 #x5FF8)
- (#xD7DA #x5FF1)
- (#xD7DB #x5FDD)
- (#xD7DC #x60B3)
- (#xD7DD #x5FFF)
- (#xD7DE #x6021)
- (#xD7DF #x6060)
- (#xD7E0 #x6019)
- (#xD7E1 #x6010)
- (#xD7E2 #x6029)
- (#xD7E3 #x600E)
- (#xD7E4 #x6031)
- (#xD7E5 #x601B)
- (#xD7E6 #x6015)
- (#xD7E7 #x602B)
- (#xD7E8 #x6026)
- (#xD7E9 #x600F)
- (#xD7EA #x603A)
- (#xD7EB #x605A)
- (#xD7EC #x6041)
- (#xD7ED #x606A)
- (#xD7EE #x6077)
- (#xD7EF #x605F)
- (#xD7F0 #x604A)
- (#xD7F1 #x6046)
- (#xD7F2 #x604D)
- (#xD7F3 #x6063)
- (#xD7F4 #x6043)
- (#xD7F5 #x6064)
- (#xD7F6 #x6042)
- (#xD7F7 #x606C)
- (#xD7F8 #x606B)
- (#xD7F9 #x6059)
- (#xD7FA #x6081)
- (#xD7FB #x608D)
- (#xD7FC #x60E7)
- (#xD7FD #x6083)
- (#xD7FE #x609A)
- (#xD8A1 #x6084)
- (#xD8A2 #x609B)
- (#xD8A3 #x6096)
- (#xD8A4 #x6097)
- (#xD8A5 #x6092)
- (#xD8A6 #x60A7)
- (#xD8A7 #x608B)
- (#xD8A8 #x60E1)
- (#xD8A9 #x60B8)
- (#xD8AA #x60E0)
- (#xD8AB #x60D3)
- (#xD8AC #x60B4)
- (#xD8AD #x5FF0)
- (#xD8AE #x60BD)
- (#xD8AF #x60C6)
- (#xD8B0 #x60B5)
- (#xD8B1 #x60D8)
- (#xD8B2 #x614D)
- (#xD8B3 #x6115)
- (#xD8B4 #x6106)
- (#xD8B5 #x60F6)
- (#xD8B6 #x60F7)
- (#xD8B7 #x6100)
- (#xD8B8 #x60F4)
- (#xD8B9 #x60FA)
- (#xD8BA #x6103)
- (#xD8BB #x6121)
- (#xD8BC #x60FB)
- (#xD8BD #x60F1)
- (#xD8BE #x610D)
- (#xD8BF #x610E)
- (#xD8C0 #x6147)
- (#xD8C1 #x613E)
- (#xD8C2 #x6128)
- (#xD8C3 #x6127)
- (#xD8C4 #x614A)
- (#xD8C5 #x613F)
- (#xD8C6 #x613C)
- (#xD8C7 #x612C)
- (#xD8C8 #x6134)
- (#xD8C9 #x613D)
- (#xD8CA #x6142)
- (#xD8CB #x6144)
- (#xD8CC #x6173)
- (#xD8CD #x6177)
- (#xD8CE #x6158)
- (#xD8CF #x6159)
- (#xD8D0 #x615A)
- (#xD8D1 #x616B)
- (#xD8D2 #x6174)
- (#xD8D3 #x616F)
- (#xD8D4 #x6165)
- (#xD8D5 #x6171)
- (#xD8D6 #x615F)
- (#xD8D7 #x615D)
- (#xD8D8 #x6153)
- (#xD8D9 #x6175)
- (#xD8DA #x6199)
- (#xD8DB #x6196)
- (#xD8DC #x6187)
- (#xD8DD #x61AC)
- (#xD8DE #x6194)
- (#xD8DF #x619A)
- (#xD8E0 #x618A)
- (#xD8E1 #x6191)
- (#xD8E2 #x61AB)
- (#xD8E3 #x61AE)
- (#xD8E4 #x61CC)
- (#xD8E5 #x61CA)
- (#xD8E6 #x61C9)
- (#xD8E7 #x61F7)
- (#xD8E8 #x61C8)
- (#xD8E9 #x61C3)
- (#xD8EA #x61C6)
- (#xD8EB #x61BA)
- (#xD8EC #x61CB)
- (#xD8ED #x7F79)
- (#xD8EE #x61CD)
- (#xD8EF #x61E6)
- (#xD8F0 #x61E3)
- (#xD8F1 #x61F6)
- (#xD8F2 #x61FA)
- (#xD8F3 #x61F4)
- (#xD8F4 #x61FF)
- (#xD8F5 #x61FD)
- (#xD8F6 #x61FC)
- (#xD8F7 #x61FE)
- (#xD8F8 #x6200)
- (#xD8F9 #x6208)
- (#xD8FA #x6209)
- (#xD8FB #x620D)
- (#xD8FC #x620C)
- (#xD8FD #x6214)
- (#xD8FE #x621B)
- (#xD9A1 #x621E)
- (#xD9A2 #x6221)
- (#xD9A3 #x622A)
- (#xD9A4 #x622E)
- (#xD9A5 #x6230)
- (#xD9A6 #x6232)
- (#xD9A7 #x6233)
- (#xD9A8 #x6241)
- (#xD9A9 #x624E)
- (#xD9AA #x625E)
- (#xD9AB #x6263)
- (#xD9AC #x625B)
- (#xD9AD #x6260)
- (#xD9AE #x6268)
- (#xD9AF #x627C)
- (#xD9B0 #x6282)
- (#xD9B1 #x6289)
- (#xD9B2 #x627E)
- (#xD9B3 #x6292)
- (#xD9B4 #x6293)
- (#xD9B5 #x6296)
- (#xD9B6 #x62D4)
- (#xD9B7 #x6283)
- (#xD9B8 #x6294)
- (#xD9B9 #x62D7)
- (#xD9BA #x62D1)
- (#xD9BB #x62BB)
- (#xD9BC #x62CF)
- (#xD9BD #x62FF)
- (#xD9BE #x62C6)
- (#xD9BF #x64D4)
- (#xD9C0 #x62C8)
- (#xD9C1 #x62DC)
- (#xD9C2 #x62CC)
- (#xD9C3 #x62CA)
- (#xD9C4 #x62C2)
- (#xD9C5 #x62C7)
- (#xD9C6 #x629B)
- (#xD9C7 #x62C9)
- (#xD9C8 #x630C)
- (#xD9C9 #x62EE)
- (#xD9CA #x62F1)
- (#xD9CB #x6327)
- (#xD9CC #x6302)
- (#xD9CD #x6308)
- (#xD9CE #x62EF)
- (#xD9CF #x62F5)
- (#xD9D0 #x6350)
- (#xD9D1 #x633E)
- (#xD9D2 #x634D)
- (#xD9D3 #x641C)
- (#xD9D4 #x634F)
- (#xD9D5 #x6396)
- (#xD9D6 #x638E)
- (#xD9D7 #x6380)
- (#xD9D8 #x63AB)
- (#xD9D9 #x6376)
- (#xD9DA #x63A3)
- (#xD9DB #x638F)
- (#xD9DC #x6389)
- (#xD9DD #x639F)
- (#xD9DE #x63B5)
- (#xD9DF #x636B)
- (#xD9E0 #x6369)
- (#xD9E1 #x63BE)
- (#xD9E2 #x63E9)
- (#xD9E3 #x63C0)
- (#xD9E4 #x63C6)
- (#xD9E5 #x63E3)
- (#xD9E6 #x63C9)
- (#xD9E7 #x63D2)
- (#xD9E8 #x63F6)
- (#xD9E9 #x63C4)
- (#xD9EA #x6416)
- (#xD9EB #x6434)
- (#xD9EC #x6406)
- (#xD9ED #x6413)
- (#xD9EE #x6426)
- (#xD9EF #x6436)
- (#xD9F0 #x651D)
- (#xD9F1 #x6417)
- (#xD9F2 #x6428)
- (#xD9F3 #x640F)
- (#xD9F4 #x6467)
- (#xD9F5 #x646F)
- (#xD9F6 #x6476)
- (#xD9F7 #x644E)
- (#xD9F8 #x652A)
- (#xD9F9 #x6495)
- (#xD9FA #x6493)
- (#xD9FB #x64A5)
- (#xD9FC #x64A9)
- (#xD9FD #x6488)
- (#xD9FE #x64BC)
- (#xDAA1 #x64DA)
- (#xDAA2 #x64D2)
- (#xDAA3 #x64C5)
- (#xDAA4 #x64C7)
- (#xDAA5 #x64BB)
- (#xDAA6 #x64D8)
- (#xDAA7 #x64C2)
- (#xDAA8 #x64F1)
- (#xDAA9 #x64E7)
- (#xDAAA #x8209)
- (#xDAAB #x64E0)
- (#xDAAC #x64E1)
- (#xDAAD #x62AC)
- (#xDAAE #x64E3)
- (#xDAAF #x64EF)
- (#xDAB0 #x652C)
- (#xDAB1 #x64F6)
- (#xDAB2 #x64F4)
- (#xDAB3 #x64F2)
- (#xDAB4 #x64FA)
- (#xDAB5 #x6500)
- (#xDAB6 #x64FD)
- (#xDAB7 #x6518)
- (#xDAB8 #x651C)
- (#xDAB9 #x6505)
- (#xDABA #x6524)
- (#xDABB #x6523)
- (#xDABC #x652B)
- (#xDABD #x6534)
- (#xDABE #x6535)
- (#xDABF #x6537)
- (#xDAC0 #x6536)
- (#xDAC1 #x6538)
- (#xDAC2 #x754B)
- (#xDAC3 #x6548)
- (#xDAC4 #x6556)
- (#xDAC5 #x6555)
- (#xDAC6 #x654D)
- (#xDAC7 #x6558)
- (#xDAC8 #x655E)
- (#xDAC9 #x655D)
- (#xDACA #x6572)
- (#xDACB #x6578)
- (#xDACC #x6582)
- (#xDACD #x6583)
- (#xDACE #x8B8A)
- (#xDACF #x659B)
- (#xDAD0 #x659F)
- (#xDAD1 #x65AB)
- (#xDAD2 #x65B7)
- (#xDAD3 #x65C3)
- (#xDAD4 #x65C6)
- (#xDAD5 #x65C1)
- (#xDAD6 #x65C4)
- (#xDAD7 #x65CC)
- (#xDAD8 #x65D2)
- (#xDAD9 #x65DB)
- (#xDADA #x65D9)
- (#xDADB #x65E0)
- (#xDADC #x65E1)
- (#xDADD #x65F1)
- (#xDADE #x6772)
- (#xDADF #x660A)
- (#xDAE0 #x6603)
- (#xDAE1 #x65FB)
- (#xDAE2 #x6773)
- (#xDAE3 #x6635)
- (#xDAE4 #x6636)
- (#xDAE5 #x6634)
- (#xDAE6 #x661C)
- (#xDAE7 #x664F)
- (#xDAE8 #x6644)
- (#xDAE9 #x6649)
- (#xDAEA #x6641)
- (#xDAEB #x665E)
- (#xDAEC #x665D)
- (#xDAED #x6664)
- (#xDAEE #x6667)
- (#xDAEF #x6668)
- (#xDAF0 #x665F)
- (#xDAF1 #x6662)
- (#xDAF2 #x6670)
- (#xDAF3 #x6683)
- (#xDAF4 #x6688)
- (#xDAF5 #x668E)
- (#xDAF6 #x6689)
- (#xDAF7 #x6684)
- (#xDAF8 #x6698)
- (#xDAF9 #x669D)
- (#xDAFA #x66C1)
- (#xDAFB #x66B9)
- (#xDAFC #x66C9)
- (#xDAFD #x66BE)
- (#xDAFE #x66BC)
- (#xDBA1 #x66C4)
- (#xDBA2 #x66B8)
- (#xDBA3 #x66D6)
- (#xDBA4 #x66DA)
- (#xDBA5 #x66E0)
- (#xDBA6 #x663F)
- (#xDBA7 #x66E6)
- (#xDBA8 #x66E9)
- (#xDBA9 #x66F0)
- (#xDBAA #x66F5)
- (#xDBAB #x66F7)
- (#xDBAC #x670F)
- (#xDBAD #x6716)
- (#xDBAE #x671E)
- (#xDBAF #x6726)
- (#xDBB0 #x6727)
- (#xDBB1 #x9738)
- (#xDBB2 #x672E)
- (#xDBB3 #x673F)
- (#xDBB4 #x6736)
- (#xDBB5 #x6741)
- (#xDBB6 #x6738)
- (#xDBB7 #x6737)
- (#xDBB8 #x6746)
- (#xDBB9 #x675E)
- (#xDBBA #x6760)
- (#xDBBB #x6759)
- (#xDBBC #x6763)
- (#xDBBD #x6764)
- (#xDBBE #x6789)
- (#xDBBF #x6770)
- (#xDBC0 #x67A9)
- (#xDBC1 #x677C)
- (#xDBC2 #x676A)
- (#xDBC3 #x678C)
- (#xDBC4 #x678B)
- (#xDBC5 #x67A6)
- (#xDBC6 #x67A1)
- (#xDBC7 #x6785)
- (#xDBC8 #x67B7)
- (#xDBC9 #x67EF)
- (#xDBCA #x67B4)
- (#xDBCB #x67EC)
- (#xDBCC #x67B3)
- (#xDBCD #x67E9)
- (#xDBCE #x67B8)
- (#xDBCF #x67E4)
- (#xDBD0 #x67DE)
- (#xDBD1 #x67DD)
- (#xDBD2 #x67E2)
- (#xDBD3 #x67EE)
- (#xDBD4 #x67B9)
- (#xDBD5 #x67CE)
- (#xDBD6 #x67C6)
- (#xDBD7 #x67E7)
- (#xDBD8 #x6A9C)
- (#xDBD9 #x681E)
- (#xDBDA #x6846)
- (#xDBDB #x6829)
- (#xDBDC #x6840)
- (#xDBDD #x684D)
- (#xDBDE #x6832)
- (#xDBDF #x684E)
- (#xDBE0 #x68B3)
- (#xDBE1 #x682B)
- (#xDBE2 #x6859)
- (#xDBE3 #x6863)
- (#xDBE4 #x6877)
- (#xDBE5 #x687F)
- (#xDBE6 #x689F)
- (#xDBE7 #x688F)
- (#xDBE8 #x68AD)
- (#xDBE9 #x6894)
- (#xDBEA #x689D)
- (#xDBEB #x689B)
- (#xDBEC #x6883)
- (#xDBED #x6AAE)
- (#xDBEE #x68B9)
- (#xDBEF #x6874)
- (#xDBF0 #x68B5)
- (#xDBF1 #x68A0)
- (#xDBF2 #x68BA)
- (#xDBF3 #x690F)
- (#xDBF4 #x688D)
- (#xDBF5 #x687E)
- (#xDBF6 #x6901)
- (#xDBF7 #x68CA)
- (#xDBF8 #x6908)
- (#xDBF9 #x68D8)
- (#xDBFA #x6922)
- (#xDBFB #x6926)
- (#xDBFC #x68E1)
- (#xDBFD #x690C)
- (#xDBFE #x68CD)
- (#xDCA1 #x68D4)
- (#xDCA2 #x68E7)
- (#xDCA3 #x68D5)
- (#xDCA4 #x6936)
- (#xDCA5 #x6912)
- (#xDCA6 #x6904)
- (#xDCA7 #x68D7)
- (#xDCA8 #x68E3)
- (#xDCA9 #x6925)
- (#xDCAA #x68F9)
- (#xDCAB #x68E0)
- (#xDCAC #x68EF)
- (#xDCAD #x6928)
- (#xDCAE #x692A)
- (#xDCAF #x691A)
- (#xDCB0 #x6923)
- (#xDCB1 #x6921)
- (#xDCB2 #x68C6)
- (#xDCB3 #x6979)
- (#xDCB4 #x6977)
- (#xDCB5 #x695C)
- (#xDCB6 #x6978)
- (#xDCB7 #x696B)
- (#xDCB8 #x6954)
- (#xDCB9 #x697E)
- (#xDCBA #x696E)
- (#xDCBB #x6939)
- (#xDCBC #x6974)
- (#xDCBD #x693D)
- (#xDCBE #x6959)
- (#xDCBF #x6930)
- (#xDCC0 #x6961)
- (#xDCC1 #x695E)
- (#xDCC2 #x695D)
- (#xDCC3 #x6981)
- (#xDCC4 #x696A)
- (#xDCC5 #x69B2)
- (#xDCC6 #x69AE)
- (#xDCC7 #x69D0)
- (#xDCC8 #x69BF)
- (#xDCC9 #x69C1)
- (#xDCCA #x69D3)
- (#xDCCB #x69BE)
- (#xDCCC #x69CE)
- (#xDCCD #x5BE8)
- (#xDCCE #x69CA)
- (#xDCCF #x69DD)
- (#xDCD0 #x69BB)
- (#xDCD1 #x69C3)
- (#xDCD2 #x69A7)
- (#xDCD3 #x6A2E)
- (#xDCD4 #x6991)
- (#xDCD5 #x69A0)
- (#xDCD6 #x699C)
- (#xDCD7 #x6995)
- (#xDCD8 #x69B4)
- (#xDCD9 #x69DE)
- (#xDCDA #x69E8)
- (#xDCDB #x6A02)
- (#xDCDC #x6A1B)
- (#xDCDD #x69FF)
- (#xDCDE #x6B0A)
- (#xDCDF #x69F9)
- (#xDCE0 #x69F2)
- (#xDCE1 #x69E7)
- (#xDCE2 #x6A05)
- (#xDCE3 #x69B1)
- (#xDCE4 #x6A1E)
- (#xDCE5 #x69ED)
- (#xDCE6 #x6A14)
- (#xDCE7 #x69EB)
- (#xDCE8 #x6A0A)
- (#xDCE9 #x6A12)
- (#xDCEA #x6AC1)
- (#xDCEB #x6A23)
- (#xDCEC #x6A13)
- (#xDCED #x6A44)
- (#xDCEE #x6A0C)
- (#xDCEF #x6A72)
- (#xDCF0 #x6A36)
- (#xDCF1 #x6A78)
- (#xDCF2 #x6A47)
- (#xDCF3 #x6A62)
- (#xDCF4 #x6A59)
- (#xDCF5 #x6A66)
- (#xDCF6 #x6A48)
- (#xDCF7 #x6A38)
- (#xDCF8 #x6A22)
- (#xDCF9 #x6A90)
- (#xDCFA #x6A8D)
- (#xDCFB #x6AA0)
- (#xDCFC #x6A84)
- (#xDCFD #x6AA2)
- (#xDCFE #x6AA3)
- (#xDDA1 #x6A97)
- (#xDDA2 #x8617)
- (#xDDA3 #x6ABB)
- (#xDDA4 #x6AC3)
- (#xDDA5 #x6AC2)
- (#xDDA6 #x6AB8)
- (#xDDA7 #x6AB3)
- (#xDDA8 #x6AAC)
- (#xDDA9 #x6ADE)
- (#xDDAA #x6AD1)
- (#xDDAB #x6ADF)
- (#xDDAC #x6AAA)
- (#xDDAD #x6ADA)
- (#xDDAE #x6AEA)
- (#xDDAF #x6AFB)
- (#xDDB0 #x6B05)
- (#xDDB1 #x8616)
- (#xDDB2 #x6AFA)
- (#xDDB3 #x6B12)
- (#xDDB4 #x6B16)
- (#xDDB5 #x9B31)
- (#xDDB6 #x6B1F)
- (#xDDB7 #x6B38)
- (#xDDB8 #x6B37)
- (#xDDB9 #x76DC)
- (#xDDBA #x6B39)
- (#xDDBB #x98EE)
- (#xDDBC #x6B47)
- (#xDDBD #x6B43)
- (#xDDBE #x6B49)
- (#xDDBF #x6B50)
- (#xDDC0 #x6B59)
- (#xDDC1 #x6B54)
- (#xDDC2 #x6B5B)
- (#xDDC3 #x6B5F)
- (#xDDC4 #x6B61)
- (#xDDC5 #x6B78)
- (#xDDC6 #x6B79)
- (#xDDC7 #x6B7F)
- (#xDDC8 #x6B80)
- (#xDDC9 #x6B84)
- (#xDDCA #x6B83)
- (#xDDCB #x6B8D)
- (#xDDCC #x6B98)
- (#xDDCD #x6B95)
- (#xDDCE #x6B9E)
- (#xDDCF #x6BA4)
- (#xDDD0 #x6BAA)
- (#xDDD1 #x6BAB)
- (#xDDD2 #x6BAF)
- (#xDDD3 #x6BB2)
- (#xDDD4 #x6BB1)
- (#xDDD5 #x6BB3)
- (#xDDD6 #x6BB7)
- (#xDDD7 #x6BBC)
- (#xDDD8 #x6BC6)
- (#xDDD9 #x6BCB)
- (#xDDDA #x6BD3)
- (#xDDDB #x6BDF)
- (#xDDDC #x6BEC)
- (#xDDDD #x6BEB)
- (#xDDDE #x6BF3)
- (#xDDDF #x6BEF)
- (#xDDE0 #x9EBE)
- (#xDDE1 #x6C08)
- (#xDDE2 #x6C13)
- (#xDDE3 #x6C14)
- (#xDDE4 #x6C1B)
- (#xDDE5 #x6C24)
- (#xDDE6 #x6C23)
- (#xDDE7 #x6C5E)
- (#xDDE8 #x6C55)
- (#xDDE9 #x6C62)
- (#xDDEA #x6C6A)
- (#xDDEB #x6C82)
- (#xDDEC #x6C8D)
- (#xDDED #x6C9A)
- (#xDDEE #x6C81)
- (#xDDEF #x6C9B)
- (#xDDF0 #x6C7E)
- (#xDDF1 #x6C68)
- (#xDDF2 #x6C73)
- (#xDDF3 #x6C92)
- (#xDDF4 #x6C90)
- (#xDDF5 #x6CC4)
- (#xDDF6 #x6CF1)
- (#xDDF7 #x6CD3)
- (#xDDF8 #x6CBD)
- (#xDDF9 #x6CD7)
- (#xDDFA #x6CC5)
- (#xDDFB #x6CDD)
- (#xDDFC #x6CAE)
- (#xDDFD #x6CB1)
- (#xDDFE #x6CBE)
- (#xDEA1 #x6CBA)
- (#xDEA2 #x6CDB)
- (#xDEA3 #x6CEF)
- (#xDEA4 #x6CD9)
- (#xDEA5 #x6CEA)
- (#xDEA6 #x6D1F)
- (#xDEA7 #x884D)
- (#xDEA8 #x6D36)
- (#xDEA9 #x6D2B)
- (#xDEAA #x6D3D)
- (#xDEAB #x6D38)
- (#xDEAC #x6D19)
- (#xDEAD #x6D35)
- (#xDEAE #x6D33)
- (#xDEAF #x6D12)
- (#xDEB0 #x6D0C)
- (#xDEB1 #x6D63)
- (#xDEB2 #x6D93)
- (#xDEB3 #x6D64)
- (#xDEB4 #x6D5A)
- (#xDEB5 #x6D79)
- (#xDEB6 #x6D59)
- (#xDEB7 #x6D8E)
- (#xDEB8 #x6D95)
- (#xDEB9 #x6FE4)
- (#xDEBA #x6D85)
- (#xDEBB #x6DF9)
- (#xDEBC #x6E15)
- (#xDEBD #x6E0A)
- (#xDEBE #x6DB5)
- (#xDEBF #x6DC7)
- (#xDEC0 #x6DE6)
- (#xDEC1 #x6DB8)
- (#xDEC2 #x6DC6)
- (#xDEC3 #x6DEC)
- (#xDEC4 #x6DDE)
- (#xDEC5 #x6DCC)
- (#xDEC6 #x6DE8)
- (#xDEC7 #x6DD2)
- (#xDEC8 #x6DC5)
- (#xDEC9 #x6DFA)
- (#xDECA #x6DD9)
- (#xDECB #x6DE4)
- (#xDECC #x6DD5)
- (#xDECD #x6DEA)
- (#xDECE #x6DEE)
- (#xDECF #x6E2D)
- (#xDED0 #x6E6E)
- (#xDED1 #x6E2E)
- (#xDED2 #x6E19)
- (#xDED3 #x6E72)
- (#xDED4 #x6E5F)
- (#xDED5 #x6E3E)
- (#xDED6 #x6E23)
- (#xDED7 #x6E6B)
- (#xDED8 #x6E2B)
- (#xDED9 #x6E76)
- (#xDEDA #x6E4D)
- (#xDEDB #x6E1F)
- (#xDEDC #x6E43)
- (#xDEDD #x6E3A)
- (#xDEDE #x6E4E)
- (#xDEDF #x6E24)
- (#xDEE0 #x6EFF)
- (#xDEE1 #x6E1D)
- (#xDEE2 #x6E38)
- (#xDEE3 #x6E82)
- (#xDEE4 #x6EAA)
- (#xDEE5 #x6E98)
- (#xDEE6 #x6EC9)
- (#xDEE7 #x6EB7)
- (#xDEE8 #x6ED3)
- (#xDEE9 #x6EBD)
- (#xDEEA #x6EAF)
- (#xDEEB #x6EC4)
- (#xDEEC #x6EB2)
- (#xDEED #x6ED4)
- (#xDEEE #x6ED5)
- (#xDEEF #x6E8F)
- (#xDEF0 #x6EA5)
- (#xDEF1 #x6EC2)
- (#xDEF2 #x6E9F)
- (#xDEF3 #x6F41)
- (#xDEF4 #x6F11)
- (#xDEF5 #x704C)
- (#xDEF6 #x6EEC)
- (#xDEF7 #x6EF8)
- (#xDEF8 #x6EFE)
- (#xDEF9 #x6F3F)
- (#xDEFA #x6EF2)
- (#xDEFB #x6F31)
- (#xDEFC #x6EEF)
- (#xDEFD #x6F32)
- (#xDEFE #x6ECC)
- (#xDFA1 #x6F3E)
- (#xDFA2 #x6F13)
- (#xDFA3 #x6EF7)
- (#xDFA4 #x6F86)
- (#xDFA5 #x6F7A)
- (#xDFA6 #x6F78)
- (#xDFA7 #x6F81)
- (#xDFA8 #x6F80)
- (#xDFA9 #x6F6F)
- (#xDFAA #x6F5B)
- (#xDFAB #x6FF3)
- (#xDFAC #x6F6D)
- (#xDFAD #x6F82)
- (#xDFAE #x6F7C)
- (#xDFAF #x6F58)
- (#xDFB0 #x6F8E)
- (#xDFB1 #x6F91)
- (#xDFB2 #x6FC2)
- (#xDFB3 #x6F66)
- (#xDFB4 #x6FB3)
- (#xDFB5 #x6FA3)
- (#xDFB6 #x6FA1)
- (#xDFB7 #x6FA4)
- (#xDFB8 #x6FB9)
- (#xDFB9 #x6FC6)
- (#xDFBA #x6FAA)
- (#xDFBB #x6FDF)
- (#xDFBC #x6FD5)
- (#xDFBD #x6FEC)
- (#xDFBE #x6FD4)
- (#xDFBF #x6FD8)
- (#xDFC0 #x6FF1)
- (#xDFC1 #x6FEE)
- (#xDFC2 #x6FDB)
- (#xDFC3 #x7009)
- (#xDFC4 #x700B)
- (#xDFC5 #x6FFA)
- (#xDFC6 #x7011)
- (#xDFC7 #x7001)
- (#xDFC8 #x700F)
- (#xDFC9 #x6FFE)
- (#xDFCA #x701B)
- (#xDFCB #x701A)
- (#xDFCC #x6F74)
- (#xDFCD #x701D)
- (#xDFCE #x7018)
- (#xDFCF #x701F)
- (#xDFD0 #x7030)
- (#xDFD1 #x703E)
- (#xDFD2 #x7032)
- (#xDFD3 #x7051)
- (#xDFD4 #x7063)
- (#xDFD5 #x7099)
- (#xDFD6 #x7092)
- (#xDFD7 #x70AF)
- (#xDFD8 #x70F1)
- (#xDFD9 #x70AC)
- (#xDFDA #x70B8)
- (#xDFDB #x70B3)
- (#xDFDC #x70AE)
- (#xDFDD #x70DF)
- (#xDFDE #x70CB)
- (#xDFDF #x70DD)
- (#xDFE0 #x70D9)
- (#xDFE1 #x7109)
- (#xDFE2 #x70FD)
- (#xDFE3 #x711C)
- (#xDFE4 #x7119)
- (#xDFE5 #x7165)
- (#xDFE6 #x7155)
- (#xDFE7 #x7188)
- (#xDFE8 #x7166)
- (#xDFE9 #x7162)
- (#xDFEA #x714C)
- (#xDFEB #x7156)
- (#xDFEC #x716C)
- (#xDFED #x718F)
- (#xDFEE #x71FB)
- (#xDFEF #x7184)
- (#xDFF0 #x7195)
- (#xDFF1 #x71A8)
- (#xDFF2 #x71AC)
- (#xDFF3 #x71D7)
- (#xDFF4 #x71B9)
- (#xDFF5 #x71BE)
- (#xDFF6 #x71D2)
- (#xDFF7 #x71C9)
- (#xDFF8 #x71D4)
- (#xDFF9 #x71CE)
- (#xDFFA #x71E0)
- (#xDFFB #x71EC)
- (#xDFFC #x71E7)
- (#xDFFD #x71F5)
- (#xDFFE #x71FC)
- (#xE0A1 #x71F9)
- (#xE0A2 #x71FF)
- (#xE0A3 #x720D)
- (#xE0A4 #x7210)
- (#xE0A5 #x721B)
- (#xE0A6 #x7228)
- (#xE0A7 #x722D)
- (#xE0A8 #x722C)
- (#xE0A9 #x7230)
- (#xE0AA #x7232)
- (#xE0AB #x723B)
- (#xE0AC #x723C)
- (#xE0AD #x723F)
- (#xE0AE #x7240)
- (#xE0AF #x7246)
- (#xE0B0 #x724B)
- (#xE0B1 #x7258)
- (#xE0B2 #x7274)
- (#xE0B3 #x727E)
- (#xE0B4 #x7282)
- (#xE0B5 #x7281)
- (#xE0B6 #x7287)
- (#xE0B7 #x7292)
- (#xE0B8 #x7296)
- (#xE0B9 #x72A2)
- (#xE0BA #x72A7)
- (#xE0BB #x72B9)
- (#xE0BC #x72B2)
- (#xE0BD #x72C3)
- (#xE0BE #x72C6)
- (#xE0BF #x72C4)
- (#xE0C0 #x72CE)
- (#xE0C1 #x72D2)
- (#xE0C2 #x72E2)
- (#xE0C3 #x72E0)
- (#xE0C4 #x72E1)
- (#xE0C5 #x72F9)
- (#xE0C6 #x72F7)
- (#xE0C7 #x500F)
- (#xE0C8 #x7317)
- (#xE0C9 #x730A)
- (#xE0CA #x731C)
- (#xE0CB #x7316)
- (#xE0CC #x731D)
- (#xE0CD #x7334)
- (#xE0CE #x732F)
- (#xE0CF #x7329)
- (#xE0D0 #x7325)
- (#xE0D1 #x733E)
- (#xE0D2 #x734E)
- (#xE0D3 #x734F)
- (#xE0D4 #x9ED8)
- (#xE0D5 #x7357)
- (#xE0D6 #x736A)
- (#xE0D7 #x7368)
- (#xE0D8 #x7370)
- (#xE0D9 #x7378)
- (#xE0DA #x7375)
- (#xE0DB #x737B)
- (#xE0DC #x737A)
- (#xE0DD #x73C8)
- (#xE0DE #x73B3)
- (#xE0DF #x73CE)
- (#xE0E0 #x73BB)
- (#xE0E1 #x73C0)
- (#xE0E2 #x73E5)
- (#xE0E3 #x73EE)
- (#xE0E4 #x73DE)
- (#xE0E5 #x74A2)
- (#xE0E6 #x7405)
- (#xE0E7 #x746F)
- (#xE0E8 #x7425)
- (#xE0E9 #x73F8)
- (#xE0EA #x7432)
- (#xE0EB #x743A)
- (#xE0EC #x7455)
- (#xE0ED #x743F)
- (#xE0EE #x745F)
- (#xE0EF #x7459)
- (#xE0F0 #x7441)
- (#xE0F1 #x745C)
- (#xE0F2 #x7469)
- (#xE0F3 #x7470)
- (#xE0F4 #x7463)
- (#xE0F5 #x746A)
- (#xE0F6 #x7476)
- (#xE0F7 #x747E)
- (#xE0F8 #x748B)
- (#xE0F9 #x749E)
- (#xE0FA #x74A7)
- (#xE0FB #x74CA)
- (#xE0FC #x74CF)
- (#xE0FD #x74D4)
- (#xE0FE #x73F1)
- (#xE1A1 #x74E0)
- (#xE1A2 #x74E3)
- (#xE1A3 #x74E7)
- (#xE1A4 #x74E9)
- (#xE1A5 #x74EE)
- (#xE1A6 #x74F2)
- (#xE1A7 #x74F0)
- (#xE1A8 #x74F1)
- (#xE1A9 #x74F8)
- (#xE1AA #x74F7)
- (#xE1AB #x7504)
- (#xE1AC #x7503)
- (#xE1AD #x7505)
- (#xE1AE #x750C)
- (#xE1AF #x750E)
- (#xE1B0 #x750D)
- (#xE1B1 #x7515)
- (#xE1B2 #x7513)
- (#xE1B3 #x751E)
- (#xE1B4 #x7526)
- (#xE1B5 #x752C)
- (#xE1B6 #x753C)
- (#xE1B7 #x7544)
- (#xE1B8 #x754D)
- (#xE1B9 #x754A)
- (#xE1BA #x7549)
- (#xE1BB #x755B)
- (#xE1BC #x7546)
- (#xE1BD #x755A)
- (#xE1BE #x7569)
- (#xE1BF #x7564)
- (#xE1C0 #x7567)
- (#xE1C1 #x756B)
- (#xE1C2 #x756D)
- (#xE1C3 #x7578)
- (#xE1C4 #x7576)
- (#xE1C5 #x7586)
- (#xE1C6 #x7587)
- (#xE1C7 #x7574)
- (#xE1C8 #x758A)
- (#xE1C9 #x7589)
- (#xE1CA #x7582)
- (#xE1CB #x7594)
- (#xE1CC #x759A)
- (#xE1CD #x759D)
- (#xE1CE #x75A5)
- (#xE1CF #x75A3)
- (#xE1D0 #x75C2)
- (#xE1D1 #x75B3)
- (#xE1D2 #x75C3)
- (#xE1D3 #x75B5)
- (#xE1D4 #x75BD)
- (#xE1D5 #x75B8)
- (#xE1D6 #x75BC)
- (#xE1D7 #x75B1)
- (#xE1D8 #x75CD)
- (#xE1D9 #x75CA)
- (#xE1DA #x75D2)
- (#xE1DB #x75D9)
- (#xE1DC #x75E3)
- (#xE1DD #x75DE)
- (#xE1DE #x75FE)
- (#xE1DF #x75FF)
- (#xE1E0 #x75FC)
- (#xE1E1 #x7601)
- (#xE1E2 #x75F0)
- (#xE1E3 #x75FA)
- (#xE1E4 #x75F2)
- (#xE1E5 #x75F3)
- (#xE1E6 #x760B)
- (#xE1E7 #x760D)
- (#xE1E8 #x7609)
- (#xE1E9 #x761F)
- (#xE1EA #x7627)
- (#xE1EB #x7620)
- (#xE1EC #x7621)
- (#xE1ED #x7622)
- (#xE1EE #x7624)
- (#xE1EF #x7634)
- (#xE1F0 #x7630)
- (#xE1F1 #x763B)
- (#xE1F2 #x7647)
- (#xE1F3 #x7648)
- (#xE1F4 #x7646)
- (#xE1F5 #x765C)
- (#xE1F6 #x7658)
- (#xE1F7 #x7661)
- (#xE1F8 #x7662)
- (#xE1F9 #x7668)
- (#xE1FA #x7669)
- (#xE1FB #x766A)
- (#xE1FC #x7667)
- (#xE1FD #x766C)
- (#xE1FE #x7670)
- (#xE2A1 #x7672)
- (#xE2A2 #x7676)
- (#xE2A3 #x7678)
- (#xE2A4 #x767C)
- (#xE2A5 #x7680)
- (#xE2A6 #x7683)
- (#xE2A7 #x7688)
- (#xE2A8 #x768B)
- (#xE2A9 #x768E)
- (#xE2AA #x7696)
- (#xE2AB #x7693)
- (#xE2AC #x7699)
- (#xE2AD #x769A)
- (#xE2AE #x76B0)
- (#xE2AF #x76B4)
- (#xE2B0 #x76B8)
- (#xE2B1 #x76B9)
- (#xE2B2 #x76BA)
- (#xE2B3 #x76C2)
- (#xE2B4 #x76CD)
- (#xE2B5 #x76D6)
- (#xE2B6 #x76D2)
- (#xE2B7 #x76DE)
- (#xE2B8 #x76E1)
- (#xE2B9 #x76E5)
- (#xE2BA #x76E7)
- (#xE2BB #x76EA)
- (#xE2BC #x862F)
- (#xE2BD #x76FB)
- (#xE2BE #x7708)
- (#xE2BF #x7707)
- (#xE2C0 #x7704)
- (#xE2C1 #x7729)
- (#xE2C2 #x7724)
- (#xE2C3 #x771E)
- (#xE2C4 #x7725)
- (#xE2C5 #x7726)
- (#xE2C6 #x771B)
- (#xE2C7 #x7737)
- (#xE2C8 #x7738)
- (#xE2C9 #x7747)
- (#xE2CA #x775A)
- (#xE2CB #x7768)
- (#xE2CC #x776B)
- (#xE2CD #x775B)
- (#xE2CE #x7765)
- (#xE2CF #x777F)
- (#xE2D0 #x777E)
- (#xE2D1 #x7779)
- (#xE2D2 #x778E)
- (#xE2D3 #x778B)
- (#xE2D4 #x7791)
- (#xE2D5 #x77A0)
- (#xE2D6 #x779E)
- (#xE2D7 #x77B0)
- (#xE2D8 #x77B6)
- (#xE2D9 #x77B9)
- (#xE2DA #x77BF)
- (#xE2DB #x77BC)
- (#xE2DC #x77BD)
- (#xE2DD #x77BB)
- (#xE2DE #x77C7)
- (#xE2DF #x77CD)
- (#xE2E0 #x77D7)
- (#xE2E1 #x77DA)
- (#xE2E2 #x77DC)
- (#xE2E3 #x77E3)
- (#xE2E4 #x77EE)
- (#xE2E5 #x77FC)
- (#xE2E6 #x780C)
- (#xE2E7 #x7812)
- (#xE2E8 #x7926)
- (#xE2E9 #x7820)
- (#xE2EA #x792A)
- (#xE2EB #x7845)
- (#xE2EC #x788E)
- (#xE2ED #x7874)
- (#xE2EE #x7886)
- (#xE2EF #x787C)
- (#xE2F0 #x789A)
- (#xE2F1 #x788C)
- (#xE2F2 #x78A3)
- (#xE2F3 #x78B5)
- (#xE2F4 #x78AA)
- (#xE2F5 #x78AF)
- (#xE2F6 #x78D1)
- (#xE2F7 #x78C6)
- (#xE2F8 #x78CB)
- (#xE2F9 #x78D4)
- (#xE2FA #x78BE)
- (#xE2FB #x78BC)
- (#xE2FC #x78C5)
- (#xE2FD #x78CA)
- (#xE2FE #x78EC)
- (#xE3A1 #x78E7)
- (#xE3A2 #x78DA)
- (#xE3A3 #x78FD)
- (#xE3A4 #x78F4)
- (#xE3A5 #x7907)
- (#xE3A6 #x7912)
- (#xE3A7 #x7911)
- (#xE3A8 #x7919)
- (#xE3A9 #x792C)
- (#xE3AA #x792B)
- (#xE3AB #x7940)
- (#xE3AC #x7960)
- (#xE3AD #x7957)
- (#xE3AE #x795F)
- (#xE3AF #x795A)
- (#xE3B0 #x7955)
- (#xE3B1 #x7953)
- (#xE3B2 #x797A)
- (#xE3B3 #x797F)
- (#xE3B4 #x798A)
- (#xE3B5 #x799D)
- (#xE3B6 #x79A7)
- (#xE3B7 #x9F4B)
- (#xE3B8 #x79AA)
- (#xE3B9 #x79AE)
- (#xE3BA #x79B3)
- (#xE3BB #x79B9)
- (#xE3BC #x79BA)
- (#xE3BD #x79C9)
- (#xE3BE #x79D5)
- (#xE3BF #x79E7)
- (#xE3C0 #x79EC)
- (#xE3C1 #x79E1)
- (#xE3C2 #x79E3)
- (#xE3C3 #x7A08)
- (#xE3C4 #x7A0D)
- (#xE3C5 #x7A18)
- (#xE3C6 #x7A19)
- (#xE3C7 #x7A20)
- (#xE3C8 #x7A1F)
- (#xE3C9 #x7980)
- (#xE3CA #x7A31)
- (#xE3CB #x7A3B)
- (#xE3CC #x7A3E)
- (#xE3CD #x7A37)
- (#xE3CE #x7A43)
- (#xE3CF #x7A57)
- (#xE3D0 #x7A49)
- (#xE3D1 #x7A61)
- (#xE3D2 #x7A62)
- (#xE3D3 #x7A69)
- (#xE3D4 #x9F9D)
- (#xE3D5 #x7A70)
- (#xE3D6 #x7A79)
- (#xE3D7 #x7A7D)
- (#xE3D8 #x7A88)
- (#xE3D9 #x7A97)
- (#xE3DA #x7A95)
- (#xE3DB #x7A98)
- (#xE3DC #x7A96)
- (#xE3DD #x7AA9)
- (#xE3DE #x7AC8)
- (#xE3DF #x7AB0)
- (#xE3E0 #x7AB6)
- (#xE3E1 #x7AC5)
- (#xE3E2 #x7AC4)
- (#xE3E3 #x7ABF)
- (#xE3E4 #x9083)
- (#xE3E5 #x7AC7)
- (#xE3E6 #x7ACA)
- (#xE3E7 #x7ACD)
- (#xE3E8 #x7ACF)
- (#xE3E9 #x7AD5)
- (#xE3EA #x7AD3)
- (#xE3EB #x7AD9)
- (#xE3EC #x7ADA)
- (#xE3ED #x7ADD)
- (#xE3EE #x7AE1)
- (#xE3EF #x7AE2)
- (#xE3F0 #x7AE6)
- (#xE3F1 #x7AED)
- (#xE3F2 #x7AF0)
- (#xE3F3 #x7B02)
- (#xE3F4 #x7B0F)
- (#xE3F5 #x7B0A)
- (#xE3F6 #x7B06)
- (#xE3F7 #x7B33)
- (#xE3F8 #x7B18)
- (#xE3F9 #x7B19)
- (#xE3FA #x7B1E)
- (#xE3FB #x7B35)
- (#xE3FC #x7B28)
- (#xE3FD #x7B36)
- (#xE3FE #x7B50)
- (#xE4A1 #x7B7A)
- (#xE4A2 #x7B04)
- (#xE4A3 #x7B4D)
- (#xE4A4 #x7B0B)
- (#xE4A5 #x7B4C)
- (#xE4A6 #x7B45)
- (#xE4A7 #x7B75)
- (#xE4A8 #x7B65)
- (#xE4A9 #x7B74)
- (#xE4AA #x7B67)
- (#xE4AB #x7B70)
- (#xE4AC #x7B71)
- (#xE4AD #x7B6C)
- (#xE4AE #x7B6E)
- (#xE4AF #x7B9D)
- (#xE4B0 #x7B98)
- (#xE4B1 #x7B9F)
- (#xE4B2 #x7B8D)
- (#xE4B3 #x7B9C)
- (#xE4B4 #x7B9A)
- (#xE4B5 #x7B8B)
- (#xE4B6 #x7B92)
- (#xE4B7 #x7B8F)
- (#xE4B8 #x7B5D)
- (#xE4B9 #x7B99)
- (#xE4BA #x7BCB)
- (#xE4BB #x7BC1)
- (#xE4BC #x7BCC)
- (#xE4BD #x7BCF)
- (#xE4BE #x7BB4)
- (#xE4BF #x7BC6)
- (#xE4C0 #x7BDD)
- (#xE4C1 #x7BE9)
- (#xE4C2 #x7C11)
- (#xE4C3 #x7C14)
- (#xE4C4 #x7BE6)
- (#xE4C5 #x7BE5)
- (#xE4C6 #x7C60)
- (#xE4C7 #x7C00)
- (#xE4C8 #x7C07)
- (#xE4C9 #x7C13)
- (#xE4CA #x7BF3)
- (#xE4CB #x7BF7)
- (#xE4CC #x7C17)
- (#xE4CD #x7C0D)
- (#xE4CE #x7BF6)
- (#xE4CF #x7C23)
- (#xE4D0 #x7C27)
- (#xE4D1 #x7C2A)
- (#xE4D2 #x7C1F)
- (#xE4D3 #x7C37)
- (#xE4D4 #x7C2B)
- (#xE4D5 #x7C3D)
- (#xE4D6 #x7C4C)
- (#xE4D7 #x7C43)
- (#xE4D8 #x7C54)
- (#xE4D9 #x7C4F)
- (#xE4DA #x7C40)
- (#xE4DB #x7C50)
- (#xE4DC #x7C58)
- (#xE4DD #x7C5F)
- (#xE4DE #x7C64)
- (#xE4DF #x7C56)
- (#xE4E0 #x7C65)
- (#xE4E1 #x7C6C)
- (#xE4E2 #x7C75)
- (#xE4E3 #x7C83)
- (#xE4E4 #x7C90)
- (#xE4E5 #x7CA4)
- (#xE4E6 #x7CAD)
- (#xE4E7 #x7CA2)
- (#xE4E8 #x7CAB)
- (#xE4E9 #x7CA1)
- (#xE4EA #x7CA8)
- (#xE4EB #x7CB3)
- (#xE4EC #x7CB2)
- (#xE4ED #x7CB1)
- (#xE4EE #x7CAE)
- (#xE4EF #x7CB9)
- (#xE4F0 #x7CBD)
- (#xE4F1 #x7CC0)
- (#xE4F2 #x7CC5)
- (#xE4F3 #x7CC2)
- (#xE4F4 #x7CD8)
- (#xE4F5 #x7CD2)
- (#xE4F6 #x7CDC)
- (#xE4F7 #x7CE2)
- (#xE4F8 #x9B3B)
- (#xE4F9 #x7CEF)
- (#xE4FA #x7CF2)
- (#xE4FB #x7CF4)
- (#xE4FC #x7CF6)
- (#xE4FD #x7CFA)
- (#xE4FE #x7D06)
- (#xE5A1 #x7D02)
- (#xE5A2 #x7D1C)
- (#xE5A3 #x7D15)
- (#xE5A4 #x7D0A)
- (#xE5A5 #x7D45)
- (#xE5A6 #x7D4B)
- (#xE5A7 #x7D2E)
- (#xE5A8 #x7D32)
- (#xE5A9 #x7D3F)
- (#xE5AA #x7D35)
- (#xE5AB #x7D46)
- (#xE5AC #x7D73)
- (#xE5AD #x7D56)
- (#xE5AE #x7D4E)
- (#xE5AF #x7D72)
- (#xE5B0 #x7D68)
- (#xE5B1 #x7D6E)
- (#xE5B2 #x7D4F)
- (#xE5B3 #x7D63)
- (#xE5B4 #x7D93)
- (#xE5B5 #x7D89)
- (#xE5B6 #x7D5B)
- (#xE5B7 #x7D8F)
- (#xE5B8 #x7D7D)
- (#xE5B9 #x7D9B)
- (#xE5BA #x7DBA)
- (#xE5BB #x7DAE)
- (#xE5BC #x7DA3)
- (#xE5BD #x7DB5)
- (#xE5BE #x7DC7)
- (#xE5BF #x7DBD)
- (#xE5C0 #x7DAB)
- (#xE5C1 #x7E3D)
- (#xE5C2 #x7DA2)
- (#xE5C3 #x7DAF)
- (#xE5C4 #x7DDC)
- (#xE5C5 #x7DB8)
- (#xE5C6 #x7D9F)
- (#xE5C7 #x7DB0)
- (#xE5C8 #x7DD8)
- (#xE5C9 #x7DDD)
- (#xE5CA #x7DE4)
- (#xE5CB #x7DDE)
- (#xE5CC #x7DFB)
- (#xE5CD #x7DF2)
- (#xE5CE #x7DE1)
- (#xE5CF #x7E05)
- (#xE5D0 #x7E0A)
- (#xE5D1 #x7E23)
- (#xE5D2 #x7E21)
- (#xE5D3 #x7E12)
- (#xE5D4 #x7E31)
- (#xE5D5 #x7E1F)
- (#xE5D6 #x7E09)
- (#xE5D7 #x7E0B)
- (#xE5D8 #x7E22)
- (#xE5D9 #x7E46)
- (#xE5DA #x7E66)
- (#xE5DB #x7E3B)
- (#xE5DC #x7E35)
- (#xE5DD #x7E39)
- (#xE5DE #x7E43)
- (#xE5DF #x7E37)
- (#xE5E0 #x7E32)
- (#xE5E1 #x7E3A)
- (#xE5E2 #x7E67)
- (#xE5E3 #x7E5D)
- (#xE5E4 #x7E56)
- (#xE5E5 #x7E5E)
- (#xE5E6 #x7E59)
- (#xE5E7 #x7E5A)
- (#xE5E8 #x7E79)
- (#xE5E9 #x7E6A)
- (#xE5EA #x7E69)
- (#xE5EB #x7E7C)
- (#xE5EC #x7E7B)
- (#xE5ED #x7E83)
- (#xE5EE #x7DD5)
- (#xE5EF #x7E7D)
- (#xE5F0 #x8FAE)
- (#xE5F1 #x7E7F)
- (#xE5F2 #x7E88)
- (#xE5F3 #x7E89)
- (#xE5F4 #x7E8C)
- (#xE5F5 #x7E92)
- (#xE5F6 #x7E90)
- (#xE5F7 #x7E93)
- (#xE5F8 #x7E94)
- (#xE5F9 #x7E96)
- (#xE5FA #x7E8E)
- (#xE5FB #x7E9B)
- (#xE5FC #x7E9C)
- (#xE5FD #x7F38)
- (#xE5FE #x7F3A)
- (#xE6A1 #x7F45)
- (#xE6A2 #x7F4C)
- (#xE6A3 #x7F4D)
- (#xE6A4 #x7F4E)
- (#xE6A5 #x7F50)
- (#xE6A6 #x7F51)
- (#xE6A7 #x7F55)
- (#xE6A8 #x7F54)
- (#xE6A9 #x7F58)
- (#xE6AA #x7F5F)
- (#xE6AB #x7F60)
- (#xE6AC #x7F68)
- (#xE6AD #x7F69)
- (#xE6AE #x7F67)
- (#xE6AF #x7F78)
- (#xE6B0 #x7F82)
- (#xE6B1 #x7F86)
- (#xE6B2 #x7F83)
- (#xE6B3 #x7F88)
- (#xE6B4 #x7F87)
- (#xE6B5 #x7F8C)
- (#xE6B6 #x7F94)
- (#xE6B7 #x7F9E)
- (#xE6B8 #x7F9D)
- (#xE6B9 #x7F9A)
- (#xE6BA #x7FA3)
- (#xE6BB #x7FAF)
- (#xE6BC #x7FB2)
- (#xE6BD #x7FB9)
- (#xE6BE #x7FAE)
- (#xE6BF #x7FB6)
- (#xE6C0 #x7FB8)
- (#xE6C1 #x8B71)
- (#xE6C2 #x7FC5)
- (#xE6C3 #x7FC6)
- (#xE6C4 #x7FCA)
- (#xE6C5 #x7FD5)
- (#xE6C6 #x7FD4)
- (#xE6C7 #x7FE1)
- (#xE6C8 #x7FE6)
- (#xE6C9 #x7FE9)
- (#xE6CA #x7FF3)
- (#xE6CB #x7FF9)
- (#xE6CC #x98DC)
- (#xE6CD #x8006)
- (#xE6CE #x8004)
- (#xE6CF #x800B)
- (#xE6D0 #x8012)
- (#xE6D1 #x8018)
- (#xE6D2 #x8019)
- (#xE6D3 #x801C)
- (#xE6D4 #x8021)
- (#xE6D5 #x8028)
- (#xE6D6 #x803F)
- (#xE6D7 #x803B)
- (#xE6D8 #x804A)
- (#xE6D9 #x8046)
- (#xE6DA #x8052)
- (#xE6DB #x8058)
- (#xE6DC #x805A)
- (#xE6DD #x805F)
- (#xE6DE #x8062)
- (#xE6DF #x8068)
- (#xE6E0 #x8073)
- (#xE6E1 #x8072)
- (#xE6E2 #x8070)
- (#xE6E3 #x8076)
- (#xE6E4 #x8079)
- (#xE6E5 #x807D)
- (#xE6E6 #x807F)
- (#xE6E7 #x8084)
- (#xE6E8 #x8086)
- (#xE6E9 #x8085)
- (#xE6EA #x809B)
- (#xE6EB #x8093)
- (#xE6EC #x809A)
- (#xE6ED #x80AD)
- (#xE6EE #x5190)
- (#xE6EF #x80AC)
- (#xE6F0 #x80DB)
- (#xE6F1 #x80E5)
- (#xE6F2 #x80D9)
- (#xE6F3 #x80DD)
- (#xE6F4 #x80C4)
- (#xE6F5 #x80DA)
- (#xE6F6 #x80D6)
- (#xE6F7 #x8109)
- (#xE6F8 #x80EF)
- (#xE6F9 #x80F1)
- (#xE6FA #x811B)
- (#xE6FB #x8129)
- (#xE6FC #x8123)
- (#xE6FD #x812F)
- (#xE6FE #x814B)
- (#xE7A1 #x968B)
- (#xE7A2 #x8146)
- (#xE7A3 #x813E)
- (#xE7A4 #x8153)
- (#xE7A5 #x8151)
- (#xE7A6 #x80FC)
- (#xE7A7 #x8171)
- (#xE7A8 #x816E)
- (#xE7A9 #x8165)
- (#xE7AA #x8166)
- (#xE7AB #x8174)
- (#xE7AC #x8183)
- (#xE7AD #x8188)
- (#xE7AE #x818A)
- (#xE7AF #x8180)
- (#xE7B0 #x8182)
- (#xE7B1 #x81A0)
- (#xE7B2 #x8195)
- (#xE7B3 #x81A4)
- (#xE7B4 #x81A3)
- (#xE7B5 #x815F)
- (#xE7B6 #x8193)
- (#xE7B7 #x81A9)
- (#xE7B8 #x81B0)
- (#xE7B9 #x81B5)
- (#xE7BA #x81BE)
- (#xE7BB #x81B8)
- (#xE7BC #x81BD)
- (#xE7BD #x81C0)
- (#xE7BE #x81C2)
- (#xE7BF #x81BA)
- (#xE7C0 #x81C9)
- (#xE7C1 #x81CD)
- (#xE7C2 #x81D1)
- (#xE7C3 #x81D9)
- (#xE7C4 #x81D8)
- (#xE7C5 #x81C8)
- (#xE7C6 #x81DA)
- (#xE7C7 #x81DF)
- (#xE7C8 #x81E0)
- (#xE7C9 #x81E7)
- (#xE7CA #x81FA)
- (#xE7CB #x81FB)
- (#xE7CC #x81FE)
- (#xE7CD #x8201)
- (#xE7CE #x8202)
- (#xE7CF #x8205)
- (#xE7D0 #x8207)
- (#xE7D1 #x820A)
- (#xE7D2 #x820D)
- (#xE7D3 #x8210)
- (#xE7D4 #x8216)
- (#xE7D5 #x8229)
- (#xE7D6 #x822B)
- (#xE7D7 #x8238)
- (#xE7D8 #x8233)
- (#xE7D9 #x8240)
- (#xE7DA #x8259)
- (#xE7DB #x8258)
- (#xE7DC #x825D)
- (#xE7DD #x825A)
- (#xE7DE #x825F)
- (#xE7DF #x8264)
- (#xE7E0 #x8262)
- (#xE7E1 #x8268)
- (#xE7E2 #x826A)
- (#xE7E3 #x826B)
- (#xE7E4 #x822E)
- (#xE7E5 #x8271)
- (#xE7E6 #x8277)
- (#xE7E7 #x8278)
- (#xE7E8 #x827E)
- (#xE7E9 #x828D)
- (#xE7EA #x8292)
- (#xE7EB #x82AB)
- (#xE7EC #x829F)
- (#xE7ED #x82BB)
- (#xE7EE #x82AC)
- (#xE7EF #x82E1)
- (#xE7F0 #x82E3)
- (#xE7F1 #x82DF)
- (#xE7F2 #x82D2)
- (#xE7F3 #x82F4)
- (#xE7F4 #x82F3)
- (#xE7F5 #x82FA)
- (#xE7F6 #x8393)
- (#xE7F7 #x8303)
- (#xE7F8 #x82FB)
- (#xE7F9 #x82F9)
- (#xE7FA #x82DE)
- (#xE7FB #x8306)
- (#xE7FC #x82DC)
- (#xE7FD #x8309)
- (#xE7FE #x82D9)
- (#xE8A1 #x8335)
- (#xE8A2 #x8334)
- (#xE8A3 #x8316)
- (#xE8A4 #x8332)
- (#xE8A5 #x8331)
- (#xE8A6 #x8340)
- (#xE8A7 #x8339)
- (#xE8A8 #x8350)
- (#xE8A9 #x8345)
- (#xE8AA #x832F)
- (#xE8AB #x832B)
- (#xE8AC #x8317)
- (#xE8AD #x8318)
- (#xE8AE #x8385)
- (#xE8AF #x839A)
- (#xE8B0 #x83AA)
- (#xE8B1 #x839F)
- (#xE8B2 #x83A2)
- (#xE8B3 #x8396)
- (#xE8B4 #x8323)
- (#xE8B5 #x838E)
- (#xE8B6 #x8387)
- (#xE8B7 #x838A)
- (#xE8B8 #x837C)
- (#xE8B9 #x83B5)
- (#xE8BA #x8373)
- (#xE8BB #x8375)
- (#xE8BC #x83A0)
- (#xE8BD #x8389)
- (#xE8BE #x83A8)
- (#xE8BF #x83F4)
- (#xE8C0 #x8413)
- (#xE8C1 #x83EB)
- (#xE8C2 #x83CE)
- (#xE8C3 #x83FD)
- (#xE8C4 #x8403)
- (#xE8C5 #x83D8)
- (#xE8C6 #x840B)
- (#xE8C7 #x83C1)
- (#xE8C8 #x83F7)
- (#xE8C9 #x8407)
- (#xE8CA #x83E0)
- (#xE8CB #x83F2)
- (#xE8CC #x840D)
- (#xE8CD #x8422)
- (#xE8CE #x8420)
- (#xE8CF #x83BD)
- (#xE8D0 #x8438)
- (#xE8D1 #x8506)
- (#xE8D2 #x83FB)
- (#xE8D3 #x846D)
- (#xE8D4 #x842A)
- (#xE8D5 #x843C)
- (#xE8D6 #x855A)
- (#xE8D7 #x8484)
- (#xE8D8 #x8477)
- (#xE8D9 #x846B)
- (#xE8DA #x84AD)
- (#xE8DB #x846E)
- (#xE8DC #x8482)
- (#xE8DD #x8469)
- (#xE8DE #x8446)
- (#xE8DF #x842C)
- (#xE8E0 #x846F)
- (#xE8E1 #x8479)
- (#xE8E2 #x8435)
- (#xE8E3 #x84CA)
- (#xE8E4 #x8462)
- (#xE8E5 #x84B9)
- (#xE8E6 #x84BF)
- (#xE8E7 #x849F)
- (#xE8E8 #x84D9)
- (#xE8E9 #x84CD)
- (#xE8EA #x84BB)
- (#xE8EB #x84DA)
- (#xE8EC #x84D0)
- (#xE8ED #x84C1)
- (#xE8EE #x84C6)
- (#xE8EF #x84D6)
- (#xE8F0 #x84A1)
- (#xE8F1 #x8521)
- (#xE8F2 #x84FF)
- (#xE8F3 #x84F4)
- (#xE8F4 #x8517)
- (#xE8F5 #x8518)
- (#xE8F6 #x852C)
- (#xE8F7 #x851F)
- (#xE8F8 #x8515)
- (#xE8F9 #x8514)
- (#xE8FA #x84FC)
- (#xE8FB #x8540)
- (#xE8FC #x8563)
- (#xE8FD #x8558)
- (#xE8FE #x8548)
- (#xE9A1 #x8541)
- (#xE9A2 #x8602)
- (#xE9A3 #x854B)
- (#xE9A4 #x8555)
- (#xE9A5 #x8580)
- (#xE9A6 #x85A4)
- (#xE9A7 #x8588)
- (#xE9A8 #x8591)
- (#xE9A9 #x858A)
- (#xE9AA #x85A8)
- (#xE9AB #x856D)
- (#xE9AC #x8594)
- (#xE9AD #x859B)
- (#xE9AE #x85EA)
- (#xE9AF #x8587)
- (#xE9B0 #x859C)
- (#xE9B1 #x8577)
- (#xE9B2 #x857E)
- (#xE9B3 #x8590)
- (#xE9B4 #x85C9)
- (#xE9B5 #x85BA)
- (#xE9B6 #x85CF)
- (#xE9B7 #x85B9)
- (#xE9B8 #x85D0)
- (#xE9B9 #x85D5)
- (#xE9BA #x85DD)
- (#xE9BB #x85E5)
- (#xE9BC #x85DC)
- (#xE9BD #x85F9)
- (#xE9BE #x860A)
- (#xE9BF #x8613)
- (#xE9C0 #x860B)
- (#xE9C1 #x85FE)
- (#xE9C2 #x85FA)
- (#xE9C3 #x8606)
- (#xE9C4 #x8622)
- (#xE9C5 #x861A)
- (#xE9C6 #x8630)
- (#xE9C7 #x863F)
- (#xE9C8 #x864D)
- (#xE9C9 #x4E55)
- (#xE9CA #x8654)
- (#xE9CB #x865F)
- (#xE9CC #x8667)
- (#xE9CD #x8671)
- (#xE9CE #x8693)
- (#xE9CF #x86A3)
- (#xE9D0 #x86A9)
- (#xE9D1 #x86AA)
- (#xE9D2 #x868B)
- (#xE9D3 #x868C)
- (#xE9D4 #x86B6)
- (#xE9D5 #x86AF)
- (#xE9D6 #x86C4)
- (#xE9D7 #x86C6)
- (#xE9D8 #x86B0)
- (#xE9D9 #x86C9)
- (#xE9DA #x8823)
- (#xE9DB #x86AB)
- (#xE9DC #x86D4)
- (#xE9DD #x86DE)
- (#xE9DE #x86E9)
- (#xE9DF #x86EC)
- (#xE9E0 #x86DF)
- (#xE9E1 #x86DB)
- (#xE9E2 #x86EF)
- (#xE9E3 #x8712)
- (#xE9E4 #x8706)
- (#xE9E5 #x8708)
- (#xE9E6 #x8700)
- (#xE9E7 #x8703)
- (#xE9E8 #x86FB)
- (#xE9E9 #x8711)
- (#xE9EA #x8709)
- (#xE9EB #x870D)
- (#xE9EC #x86F9)
- (#xE9ED #x870A)
- (#xE9EE #x8734)
- (#xE9EF #x873F)
- (#xE9F0 #x8737)
- (#xE9F1 #x873B)
- (#xE9F2 #x8725)
- (#xE9F3 #x8729)
- (#xE9F4 #x871A)
- (#xE9F5 #x8760)
- (#xE9F6 #x875F)
- (#xE9F7 #x8778)
- (#xE9F8 #x874C)
- (#xE9F9 #x874E)
- (#xE9FA #x8774)
- (#xE9FB #x8757)
- (#xE9FC #x8768)
- (#xE9FD #x876E)
- (#xE9FE #x8759)
- (#xEAA1 #x8753)
- (#xEAA2 #x8763)
- (#xEAA3 #x876A)
- (#xEAA4 #x8805)
- (#xEAA5 #x87A2)
- (#xEAA6 #x879F)
- (#xEAA7 #x8782)
- (#xEAA8 #x87AF)
- (#xEAA9 #x87CB)
- (#xEAAA #x87BD)
- (#xEAAB #x87C0)
- (#xEAAC #x87D0)
- (#xEAAD #x96D6)
- (#xEAAE #x87AB)
- (#xEAAF #x87C4)
- (#xEAB0 #x87B3)
- (#xEAB1 #x87C7)
- (#xEAB2 #x87C6)
- (#xEAB3 #x87BB)
- (#xEAB4 #x87EF)
- (#xEAB5 #x87F2)
- (#xEAB6 #x87E0)
- (#xEAB7 #x880F)
- (#xEAB8 #x880D)
- (#xEAB9 #x87FE)
- (#xEABA #x87F6)
- (#xEABB #x87F7)
- (#xEABC #x880E)
- (#xEABD #x87D2)
- (#xEABE #x8811)
- (#xEABF #x8816)
- (#xEAC0 #x8815)
- (#xEAC1 #x8822)
- (#xEAC2 #x8821)
- (#xEAC3 #x8831)
- (#xEAC4 #x8836)
- (#xEAC5 #x8839)
- (#xEAC6 #x8827)
- (#xEAC7 #x883B)
- (#xEAC8 #x8844)
- (#xEAC9 #x8842)
- (#xEACA #x8852)
- (#xEACB #x8859)
- (#xEACC #x885E)
- (#xEACD #x8862)
- (#xEACE #x886B)
- (#xEACF #x8881)
- (#xEAD0 #x887E)
- (#xEAD1 #x889E)
- (#xEAD2 #x8875)
- (#xEAD3 #x887D)
- (#xEAD4 #x88B5)
- (#xEAD5 #x8872)
- (#xEAD6 #x8882)
- (#xEAD7 #x8897)
- (#xEAD8 #x8892)
- (#xEAD9 #x88AE)
- (#xEADA #x8899)
- (#xEADB #x88A2)
- (#xEADC #x888D)
- (#xEADD #x88A4)
- (#xEADE #x88B0)
- (#xEADF #x88BF)
- (#xEAE0 #x88B1)
- (#xEAE1 #x88C3)
- (#xEAE2 #x88C4)
- (#xEAE3 #x88D4)
- (#xEAE4 #x88D8)
- (#xEAE5 #x88D9)
- (#xEAE6 #x88DD)
- (#xEAE7 #x88F9)
- (#xEAE8 #x8902)
- (#xEAE9 #x88FC)
- (#xEAEA #x88F4)
- (#xEAEB #x88E8)
- (#xEAEC #x88F2)
- (#xEAED #x8904)
- (#xEAEE #x890C)
- (#xEAEF #x890A)
- (#xEAF0 #x8913)
- (#xEAF1 #x8943)
- (#xEAF2 #x891E)
- (#xEAF3 #x8925)
- (#xEAF4 #x892A)
- (#xEAF5 #x892B)
- (#xEAF6 #x8941)
- (#xEAF7 #x8944)
- (#xEAF8 #x893B)
- (#xEAF9 #x8936)
- (#xEAFA #x8938)
- (#xEAFB #x894C)
- (#xEAFC #x891D)
- (#xEAFD #x8960)
- (#xEAFE #x895E)
- (#xEBA1 #x8966)
- (#xEBA2 #x8964)
- (#xEBA3 #x896D)
- (#xEBA4 #x896A)
- (#xEBA5 #x896F)
- (#xEBA6 #x8974)
- (#xEBA7 #x8977)
- (#xEBA8 #x897E)
- (#xEBA9 #x8983)
- (#xEBAA #x8988)
- (#xEBAB #x898A)
- (#xEBAC #x8993)
- (#xEBAD #x8998)
- (#xEBAE #x89A1)
- (#xEBAF #x89A9)
- (#xEBB0 #x89A6)
- (#xEBB1 #x89AC)
- (#xEBB2 #x89AF)
- (#xEBB3 #x89B2)
- (#xEBB4 #x89BA)
- (#xEBB5 #x89BD)
- (#xEBB6 #x89BF)
- (#xEBB7 #x89C0)
- (#xEBB8 #x89DA)
- (#xEBB9 #x89DC)
- (#xEBBA #x89DD)
- (#xEBBB #x89E7)
- (#xEBBC #x89F4)
- (#xEBBD #x89F8)
- (#xEBBE #x8A03)
- (#xEBBF #x8A16)
- (#xEBC0 #x8A10)
- (#xEBC1 #x8A0C)
- (#xEBC2 #x8A1B)
- (#xEBC3 #x8A1D)
- (#xEBC4 #x8A25)
- (#xEBC5 #x8A36)
- (#xEBC6 #x8A41)
- (#xEBC7 #x8A5B)
- (#xEBC8 #x8A52)
- (#xEBC9 #x8A46)
- (#xEBCA #x8A48)
- (#xEBCB #x8A7C)
- (#xEBCC #x8A6D)
- (#xEBCD #x8A6C)
- (#xEBCE #x8A62)
- (#xEBCF #x8A85)
- (#xEBD0 #x8A82)
- (#xEBD1 #x8A84)
- (#xEBD2 #x8AA8)
- (#xEBD3 #x8AA1)
- (#xEBD4 #x8A91)
- (#xEBD5 #x8AA5)
- (#xEBD6 #x8AA6)
- (#xEBD7 #x8A9A)
- (#xEBD8 #x8AA3)
- (#xEBD9 #x8AC4)
- (#xEBDA #x8ACD)
- (#xEBDB #x8AC2)
- (#xEBDC #x8ADA)
- (#xEBDD #x8AEB)
- (#xEBDE #x8AF3)
- (#xEBDF #x8AE7)
- (#xEBE0 #x8AE4)
- (#xEBE1 #x8AF1)
- (#xEBE2 #x8B14)
- (#xEBE3 #x8AE0)
- (#xEBE4 #x8AE2)
- (#xEBE5 #x8AF7)
- (#xEBE6 #x8ADE)
- (#xEBE7 #x8ADB)
- (#xEBE8 #x8B0C)
- (#xEBE9 #x8B07)
- (#xEBEA #x8B1A)
- (#xEBEB #x8AE1)
- (#xEBEC #x8B16)
- (#xEBED #x8B10)
- (#xEBEE #x8B17)
- (#xEBEF #x8B20)
- (#xEBF0 #x8B33)
- (#xEBF1 #x97AB)
- (#xEBF2 #x8B26)
- (#xEBF3 #x8B2B)
- (#xEBF4 #x8B3E)
- (#xEBF5 #x8B28)
- (#xEBF6 #x8B41)
- (#xEBF7 #x8B4C)
- (#xEBF8 #x8B4F)
- (#xEBF9 #x8B4E)
- (#xEBFA #x8B49)
- (#xEBFB #x8B56)
- (#xEBFC #x8B5B)
- (#xEBFD #x8B5A)
- (#xEBFE #x8B6B)
- (#xECA1 #x8B5F)
- (#xECA2 #x8B6C)
- (#xECA3 #x8B6F)
- (#xECA4 #x8B74)
- (#xECA5 #x8B7D)
- (#xECA6 #x8B80)
- (#xECA7 #x8B8C)
- (#xECA8 #x8B8E)
- (#xECA9 #x8B92)
- (#xECAA #x8B93)
- (#xECAB #x8B96)
- (#xECAC #x8B99)
- (#xECAD #x8B9A)
- (#xECAE #x8C3A)
- (#xECAF #x8C41)
- (#xECB0 #x8C3F)
- (#xECB1 #x8C48)
- (#xECB2 #x8C4C)
- (#xECB3 #x8C4E)
- (#xECB4 #x8C50)
- (#xECB5 #x8C55)
- (#xECB6 #x8C62)
- (#xECB7 #x8C6C)
- (#xECB8 #x8C78)
- (#xECB9 #x8C7A)
- (#xECBA #x8C82)
- (#xECBB #x8C89)
- (#xECBC #x8C85)
- (#xECBD #x8C8A)
- (#xECBE #x8C8D)
- (#xECBF #x8C8E)
- (#xECC0 #x8C94)
- (#xECC1 #x8C7C)
- (#xECC2 #x8C98)
- (#xECC3 #x621D)
- (#xECC4 #x8CAD)
- (#xECC5 #x8CAA)
- (#xECC6 #x8CBD)
- (#xECC7 #x8CB2)
- (#xECC8 #x8CB3)
- (#xECC9 #x8CAE)
- (#xECCA #x8CB6)
- (#xECCB #x8CC8)
- (#xECCC #x8CC1)
- (#xECCD #x8CE4)
- (#xECCE #x8CE3)
- (#xECCF #x8CDA)
- (#xECD0 #x8CFD)
- (#xECD1 #x8CFA)
- (#xECD2 #x8CFB)
- (#xECD3 #x8D04)
- (#xECD4 #x8D05)
- (#xECD5 #x8D0A)
- (#xECD6 #x8D07)
- (#xECD7 #x8D0F)
- (#xECD8 #x8D0D)
- (#xECD9 #x8D10)
- (#xECDA #x9F4E)
- (#xECDB #x8D13)
- (#xECDC #x8CCD)
- (#xECDD #x8D14)
- (#xECDE #x8D16)
- (#xECDF #x8D67)
- (#xECE0 #x8D6D)
- (#xECE1 #x8D71)
- (#xECE2 #x8D73)
- (#xECE3 #x8D81)
- (#xECE4 #x8D99)
- (#xECE5 #x8DC2)
- (#xECE6 #x8DBE)
- (#xECE7 #x8DBA)
- (#xECE8 #x8DCF)
- (#xECE9 #x8DDA)
- (#xECEA #x8DD6)
- (#xECEB #x8DCC)
- (#xECEC #x8DDB)
- (#xECED #x8DCB)
- (#xECEE #x8DEA)
- (#xECEF #x8DEB)
- (#xECF0 #x8DDF)
- (#xECF1 #x8DE3)
- (#xECF2 #x8DFC)
- (#xECF3 #x8E08)
- (#xECF4 #x8E09)
- (#xECF5 #x8DFF)
- (#xECF6 #x8E1D)
- (#xECF7 #x8E1E)
- (#xECF8 #x8E10)
- (#xECF9 #x8E1F)
- (#xECFA #x8E42)
- (#xECFB #x8E35)
- (#xECFC #x8E30)
- (#xECFD #x8E34)
- (#xECFE #x8E4A)
- (#xEDA1 #x8E47)
- (#xEDA2 #x8E49)
- (#xEDA3 #x8E4C)
- (#xEDA4 #x8E50)
- (#xEDA5 #x8E48)
- (#xEDA6 #x8E59)
- (#xEDA7 #x8E64)
- (#xEDA8 #x8E60)
- (#xEDA9 #x8E2A)
- (#xEDAA #x8E63)
- (#xEDAB #x8E55)
- (#xEDAC #x8E76)
- (#xEDAD #x8E72)
- (#xEDAE #x8E7C)
- (#xEDAF #x8E81)
- (#xEDB0 #x8E87)
- (#xEDB1 #x8E85)
- (#xEDB2 #x8E84)
- (#xEDB3 #x8E8B)
- (#xEDB4 #x8E8A)
- (#xEDB5 #x8E93)
- (#xEDB6 #x8E91)
- (#xEDB7 #x8E94)
- (#xEDB8 #x8E99)
- (#xEDB9 #x8EAA)
- (#xEDBA #x8EA1)
- (#xEDBB #x8EAC)
- (#xEDBC #x8EB0)
- (#xEDBD #x8EC6)
- (#xEDBE #x8EB1)
- (#xEDBF #x8EBE)
- (#xEDC0 #x8EC5)
- (#xEDC1 #x8EC8)
- (#xEDC2 #x8ECB)
- (#xEDC3 #x8EDB)
- (#xEDC4 #x8EE3)
- (#xEDC5 #x8EFC)
- (#xEDC6 #x8EFB)
- (#xEDC7 #x8EEB)
- (#xEDC8 #x8EFE)
- (#xEDC9 #x8F0A)
- (#xEDCA #x8F05)
- (#xEDCB #x8F15)
- (#xEDCC #x8F12)
- (#xEDCD #x8F19)
- (#xEDCE #x8F13)
- (#xEDCF #x8F1C)
- (#xEDD0 #x8F1F)
- (#xEDD1 #x8F1B)
- (#xEDD2 #x8F0C)
- (#xEDD3 #x8F26)
- (#xEDD4 #x8F33)
- (#xEDD5 #x8F3B)
- (#xEDD6 #x8F39)
- (#xEDD7 #x8F45)
- (#xEDD8 #x8F42)
- (#xEDD9 #x8F3E)
- (#xEDDA #x8F4C)
- (#xEDDB #x8F49)
- (#xEDDC #x8F46)
- (#xEDDD #x8F4E)
- (#xEDDE #x8F57)
- (#xEDDF #x8F5C)
- (#xEDE0 #x8F62)
- (#xEDE1 #x8F63)
- (#xEDE2 #x8F64)
- (#xEDE3 #x8F9C)
- (#xEDE4 #x8F9F)
- (#xEDE5 #x8FA3)
- (#xEDE6 #x8FAD)
- (#xEDE7 #x8FAF)
- (#xEDE8 #x8FB7)
- (#xEDE9 #x8FDA)
- (#xEDEA #x8FE5)
- (#xEDEB #x8FE2)
- (#xEDEC #x8FEA)
- (#xEDED #x8FEF)
- (#xEDEE #x9087)
- (#xEDEF #x8FF4)
- (#xEDF0 #x9005)
- (#xEDF1 #x8FF9)
- (#xEDF2 #x8FFA)
- (#xEDF3 #x9011)
- (#xEDF4 #x9015)
- (#xEDF5 #x9021)
- (#xEDF6 #x900D)
- (#xEDF7 #x901E)
- (#xEDF8 #x9016)
- (#xEDF9 #x900B)
- (#xEDFA #x9027)
- (#xEDFB #x9036)
- (#xEDFC #x9035)
- (#xEDFD #x9039)
- (#xEDFE #x8FF8)
- (#xEEA1 #x904F)
- (#xEEA2 #x9050)
- (#xEEA3 #x9051)
- (#xEEA4 #x9052)
- (#xEEA5 #x900E)
- (#xEEA6 #x9049)
- (#xEEA7 #x903E)
- (#xEEA8 #x9056)
- (#xEEA9 #x9058)
- (#xEEAA #x905E)
- (#xEEAB #x9068)
- (#xEEAC #x906F)
- (#xEEAD #x9076)
- (#xEEAE #x96A8)
- (#xEEAF #x9072)
- (#xEEB0 #x9082)
- (#xEEB1 #x907D)
- (#xEEB2 #x9081)
- (#xEEB3 #x9080)
- (#xEEB4 #x908A)
- (#xEEB5 #x9089)
- (#xEEB6 #x908F)
- (#xEEB7 #x90A8)
- (#xEEB8 #x90AF)
- (#xEEB9 #x90B1)
- (#xEEBA #x90B5)
- (#xEEBB #x90E2)
- (#xEEBC #x90E4)
- (#xEEBD #x6248)
- (#xEEBE #x90DB)
- (#xEEBF #x9102)
- (#xEEC0 #x9112)
- (#xEEC1 #x9119)
- (#xEEC2 #x9132)
- (#xEEC3 #x9130)
- (#xEEC4 #x914A)
- (#xEEC5 #x9156)
- (#xEEC6 #x9158)
- (#xEEC7 #x9163)
- (#xEEC8 #x9165)
- (#xEEC9 #x9169)
- (#xEECA #x9173)
- (#xEECB #x9172)
- (#xEECC #x918B)
- (#xEECD #x9189)
- (#xEECE #x9182)
- (#xEECF #x91A2)
- (#xEED0 #x91AB)
- (#xEED1 #x91AF)
- (#xEED2 #x91AA)
- (#xEED3 #x91B5)
- (#xEED4 #x91B4)
- (#xEED5 #x91BA)
- (#xEED6 #x91C0)
- (#xEED7 #x91C1)
- (#xEED8 #x91C9)
- (#xEED9 #x91CB)
- (#xEEDA #x91D0)
- (#xEEDB #x91D6)
- (#xEEDC #x91DF)
- (#xEEDD #x91E1)
- (#xEEDE #x91DB)
- (#xEEDF #x91FC)
- (#xEEE0 #x91F5)
- (#xEEE1 #x91F6)
- (#xEEE2 #x921E)
- (#xEEE3 #x91FF)
- (#xEEE4 #x9214)
- (#xEEE5 #x922C)
- (#xEEE6 #x9215)
- (#xEEE7 #x9211)
- (#xEEE8 #x925E)
- (#xEEE9 #x9257)
- (#xEEEA #x9245)
- (#xEEEB #x9249)
- (#xEEEC #x9264)
- (#xEEED #x9248)
- (#xEEEE #x9295)
- (#xEEEF #x923F)
- (#xEEF0 #x924B)
- (#xEEF1 #x9250)
- (#xEEF2 #x929C)
- (#xEEF3 #x9296)
- (#xEEF4 #x9293)
- (#xEEF5 #x929B)
- (#xEEF6 #x925A)
- (#xEEF7 #x92CF)
- (#xEEF8 #x92B9)
- (#xEEF9 #x92B7)
- (#xEEFA #x92E9)
- (#xEEFB #x930F)
- (#xEEFC #x92FA)
- (#xEEFD #x9344)
- (#xEEFE #x932E)
- (#xEFA1 #x9319)
- (#xEFA2 #x9322)
- (#xEFA3 #x931A)
- (#xEFA4 #x9323)
- (#xEFA5 #x933A)
- (#xEFA6 #x9335)
- (#xEFA7 #x933B)
- (#xEFA8 #x935C)
- (#xEFA9 #x9360)
- (#xEFAA #x937C)
- (#xEFAB #x936E)
- (#xEFAC #x9356)
- (#xEFAD #x93B0)
- (#xEFAE #x93AC)
- (#xEFAF #x93AD)
- (#xEFB0 #x9394)
- (#xEFB1 #x93B9)
- (#xEFB2 #x93D6)
- (#xEFB3 #x93D7)
- (#xEFB4 #x93E8)
- (#xEFB5 #x93E5)
- (#xEFB6 #x93D8)
- (#xEFB7 #x93C3)
- (#xEFB8 #x93DD)
- (#xEFB9 #x93D0)
- (#xEFBA #x93C8)
- (#xEFBB #x93E4)
- (#xEFBC #x941A)
- (#xEFBD #x9414)
- (#xEFBE #x9413)
- (#xEFBF #x9403)
- (#xEFC0 #x9407)
- (#xEFC1 #x9410)
- (#xEFC2 #x9436)
- (#xEFC3 #x942B)
- (#xEFC4 #x9435)
- (#xEFC5 #x9421)
- (#xEFC6 #x943A)
- (#xEFC7 #x9441)
- (#xEFC8 #x9452)
- (#xEFC9 #x9444)
- (#xEFCA #x945B)
- (#xEFCB #x9460)
- (#xEFCC #x9462)
- (#xEFCD #x945E)
- (#xEFCE #x946A)
- (#xEFCF #x9229)
- (#xEFD0 #x9470)
- (#xEFD1 #x9475)
- (#xEFD2 #x9477)
- (#xEFD3 #x947D)
- (#xEFD4 #x945A)
- (#xEFD5 #x947C)
- (#xEFD6 #x947E)
- (#xEFD7 #x9481)
- (#xEFD8 #x947F)
- (#xEFD9 #x9582)
- (#xEFDA #x9587)
- (#xEFDB #x958A)
- (#xEFDC #x9594)
- (#xEFDD #x9596)
- (#xEFDE #x9598)
- (#xEFDF #x9599)
- (#xEFE0 #x95A0)
- (#xEFE1 #x95A8)
- (#xEFE2 #x95A7)
- (#xEFE3 #x95AD)
- (#xEFE4 #x95BC)
- (#xEFE5 #x95BB)
- (#xEFE6 #x95B9)
- (#xEFE7 #x95BE)
- (#xEFE8 #x95CA)
- (#xEFE9 #x6FF6)
- (#xEFEA #x95C3)
- (#xEFEB #x95CD)
- (#xEFEC #x95CC)
- (#xEFED #x95D5)
- (#xEFEE #x95D4)
- (#xEFEF #x95D6)
- (#xEFF0 #x95DC)
- (#xEFF1 #x95E1)
- (#xEFF2 #x95E5)
- (#xEFF3 #x95E2)
- (#xEFF4 #x9621)
- (#xEFF5 #x9628)
- (#xEFF6 #x962E)
- (#xEFF7 #x962F)
- (#xEFF8 #x9642)
- (#xEFF9 #x964C)
- (#xEFFA #x964F)
- (#xEFFB #x964B)
- (#xEFFC #x9677)
- (#xEFFD #x965C)
- (#xEFFE #x965E)
- (#xF0A1 #x965D)
- (#xF0A2 #x965F)
- (#xF0A3 #x9666)
- (#xF0A4 #x9672)
- (#xF0A5 #x966C)
- (#xF0A6 #x968D)
- (#xF0A7 #x9698)
- (#xF0A8 #x9695)
- (#xF0A9 #x9697)
- (#xF0AA #x96AA)
- (#xF0AB #x96A7)
- (#xF0AC #x96B1)
- (#xF0AD #x96B2)
- (#xF0AE #x96B0)
- (#xF0AF #x96B4)
- (#xF0B0 #x96B6)
- (#xF0B1 #x96B8)
- (#xF0B2 #x96B9)
- (#xF0B3 #x96CE)
- (#xF0B4 #x96CB)
- (#xF0B5 #x96C9)
- (#xF0B6 #x96CD)
- (#xF0B7 #x894D)
- (#xF0B8 #x96DC)
- (#xF0B9 #x970D)
- (#xF0BA #x96D5)
- (#xF0BB #x96F9)
- (#xF0BC #x9704)
- (#xF0BD #x9706)
- (#xF0BE #x9708)
- (#xF0BF #x9713)
- (#xF0C0 #x970E)
- (#xF0C1 #x9711)
- (#xF0C2 #x970F)
- (#xF0C3 #x9716)
- (#xF0C4 #x9719)
- (#xF0C5 #x9724)
- (#xF0C6 #x972A)
- (#xF0C7 #x9730)
- (#xF0C8 #x9739)
- (#xF0C9 #x973D)
- (#xF0CA #x973E)
- (#xF0CB #x9744)
- (#xF0CC #x9746)
- (#xF0CD #x9748)
- (#xF0CE #x9742)
- (#xF0CF #x9749)
- (#xF0D0 #x975C)
- (#xF0D1 #x9760)
- (#xF0D2 #x9764)
- (#xF0D3 #x9766)
- (#xF0D4 #x9768)
- (#xF0D5 #x52D2)
- (#xF0D6 #x976B)
- (#xF0D7 #x9771)
- (#xF0D8 #x9779)
- (#xF0D9 #x9785)
- (#xF0DA #x977C)
- (#xF0DB #x9781)
- (#xF0DC #x977A)
- (#xF0DD #x9786)
- (#xF0DE #x978B)
- (#xF0DF #x978F)
- (#xF0E0 #x9790)
- (#xF0E1 #x979C)
- (#xF0E2 #x97A8)
- (#xF0E3 #x97A6)
- (#xF0E4 #x97A3)
- (#xF0E5 #x97B3)
- (#xF0E6 #x97B4)
- (#xF0E7 #x97C3)
- (#xF0E8 #x97C6)
- (#xF0E9 #x97C8)
- (#xF0EA #x97CB)
- (#xF0EB #x97DC)
- (#xF0EC #x97ED)
- (#xF0ED #x9F4F)
- (#xF0EE #x97F2)
- (#xF0EF #x7ADF)
- (#xF0F0 #x97F6)
- (#xF0F1 #x97F5)
- (#xF0F2 #x980F)
- (#xF0F3 #x980C)
- (#xF0F4 #x9838)
- (#xF0F5 #x9824)
- (#xF0F6 #x9821)
- (#xF0F7 #x9837)
- (#xF0F8 #x983D)
- (#xF0F9 #x9846)
- (#xF0FA #x984F)
- (#xF0FB #x984B)
- (#xF0FC #x986B)
- (#xF0FD #x986F)
- (#xF0FE #x9870)
- (#xF1A1 #x9871)
- (#xF1A2 #x9874)
- (#xF1A3 #x9873)
- (#xF1A4 #x98AA)
- (#xF1A5 #x98AF)
- (#xF1A6 #x98B1)
- (#xF1A7 #x98B6)
- (#xF1A8 #x98C4)
- (#xF1A9 #x98C3)
- (#xF1AA #x98C6)
- (#xF1AB #x98E9)
- (#xF1AC #x98EB)
- (#xF1AD #x9903)
- (#xF1AE #x9909)
- (#xF1AF #x9912)
- (#xF1B0 #x9914)
- (#xF1B1 #x9918)
- (#xF1B2 #x9921)
- (#xF1B3 #x991D)
- (#xF1B4 #x991E)
- (#xF1B5 #x9924)
- (#xF1B6 #x9920)
- (#xF1B7 #x992C)
- (#xF1B8 #x992E)
- (#xF1B9 #x993D)
- (#xF1BA #x993E)
- (#xF1BB #x9942)
- (#xF1BC #x9949)
- (#xF1BD #x9945)
- (#xF1BE #x9950)
- (#xF1BF #x994B)
- (#xF1C0 #x9951)
- (#xF1C1 #x9952)
- (#xF1C2 #x994C)
- (#xF1C3 #x9955)
- (#xF1C4 #x9997)
- (#xF1C5 #x9998)
- (#xF1C6 #x99A5)
- (#xF1C7 #x99AD)
- (#xF1C8 #x99AE)
- (#xF1C9 #x99BC)
- (#xF1CA #x99DF)
- (#xF1CB #x99DB)
- (#xF1CC #x99DD)
- (#xF1CD #x99D8)
- (#xF1CE #x99D1)
- (#xF1CF #x99ED)
- (#xF1D0 #x99EE)
- (#xF1D1 #x99F1)
- (#xF1D2 #x99F2)
- (#xF1D3 #x99FB)
- (#xF1D4 #x99F8)
- (#xF1D5 #x9A01)
- (#xF1D6 #x9A0F)
- (#xF1D7 #x9A05)
- (#xF1D8 #x99E2)
- (#xF1D9 #x9A19)
- (#xF1DA #x9A2B)
- (#xF1DB #x9A37)
- (#xF1DC #x9A45)
- (#xF1DD #x9A42)
- (#xF1DE #x9A40)
- (#xF1DF #x9A43)
- (#xF1E0 #x9A3E)
- (#xF1E1 #x9A55)
- (#xF1E2 #x9A4D)
- (#xF1E3 #x9A5B)
- (#xF1E4 #x9A57)
- (#xF1E5 #x9A5F)
- (#xF1E6 #x9A62)
- (#xF1E7 #x9A65)
- (#xF1E8 #x9A64)
- (#xF1E9 #x9A69)
- (#xF1EA #x9A6B)
- (#xF1EB #x9A6A)
- (#xF1EC #x9AAD)
- (#xF1ED #x9AB0)
- (#xF1EE #x9ABC)
- (#xF1EF #x9AC0)
- (#xF1F0 #x9ACF)
- (#xF1F1 #x9AD1)
- (#xF1F2 #x9AD3)
- (#xF1F3 #x9AD4)
- (#xF1F4 #x9ADE)
- (#xF1F5 #x9ADF)
- (#xF1F6 #x9AE2)
- (#xF1F7 #x9AE3)
- (#xF1F8 #x9AE6)
- (#xF1F9 #x9AEF)
- (#xF1FA #x9AEB)
- (#xF1FB #x9AEE)
- (#xF1FC #x9AF4)
- (#xF1FD #x9AF1)
- (#xF1FE #x9AF7)
- (#xF2A1 #x9AFB)
- (#xF2A2 #x9B06)
- (#xF2A3 #x9B18)
- (#xF2A4 #x9B1A)
- (#xF2A5 #x9B1F)
- (#xF2A6 #x9B22)
- (#xF2A7 #x9B23)
- (#xF2A8 #x9B25)
- (#xF2A9 #x9B27)
- (#xF2AA #x9B28)
- (#xF2AB #x9B29)
- (#xF2AC #x9B2A)
- (#xF2AD #x9B2E)
- (#xF2AE #x9B2F)
- (#xF2AF #x9B32)
- (#xF2B0 #x9B44)
- (#xF2B1 #x9B43)
- (#xF2B2 #x9B4F)
- (#xF2B3 #x9B4D)
- (#xF2B4 #x9B4E)
- (#xF2B5 #x9B51)
- (#xF2B6 #x9B58)
- (#xF2B7 #x9B74)
- (#xF2B8 #x9B93)
- (#xF2B9 #x9B83)
- (#xF2BA #x9B91)
- (#xF2BB #x9B96)
- (#xF2BC #x9B97)
- (#xF2BD #x9B9F)
- (#xF2BE #x9BA0)
- (#xF2BF #x9BA8)
- (#xF2C0 #x9BB4)
- (#xF2C1 #x9BC0)
- (#xF2C2 #x9BCA)
- (#xF2C3 #x9BB9)
- (#xF2C4 #x9BC6)
- (#xF2C5 #x9BCF)
- (#xF2C6 #x9BD1)
- (#xF2C7 #x9BD2)
- (#xF2C8 #x9BE3)
- (#xF2C9 #x9BE2)
- (#xF2CA #x9BE4)
- (#xF2CB #x9BD4)
- (#xF2CC #x9BE1)
- (#xF2CD #x9C3A)
- (#xF2CE #x9BF2)
- (#xF2CF #x9BF1)
- (#xF2D0 #x9BF0)
- (#xF2D1 #x9C15)
- (#xF2D2 #x9C14)
- (#xF2D3 #x9C09)
- (#xF2D4 #x9C13)
- (#xF2D5 #x9C0C)
- (#xF2D6 #x9C06)
- (#xF2D7 #x9C08)
- (#xF2D8 #x9C12)
- (#xF2D9 #x9C0A)
- (#xF2DA #x9C04)
- (#xF2DB #x9C2E)
- (#xF2DC #x9C1B)
- (#xF2DD #x9C25)
- (#xF2DE #x9C24)
- (#xF2DF #x9C21)
- (#xF2E0 #x9C30)
- (#xF2E1 #x9C47)
- (#xF2E2 #x9C32)
- (#xF2E3 #x9C46)
- (#xF2E4 #x9C3E)
- (#xF2E5 #x9C5A)
- (#xF2E6 #x9C60)
- (#xF2E7 #x9C67)
- (#xF2E8 #x9C76)
- (#xF2E9 #x9C78)
- (#xF2EA #x9CE7)
- (#xF2EB #x9CEC)
- (#xF2EC #x9CF0)
- (#xF2ED #x9D09)
- (#xF2EE #x9D08)
- (#xF2EF #x9CEB)
- (#xF2F0 #x9D03)
- (#xF2F1 #x9D06)
- (#xF2F2 #x9D2A)
- (#xF2F3 #x9D26)
- (#xF2F4 #x9DAF)
- (#xF2F5 #x9D23)
- (#xF2F6 #x9D1F)
- (#xF2F7 #x9D44)
- (#xF2F8 #x9D15)
- (#xF2F9 #x9D12)
- (#xF2FA #x9D41)
- (#xF2FB #x9D3F)
- (#xF2FC #x9D3E)
- (#xF2FD #x9D46)
- (#xF2FE #x9D48)
- (#xF3A1 #x9D5D)
- (#xF3A2 #x9D5E)
- (#xF3A3 #x9D64)
- (#xF3A4 #x9D51)
- (#xF3A5 #x9D50)
- (#xF3A6 #x9D59)
- (#xF3A7 #x9D72)
- (#xF3A8 #x9D89)
- (#xF3A9 #x9D87)
- (#xF3AA #x9DAB)
- (#xF3AB #x9D6F)
- (#xF3AC #x9D7A)
- (#xF3AD #x9D9A)
- (#xF3AE #x9DA4)
- (#xF3AF #x9DA9)
- (#xF3B0 #x9DB2)
- (#xF3B1 #x9DC4)
- (#xF3B2 #x9DC1)
- (#xF3B3 #x9DBB)
- (#xF3B4 #x9DB8)
- (#xF3B5 #x9DBA)
- (#xF3B6 #x9DC6)
- (#xF3B7 #x9DCF)
- (#xF3B8 #x9DC2)
- (#xF3B9 #x9DD9)
- (#xF3BA #x9DD3)
- (#xF3BB #x9DF8)
- (#xF3BC #x9DE6)
- (#xF3BD #x9DED)
- (#xF3BE #x9DEF)
- (#xF3BF #x9DFD)
- (#xF3C0 #x9E1A)
- (#xF3C1 #x9E1B)
- (#xF3C2 #x9E1E)
- (#xF3C3 #x9E75)
- (#xF3C4 #x9E79)
- (#xF3C5 #x9E7D)
- (#xF3C6 #x9E81)
- (#xF3C7 #x9E88)
- (#xF3C8 #x9E8B)
- (#xF3C9 #x9E8C)
- (#xF3CA #x9E92)
- (#xF3CB #x9E95)
- (#xF3CC #x9E91)
- (#xF3CD #x9E9D)
- (#xF3CE #x9EA5)
- (#xF3CF #x9EA9)
- (#xF3D0 #x9EB8)
- (#xF3D1 #x9EAA)
- (#xF3D2 #x9EAD)
- (#xF3D3 #x9761)
- (#xF3D4 #x9ECC)
- (#xF3D5 #x9ECE)
- (#xF3D6 #x9ECF)
- (#xF3D7 #x9ED0)
- (#xF3D8 #x9ED4)
- (#xF3D9 #x9EDC)
- (#xF3DA #x9EDE)
- (#xF3DB #x9EDD)
- (#xF3DC #x9EE0)
- (#xF3DD #x9EE5)
- (#xF3DE #x9EE8)
- (#xF3DF #x9EEF)
- (#xF3E0 #x9EF4)
- (#xF3E1 #x9EF6)
- (#xF3E2 #x9EF7)
- (#xF3E3 #x9EF9)
- (#xF3E4 #x9EFB)
- (#xF3E5 #x9EFC)
- (#xF3E6 #x9EFD)
- (#xF3E7 #x9F07)
- (#xF3E8 #x9F08)
- (#xF3E9 #x76B7)
- (#xF3EA #x9F15)
- (#xF3EB #x9F21)
- (#xF3EC #x9F2C)
- (#xF3ED #x9F3E)
- (#xF3EE #x9F4A)
- (#xF3EF #x9F52)
- (#xF3F0 #x9F54)
- (#xF3F1 #x9F63)
- (#xF3F2 #x9F5F)
- (#xF3F3 #x9F60)
- (#xF3F4 #x9F61)
- (#xF3F5 #x9F66)
- (#xF3F6 #x9F67)
- (#xF3F7 #x9F6C)
- (#xF3F8 #x9F6A)
- (#xF3F9 #x9F77)
- (#xF3FA #x9F72)
- (#xF3FB #x9F76)
- (#xF3FC #x9F95)
- (#xF3FD #x9F9C)
- (#xF3FE #x9FA0)
- (#xF4A1 #x582F)
- (#xF4A2 #x69C7)
- (#xF4A3 #x9059)
- (#xF4A4 #x7464)
- (#xF4A5 #x51DC)
- (#xF4A6 #x7199)
- ))
(DIR) diff --git a/3rdparties/software/babel-20171227-git/src/packages.lisp b/3rdparties/software/babel-20171227-git/src/packages.lisp
@@ -1,115 +0,0 @@
-;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
-;;;
-;;; package.lisp --- Package definition for Babel
-;;;
-;;; Copyright (C) 2007, Luis Oliveira <loliveira@common-lisp.net>
-;;;
-;;; Permission is hereby granted, free of charge, to any person
-;;; obtaining a copy of this software and associated documentation
-;;; files (the "Software"), to deal in the Software without
-;;; restriction, including without limitation the rights to use, copy,
-;;; modify, merge, publish, distribute, sublicense, and/or sell copies
-;;; of the Software, and to permit persons to whom the Software is
-;;; furnished to do so, subject to the following conditions:
-;;;
-;;; The above copyright notice and this permission notice shall be
-;;; included in all copies or substantial portions of the Software.
-;;;
-;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
-;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
-;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
-;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
-;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
-;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
-;;; DEALINGS IN THE SOFTWARE.
-
-(in-package #:cl-user)
-
-(defpackage #:babel-encodings
- (:use #:common-lisp #:alexandria)
- (:export
- ;; character encoding objects
- #:list-character-encodings
- #:character-encoding
- #:*default-character-encoding*
- #:get-character-encoding
- #:enc-name
- #:enc-aliases
- #:enc-code-unit-size
- #:enc-max-units-per-char
- #:enc-native-endianness
- #:enc-decode-literal-code-unit-limit
- #:enc-encode-literal-code-unit-limit
- #:enc-use-bom
- #:enc-bom-encoding
- #:enc-nul-encoding
- #:enc-default-replacement
- #:ambiguous-encoding-p
- ;; concrete mappings
- #:instantiate-concrete-mappings
- #:encoder
- #:decoder
- #:octet-counter
- #:code-point-counter
- #:lookup-mapping
- #:with-simple-vector
- #:with-checked-simple-vector
- #:*suppress-character-coding-errors*
- ;; errors
- #:character-coding-error
- #:character-coding-error-encoding ; accessor
- #:character-coding-error-buffer ; accessor
- #:character-coding-error-position ; accessor
- #:character-decoding-error
- #:character-decoding-error-octets ; accessor
- #:character-encoding-error
- #:character-encoding-error-code ; accessor
- #:end-of-input-in-character
- #:character-out-of-range
- #:invalid-utf8-starter-byte
- #:invalid-utf8-continuation-byte
- #:overlong-utf8-sequence))
-
-(defpackage #:babel
- (:use #:common-lisp #:babel-encodings #:alexandria)
- (:import-from #:babel-encodings)
- (:export
- ;; types
- #:unicode-char
- #:unicode-char-code-limit
- #:unicode-string
- #:simple-unicode-string
- ;; fixed sharp-backslash reader
- #:enable-sharp-backslash-syntax
- #:set-sharp-backslash-syntax-in-readtable
- ;; external formats
- #:external-format
- #:make-external-format
- #:ensure-external-format
- #:external-format-encoding
- #:external-format-eol-style
- #:external-format-equal
- #:*default-eol-style*
- ;; general user API
- #:*default-character-encoding*
- #:list-character-encodings
- #:string-to-octets
- #:octets-to-string
- #:concatenate-strings-to-octets
- #:string-size-in-octets
- #:vector-size-in-chars
- ;; errors
- #:character-coding-error
- #:character-coding-error-encoding ; accessor
- #:character-coding-error-buffer ; accessor
- #:character-coding-error-position ; accessor
- #:character-decoding-error
- #:character-decoding-error-octets ; accessor
- #:character-encoding-error
- #:character-encoding-error-code ; accessor
- #:end-of-input-in-character
- #:character-out-of-range
- #:invalid-utf8-starter-byte
- #:invalid-utf8-continuation-byte
- #:overlong-utf8-sequence))
(DIR) diff --git a/3rdparties/software/babel-20171227-git/src/sharp-backslash.lisp b/3rdparties/software/babel-20171227-git/src/sharp-backslash.lisp
@@ -1,82 +0,0 @@
-;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
-;;;
-;;; sharp-backslash.lisp --- Alternative #\ dispatch code.
-;;;
-;;; Copyright (C) 2007-2009, Luis Oliveira <loliveira@common-lisp.net>
-;;;
-;;; Permission is hereby granted, free of charge, to any person
-;;; obtaining a copy of this software and associated documentation
-;;; files (the "Software"), to deal in the Software without
-;;; restriction, including without limitation the rights to use, copy,
-;;; modify, merge, publish, distribute, sublicense, and/or sell copies
-;;; of the Software, and to permit persons to whom the Software is
-;;; furnished to do so, subject to the following conditions:
-;;;
-;;; The above copyright notice and this permission notice shall be
-;;; included in all copies or substantial portions of the Software.
-;;;
-;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
-;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
-;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
-;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
-;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
-;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
-;;; DEALINGS IN THE SOFTWARE.
-
-(in-package #:babel)
-
-#-allegro
-(defun sharp-backslash-reader (original-reader stream char numarg)
- (let ((1st-char (read-char stream)))
- (if (and (char-equal 1st-char #\u)
- ;; because #\z is not a digit char...
- (digit-char-p (peek-char nil stream nil #\z) 16))
- ;; something better than READ would be nice here
- (let ((token (let ((*read-base* 16)) (read stream))))
- (if (typep token 'babel-encodings::code-point)
- (code-char token)
- (if *read-suppress*
- nil
- (simple-reader-error
- stream "Unrecognized character name: u~A" token))))
- (funcall original-reader
- (make-concatenated-stream (make-string-input-stream
- (string 1st-char))
- stream)
- char
- numarg))))
-
-;;; Allegro's PEEK-CHAR seems broken in some situations, and the code
-;;; above would generate an error about too many calls to UNREAD-CHAR.
-;;; Then Allegro's original SHARP-BACKSLASH wants to UNREAD-CHAR
-;;; twice, very weird. This is the best workaround I could think of.
-;;; It sucks.
-#+allegro
-(defun sharp-backslash-reader (original-reader stream char numarg)
- (let* ((1st-char (read-char stream))
- (rest (ignore-errors (excl::read-extended-token stream)))
- (code (when (and rest (char-equal 1st-char #\u))
- (ignore-errors (parse-integer rest :radix 16)))))
- (if code
- (code-char code)
- (with-input-from-string
- (s (concatenate 'string "#\\" (string 1st-char) rest))
- (read-char s)
- (read-char s)
- (funcall original-reader s char numarg)))))
-
-(defun make-sharp-backslash-reader ()
- (let ((original-sharp-backslash (get-dispatch-macro-character #\# #\\)))
- (lambda (stream char numarg)
- (sharp-backslash-reader original-sharp-backslash stream char numarg))))
-
-(defmacro enable-sharp-backslash-syntax ()
- `(eval-when (:compile-toplevel :execute)
- (setf *readtable* (copy-readtable *readtable*))
- (set-sharp-backslash-syntax-in-readtable)
- (values)))
-
-(defun set-sharp-backslash-syntax-in-readtable ()
- (set-dispatch-macro-character #\# #\\ (make-sharp-backslash-reader))
- (values))
(DIR) diff --git a/3rdparties/software/babel-20171227-git/src/streams.lisp b/3rdparties/software/babel-20171227-git/src/streams.lisp
@@ -1,436 +0,0 @@
-;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
-;;;
-;;; streams.lisp --- Conversions between strings and UB8 vectors.
-;;;
-;;; Copyright (c) 2005-2007, Dr. Edmund Weitz. All rights reserved.
-;;; Copyright (c) 2008, Attila Lendvai. All rights reserved.
-;;;
-;;; Redistribution and use in source and binary forms, with or without
-;;; modification, are permitted provided that the following conditions
-;;; are met:
-;;;
-;;; * Redistributions of source code must retain the above copyright
-;;; notice, this list of conditions and the following disclaimer.
-;;;
-;;; * Redistributions in binary form must reproduce the above
-;;; copyright notice, this list of conditions and the following
-;;; disclaimer in the documentation and/or other materials
-;;; provided with the distribution.
-;;;
-;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED
-;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
-;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
-;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
-;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
-;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
-;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
-;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
-;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
-;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
-;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-
-;;; STATUS
-;;;
-;;; - in-memory output streams support binary/bivalent/character
-;;; element-types and file-position
-
-;;; TODO
-;;;
-;;; - filter-stream types/mixins that can wrap a binary stream and
-;;; turn it into a bivalent/character stream
-;;; - in-memory input streams with file-position similar to in-memory
-;;; output streams
-;;; - in-memory input/output streams?
-
-(in-package #:babel)
-
-(defpackage #:babel-streams
- (:use #:common-lisp #:babel #:trivial-gray-streams #:alexandria)
- (:export
- #:in-memory-stream
- #:vector-output-stream
- #:vector-input-stream
- #:make-in-memory-output-stream
- #:make-in-memory-input-stream
- #:get-output-stream-sequence
- #:with-output-to-sequence
- #:with-input-from-sequence))
-
-(in-package :babel-streams)
-
-(declaim (inline check-if-open check-if-accepts-octets
- check-if-accepts-characters stream-accepts-characters?
- stream-accepts-octets? vector-extend
- extend-vector-output-stream-buffer))
-
-(defgeneric get-output-stream-sequence (stream &key &allow-other-keys))
-
-;;;; Some utilities (on top due to inlining)
-
-(defun vector-extend (extension vector &key (start 0) (end (length extension)))
- ;; copied over from cl-quasi-quote
- (declare (optimize speed)
- (type vector extension vector)
- (type array-index start end))
- (let* ((original-length (length vector))
- (extension-length (- end start))
- (new-length (+ original-length extension-length))
- (original-dimension (array-dimension vector 0)))
- (when (< original-dimension new-length)
- (setf vector
- (adjust-array vector (max (* 2 original-dimension) new-length))))
- (setf (fill-pointer vector) new-length)
- (replace vector extension :start1 original-length :start2 start :end2 end)
- vector))
-
-(defclass in-memory-stream (trivial-gray-stream-mixin)
- ((element-type ; :default means bivalent
- :initform :default :initarg :element-type :accessor element-type-of)
- (external-format
- :initform (ensure-external-format *default-character-encoding*)
- :initarg :external-format :accessor external-format-of)
- #+cmu
- (open-p
- :initform t :accessor in-memory-stream-open-p
- :documentation "For CMUCL we have to keep track of this manually."))
- (:documentation "An IN-MEMORY-STREAM is a binary stream that reads octets
- from or writes octets to a sequence in RAM."))
-
-(defmethod stream-element-type ((self in-memory-stream))
- ;; stream-element-type is a CL symbol, we may not install an accessor on it.
- ;; so, go through this extra step.
- (element-type-of self))
-
-(defun stream-accepts-octets? (stream)
- (let ((element-type (element-type-of stream)))
- (or (eq element-type :default)
- (equal element-type '(unsigned-byte 8))
- (subtypep element-type '(unsigned-byte 8)))))
-
-(defun stream-accepts-characters? (stream)
- (let ((element-type (element-type-of stream)))
- (member element-type '(:default character base-char))))
-
-(defclass in-memory-input-stream (in-memory-stream fundamental-binary-input-stream)
- ()
- (:documentation "An IN-MEMORY-INPUT-STREAM is a binary stream that reads
- octets from a sequence in RAM."))
-
-#+cmu
-(defmethod output-stream-p ((stream in-memory-input-stream))
- "Explicitly states whether this is an output stream."
- (declare (optimize speed))
- nil)
-
-(defclass in-memory-output-stream (in-memory-stream
- fundamental-binary-output-stream)
- ()
- (:documentation "An IN-MEMORY-OUTPUT-STREAM is a binary stream that
- writes octets to a sequence in RAM."))
-
-#+cmu
-(defmethod input-stream-p ((stream in-memory-output-stream))
- "Explicitly states whether this is an input stream."
- (declare (optimize speed))
- nil)
-
-(defun make-in-memory-output-stream (&key (element-type :default)
- external-format
- initial-buffer-size)
- "Returns a binary output stream which accepts objects of type
-ELEMENT-TYPE \(a subtype of OCTET) and makes available a sequence that
-contains the octes that were actually output."
- (declare (optimize speed))
- (unless external-format
- (setf external-format *default-character-encoding*))
- (when (eq element-type :bivalent)
- (setf element-type :default))
- (make-instance 'vector-output-stream
- :vector (make-vector-stream-buffer
- :element-type
- (cond
- ((or (eq element-type :default)
- (equal element-type '(unsigned-byte 8)))
- '(unsigned-byte 8))
- ((eq element-type 'character)
- 'character)
- ((subtypep element-type '(unsigned-byte 8))
- '(unsigned-byte 8))
- (t (error "Illegal element-type ~S" element-type)))
- :initial-size initial-buffer-size)
- :element-type element-type
- :external-format (ensure-external-format external-format)))
-
-(defun make-in-memory-input-stream (data &key (element-type :default)
- external-format)
- "Returns a binary input stream which provides the elements of DATA when read."
- (declare (optimize speed))
- (unless external-format
- (setf external-format *default-character-encoding*))
- (when (eq element-type :bivalent)
- (setf element-type :default))
- (make-instance 'vector-input-stream
- :vector data
- :element-type element-type
- :end (length data)
- :external-format (ensure-external-format external-format)))
-
-(defclass vector-stream ()
- ((vector
- :initarg :vector :accessor vector-stream-vector
- :documentation "The underlying vector of the stream which \(for output)
- must always be adjustable and have a fill pointer.")
- (index
- :initform 0 :initarg :index :accessor vector-stream-index
- :type (integer 0 #.array-dimension-limit)
- :documentation "An index into the underlying vector denoting the
- current position."))
- (:documentation
- "A VECTOR-STREAM is a mixin for IN-MEMORY streams where the underlying
- sequence is a vector."))
-
-(defclass vector-input-stream (vector-stream in-memory-input-stream)
- ((end
- :initarg :end :accessor vector-stream-end
- :type (integer 0 #.array-dimension-limit)
- :documentation "An index into the underlying vector denoting the end
- of the available data."))
- (:documentation "A binary input stream that gets its data from an
- associated vector of octets."))
-
-(defclass vector-output-stream (vector-stream in-memory-output-stream)
- ()
- (:documentation
- "A binary output stream that writes its data to an associated vector."))
-
-(define-condition in-memory-stream-error (stream-error)
- ()
- (:documentation "Superclass for all errors related to IN-MEMORY streams."))
-
-(define-condition in-memory-stream-closed-error (in-memory-stream-error)
- ()
- (:report (lambda (condition stream)
- (format stream "~S is closed."
- (stream-error-stream condition))))
- (:documentation "An error that is signalled when someone is trying to read
- from or write to a closed IN-MEMORY stream."))
-
-(define-condition wrong-element-type-stream-error (stream-error)
- ((expected-type :accessor expected-type-of :initarg :expected-type))
- (:report (lambda (condition output)
- (let ((stream (stream-error-stream condition)))
- (format output "The element-type of ~S is ~S while expecting ~
- a stream that accepts ~S."
- stream (element-type-of stream)
- (expected-type-of condition))))))
-
-(defun wrong-element-type-stream-error (stream expected-type)
- (error 'wrong-element-type-stream-error
- :stream stream :expected-type expected-type))
-
-#+cmu
-(defmethod open-stream-p ((stream in-memory-stream))
- "Returns a true value if STREAM is open. See ANSI standard."
- (declare (optimize speed))
- (in-memory-stream-open-p stream))
-
-#+cmu
-(defmethod close ((stream in-memory-stream) &key abort)
- "Closes the stream STREAM. See ANSI standard."
- (declare (ignore abort) (optimize speed))
- (prog1
- (in-memory-stream-open-p stream)
- (setf (in-memory-stream-open-p stream) nil)))
-
-(defun check-if-open (stream)
- "Checks if STREAM is open and signals an error otherwise."
- (declare (optimize speed))
- (unless (open-stream-p stream)
- (error 'in-memory-stream-closed-error :stream stream)))
-
-(defun check-if-accepts-octets (stream)
- (declare (optimize speed))
- (unless (stream-accepts-octets? stream)
- (wrong-element-type-stream-error stream '(unsigned-byte 8))))
-
-(defun check-if-accepts-characters (stream)
- (declare (optimize speed))
- (unless (stream-accepts-characters? stream)
- (wrong-element-type-stream-error stream 'character)))
-
-(defmethod stream-read-byte ((stream vector-input-stream))
- "Reads one byte and increments INDEX pointer unless we're beyond END pointer."
- (declare (optimize speed))
- (check-if-open stream)
- (let ((index (vector-stream-index stream)))
- (cond ((< index (vector-stream-end stream))
- (incf (vector-stream-index stream))
- (aref (vector-stream-vector stream) index))
- (t :eof))))
-
-#+#:ignore
-(defmethod stream-read-char ((stream vector-input-stream))
- ;; TODO
- )
-
-(defmethod stream-listen ((stream vector-input-stream))
- "Checking whether INDEX is beyond END."
- (declare (optimize speed))
- (check-if-open stream)
- (< (vector-stream-index stream) (vector-stream-end stream)))
-
-(defmethod stream-read-sequence ((stream vector-input-stream)
- sequence start end &key)
- (declare (optimize speed) (type array-index start end))
- ;; TODO check the sequence type, assert for the element-type and use
- ;; the external-format.
- (loop with vector-end of-type array-index = (vector-stream-end stream)
- with vector = (vector-stream-vector stream)
- for index from start below end
- for vector-index of-type array-index = (vector-stream-index stream)
- while (< vector-index vector-end)
- do (setf (elt sequence index)
- (aref vector vector-index))
- (incf (vector-stream-index stream))
- finally (return index)))
-
-(defmethod stream-write-byte ((stream vector-output-stream) byte)
- "Writes a byte \(octet) by extending the underlying vector."
- (declare (optimize speed))
- (check-if-open stream)
- (check-if-accepts-octets stream)
- (vector-push-extend byte (vector-stream-vector stream))
- (incf (vector-stream-index stream))
- byte)
-
-(defun extend-vector-output-stream-buffer (extension stream &key (start 0)
- (end (length extension)))
- (declare (optimize speed)
- (type array-index start end)
- (type vector extension))
- (vector-extend extension (vector-stream-vector stream) :start start :end end)
- (incf (vector-stream-index stream) (- end start))
- (values))
-
-(defmethod stream-write-char ((stream vector-output-stream) char)
- (declare (optimize speed))
- (check-if-open stream)
- (check-if-accepts-characters stream)
- ;; TODO this is naiive here, there's room for optimization
- (let ((octets (string-to-octets (string char)
- :encoding (external-format-of stream))))
- (extend-vector-output-stream-buffer octets stream))
- char)
-
-(defmethod stream-write-sequence ((stream vector-output-stream)
- sequence start end &key)
- "Just calls VECTOR-PUSH-EXTEND repeatedly."
- (declare (optimize speed)
- (type array-index start end))
- (etypecase sequence
- (string
- (if (stream-accepts-octets? stream)
- ;; TODO this is naiive here, there's room for optimization
- (let ((octets (string-to-octets sequence
- :encoding (external-format-of stream)
- :start start
- :end end)))
- (extend-vector-output-stream-buffer octets stream))
- (progn
- (assert (stream-accepts-characters? stream))
- (extend-vector-output-stream-buffer sequence stream
- :start start :end end))))
- ((vector (unsigned-byte 8))
- ;; specialized branch to help inlining
- (check-if-accepts-octets stream)
- (extend-vector-output-stream-buffer sequence stream :start start :end end))
- (vector
- (check-if-accepts-octets stream)
- (extend-vector-output-stream-buffer sequence stream :start start :end end)))
- sequence)
-
-(defmethod stream-write-string ((stream vector-output-stream)
- string &optional (start 0) (end (length string)))
- (stream-write-sequence stream string start (or end (length string))))
-
-(defmethod stream-line-column ((stream vector-output-stream))
- "Dummy line-column method that always returns NIL. Needed for
-character output streams."
- nil)
-
-(defmethod stream-file-position ((stream vector-stream))
- "Simply returns the index into the underlying vector."
- (declare (optimize speed))
- (vector-stream-index stream))
-
-(defun make-vector-stream-buffer (&key (element-type '(unsigned-byte 8))
- initial-size)
- "Creates and returns an array which can be used as the underlying vector
- for a VECTOR-OUTPUT-STREAM."
- (declare (optimize speed)
- (type (or null array-index) initial-size))
- (make-array (the array-index (or initial-size 32))
- :adjustable t
- :fill-pointer 0
- :element-type element-type))
-
-(defmethod get-output-stream-sequence ((stream in-memory-output-stream) &key (return-as 'vector))
- "Returns a vector containing, in order, all the octets that have
-been output to the IN-MEMORY stream STREAM. This operation clears any
-octets on STREAM, so the vector contains only those octets which have
-been output since the last call to GET-OUTPUT-STREAM-SEQUENCE or since
-the creation of the stream, whichever occurred most recently. If
-AS-LIST is true the return value is coerced to a list."
- (declare (optimize speed))
- (prog1
- (ecase return-as
- (vector (vector-stream-vector stream))
- (string (octets-to-string (vector-stream-vector stream)
- :encoding (external-format-of stream)))
- (list (coerce (vector-stream-vector stream) 'list)))
- (setf (vector-stream-vector stream) (make-vector-stream-buffer))))
-
-(defmacro with-output-to-sequence
- ((var &key (return-as ''vector) (element-type '':default)
- (external-format '*default-character-encoding*) initial-buffer-size)
- &body body)
- "Creates an IN-MEMORY output stream, binds VAR to this stream and
-then executes the code in BODY. The stream stores data of type
-ELEMENT-TYPE \(a subtype of OCTET). The stream is automatically closed
-on exit from WITH-OUTPUT-TO-SEQUENCE, no matter whether the exit is
-normal or abnormal. The return value of this macro is a vector \(or a
-list if AS-LIST is true) containing the octets that were sent to the
-stream within BODY."
- (multiple-value-bind (body declarations) (parse-body body)
- ;; this is here to stop SBCL complaining about binding them to NIL
- `(let ((,var (make-in-memory-output-stream
- :element-type ,element-type
- :external-format ,external-format
- :initial-buffer-size ,initial-buffer-size)))
- ,@declarations
- (unwind-protect
- (progn
- ,@body
- (get-output-stream-sequence ,var :return-as ,return-as))
- (close ,var)))))
-
-(defmacro with-input-from-sequence
- ((var data &key (element-type '':default)
- (external-format '*default-character-encoding*))
- &body body)
- "Creates an IN-MEMORY input stream that will return the values
-available in DATA, binds VAR to this stream and then executes the code
-in BODY. The stream stores data of type ELEMENT-TYPE \(a subtype of
-OCTET). The stream is automatically closed on exit from
-WITH-INPUT-FROM-SEQUENCE, no matter whether the exit is normal or
-abnormal. The return value of this macro is the return value of BODY."
- (multiple-value-bind (body declarations) (parse-body body)
- ;; this is here to stop SBCL complaining about binding them to NIL
- `(let ((,var (make-in-memory-input-stream
- ,data :element-type ,element-type
- :external-format ,external-format)))
- ,@declarations
- (unwind-protect
- (progn
- ,@body)
- (close ,var)))))
(DIR) diff --git a/3rdparties/software/babel-20171227-git/src/strings.lisp b/3rdparties/software/babel-20171227-git/src/strings.lisp
@@ -1,353 +0,0 @@
-;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
-;;;
-;;; strings.lisp --- Conversions between strings and UB8 vectors.
-;;;
-;;; Copyright (C) 2007, Luis Oliveira <loliveira@common-lisp.net>
-;;;
-;;; Permission is hereby granted, free of charge, to any person
-;;; obtaining a copy of this software and associated documentation
-;;; files (the "Software"), to deal in the Software without
-;;; restriction, including without limitation the rights to use, copy,
-;;; modify, merge, publish, distribute, sublicense, and/or sell copies
-;;; of the Software, and to permit persons to whom the Software is
-;;; furnished to do so, subject to the following conditions:
-;;;
-;;; The above copyright notice and this permission notice shall be
-;;; included in all copies or substantial portions of the Software.
-;;;
-;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
-;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
-;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
-;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
-;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
-;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
-;;; DEALINGS IN THE SOFTWARE.
-
-(in-package #:babel)
-
-;;; The usefulness of this string/octets interface of Babel's is very
-;;; limited on Lisps with 8-bit characters which will in effect only
-;;; support the latin-1 subset of Unicode. That is, all encodings are
-;;; supported but we can only store the first 256 code points in Lisp
-;;; strings. Support for using other 8-bit encodings for strings on
-;;; these Lisps could be added with an extra encoding/decoding step.
-;;; Supporting other encodings with larger code units would be silly
-;;; (it would break expectations about common string operations) and
-;;; better done with something like Closure's runes.
-
-;;; Can we handle unicode fully?
-(eval-when (:compile-toplevel :load-toplevel :execute)
- ;; The EVAL is just here to avoid warnings...
- (case (eval char-code-limit)
- (#x100 (pushnew '8-bit-chars *features*))
- (#x10000 (pushnew 'ucs-2-chars *features*))
- (#x110000 #| yay |#)
- ;; This is here mostly because if the CHAR-CODE-LIMIT is bigger
- ;; than #x11000, strange things might happen but we probably
- ;; shouldn't descriminate against other, smaller, values.
- (t (error "Strange CHAR-CODE-LIMIT (#x~X), bailing out."
- char-code-limit))))
-
-;;; Adapted from Ironclad. TODO: check if it's worthwhile adding
-;;; implementation-specific accessors such as SAP-REF-* for SBCL.
-(defmacro ub-get (vector index &optional (bytes 1) (endianness :ne))
- (let ((big-endian (member endianness
- '(:be #+big-endian :ne #+little-endian :re))))
- (once-only (vector index)
- `(logand
- ,(1- (ash 1 (* 8 bytes)))
- (logior
- ,@(loop for i from 0 below bytes
- for offset = (if big-endian i (- bytes i 1))
- for shift = (if big-endian
- (* (- bytes i 1) 8)
- (* offset 8))
- collect `(ash (aref ,vector (+ ,index ,offset)) ,shift)))))))
-
-(defmacro ub-set (value vector index &optional (bytes 1) (endianness :ne))
- (let ((big-endian (member endianness
- '(:be #+big-endian :ne #+little-endian :re))))
- `(progn
- ,@(loop for i from 1 to bytes
- for offset = (if big-endian (- bytes i) (1- i)) collect
- `(setf (aref ,vector (+ ,index ,offset))
- (ldb (byte 8 ,(* 8 (1- i))) ,value)))
- (values))))
-
-(defmacro string-get (string index)
- `(char-code (schar ,string ,index)))
-
-(defmacro string-set (code string index)
- `(setf (schar ,string ,index) (code-char ,code)))
-
-;;; SIMPLE-BASE-STRING would also be a subtype of SIMPLE-STRING so we
-;;; don't use that because on SBCL BASE-CHARs can only hold ASCII.
-;;; Also, with (> SPEED SAFETY) (setf (schar base-str n) big-char)
-;;; will quietly work, sort of.
-;;;
-;;; XXX: test this on various lisps.
-
-(defconstant unicode-char-code-limit
- char-code-limit
- "An alias for CL:CHAR-CODE-LIMIT which might be lower than
-#x110000 on some Lisps.")
-
-(deftype unicode-char ()
- "This character type can hold any characters whose CHAR-CODEs
-are less than UNICODE-CHAR-CODE-LIMIT."
- #+lispworks 'lw:simple-char
- #-lispworks 'character)
-
-(deftype simple-unicode-string ()
- "Alias for (SIMPLE-ARRAY UNICODE-CHAR (*))."
- '(simple-array unicode-char (*)))
-
-(deftype unicode-string ()
- "Alias for (VECTOR UNICODE-CHAR *)."
- '(vector unicode-char *))
-
-(defparameter *string-vector-mappings*
- (instantiate-concrete-mappings
- ;; :optimize ((speed 3) (safety 0) (debug 0) (compilation-speed 0))
- :octet-seq-setter ub-set
- :octet-seq-getter ub-get
- :octet-seq-type (simple-array (unsigned-byte 8) (*))
- :code-point-seq-setter string-set
- :code-point-seq-getter string-get
- :code-point-seq-type simple-unicode-string))
-
-#+sbcl
-(defparameter *simple-base-string-vector-mappings*
- (instantiate-concrete-mappings
- ;; :optimize ((speed 3) (safety 0) (debug 0) (compilation-speed 0))
- :instantiate-decoders nil
- :octet-seq-setter ub-set
- :octet-seq-getter ub-get
- :octet-seq-type (simple-array (unsigned-byte 8) (*))
- :code-point-seq-setter string-set
- :code-point-seq-getter string-get
- :code-point-seq-type simple-base-string))
-
-;;; Do we want a more a specific error condition here?
-(defun check-vector-bounds (vector start end)
- (unless (<= 0 start end (length vector))
- (error "Invalid start (~A) and end (~A) values for vector of length ~A."
- start end (length vector))))
-
-(defmacro with-simple-vector (((v vector) (s start) (e end)) &body body)
- "If VECTOR is a displaced or adjustable array, binds V to the
-underlying simple vector, adds an adequate offset to START and
-END and binds those offset values to S and E. Otherwise, if
-VECTOR is already a simple array, it's simply bound to V with no
-further changes.
-
-START and END are unchecked and assumed to be within bounds.
-
-Note that in some Lisps, a slow copying implementation is
-necessary to obtain a simple vector thus V will be bound to a
-copy of VECTOR coerced to a simple-vector. Therefore, you
-shouldn't attempt to modify V."
- #+sbcl
- `(sb-kernel:with-array-data ((,v ,vector) (,s ,start) (,e ,end))
- ,@body)
- #+(or cmu scl)
- `(lisp::with-array-data ((,v ,vector) (,s ,start) (,e ,end))
- ,@body)
- #+openmcl
- (with-unique-names (offset)
- `(multiple-value-bind (,v ,offset)
- (ccl::array-data-and-offset ,vector)
- (let ((,s (+ ,start ,offset))
- (,e (+ ,end ,offset)))
- ,@body)))
- #+allegro
- (with-unique-names (offset)
- `(excl::with-underlying-simple-vector (,vector ,v ,offset)
- (let ((,e (+ ,end ,offset))
- (,s (+ ,start ,offset)))
- ,@body)))
- ;; slow, copying implementation
- #-(or sbcl cmu scl openmcl allegro)
- (once-only (vector)
- `(funcall (if (adjustable-array-p ,vector)
- #'call-with-array-data/copy
- #'call-with-array-data/fast)
- ,vector ,start ,end
- (lambda (,v ,s ,e) ,@body))))
-
-#-(or sbcl cmu scl openmcl allegro)
-(progn
- ;; Stolen from f2cl.
- (defun array-data-and-offset (array)
- (loop with offset = 0 do
- (multiple-value-bind (displaced-to index-offset)
- (array-displacement array)
- (when (null displaced-to)
- (return-from array-data-and-offset
- (values array offset)))
- (incf offset index-offset)
- (setf array displaced-to))))
-
- (defun call-with-array-data/fast (vector start end fn)
- (multiple-value-bind (data offset)
- (array-data-and-offset vector)
- (funcall fn data (+ offset start) (+ offset end))))
-
- (defun call-with-array-data/copy (vector start end fn)
- (funcall fn (replace (make-array (- end start) :element-type
- (array-element-type vector))
- vector :start2 start :end2 end)
- 0 (- end start))))
-
-(defmacro with-checked-simple-vector (((v vector) (s start) (e end)) &body body)
- "Like WITH-SIMPLE-VECTOR but bound-checks START and END."
- (once-only (vector start)
- `(let ((,e (or ,end (length ,vector))))
- (check-vector-bounds ,vector ,start ,e)
- (with-simple-vector ((,v ,vector) (,s ,start) (,e ,e))
- ,@body))))
-
-;;; Future features these functions should have:
-;;;
-;;; * null-terminate
-;;; * specify target vector/string + offset
-;;; * documentation :)
-
-(declaim (inline octets-to-string string-to-octets string-size-in-octets
- vector-size-in-chars concatenate-strings-to-octets
- bom-vector))
-
-(defun octets-to-string (vector &key (start 0) end
- (errorp (not *suppress-character-coding-errors*))
- (encoding *default-character-encoding*))
- (check-type vector (vector (unsigned-byte 8)))
- (with-checked-simple-vector ((vector vector) (start start) (end end))
- (declare (type (simple-array (unsigned-byte 8) (*)) vector))
- (let ((*suppress-character-coding-errors* (not errorp))
- (mapping (lookup-mapping *string-vector-mappings* encoding)))
- (multiple-value-bind (size new-end)
- (funcall (code-point-counter mapping) vector start end -1)
- ;; TODO we could optimize ASCII here: the result should
- ;; be a simple-base-string filled using code-char...
- (let ((string (make-string size :element-type 'unicode-char)))
- (funcall (decoder mapping) vector start new-end string 0)
- string)))))
-
-(defun bom-vector (encoding use-bom)
- (check-type use-bom (member :default t nil))
- (the simple-vector
- (if (null use-bom)
- #()
- (let ((enc (typecase encoding
- (external-format (external-format-encoding encoding))
- (t (get-character-encoding encoding)))))
- (if (or (eq use-bom t)
- (and (eq use-bom :default) (enc-use-bom enc)))
- ;; VALUES avoids a "type assertion too complex to check" note.
- (values (enc-bom-encoding enc))
- #())))))
-
-(defun string-to-octets (string &key (encoding *default-character-encoding*)
- (start 0) end (use-bom :default)
- (errorp (not *suppress-character-coding-errors*)))
- (declare (optimize (speed 3) (safety 2)))
- (let ((*suppress-character-coding-errors* (not errorp)))
- (etypecase string
- ;; On some lisps (e.g. clisp and ccl) all strings are BASE-STRING and all
- ;; characters are BASE-CHAR. So, only enable this optimization for
- ;; selected targets.
- #+sbcl
- (simple-base-string
- (unless end
- (setf end (length string)))
- (check-vector-bounds string start end)
- (let* ((mapping (lookup-mapping *simple-base-string-vector-mappings*
- encoding))
- (bom (bom-vector encoding use-bom))
- (bom-length (length bom))
- ;; OPTIMIZE: we could use the (length string) information here
- ;; because it's a simple-base-string where each character <= 127
- (result (make-array
- (+ (the array-index
- (funcall (the function (octet-counter mapping))
- string start end -1))
- bom-length)
- :element-type '(unsigned-byte 8))))
- (replace result bom)
- (funcall (the function (encoder mapping))
- string start end result bom-length)
- result))
- (string
- ;; FIXME: we shouldn't really need that coercion to UNICODE-STRING
- ;; but we kind of because it's declared all over. To avoid that,
- ;; we'd need different types for input and output strings. Or maybe
- ;; this is not a problem; figure that out.
- (with-checked-simple-vector ((string (coerce string 'unicode-string))
- (start start) (end end))
- (declare (type simple-unicode-string string))
- (let* ((mapping (lookup-mapping *string-vector-mappings* encoding))
- (bom (bom-vector encoding use-bom))
- (bom-length (length bom))
- (result (make-array
- (+ (the array-index
- (funcall (the function (octet-counter mapping))
- string start end -1))
- bom-length)
- :element-type '(unsigned-byte 8))))
- (replace result bom)
- (funcall (the function (encoder mapping))
- string start end result bom-length)
- result))))))
-
-(defun concatenate-strings-to-octets (encoding &rest strings)
- "Optimized equivalent of
-\(string-to-octets \(apply #'concatenate 'string strings)
- :encoding encoding)"
- (declare (dynamic-extent strings))
- (let* ((mapping (lookup-mapping *string-vector-mappings* encoding))
- (octet-counter (octet-counter mapping))
- (vector (make-array
- (the array-index
- (reduce #'+ strings
- :key (lambda (string)
- (funcall octet-counter
- string 0 (length string) -1))))
- :element-type '(unsigned-byte 8)))
- (current-index 0))
- (declare (type array-index current-index))
- (dolist (string strings)
- (check-type string string)
- (with-checked-simple-vector ((string (coerce string 'unicode-string))
- (start 0) (end (length string)))
- (declare (type simple-unicode-string string))
- (incf current-index
- (funcall (encoder mapping)
- string start end vector current-index))))
- vector))
-
-(defun string-size-in-octets (string &key (start 0) end (max -1 maxp)
- (errorp (not *suppress-character-coding-errors*))
- (encoding *default-character-encoding*))
- (check-type string string)
- (with-checked-simple-vector ((string (coerce string 'unicode-string))
- (start start) (end end))
- (declare (type simple-unicode-string string))
- (let ((mapping (lookup-mapping *string-vector-mappings* encoding))
- (*suppress-character-coding-errors* (not errorp)))
- (when maxp (assert (plusp max)))
- (funcall (octet-counter mapping) string start end max))))
-
-(defun vector-size-in-chars (vector &key (start 0) end (max -1 maxp)
- (errorp (not *suppress-character-coding-errors*))
- (encoding *default-character-encoding*))
- (check-type vector (vector (unsigned-byte 8)))
- (with-checked-simple-vector ((vector vector) (start start) (end end))
- (declare (type (simple-array (unsigned-byte 8) (*)) vector))
- (let ((mapping (lookup-mapping *string-vector-mappings* encoding))
- (*suppress-character-coding-errors* (not errorp)))
- (when maxp (assert (plusp max)))
- (funcall (code-point-counter mapping) vector start end max))))
-
-(declaim (notinline octets-to-string string-to-octets string-size-in-octets
- vector-size-in-chars concatenate-strings-to-octets))
(DIR) diff --git a/3rdparties/software/babel-20171227-git/tests/ascii.txt b/3rdparties/software/babel-20171227-git/tests/ascii.txt
@@ -1,212 +0,0 @@
-
-UTF-8 encoded sample plain-text file
-
-
-Markus Kuhn [maks kun] <http://www.cl.cam.ac.uk/~mgk25/> 2002-07-25
-
-
-The ASCII compatible UTF-8 encoding used in this plain-text file
-is defined in Unicode, ISO 10646-1, and RFC 2279.
-
-
-Using Unicode/UTF-8, you can write in emails and source code things such as
-
-Mathematics and sciences:
-
- Eda = Q, n , f(i) = g(i),
- a+b
- x: x = x, = ( ),
- c
- ,
-
- < a b c d (A B),
- a-b
- 2H + O 2HO, R = 4.7 k, 200 mm i=1
-
-Linguistics and dictionaries:
-
- i ntnnl fntk sosien
- Y [psiln], Yen [jn], Yoga [jog]
-
-APL:
-
- ((VV)=V)/V,V
-
-Nicer typography in plain text files:
-
-
-
- single and double quotes
-
- Curly apostrophes: Weve been here
-
- Latin-1 apostrophe and accents: '`
-
- deutsche Anfhrungszeichen
-
- , , , , 34, , 5/+5, ,
-
- ASCII safety test: 1lI|, 0OD, 8B
-
- the euro symbol: 14.95
-
-
-
-Combining characters:
-
- STARGTE SG-1, a = v = r, a b
-
-Greek (in Polytonic):
-
- The Greek anthem:
-
-
- ,
-
- .
-
-
-
-
- , , !
-
- From a speech of Demosthenes in the 4th century BC:
-
- , ,
-
-
- ,
- ,
- .
- , ,
- . ,
-
- , ,
-
- ,
- . ,
-
- ,
- .
-
- ,
-
-Georgian:
-
- From a Unicode conference invitation:
-
- Unicode-
- , 10-12 ,
- . , .
- Unicode-,
- , Unicode-
- , , ,
- .
-
-Russian:
-
- From a Unicode conference invitation:
-
-
- Unicode, 10-12 1997 .
-
- Unicode, ,
- Unicode
- , , .
-
-Thai (UCS Level 2):
-
- Excerpt from a poetry on The Romance of The Three Kingdoms (a Chinese
- classic 'San Gua'):
-
- [----------------------------|------------------------]
-
-
-
-
-
-
-
-
-
- (The above is a two-column text. If combining characters are handled
- correctly, the lines of the second column should be aligned with the
- | character above.)
-
-Ethiopian:
-
- Proverbs in the Amharic language:
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-Runes:
-
-
-
- (Old English, which transcribed into Latin reads 'He cwaeth that he
- bude thaem lande northweardum with tha Westsae.' and means 'He said
- that he lived in the northern land near the Western Sea.')
-
-Braille:
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
- (The first couple of paragraphs of "A Christmas Carol" by Dickens)
-
-Compact font selection example text:
-
- ABCDEFGHIJKLMNOPQRSTUVWXYZ /0123456789
- abcdefghijklmnopqrstuvwxyz
-
-
-
-Greetings in various languages:
-
- Hello world, ,
-
-Box drawing alignment tests:
-
-
-
-
-
-
-
-
-
(DIR) diff --git a/3rdparties/software/babel-20171227-git/tests/ascii.txt-utf8 b/3rdparties/software/babel-20171227-git/tests/ascii.txt-utf8
@@ -1,212 +0,0 @@
-
-UTF-8 encoded sample plain-text file
-
-
-Markus Kuhn [maks kun] <http://www.cl.cam.ac.uk/~mgk25/> 2002-07-25
-
-
-The ASCII compatible UTF-8 encoding used in this plain-text file
-is defined in Unicode, ISO 10646-1, and RFC 2279.
-
-
-Using Unicode/UTF-8, you can write in emails and source code things such as
-
-Mathematics and sciences:
-
- Eda = Q, n , f(i) = g(i),
- a+b
- x: x = x, = ( ),
- c
- ,
-
- < a b c d (A B),
- a-b
- 2H + O 2HO, R = 4.7 k, 200 mm i=1
-
-Linguistics and dictionaries:
-
- i ntnnl fntk sosien
- Y [psiln], Yen [jn], Yoga [jog]
-
-APL:
-
- ((VV)=V)/V,V
-
-Nicer typography in plain text files:
-
-
-
- single and double quotes
-
- Curly apostrophes: Weve been here
-
- Latin-1 apostrophe and accents: '`
-
- deutsche Anfhrungszeichen
-
- , , , , 34, , 5/+5, ,
-
- ASCII safety test: 1lI|, 0OD, 8B
-
- the euro symbol: 14.95
-
-
-
-Combining characters:
-
- STARGTE SG-1, a = v = r, a b
-
-Greek (in Polytonic):
-
- The Greek anthem:
-
-
- ,
-
- .
-
-
-
-
- , , !
-
- From a speech of Demosthenes in the 4th century BC:
-
- , ,
-
-
- ,
- ,
- .
- , ,
- . ,
-
- , ,
-
- ,
- . ,
-
- ,
- .
-
- ,
-
-Georgian:
-
- From a Unicode conference invitation:
-
- Unicode-
- , 10-12 ,
- . , .
- Unicode-,
- , Unicode-
- , , ,
- .
-
-Russian:
-
- From a Unicode conference invitation:
-
-
- Unicode, 10-12 1997 .
-
- Unicode, ,
- Unicode
- , , .
-
-Thai (UCS Level 2):
-
- Excerpt from a poetry on The Romance of The Three Kingdoms (a Chinese
- classic 'San Gua'):
-
- [----------------------------|------------------------]
-
-
-
-
-
-
-
-
-
- (The above is a two-column text. If combining characters are handled
- correctly, the lines of the second column should be aligned with the
- | character above.)
-
-Ethiopian:
-
- Proverbs in the Amharic language:
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-Runes:
-
-
-
- (Old English, which transcribed into Latin reads 'He cwaeth that he
- bude thaem lande northweardum with tha Westsae.' and means 'He said
- that he lived in the northern land near the Western Sea.')
-
-Braille:
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
- (The first couple of paragraphs of "A Christmas Carol" by Dickens)
-
-Compact font selection example text:
-
- ABCDEFGHIJKLMNOPQRSTUVWXYZ /0123456789
- abcdefghijklmnopqrstuvwxyz
-
-
-
-Greetings in various languages:
-
- Hello world, ,
-
-Box drawing alignment tests:
-
-
-
-
-
-
-
-
-
(DIR) diff --git a/3rdparties/software/babel-20171227-git/tests/benchmarks.lisp b/3rdparties/software/babel-20171227-git/tests/benchmarks.lisp
@@ -1,43 +0,0 @@
-;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
-;;;
-;;; benchmarks.lisp --- Benchmarks, Babel vs. other implementations.
-;;;
-;;; Copyright (C) 2007, Luis Oliveira <loliveira@common-lisp.net>
-;;;
-;;; Permission is hereby granted, free of charge, to any person
-;;; obtaining a copy of this software and associated documentation
-;;; files (the "Software"), to deal in the Software without
-;;; restriction, including without limitation the rights to use, copy,
-;;; modify, merge, publish, distribute, sublicense, and/or sell copies
-;;; of the Software, and to permit persons to whom the Software is
-;;; furnished to do so, subject to the following conditions:
-;;;
-;;; The above copyright notice and this permission notice shall be
-;;; included in all copies or substantial portions of the Software.
-;;;
-;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
-;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
-;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
-;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
-;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
-;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
-;;; DEALINGS IN THE SOFTWARE.
-
-(defpackage #:babel-benchmarks
- (:use #:cl #:babel))
-(in-package #:babel-benchmarks)
-
-(defun benchmark (enc file-name file-type &optional (n 100))
- (let* ((octets (read-test-file file-name file-type))
- (string (octets-to-string octets :encoding enc)))
- (write-line ";; testing SB-EXT:STRING-TO-OCTETS")
- (time (loop repeat n do
- (sb-ext:string-to-octets string :external-format enc)))
- (write-line ";; testing BABEL:STRING-TO-OCTETS")
- (time (loop repeat n do (string-to-octets string :encoding enc)))
- (write-line ";; testing SB-EXT:OCTETS-TO-STRING")
- (time (loop repeat n do
- (sb-ext:octets-to-string octets :external-format enc)))
- (write-line ";; testing BABEL:OCTETS-TO-STRING")
- (time (loop repeat n do (octets-to-string octets :encoding enc)))))
(DIR) diff --git a/3rdparties/software/babel-20171227-git/tests/ebcdic-us.txt b/3rdparties/software/babel-20171227-git/tests/ebcdic-us.txt
@@ -1 +0,0 @@
-%`@@@`@%%%ԁ@Ҥ@@@LzaaKKKKaan@@``%%%㈅@@@`@@@@@`@%@@@䕉k@@`k@@@K%%%䢉@䕉a`k@@@@@@@@@@@%%ԁ@@z%%@@@ń@~@k@@@@k@@M]@~@@M]k@@@@@@%@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@N@%@@z@@~@k@@@_@~@_M_@@]k@@@@@%@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@%@@@@@@@@@@@@k@@@@@@@@@@@@@@@@@@@@@@@@@@%@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@%@@@L@@@@@@@@@@@M@@]k@@@@@@@@@@@@%@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@`%@@@N@@@k@@~@K@k@@@@@@@@~@@@@%%Ӊ@@z%%@@@@@%@@@k@腕@k@薇@%%z%%@@MM]~]ak@@@@%%Չ@@@@@z%%@@%@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@%@@@@@@@@@@@@@@@@@@%@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@%@@@@@@ä@z@慥@@@%@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@%@@@@@@Ӂ`@@@z@}y@@%@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@%@@@@@@@@@@@@@@%@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@%@@@@@@k@k@k@k@k@k@aNk@k@@@@@@@%@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@%@@@@@@@@z@Ok@k@@@@@@%@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@%@@@@@@@@z@@K@@@@@@@@@@@%@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@%@@%%Ö@z%%@@@`k@@~@@~@k@@@%%Ǚ@M@ז]z%%@@㈅@Ǚ@z%%@@@@@@%@@@@@k%@@@@@@%@@@@@@@K%%@@@@@%@@@@@%@@@@@%@@k@@k@Z%%@@ƙ@@@@ą@@@@@z%%@@@@@@k@@@k%@@@@@@@@@@@%@@@@@@@@@@%@@@@@k@@@%@@@@k@@@@@@%@@@@@K@@@@@%@@@@@@@@k@@@k%@@@@@@@K@@k@@%@@@@@@@@@@@@%@@k@@@@@@@k@@%@@@@@@@@@%@@@@@@k@@@%@@K@@@@@k@@@@%@@@@@@@@@@@%@@@@@k@@@@%@@@@@K%%@@k@@%%Džz%%@@ƙ@@䕉@@z%%@@@@@@䕉`@@%@@@k@@@`@k%@@K@k@K@@@@%@@@@@@@@䕉`k%@@@@k@䕉`@%@@@k@@@k@k%@@@@@@@K%%٤z%%@@ƙ@@䕉@@z%%@@@@@@@@%@@䕉k@@@`@@@@@@@K%@@@@@@@@@@%@@@@䕉k@@@k@@%@@@䕉@@@@@@%@@k@k@@@@@K%%㈁@M@Ӆ@]z%%@@ŧ@@@@@㈅@ٖ@@㈅@㈙@҉@M@È%@@@}⁕@Ǥ}]z%%@@````````````````````````````O````````````````````````%@@@@@@@%@@@@@@@@@%@@@@@@@@@@@@@@@%@@@@@@@@@@@%@@@@@@@@@@%@@@@@@@@@@@@%@@@@@@@@@@@@@@%@@@@@@@@@@@@@@%%@@M㈅@@@@`@K@Ɇ@@@@%@@k@@@@@@@@@@@%@@O@@K]%%ţz%%@@י@@@@z%%@@@@@%@@@@@%@@@@@%@@@@@@@%@@@@@%@@@@@%@@@%@@@@@@%@@@@@%@@@@@@@%@@@@@@%@@@@@@@%@@@@@%@@@@@@@%@@@@@@@%@@@@@%@@@@@@%@@@@@%%٤z%%@@@@@@@@@@@@@%%@@M֓@ŕk@@@@Ӂ@@}ȅ@@@%@@@@@@@@慢K}@@@}ȅ@%@@@@@@@@@@@慢@⅁K}]%%z%%@@@@@@%%@@@@@@@@@@@%@@@@@@@@@@%@@@@@@@@@%@@@@@@@@@%@@@@@@@@@@%@@@@@@@%%@@@@@@@@@%%@@@@@@@@@@@@%@@@@@@@@@%@@@@@@@@@@%@@@@@@@@@@%@@@@@@@@@@%@@@@@@@@@%@@@@@@@@@@@%@@@@@@@@@%@@@@@@@@%%@@M㈅@@@@@@@È@Á@@ĉ]%%Ö@@@@z%%@@@a%@@@%@@@@%@@@@@%%Ǚ@@@z%%@@ȅ@k@@k@%%@@@z@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@%@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@%@@@@@@@@@@@@@@@@@@@@@@@@%@@@@@@@@@@@@@@@@@@@@%@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@%@@@@@@@@@@@@@@@@@@@@@@@@@@@%@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@%@@@@@@@@@@@@@@@@@@@@@%@@@@@@@@@@@@@@@@@@@@%@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@%
-\ No newline at end of file
(DIR) diff --git a/3rdparties/software/babel-20171227-git/tests/ebcdic-us.txt-utf8 b/3rdparties/software/babel-20171227-git/tests/ebcdic-us.txt-utf8
@@ -1,212 +0,0 @@
-
-UTF-8 encoded sample plain-text file
-
-
-Markus Kuhn maks kun <http://www.cl.cam.ac.uk/~mgk25/> 2002-07-25
-
-
-The ASCII compatible UTF-8 encoding used in this plain-text file
-is defined in Unicode, ISO 10646-1, and RFC 2279.
-
-
-Using Unicode/UTF-8, you can write in emails and source code things such as
-
-Mathematics and sciences:
-
- Eda = Q, n , f(i) = g(i),
- a+b
- x: x = x, ¬ = ¬(¬ ),
- c
- ,
-
- < a b c d (A B),
- a-b
- 2H + O 2HO, R = 4.7 k, 200 mm i=1
-
-Linguistics and dictionaries:
-
- i ntnnl fntk sosien
- Y psiln, Yen jn, Yoga jog
-
-APL:
-
- ((VV)=V)/V,V
-
-Nicer typography in plain text files:
-
-
-
- single and double quotes
-
- Curly apostrophes: Weve been here
-
- Latin-1 apostrophe and accents: '`
-
- deutsche Anfhrungszeichen
-
- , , , , 34, , 5/+5, ,
-
- ASCII safety test: 1lI|, 0OD, 8B
-
- the euro symbol: 14.95
-
-
-
-Combining characters:
-
- STARGTE SG-1, a = v = r, a b
-
-Greek (in Polytonic):
-
- The Greek anthem:
-
-
- ,
-
- .
-
-
-
-
- , , !
-
- From a speech of Demosthenes in the 4th century BC:
-
- , ,
-
-
- ,
- ,
- .
- , ,
- . ,
-
- , ,
-
- ,
- . ,
-
- ,
- .
-
- ,
-
-Georgian:
-
- From a Unicode conference invitation:
-
- Unicode-
- , 10-12 ,
- . , .
- Unicode-,
- , Unicode-
- , , ,
- .
-
-Russian:
-
- From a Unicode conference invitation:
-
-
- Unicode, 10-12 1997 .
-
- Unicode, ,
- Unicode
- , , .
-
-Thai (UCS Level 2):
-
- Excerpt from a poetry on The Romance of The Three Kingdoms (a Chinese
- classic 'San Gua'):
-
- ----------------------------|------------------------
-
-
-
-
-
-
-
-
-
- (The above is a two-column text. If combining characters are handled
- correctly, the lines of the second column should be aligned with the
- | character above.)
-
-Ethiopian:
-
- Proverbs in the Amharic language:
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-Runes:
-
-
-
- (Old English, which transcribed into Latin reads 'He cwaeth that he
- bude thaem lande northweardum with tha Westsae.' and means 'He said
- that he lived in the northern land near the Western Sea.')
-
-Braille:
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
- (The first couple of paragraphs of "A Christmas Carol" by Dickens)
-
-Compact font selection example text:
-
- ABCDEFGHIJKLMNOPQRSTUVWXYZ /0123456789
- abcdefghijklmnopqrstuvwxyz
-
-
-
-Greetings in various languages:
-
- Hello world, ,
-
-Box drawing alignment tests:
-
-
-
-
-
-
-
-
-
(DIR) diff --git a/3rdparties/software/babel-20171227-git/tests/gen-test-files.sh b/3rdparties/software/babel-20171227-git/tests/gen-test-files.sh
@@ -1,37 +0,0 @@
-#!/bin/sh
-# -*- indent-tabs-mode: nil -*-
-#
-# gen-test-files.sh --- Generates test files with iconv.
-#
-# Copyright (C) 2007, Luis Oliveira <loliveira@common-lisp.net>
-#
-# Permission is hereby granted, free of charge, to any person
-# obtaining a copy of this software and associated documentation
-# files (the "Software"), to deal in the Software without
-# restriction, including without limitation the rights to use, copy,
-# modify, merge, publish, distribute, sublicense, and/or sell copies
-# of the Software, and to permit persons to whom the Software is
-# furnished to do so, subject to the following conditions:
-#
-# The above copyright notice and this permission notice shall be
-# included in all copies or substantial portions of the Software.
-#
-# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
-# EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
-# MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
-# NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
-# HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
-# WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-# OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
-# DEALINGS IN THE SOFTWARE.
-
-INPUT_FILE="utf-8.txt"
-INPUT_ENC="utf-8"
-CHARSETS=('ebcdic-us' 'ascii' 'iso-8859-1' 'utf-16' 'utf-32')
-
-echo "Converting $INPUT_FILE..."
-for c in ${CHARSETS[@]}; do
- echo " ${c}.txt";
- iconv -c -f $INPUT_ENC -t $c $INPUT_FILE > ${c}.txt;
- iconv -f $c -t 'utf-8' ${c}.txt > ${c}.txt-utf8;
-done
(DIR) diff --git a/3rdparties/software/babel-20171227-git/tests/streams.lisp b/3rdparties/software/babel-20171227-git/tests/streams.lisp
@@ -1,45 +0,0 @@
-;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
-;;;
-;;; streams.lisp --- Unit and regression tests for Babel streams.
-;;;
-;;; Copyright (C) 2007, Attila Lendva <attila.lendvai@gmail.com>
-;;;
-;;; Permission is hereby granted, free of charge, to any person
-;;; obtaining a copy of this software and associated documentation
-;;; files (the "Software"), to deal in the Software without
-;;; restriction, including without limitation the rights to use, copy,
-;;; modify, merge, publish, distribute, sublicense, and/or sell copies
-;;; of the Software, and to permit persons to whom the Software is
-;;; furnished to do so, subject to the following conditions:
-;;;
-;;; The above copyright notice and this permission notice shall be
-;;; included in all copies or substantial portions of the Software.
-;;;
-;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
-;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
-;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
-;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
-;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
-;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
-;;; DEALINGS IN THE SOFTWARE.
-
-(in-package #:babel-tests)
-
-(eval-when (:compile-toplevel :load-toplevel :execute)
- (use-package :babel-streams))
-
-(deftest in-memory-vector-stream
- (with-output-to-sequence (output)
- ;; TODO use a better test lib and inject asserts for the file position
- ;(print (file-position output))
- (write-sequence "éáőűú" output)
- ;(print (file-position output))
- (write-char #\ű output)
- ;(print (file-position output))
- (write-byte 12 output)
- (write-sequence (string-to-octets "körte") output)
- (write-string "körte" output)
- ;(print (file-position output))
- )
- #(195 169 195 161 197 145 197 177 195 186 197 177 12 107 195 182 114 116 101))
(DIR) diff --git a/3rdparties/software/babel-20171227-git/tests/tests.lisp b/3rdparties/software/babel-20171227-git/tests/tests.lisp
@@ -1,911 +0,0 @@
-;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
-;;;
-;;; tests.lisp --- Unit and regression tests for Babel.
-;;;
-;;; Copyright (C) 2007-2009, Luis Oliveira <loliveira@common-lisp.net>
-;;;
-;;; Permission is hereby granted, free of charge, to any person
-;;; obtaining a copy of this software and associated documentation
-;;; files (the "Software"), to deal in the Software without
-;;; restriction, including without limitation the rights to use, copy,
-;;; modify, merge, publish, distribute, sublicense, and/or sell copies
-;;; of the Software, and to permit persons to whom the Software is
-;;; furnished to do so, subject to the following conditions:
-;;;
-;;; The above copyright notice and this permission notice shall be
-;;; included in all copies or substantial portions of the Software.
-;;;
-;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
-;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
-;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
-;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
-;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
-;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
-;;; DEALINGS IN THE SOFTWARE.
-
-(in-package #:cl-user)
-(defpackage #:babel-tests
- (:use #:common-lisp #:babel #:babel-encodings #:hu.dwim.stefil)
- (:import-from #:alexandria #:ignore-some-conditions)
- (:export #:run))
-(in-package #:babel-tests)
-
-(defun indented-format (level stream format-control &rest format-arguments)
- (let ((line-prefix (make-string level :initial-element #\Space)))
- (let ((output (format nil "~?~%" format-control format-arguments)))
- (with-input-from-string (s output)
- (loop for line = (read-line s nil nil) until (null line)
- do (format stream "~A~A~%" line-prefix line))))))
-
-;; adapted from https://github.com/luismbo/stefil/blob/master/source/suite.lisp
-(defun describe-failed-tests (&key (result *last-test-result*) (stream t))
- "Prints out a report for RESULT in STREAM.
-
-RESULT defaults to `*last-test-result*' and STREAM defaults to t"
- (let ((descs (hu.dwim.stefil::failure-descriptions-of result)))
- (cond ((zerop (length descs))
- (format stream "~&~%[no failures!]"))
- (t
- (format stream "~&~%Test failures:~%")
- (dotimes (i (length descs))
- (let ((desc (aref descs i))
- format-control format-arguments)
- ;; XXX: most of Stefil's conditions specialise DESCRIBE-OBJECT
- ;; with nice human-readable messages. We should add any missing
- ;; ones (like UNEXPECTED-ERROR) and ditch this code.
- (etypecase desc
- (hu.dwim.stefil::unexpected-error
- (let ((c (hu.dwim.stefil::condition-of desc)))
- (typecase c
- (simple-condition
- (setf format-control (simple-condition-format-control c))
- (setf format-arguments
- (simple-condition-format-arguments c)))
- (t
- (setf format-control "~S"
- format-arguments (list c))))))
- (hu.dwim.stefil::failed-assertion
- (setf format-control (hu.dwim.stefil::format-control-of desc)
- format-arguments (hu.dwim.stefil::format-arguments-of desc)))
- (hu.dwim.stefil::missing-condition
- (setf format-control "~A"
- format-arguments (list (with-output-to-string (stream)
- (describe desc stream)))))
- (null
- (setf format-control "Test succeeded!")))
- (format stream "~%Failure ~A: ~A when running ~S~%~%"
- (1+ i)
- (type-of desc)
- (hu.dwim.stefil::name-of (hu.dwim.stefil::test-of (first (hu.dwim.stefil::test-context-backtrace-of desc)))))
- (indented-format 4 stream "~?" format-control format-arguments)))))))
-
-(defun run ()
- (let ((test-run (without-debugging (babel-tests))))
- (print test-run)
- (describe-failed-tests :result test-run)
- (values (zerop (length (hu.dwim.stefil::failure-descriptions-of test-run)))
- test-run)))
-
-(defsuite* (babel-tests :in root-suite))
-
-(defun ub8v (&rest contents)
- (make-array (length contents) :element-type '(unsigned-byte 8)
- :initial-contents contents))
-
-(defun make-ub8-vector (size)
- (make-array size :element-type '(unsigned-byte 8)
- :initial-element 0))
-
-(defmacro returns (form &rest values)
- "Asserts, through EQUALP, that FORM returns VALUES."
- `(is (equalp (multiple-value-list ,form) (list ,@values))))
-
-(defmacro defstest (name form &body return-values)
- "Similar to RT's DEFTEST."
- `(deftest ,name ()
- (returns ,form ,@(mapcar (lambda (x) `',x) return-values))))
-
-(defun fail (control-string &rest arguments)
- (hu.dwim.stefil::record/failure 'hu.dwim.stefil::failed-assertion
- :format-control control-string
- :format-arguments arguments))
-
-(defun expected (expected &key got)
- (fail "expected ~A, got ~A instead" expected got))
-
-(enable-sharp-backslash-syntax)
-
-;;;; Simple tests using ASCII
-
-(defstest enc.ascii.1
- (string-to-octets "abc" :encoding :ascii)
- #(97 98 99))
-
-(defstest enc.ascii.2
- (string-to-octets (string #\uED) :encoding :ascii :errorp nil)
- #(#x1a))
-
-(deftest enc.ascii.3 ()
- (handler-case
- (string-to-octets (string #\uED) :encoding :ascii :errorp t)
- (character-encoding-error (c)
- (is (eql 0 (character-coding-error-position c)))
- (is (eq :ascii (character-coding-error-encoding c)))
- (is (eql #xed (character-encoding-error-code c))))
- (:no-error (result)
- (expected 'character-encoding-error :got result))))
-
-(defstest dec.ascii.1
- (octets-to-string (ub8v 97 98 99) :encoding :ascii)
- "abc")
-
-(deftest dec.ascii.2 ()
- (handler-case
- (octets-to-string (ub8v 97 128 99) :encoding :ascii :errorp t)
- (character-decoding-error (c)
- (is (equalp #(128) (character-decoding-error-octets c)))
- (is (eql 1 (character-coding-error-position c)))
- (is (eq :ascii (character-coding-error-encoding c))))
- (:no-error (result)
- (expected 'character-decoding-error :got result))))
-
-(defstest dec.ascii.3
- (octets-to-string (ub8v 97 255 98 99) :encoding :ascii :errorp nil)
- #(#\a #\Sub #\b #\c))
-
-(defstest oct-count.ascii.1
- (string-size-in-octets "abc" :encoding :ascii)
- 3 3)
-
-(defstest char-count.ascii.1
- (vector-size-in-chars (ub8v 97 98 99) :encoding :ascii)
- 3 3)
-
-;;;; UTF-8
-
-(defstest char-count.utf-8.1
- ;; "ni hao" in hanzi with the last octet missing
- (vector-size-in-chars (ub8v 228 189 160 229 165) :errorp nil)
- 2 5)
-
-(deftest char-count.utf-8.2 ()
- ;; same as above with the last 2 octets missing
- (handler-case
- (vector-size-in-chars (ub8v 228 189 160 229) :errorp t)
- (end-of-input-in-character (c)
- (is (equalp #(229) (character-decoding-error-octets c)))
- (is (eql 3 (character-coding-error-position c)))
- (is (eq :utf-8 (character-coding-error-encoding c))))
- (:no-error (result)
- (expected 'end-of-input-in-character :got result))))
-
-;;; Lispworks bug?
-;; #+lispworks
-;; (pushnew 'dec.utf-8.1 rtest::*expected-failures*)
-
-(defstest dec.utf-8.1
- (octets-to-string (ub8v 228 189 160 229) :errorp nil)
- #(#\u4f60 #\ufffd))
-
-(deftest dec.utf-8.2 ()
- (handler-case
- (octets-to-string (ub8v 228 189 160 229) :errorp t)
- (end-of-input-in-character (c)
- (is (equalp #(229) (character-decoding-error-octets c)))
- (is (eql 3 (character-coding-error-position c)))
- (is (eq :utf-8 (character-coding-error-encoding c))))
- (:no-error (result)
- (expected 'end-of-input-in-character :got result))))
-
-;;;; UTF-16
-
-;;; Test that the BOM is not being counted as a character.
-(deftest char-count.utf-16.bom ()
- (is (eql (vector-size-in-chars (ub8v #xfe #xff #x00 #x55 #x00 #x54 #x00 #x46)
- :encoding :utf-16)
- 3))
- (is (eql (vector-size-in-chars (ub8v #xff #xfe #x00 #x55 #x00 #x54 #x00 #x46)
- :encoding :utf-16)
- 3)))
-
-;;;; UTF-32
-
-;;; RT: check that UTF-32 characters without a BOM are treated as
-;;; little-endian.
-(deftest endianness.utf-32.no-bom ()
- (is (string= "a" (octets-to-string (ub8v 0 0 0 97) :encoding :utf-32))))
-
-;;;; MORE TESTS
-
-(defparameter *standard-characters*
- "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789!$\"'(),_-./:;?+<=>#%&*@[\\]{|}`^~")
-
-;;; Testing consistency by encoding and decoding a simple string for
-;;; all character encodings.
-(deftest rw-equiv.1 ()
- (let ((compatible-encodings (remove :ebcdic-international (list-character-encodings))))
- (dolist (*default-character-encoding* compatible-encodings)
- (let ((octets (string-to-octets *standard-characters*)))
- (is (string= (octets-to-string octets) *standard-characters*))))))
-
-;;; FIXME: assumes little-endianness. Easily fixable when we
-;;; implement the BE and LE variants of :UTF-16.
-(deftest concatenate-strings-to-octets-equiv.1 ()
- (let ((foo (octets-to-string (ub8v 102 195 186 195 186)
- :encoding :utf-8))
- (bar (octets-to-string (ub8v 98 195 161 114)
- :encoding :utf-8)))
- ;; note: FOO and BAR are not ascii
- (is (equalp (concatenate-strings-to-octets :utf-8 foo bar)
- (ub8v 102 195 186 195 186 98 195 161 114)))
- (is (equalp (concatenate-strings-to-octets :utf-16 foo bar)
- (ub8v 102 0 250 0 250 0 98 0 225 0 114 0)))))
-
-;;;; Testing against files generated by GNU iconv.
-
-(defun test-file (name type)
- (uiop:subpathname (asdf:system-relative-pathname "babel-tests" "tests/")
- name :type type))
-
-(defun read-test-file (name type)
- (with-open-file (in (test-file name type) :element-type '(unsigned-byte 8))
- (let* ((data (loop for byte = (read-byte in nil nil)
- until (null byte) collect byte)))
- (make-array (length data) :element-type '(unsigned-byte 8)
- :initial-contents data))))
-
-(deftest test-encoding (enc &optional input-enc-name)
- (let* ((*default-character-encoding* enc)
- (enc-name (string-downcase (symbol-name enc)))
- (utf8-octets (read-test-file enc-name "txt-utf8"))
- (foo-octets (read-test-file (or input-enc-name enc-name) "txt"))
- (utf8-string (octets-to-string utf8-octets :encoding :utf-8 :errorp t))
- (foo-string (octets-to-string foo-octets :errorp t)))
- (is (string= utf8-string foo-string))
- (is (= (length foo-string) (vector-size-in-chars foo-octets :errorp t)))
- (unless (member enc '(:utf-16 :utf-32))
- ;; FIXME: skipping UTF-16 and UTF-32 because of the BOMs and
- ;; because the input might not be in native-endian order so the
- ;; comparison will fail there.
- (let ((new-octets (string-to-octets foo-string :errorp t)))
- (is (equalp new-octets foo-octets))
- (is (eql (length foo-octets)
- (string-size-in-octets foo-string :errorp t)))))))
-
-(deftest iconv-test ()
- (dolist (enc '(:ascii :ebcdic-us :utf-8 :utf-16 :utf-32))
- (case enc
- (:utf-16 (test-encoding :utf-16 "utf-16-with-le-bom"))
- (:utf-32 (test-encoding :utf-32 "utf-32-with-le-bom")))
- (test-encoding enc)))
-
-;;; RT: accept encoding objects in LOOKUP-MAPPING etc.
-(defstest encoding-objects.1
- (string-to-octets "abc" :encoding (get-character-encoding :ascii))
- #(97 98 99))
-
-(defmacro with-sharp-backslash-syntax (&body body)
- `(let ((*readtable* (copy-readtable *readtable*)))
- (set-sharp-backslash-syntax-in-readtable)
- ,@body))
-
-(defstest sharp-backslash.1
- (with-sharp-backslash-syntax
- (loop for string in '("#\\a" "#\\u" "#\\ued")
- collect (char-code (read-from-string string))))
- (97 117 #xed))
-
-(deftest sharp-backslash.2 ()
- (signals reader-error (with-sharp-backslash-syntax
- (read-from-string "#\\u12zz"))))
-
-(deftest test-read-from-string (string object position)
- "Test that (read-from-string STRING) returns values OBJECT and POSITION."
- (multiple-value-bind (obj pos)
- (read-from-string string)
- (is (eql object obj))
- (is (eql position pos))))
-
-;;; RT: our #\ reader didn't honor *READ-SUPPRESS*.
-(deftest sharp-backslash.3 ()
- (with-sharp-backslash-syntax
- (let ((*read-suppress* t))
- (test-read-from-string "#\\ujunk" nil 7)
- (test-read-from-string "#\\u12zz" nil 7))))
-
-;;; RT: the slow implementation of with-simple-vector was buggy.
-(defstest string-to-octets.1
- (code-char (aref (string-to-octets "abc" :start 1 :end 2) 0))
- #\b)
-
-(defstest simple-base-string.1
- (string-to-octets (coerce "abc" 'base-string) :encoding :ascii)
- #(97 98 99))
-
-;;; For now, disable this tests for Lisps that are strict about
-;;; non-character code points. In the future, simply mark them as
-;;; expected failures.
-#-(or abcl ccl)
-(progn
- (defstest utf-8b.1
- (string-to-octets (coerce #(#\a #\b #\udcf0) 'unicode-string)
- :encoding :utf-8b)
- #(97 98 #xf0))
-
- #+#:temporarily-disabled
- (defstest utf-8b.2
- (octets-to-string (ub8v 97 98 #xcd) :encoding :utf-8b)
- #(#\a #\b #\udccd))
-
- (defstest utf-8b.3
- (octets-to-string (ub8v 97 #xf0 #xf1 #xff #x01) :encoding :utf-8b)
- #(#\a #\udcf0 #\udcf1 #\udcff #\udc01))
-
- (deftest utf-8b.4 ()
- (let* ((octets (coerce (loop repeat 8192 collect (random (+ #x82)))
- '(array (unsigned-byte 8) (*))))
- (string (octets-to-string octets :encoding :utf-8b)))
- (is (equalp octets (string-to-octets string :encoding :utf-8b))))))
-
-;;; The following tests have been adapted from SBCL's
-;;; tests/octets.pure.lisp file.
-
-(deftest ensure-roundtrip-ascii ()
- (let ((octets (make-ub8-vector 128)))
- (dotimes (i 128)
- (setf (aref octets i) i))
- (let* ((str (octets-to-string octets :encoding :ascii))
- (oct2 (string-to-octets str :encoding :ascii)))
- (is (= (length octets) (length oct2)))
- (is (every #'= octets oct2)))))
-
-(deftest test-8bit-roundtrip (enc)
- (let ((octets (make-ub8-vector 256)))
- (dotimes (i 256)
- (setf (aref octets i) i))
- (let* ((str (octets-to-string octets :encoding enc)))
- ;; remove the undefined code-points because they translate
- ;; to #xFFFD and string-to-octets raises an error when
- ;; encoding #xFFFD
- (multiple-value-bind (filtered-str filtered-octets)
- (let ((s (make-array 0 :element-type 'character
- :adjustable t :fill-pointer 0))
- (o (make-array 0 :element-type '(unsigned-byte 16)
- :adjustable t :fill-pointer 0)))
- (loop for i below 256
- for c = (aref str i)
- when (/= (char-code c) #xFFFD)
- do (vector-push-extend c s)
- (vector-push-extend (aref octets i) o))
- (values s o))
- (let ((oct2 (string-to-octets filtered-str :encoding enc)))
- (is (eql (length filtered-octets) (length oct2)))
- (is (every #'eql filtered-octets oct2)))))))
-
-(defparameter *iso-8859-charsets*
- '(:iso-8859-1 :iso-8859-2 :iso-8859-3 :iso-8859-4 :iso-8859-5 :iso-8859-6
- :iso-8859-7 :iso-8859-8 :iso-8859-9 :iso-8859-10 :iso-8859-11 :iso-8859-13
- :iso-8859-14 :iso-8859-15 :iso-8859-16))
-
-;;; Don't actually see what comes out, but there shouldn't be any
-;;; errors.
-(deftest iso-8859-roundtrip-no-checking ()
- (loop for enc in *iso-8859-charsets* do (test-8bit-roundtrip enc)))
-
-(deftest ensure-roundtrip-latin ()
- (loop for enc in '(:latin1 :latin9) do (test-8bit-roundtrip enc)))
-
-;;; Latin-9 chars; the previous test checked roundtrip from
-;;; octets->char and back, now test that the latin-9 characters did in
-;;; fact appear during that trip.
-(deftest ensure-roundtrip-latin9 ()
- (let ((l9c (map 'string #'code-char '(8364 352 353 381 382 338 339 376))))
- (is (string= (octets-to-string (string-to-octets l9c :encoding :latin9)
- :encoding :latin9)
- l9c))))
-
-;; Expected to fail on Lisps that are strict about non-character code
-;; points. Mark this as an expected failure when Stefil supports such
-;; a feature.
-#-(or abcl ccl)
-(deftest code-char-nilness ()
- (is (loop for i below unicode-char-code-limit
- never (null (code-char i)))))
-
-(deftest test-unicode-roundtrip (enc)
- (let ((string (make-string unicode-char-code-limit)))
- (dotimes (i unicode-char-code-limit)
- (setf (char string i)
- (if (or (<= #xD800 i #xDFFF)
- (<= #xFDD0 i #xFDEF)
- (eql (logand i #xFFFF) #xFFFF)
- (eql (logand i #xFFFF) #xFFFE))
- #\? ; don't try to encode non-characters.
- (code-char i))))
- (let ((string2 (octets-to-string
- (string-to-octets string :encoding enc :errorp t)
- :encoding enc :errorp t)))
- (is (eql (length string2) (length string)))
- (is (string= string string2)))))
-
-(deftest ensure-roundtrip.utf8 ()
- (test-unicode-roundtrip :utf-8))
-
-(deftest ensure-roundtrip.utf16 ()
- (test-unicode-roundtrip :utf-16))
-
-(deftest ensure-roundtrip.utf32 ()
- (test-unicode-roundtrip :utf-32))
-
-#+sbcl
-(progn
- (deftest test-encode-against-sbcl (enc)
- (let ((string (make-string unicode-char-code-limit)))
- (dotimes (i unicode-char-code-limit)
- (setf (char string i) (code-char i)))
- (loop for ch across string
- for babel = (string-to-octets (string ch) :encoding enc)
- for sbcl = (sb-ext:string-to-octets (string ch)
- :external-format enc)
- do (is (equalp babel sbcl)))))
-
- ;; not run automatically because it's a bit slow (1114112 assertions)
- (deftest (test-encode-against-sbcl.utf-8 :auto-call nil) ()
- (test-encode-against-sbcl :utf-8)))
-
-(deftest non-ascii-bytes ()
- (let ((octets (make-array 128
- :element-type '(unsigned-byte 8)
- :initial-contents (loop for i from 128 below 256
- collect i))))
- (is (string= (octets-to-string octets :encoding :ascii :errorp nil)
- (make-string 128 :initial-element #\Sub)))))
-
-(deftest non-ascii-chars ()
- (let ((string (make-array 128
- :element-type 'character
- :initial-contents (loop for i from 128 below 256
- collect (code-char i)))))
- (is (equalp (string-to-octets string :encoding :ascii :errorp nil)
- (make-array 128 :initial-element (char-code #\Sub))))))
-
-;;;; The following UTF-8 decoding tests are adapted from
-;;;; <http://www.cl.cam.ac.uk/~mgk25/ucs/examples/UTF-8-test.txt>.
-
-(deftest utf8-decode-test (octets expected-results expected-errors)
- (let ((string (octets-to-string (coerce octets '(vector (unsigned-byte 8) *))
- :encoding :utf-8 :errorp nil)))
- (is (string= expected-results string))
- (is (= (count #\ufffd string) expected-errors))))
-
-(deftest utf8-decode-tests (octets expected-results)
- (let ((expected-errors (count #\? expected-results))
- (expected-results (substitute #\ufffd #\? expected-results)))
- (utf8-decode-test octets expected-results expected-errors)
- (utf8-decode-test (concatenate 'vector '(34) octets '(34))
- (format nil "\"~A\"" expected-results)
- expected-errors)))
-
-(deftest utf8-too-big-characters ()
- (utf8-decode-tests #(#xf4 #x90 #x80 #x80) "?") ; #x110000
- (utf8-decode-tests #(#xf7 #xbf #xbf #xbf) "?") ; #x1fffff
- (utf8-decode-tests #(#xf8 #x88 #x80 #x80 #x80) "?") ; #x200000
- (utf8-decode-tests #(#xfb #xbf #xbf #xbf #xbf) "?") ; #x3ffffff
- (utf8-decode-tests #(#xfc #x84 #x80 #x80 #x80 #x80) "?") ; #x4000000e
- (utf8-decode-tests #(#xfd #xbf #xbf #xbf #xbf #xbf) "?")) ; #x7fffffff
-
-(deftest utf8-unexpected-continuation-bytes ()
- (utf8-decode-tests #(#x80) "?")
- (utf8-decode-tests #(#xbf) "?")
- (utf8-decode-tests #(#x80 #xbf) "??")
- (utf8-decode-tests #(#x80 #xbf #x80) "???")
- (utf8-decode-tests #(#x80 #xbf #x80 #xbf) "????")
- (utf8-decode-tests #(#x80 #xbf #x80 #xbf #x80) "?????")
- (utf8-decode-tests #(#x80 #xbf #x80 #xbf #x80 #xbf) "??????")
- (utf8-decode-tests #(#x80 #xbf #x80 #xbf #x80 #xbf #x80) "???????"))
-
-;;; All 64 continuation bytes in a row.
-(deftest utf8-continuation-bytes ()
- (apply #'utf8-decode-tests
- (loop for i from #x80 to #xbf
- collect i into bytes
- collect #\? into chars
- finally (return (list bytes
- (coerce chars 'string))))))
-
-(deftest utf8-lonely-start-characters ()
- (flet ((lsc (first last)
- (apply #'utf8-decode-tests
- (loop for i from first to last
- nconc (list i 32) into bytes
- nconc (list #\? #\Space) into chars
- finally (return (list bytes (coerce chars 'string)))))
- (apply #'utf8-decode-tests
- (loop for i from first to last
- collect i into bytes
- collect #\? into chars
- finally (return
- (list bytes (coerce chars 'string)))))))
- (lsc #xc0 #xdf) ; 2-byte sequence start chars
- (lsc #xe0 #xef) ; 3-byte
- (lsc #xf0 #xf7) ; 4-byte
- (lsc #xf8 #xfb) ; 5-byte
- (lsc #xfc #xfd))) ; 6-byte
-
-;;; Otherwise incomplete sequences (last continuation byte missing)
-(deftest utf8-incomplete-sequences ()
- (utf8-decode-tests #0=#(#xc0) "?")
- (utf8-decode-tests #1=#(#xe0 #x80) "?")
- (utf8-decode-tests #2=#(#xf0 #x80 #x80) "?")
- (utf8-decode-tests #3=#(#xf8 #x80 #x80 #x80) "?")
- (utf8-decode-tests #4=#(#xfc #x80 #x80 #x80 #x80) "?")
- (utf8-decode-tests #5=#(#xdf) "?")
- (utf8-decode-tests #6=#(#xef #xbf) "?")
- (utf8-decode-tests #7=#(#xf7 #xbf #xbf) "?")
- (utf8-decode-tests #8=#(#xfb #xbf #xbf #xbf) "?")
- (utf8-decode-tests #9=#(#xfd #xbf #xbf #xbf #xbf) "?")
- ;; All ten previous tests concatenated
- (utf8-decode-tests (concatenate 'vector
- #0# #1# #2# #3# #4# #5# #6# #7# #8# #9#)
- "??????????"))
-
-(deftest utf8-random-impossible-bytes ()
- (utf8-decode-tests #(#xfe) "?")
- (utf8-decode-tests #(#xff) "?")
- (utf8-decode-tests #(#xfe #xfe #xff #xff) "????"))
-
-(deftest utf8-overlong-sequences-/ ()
- (utf8-decode-tests #(#xc0 #xaf) "?")
- (utf8-decode-tests #(#xe0 #x80 #xaf) "?")
- (utf8-decode-tests #(#xf0 #x80 #x80 #xaf) "?")
- (utf8-decode-tests #(#xf8 #x80 #x80 #x80 #xaf) "?")
- (utf8-decode-tests #(#xfc #x80 #x80 #x80 #x80 #xaf) "?"))
-
-(deftest utf8-overlong-sequences-rubout ()
- (utf8-decode-tests #(#xc1 #xbf) "?")
- (utf8-decode-tests #(#xe0 #x9f #xbf) "?")
- (utf8-decode-tests #(#xf0 #x8f #xbf #xbf) "?")
- (utf8-decode-tests #(#xf8 #x87 #xbf #xbf #xbf) "?")
- (utf8-decode-tests #(#xfc #x83 #xbf #xbf #xbf #xbf) "?"))
-
-(deftest utf8-overlong-sequences-null ()
- (utf8-decode-tests #(#xc0 #x80) "?")
- (utf8-decode-tests #(#xe0 #x80 #x80) "?")
- (utf8-decode-tests #(#xf0 #x80 #x80 #x80) "?")
- (utf8-decode-tests #(#xf8 #x80 #x80 #x80 #x80) "?")
- (utf8-decode-tests #(#xfc #x80 #x80 #x80 #x80 #x80) "?"))
-
-;;;; End of adapted SBCL tests.
-
-;;; Expected to fail, for now.
-#+#:ignore
-(deftest utf8-illegal-code-positions ()
- ;; single UTF-16 surrogates
- (utf8-decode-tests #(#xed #xa0 #x80) "?")
- (utf8-decode-tests #(#xed #xad #xbf) "?")
- (utf8-decode-tests #(#xed #xae #x80) "?")
- (utf8-decode-tests #(#xed #xaf #xbf) "?")
- (utf8-decode-tests #(#xed #xb0 #x80) "?")
- (utf8-decode-tests #(#xed #xbe #x80) "?")
- (utf8-decode-tests #(#xed #xbf #xbf) "?")
- ;; paired UTF-16 surrogates
- (utf8-decode-tests #(ed a0 80 ed b0 80) "??")
- (utf8-decode-tests #(ed a0 80 ed bf bf) "??")
- (utf8-decode-tests #(ed ad bf ed b0 80) "??")
- (utf8-decode-tests #(ed ad bf ed bf bf) "??")
- (utf8-decode-tests #(ed ae 80 ed b0 80) "??")
- (utf8-decode-tests #(ed ae 80 ed bf bf) "??")
- (utf8-decode-tests #(ed af bf ed b0 80) "??")
- (utf8-decode-tests #(ed af bf ed bf bf) "??")
- ;; other illegal code positions
- (utf8-decode-tests #(#xef #xbf #xbe) "?") ; #\uFFFE
- (utf8-decode-tests #(#xef #xbf #xbf) "?")) ; #\uFFFF
-
-;;; A list of the ISO-8859 encodings where each element is a cons with
-;;; the car being a keyword denoting the encoding and the cdr being a
-;;; vector enumerating the corresponding character codes.
-;;;
-;;; It was auto-generated from files which can be found at
-;;; <ftp://ftp.unicode.org/Public/MAPPINGS/ISO8859/>.
-;;;
-;;; Taken from flexi-streams.
-(defparameter *iso-8859-tables*
- '((:iso-8859-1 .
- #(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26
- 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50
- 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74
- 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98
- 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116
- 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134
- 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152
- 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170
- 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188
- 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206
- 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224
- 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242
- 243 244 245 246 247 248 249 250 251 252 253 254 255))
-
- (:iso-8859-2 .
- #(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26
- 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50
- 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74
- 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98
- 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116
- 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134
- 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152
- 153 154 155 156 157 158 159 160 260 728 321 164 317 346 167 168 352 350
- 356 377 173 381 379 176 261 731 322 180 318 347 711 184 353 351 357 378
- 733 382 380 340 193 194 258 196 313 262 199 268 201 280 203 282 205 206
- 270 272 323 327 211 212 336 214 215 344 366 218 368 220 221 354 223 341
- 225 226 259 228 314 263 231 269 233 281 235 283 237 238 271 273 324 328
- 243 244 337 246 247 345 367 250 369 252 253 355 729))
-
- (:iso-8859-3 .
- #(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26
- 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50
- 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74
- 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98
- 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116
- 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134
- 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152
- 153 154 155 156 157 158 159 160 294 728 163 164 65533 292 167 168 304
- 350 286 308 173 65533 379 176 295 178 179 180 181 293 183 184 305 351
- 287 309 189 65533 380 192 193 194 65533 196 266 264 199 200 201 202 203
- 204 205 206 207 65533 209 210 211 212 288 214 215 284 217 218 219 220
- 364 348 223 224 225 226 65533 228 267 265 231 232 233 234 235 236 237
- 238 239 65533 241 242 243 244 289 246 247 285 249 250 251 252 365 349
- 729))
-
- (:iso-8859-4 .
- #(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26
- 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50
- 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74
- 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98
- 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116
- 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134
- 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152
- 153 154 155 156 157 158 159 160 260 312 342 164 296 315 167 168 352 274
- 290 358 173 381 175 176 261 731 343 180 297 316 711 184 353 275 291 359
- 330 382 331 256 193 194 195 196 197 198 302 268 201 280 203 278 205 206
- 298 272 325 332 310 212 213 214 215 216 370 218 219 220 360 362 223 257
- 225 226 227 228 229 230 303 269 233 281 235 279 237 238 299 273 326 333
- 311 244 245 246 247 248 371 250 251 252 361 363 729))
-
- (:iso-8859-5 .
- #(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26
- 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50
- 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74
- 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98
- 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116
- 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134
- 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152
- 153 154 155 156 157 158 159 160 1025 1026 1027 1028 1029 1030 1031 1032
- 1033 1034 1035 1036 173 1038 1039 1040 1041 1042 1043 1044 1045 1046
- 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060
- 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074
- 1075 1076 1077 1078 1079 1080 1081 1082 1083 1084 1085 1086 1087 1088
- 1089 1090 1091 1092 1093 1094 1095 1096 1097 1098 1099 1100 1101 1102
- 1103 8470 1105 1106 1107 1108 1109 1110 1111 1112 1113 1114 1115 1116
- 167 1118 1119))
-
- (:iso-8859-6 .
- #(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26
- 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50
- 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74
- 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98
- 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116
- 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134
- 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152
- 153 154 155 156 157 158 159 160 65533 65533 65533 164 65533 65533 65533
- 65533 65533 65533 65533 1548 173 65533 65533 65533 65533 65533 65533
- 65533 65533 65533 65533 65533 65533 65533 1563 65533 65533 65533 1567
- 65533 1569 1570 1571 1572 1573 1574 1575 1576 1577 1578 1579 1580 1581
- 1582 1583 1584 1585 1586 1587 1588 1589 1590 1591 1592 1593 1594 65533
- 65533 65533 65533 65533 1600 1601 1602 1603 1604 1605 1606 1607 1608
- 1609 1610 1611 1612 1613 1614 1615 1616 1617 1618 65533 65533 65533
- 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533))
-
- (:iso-8859-7 .
- #(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26
- 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50
- 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74
- 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98
- 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116
- 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134
- 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152
- 153 154 155 156 157 158 159 160 8216 8217 163 8364 8367 166 167 168 169
- 890 171 172 173 65533 8213 176 177 178 179 900 901 902 183 904 905 906
- 187 908 189 910 911 912 913 914 915 916 917 918 919 920 921 922 923 924
- 925 926 927 928 929 65533 931 932 933 934 935 936 937 938 939 940 941
- 942 943 944 945 946 947 948 949 950 951 952 953 954 955 956 957 958 959
- 960 961 962 963 964 965 966 967 968 969 970 971 972 973 974 65533))
-
- (:iso-8859-8 .
- #(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26
- 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50
- 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74
- 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98
- 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116
- 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134
- 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152
- 153 154 155 156 157 158 159 160 65533 162 163 164 165 166 167 168 169
- 215 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 247 187
- 188 189 190 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533
- 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533
- 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 8215 1488
- 1489 1490 1491 1492 1493 1494 1495 1496 1497 1498 1499 1500 1501 1502
- 1503 1504 1505 1506 1507 1508 1509 1510 1511 1512 1513 1514 65533 65533
- 8206 8207 65533))
-
- (:iso-8859-9 .
- #(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26
- 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50
- 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74
- 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98
- 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116
- 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134
- 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152
- 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170
- 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188
- 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206
- 207 286 209 210 211 212 213 214 215 216 217 218 219 220 304 350 223 224
- 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 287 241 242
- 243 244 245 246 247 248 249 250 251 252 305 351 255))
-
- (:iso-8859-10 .
- #(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26
- 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50
- 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74
- 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98
- 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116
- 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134
- 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152
- 153 154 155 156 157 158 159 160 260 274 290 298 296 310 167 315 272 352
- 358 381 173 362 330 176 261 275 291 299 297 311 183 316 273 353 359 382
- 8213 363 331 256 193 194 195 196 197 198 302 268 201 280 203 278 205 206
- 207 208 325 332 211 212 213 214 360 216 370 218 219 220 221 222 223 257
- 225 226 227 228 229 230 303 269 233 281 235 279 237 238 239 240 326 333
- 243 244 245 246 361 248 371 250 251 252 253 254 312))
-
- (:iso-8859-11 .
- #(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26
- 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50
- 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74
- 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98
- 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116
- 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134
- 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152
- 153 154 155 156 157 158 159 160 3585 3586 3587 3588 3589 3590 3591 3592
- 3593 3594 3595 3596 3597 3598 3599 3600 3601 3602 3603 3604 3605 3606
- 3607 3608 3609 3610 3611 3612 3613 3614 3615 3616 3617 3618 3619 3620
- 3621 3622 3623 3624 3625 3626 3627 3628 3629 3630 3631 3632 3633 3634
- 3635 3636 3637 3638 3639 3640 3641 3642 65533 65533 65533 65533 3647
- 3648 3649 3650 3651 3652 3653 3654 3655 3656 3657 3658 3659 3660 3661
- 3662 3663 3664 3665 3666 3667 3668 3669 3670 3671 3672 3673 3674 3675
- 65533 65533 65533 65533))
-
- (:iso-8859-13 .
- #(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26
- 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50
- 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74
- 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98
- 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116
- 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134
- 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152
- 153 154 155 156 157 158 159 160 8221 162 163 164 8222 166 167 216 169
- 342 171 172 173 174 198 176 177 178 179 8220 181 182 183 248 185 343 187
- 188 189 190 230 260 302 256 262 196 197 280 274 268 201 377 278 290 310
- 298 315 352 323 325 211 332 213 214 215 370 321 346 362 220 379 381 223
- 261 303 257 263 228 229 281 275 269 233 378 279 291 311 299 316 353 324
- 326 243 333 245 246 247 371 322 347 363 252 380 382 8217))
-
- (:iso-8859-14 .
- #(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26
- 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50
- 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74
- 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98
- 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116
- 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134
- 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152
- 153 154 155 156 157 158 159 160 7682 7683 163 266 267 7690 167 7808 169
- 7810 7691 7922 173 174 376 7710 7711 288 289 7744 7745 182 7766 7809
- 7767 7811 7776 7923 7812 7813 7777 192 193 194 195 196 197 198 199 200
- 201 202 203 204 205 206 207 372 209 210 211 212 213 214 7786 216 217 218
- 219 220 221 374 223 224 225 226 227 228 229 230 231 232 233 234 235 236
- 237 238 239 373 241 242 243 244 245 246 7787 248 249 250 251 252 253 375
- 255))
-
- (:iso-8859-15 .
- #(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26
- 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50
- 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74
- 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98
- 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116
- 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134
- 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152
- 153 154 155 156 157 158 159 160 161 162 163 8364 165 352 167 353 169 170
- 171 172 173 174 175 176 177 178 179 381 181 182 183 382 185 186 187 338
- 339 376 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206
- 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224
- 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242
- 243 244 245 246 247 248 249 250 251 252 253 254 255))
-
- (:iso-8859-16 .
- #(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26
- 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50
- 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74
- 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98
- 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116
- 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134
- 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152
- 153 154 155 156 157 158 159 160 260 261 321 8364 8222 352 167 353 169
- 536 171 377 173 378 379 176 177 268 322 381 8221 182 183 382 269 537 187
- 338 339 376 380 192 193 194 258 196 262 198 199 200 201 202 203 204 205
- 206 207 272 323 210 211 212 336 214 346 368 217 218 219 220 280 538 223
- 224 225 226 259 228 263 230 231 232 233 234 235 236 237 238 239 273 324
- 242 243 244 337 246 347 369 249 250 251 252 281 539 255))))
-
-(deftest iso-8859-decode-check ()
- (loop for enc in *iso-8859-charsets*
- for octets = (let ((octets (make-ub8-vector 256)))
- (dotimes (i 256 octets)
- (setf (aref octets i) i)))
- for string = (octets-to-string octets :encoding enc)
- do (is (equalp (map 'vector #'char-code string)
- (cdr (assoc enc *iso-8859-tables*))))))
-
-(deftest character-out-of-range.utf-32 ()
- (signals character-out-of-range
- (octets-to-string (ub8v 0 0 #xfe #xff 0 #x11 0 0)
- :encoding :utf-32 :errorp t)))
-
-;;; RT: encoders and decoders were returning bogus values.
-(deftest encoder/decoder-retvals (encoding &optional (test-string "abc"))
- (let* ((mapping (lookup-mapping babel::*string-vector-mappings* encoding))
- (strlen (length test-string))
- ;; encoding
- (octet-precount (funcall (octet-counter mapping)
- test-string 0 strlen -1))
- (array (make-array octet-precount :element-type '(unsigned-byte 8)))
- (encoded-octet-count (funcall (encoder mapping)
- test-string 0 strlen array 0))
- ;; decoding
- (string (make-string strlen))
- (char-precount (funcall (code-point-counter mapping)
- array 0 octet-precount -1))
- (char-count (funcall (decoder mapping)
- array 0 octet-precount string 0)))
- (is (= octet-precount encoded-octet-count))
- (is (= char-precount char-count))
- (is (string= test-string string))))
-
-(deftest encoder-and-decoder-return-values ()
- (mapcar 'encoder/decoder-retvals
- (remove-if 'ambiguous-encoding-p
- (list-character-encodings))))
-
-(deftest code-point-sweep (encoding)
- (finishes
- (dotimes (i char-code-limit)
- (let ((char (ignore-errors (code-char i))))
- (when char
- (ignore-some-conditions (character-encoding-error)
- (string-to-octets (string char) :encoding encoding)))))))
-
-#+enable-slow-babel-tests
-(deftest code-point-sweep-all-encodings ()
- (mapc #'code-point-sweep (list-character-encodings)))
-
-(deftest octet-sweep (encoding)
- (finishes
- (loop for b1 upto #xff do
- (loop for b2 upto #xff do
- (loop for b3 upto #xff do
- (loop for b4 upto #xff do
- (ignore-some-conditions (character-decoding-error)
- (octets-to-string (ub8v b1 b2 b3 b4) :encoding encoding))))))))
-
-#+enable-slow-babel-tests
-(deftest octet-sweep-all-encodings ()
- (mapc #'octet-sweep (list-character-encodings)))
(DIR) diff --git a/3rdparties/software/babel-20171227-git/tests/utf-16-with-le-bom.txt b/3rdparties/software/babel-20171227-git/tests/utf-16-with-le-bom.txt
Binary files differ.
(DIR) diff --git a/3rdparties/software/babel-20171227-git/tests/utf-16.txt b/3rdparties/software/babel-20171227-git/tests/utf-16.txt
Binary files differ.
(DIR) diff --git a/3rdparties/software/babel-20171227-git/tests/utf-16.txt-utf8 b/3rdparties/software/babel-20171227-git/tests/utf-16.txt-utf8
@@ -1,212 +0,0 @@
-
-UTF-8 encoded sample plain-text file
-‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾
-
-Markus Kuhn [ˈmaʳkʊs kuːn] <http://www.cl.cam.ac.uk/~mgk25/> — 2002-07-25
-
-
-The ASCII compatible UTF-8 encoding used in this plain-text file
-is defined in Unicode, ISO 10646-1, and RFC 2279.
-
-
-Using Unicode/UTF-8, you can write in emails and source code things such as
-
-Mathematics and sciences:
-
- ∮ E⋅da = Q, n → ∞, ∑ f(i) = ∏ g(i), ⎧⎡⎛┌─────┐⎞⎤⎫
- ⎪⎢⎜│a²+b³ ⎟⎥⎪
- ∀x∈ℝ: ⌈x⌉ = −⌊−x⌋, α ∧ ¬β = ¬(¬α ∨ β), ⎪⎢⎜│───── ⎟⎥⎪
- ⎪⎢⎜⎷ c₈ ⎟⎥⎪
- ℕ ⊆ ℕ₀ ⊂ ℤ ⊂ ℚ ⊂ ℝ ⊂ ℂ, ⎨⎢⎜ ⎟⎥⎬
- ⎪⎢⎜ ∞ ⎟⎥⎪
- ⊥ < a ≠ b ≡ c ≤ d ≪ ⊤ ⇒ (⟦A⟧ ⇔ ⟪B⟫), ⎪⎢⎜ ⎲ ⎟⎥⎪
- ⎪⎢⎜ ⎳aⁱ-bⁱ⎟⎥⎪
- 2H₂ + O₂ ⇌ 2H₂O, R = 4.7 kΩ, ⌀ 200 mm ⎩⎣⎝i=1 ⎠⎦⎭
-
-Linguistics and dictionaries:
-
- ði ıntəˈnæʃənəl fəˈnɛtık əsoʊsiˈeıʃn
- Y [ˈʏpsilɔn], Yen [jɛn], Yoga [ˈjoːgɑ]
-
-APL:
-
- ((V⍳V)=⍳⍴V)/V←,V ⌷←⍳→⍴∆∇⊃‾⍎⍕⌈
-
-Nicer typography in plain text files:
-
- ╔══════════════════════════════════════════╗
- ║ ║
- ║ • ‘single’ and “double” quotes ║
- ║ ║
- ║ • Curly apostrophes: “We’ve been here” ║
- ║ ║
- ║ • Latin-1 apostrophe and accents: '´` ║
- ║ ║
- ║ • ‚deutsche‘ „Anführungszeichen“ ║
- ║ ║
- ║ • †, ‡, ‰, •, 3–4, —, −5/+5, ™, … ║
- ║ ║
- ║ • ASCII safety test: 1lI|, 0OD, 8B ║
- ║ ╭─────────╮ ║
- ║ • the euro symbol: │ 14.95 € │ ║
- ║ ╰─────────╯ ║
- ╚══════════════════════════════════════════╝
-
-Combining characters:
-
- STARGΛ̊TE SG-1, a = v̇ = r̈, a⃑ ⊥ b⃑
-
-Greek (in Polytonic):
-
- The Greek anthem:
-
- Σὲ γνωρίζω ἀπὸ τὴν κόψη
- τοῦ σπαθιοῦ τὴν τρομερή,
- σὲ γνωρίζω ἀπὸ τὴν ὄψη
- ποὺ μὲ βία μετράει τὴ γῆ.
-
- ᾿Απ᾿ τὰ κόκκαλα βγαλμένη
- τῶν ῾Ελλήνων τὰ ἱερά
- καὶ σὰν πρῶτα ἀνδρειωμένη
- χαῖρε, ὦ χαῖρε, ᾿Ελευθεριά!
-
- From a speech of Demosthenes in the 4th century BC:
-
- Οὐχὶ ταὐτὰ παρίσταταί μοι γιγνώσκειν, ὦ ἄνδρες ᾿Αθηναῖοι,
- ὅταν τ᾿ εἰς τὰ πράγματα ἀποβλέψω καὶ ὅταν πρὸς τοὺς
- λόγους οὓς ἀκούω· τοὺς μὲν γὰρ λόγους περὶ τοῦ
- τιμωρήσασθαι Φίλιππον ὁρῶ γιγνομένους, τὰ δὲ πράγματ᾿
- εἰς τοῦτο προήκοντα, ὥσθ᾿ ὅπως μὴ πεισόμεθ᾿ αὐτοὶ
- πρότερον κακῶς σκέψασθαι δέον. οὐδέν οὖν ἄλλο μοι δοκοῦσιν
- οἱ τὰ τοιαῦτα λέγοντες ἢ τὴν ὑπόθεσιν, περὶ ἧς βουλεύεσθαι,
- οὐχὶ τὴν οὖσαν παριστάντες ὑμῖν ἁμαρτάνειν. ἐγὼ δέ, ὅτι μέν
- ποτ᾿ ἐξῆν τῇ πόλει καὶ τὰ αὑτῆς ἔχειν ἀσφαλῶς καὶ Φίλιππον
- τιμωρήσασθαι, καὶ μάλ᾿ ἀκριβῶς οἶδα· ἐπ᾿ ἐμοῦ γάρ, οὐ πάλαι
- γέγονεν ταῦτ᾿ ἀμφότερα· νῦν μέντοι πέπεισμαι τοῦθ᾿ ἱκανὸν
- προλαβεῖν ἡμῖν εἶναι τὴν πρώτην, ὅπως τοὺς συμμάχους
- σώσομεν. ἐὰν γὰρ τοῦτο βεβαίως ὑπάρξῃ, τότε καὶ περὶ τοῦ
- τίνα τιμωρήσεταί τις καὶ ὃν τρόπον ἐξέσται σκοπεῖν· πρὶν δὲ
- τὴν ἀρχὴν ὀρθῶς ὑποθέσθαι, μάταιον ἡγοῦμαι περὶ τῆς
- τελευτῆς ὁντινοῦν ποιεῖσθαι λόγον.
-
- Δημοσθένους, Γ´ ᾿Ολυνθιακὸς
-
-Georgian:
-
- From a Unicode conference invitation:
-
- გთხოვთ ახლავე გაიაროთ რეგისტრაცია Unicode-ის მეათე საერთაშორისო
- კონფერენციაზე დასასწრებად, რომელიც გაიმართება 10-12 მარტს,
- ქ. მაინცში, გერმანიაში. კონფერენცია შეჰკრებს ერთად მსოფლიოს
- ექსპერტებს ისეთ დარგებში როგორიცაა ინტერნეტი და Unicode-ი,
- ინტერნაციონალიზაცია და ლოკალიზაცია, Unicode-ის გამოყენება
- ოპერაციულ სისტემებსა, და გამოყენებით პროგრამებში, შრიფტებში,
- ტექსტების დამუშავებასა და მრავალენოვან კომპიუტერულ სისტემებში.
-
-Russian:
-
- From a Unicode conference invitation:
-
- Зарегистрируйтесь сейчас на Десятую Международную Конференцию по
- Unicode, которая состоится 10-12 марта 1997 года в Майнце в Германии.
- Конференция соберет широкий круг экспертов по вопросам глобального
- Интернета и Unicode, локализации и интернационализации, воплощению и
- применению Unicode в различных операционных системах и программных
- приложениях, шрифтах, верстке и многоязычных компьютерных системах.
-
-Thai (UCS Level 2):
-
- Excerpt from a poetry on The Romance of The Three Kingdoms (a Chinese
- classic 'San Gua'):
-
- [----------------------------|------------------------]
- ๏ แผ่นดินฮั่นเสื่อมโทรมแสนสังเวช พระปกเกศกองบู๊กู้ขึ้นใหม่
- สิบสองกษัตริย์ก่อนหน้าแลถัดไป สององค์ไซร้โง่เขลาเบาปัญญา
- ทรงนับถือขันทีเป็นที่พึ่ง บ้านเมืองจึงวิปริตเป็นนักหนา
- โฮจิ๋นเรียกทัพทั่วหัวเมืองมา หมายจะฆ่ามดชั่วตัวสำคัญ
- เหมือนขับไสไล่เสือจากเคหา รับหมาป่าเข้ามาเลยอาสัญ
- ฝ่ายอ้องอุ้นยุแยกให้แตกกัน ใช้สาวนั้นเป็นชนวนชื่นชวนใจ
- พลันลิฉุยกุยกีกลับก่อเหตุ ช่างอาเพศจริงหนาฟ้าร้องไห้
- ต้องรบราฆ่าฟันจนบรรลัย ฤๅหาใครค้ำชูกู้บรรลังก์ ฯ
-
- (The above is a two-column text. If combining characters are handled
- correctly, the lines of the second column should be aligned with the
- | character above.)
-
-Ethiopian:
-
- Proverbs in the Amharic language:
-
- ሰማይ አይታረስ ንጉሥ አይከሰስ።
- ብላ ካለኝ እንደአባቴ በቆመጠኝ።
- ጌጥ ያለቤቱ ቁምጥና ነው።
- ደሀ በሕልሙ ቅቤ ባይጠጣ ንጣት በገደለው።
- የአፍ ወለምታ በቅቤ አይታሽም።
- አይጥ በበላ ዳዋ ተመታ።
- ሲተረጉሙ ይደረግሙ።
- ቀስ በቀስ፥ ዕንቁላል በእግሩ ይሄዳል።
- ድር ቢያብር አንበሳ ያስር።
- ሰው እንደቤቱ እንጅ እንደ ጉረቤቱ አይተዳደርም።
- እግዜር የከፈተውን ጉሮሮ ሳይዘጋው አይድርም።
- የጎረቤት ሌባ፥ ቢያዩት ይስቅ ባያዩት ያጠልቅ።
- ሥራ ከመፍታት ልጄን ላፋታት።
- ዓባይ ማደሪያ የለው፥ ግንድ ይዞ ይዞራል።
- የእስላም አገሩ መካ የአሞራ አገሩ ዋርካ።
- ተንጋሎ ቢተፉ ተመልሶ ባፉ።
- ወዳጅህ ማር ቢሆን ጨርስህ አትላሰው።
- እግርህን በፍራሽህ ልክ ዘርጋ።
-
-Runes:
-
- ᚻᛖ ᚳᚹᚫᚦ ᚦᚫᛏ ᚻᛖ ᛒᚢᛞᛖ ᚩᚾ ᚦᚫᛗ ᛚᚪᚾᛞᛖ ᚾᚩᚱᚦᚹᛖᚪᚱᛞᚢᛗ ᚹᛁᚦ ᚦᚪ ᚹᛖᛥᚫ
-
- (Old English, which transcribed into Latin reads 'He cwaeth that he
- bude thaem lande northweardum with tha Westsae.' and means 'He said
- that he lived in the northern land near the Western Sea.')
-
-Braille:
-
- ⡌⠁⠧⠑ ⠼⠁⠒ ⡍⠜⠇⠑⠹⠰⠎ ⡣⠕⠌
-
- ⡍⠜⠇⠑⠹ ⠺⠁⠎ ⠙⠑⠁⠙⠒ ⠞⠕ ⠃⠑⠛⠔ ⠺⠊⠹⠲ ⡹⠻⠑ ⠊⠎ ⠝⠕ ⠙⠳⠃⠞
- ⠱⠁⠞⠑⠧⠻ ⠁⠃⠳⠞ ⠹⠁⠞⠲ ⡹⠑ ⠗⠑⠛⠊⠌⠻ ⠕⠋ ⠙⠊⠎ ⠃⠥⠗⠊⠁⠇ ⠺⠁⠎
- ⠎⠊⠛⠝⠫ ⠃⠹ ⠹⠑ ⠊⠇⠻⠛⠹⠍⠁⠝⠂ ⠹⠑ ⠊⠇⠻⠅⠂ ⠹⠑ ⠥⠝⠙⠻⠞⠁⠅⠻⠂
- ⠁⠝⠙ ⠹⠑ ⠡⠊⠑⠋ ⠍⠳⠗⠝⠻⠲ ⡎⠊⠗⠕⠕⠛⠑ ⠎⠊⠛⠝⠫ ⠊⠞⠲ ⡁⠝⠙
- ⡎⠊⠗⠕⠕⠛⠑⠰⠎ ⠝⠁⠍⠑ ⠺⠁⠎ ⠛⠕⠕⠙ ⠥⠏⠕⠝ ⠰⡡⠁⠝⠛⠑⠂ ⠋⠕⠗ ⠁⠝⠹⠹⠔⠛ ⠙⠑
- ⠡⠕⠎⠑ ⠞⠕ ⠏⠥⠞ ⠙⠊⠎ ⠙⠁⠝⠙ ⠞⠕⠲
-
- ⡕⠇⠙ ⡍⠜⠇⠑⠹ ⠺⠁⠎ ⠁⠎ ⠙⠑⠁⠙ ⠁⠎ ⠁ ⠙⠕⠕⠗⠤⠝⠁⠊⠇⠲
-
- ⡍⠔⠙⠖ ⡊ ⠙⠕⠝⠰⠞ ⠍⠑⠁⠝ ⠞⠕ ⠎⠁⠹ ⠹⠁⠞ ⡊ ⠅⠝⠪⠂ ⠕⠋ ⠍⠹
- ⠪⠝ ⠅⠝⠪⠇⠫⠛⠑⠂ ⠱⠁⠞ ⠹⠻⠑ ⠊⠎ ⠏⠜⠞⠊⠊⠥⠇⠜⠇⠹ ⠙⠑⠁⠙ ⠁⠃⠳⠞
- ⠁ ⠙⠕⠕⠗⠤⠝⠁⠊⠇⠲ ⡊ ⠍⠊⠣⠞ ⠙⠁⠧⠑ ⠃⠑⠲ ⠔⠊⠇⠔⠫⠂ ⠍⠹⠎⠑⠇⠋⠂ ⠞⠕
- ⠗⠑⠛⠜⠙ ⠁ ⠊⠕⠋⠋⠔⠤⠝⠁⠊⠇ ⠁⠎ ⠹⠑ ⠙⠑⠁⠙⠑⠌ ⠏⠊⠑⠊⠑ ⠕⠋ ⠊⠗⠕⠝⠍⠕⠝⠛⠻⠹
- ⠔ ⠹⠑ ⠞⠗⠁⠙⠑⠲ ⡃⠥⠞ ⠹⠑ ⠺⠊⠎⠙⠕⠍ ⠕⠋ ⠳⠗ ⠁⠝⠊⠑⠌⠕⠗⠎
- ⠊⠎ ⠔ ⠹⠑ ⠎⠊⠍⠊⠇⠑⠆ ⠁⠝⠙ ⠍⠹ ⠥⠝⠙⠁⠇⠇⠪⠫ ⠙⠁⠝⠙⠎
- ⠩⠁⠇⠇ ⠝⠕⠞ ⠙⠊⠌⠥⠗⠃ ⠊⠞⠂ ⠕⠗ ⠹⠑ ⡊⠳⠝⠞⠗⠹⠰⠎ ⠙⠕⠝⠑ ⠋⠕⠗⠲ ⡹⠳
- ⠺⠊⠇⠇ ⠹⠻⠑⠋⠕⠗⠑ ⠏⠻⠍⠊⠞ ⠍⠑ ⠞⠕ ⠗⠑⠏⠑⠁⠞⠂ ⠑⠍⠏⠙⠁⠞⠊⠊⠁⠇⠇⠹⠂ ⠹⠁⠞
- ⡍⠜⠇⠑⠹ ⠺⠁⠎ ⠁⠎ ⠙⠑⠁⠙ ⠁⠎ ⠁ ⠙⠕⠕⠗⠤⠝⠁⠊⠇⠲
-
- (The first couple of paragraphs of "A Christmas Carol" by Dickens)
-
-Compact font selection example text:
-
- ABCDEFGHIJKLMNOPQRSTUVWXYZ /0123456789
- abcdefghijklmnopqrstuvwxyz £©µÀÆÖÞßéöÿ
- –—‘“”„†•…‰™œŠŸž€ ΑΒΓΔΩαβγδω АБВГДабвгд
- ∀∂∈ℝ∧∪≡∞ ↑↗↨↻⇣ ┐┼╔╘░►☺♀ fi�⑀₂ἠḂӥẄɐː⍎אԱა
-
-Greetings in various languages:
-
- Hello world, Καλημέρα κόσμε, コンニチハ
-
-Box drawing alignment tests: █
- ▉
- ╔══╦══╗ ┌──┬──┐ ╭──┬──╮ ╭──┬──╮ ┏━━┳━━┓ ┎┒┏┑ ╷ ╻ ┏┯┓ ┌┰┐ ▊ ╱╲╱╲╳╳╳
- ║┌─╨─┐║ │╔═╧═╗│ │╒═╪═╕│ │╓─╁─╖│ ┃┌─╂─┐┃ ┗╃╄┙ ╶┼╴╺╋╸┠┼┨ ┝╋┥ ▋ ╲╱╲╱╳╳╳
- ║│╲ ╱│║ │║ ║│ ││ │ ││ │║ ┃ ║│ ┃│ ╿ │┃ ┍╅╆┓ ╵ ╹ ┗┷┛ └┸┘ ▌ ╱╲╱╲╳╳╳
- ╠╡ ╳ ╞╣ ├╢ ╟┤ ├┼─┼─┼┤ ├╫─╂─╫┤ ┣┿╾┼╼┿┫ ┕┛┖┚ ┌┄┄┐ ╎ ┏┅┅┓ ┋ ▍ ╲╱╲╱╳╳╳
- ║│╱ ╲│║ │║ ║│ ││ │ ││ │║ ┃ ║│ ┃│ ╽ │┃ ░░▒▒▓▓██ ┊ ┆ ╎ ╏ ┇ ┋ ▎
- ║└─╥─┘║ │╚═╤═╝│ │╘═╪═╛│ │╙─╀─╜│ ┃└─╂─┘┃ ░░▒▒▓▓██ ┊ ┆ ╎ ╏ ┇ ┋ ▏
- ╚══╩══╝ └──┴──┘ ╰──┴──╯ ╰──┴──╯ ┗━━┻━━┛ ▗▄▖▛▀▜ └╌╌┘ ╎ ┗╍╍┛ ┋ ▁▂▃▄▅▆▇█
- ▝▀▘▙▄▟
(DIR) diff --git a/3rdparties/software/babel-20171227-git/tests/utf-32-with-le-bom.txt b/3rdparties/software/babel-20171227-git/tests/utf-32-with-le-bom.txt
Binary files differ.
(DIR) diff --git a/3rdparties/software/babel-20171227-git/tests/utf-32.txt b/3rdparties/software/babel-20171227-git/tests/utf-32.txt
Binary files differ.
(DIR) diff --git a/3rdparties/software/babel-20171227-git/tests/utf-32.txt-utf8 b/3rdparties/software/babel-20171227-git/tests/utf-32.txt-utf8
@@ -1,212 +0,0 @@
-
-UTF-8 encoded sample plain-text file
-‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾
-
-Markus Kuhn [ˈmaʳkʊs kuːn] <http://www.cl.cam.ac.uk/~mgk25/> — 2002-07-25
-
-
-The ASCII compatible UTF-8 encoding used in this plain-text file
-is defined in Unicode, ISO 10646-1, and RFC 2279.
-
-
-Using Unicode/UTF-8, you can write in emails and source code things such as
-
-Mathematics and sciences:
-
- ∮ E⋅da = Q, n → ∞, ∑ f(i) = ∏ g(i), ⎧⎡⎛┌─────┐⎞⎤⎫
- ⎪⎢⎜│a²+b³ ⎟⎥⎪
- ∀x∈ℝ: ⌈x⌉ = −⌊−x⌋, α ∧ ¬β = ¬(¬α ∨ β), ⎪⎢⎜│───── ⎟⎥⎪
- ⎪⎢⎜⎷ c₈ ⎟⎥⎪
- ℕ ⊆ ℕ₀ ⊂ ℤ ⊂ ℚ ⊂ ℝ ⊂ ℂ, ⎨⎢⎜ ⎟⎥⎬
- ⎪⎢⎜ ∞ ⎟⎥⎪
- ⊥ < a ≠ b ≡ c ≤ d ≪ ⊤ ⇒ (⟦A⟧ ⇔ ⟪B⟫), ⎪⎢⎜ ⎲ ⎟⎥⎪
- ⎪⎢⎜ ⎳aⁱ-bⁱ⎟⎥⎪
- 2H₂ + O₂ ⇌ 2H₂O, R = 4.7 kΩ, ⌀ 200 mm ⎩⎣⎝i=1 ⎠⎦⎭
-
-Linguistics and dictionaries:
-
- ði ıntəˈnæʃənəl fəˈnɛtık əsoʊsiˈeıʃn
- Y [ˈʏpsilɔn], Yen [jɛn], Yoga [ˈjoːgɑ]
-
-APL:
-
- ((V⍳V)=⍳⍴V)/V←,V ⌷←⍳→⍴∆∇⊃‾⍎⍕⌈
-
-Nicer typography in plain text files:
-
- ╔══════════════════════════════════════════╗
- ║ ║
- ║ • ‘single’ and “double” quotes ║
- ║ ║
- ║ • Curly apostrophes: “We’ve been here” ║
- ║ ║
- ║ • Latin-1 apostrophe and accents: '´` ║
- ║ ║
- ║ • ‚deutsche‘ „Anführungszeichen“ ║
- ║ ║
- ║ • †, ‡, ‰, •, 3–4, —, −5/+5, ™, … ║
- ║ ║
- ║ • ASCII safety test: 1lI|, 0OD, 8B ║
- ║ ╭─────────╮ ║
- ║ • the euro symbol: │ 14.95 € │ ║
- ║ ╰─────────╯ ║
- ╚══════════════════════════════════════════╝
-
-Combining characters:
-
- STARGΛ̊TE SG-1, a = v̇ = r̈, a⃑ ⊥ b⃑
-
-Greek (in Polytonic):
-
- The Greek anthem:
-
- Σὲ γνωρίζω ἀπὸ τὴν κόψη
- τοῦ σπαθιοῦ τὴν τρομερή,
- σὲ γνωρίζω ἀπὸ τὴν ὄψη
- ποὺ μὲ βία μετράει τὴ γῆ.
-
- ᾿Απ᾿ τὰ κόκκαλα βγαλμένη
- τῶν ῾Ελλήνων τὰ ἱερά
- καὶ σὰν πρῶτα ἀνδρειωμένη
- χαῖρε, ὦ χαῖρε, ᾿Ελευθεριά!
-
- From a speech of Demosthenes in the 4th century BC:
-
- Οὐχὶ ταὐτὰ παρίσταταί μοι γιγνώσκειν, ὦ ἄνδρες ᾿Αθηναῖοι,
- ὅταν τ᾿ εἰς τὰ πράγματα ἀποβλέψω καὶ ὅταν πρὸς τοὺς
- λόγους οὓς ἀκούω· τοὺς μὲν γὰρ λόγους περὶ τοῦ
- τιμωρήσασθαι Φίλιππον ὁρῶ γιγνομένους, τὰ δὲ πράγματ᾿
- εἰς τοῦτο προήκοντα, ὥσθ᾿ ὅπως μὴ πεισόμεθ᾿ αὐτοὶ
- πρότερον κακῶς σκέψασθαι δέον. οὐδέν οὖν ἄλλο μοι δοκοῦσιν
- οἱ τὰ τοιαῦτα λέγοντες ἢ τὴν ὑπόθεσιν, περὶ ἧς βουλεύεσθαι,
- οὐχὶ τὴν οὖσαν παριστάντες ὑμῖν ἁμαρτάνειν. ἐγὼ δέ, ὅτι μέν
- ποτ᾿ ἐξῆν τῇ πόλει καὶ τὰ αὑτῆς ἔχειν ἀσφαλῶς καὶ Φίλιππον
- τιμωρήσασθαι, καὶ μάλ᾿ ἀκριβῶς οἶδα· ἐπ᾿ ἐμοῦ γάρ, οὐ πάλαι
- γέγονεν ταῦτ᾿ ἀμφότερα· νῦν μέντοι πέπεισμαι τοῦθ᾿ ἱκανὸν
- προλαβεῖν ἡμῖν εἶναι τὴν πρώτην, ὅπως τοὺς συμμάχους
- σώσομεν. ἐὰν γὰρ τοῦτο βεβαίως ὑπάρξῃ, τότε καὶ περὶ τοῦ
- τίνα τιμωρήσεταί τις καὶ ὃν τρόπον ἐξέσται σκοπεῖν· πρὶν δὲ
- τὴν ἀρχὴν ὀρθῶς ὑποθέσθαι, μάταιον ἡγοῦμαι περὶ τῆς
- τελευτῆς ὁντινοῦν ποιεῖσθαι λόγον.
-
- Δημοσθένους, Γ´ ᾿Ολυνθιακὸς
-
-Georgian:
-
- From a Unicode conference invitation:
-
- გთხოვთ ახლავე გაიაროთ რეგისტრაცია Unicode-ის მეათე საერთაშორისო
- კონფერენციაზე დასასწრებად, რომელიც გაიმართება 10-12 მარტს,
- ქ. მაინცში, გერმანიაში. კონფერენცია შეჰკრებს ერთად მსოფლიოს
- ექსპერტებს ისეთ დარგებში როგორიცაა ინტერნეტი და Unicode-ი,
- ინტერნაციონალიზაცია და ლოკალიზაცია, Unicode-ის გამოყენება
- ოპერაციულ სისტემებსა, და გამოყენებით პროგრამებში, შრიფტებში,
- ტექსტების დამუშავებასა და მრავალენოვან კომპიუტერულ სისტემებში.
-
-Russian:
-
- From a Unicode conference invitation:
-
- Зарегистрируйтесь сейчас на Десятую Международную Конференцию по
- Unicode, которая состоится 10-12 марта 1997 года в Майнце в Германии.
- Конференция соберет широкий круг экспертов по вопросам глобального
- Интернета и Unicode, локализации и интернационализации, воплощению и
- применению Unicode в различных операционных системах и программных
- приложениях, шрифтах, верстке и многоязычных компьютерных системах.
-
-Thai (UCS Level 2):
-
- Excerpt from a poetry on The Romance of The Three Kingdoms (a Chinese
- classic 'San Gua'):
-
- [----------------------------|------------------------]
- ๏ แผ่นดินฮั่นเสื่อมโทรมแสนสังเวช พระปกเกศกองบู๊กู้ขึ้นใหม่
- สิบสองกษัตริย์ก่อนหน้าแลถัดไป สององค์ไซร้โง่เขลาเบาปัญญา
- ทรงนับถือขันทีเป็นที่พึ่ง บ้านเมืองจึงวิปริตเป็นนักหนา
- โฮจิ๋นเรียกทัพทั่วหัวเมืองมา หมายจะฆ่ามดชั่วตัวสำคัญ
- เหมือนขับไสไล่เสือจากเคหา รับหมาป่าเข้ามาเลยอาสัญ
- ฝ่ายอ้องอุ้นยุแยกให้แตกกัน ใช้สาวนั้นเป็นชนวนชื่นชวนใจ
- พลันลิฉุยกุยกีกลับก่อเหตุ ช่างอาเพศจริงหนาฟ้าร้องไห้
- ต้องรบราฆ่าฟันจนบรรลัย ฤๅหาใครค้ำชูกู้บรรลังก์ ฯ
-
- (The above is a two-column text. If combining characters are handled
- correctly, the lines of the second column should be aligned with the
- | character above.)
-
-Ethiopian:
-
- Proverbs in the Amharic language:
-
- ሰማይ አይታረስ ንጉሥ አይከሰስ።
- ብላ ካለኝ እንደአባቴ በቆመጠኝ።
- ጌጥ ያለቤቱ ቁምጥና ነው።
- ደሀ በሕልሙ ቅቤ ባይጠጣ ንጣት በገደለው።
- የአፍ ወለምታ በቅቤ አይታሽም።
- አይጥ በበላ ዳዋ ተመታ።
- ሲተረጉሙ ይደረግሙ።
- ቀስ በቀስ፥ ዕንቁላል በእግሩ ይሄዳል።
- ድር ቢያብር አንበሳ ያስር።
- ሰው እንደቤቱ እንጅ እንደ ጉረቤቱ አይተዳደርም።
- እግዜር የከፈተውን ጉሮሮ ሳይዘጋው አይድርም።
- የጎረቤት ሌባ፥ ቢያዩት ይስቅ ባያዩት ያጠልቅ።
- ሥራ ከመፍታት ልጄን ላፋታት።
- ዓባይ ማደሪያ የለው፥ ግንድ ይዞ ይዞራል።
- የእስላም አገሩ መካ የአሞራ አገሩ ዋርካ።
- ተንጋሎ ቢተፉ ተመልሶ ባፉ።
- ወዳጅህ ማር ቢሆን ጨርስህ አትላሰው።
- እግርህን በፍራሽህ ልክ ዘርጋ።
-
-Runes:
-
- ᚻᛖ ᚳᚹᚫᚦ ᚦᚫᛏ ᚻᛖ ᛒᚢᛞᛖ ᚩᚾ ᚦᚫᛗ ᛚᚪᚾᛞᛖ ᚾᚩᚱᚦᚹᛖᚪᚱᛞᚢᛗ ᚹᛁᚦ ᚦᚪ ᚹᛖᛥᚫ
-
- (Old English, which transcribed into Latin reads 'He cwaeth that he
- bude thaem lande northweardum with tha Westsae.' and means 'He said
- that he lived in the northern land near the Western Sea.')
-
-Braille:
-
- ⡌⠁⠧⠑ ⠼⠁⠒ ⡍⠜⠇⠑⠹⠰⠎ ⡣⠕⠌
-
- ⡍⠜⠇⠑⠹ ⠺⠁⠎ ⠙⠑⠁⠙⠒ ⠞⠕ ⠃⠑⠛⠔ ⠺⠊⠹⠲ ⡹⠻⠑ ⠊⠎ ⠝⠕ ⠙⠳⠃⠞
- ⠱⠁⠞⠑⠧⠻ ⠁⠃⠳⠞ ⠹⠁⠞⠲ ⡹⠑ ⠗⠑⠛⠊⠌⠻ ⠕⠋ ⠙⠊⠎ ⠃⠥⠗⠊⠁⠇ ⠺⠁⠎
- ⠎⠊⠛⠝⠫ ⠃⠹ ⠹⠑ ⠊⠇⠻⠛⠹⠍⠁⠝⠂ ⠹⠑ ⠊⠇⠻⠅⠂ ⠹⠑ ⠥⠝⠙⠻⠞⠁⠅⠻⠂
- ⠁⠝⠙ ⠹⠑ ⠡⠊⠑⠋ ⠍⠳⠗⠝⠻⠲ ⡎⠊⠗⠕⠕⠛⠑ ⠎⠊⠛⠝⠫ ⠊⠞⠲ ⡁⠝⠙
- ⡎⠊⠗⠕⠕⠛⠑⠰⠎ ⠝⠁⠍⠑ ⠺⠁⠎ ⠛⠕⠕⠙ ⠥⠏⠕⠝ ⠰⡡⠁⠝⠛⠑⠂ ⠋⠕⠗ ⠁⠝⠹⠹⠔⠛ ⠙⠑
- ⠡⠕⠎⠑ ⠞⠕ ⠏⠥⠞ ⠙⠊⠎ ⠙⠁⠝⠙ ⠞⠕⠲
-
- ⡕⠇⠙ ⡍⠜⠇⠑⠹ ⠺⠁⠎ ⠁⠎ ⠙⠑⠁⠙ ⠁⠎ ⠁ ⠙⠕⠕⠗⠤⠝⠁⠊⠇⠲
-
- ⡍⠔⠙⠖ ⡊ ⠙⠕⠝⠰⠞ ⠍⠑⠁⠝ ⠞⠕ ⠎⠁⠹ ⠹⠁⠞ ⡊ ⠅⠝⠪⠂ ⠕⠋ ⠍⠹
- ⠪⠝ ⠅⠝⠪⠇⠫⠛⠑⠂ ⠱⠁⠞ ⠹⠻⠑ ⠊⠎ ⠏⠜⠞⠊⠊⠥⠇⠜⠇⠹ ⠙⠑⠁⠙ ⠁⠃⠳⠞
- ⠁ ⠙⠕⠕⠗⠤⠝⠁⠊⠇⠲ ⡊ ⠍⠊⠣⠞ ⠙⠁⠧⠑ ⠃⠑⠲ ⠔⠊⠇⠔⠫⠂ ⠍⠹⠎⠑⠇⠋⠂ ⠞⠕
- ⠗⠑⠛⠜⠙ ⠁ ⠊⠕⠋⠋⠔⠤⠝⠁⠊⠇ ⠁⠎ ⠹⠑ ⠙⠑⠁⠙⠑⠌ ⠏⠊⠑⠊⠑ ⠕⠋ ⠊⠗⠕⠝⠍⠕⠝⠛⠻⠹
- ⠔ ⠹⠑ ⠞⠗⠁⠙⠑⠲ ⡃⠥⠞ ⠹⠑ ⠺⠊⠎⠙⠕⠍ ⠕⠋ ⠳⠗ ⠁⠝⠊⠑⠌⠕⠗⠎
- ⠊⠎ ⠔ ⠹⠑ ⠎⠊⠍⠊⠇⠑⠆ ⠁⠝⠙ ⠍⠹ ⠥⠝⠙⠁⠇⠇⠪⠫ ⠙⠁⠝⠙⠎
- ⠩⠁⠇⠇ ⠝⠕⠞ ⠙⠊⠌⠥⠗⠃ ⠊⠞⠂ ⠕⠗ ⠹⠑ ⡊⠳⠝⠞⠗⠹⠰⠎ ⠙⠕⠝⠑ ⠋⠕⠗⠲ ⡹⠳
- ⠺⠊⠇⠇ ⠹⠻⠑⠋⠕⠗⠑ ⠏⠻⠍⠊⠞ ⠍⠑ ⠞⠕ ⠗⠑⠏⠑⠁⠞⠂ ⠑⠍⠏⠙⠁⠞⠊⠊⠁⠇⠇⠹⠂ ⠹⠁⠞
- ⡍⠜⠇⠑⠹ ⠺⠁⠎ ⠁⠎ ⠙⠑⠁⠙ ⠁⠎ ⠁ ⠙⠕⠕⠗⠤⠝⠁⠊⠇⠲
-
- (The first couple of paragraphs of "A Christmas Carol" by Dickens)
-
-Compact font selection example text:
-
- ABCDEFGHIJKLMNOPQRSTUVWXYZ /0123456789
- abcdefghijklmnopqrstuvwxyz £©µÀÆÖÞßéöÿ
- –—‘“”„†•…‰™œŠŸž€ ΑΒΓΔΩαβγδω АБВГДабвгд
- ∀∂∈ℝ∧∪≡∞ ↑↗↨↻⇣ ┐┼╔╘░►☺♀ fi�⑀₂ἠḂӥẄɐː⍎אԱა
-
-Greetings in various languages:
-
- Hello world, Καλημέρα κόσμε, コンニチハ
-
-Box drawing alignment tests: █
- ▉
- ╔══╦══╗ ┌──┬──┐ ╭──┬──╮ ╭──┬──╮ ┏━━┳━━┓ ┎┒┏┑ ╷ ╻ ┏┯┓ ┌┰┐ ▊ ╱╲╱╲╳╳╳
- ║┌─╨─┐║ │╔═╧═╗│ │╒═╪═╕│ │╓─╁─╖│ ┃┌─╂─┐┃ ┗╃╄┙ ╶┼╴╺╋╸┠┼┨ ┝╋┥ ▋ ╲╱╲╱╳╳╳
- ║│╲ ╱│║ │║ ║│ ││ │ ││ │║ ┃ ║│ ┃│ ╿ │┃ ┍╅╆┓ ╵ ╹ ┗┷┛ └┸┘ ▌ ╱╲╱╲╳╳╳
- ╠╡ ╳ ╞╣ ├╢ ╟┤ ├┼─┼─┼┤ ├╫─╂─╫┤ ┣┿╾┼╼┿┫ ┕┛┖┚ ┌┄┄┐ ╎ ┏┅┅┓ ┋ ▍ ╲╱╲╱╳╳╳
- ║│╱ ╲│║ │║ ║│ ││ │ ││ │║ ┃ ║│ ┃│ ╽ │┃ ░░▒▒▓▓██ ┊ ┆ ╎ ╏ ┇ ┋ ▎
- ║└─╥─┘║ │╚═╤═╝│ │╘═╪═╛│ │╙─╀─╜│ ┃└─╂─┘┃ ░░▒▒▓▓██ ┊ ┆ ╎ ╏ ┇ ┋ ▏
- ╚══╩══╝ └──┴──┘ ╰──┴──╯ ╰──┴──╯ ┗━━┻━━┛ ▗▄▖▛▀▜ └╌╌┘ ╎ ┗╍╍┛ ┋ ▁▂▃▄▅▆▇█
- ▝▀▘▙▄▟
(DIR) diff --git a/3rdparties/software/babel-20171227-git/tests/utf-8.txt b/3rdparties/software/babel-20171227-git/tests/utf-8.txt
@@ -1,212 +0,0 @@
-
-UTF-8 encoded sample plain-text file
-‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾
-
-Markus Kuhn [ˈmaʳkʊs kuːn] <http://www.cl.cam.ac.uk/~mgk25/> — 2002-07-25
-
-
-The ASCII compatible UTF-8 encoding used in this plain-text file
-is defined in Unicode, ISO 10646-1, and RFC 2279.
-
-
-Using Unicode/UTF-8, you can write in emails and source code things such as
-
-Mathematics and sciences:
-
- ∮ E⋅da = Q, n → ∞, ∑ f(i) = ∏ g(i), ⎧⎡⎛┌─────┐⎞⎤⎫
- ⎪⎢⎜│a²+b³ ⎟⎥⎪
- ∀x∈ℝ: ⌈x⌉ = −⌊−x⌋, α ∧ ¬β = ¬(¬α ∨ β), ⎪⎢⎜│───── ⎟⎥⎪
- ⎪⎢⎜⎷ c₈ ⎟⎥⎪
- ℕ ⊆ ℕ₀ ⊂ ℤ ⊂ ℚ ⊂ ℝ ⊂ ℂ, ⎨⎢⎜ ⎟⎥⎬
- ⎪⎢⎜ ∞ ⎟⎥⎪
- ⊥ < a ≠ b ≡ c ≤ d ≪ ⊤ ⇒ (⟦A⟧ ⇔ ⟪B⟫), ⎪⎢⎜ ⎲ ⎟⎥⎪
- ⎪⎢⎜ ⎳aⁱ-bⁱ⎟⎥⎪
- 2H₂ + O₂ ⇌ 2H₂O, R = 4.7 kΩ, ⌀ 200 mm ⎩⎣⎝i=1 ⎠⎦⎭
-
-Linguistics and dictionaries:
-
- ði ıntəˈnæʃənəl fəˈnɛtık əsoʊsiˈeıʃn
- Y [ˈʏpsilɔn], Yen [jɛn], Yoga [ˈjoːgɑ]
-
-APL:
-
- ((V⍳V)=⍳⍴V)/V←,V ⌷←⍳→⍴∆∇⊃‾⍎⍕⌈
-
-Nicer typography in plain text files:
-
- ╔══════════════════════════════════════════╗
- ║ ║
- ║ • ‘single’ and “double” quotes ║
- ║ ║
- ║ • Curly apostrophes: “We’ve been here” ║
- ║ ║
- ║ • Latin-1 apostrophe and accents: '´` ║
- ║ ║
- ║ • ‚deutsche‘ „Anführungszeichen“ ║
- ║ ║
- ║ • †, ‡, ‰, •, 3–4, —, −5/+5, ™, … ║
- ║ ║
- ║ • ASCII safety test: 1lI|, 0OD, 8B ║
- ║ ╭─────────╮ ║
- ║ • the euro symbol: │ 14.95 € │ ║
- ║ ╰─────────╯ ║
- ╚══════════════════════════════════════════╝
-
-Combining characters:
-
- STARGΛ̊TE SG-1, a = v̇ = r̈, a⃑ ⊥ b⃑
-
-Greek (in Polytonic):
-
- The Greek anthem:
-
- Σὲ γνωρίζω ἀπὸ τὴν κόψη
- τοῦ σπαθιοῦ τὴν τρομερή,
- σὲ γνωρίζω ἀπὸ τὴν ὄψη
- ποὺ μὲ βία μετράει τὴ γῆ.
-
- ᾿Απ᾿ τὰ κόκκαλα βγαλμένη
- τῶν ῾Ελλήνων τὰ ἱερά
- καὶ σὰν πρῶτα ἀνδρειωμένη
- χαῖρε, ὦ χαῖρε, ᾿Ελευθεριά!
-
- From a speech of Demosthenes in the 4th century BC:
-
- Οὐχὶ ταὐτὰ παρίσταταί μοι γιγνώσκειν, ὦ ἄνδρες ᾿Αθηναῖοι,
- ὅταν τ᾿ εἰς τὰ πράγματα ἀποβλέψω καὶ ὅταν πρὸς τοὺς
- λόγους οὓς ἀκούω· τοὺς μὲν γὰρ λόγους περὶ τοῦ
- τιμωρήσασθαι Φίλιππον ὁρῶ γιγνομένους, τὰ δὲ πράγματ᾿
- εἰς τοῦτο προήκοντα, ὥσθ᾿ ὅπως μὴ πεισόμεθ᾿ αὐτοὶ
- πρότερον κακῶς σκέψασθαι δέον. οὐδέν οὖν ἄλλο μοι δοκοῦσιν
- οἱ τὰ τοιαῦτα λέγοντες ἢ τὴν ὑπόθεσιν, περὶ ἧς βουλεύεσθαι,
- οὐχὶ τὴν οὖσαν παριστάντες ὑμῖν ἁμαρτάνειν. ἐγὼ δέ, ὅτι μέν
- ποτ᾿ ἐξῆν τῇ πόλει καὶ τὰ αὑτῆς ἔχειν ἀσφαλῶς καὶ Φίλιππον
- τιμωρήσασθαι, καὶ μάλ᾿ ἀκριβῶς οἶδα· ἐπ᾿ ἐμοῦ γάρ, οὐ πάλαι
- γέγονεν ταῦτ᾿ ἀμφότερα· νῦν μέντοι πέπεισμαι τοῦθ᾿ ἱκανὸν
- προλαβεῖν ἡμῖν εἶναι τὴν πρώτην, ὅπως τοὺς συμμάχους
- σώσομεν. ἐὰν γὰρ τοῦτο βεβαίως ὑπάρξῃ, τότε καὶ περὶ τοῦ
- τίνα τιμωρήσεταί τις καὶ ὃν τρόπον ἐξέσται σκοπεῖν· πρὶν δὲ
- τὴν ἀρχὴν ὀρθῶς ὑποθέσθαι, μάταιον ἡγοῦμαι περὶ τῆς
- τελευτῆς ὁντινοῦν ποιεῖσθαι λόγον.
-
- Δημοσθένους, Γ´ ᾿Ολυνθιακὸς
-
-Georgian:
-
- From a Unicode conference invitation:
-
- გთხოვთ ახლავე გაიაროთ რეგისტრაცია Unicode-ის მეათე საერთაშორისო
- კონფერენციაზე დასასწრებად, რომელიც გაიმართება 10-12 მარტს,
- ქ. მაინცში, გერმანიაში. კონფერენცია შეჰკრებს ერთად მსოფლიოს
- ექსპერტებს ისეთ დარგებში როგორიცაა ინტერნეტი და Unicode-ი,
- ინტერნაციონალიზაცია და ლოკალიზაცია, Unicode-ის გამოყენება
- ოპერაციულ სისტემებსა, და გამოყენებით პროგრამებში, შრიფტებში,
- ტექსტების დამუშავებასა და მრავალენოვან კომპიუტერულ სისტემებში.
-
-Russian:
-
- From a Unicode conference invitation:
-
- Зарегистрируйтесь сейчас на Десятую Международную Конференцию по
- Unicode, которая состоится 10-12 марта 1997 года в Майнце в Германии.
- Конференция соберет широкий круг экспертов по вопросам глобального
- Интернета и Unicode, локализации и интернационализации, воплощению и
- применению Unicode в различных операционных системах и программных
- приложениях, шрифтах, верстке и многоязычных компьютерных системах.
-
-Thai (UCS Level 2):
-
- Excerpt from a poetry on The Romance of The Three Kingdoms (a Chinese
- classic 'San Gua'):
-
- [----------------------------|------------------------]
- ๏ แผ่นดินฮั่นเสื่อมโทรมแสนสังเวช พระปกเกศกองบู๊กู้ขึ้นใหม่
- สิบสองกษัตริย์ก่อนหน้าแลถัดไป สององค์ไซร้โง่เขลาเบาปัญญา
- ทรงนับถือขันทีเป็นที่พึ่ง บ้านเมืองจึงวิปริตเป็นนักหนา
- โฮจิ๋นเรียกทัพทั่วหัวเมืองมา หมายจะฆ่ามดชั่วตัวสำคัญ
- เหมือนขับไสไล่เสือจากเคหา รับหมาป่าเข้ามาเลยอาสัญ
- ฝ่ายอ้องอุ้นยุแยกให้แตกกัน ใช้สาวนั้นเป็นชนวนชื่นชวนใจ
- พลันลิฉุยกุยกีกลับก่อเหตุ ช่างอาเพศจริงหนาฟ้าร้องไห้
- ต้องรบราฆ่าฟันจนบรรลัย ฤๅหาใครค้ำชูกู้บรรลังก์ ฯ
-
- (The above is a two-column text. If combining characters are handled
- correctly, the lines of the second column should be aligned with the
- | character above.)
-
-Ethiopian:
-
- Proverbs in the Amharic language:
-
- ሰማይ አይታረስ ንጉሥ አይከሰስ።
- ብላ ካለኝ እንደአባቴ በቆመጠኝ።
- ጌጥ ያለቤቱ ቁምጥና ነው።
- ደሀ በሕልሙ ቅቤ ባይጠጣ ንጣት በገደለው።
- የአፍ ወለምታ በቅቤ አይታሽም።
- አይጥ በበላ ዳዋ ተመታ።
- ሲተረጉሙ ይደረግሙ።
- ቀስ በቀስ፥ ዕንቁላል በእግሩ ይሄዳል።
- ድር ቢያብር አንበሳ ያስር።
- ሰው እንደቤቱ እንጅ እንደ ጉረቤቱ አይተዳደርም።
- እግዜር የከፈተውን ጉሮሮ ሳይዘጋው አይድርም።
- የጎረቤት ሌባ፥ ቢያዩት ይስቅ ባያዩት ያጠልቅ።
- ሥራ ከመፍታት ልጄን ላፋታት።
- ዓባይ ማደሪያ የለው፥ ግንድ ይዞ ይዞራል።
- የእስላም አገሩ መካ የአሞራ አገሩ ዋርካ።
- ተንጋሎ ቢተፉ ተመልሶ ባፉ።
- ወዳጅህ ማር ቢሆን ጨርስህ አትላሰው።
- እግርህን በፍራሽህ ልክ ዘርጋ።
-
-Runes:
-
- ᚻᛖ ᚳᚹᚫᚦ ᚦᚫᛏ ᚻᛖ ᛒᚢᛞᛖ ᚩᚾ ᚦᚫᛗ ᛚᚪᚾᛞᛖ ᚾᚩᚱᚦᚹᛖᚪᚱᛞᚢᛗ ᚹᛁᚦ ᚦᚪ ᚹᛖᛥᚫ
-
- (Old English, which transcribed into Latin reads 'He cwaeth that he
- bude thaem lande northweardum with tha Westsae.' and means 'He said
- that he lived in the northern land near the Western Sea.')
-
-Braille:
-
- ⡌⠁⠧⠑ ⠼⠁⠒ ⡍⠜⠇⠑⠹⠰⠎ ⡣⠕⠌
-
- ⡍⠜⠇⠑⠹ ⠺⠁⠎ ⠙⠑⠁⠙⠒ ⠞⠕ ⠃⠑⠛⠔ ⠺⠊⠹⠲ ⡹⠻⠑ ⠊⠎ ⠝⠕ ⠙⠳⠃⠞
- ⠱⠁⠞⠑⠧⠻ ⠁⠃⠳⠞ ⠹⠁⠞⠲ ⡹⠑ ⠗⠑⠛⠊⠌⠻ ⠕⠋ ⠙⠊⠎ ⠃⠥⠗⠊⠁⠇ ⠺⠁⠎
- ⠎⠊⠛⠝⠫ ⠃⠹ ⠹⠑ ⠊⠇⠻⠛⠹⠍⠁⠝⠂ ⠹⠑ ⠊⠇⠻⠅⠂ ⠹⠑ ⠥⠝⠙⠻⠞⠁⠅⠻⠂
- ⠁⠝⠙ ⠹⠑ ⠡⠊⠑⠋ ⠍⠳⠗⠝⠻⠲ ⡎⠊⠗⠕⠕⠛⠑ ⠎⠊⠛⠝⠫ ⠊⠞⠲ ⡁⠝⠙
- ⡎⠊⠗⠕⠕⠛⠑⠰⠎ ⠝⠁⠍⠑ ⠺⠁⠎ ⠛⠕⠕⠙ ⠥⠏⠕⠝ ⠰⡡⠁⠝⠛⠑⠂ ⠋⠕⠗ ⠁⠝⠹⠹⠔⠛ ⠙⠑
- ⠡⠕⠎⠑ ⠞⠕ ⠏⠥⠞ ⠙⠊⠎ ⠙⠁⠝⠙ ⠞⠕⠲
-
- ⡕⠇⠙ ⡍⠜⠇⠑⠹ ⠺⠁⠎ ⠁⠎ ⠙⠑⠁⠙ ⠁⠎ ⠁ ⠙⠕⠕⠗⠤⠝⠁⠊⠇⠲
-
- ⡍⠔⠙⠖ ⡊ ⠙⠕⠝⠰⠞ ⠍⠑⠁⠝ ⠞⠕ ⠎⠁⠹ ⠹⠁⠞ ⡊ ⠅⠝⠪⠂ ⠕⠋ ⠍⠹
- ⠪⠝ ⠅⠝⠪⠇⠫⠛⠑⠂ ⠱⠁⠞ ⠹⠻⠑ ⠊⠎ ⠏⠜⠞⠊⠊⠥⠇⠜⠇⠹ ⠙⠑⠁⠙ ⠁⠃⠳⠞
- ⠁ ⠙⠕⠕⠗⠤⠝⠁⠊⠇⠲ ⡊ ⠍⠊⠣⠞ ⠙⠁⠧⠑ ⠃⠑⠲ ⠔⠊⠇⠔⠫⠂ ⠍⠹⠎⠑⠇⠋⠂ ⠞⠕
- ⠗⠑⠛⠜⠙ ⠁ ⠊⠕⠋⠋⠔⠤⠝⠁⠊⠇ ⠁⠎ ⠹⠑ ⠙⠑⠁⠙⠑⠌ ⠏⠊⠑⠊⠑ ⠕⠋ ⠊⠗⠕⠝⠍⠕⠝⠛⠻⠹
- ⠔ ⠹⠑ ⠞⠗⠁⠙⠑⠲ ⡃⠥⠞ ⠹⠑ ⠺⠊⠎⠙⠕⠍ ⠕⠋ ⠳⠗ ⠁⠝⠊⠑⠌⠕⠗⠎
- ⠊⠎ ⠔ ⠹⠑ ⠎⠊⠍⠊⠇⠑⠆ ⠁⠝⠙ ⠍⠹ ⠥⠝⠙⠁⠇⠇⠪⠫ ⠙⠁⠝⠙⠎
- ⠩⠁⠇⠇ ⠝⠕⠞ ⠙⠊⠌⠥⠗⠃ ⠊⠞⠂ ⠕⠗ ⠹⠑ ⡊⠳⠝⠞⠗⠹⠰⠎ ⠙⠕⠝⠑ ⠋⠕⠗⠲ ⡹⠳
- ⠺⠊⠇⠇ ⠹⠻⠑⠋⠕⠗⠑ ⠏⠻⠍⠊⠞ ⠍⠑ ⠞⠕ ⠗⠑⠏⠑⠁⠞⠂ ⠑⠍⠏⠙⠁⠞⠊⠊⠁⠇⠇⠹⠂ ⠹⠁⠞
- ⡍⠜⠇⠑⠹ ⠺⠁⠎ ⠁⠎ ⠙⠑⠁⠙ ⠁⠎ ⠁ ⠙⠕⠕⠗⠤⠝⠁⠊⠇⠲
-
- (The first couple of paragraphs of "A Christmas Carol" by Dickens)
-
-Compact font selection example text:
-
- ABCDEFGHIJKLMNOPQRSTUVWXYZ /0123456789
- abcdefghijklmnopqrstuvwxyz £©µÀÆÖÞßéöÿ
- –—‘“”„†•…‰™œŠŸž€ ΑΒΓΔΩαβγδω АБВГДабвгд
- ∀∂∈ℝ∧∪≡∞ ↑↗↨↻⇣ ┐┼╔╘░►☺♀ fi�⑀₂ἠḂӥẄɐː⍎אԱა
-
-Greetings in various languages:
-
- Hello world, Καλημέρα κόσμε, コンニチハ
-
-Box drawing alignment tests: █
- ▉
- ╔══╦══╗ ┌──┬──┐ ╭──┬──╮ ╭──┬──╮ ┏━━┳━━┓ ┎┒┏┑ ╷ ╻ ┏┯┓ ┌┰┐ ▊ ╱╲╱╲╳╳╳
- ║┌─╨─┐║ │╔═╧═╗│ │╒═╪═╕│ │╓─╁─╖│ ┃┌─╂─┐┃ ┗╃╄┙ ╶┼╴╺╋╸┠┼┨ ┝╋┥ ▋ ╲╱╲╱╳╳╳
- ║│╲ ╱│║ │║ ║│ ││ │ ││ │║ ┃ ║│ ┃│ ╿ │┃ ┍╅╆┓ ╵ ╹ ┗┷┛ └┸┘ ▌ ╱╲╱╲╳╳╳
- ╠╡ ╳ ╞╣ ├╢ ╟┤ ├┼─┼─┼┤ ├╫─╂─╫┤ ┣┿╾┼╼┿┫ ┕┛┖┚ ┌┄┄┐ ╎ ┏┅┅┓ ┋ ▍ ╲╱╲╱╳╳╳
- ║│╱ ╲│║ │║ ║│ ││ │ ││ │║ ┃ ║│ ┃│ ╽ │┃ ░░▒▒▓▓██ ┊ ┆ ╎ ╏ ┇ ┋ ▎
- ║└─╥─┘║ │╚═╤═╝│ │╘═╪═╛│ │╙─╀─╜│ ┃└─╂─┘┃ ░░▒▒▓▓██ ┊ ┆ ╎ ╏ ┇ ┋ ▏
- ╚══╩══╝ └──┴──┘ ╰──┴──╯ ╰──┴──╯ ┗━━┻━━┛ ▗▄▖▛▀▜ └╌╌┘ ╎ ┗╍╍┛ ┋ ▁▂▃▄▅▆▇█
- ▝▀▘▙▄▟
(DIR) diff --git a/3rdparties/software/babel-20171227-git/tests/utf-8.txt-utf8 b/3rdparties/software/babel-20171227-git/tests/utf-8.txt-utf8
@@ -1,212 +0,0 @@
-
-UTF-8 encoded sample plain-text file
-‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾
-
-Markus Kuhn [ˈmaʳkʊs kuːn] <http://www.cl.cam.ac.uk/~mgk25/> — 2002-07-25
-
-
-The ASCII compatible UTF-8 encoding used in this plain-text file
-is defined in Unicode, ISO 10646-1, and RFC 2279.
-
-
-Using Unicode/UTF-8, you can write in emails and source code things such as
-
-Mathematics and sciences:
-
- ∮ E⋅da = Q, n → ∞, ∑ f(i) = ∏ g(i), ⎧⎡⎛┌─────┐⎞⎤⎫
- ⎪⎢⎜│a²+b³ ⎟⎥⎪
- ∀x∈ℝ: ⌈x⌉ = −⌊−x⌋, α ∧ ¬β = ¬(¬α ∨ β), ⎪⎢⎜│───── ⎟⎥⎪
- ⎪⎢⎜⎷ c₈ ⎟⎥⎪
- ℕ ⊆ ℕ₀ ⊂ ℤ ⊂ ℚ ⊂ ℝ ⊂ ℂ, ⎨⎢⎜ ⎟⎥⎬
- ⎪⎢⎜ ∞ ⎟⎥⎪
- ⊥ < a ≠ b ≡ c ≤ d ≪ ⊤ ⇒ (⟦A⟧ ⇔ ⟪B⟫), ⎪⎢⎜ ⎲ ⎟⎥⎪
- ⎪⎢⎜ ⎳aⁱ-bⁱ⎟⎥⎪
- 2H₂ + O₂ ⇌ 2H₂O, R = 4.7 kΩ, ⌀ 200 mm ⎩⎣⎝i=1 ⎠⎦⎭
-
-Linguistics and dictionaries:
-
- ði ıntəˈnæʃənəl fəˈnɛtık əsoʊsiˈeıʃn
- Y [ˈʏpsilɔn], Yen [jɛn], Yoga [ˈjoːgɑ]
-
-APL:
-
- ((V⍳V)=⍳⍴V)/V←,V ⌷←⍳→⍴∆∇⊃‾⍎⍕⌈
-
-Nicer typography in plain text files:
-
- ╔══════════════════════════════════════════╗
- ║ ║
- ║ • ‘single’ and “double” quotes ║
- ║ ║
- ║ • Curly apostrophes: “We’ve been here” ║
- ║ ║
- ║ • Latin-1 apostrophe and accents: '´` ║
- ║ ║
- ║ • ‚deutsche‘ „Anführungszeichen“ ║
- ║ ║
- ║ • †, ‡, ‰, •, 3–4, —, −5/+5, ™, … ║
- ║ ║
- ║ • ASCII safety test: 1lI|, 0OD, 8B ║
- ║ ╭─────────╮ ║
- ║ • the euro symbol: │ 14.95 € │ ║
- ║ ╰─────────╯ ║
- ╚══════════════════════════════════════════╝
-
-Combining characters:
-
- STARGΛ̊TE SG-1, a = v̇ = r̈, a⃑ ⊥ b⃑
-
-Greek (in Polytonic):
-
- The Greek anthem:
-
- Σὲ γνωρίζω ἀπὸ τὴν κόψη
- τοῦ σπαθιοῦ τὴν τρομερή,
- σὲ γνωρίζω ἀπὸ τὴν ὄψη
- ποὺ μὲ βία μετράει τὴ γῆ.
-
- ᾿Απ᾿ τὰ κόκκαλα βγαλμένη
- τῶν ῾Ελλήνων τὰ ἱερά
- καὶ σὰν πρῶτα ἀνδρειωμένη
- χαῖρε, ὦ χαῖρε, ᾿Ελευθεριά!
-
- From a speech of Demosthenes in the 4th century BC:
-
- Οὐχὶ ταὐτὰ παρίσταταί μοι γιγνώσκειν, ὦ ἄνδρες ᾿Αθηναῖοι,
- ὅταν τ᾿ εἰς τὰ πράγματα ἀποβλέψω καὶ ὅταν πρὸς τοὺς
- λόγους οὓς ἀκούω· τοὺς μὲν γὰρ λόγους περὶ τοῦ
- τιμωρήσασθαι Φίλιππον ὁρῶ γιγνομένους, τὰ δὲ πράγματ᾿
- εἰς τοῦτο προήκοντα, ὥσθ᾿ ὅπως μὴ πεισόμεθ᾿ αὐτοὶ
- πρότερον κακῶς σκέψασθαι δέον. οὐδέν οὖν ἄλλο μοι δοκοῦσιν
- οἱ τὰ τοιαῦτα λέγοντες ἢ τὴν ὑπόθεσιν, περὶ ἧς βουλεύεσθαι,
- οὐχὶ τὴν οὖσαν παριστάντες ὑμῖν ἁμαρτάνειν. ἐγὼ δέ, ὅτι μέν
- ποτ᾿ ἐξῆν τῇ πόλει καὶ τὰ αὑτῆς ἔχειν ἀσφαλῶς καὶ Φίλιππον
- τιμωρήσασθαι, καὶ μάλ᾿ ἀκριβῶς οἶδα· ἐπ᾿ ἐμοῦ γάρ, οὐ πάλαι
- γέγονεν ταῦτ᾿ ἀμφότερα· νῦν μέντοι πέπεισμαι τοῦθ᾿ ἱκανὸν
- προλαβεῖν ἡμῖν εἶναι τὴν πρώτην, ὅπως τοὺς συμμάχους
- σώσομεν. ἐὰν γὰρ τοῦτο βεβαίως ὑπάρξῃ, τότε καὶ περὶ τοῦ
- τίνα τιμωρήσεταί τις καὶ ὃν τρόπον ἐξέσται σκοπεῖν· πρὶν δὲ
- τὴν ἀρχὴν ὀρθῶς ὑποθέσθαι, μάταιον ἡγοῦμαι περὶ τῆς
- τελευτῆς ὁντινοῦν ποιεῖσθαι λόγον.
-
- Δημοσθένους, Γ´ ᾿Ολυνθιακὸς
-
-Georgian:
-
- From a Unicode conference invitation:
-
- გთხოვთ ახლავე გაიაროთ რეგისტრაცია Unicode-ის მეათე საერთაშორისო
- კონფერენციაზე დასასწრებად, რომელიც გაიმართება 10-12 მარტს,
- ქ. მაინცში, გერმანიაში. კონფერენცია შეჰკრებს ერთად მსოფლიოს
- ექსპერტებს ისეთ დარგებში როგორიცაა ინტერნეტი და Unicode-ი,
- ინტერნაციონალიზაცია და ლოკალიზაცია, Unicode-ის გამოყენება
- ოპერაციულ სისტემებსა, და გამოყენებით პროგრამებში, შრიფტებში,
- ტექსტების დამუშავებასა და მრავალენოვან კომპიუტერულ სისტემებში.
-
-Russian:
-
- From a Unicode conference invitation:
-
- Зарегистрируйтесь сейчас на Десятую Международную Конференцию по
- Unicode, которая состоится 10-12 марта 1997 года в Майнце в Германии.
- Конференция соберет широкий круг экспертов по вопросам глобального
- Интернета и Unicode, локализации и интернационализации, воплощению и
- применению Unicode в различных операционных системах и программных
- приложениях, шрифтах, верстке и многоязычных компьютерных системах.
-
-Thai (UCS Level 2):
-
- Excerpt from a poetry on The Romance of The Three Kingdoms (a Chinese
- classic 'San Gua'):
-
- [----------------------------|------------------------]
- ๏ แผ่นดินฮั่นเสื่อมโทรมแสนสังเวช พระปกเกศกองบู๊กู้ขึ้นใหม่
- สิบสองกษัตริย์ก่อนหน้าแลถัดไป สององค์ไซร้โง่เขลาเบาปัญญา
- ทรงนับถือขันทีเป็นที่พึ่ง บ้านเมืองจึงวิปริตเป็นนักหนา
- โฮจิ๋นเรียกทัพทั่วหัวเมืองมา หมายจะฆ่ามดชั่วตัวสำคัญ
- เหมือนขับไสไล่เสือจากเคหา รับหมาป่าเข้ามาเลยอาสัญ
- ฝ่ายอ้องอุ้นยุแยกให้แตกกัน ใช้สาวนั้นเป็นชนวนชื่นชวนใจ
- พลันลิฉุยกุยกีกลับก่อเหตุ ช่างอาเพศจริงหนาฟ้าร้องไห้
- ต้องรบราฆ่าฟันจนบรรลัย ฤๅหาใครค้ำชูกู้บรรลังก์ ฯ
-
- (The above is a two-column text. If combining characters are handled
- correctly, the lines of the second column should be aligned with the
- | character above.)
-
-Ethiopian:
-
- Proverbs in the Amharic language:
-
- ሰማይ አይታረስ ንጉሥ አይከሰስ።
- ብላ ካለኝ እንደአባቴ በቆመጠኝ።
- ጌጥ ያለቤቱ ቁምጥና ነው።
- ደሀ በሕልሙ ቅቤ ባይጠጣ ንጣት በገደለው።
- የአፍ ወለምታ በቅቤ አይታሽም።
- አይጥ በበላ ዳዋ ተመታ።
- ሲተረጉሙ ይደረግሙ።
- ቀስ በቀስ፥ ዕንቁላል በእግሩ ይሄዳል።
- ድር ቢያብር አንበሳ ያስር።
- ሰው እንደቤቱ እንጅ እንደ ጉረቤቱ አይተዳደርም።
- እግዜር የከፈተውን ጉሮሮ ሳይዘጋው አይድርም።
- የጎረቤት ሌባ፥ ቢያዩት ይስቅ ባያዩት ያጠልቅ።
- ሥራ ከመፍታት ልጄን ላፋታት።
- ዓባይ ማደሪያ የለው፥ ግንድ ይዞ ይዞራል።
- የእስላም አገሩ መካ የአሞራ አገሩ ዋርካ።
- ተንጋሎ ቢተፉ ተመልሶ ባፉ።
- ወዳጅህ ማር ቢሆን ጨርስህ አትላሰው።
- እግርህን በፍራሽህ ልክ ዘርጋ።
-
-Runes:
-
- ᚻᛖ ᚳᚹᚫᚦ ᚦᚫᛏ ᚻᛖ ᛒᚢᛞᛖ ᚩᚾ ᚦᚫᛗ ᛚᚪᚾᛞᛖ ᚾᚩᚱᚦᚹᛖᚪᚱᛞᚢᛗ ᚹᛁᚦ ᚦᚪ ᚹᛖᛥᚫ
-
- (Old English, which transcribed into Latin reads 'He cwaeth that he
- bude thaem lande northweardum with tha Westsae.' and means 'He said
- that he lived in the northern land near the Western Sea.')
-
-Braille:
-
- ⡌⠁⠧⠑ ⠼⠁⠒ ⡍⠜⠇⠑⠹⠰⠎ ⡣⠕⠌
-
- ⡍⠜⠇⠑⠹ ⠺⠁⠎ ⠙⠑⠁⠙⠒ ⠞⠕ ⠃⠑⠛⠔ ⠺⠊⠹⠲ ⡹⠻⠑ ⠊⠎ ⠝⠕ ⠙⠳⠃⠞
- ⠱⠁⠞⠑⠧⠻ ⠁⠃⠳⠞ ⠹⠁⠞⠲ ⡹⠑ ⠗⠑⠛⠊⠌⠻ ⠕⠋ ⠙⠊⠎ ⠃⠥⠗⠊⠁⠇ ⠺⠁⠎
- ⠎⠊⠛⠝⠫ ⠃⠹ ⠹⠑ ⠊⠇⠻⠛⠹⠍⠁⠝⠂ ⠹⠑ ⠊⠇⠻⠅⠂ ⠹⠑ ⠥⠝⠙⠻⠞⠁⠅⠻⠂
- ⠁⠝⠙ ⠹⠑ ⠡⠊⠑⠋ ⠍⠳⠗⠝⠻⠲ ⡎⠊⠗⠕⠕⠛⠑ ⠎⠊⠛⠝⠫ ⠊⠞⠲ ⡁⠝⠙
- ⡎⠊⠗⠕⠕⠛⠑⠰⠎ ⠝⠁⠍⠑ ⠺⠁⠎ ⠛⠕⠕⠙ ⠥⠏⠕⠝ ⠰⡡⠁⠝⠛⠑⠂ ⠋⠕⠗ ⠁⠝⠹⠹⠔⠛ ⠙⠑
- ⠡⠕⠎⠑ ⠞⠕ ⠏⠥⠞ ⠙⠊⠎ ⠙⠁⠝⠙ ⠞⠕⠲
-
- ⡕⠇⠙ ⡍⠜⠇⠑⠹ ⠺⠁⠎ ⠁⠎ ⠙⠑⠁⠙ ⠁⠎ ⠁ ⠙⠕⠕⠗⠤⠝⠁⠊⠇⠲
-
- ⡍⠔⠙⠖ ⡊ ⠙⠕⠝⠰⠞ ⠍⠑⠁⠝ ⠞⠕ ⠎⠁⠹ ⠹⠁⠞ ⡊ ⠅⠝⠪⠂ ⠕⠋ ⠍⠹
- ⠪⠝ ⠅⠝⠪⠇⠫⠛⠑⠂ ⠱⠁⠞ ⠹⠻⠑ ⠊⠎ ⠏⠜⠞⠊⠊⠥⠇⠜⠇⠹ ⠙⠑⠁⠙ ⠁⠃⠳⠞
- ⠁ ⠙⠕⠕⠗⠤⠝⠁⠊⠇⠲ ⡊ ⠍⠊⠣⠞ ⠙⠁⠧⠑ ⠃⠑⠲ ⠔⠊⠇⠔⠫⠂ ⠍⠹⠎⠑⠇⠋⠂ ⠞⠕
- ⠗⠑⠛⠜⠙ ⠁ ⠊⠕⠋⠋⠔⠤⠝⠁⠊⠇ ⠁⠎ ⠹⠑ ⠙⠑⠁⠙⠑⠌ ⠏⠊⠑⠊⠑ ⠕⠋ ⠊⠗⠕⠝⠍⠕⠝⠛⠻⠹
- ⠔ ⠹⠑ ⠞⠗⠁⠙⠑⠲ ⡃⠥⠞ ⠹⠑ ⠺⠊⠎⠙⠕⠍ ⠕⠋ ⠳⠗ ⠁⠝⠊⠑⠌⠕⠗⠎
- ⠊⠎ ⠔ ⠹⠑ ⠎⠊⠍⠊⠇⠑⠆ ⠁⠝⠙ ⠍⠹ ⠥⠝⠙⠁⠇⠇⠪⠫ ⠙⠁⠝⠙⠎
- ⠩⠁⠇⠇ ⠝⠕⠞ ⠙⠊⠌⠥⠗⠃ ⠊⠞⠂ ⠕⠗ ⠹⠑ ⡊⠳⠝⠞⠗⠹⠰⠎ ⠙⠕⠝⠑ ⠋⠕⠗⠲ ⡹⠳
- ⠺⠊⠇⠇ ⠹⠻⠑⠋⠕⠗⠑ ⠏⠻⠍⠊⠞ ⠍⠑ ⠞⠕ ⠗⠑⠏⠑⠁⠞⠂ ⠑⠍⠏⠙⠁⠞⠊⠊⠁⠇⠇⠹⠂ ⠹⠁⠞
- ⡍⠜⠇⠑⠹ ⠺⠁⠎ ⠁⠎ ⠙⠑⠁⠙ ⠁⠎ ⠁ ⠙⠕⠕⠗⠤⠝⠁⠊⠇⠲
-
- (The first couple of paragraphs of "A Christmas Carol" by Dickens)
-
-Compact font selection example text:
-
- ABCDEFGHIJKLMNOPQRSTUVWXYZ /0123456789
- abcdefghijklmnopqrstuvwxyz £©µÀÆÖÞßéöÿ
- –—‘“”„†•…‰™œŠŸž€ ΑΒΓΔΩαβγδω АБВГДабвгд
- ∀∂∈ℝ∧∪≡∞ ↑↗↨↻⇣ ┐┼╔╘░►☺♀ fi�⑀₂ἠḂӥẄɐː⍎אԱა
-
-Greetings in various languages:
-
- Hello world, Καλημέρα κόσμε, コンニチハ
-
-Box drawing alignment tests: █
- ▉
- ╔══╦══╗ ┌──┬──┐ ╭──┬──╮ ╭──┬──╮ ┏━━┳━━┓ ┎┒┏┑ ╷ ╻ ┏┯┓ ┌┰┐ ▊ ╱╲╱╲╳╳╳
- ║┌─╨─┐║ │╔═╧═╗│ │╒═╪═╕│ │╓─╁─╖│ ┃┌─╂─┐┃ ┗╃╄┙ ╶┼╴╺╋╸┠┼┨ ┝╋┥ ▋ ╲╱╲╱╳╳╳
- ║│╲ ╱│║ │║ ║│ ││ │ ││ │║ ┃ ║│ ┃│ ╿ │┃ ┍╅╆┓ ╵ ╹ ┗┷┛ └┸┘ ▌ ╱╲╱╲╳╳╳
- ╠╡ ╳ ╞╣ ├╢ ╟┤ ├┼─┼─┼┤ ├╫─╂─╫┤ ┣┿╾┼╼┿┫ ┕┛┖┚ ┌┄┄┐ ╎ ┏┅┅┓ ┋ ▍ ╲╱╲╱╳╳╳
- ║│╱ ╲│║ │║ ║│ ││ │ ││ │║ ┃ ║│ ┃│ ╽ │┃ ░░▒▒▓▓██ ┊ ┆ ╎ ╏ ┇ ┋ ▎
- ║└─╥─┘║ │╚═╤═╝│ │╘═╪═╛│ │╙─╀─╜│ ┃└─╂─┘┃ ░░▒▒▓▓██ ┊ ┆ ╎ ╏ ┇ ┋ ▏
- ╚══╩══╝ └──┴──┘ ╰──┴──╯ ╰──┴──╯ ┗━━┻━━┛ ▗▄▖▛▀▜ └╌╌┘ ╎ ┗╍╍┛ ┋ ▁▂▃▄▅▆▇█
- ▝▀▘▙▄▟
(DIR) diff --git a/3rdparties/software/bordeaux-threads-v0.8.6/.travis.yml b/3rdparties/software/bordeaux-threads-v0.8.6/.travis.yml
@@ -1,46 +0,0 @@
-language: lisp
-
-env:
- matrix:
- - LISP=allegro
- - LISP=ccl
- - LISP=ccl32
- - LISP=sbcl
- - LISP=sbcl32
- - LISP=abcl
- - LISP=cmucl
- - LISP=ecl
-
-matrix:
- allow_failures:
- - env: LISP=abcl
- - env: LISP=cmucl
- - env: LISP=ecl
-
-notifications:
- email:
- on_success: change
- on_failure: always
- irc:
- channels:
- - "chat.freenode.net#iolib"
- on_success: change
- on_failure: always
- use_notice: true
- skip_join: true
-
-install:
- - curl -L https://raw.githubusercontent.com/sionescu/cl-travis/master/install.sh | sh
- - cl -e "(cl:in-package :cl-user)
- (dolist (p '(:fiveam))
- (ql:quickload p :verbose t))"
-
-script:
- - cl -e "(cl:in-package :cl-user)
- (prin1 (lisp-implementation-type)) (terpri) (prin1 (lisp-implementation-version)) (terpri)
- (ql:quickload :bordeaux-threads/test :verbose t)
- (uiop:quit (if (some (lambda (x) (typep x '5am::test-failure))
- (5am:run :bordeaux-threads))
- 1 0))"
-
-sudo: required
(DIR) diff --git a/3rdparties/software/bordeaux-threads-v0.8.6/CONTRIBUTORS b/3rdparties/software/bordeaux-threads-v0.8.6/CONTRIBUTORS
@@ -1,19 +0,0 @@
--*- outline -*-
-
-Based on original Bordeaux-MP spec by Dan Barlow <dan@telent.net>
-
-Contributors:
-
-* Attila Lendvai <attila.lendvai@gmail.com>
- - better handling of unsupported Lisps
-* Vladimir Sekissov <svg@surnet.ru>
- - fixes for CMUCL implementation
-* Pierre Thierry <nowhere.man@levallois.eu.org>
- - added license information
-* Stelian Ionescu <sionescu@cddr.org>
- - finished conversion from generic functions
- - enabled running thread-safe code in unthreaded lisps
-* Douglas Crosher <dtc@scieneer.com>
- - added Scieneer Common Lisp support
-* Daniel Kochmański <daniel@turtleware.eu>
- - semaphores implementation
(DIR) diff --git a/3rdparties/software/bordeaux-threads-v0.8.6/LICENSE b/3rdparties/software/bordeaux-threads-v0.8.6/LICENSE
@@ -1,20 +0,0 @@
-Permission is hereby granted, free of charge, to any person
-obtaining a copy of this software and associated documentation
-files (the "Software"), to deal in the Software without
-restriction, including without limitation the rights to use,
-copy, modify, merge, publish, distribute, sublicense, and/or sell
-copies of the Software, and to permit persons to whom the
-Software is furnished to do so, subject to the following
-conditions:
-
-The above copyright notice and this permission notice shall be
-included in all copies or substantial portions of the Software.
-
-THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
-EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES
-OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
-NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
-HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
-WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
-FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
-OTHER DEALINGS IN THE SOFTWARE.
(DIR) diff --git a/3rdparties/software/bordeaux-threads-v0.8.6/README b/3rdparties/software/bordeaux-threads-v0.8.6/README
@@ -1,2 +0,0 @@
-You can find API documentation on the project's wiki:
- http://trac.common-lisp.net/bordeaux-threads/wiki/ApiDocumentation
(DIR) diff --git a/3rdparties/software/bordeaux-threads-v0.8.6/bordeaux-threads.asd b/3rdparties/software/bordeaux-threads-v0.8.6/bordeaux-threads.asd
@@ -1,74 +0,0 @@
-;;;; -*- Mode: Lisp; indent-tabs-mode: nil -*-
-
-#|
-Copyright 2006,2007 Greg Pfeil
-
-Distributed under the MIT license (see LICENSE file)
-|#
-
-#.(unless (or #+asdf3.1 (version<= "3.1" (asdf-version)))
- (error "You need ASDF >= 3.1 to load this system correctly."))
-
-(eval-when (:compile-toplevel :load-toplevel :execute)
- #+(or armedbear
- (and allegro multiprocessing)
- (and clisp mt)
- (and openmcl openmcl-native-threads)
- (and cmu mp)
- corman
- (and ecl threads)
- genera
- mkcl
- lispworks
- (and digitool ccl-5.1)
- (and sbcl sb-thread)
- scl)
- (pushnew :thread-support *features*))
-
-(defsystem :bordeaux-threads
- :author "Greg Pfeil <greg@technomadic.org>"
- :licence "MIT"
- :description "Bordeaux Threads makes writing portable multi-threaded apps simple."
- :version (:read-file-form "version.sexp")
- :depends-on (:alexandria
- #+(and allegro (version>= 9)) (:require "smputil")
- #+(and allegro (not (version>= 9))) (:require "process")
- #+corman (:require "threads"))
- :components ((:static-file "version.sexp")
- (:module "src"
- :serial t
- :components
- ((:file "pkgdcl")
- (:file "bordeaux-threads")
- (:file #+(and thread-support armedbear) "impl-abcl"
- #+(and thread-support allegro) "impl-allegro"
- #+(and thread-support clisp) "impl-clisp"
- #+(and thread-support openmcl) "impl-clozure"
- #+(and thread-support cmu) "impl-cmucl"
- #+(and thread-support corman) "impl-corman"
- #+(and thread-support ecl) "impl-ecl"
- #+(and thread-support genera) "impl-genera"
- #+(and thread-support mkcl) "impl-mkcl"
- #+(and thread-support lispworks) "impl-lispworks"
- #+(and thread-support digitool) "impl-mcl"
- #+(and thread-support sbcl) "impl-sbcl"
- #+(and thread-support scl) "impl-scl"
- #-thread-support "impl-null")
- #+(and thread-support lispworks (or lispworks4 lispworks5))
- (:file "impl-lispworks-condition-variables")
- #+(and thread-support digitool)
- (:file "condition-variables")
- (:file "default-implementations")))))
-
-(defsystem :bordeaux-threads/test
- :author "Greg Pfeil <greg@technomadic.org>"
- :description "Bordeaux Threads test suite."
- :licence "MIT"
- :version (:read-file-form "version.sexp")
- :depends-on (:bordeaux-threads :fiveam)
- :components ((:module "test"
- :components ((:file "bordeaux-threads-test")))))
-
-(defmethod perform ((o test-op) (c (eql (find-system :bordeaux-threads))))
- (load-system :bordeaux-threads/test)
- (symbol-call :5am :run! :bordeaux-threads))
(DIR) diff --git a/3rdparties/software/bordeaux-threads-v0.8.6/site/index.html b/3rdparties/software/bordeaux-threads-v0.8.6/site/index.html
@@ -1,55 +0,0 @@
-<?xml version="1.0"?>
-
-<!--
-Copyright 2006,2007 Greg Pfeil
-
-Distributed under the MIT license (see LICENSE file)
--->
-
-<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN"
- "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
-<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
- <head>
- <title>Bordeaux Threads project</title>
- <link rel="stylesheet" type="text/css" href="style.css"/>
- <meta http-equiv="Content-Type" content="text/html; charset=ISO-8859-1"/>
- </head>
-
- <body>
- <div class="header">
- <h1>Bordeaux Threads</h1>
- <h2>Portable shared-state concurrency for Common Lisp</h2>
- </div>
-
- <p>Based on an original proposal by Dan Barlow (Bordeaux-MP) this
- library is meant to make writing portable multi-threaded apps
- simple.</p>
-
- <p>Read the current <a href="http://trac.common-lisp.net/bordeaux-threads/wiki/ApiDocumentation">API documentation</a>.</p>
-
- <p>Supports all major Common Lisp implementations: SBCL, CCL,
- Lispworks, Allegro, ABCL, ECL, Clisp.<br/> The MKCL, Corman,
- MCL and Scieneer backends are not tested frequently(if ever) and
- might not work.</p>
-
- <p>For discussion, use the mailing
- list <a href="http://www.common-lisp.net/mailman/listinfo/bordeaux-threads-devel">bordeaux-threads-devel</a>
- or the #lisp IRC channel on Freenode.</p>
-
- <h3>Source repository</h3>
-
- <p>Bordeaux-threads is developed
- at <a href="https://github.com/sionescu/bordeaux-threads">Github</a>. The
- repository is also mirrored
- to <a href="https://gitlab.com/bordeaux-threads/bordeaux-threads">Gitlab</a>
- and <a href="https://bitbucket.org/sionescu/bordeaux-threads">Bitbucket</a>.</p>
-
- <div class="footer">
- <a href="mailto:sionescu@cddr.org">Stelian Ionescu</a>. Last modified: <!--#flastmod file="index.shtml" -->
- </div>
-
- <div class="check">
- <a href="http://validator.w3.org/check/referer">Valid XHTML 1.0 Strict</a>
- </div>
- </body>
-</html>
(DIR) diff --git a/3rdparties/software/bordeaux-threads-v0.8.6/site/style.css b/3rdparties/software/bordeaux-threads-v0.8.6/site/style.css
@@ -1,86 +0,0 @@
-/*
-Copyright 2006,2007 Greg Pfeil
-
-Distributed under the MIT license (see LICENSE file)
-*/
-
-tbody {
- border-top: thin dotted black;
-}
-
-.failure {
- background-color: #ff0;
-}
-
-.nonexistant {
- background-color: #ccc;
-}
-
-.perfect {
- background-color: #0f0;
-}
-
-.error {
- background-color: #f00;
-}
-
-.header {
- font-size: medium;
- background-color:#336699;
- color:#ffffff;
- border-style:solid;
- border-width: 5px;
- border-color:#002244;
- padding: 1mm 1mm 1mm 5mm;
-}
-
-.footer {
- font-size: small;
- font-style: italic;
- text-align: right;
- background-color:#336699;
- color:#ffffff;
- border-style:solid;
- border-width: 2px;
- border-color:#002244;
- padding: 1mm 1mm 1mm 1mm;
-}
-
-.footer a:link {
- font-weight:bold;
- color:#ffffff;
- background-color: #336699;
- text-decoration:underline;
-}
-
-.footer a:visited {
- font-weight:bold;
- color:#ffffff;
- background-color: #336699;
- text-decoration:underline;
-}
-
-.footer a:hover {
- font-weight:bold;
- color:#002244;
- background-color: #336699;
- text-decoration:underline; }
-
-.check {font-size: x-small;
- text-align:right;}
-
-.check a:link { font-weight:bold;
- color:#a0a0ff;
- background-color: #FFFFFF;
- text-decoration:underline; }
-
-.check a:visited { font-weight:bold;
- color:#a0a0ff;
- background-color: #FFFFFF;
- text-decoration:underline; }
-
-.check a:hover { font-weight:bold;
- color:#000000;
- background-color: #FFFFFF;
- text-decoration:underline; }
-
(DIR) diff --git a/3rdparties/software/bordeaux-threads-v0.8.6/src/bordeaux-threads.lisp b/3rdparties/software/bordeaux-threads-v0.8.6/src/bordeaux-threads.lisp
@@ -1,170 +0,0 @@
-;;;; -*- indent-tabs-mode: nil -*-
-
-#|
-Copyright 2006, 2007 Greg Pfeil
-
-Distributed under the MIT license (see LICENSE file)
-|#
-
-(in-package #:bordeaux-threads)
-
-(defvar *supports-threads-p* nil
- "This should be set to T if the running instance has thread support.")
-
-(defun mark-supported ()
- (setf *supports-threads-p* t)
- (pushnew :bordeaux-threads *features*))
-
-(define-condition bordeaux-mp-condition (error)
- ((message :initarg :message :reader message))
- (:report (lambda (condition stream)
- (format stream (message condition)))))
-
-(defgeneric make-threading-support-error ()
- (:documentation "Creates a BORDEAUX-THREADS condition which specifies
- whether there is no BORDEAUX-THREADS support for the implementation, no
- threads enabled for the system, or no support for a particular
- function.")
- (:method ()
- (make-condition
- 'bordeaux-mp-condition
- :message (if *supports-threads-p*
- "There is no support for this method on this implementation."
- "There is no thread support in this instance."))))
-
-;;; Timeouts
-
-#-sbcl
-(define-condition timeout (serious-condition)
- ((length :initform nil
- :initarg :length
- :reader timeout-length))
- (:report (lambda (c s)
- (if (timeout-length c)
- (format s "A timeout set to ~A seconds occurred."
- (timeout-length c))
- (format s "A timeout occurred.")))))
-
-#-sbcl
-(defmacro with-timeout ((timeout) &body body)
- "Execute `BODY' and signal a condition of type TIMEOUT if the execution of
-BODY does not complete within `TIMEOUT' seconds. On implementations which do not
-support WITH-TIMEOUT natively and don't support threads either it has no effect."
- (declare (ignorable timeout body))
- #+thread-support
- (let ((ok-tag (gensym "OK"))
- (timeout-tag (gensym "TIMEOUT"))
- (caller (gensym "CALLER")))
- (once-only (timeout)
- `(multiple-value-prog1
- (catch ',ok-tag
- (catch ',timeout-tag
- (let ((,caller (current-thread)))
- (make-thread #'(lambda ()
- (sleep ,timeout)
- (interrupt-thread ,caller
- #'(lambda ()
- (ignore-errors
- (throw ',timeout-tag nil)))))
- :name (format nil "WITH-TIMEOUT thread serving: ~S."
- (thread-name ,caller)))
- (throw ',ok-tag (progn ,@body))))
- (error 'timeout :length ,timeout)))))
- #-thread-support
- `(error (make-threading-support-error)))
-
-;;; Semaphores
-
-;;; We provide this structure definition unconditionally regardless of the fact
-;;; it may not be used not to prevent warnings from compiling default functions
-;;; for semaphore in default-implementations.lisp.
-(defstruct %semaphore
- lock
- condition-variable
- counter)
-
-#-(or ccl sbcl)
-(deftype semaphore ()
- '%semaphore)
-
-;;; Thread Creation
-
-;;; See default-implementations.lisp for MAKE-THREAD.
-
-;; Forms are evaluated in the new thread or in the calling thread?
-(defvar *default-special-bindings* nil
- "This variable holds an alist associating special variable symbols
- to forms to evaluate. Special variables named in this list will
- be locally bound in the new thread before it begins executing user code.
-
- This variable may be rebound around calls to MAKE-THREAD to
- add/alter default bindings. The effect of mutating this list is
- undefined, but earlier forms take precedence over later forms for
- the same symbol, so defaults may be overridden by consing to the
- head of the list.")
-
-(defmacro defbindings (name docstring &body initforms)
- (check-type docstring string)
- `(defparameter ,name
- (list
- ,@(loop for (special form) in initforms
- collect `(cons ',special ',form)))
- ,docstring))
-
-;; Forms are evaluated in the new thread or in the calling thread?
-(defbindings *standard-io-bindings*
- "Standard bindings of printer/reader control variables as per CL:WITH-STANDARD-IO-SYNTAX."
- (*package* (find-package :common-lisp-user))
- (*print-array* t)
- (*print-base* 10)
- (*print-case* :upcase)
- (*print-circle* nil)
- (*print-escape* t)
- (*print-gensym* t)
- (*print-length* nil)
- (*print-level* nil)
- (*print-lines* nil)
- (*print-miser-width* nil)
- (*print-pprint-dispatch* (copy-pprint-dispatch nil))
- (*print-pretty* nil)
- (*print-radix* nil)
- (*print-readably* t)
- (*print-right-margin* nil)
- (*random-state* (make-random-state t))
- (*read-base* 10)
- (*read-default-float-format* 'single-float)
- (*read-eval* t)
- (*read-suppress* nil)
- (*readtable* (copy-readtable nil)))
-
-(defun binding-default-specials (function special-bindings)
- "Return a closure that binds the symbols in SPECIAL-BINDINGS and calls
-FUNCTION."
- (let ((specials (remove-duplicates special-bindings :from-end t :key #'car)))
- (lambda ()
- (progv (mapcar #'car specials)
- (loop for (nil . form) in specials collect (eval form))
- (funcall function)))))
-
-;;; FIXME: This test won't work if CURRENT-THREAD
-;;; conses a new object each time
-(defun signal-error-if-current-thread (thread)
- (when (eq thread (current-thread))
- (error 'bordeaux-mp-condition
- :message "Cannot destroy the current thread")))
-
-(defparameter *no-condition-wait-timeout-message*
- "CONDITION-WAIT with :TIMEOUT is not available for this Lisp implementation.")
-
-(defun signal-error-if-condition-wait-timeout (timeout)
- (when timeout
- (error 'bordeaux-mp-condition
- :message *no-condition-wait-timeout-message*)))
-
-(defmacro define-condition-wait-compiler-macro ()
- `(define-compiler-macro condition-wait
- (&whole whole condition-variable lock &key timeout)
- (declare (ignore condition-variable lock))
- (when timeout
- (simple-style-warning *no-condition-wait-timeout-message*))
- whole))
(DIR) diff --git a/3rdparties/software/bordeaux-threads-v0.8.6/src/condition-variables.lisp b/3rdparties/software/bordeaux-threads-v0.8.6/src/condition-variables.lisp
@@ -1,38 +0,0 @@
-;;;; -*- indent-tabs-mode: nil -*-
-
-#|
-Copyright 2006, 2007 Greg Pfeil
-
-Distributed under the MIT license (see LICENSE file)
-|#
-
-(in-package #:bordeaux-threads)
-
-;;; This file provides a portable implementation of condition
-;;; variables (given a working WITH-LOCK-HELD and THREAD-YIELD), and
-;;; should be used if there is no condition variable implementation in
-;;; the host Lisp.
-
-(defstruct condition-var
- name
- lock
- active)
-
-(defun condition-wait (condition-variable lock &key timeout)
- (signal-error-if-condition-wait-timeout timeout)
- (check-type condition-variable condition-var)
- (setf (condition-var-active condition-variable) nil)
- (release-lock lock)
- (do ()
- ((when (condition-var-active condition-variable)
- (acquire-lock lock)
- t))
- (thread-yield))
- t)
-
-(define-condition-wait-compiler-macro)
-
-(defun condition-notify (condition-variable)
- (check-type condition-variable condition-var)
- (with-lock-held ((condition-var-lock condition-variable))
- (setf (condition-var-active condition-variable) t)))
(DIR) diff --git a/3rdparties/software/bordeaux-threads-v0.8.6/src/default-implementations.lisp b/3rdparties/software/bordeaux-threads-v0.8.6/src/default-implementations.lisp
@@ -1,361 +0,0 @@
-;;;; -*- indent-tabs-mode: nil -*-
-
-(in-package #:bordeaux-threads)
-
-;;; Helper macros
-
-(defmacro defdfun (name args doc &body body)
- `(eval-when (:compile-toplevel :load-toplevel :execute)
- (unless (fboundp ',name)
- (defun ,name ,args ,@body))
- (setf (documentation ',name 'function)
- (or (documentation ',name 'function) ,doc))))
-
-(defmacro defdmacro (name args doc &body body)
- `(eval-when (:compile-toplevel :load-toplevel :execute)
- (unless (fboundp ',name)
- (defmacro ,name ,args ,@body))
- (setf (documentation ',name 'function)
- (or (documentation ',name 'function) ,doc))))
-
-;;; Thread Creation
-
-(defdfun start-multiprocessing ()
- "If the host implementation uses user-level threads, start the
-scheduler and multiprocessing, otherwise do nothing.
-It is safe to call repeatedly."
- nil)
-
-(defdfun make-thread (function &key name
- (initial-bindings *default-special-bindings*))
- "Creates and returns a thread named NAME, which will call the
- function FUNCTION with no arguments: when FUNCTION returns, the
- thread terminates. NAME defaults to \"Anonymous thread\" if unsupplied.
-
- On systems that do not support multi-threading, MAKE-THREAD will
- signal an error.
-
- The interaction between threads and dynamic variables is in some
- cases complex, and depends on whether the variable has only a global
- binding (as established by e.g. DEFVAR/DEFPARAMETER/top-level SETQ)
- or has been bound locally (e.g. with LET or LET*) in the calling
- thread.
-
- - Global bindings are shared between threads: the initial value of a
- global variable in the new thread will be the same as in the
- parent, and an assignment to such a variable in any thread will be
- visible to all threads in which the global binding is visible.
-
- - Local bindings, such as the ones introduced by INITIAL-BINDINGS,
- are local to the thread they are introduced in, except that
-
- - Local bindings in the the caller of MAKE-THREAD may or may not be
- shared with the new thread that it creates: this is
- implementation-defined. Portable code should not depend on
- particular behaviour in this case, nor should it assign to such
- variables without first rebinding them in the new thread."
- (%make-thread (binding-default-specials function initial-bindings)
- (or name "Anonymous thread")))
-
-(defdfun %make-thread (function name)
- "The actual implementation-dependent function that creates threads."
- (declare (ignore function name))
- (error (make-threading-support-error)))
-
-(defdfun current-thread ()
- "Returns the thread object for the calling
- thread. This is the same kind of object as would be returned by
- MAKE-THREAD."
- nil)
-
-(defdfun threadp (object)
- "Returns true if object is a thread, otherwise NIL."
- (declare (ignore object))
- nil)
-
-(defdfun thread-name (thread)
- "Returns the name of the thread, as supplied to MAKE-THREAD."
- (declare (ignore thread))
- "Main thread")
-
-;;; Resource contention: locks and recursive locks
-
-(defdfun lock-p (object)
- "Returns T if OBJECT is a lock; returns NIL otherwise."
- (declare (ignore object))
- nil)
-
-(defdfun recursive-lock-p (object)
- "Returns T if OBJECT is a recursive lock; returns NIL otherwise."
- (declare (ignore object))
- nil)
-
-(defdfun make-lock (&optional name)
- "Creates a lock (a mutex) whose name is NAME. If the system does not
- support multiple threads this will still return some object, but it
- may not be used for very much."
- ;; In CLIM-SYS this is a freshly consed list (NIL). I don't know if
- ;; there's some good reason it should be said structure or that it
- ;; be freshly consed - EQ comparison of locks?
- (declare (ignore name))
- (list nil))
-
-(defdfun acquire-lock (lock &optional wait-p)
- "Acquire the lock LOCK for the calling thread.
- WAIT-P governs what happens if the lock is not available: if WAIT-P
- is true, the calling thread will wait until the lock is available
- and then acquire it; if WAIT-P is NIL, ACQUIRE-LOCK will return
- immediately. ACQUIRE-LOCK returns true if the lock was acquired and
- NIL otherwise.
-
- This specification does not define what happens if a thread
- attempts to acquire a lock that it already holds. For applications
- that require locks to be safe when acquired recursively, see instead
- MAKE-RECURSIVE-LOCK and friends."
- (declare (ignore lock wait-p))
- t)
-
-(defdfun release-lock (lock)
- "Release LOCK. It is an error to call this unless
- the lock has previously been acquired (and not released) by the same
- thread. If other threads are waiting for the lock, the
- ACQUIRE-LOCK call in one of them will now be able to continue.
-
- This function has no interesting return value."
- (declare (ignore lock))
- (values))
-
-(defdmacro with-lock-held ((place) &body body)
- "Evaluates BODY with the lock named by PLACE, the value of which
- is a lock created by MAKE-LOCK. Before the forms in BODY are
- evaluated, the lock is acquired as if by using ACQUIRE-LOCK. After the
- forms in BODY have been evaluated, or if a non-local control transfer
- is caused (e.g. by THROW or SIGNAL), the lock is released as if by
- RELEASE-LOCK.
-
- Note that if the debugger is entered, it is unspecified whether the
- lock is released at debugger entry or at debugger exit when execution
- is restarted."
- `(when (acquire-lock ,place t)
- (unwind-protect
- (locally ,@body)
- (release-lock ,place))))
-
-(defdfun make-recursive-lock (&optional name)
- "Create and return a recursive lock whose name is NAME. A recursive
- lock differs from an ordinary lock in that a thread that already
- holds the recursive lock can acquire it again without blocking. The
- thread must then release the lock twice before it becomes available
- for another thread."
- (declare (ignore name))
- (list nil))
-
-(defdfun acquire-recursive-lock (lock)
- "As for ACQUIRE-LOCK, but for recursive locks."
- (declare (ignore lock))
- t)
-
-(defdfun release-recursive-lock (lock)
- "Release the recursive LOCK. The lock will only
- become free after as many Release operations as there have been
- Acquire operations. See RELEASE-LOCK for other information."
- (declare (ignore lock))
- (values))
-
-(defdmacro with-recursive-lock-held ((place &key timeout) &body body)
- "Evaluates BODY with the recursive lock named by PLACE, which is a
-reference to a recursive lock created by MAKE-RECURSIVE-LOCK. See
-WITH-LOCK-HELD etc etc"
- (declare (ignore timeout))
- `(when (acquire-recursive-lock ,place)
- (unwind-protect
- (locally ,@body)
- (release-recursive-lock ,place))))
-
-;;; Resource contention: condition variables
-
-;;; A condition variable provides a mechanism for threads to put
-;;; themselves to sleep while waiting for the state of something to
-;;; change, then to be subsequently woken by another thread which has
-;;; changed the state.
-;;;
-;;; A condition variable must be used in conjunction with a lock to
-;;; protect access to the state of the object of interest. The
-;;; procedure is as follows:
-;;;
-;;; Suppose two threads A and B, and some kind of notional event
-;;; channel C. A is consuming events in C, and B is producing them.
-;;; CV is a condition-variable
-;;;
-;;; 1) A acquires the lock that safeguards access to C
-;;; 2) A threads and removes all events that are available in C
-;;; 3) When C is empty, A calls CONDITION-WAIT, which atomically
-;;; releases the lock and puts A to sleep on CV
-;;; 4) Wait to be notified; CONDITION-WAIT will acquire the lock again
-;;; before returning
-;;; 5) Loop back to step 2, for as long as threading should continue
-;;;
-;;; When B generates an event E, it
-;;; 1) acquires the lock guarding C
-;;; 2) adds E to the channel
-;;; 3) calls CONDITION-NOTIFY on CV to wake any sleeping thread
-;;; 4) releases the lock
-;;;
-;;; To avoid the "lost wakeup" problem, the implementation must
-;;; guarantee that CONDITION-WAIT in thread A atomically releases the
-;;; lock and sleeps. If this is not guaranteed there is the
-;;; possibility that thread B can add an event and call
-;;; CONDITION-NOTIFY between the lock release and the sleep - in this
-;;; case the notify call would not see A, which would be left sleeping
-;;; despite there being an event available.
-
-(defdfun thread-yield ()
- "Allows other threads to run. It may be necessary or desirable to
- call this periodically in some implementations; others may schedule
- threads automatically. On systems that do not support
- multi-threading, this does nothing."
- (values))
-
-(defdfun make-condition-variable (&key name)
- "Returns a new condition-variable object for use
- with CONDITION-WAIT and CONDITION-NOTIFY."
- (declare (ignore name))
- nil)
-
-(defdfun condition-wait (condition-variable lock &key timeout)
- "Atomically release LOCK and enqueue the calling
- thread waiting for CONDITION-VARIABLE. The thread will resume when
- another thread has notified it using CONDITION-NOTIFY; it may also
- resume if interrupted by some external event or in other
- implementation-dependent circumstances: the caller must always test
- on waking that there is threading to be done, instead of assuming
- that it can go ahead.
-
- It is an error to call function this unless from the thread that
- holds LOCK.
-
- If TIMEOUT is nil or not provided, the system always reacquires LOCK
- before returning to the caller. In this case T is returned.
-
- If TIMEOUT is non-nil, the call will return after at most TIMEOUT
- seconds (approximately), whether or not a notification has occurred.
- Either NIL or T will be returned. A return of NIL indicates that the
- lock is no longer held and that the timeout has expired. A return of
- T indicates that the lock is held, in which case the timeout may or
- may not have expired.
-
- **NOTE**: The behavior of CONDITION-WAIT with TIMEOUT diverges from
- the POSIX function pthread_cond_timedwait. The former may return
- without the lock being held while the latter always returns with the
- lock held.
-
- In an implementation that does not support multiple threads, this
- function signals an error."
- (declare (ignore condition-variable lock timeout))
- (error (make-threading-support-error)))
-
-(defdfun condition-notify (condition-variable)
- "Notify at least one of the threads waiting for
- CONDITION-VARIABLE. It is implementation-dependent whether one or
- more than one (and possibly all) threads are woken, but if the
- implementation is capable of waking only a single thread (not all
- are) this is probably preferable for efficiency reasons. The order
- of wakeup is unspecified and does not necessarily relate to the
- order that the threads went to sleep in.
-
- CONDITION-NOTIFY has no useful return value. In an implementation
- that does not support multiple threads, it has no effect."
- (declare (ignore condition-variable))
- (values))
-
-;;; Resource contention: semaphores
-
-(defdfun make-semaphore (&key name (count 0))
- "Create a semaphore with the supplied NAME and initial counter value COUNT."
- (make-%semaphore :lock (make-lock name)
- :condition-variable (make-condition-variable :name name)
- :counter count))
-
-(defdfun signal-semaphore (semaphore &key (count 1))
- "Increment SEMAPHORE by COUNT. If there are threads waiting on this
-semaphore, then COUNT of them are woken up."
- (with-lock-held ((%semaphore-lock semaphore))
- (incf (%semaphore-counter semaphore) count)
- (dotimes (v count)
- (condition-notify (%semaphore-condition-variable semaphore))))
- (values))
-
-(defdfun wait-on-semaphore (semaphore &key timeout)
- "Decrement the count of SEMAPHORE by 1 if the count would not be negative.
-
-Else blocks until the semaphore can be decremented. Returns generalized boolean
-T on success.
-
-If TIMEOUT is given, it is the maximum number of seconds to wait. If the count
-cannot be decremented in that time, returns NIL without decrementing the count."
- (with-lock-held ((%semaphore-lock semaphore))
- (if (>= (%semaphore-counter semaphore) 1)
- (decf (%semaphore-counter semaphore))
- (let ((deadline (when timeout
- (+ (get-internal-real-time)
- (* timeout internal-time-units-per-second)))))
- ;; we need this loop because of a spurious wakeup possibility
- (loop until (>= (%semaphore-counter semaphore) 1)
- do (cond
- ((null (condition-wait (%semaphore-condition-variable semaphore)
- (%semaphore-lock semaphore)
- :timeout timeout))
- (return-from wait-on-semaphore))
- ;; unfortunately cv-wait may return T on timeout too
- ((and deadline (>= (get-internal-real-time) deadline))
- (return-from wait-on-semaphore))
- (timeout
- (setf timeout (/ (- deadline (get-internal-real-time))
- internal-time-units-per-second)))))
- (decf (%semaphore-counter semaphore))))))
-
-(defdfun semaphore-p (object)
- "Returns T if OBJECT is a semaphore; returns NIL otherwise."
- (typep object 'semaphore))
-
-;;; Introspection/debugging
-
-;;; The following functions may be provided for debugging purposes,
-;;; but are not advised to be called from normal user code.
-
-(defdfun all-threads ()
- "Returns a sequence of all of the threads. This may not
- be freshly-allocated, so the caller should not modify it."
- (error (make-threading-support-error)))
-
-(defdfun interrupt-thread (thread function)
- "Interrupt THREAD and cause it to evaluate FUNCTION
- before continuing with the interrupted path of execution. This may
- not be a good idea if THREAD is holding locks or doing anything
- important. On systems that do not support multiple threads, this
- function signals an error."
- (declare (ignore thread function))
- (error (make-threading-support-error)))
-
-(defdfun destroy-thread (thread)
- "Terminates the thread THREAD, which is an object
- as returned by MAKE-THREAD. This should be used with caution: it is
- implementation-defined whether the thread runs cleanup forms or
- releases its locks first.
-
- Destroying the calling thread is an error."
- (declare (ignore thread))
- (error (make-threading-support-error)))
-
-(defdfun thread-alive-p (thread)
- "Returns true if THREAD is alive, that is, if
- DESTROY-THREAD has not been called on it."
- (declare (ignore thread))
- (error (make-threading-support-error)))
-
-(defdfun join-thread (thread)
- "Wait until THREAD terminates. If THREAD has already terminated,
- return immediately. The return values of the thread function are
- returned."
- (declare (ignore thread))
- (error (make-threading-support-error)))
(DIR) diff --git a/3rdparties/software/bordeaux-threads-v0.8.6/src/impl-abcl.lisp b/3rdparties/software/bordeaux-threads-v0.8.6/src/impl-abcl.lisp
@@ -1,150 +0,0 @@
-;;;; -*- indent-tabs-mode: nil -*-
-
-#|
-Copyright 2006, 2007 Greg Pfeil
-
-Reimplemented with java.util.concurrent.locks.ReentrantLock by Mark Evenson 2011.
-
-Distributed under the MIT license (see LICENSE file)
-|#
-
-(in-package #:bordeaux-threads)
-
-;;; the implementation of the Armed Bear thread interface can be found in
-;;; src/org/armedbear/lisp/LispThread.java
-
-(deftype thread ()
- 'threads:thread)
-
-;;; Thread Creation
-
-(defun %make-thread (function name)
- (threads:make-thread function :name name))
-
-(defun current-thread ()
- (threads:current-thread))
-
-(defun thread-name (thread)
- (threads:thread-name thread))
-
-(defun threadp (object)
- (typep object 'thread))
-
-;;; Resource contention: locks and recursive locks
-
-(defstruct mutex name lock)
-(defstruct (mutex-recursive (:include mutex)))
-
-;; Making methods constants in this manner avoids the runtime expense of
-;; introspection involved in JCALL with string arguments.
-(defconstant +lock+
- (jmethod "java.util.concurrent.locks.ReentrantLock" "lock"))
-(defconstant +try-lock+
- (jmethod "java.util.concurrent.locks.ReentrantLock" "tryLock"))
-(defconstant +is-held-by-current-thread+
- (jmethod "java.util.concurrent.locks.ReentrantLock" "isHeldByCurrentThread"))
-(defconstant +unlock+
- (jmethod "java.util.concurrent.locks.ReentrantLock" "unlock"))
-(defconstant +get-hold-count+
- (jmethod "java.util.concurrent.locks.ReentrantLock" "getHoldCount"))
-
-(deftype lock () 'mutex)
-
-(deftype recursive-lock () 'mutex-recursive)
-
-(defun lock-p (object)
- (typep object 'mutex))
-
-(defun recursive-lock-p (object)
- (typep object 'mutex-recursive))
-
-(defun make-lock (&optional name)
- (make-mutex
- :name (or name "Anonymous lock")
- :lock (jnew "java.util.concurrent.locks.ReentrantLock")))
-
-(defun acquire-lock (lock &optional (wait-p t))
- (check-type lock mutex)
- (when (jcall +is-held-by-current-thread+ (mutex-lock lock))
- (error "Non-recursive lock being reacquired by owner."))
- (cond
- (wait-p
- (jcall +lock+ (mutex-lock lock))
- t)
- (t (jcall +try-lock+ (mutex-lock lock)))))
-
-(defun release-lock (lock)
- (check-type lock mutex)
- (unless (jcall +is-held-by-current-thread+ (mutex-lock lock))
- (error "Attempt to release lock not held by calling thread."))
- (jcall +unlock+ (mutex-lock lock))
- (values))
-
-(defun make-recursive-lock (&optional name)
- (make-mutex-recursive
- :name (or name "Anonymous lock")
- :lock (jnew "java.util.concurrent.locks.ReentrantLock")))
-
-(defun acquire-recursive-lock (lock &optional (wait-p t))
- (check-type lock mutex-recursive)
- (cond
- (wait-p
- (jcall +lock+ (mutex-recursive-lock lock))
- t)
- (t (jcall +try-lock+ (mutex-recursive-lock lock)))))
-
-(defun release-recursive-lock (lock)
- (check-type lock mutex-recursive)
- (unless (jcall +is-held-by-current-thread+ (mutex-lock lock))
- (error "Attempt to release lock not held by calling thread."))
- (jcall +unlock+ (mutex-lock lock))
- (values))
-
-;;; Resource contention: condition variables
-
-(defun thread-yield ()
- (java:jstatic "yield" "java.lang.Thread"))
-
-(defstruct condition-variable
- (name "Anonymous condition variable"))
-
-(defun condition-wait (condition lock &key timeout)
- (threads:synchronized-on condition
- (release-lock lock)
- (if timeout
- ;; Since giving a zero time value to threads:object-wait means
- ;; an indefinite wait, use some arbitrary small number.
- (threads:object-wait condition
- (if (zerop timeout)
- least-positive-single-float
- timeout))
- (threads:object-wait condition)))
- (acquire-lock lock)
- t)
-
-(defun condition-notify (condition)
- (threads:synchronized-on condition
- (threads:object-notify condition)))
-
-;;; Introspection/debugging
-
-(defun all-threads ()
- (let ((threads ()))
- (threads:mapcar-threads (lambda (thread)
- (push thread threads)))
- (reverse threads)))
-
-(defun interrupt-thread (thread function &rest args)
- (apply #'threads:interrupt-thread thread function args))
-
-(defun destroy-thread (thread)
- (signal-error-if-current-thread thread)
- (threads:destroy-thread thread))
-
-(defun thread-alive-p (thread)
- (threads:thread-alive-p thread))
-
-(defun join-thread (thread)
- (threads:thread-join thread))
-
-(mark-supported)
(DIR) diff --git a/3rdparties/software/bordeaux-threads-v0.8.6/src/impl-allegro.lisp b/3rdparties/software/bordeaux-threads-v0.8.6/src/impl-allegro.lisp
@@ -1,143 +0,0 @@
-;;;; -*- indent-tabs-mode: nil -*-
-
-#|
-Copyright 2006, 2007 Greg Pfeil
-
-Distributed under the MIT license (see LICENSE file)
-|#
-
-(in-package #:bordeaux-threads)
-
-;;; documentation on the Allegro Multiprocessing interface can be found at
-;;; http://www.franz.com/support/documentation/8.1/doc/multiprocessing.htm
-
-;;; Resource contention: locks and recursive locks
-
-(deftype lock () 'mp:process-lock)
-
-(deftype recursive-lock () 'mp:process-lock)
-
-(defun lock-p (object)
- (typep object 'mp:process-lock))
-
-(defun recursive-lock-p (object)
- (typep object 'mp:process-lock))
-
-(defun make-lock (&optional name)
- (mp:make-process-lock :name (or name "Anonymous lock")))
-
-(defun make-recursive-lock (&optional name)
- (mp:make-process-lock :name (or name "Anonymous recursive lock")))
-
-(defun acquire-lock (lock &optional (wait-p t))
- (mp:process-lock lock mp:*current-process* "Lock" (if wait-p nil 0)))
-
-(defun release-lock (lock)
- (mp:process-unlock lock))
-
-(defmacro with-lock-held ((place) &body body)
- `(mp:with-process-lock (,place :norecursive t)
- ,@body))
-
-(defmacro with-recursive-lock-held ((place &key timeout) &body body)
- `(mp:with-process-lock (,place :timeout ,timeout)
- ,@body))
-
-;;; Resource contention: condition variables
-
-(defun make-condition-variable (&key name)
- (declare (ignorable name))
- #-(version>= 9)
- (mp:make-gate nil)
- #+(version>= 9)
- (mp:make-condition-variable :name name))
-
-(defun condition-wait (condition-variable lock &key timeout)
- #-(version>= 9)
- (progn
- (release-lock lock)
- (if timeout
- (mp:process-wait-with-timeout "wait for message" timeout
- #'mp:gate-open-p condition-variable)
- (mp:process-wait "wait for message" #'mp:gate-open-p condition-variable))
- (acquire-lock lock)
- (mp:close-gate condition-variable))
- #+(version>= 9)
- (mp:condition-variable-wait condition-variable lock :timeout timeout)
- t)
-
-(defun condition-notify (condition-variable)
- #-(version>= 9)
- (mp:open-gate condition-variable)
- #+(version>= 9)
- (mp:condition-variable-signal condition-variable))
-
-(defun thread-yield ()
- (mp:process-allow-schedule))
-
-(deftype thread ()
- 'mp:process)
-
-;;; Thread Creation
-
-(defun start-multiprocessing ()
- (mp:start-scheduler))
-
-(defun %make-thread (function name)
- #+smp
- (mp:process-run-function name function)
- #-smp
- (mp:process-run-function
- name
- (lambda ()
- (let ((return-values
- (multiple-value-list (funcall function))))
- (setf (getf (mp:process-property-list mp:*current-process*)
- 'return-values)
- return-values)
- (values-list return-values)))))
-
-(defun current-thread ()
- mp:*current-process*)
-
-(defun threadp (object)
- (typep object 'mp:process))
-
-(defun thread-name (thread)
- (mp:process-name thread))
-
-;;; Timeouts
-
-(defmacro with-timeout ((timeout) &body body)
- (once-only (timeout)
- `(mp:with-timeout (,timeout (error 'timeout :length ,timeout))
- ,@body)))
-
-;;; Introspection/debugging
-
-(defun all-threads ()
- mp:*all-processes*)
-
-(defun interrupt-thread (thread function &rest args)
- (apply #'mp:process-interrupt thread function args))
-
-(defun destroy-thread (thread)
- (signal-error-if-current-thread thread)
- (mp:process-kill thread))
-
-(defun thread-alive-p (thread)
- (mp:process-alive-p thread))
-
-(defun join-thread (thread)
- #+smp
- (values-list (mp:process-join thread))
- #-smp
- (progn
- (mp:process-wait (format nil "Waiting for thread ~A to complete" thread)
- (complement #'mp:process-alive-p)
- thread)
- (let ((return-values
- (getf (mp:process-property-list thread) 'return-values)))
- (values-list return-values))))
-
-(mark-supported)
(DIR) diff --git a/3rdparties/software/bordeaux-threads-v0.8.6/src/impl-clisp.lisp b/3rdparties/software/bordeaux-threads-v0.8.6/src/impl-clisp.lisp
@@ -1,105 +0,0 @@
-;;;; -*- indent-tabs-mode: nil -*-
-
-#|
-Copyright 2006, 2007 Greg Pfeil
-
-Distributed under the MIT license (see LICENSE file)
-|#
-
-(in-package #:bordeaux-threads)
-
-(deftype thread ()
- 'mt:thread)
-
-;;; Thread Creation
-(defun %make-thread (function name)
- (mt:make-thread function
- :name name
- :initial-bindings mt:*default-special-bindings*))
-
-(defun current-thread ()
- (mt:current-thread))
-
-(defun threadp (object)
- (mt:threadp object))
-
-(defun thread-name (thread)
- (mt:thread-name thread))
-
-;;; Resource contention: locks and recursive locks
-
-(deftype lock () 'mt:mt-mutex)
-
-(deftype recursive-lock ()
- '(and mt:mt-mutex (satisfies mt:mutex-recursive-p)))
-
-(defun lock-p (object)
- (typep object 'mt:mt-mutex))
-
-(defun recursive-lock-p (object)
- (and (typep object 'mt:mt-mutex)
- (mt:mutex-recursive-p object)))
-
-(defun make-lock (&optional name)
- (mt:make-mutex :name (or name "Anonymous lock")))
-
-(defun acquire-lock (lock &optional (wait-p t))
- (mt:mutex-lock lock :timeout (if wait-p nil 0)))
-
-(defun release-lock (lock)
- (mt:mutex-unlock lock))
-
-(defmacro with-lock-held ((place) &body body)
- `(mt:with-mutex-lock (,place) ,@body))
-
-(defun make-recursive-lock (&optional name)
- (mt:make-mutex :name (or name "Anonymous recursive lock")
- :recursive-p t))
-
-(defmacro with-recursive-lock-held ((place) &body body)
- `(mt:with-mutex-lock (,place) ,@body))
-
-;;; Resource contention: condition variables
-
-(defun make-condition-variable (&key name)
- (mt:make-exemption :name (or name "Anonymous condition variable")))
-
-(defun condition-wait (condition-variable lock &key timeout)
- (mt:exemption-wait condition-variable lock :timeout timeout)
- t)
-
-(defun condition-notify (condition-variable)
- (mt:exemption-signal condition-variable))
-
-(defun thread-yield ()
- (mt:thread-yield))
-
-;;; Timeouts
-
-(defmacro with-timeout ((timeout) &body body)
- (once-only (timeout)
- `(mt:with-timeout (,timeout (error 'timeout :length ,timeout))
- ,@body)))
-
-;;; Introspection/debugging
-
-;;; VTZ: mt:list-threads returns all threads that are not garbage collected.
-(defun all-threads ()
- (delete-if-not #'mt:thread-active-p (mt:list-threads)))
-
-(defun interrupt-thread (thread function &rest args)
- (mt:thread-interrupt thread :function function :arguments args))
-
-(defun destroy-thread (thread)
- ;;; VTZ: actually we can kill ourselelf.
- ;;; suicide is part of our contemporary life :)
- (signal-error-if-current-thread thread)
- (mt:thread-interrupt thread :function t))
-
-(defun thread-alive-p (thread)
- (mt:thread-active-p thread))
-
-(defun join-thread (thread)
- (mt:thread-join thread))
-
-(mark-supported)
(DIR) diff --git a/3rdparties/software/bordeaux-threads-v0.8.6/src/impl-clozure.lisp b/3rdparties/software/bordeaux-threads-v0.8.6/src/impl-clozure.lisp
@@ -1,130 +0,0 @@
-;;;; -*- indent-tabs-mode: nil -*-
-
-#|
-Copyright 2006, 2007 Greg Pfeil
-
-Distributed under the MIT license (see LICENSE file)
-|#
-
-(in-package #:bordeaux-threads)
-
-;;; documentation on the OpenMCL Threads interface can be found at
-;;; http://openmcl.clozure.com/Doc/Programming-with-Threads.html
-
-(deftype thread ()
- 'ccl:process)
-
-;;; Thread Creation
-
-(defun %make-thread (function name)
- (ccl:process-run-function name function))
-
-(defun current-thread ()
- ccl:*current-process*)
-
-(defun threadp (object)
- (typep object 'ccl:process))
-
-(defun thread-name (thread)
- (ccl:process-name thread))
-
-;;; Resource contention: locks and recursive locks
-
-(deftype lock () 'ccl:lock)
-
-(deftype recursive-lock () 'ccl:lock)
-
-(defun lock-p (object)
- (typep object 'ccl:lock))
-
-(defun recursive-lock-p (object)
- (typep object 'ccl:lock))
-
-(defun make-lock (&optional name)
- (ccl:make-lock (or name "Anonymous lock")))
-
-(defun acquire-lock (lock &optional (wait-p t))
- (if wait-p
- (ccl:grab-lock lock)
- (ccl:try-lock lock)))
-
-(defun release-lock (lock)
- (ccl:release-lock lock))
-
-(defmacro with-lock-held ((place) &body body)
- `(ccl:with-lock-grabbed (,place)
- ,@body))
-
-(defun make-recursive-lock (&optional name)
- (ccl:make-lock (or name "Anonymous recursive lock")))
-
-(defun acquire-recursive-lock (lock)
- (ccl:grab-lock lock))
-
-(defun release-recursive-lock (lock)
- (ccl:release-lock lock))
-
-(defmacro with-recursive-lock-held ((place) &body body)
- `(ccl:with-lock-grabbed (,place)
- ,@body))
-
-;;; Resource contention: condition variables
-
-(defun make-condition-variable (&key name)
- (declare (ignore name))
- (ccl:make-semaphore))
-
-(defun condition-wait (condition-variable lock &key timeout)
- (release-lock lock)
- (unwind-protect
- (if timeout
- (ccl:timed-wait-on-semaphore condition-variable timeout)
- (ccl:wait-on-semaphore condition-variable))
- (acquire-lock lock t))
- t)
-
-(defun condition-notify (condition-variable)
- (ccl:signal-semaphore condition-variable))
-
-(defun thread-yield ()
- (ccl:process-allow-schedule))
-
-;;; Semaphores
-
-(deftype semaphore ()
- 'ccl:semaphore)
-
-(defun make-semaphore (&key name (count 0))
- (declare (ignore name))
- (let ((semaphore (ccl:make-semaphore)))
- (dotimes (c count) (ccl:signal-semaphore semaphore))
- semaphore))
-
-(defun signal-semaphore (semaphore &key (count 1))
- (dotimes (c count) (ccl:signal-semaphore semaphore)))
-
-(defun wait-on-semaphore (semaphore &key timeout)
- (if timeout
- (ccl:timed-wait-on-semaphore semaphore timeout)
- (ccl:wait-on-semaphore semaphore)))
-
-;;; Introspection/debugging
-
-(defun all-threads ()
- (ccl:all-processes))
-
-(defun interrupt-thread (thread function &rest args)
- (declare (dynamic-extent args))
- (apply #'ccl:process-interrupt thread function args))
-
-(defun destroy-thread (thread)
- (signal-error-if-current-thread thread)
- (ccl:process-kill thread))
-
-(defun thread-alive-p (thread)
- (not (ccl:process-exhausted-p thread)))
-
-(defun join-thread (thread)
- (ccl:join-process thread))
-
-(mark-supported)
(DIR) diff --git a/3rdparties/software/bordeaux-threads-v0.8.6/src/impl-cmucl.lisp b/3rdparties/software/bordeaux-threads-v0.8.6/src/impl-cmucl.lisp
@@ -1,161 +0,0 @@
-;;;; -*- indent-tabs-mode: nil -*-
-
-#|
-Copyright 2006, 2007 Greg Pfeil
-
-Distributed under the MIT license (see LICENSE file)
-|#
-
-(in-package #:bordeaux-threads)
-
-(deftype thread ()
- 'mp::process)
-
-;;; Thread Creation
-
-(defun start-multiprocessing ()
- (mp::startup-idle-and-top-level-loops))
-
-(defun %make-thread (function name)
- #+#.(cl:if (cl:find-symbol (cl:string '#:process-join) :mp) '(and) '(or))
- (mp:make-process function :name name)
- #-#.(cl:if (cl:find-symbol (cl:string '#:process-join) :mp) '(and) '(or))
- (mp:make-process (lambda ()
- (let ((return-values
- (multiple-value-list (funcall function))))
- (setf (getf (mp:process-property-list mp:*current-process*)
- 'return-values)
- return-values)
- (values-list return-values)))
- :name name))
-
-(defun current-thread ()
- mp:*current-process*)
-
-(defmethod threadp (object)
- (mp:processp object))
-
-(defun thread-name (thread)
- (mp:process-name thread))
-
-;;; Resource contention: locks and recursive locks
-
-(deftype lock () 'mp::error-check-lock)
-
-(deftype recursive-lock () 'mp::recursive-lock)
-
-(defun lock-p (object)
- (typep object 'mp::error-check-lock))
-
-(defun recursive-lock-p (object)
- (typep object 'mp::recursive-lock))
-
-(defun make-lock (&optional name)
- (mp:make-lock (or name "Anonymous lock")
- :kind :error-check))
-
-(defun acquire-lock (lock &optional (wait-p t))
- (if wait-p
- (mp::lock-wait lock "Lock wait")
- (mp::lock-wait-with-timeout lock "Lock wait" 0)))
-
-(defun release-lock (lock)
- (setf (mp::lock-process lock) nil))
-
-(defmacro with-lock-held ((place) &body body)
- `(mp:with-lock-held (,place "Lock wait") ,@body))
-
-(defun make-recursive-lock (&optional name)
- (mp:make-lock (or name "Anonymous recursive lock")
- :kind :recursive))
-
-(defun acquire-recursive-lock (lock &optional (wait-p t))
- (acquire-lock lock))
-
-(defun release-recursive-lock (lock)
- (release-lock lock))
-
-(defmacro with-recursive-lock-held ((place &key timeout) &body body)
- `(mp:with-lock-held (,place "Lock Wait" :timeout ,timeout) ,@body))
-
-;;; Note that the locks _are_ recursive, but not "balanced", and only
-;;; checked if they are being held by the same process by with-lock-held.
-;;; The default with-lock-held in bordeaux-mp.lisp sort of works, in that
-;;; it will wait for recursive locks by the same process as well.
-
-;;; Resource contention: condition variables
-
-;;; There's some stuff in x86-vm.lisp that might be worth investigating
-;;; whether to build on. There's also process-wait and friends.
-
-(defstruct condition-var
- "CMUCL doesn't have conditions, so we need to create our own type."
- name
- lock
- active)
-
-(defun make-condition-variable (&key name)
- (make-condition-var :lock (make-lock)
- :name (or name "Anonymous condition variable")))
-
-(defun condition-wait (condition-variable lock &key timeout)
- (signal-error-if-condition-wait-timeout timeout)
- (check-type condition-variable condition-var)
- (with-lock-held ((condition-var-lock condition-variable))
- (setf (condition-var-active condition-variable) nil))
- (release-lock lock)
- (mp:process-wait "Condition Wait"
- #'(lambda () (condition-var-active condition-variable)))
- (acquire-lock lock)
- t)
-
-(define-condition-wait-compiler-macro)
-
-(defun condition-notify (condition-variable)
- (check-type condition-variable condition-var)
- (with-lock-held ((condition-var-lock condition-variable))
- (setf (condition-var-active condition-variable) t))
- (thread-yield))
-
-(defun thread-yield ()
- (mp:process-yield))
-
-;;; Timeouts
-
-(defmacro with-timeout ((timeout) &body body)
- (once-only (timeout)
- `(mp:with-timeout (,timeout (error 'timeout :length ,timeout))
- ,@body)))
-
-;;; Introspection/debugging
-
-(defun all-threads ()
- (mp:all-processes))
-
-(defun interrupt-thread (thread function &rest args)
- (flet ((apply-function ()
- (if args
- (lambda () (apply function args))
- function)))
- (declare (dynamic-extent #'apply-function))
- (mp:process-interrupt thread (apply-function))))
-
-(defun destroy-thread (thread)
- (signal-error-if-current-thread thread)
- (mp:destroy-process thread))
-
-(defun thread-alive-p (thread)
- (mp:process-active-p thread))
-
-(defun join-thread (thread)
- #+#.(cl:if (cl:find-symbol (cl:string '#:process-join) :mp) '(and) '(or))
- (mp:process-join thread)
- #-#.(cl:if (cl:find-symbol (cl:string '#:process-join) :mp) '(and) '(or))
- (progn
- (mp:process-wait (format nil "Waiting for thread ~A to complete" thread)
- (lambda () (not (mp:process-alive-p thread))))
- (let ((return-values
- (getf (mp:process-property-list thread) 'return-values)))
- (values-list return-values))))
-
-(mark-supported)
(DIR) diff --git a/3rdparties/software/bordeaux-threads-v0.8.6/src/impl-corman.lisp b/3rdparties/software/bordeaux-threads-v0.8.6/src/impl-corman.lisp
@@ -1,26 +0,0 @@
-;;;; -*- indent-tabs-mode: nil -*-
-
-#|
-Copyright 2006, 2007 Greg Pfeil
-
-Distributed under the MIT license (see LICENSE file)
-|#
-
-(in-package #:bordeaux-threads)
-
-;;; Thread Creation
-
-(defun %make-thread (function name)
- (declare (ignore name))
- (threads:create-thread function))
-
-(defun current-thread ()
- threads:*current-thread*)
-
-;;; Introspection/debugging
-
-(defun destroy-thread (thread)
- (signal-error-if-current-thread thread)
- (threads:terminate-thread thread))
-
-(mark-supported)
(DIR) diff --git a/3rdparties/software/bordeaux-threads-v0.8.6/src/impl-ecl.lisp b/3rdparties/software/bordeaux-threads-v0.8.6/src/impl-ecl.lisp
@@ -1,111 +0,0 @@
-;;;; -*- indent-tabs-mode: nil -*-
-
-#|
-Copyright 2006, 2007 Greg Pfeil
-
-Distributed under the MIT license (see LICENSE file)
-|#
-
-(in-package #:bordeaux-threads)
-
-;;; documentation on the ECL Multiprocessing interface can be found at
-;;; http://ecls.sourceforge.net/cgi-bin/view/Main/MultiProcessing
-
-(deftype thread ()
- 'mp:process)
-
-;;; Thread Creation
-
-(defun %make-thread (function name)
- (mp:process-run-function name function))
-
-(defun current-thread ()
- mp::*current-process*)
-
-(defun threadp (object)
- (typep object 'mp:process))
-
-(defun thread-name (thread)
- (mp:process-name thread))
-
-;;; Resource contention: locks and recursive locks
-
-(deftype lock () 'mp:lock)
-
-(deftype recursive-lock ()
- '(and mp:lock (satisfies mp:recursive-lock-p)))
-
-(defun lock-p (object)
- (typep object 'mp:lock))
-
-(defun recursive-lock-p (object)
- (and (typep object 'mp:lock)
- (mp:recursive-lock-p object)))
-
-(defun make-lock (&optional name)
- (mp:make-lock :name (or name "Anonymous lock")))
-
-(defun acquire-lock (lock &optional (wait-p t))
- (mp:get-lock lock wait-p))
-
-(defun release-lock (lock)
- (mp:giveup-lock lock))
-
-(defmacro with-lock-held ((place) &body body)
- `(mp:with-lock (,place) ,@body))
-
-(defun make-recursive-lock (&optional name)
- (mp:make-lock :name (or name "Anonymous recursive lock") :recursive t))
-
-(defun acquire-recursive-lock (lock &optional (wait-p t))
- (mp:get-lock lock wait-p))
-
-(defun release-recursive-lock (lock)
- (mp:giveup-lock lock))
-
-(defmacro with-recursive-lock-held ((place) &body body)
- `(mp:with-lock (,place) ,@body))
-
-;;; Resource contention: condition variables
-
-(defun make-condition-variable (&key name)
- (declare (ignore name))
- (mp:make-condition-variable))
-
-(defun condition-wait (condition-variable lock &key timeout)
- (if timeout
- (handler-case (with-timeout (timeout)
- (mp:condition-variable-wait condition-variable lock))
- (timeout () nil))
- (mp:condition-variable-wait condition-variable lock)))
-
-(defun condition-notify (condition-variable)
- (mp:condition-variable-signal condition-variable))
-
-(defun thread-yield ()
- (mp:process-yield))
-
-;;; Introspection/debugging
-
-(defun all-threads ()
- (mp:all-processes))
-
-(defun interrupt-thread (thread function &rest args)
- (flet ((apply-function ()
- (if args
- (lambda () (apply function args))
- function)))
- (declare (dynamic-extent #'apply-function))
- (mp:interrupt-process thread (apply-function))))
-
-(defun destroy-thread (thread)
- (signal-error-if-current-thread thread)
- (mp:process-kill thread))
-
-(defun thread-alive-p (thread)
- (mp:process-active-p thread))
-
-(defun join-thread (thread)
- (mp:process-join thread))
-
-(mark-supported)
(DIR) diff --git a/3rdparties/software/bordeaux-threads-v0.8.6/src/impl-genera.lisp b/3rdparties/software/bordeaux-threads-v0.8.6/src/impl-genera.lisp
@@ -1,136 +0,0 @@
-;;;; -*- Mode: LISP; Syntax: Ansi-Common-Lisp; Package: BORDEAUX-THREADS; Base: 10; -*-
-
-#|
-Distributed under the MIT license (see LICENSE file)
-|#
-
-(in-package #:bordeaux-threads)
-
-(deftype thread ()
- 'process:process)
-
-;;; Thread Creation
-
-(defun %make-thread (function name)
- (process:process-run-function name function))
-
-(defun current-thread ()
- scl:*current-process*)
-
-(defun threadp (object)
- (process:process-p object))
-
-(defun thread-name (thread)
- (process:process-name thread))
-
-;;; Resource contention: locks and recursive locks
-
-(defstruct (lock (:constructor make-lock-internal))
- lock
- lock-argument)
-
-(defun make-lock (&optional name)
- (let ((lock (process:make-lock (or name "Anonymous lock"))))
- (make-lock-internal :lock lock
- :lock-argument nil)))
-
-(defun acquire-lock (lock &optional (wait-p t))
- (check-type lock lock)
- (setf (lock-lock-argument lock) (process:make-lock-argument (lock-lock lock)))
- (if wait-p
- (process:lock (lock-lock lock) (lock-lock-argument lock))
- (process:with-no-other-processes
- (when (process:lock-lockable-p (lock-lock lock))
- (process:lock (lock-lock lock) (lock-lock-argument lock))))))
-
-(defun release-lock (lock)
- (check-type lock lock)
- (process:unlock (lock-lock lock) (scl:shiftf (lock-lock-argument lock) nil)))
-
-(defmacro with-lock-held ((place) &body body)
- `(process:with-lock ((lock-lock ,place))
- ,@body))
-
-(defstruct (recursive-lock (:constructor make-recursive-lock-internal))
- lock
- lock-arguments)
-
-(defun make-recursive-lock (&optional name)
- (make-recursive-lock-internal :lock (process:make-lock (or name "Anonymous recursive lock")
- :recursive t)
- :lock-arguments nil))
-
-(defun acquire-recursive-lock (lock)
- (check-type lock recursive-lock)
- (process:lock (recursive-lock-lock lock)
- (car (push (process:make-lock-argument (recursive-lock-lock lock))
- (recursive-lock-lock-arguments lock)))))
-
-(defun release-recursive-lock (lock)
- (check-type lock recursive-lock)
- (process:unlock (recursive-lock-lock lock) (pop (recursive-lock-lock-arguments lock))))
-
-(defmacro with-recursive-lock-held ((place) &body body)
- `(process:with-lock ((recursive-lock-lock ,place))
- ,@body))
-
-;;; Resource contention: condition variables
-
-(eval-when (:compile-toplevel :load-toplevel :execute)
-(defstruct (condition-variable (:constructor %make-condition-variable))
- name
- (waiters nil))
-)
-
-(defun make-condition-variable (&key name)
- (%make-condition-variable :name name))
-
-(defun condition-wait (condition-variable lock)
- (check-type condition-variable condition-variable)
- (check-type lock lock)
- (process:with-no-other-processes
- (let ((waiter (cons scl:*current-process* nil)))
- (process:atomic-updatef (condition-variable-waiters condition-variable)
- #'(lambda (waiters)
- (append waiters (scl:ncons waiter))))
- (process:without-lock ((lock-lock lock))
- (process:process-block (format nil "Waiting~@[ on ~A~]"
- (condition-variable-name condition-variable))
- #'(lambda (waiter)
- (not (null (cdr waiter))))
- waiter)))))
-
-(defun condition-notify (condition-variable)
- (check-type condition-variable condition-variable)
- (let ((waiter (process:atomic-pop (condition-variable-waiters condition-variable))))
- (when waiter
- (setf (cdr waiter) t)
- (process:wakeup (car waiter))))
- (values))
-
-(defun thread-yield ()
- (scl:process-allow-schedule))
-
-;;; Introspection/debugging
-
-(defun all-threads ()
- process:*all-processes*)
-
-(defun interrupt-thread (thread function &rest args)
- (declare (dynamic-extent args))
- (apply #'process:process-interrupt thread function args))
-
-(defun destroy-thread (thread)
- (signal-error-if-current-thread thread)
- (process:process-kill thread :without-aborts :force))
-
-(defun thread-alive-p (thread)
- (process:process-active-p thread))
-
-(defun join-thread (thread)
- (process:process-wait (format nil "Join ~S" thread)
- #'(lambda (thread)
- (not (process:process-active-p thread)))
- thread))
-
-(mark-supported)
(DIR) diff --git a/3rdparties/software/bordeaux-threads-v0.8.6/src/impl-lispworks-condition-variables.lisp b/3rdparties/software/bordeaux-threads-v0.8.6/src/impl-lispworks-condition-variables.lisp
@@ -1,144 +0,0 @@
-;;;; -*- indent-tabs-mode: nil -*-
-
-(in-package #:bordeaux-threads)
-
-;; Lispworks condition support is simulated, albeit via a lightweight wrapper over
-;; its own polling-based wait primitive. Waiters register with the condition variable,
-;; and use MP:process-wait which queries for permission to proceed at its own (usspecified) interval.
-;; http://www.lispworks.com/documentation/lw51/LWRM/html/lwref-445.htm
-;; A wakeup callback (on notify) is provided to lighten this query to not have to do a hash lookup
-;; on every poll (or have to serialize on the condition variable) and a mechanism is put
-;; in place to unregister any waiter that exits wait for other reasons,
-;; and to resend any (single) notification that may have been consumed before this (corner
-;; case). Much of the complexity present is to support single notification (as recommended in
-;; the spec); but a distinct condition-notify-all is provided for reference.
-;; Single-notification follows a first-in first-out ordering
-;;
-;; Performance: With 1000 threads waiting on one condition-variable, the steady-state hit (at least
-;; as tested on a 3GHz Win32 box) is noise - hovering at 0% on Task manager.
-;; While not true zero like a true native solution, the use of the Lispworks native checks appear
-;; fast enough to be an equivalent substitute (thread count will cause issue before the
-;; waiting overhead becomes significant)
-(defstruct (condition-variable (:constructor make-lw-condition (name)))
- name
- (lock (mp:make-lock :name "For condition-variable") :type mp:lock :read-only t)
- (wait-tlist (cons nil nil) :type cons :read-only t)
- (wait-hash (make-hash-table :test 'eq) :type hash-table :read-only t)
- ;; unconsumed-notifications is to track :remove-from-consideration
- ;; for entries that may have exited prematurely - notification is sent through
- ;; to someone else, and offender is removed from hash and list
- (unconsumed-notifications (make-hash-table :test 'eq) :type hash-table :read-only t))
-
-(defun make-condition-variable (&key name)
- (make-lw-condition name))
-
-(defmacro with-cv-access (condition-variable &body body)
- (let ((cv-sym (gensym))
- (slots '(lock wait-tlist wait-hash unconsumed-notifications)))
- `(let ((,cv-sym ,condition-variable))
- (with-slots ,slots
- ,cv-sym
- (macrolet ((locked (&body body) `(mp:with-lock (lock) ,@body)))
- (labels ((,(gensym) () ,@slots))) ; Trigger expansion of the symbol-macrolets to ignore
- ,@body)))))
-
-(defmacro defcvfun (function-name (condition-variable &rest args) &body body)
- `(defun ,function-name (,condition-variable ,@args)
- (with-cv-access ,condition-variable
- ,@body)))
-#+lispworks (editor:setup-indent "defcvfun" 2 2 7) ; indent defcvfun
-
-; utility function thath assumes process is locked on condition-variable's lock.
-(defcvfun do-notify-single (condition-variable) ; assumes already locked
- (let ((id (caar wait-tlist)))
- (when id
- (pop (car wait-tlist))
- (unless (car wait-tlist) ; check for empty
- (setf (cdr wait-tlist) nil))
- (funcall (gethash id wait-hash)) ; call waiter-wakeup
- (remhash id wait-hash) ; absence of entry = permission to proceed
- (setf (gethash id unconsumed-notifications) t))))
-
-;; Added for completeness/to show how it's done in this paradigm; but
-;; The symbol for this call is not exposed in the api
-(defcvfun condition-notify-all (condition-variable)
- (locked
- (loop for waiter-wakeup being the hash-values in wait-hash do (funcall waiter-wakeup))
- (clrhash wait-hash)
- (clrhash unconsumed-notifications) ; don't care as everyone just got notified
- (setf (car wait-tlist) nil)
- (setf (cdr wait-tlist) nil)))
-
-;; Currently implemented so as to notify only one waiting thread
-(defcvfun condition-notify (condition-variable)
- (locked (do-notify-single condition-variable)))
-
-(defun delete-from-tlist (tlist element)
- (let ((deleter
- (lambda ()
- (setf (car tlist) (cdar tlist))
- (unless (car tlist)
- (setf (cdr tlist) nil)))))
- (loop for cons in (car tlist) do
- (if (eq element (car cons))
- (progn
- (funcall deleter)
- (return nil))
- (let ((cons cons))
- (setq deleter
- (lambda ()
- (setf (cdr cons) (cddr cons))
- (unless (cdr cons)
- (setf (cdr tlist) cons)))))))))
-
-(defun add-to-tlist-tail (tlist element)
- (let ((new-link (cons element nil)))
- (cond
- ((car tlist)
- (setf (cddr tlist) new-link)
- (setf (cdr tlist) new-link))
- (t
- (setf (car tlist) new-link)
- (setf (cdr tlist) new-link)))))
-
-(defcvfun condition-wait (condition-variable lock- &key timeout)
- (signal-error-if-condition-wait-timeout timeout)
- (mp:process-unlock lock-)
- (unwind-protect ; for the re-taking of the lock. Guarding all of the code
- (let ((wakeup-allowed-to-proceed nil)
- (wakeup-lock (mp:make-lock :name "wakeup lock for condition-wait")))
- ;; wakeup-allowed-to-proceed is an optimisation to avoid having to serialize all waiters and
- ;; search the hashtable. That it is locked is for safety/completeness, although
- ;; as wakeup-allowed-to-proceed only transitions nil -> t, and that missing it once or twice is
- ;; moot in this situation, it would be redundant even if ever a Lispworks implementation ever became
- ;; non-atomic in its assigments
- (let ((id (cons nil nil))
- (clean-exit nil))
- (locked
- (add-to-tlist-tail wait-tlist id)
- (setf (gethash id wait-hash) (lambda () (mp:with-lock (wakeup-lock) (setq wakeup-allowed-to-proceed t)))))
- (unwind-protect
- (progn
- (mp:process-wait
- "Waiting for notification"
- (lambda ()
- (when (mp:with-lock (wakeup-lock) wakeup-allowed-to-proceed)
- (locked (not (gethash id wait-hash))))))
- (locked (remhash id unconsumed-notifications))
- (setq clean-exit t)) ; Notification was consumed
- ;; Have to call remove-from-consideration just in case process was interrupted
- ;; rather than having condition met
- (unless clean-exit ; clean-exit is just an optimization
- (locked
- (when (gethash id wait-hash) ; not notified - must have been interrupted
- ;; Have to unsubscribe
- (remhash id wait-hash)
- (delete-from-tlist wait-tlist id))
- ;; note - it's possible to be removed from wait-hash/wait-tlist (in notify-single); but still have an unconsumed notification!
- (when (gethash id unconsumed-notifications) ; Must have exited for reasons unrelated to notification
- (remhash id unconsumed-notifications) ; Have to pass on the notification to an eligible waiter
- (do-notify-single condition-variable)))))))
- (mp:process-lock lock-))
- t)
-
-(define-condition-wait-compiler-macro)
(DIR) diff --git a/3rdparties/software/bordeaux-threads-v0.8.6/src/impl-lispworks.lisp b/3rdparties/software/bordeaux-threads-v0.8.6/src/impl-lispworks.lisp
@@ -1,143 +0,0 @@
-;;;; -*- indent-tabs-mode: nil -*-
-
-#|
-Copyright 2006, 2007 Greg Pfeil
-
-Distributed under the MIT license (see LICENSE file)
-|#
-
-(in-package #:bordeaux-threads)
-
-;;; documentation on the LispWorks Multiprocessing interface can be found at
-;;; http://www.lispworks.com/documentation/lw445/LWUG/html/lwuser-156.htm
-
-(deftype thread ()
- 'mp:process)
-
-;;; Thread Creation
-
-(defun start-multiprocessing ()
- (mp:initialize-multiprocessing))
-
-(defun %make-thread (function name)
- (mp:process-run-function
- name nil
- (lambda ()
- (let ((return-values
- (multiple-value-list (funcall function))))
- (setf (mp:process-property 'return-values)
- return-values)
- (values-list return-values)))))
-
-(defun current-thread ()
- #-#.(cl:if (cl:find-symbol (cl:string '#:get-current-process) :mp) '(and) '(or))
- mp:*current-process*
- ;; introduced in LispWorks 5.1
- #+#.(cl:if (cl:find-symbol (cl:string '#:get-current-process) :mp) '(and) '(or))
- (mp:get-current-process))
-
-(defun threadp (object)
- (mp:process-p object))
-
-(defun thread-name (thread)
- (mp:process-name thread))
-
-;;; Resource contention: locks and recursive locks
-
-
-(deftype lock () 'mp:lock)
-
-#-(or lispworks4 lispworks5)
-(deftype recursive-lock ()
- '(and mp:lock (satisfies mp:lock-recursive-p)))
-
-(defun lock-p (object)
- (typep object 'mp:lock))
-
-(defun recursive-lock-p (object)
- #+(or lispworks4 lispworks5)
- nil
- #-(or lispworks4 lispworks5) ; version 6+
- (and (typep object 'mp:lock)
- (mp:lock-recursive-p object)))
-
-(defun make-lock (&optional name)
- (mp:make-lock :name (or name "Anonymous lock")
- #-(or lispworks4 lispworks5) :recursivep
- #-(or lispworks4 lispworks5) nil))
-
-(defun acquire-lock (lock &optional (wait-p t))
- (mp:process-lock lock nil
- (cond ((null wait-p) 0)
- ((numberp wait-p) wait-p)
- (t nil))))
-
-(defun release-lock (lock)
- (mp:process-unlock lock))
-
-(defmacro with-lock-held ((place) &body body)
- `(mp:with-lock (,place) ,@body))
-
-(defun make-recursive-lock (&optional name)
- (mp:make-lock :name (or name "Anonymous recursive lock")
- #-(or lispworks4 lispworks5) :recursivep
- #-(or lispworks4 lispworks5) t))
-
-(defun acquire-recursive-lock (lock &optional (wait-p t))
- (acquire-lock lock wait-p))
-
-(defun release-recursive-lock (lock)
- (release-lock lock))
-
-(defmacro with-recursive-lock-held ((place) &body body)
- `(mp:with-lock (,place) ,@body))
-
-;;; Resource contention: condition variables
-
-#+(or lispworks6 lispworks7)
-(defun make-condition-variable (&key name)
- (mp:make-condition-variable :name (or name "Anonymous condition variable")))
-
-#+(or lispworks6 lispworks7)
-(defun condition-wait (condition-variable lock &key timeout)
- (mp:condition-variable-wait condition-variable lock :timeout timeout)
- t)
-
-#+(or lispworks6 lispworks7)
-(defun condition-notify (condition-variable)
- (mp:condition-variable-signal condition-variable))
-
-(defun thread-yield ()
- (mp:process-allow-scheduling))
-
-;;; Introspection/debugging
-
-(defun all-threads ()
- (mp:list-all-processes))
-
-(defun interrupt-thread (thread function &rest args)
- (apply #'mp:process-interrupt thread function args))
-
-(defun destroy-thread (thread)
- (signal-error-if-current-thread thread)
- (mp:process-kill thread))
-
-(defun thread-alive-p (thread)
- (mp:process-alive-p thread))
-
-(declaim (inline %join-thread))
-(defun %join-thread (thread)
- #-#.(cl:if (cl:find-symbol (cl:string '#:process-join) :mp) '(and) '(or))
- (mp:process-wait (format nil "Waiting for thread ~A to complete" thread)
- (complement #'mp:process-alive-p)
- thread)
- #+#.(cl:if (cl:find-symbol (cl:string '#:process-join) :mp) '(and) '(or))
- (mp:process-join thread))
-
-(defun join-thread (thread)
- (%join-thread thread)
- (let ((return-values
- (mp:process-property 'return-values thread)))
- (values-list return-values)))
-
-(mark-supported)
(DIR) diff --git a/3rdparties/software/bordeaux-threads-v0.8.6/src/impl-mcl.lisp b/3rdparties/software/bordeaux-threads-v0.8.6/src/impl-mcl.lisp
@@ -1,68 +0,0 @@
-;;;; -*- indent-tabs-mode: nil -*-
-
-#|
-Copyright 2006, 2007 Greg Pfeil
-
-Distributed under the MIT license (see LICENSE file)
-|#
-
-(in-package #:bordeaux-threads)
-
-(deftype thread ()
- 'ccl::process)
-
-;;; Thread Creation
-
-(defun %make-thread (function name)
- (ccl:process-run-function name function))
-
-(defun current-thread ()
- ccl:*current-process*)
-
-(defun threadp (object)
- (ccl::processp object))
-
-(defun thread-name (thread)
- (ccl:process-name thread))
-
-;;; Resource contention: locks and recursive locks
-
-(deftype lock () 'ccl:lock)
-
-(defun lock-p (object)
- (typep object 'ccl:lock))
-
-(defun make-lock (&optional name)
- (ccl:make-lock (or name "Anonymous lock")))
-
-(defun acquire-lock (lock &optional (wait-p t))
- (if wait-p
- (ccl:process-lock lock ccl:*current-process*)
- ;; this is broken, but it's better than a no-op
- (ccl:without-interrupts
- (when (null (ccl::lock.value lock))
- (ccl:process-lock lock ccl:*current-process*)))))
-
-(defun release-lock (lock)
- (ccl:process-unlock lock))
-
-(defmacro with-lock-held ((place) &body body)
- `(ccl:with-lock-grabbed (,place) ,@body))
-
-(defun thread-yield ()
- (ccl:process-allow-schedule))
-
-;;; Introspection/debugging
-
-(defun all-threads ()
- ccl:*all-processes*)
-
-(defun interrupt-thread (thread function &rest args)
- (declare (dynamic-extent args))
- (apply #'ccl:process-interrupt thread function args))
-
-(defun destroy-thread (thread)
- (signal-error-if-current-thread thread)
- (ccl:process-kill thread))
-
-(mark-supported)
(DIR) diff --git a/3rdparties/software/bordeaux-threads-v0.8.6/src/impl-mkcl.lisp b/3rdparties/software/bordeaux-threads-v0.8.6/src/impl-mkcl.lisp
@@ -1,109 +0,0 @@
-;;;; -*- indent-tabs-mode: nil -*-
-
-#|
-Copyright 2006, 2007 Greg Pfeil
-Copyright 2010 Jean-Claude Beaudoin.
-
-Distributed under the MIT license (see LICENSE file)
-|#
-
-(in-package #:bordeaux-threads)
-
-(deftype thread ()
- 'mt:thread)
-
-;;; Thread Creation
-
-(defun %make-thread (function name)
- (mt:thread-run-function name function))
-
-(defun current-thread ()
- mt::*thread*)
-
-(defun threadp (object)
- (typep object 'mt:thread))
-
-(defun thread-name (thread)
- (mt:thread-name thread))
-
-;;; Resource contention: locks and recursive locks
-
-(deftype lock () 'mt:lock)
-
-(deftype recursive-lock ()
- '(and mt:lock (satisfies mt:recursive-lock-p)))
-
-(defun lock-p (object)
- (typep object 'mt:lock))
-
-(defun recursive-lock-p (object)
- (and (typep object 'mt:lock)
- (mt:recursive-lock-p object)))
-
-(defun make-lock (&optional name)
- (mt:make-lock :name (or name "Anonymous lock")))
-
-(defun acquire-lock (lock &optional (wait-p t))
- (mt:get-lock lock wait-p))
-
-(defun release-lock (lock)
- (mt:giveup-lock lock))
-
-(defmacro with-lock-held ((place) &body body)
- `(mt:with-lock (,place) ,@body))
-
-(defun make-recursive-lock (&optional name)
- (mt:make-lock :name (or name "Anonymous recursive lock") :recursive t))
-
-(defun acquire-recursive-lock (lock &optional (wait-p t))
- (mt:get-lock lock wait-p))
-
-(defun release-recursive-lock (lock)
- (mt:giveup-lock lock))
-
-(defmacro with-recursive-lock-held ((place) &body body)
- `(mt:with-lock (,place) ,@body))
-
-;;; Resource contention: condition variables
-
-(defun make-condition-variable (&key name)
- (declare (ignore name))
- (mt:make-condition-variable))
-
-(defun condition-wait (condition-variable lock &key timeout)
- (signal-error-if-condition-wait-timeout timeout)
- (mt:condition-wait condition-variable lock)
- t)
-
-(define-condition-wait-compiler-macro)
-
-(defun condition-notify (condition-variable)
- (mt:condition-signal condition-variable))
-
-(defun thread-yield ()
- (mt:thread-yield))
-
-;;; Introspection/debugging
-
-(defun all-threads ()
- (mt:all-threads))
-
-(defun interrupt-thread (thread function &rest args)
- (flet ((apply-function ()
- (if args
- (lambda () (apply function args))
- function)))
- (declare (dynamic-extent #'apply-function))
- (mt:interrupt-thread thread (apply-function))))
-
-(defun destroy-thread (thread)
- (signal-error-if-current-thread thread)
- (mt:thread-kill thread))
-
-(defun thread-alive-p (thread)
- (mt:thread-active-p thread))
-
-(defun join-thread (thread)
- (mt:thread-join thread))
-
-(mark-supported)
(DIR) diff --git a/3rdparties/software/bordeaux-threads-v0.8.6/src/impl-null.lisp b/3rdparties/software/bordeaux-threads-v0.8.6/src/impl-null.lisp
@@ -1,3 +0,0 @@
-;;;; -*- indent-tabs-mode: nil -*-
-
-(in-package #:bordeaux-threads)
(DIR) diff --git a/3rdparties/software/bordeaux-threads-v0.8.6/src/impl-sbcl.lisp b/3rdparties/software/bordeaux-threads-v0.8.6/src/impl-sbcl.lisp
@@ -1,130 +0,0 @@
-;;;; -*- indent-tabs-mode: nil -*-
-
-#|
-Copyright 2006, 2007 Greg Pfeil
-
-Distributed under the MIT license (see LICENSE file)
-|#
-
-(in-package #:bordeaux-threads)
-
-;;; documentation on the SBCL Threads interface can be found at
-;;; http://www.sbcl.org/manual/Threading.html
-
-(deftype thread ()
- 'sb-thread:thread)
-
-;;; Thread Creation
-
-(defun %make-thread (function name)
- (sb-thread:make-thread function :name name))
-
-(defun current-thread ()
- sb-thread:*current-thread*)
-
-(defun threadp (object)
- (typep object 'sb-thread:thread))
-
-(defun thread-name (thread)
- (sb-thread:thread-name thread))
-
-;;; Resource contention: locks and recursive locks
-
-(deftype lock () 'sb-thread:mutex)
-
-(deftype recursive-lock () 'sb-thread:mutex)
-
-(defun lock-p (object)
- (typep object 'sb-thread:mutex))
-
-(defun recursive-lock-p (object)
- (typep object 'sb-thread:mutex))
-
-(defun make-lock (&optional name)
- (sb-thread:make-mutex :name (or name "Anonymous lock")))
-
-(defun acquire-lock (lock &optional (wait-p t))
- #+#.(cl:if (cl:find-symbol (cl:string '#:grab-mutex) :sb-thread) '(and) '(or))
- (sb-thread:grab-mutex lock :waitp wait-p)
- #-#.(cl:if (cl:find-symbol (cl:string '#:grab-mutex) :sb-thread) '(and) '(or))
- (sb-thread:get-mutex lock nil wait-p))
-
-(defun release-lock (lock)
- (sb-thread:release-mutex lock))
-
-(defmacro with-lock-held ((place) &body body)
- `(sb-thread:with-mutex (,place) ,@body))
-
-(defun make-recursive-lock (&optional name)
- (sb-thread:make-mutex :name (or name "Anonymous recursive lock")))
-
-;;; XXX acquire-recursive-lock and release-recursive-lock are actually
-;;; complicated because we can't use control stack tricks. We need to
-;;; actually count something to check that the acquire/releases are
-;;; balanced
-
-(defmacro with-recursive-lock-held ((place) &body body)
- `(sb-thread:with-recursive-lock (,place)
- ,@body))
-
-;;; Resource contention: condition variables
-
-(defun make-condition-variable (&key name)
- (sb-thread:make-waitqueue :name (or name "Anonymous condition variable")))
-
-(defun condition-wait (condition-variable lock &key timeout)
- (sb-thread:condition-wait condition-variable lock :timeout timeout))
-
-(defun condition-notify (condition-variable)
- (sb-thread:condition-notify condition-variable))
-
-(defun thread-yield ()
- (sb-thread:release-foreground))
-
-;;; Timeouts
-
-(deftype timeout ()
- 'sb-ext:timeout)
-
-(defmacro with-timeout ((timeout) &body body)
- `(sb-ext:with-timeout ,timeout
- ,@body))
-
-;;; Semaphores
-
-(deftype semaphore ()
- 'sb-thread:semaphore)
-
-(defun make-semaphore (&key name (count 0))
- (sb-thread:make-semaphore :name name :count count))
-
-(defun signal-semaphore (semaphore &key (count 1))
- (sb-thread:signal-semaphore semaphore count))
-
-(defun wait-on-semaphore (semaphore &key timeout)
- (sb-thread:wait-on-semaphore semaphore :timeout timeout))
-
-;;; Introspection/debugging
-
-(defun all-threads ()
- (sb-thread:list-all-threads))
-
-(defun interrupt-thread (thread function &rest args)
- (flet ((apply-function ()
- (if args
- (lambda () (apply function args))
- function)))
- (declare (dynamic-extent #'apply-function))
- (sb-thread:interrupt-thread thread (apply-function))))
-
-(defun destroy-thread (thread)
- (signal-error-if-current-thread thread)
- (sb-thread:terminate-thread thread))
-
-(defun thread-alive-p (thread)
- (sb-thread:thread-alive-p thread))
-
-(defun join-thread (thread)
- (sb-thread:join-thread thread))
-
-(mark-supported)
(DIR) diff --git a/3rdparties/software/bordeaux-threads-v0.8.6/src/impl-scl.lisp b/3rdparties/software/bordeaux-threads-v0.8.6/src/impl-scl.lisp
@@ -1,103 +0,0 @@
-;;;; -*- indent-tabs-mode: nil -*-
-
-#|
-Copyright 2008 Scieneer Pty Ltd
-
-Distributed under the MIT license (see LICENSE file)
-|#
-
-(in-package #:bordeaux-threads)
-
-(deftype thread ()
- 'thread:thread)
-
-(defun %make-thread (function name)
- (thread:thread-create function :name name))
-
-(defun current-thread ()
- thread:*thread*)
-
-(defun threadp (object)
- (typep object 'thread:thread))
-
-(defun thread-name (thread)
- (thread:thread-name thread))
-
-;;; Resource contention: locks and recursive locks
-
-(deftype lock () 'thread:lock)
-
-(deftype recursive-lock () 'thread:recursive-lock)
-
-(defun lock-p (object)
- (typep object 'thread:lock))
-
-(defun recursive-lock-p (object)
- (typep object 'thread:recursive-lock))
-
-(defun make-lock (&optional name)
- (thread:make-lock (or name "Anonymous lock")))
-
-(defun acquire-lock (lock &optional (wait-p t))
- (thread::acquire-lock lock nil wait-p))
-
-(defun release-lock (lock)
- (thread::release-lock lock))
-
-(defmacro with-lock-held ((place) &body body)
- `(thread:with-lock-held (,place) ,@body))
-
-(defun make-recursive-lock (&optional name)
- (thread:make-lock (or name "Anonymous recursive lock")
- :type :recursive))
-
-;;; XXX acquire-recursive-lock and release-recursive-lock are actually
-;;; complicated because we can't use control stack tricks. We need to
-;;; actually count something to check that the acquire/releases are
-;;; balanced
-
-(defmacro with-recursive-lock-held ((place) &body body)
- `(thread:with-lock-held (,place)
- ,@body))
-
-;;; Resource contention: condition variables
-
-(defun make-condition-variable (&key name)
- (thread:make-cond-var (or name "Anonymous condition variable")))
-
-(defun condition-wait (condition-variable lock &key timeout)
- (if timeout
- (thread:cond-var-timedwait condition-variable lock timeout)
- (thread:cond-var-wait condition-variable lock))
- t)
-
-(defun condition-notify (condition-variable)
- (thread:cond-var-broadcast condition-variable))
-
-(defun thread-yield ()
- (mp:process-yield))
-
-;;; Introspection/debugging
-
-(defun all-threads ()
- (mp:all-processes))
-
-(defun interrupt-thread (thread function &rest args)
- (flet ((apply-function ()
- (if args
- (lambda () (apply function args))
- function)))
- (declare (dynamic-extent #'apply-function))
- (thread:thread-interrupt thread (apply-function))))
-
-(defun destroy-thread (thread)
- (thread:destroy-thread thread))
-
-(defun thread-alive-p (thread)
- (mp:process-alive-p thread))
-
-(defun join-thread (thread)
- (mp:process-wait (format nil "Waiting for thread ~A to complete" thread)
- (lambda () (not (mp:process-alive-p thread)))))
-
-(mark-supported)
(DIR) diff --git a/3rdparties/software/bordeaux-threads-v0.8.6/src/pkgdcl.lisp b/3rdparties/software/bordeaux-threads-v0.8.6/src/pkgdcl.lisp
@@ -1,66 +0,0 @@
-;;;; -*- indent-tabs-mode: nil -*-
-
-(cl:defpackage :bordeaux-threads
- (:nicknames #:bt)
- (:use #:cl #:alexandria)
- #+abcl
- (:import-from :java #:jnew #:jcall #:jmethod)
- (:export #:thread #:make-thread #:current-thread #:threadp #:thread-name
- #:start-multiprocessing
- #:*default-special-bindings* #:*standard-io-bindings*
- #:*supports-threads-p*
-
- #:lock #:make-lock #:lock-p
- #:acquire-lock #:release-lock #:with-lock-held
-
- #:recursive-lock #:make-recursive-lock #:recursive-lock-p
- #:acquire-recursive-lock #:release-recursive-lock #:with-recursive-lock-held
-
- #:make-condition-variable #:condition-wait #:condition-notify
-
- #:make-semaphore #:signal-semaphore #:wait-on-semaphore #:semaphore #:semaphore-p
-
- #:with-timeout #:timeout
-
- #:all-threads #:interrupt-thread #:destroy-thread #:thread-alive-p
- #:join-thread #:thread-yield)
- (:documentation "BORDEAUX-THREADS is a proposed standard for a minimal
- MP/threading interface. It is similar to the CLIM-SYS threading and
- lock support, but for the following broad differences:
-
- 1) Some behaviours are defined in additional detail: attention has
- been given to special variable interaction, whether and when
- cleanup forms are run. Some behaviours are defined in less
- detail: an implementation that does not support multiple
- threads is not required to use a new list (nil) for a lock, for
- example.
-
- 2) Many functions which would be difficult, dangerous or inefficient
- to provide on some implementations have been removed. Chiefly
- these are functions such as thread-wait which expect for
- efficiency that the thread scheduler is written in Lisp and
- 'hookable', which can't sensibly be done if the scheduler is
- external to the Lisp image, or the system has more than one CPU.
-
- 3) Unbalanced ACQUIRE-LOCK and RELEASE-LOCK functions have been
- added.
-
- 4) Posix-style condition variables have been added, as it's not
- otherwise possible to implement them correctly using the other
- operations that are specified.
-
- Threads may be implemented using whatever applicable techniques are
- provided by the operating system: user-space scheduling,
- kernel-based LWPs or anything else that does the job.
-
- Some parts of this specification can also be implemented in a Lisp
- that does not support multiple threads. Thread creation and some
- thread inspection operations will not work, but the locking
- functions are still present (though they may do nothing) so that
- thread-safe code can be compiled on both multithread and
- single-thread implementations without need of conditionals.
-
- To avoid conflict with existing MP/threading interfaces in
- implementations, these symbols live in the BORDEAUX-THREADS package.
- Implementations and/or users may also make them visible or exported
- in other more traditionally named packages."))
(DIR) diff --git a/3rdparties/software/bordeaux-threads-v0.8.6/test/bordeaux-threads-test.lisp b/3rdparties/software/bordeaux-threads-v0.8.6/test/bordeaux-threads-test.lisp
@@ -1,251 +0,0 @@
-#|
-Copyright 2006,2007 Greg Pfeil
-
-Distributed under the MIT license (see LICENSE file)
-|#
-
-(defpackage bordeaux-threads/test
- (:use #:cl #:bordeaux-threads #:fiveam)
- (:shadow #:with-timeout))
-
-(in-package #:bordeaux-threads/test)
-
-(def-suite :bordeaux-threads)
-(def-fixture using-lock ()
- (let ((lock (make-lock)))
- (&body)))
-(in-suite :bordeaux-threads)
-
-(test should-have-current-thread
- (is (current-thread)))
-
-(test current-thread-identity
- (let* ((box (list nil))
- (thread (make-thread (lambda ()
- (setf (car box) (current-thread))))))
- (join-thread thread)
- (is (eql (car box) thread))))
-
-(test join-thread-return-value
- (is (eql 0 (join-thread (make-thread (lambda () 0))))))
-
-(test should-identify-threads-correctly
- (is (threadp (current-thread)))
- (is (threadp (make-thread (lambda () t) :name "foo")))
- (is (not (threadp (make-lock)))))
-
-(test should-retrieve-thread-name
- (is (equal "foo" (thread-name (make-thread (lambda () t) :name "foo")))))
-
-(test interrupt-thread
- (let* ((box (list nil))
- (thread (make-thread (lambda ()
- (setf (car box)
- (catch 'new-thread
- (sleep 60)
- 'not-interrupted))))))
- (sleep 1)
- (interrupt-thread thread (lambda ()
- (throw 'new-thread 'interrupted)))
- (join-thread thread)
- (is (eql 'interrupted (car box)))))
-
-(test should-lock-without-contention
- (with-fixture using-lock ()
- (is (acquire-lock lock t))
- (release-lock lock)
- (is (acquire-lock lock nil))
- (release-lock lock)))
-
-(defun set-equal (set-a set-b)
- (and (null (set-difference set-a set-b))
- (null (set-difference set-b set-a))))
-
-(test default-special-bindings
- (locally (declare (special *a* *c*))
- (let* ((the-as 50) (the-bs 150) (*b* 42)
- some-a some-b some-other-a some-other-b
- (*default-special-bindings*
- `((*a* . (funcall ,(lambda () (incf the-as))))
- (*b* . (funcall ,(lambda () (incf the-bs))))
- ,@*default-special-bindings*))
- (threads (list (make-thread
- (lambda ()
- (setf some-a *a* some-b *b*)))
- (make-thread
- (lambda ()
- (setf some-other-a *a*
- some-other-b *b*))))))
- (declare (special *b*))
- (thread-yield)
- (is (not (boundp '*a*)))
- (loop while (some #'thread-alive-p threads)
- do (thread-yield))
- (is (set-equal (list some-a some-other-a) '(51 52)))
- (is (set-equal (list some-b some-other-b) '(151 152)))
- (is (not (boundp '*a*))))))
-
-
-(defparameter *shared* 0)
-(defparameter *lock* (make-lock))
-
-(test should-have-thread-interaction
- ;; this simple test generates N process. Each process grabs and
- ;; releases the lock until SHARED has some value, it then
- ;; increments SHARED. the outer code first sets shared 1 which
- ;; gets the thing running and then waits for SHARED to reach some
- ;; value. this should, i think, stress test locks.
- (setf *shared* 0)
- (flet ((worker (i)
- (loop
- do (with-lock-held (*lock*)
- (when (= i *shared*)
- (incf *shared*)
- (return)))
- (thread-yield)
- (sleep 0.001))))
- (let* ((procs (loop
- for i from 1 upto 2
- ;; create a new binding to protect against implementations that
- ;; mutate instead of binding the loop variable
- collect (let ((i i))
- (make-thread (lambda ()
- (funcall #'worker i))
- :name (format nil "Proc #~D" i))))))
- (with-lock-held (*lock*)
- (incf *shared*))
- (block test
- (loop
- until (with-lock-held (*lock*)
- (= (1+ (length procs)) *shared*))
- do (with-lock-held (*lock*)
- (is (>= (1+ (length procs)) *shared*)))
- (thread-yield)
- (sleep 0.001))))))
-
-
-(defparameter *condition-variable* (make-condition-variable))
-
-(test condition-variable
- (setf *shared* 0)
- (flet ((worker (i)
- (with-lock-held (*lock*)
- (loop
- until (= i *shared*)
- do (condition-wait *condition-variable* *lock*))
- (incf *shared*))
- (condition-notify *condition-variable*)))
- (let ((num-procs 100))
- (dotimes (i num-procs)
- ;; create a new binding to protect against implementations that
- ;; mutate instead of binding the loop variable
- (let ((i i))
- (make-thread (lambda ()
- (funcall #'worker i))
- :name (format nil "Proc #~D" i))))
- (with-lock-held (*lock*)
- (loop
- until (= num-procs *shared*)
- do (condition-wait *condition-variable* *lock*)))
- (is (equal num-procs *shared*)))))
-
-;; Generally safe sanity check for the locks and single-notify
-#+(and lispworks (not lispworks6))
-(test condition-variable-lw
- (let ((condition-variable (make-condition-variable :name "Test"))
- (test-lock (make-lock))
- (completed nil))
- (dotimes (id 6)
- (let ((id id))
- (make-thread (lambda ()
- (with-lock-held (test-lock)
- (condition-wait condition-variable test-lock)
- (push id completed)
- (condition-notify condition-variable))))))
- (sleep 2)
- (if completed
- (print "Failed: Premature passage through condition-wait")
- (print "Successfully waited on condition"))
- (condition-notify condition-variable)
- (sleep 2)
- (if (and completed
- (eql (length completed) 6)
- (equal (sort completed #'<)
- (loop for id from 0 to 5 collect id)))
- (print "Success: All elements notified")
- (print (format nil "Failed: Of 6 expected elements, only ~A proceeded" completed)))
- (bt::with-cv-access condition-variable
- (if (and
- (not (or (car wait-tlist) (cdr wait-tlist)))
- (zerop (hash-table-count wait-hash))
- (zerop (hash-table-count unconsumed-notifications)))
- (print "Success: condition variable restored to initial state")
- (print "Error: condition variable retains residue from completed waiters")))
- (setq completed nil)
- (dotimes (id 6)
- (let ((id id))
- (make-thread (lambda ()
- (with-lock-held (test-lock)
- (condition-wait condition-variable test-lock)
- (push id completed))))))
- (sleep 2)
- (condition-notify condition-variable)
- (sleep 2)
- (if (= (length completed) 1)
- (print "Success: Notify-single only notified a single waiter to restart")
- (format t "Failure: Notify-single restarted ~A items" (length completed)))
- (condition-notify condition-variable)
- (sleep 2)
- (if (= (length completed) 2)
- (print "Success: second Notify-single only notified a single waiter to restart")
- (format t "Failure: Two Notify-singles restarted ~A items" (length completed)))
- (loop for i from 0 to 5 do (condition-notify condition-variable))
- (print "Note: In the case of any failures, assume there are outstanding waiting threads")
- (values)))
-
-#+(or abcl allegro clisp clozure ecl lispworks6 sbcl scl)
-(test condition-wait-timeout
- (let ((lock (make-lock))
- (cvar (make-condition-variable))
- (flag nil))
- (make-thread (lambda () (sleep 0.4) (setf flag t)))
- (with-lock-held (lock)
- (condition-wait cvar lock :timeout 0.2)
- (is (null flag))
- (sleep 0.4)
- (is (eq t flag)))))
-
-(test semaphore-signal
- (let ((sem (make-semaphore)))
- (make-thread (lambda () (sleep 0.4) (signal-semaphore sem)))
- (is (not (null (wait-on-semaphore sem))))))
-
-(test semaphore-signal-n-of-m
- (let* ((sem (make-semaphore :count 1))
- (lock (make-lock))
- (count 0)
- (waiter (lambda ()
- (wait-on-semaphore sem)
- (with-lock-held (lock) (incf count)))))
- (make-thread (lambda () (sleep 0.2) (signal-semaphore sem :count 3)))
- (dotimes (v 5) (make-thread waiter))
- (sleep 0.3)
- (is (= count 4))
- ;; release other waiters
- (signal-semaphore sem :count 10)
- (sleep 0.1)
- (is (= count 5))))
-
-(test semaphore-wait-timeout
- (let ((sem (make-semaphore))
- (flag nil))
- (make-thread (lambda () (sleep 0.4) (setf flag t)))
- (is (null (wait-on-semaphore sem :timeout 0.2)))
- (is (null flag))
- (sleep 0.4)
- (is (eq t flag))))
-
-(test semaphore-typed
- (is (typep (bt:make-semaphore) 'bt:semaphore))
- (is (bt:semaphore-p (bt:make-semaphore)))
- (is (null (bt:semaphore-p (bt:make-lock)))))
(DIR) diff --git a/3rdparties/software/bordeaux-threads-v0.8.6/version.sexp b/3rdparties/software/bordeaux-threads-v0.8.6/version.sexp
@@ -1,2 +0,0 @@
-;; -*- lisp -*-
-"0.8.6"
(DIR) diff --git a/3rdparties/software/cffi_0.20.0/.gitignore b/3rdparties/software/cffi_0.20.0/.gitignore
@@ -1,28 +0,0 @@
-*~
-*.o
-*.dylib
-*.dll
-*.bundle
-*.so
-*.fasl
-*.xfasl
-.DS_Store
-doc/*.aux
-doc/manual/
-doc/spec/
-doc/*.log
-doc/*.info
-doc/*.aux
-doc/*.cp
-doc/*.fn
-doc/*.fns
-doc/*.ky
-doc/*.pg
-doc/*.toc
-doc/*.tps
-doc/*.tp
-doc/*.vr
-doc/*.dvi
-doc/*.cps
-doc/*.vrs
-doc/dir
(DIR) diff --git a/3rdparties/software/cffi_0.20.0/.travis.yml b/3rdparties/software/cffi_0.20.0/.travis.yml
@@ -1,38 +0,0 @@
-branches:
- only:
- - master
-
-language: lisp
-
-env:
- matrix:
- #- LISP=abcl
- #- LISP=allegro
- - LISP=sbcl
- - LISP=sbcl32
- - LISP=ccl
- - LISP=ccl32
- #- LISP=clisp
- #- LISP=clisp32
- #- LISP=cmucl
- #- LISP=ecl
-
-matrix:
- allow_failures:
- - env: LISP=ccl32
-
-install:
- - curl -L https://github.com/luismbo/cl-travis/raw/master/install.sh | sh
- - if [ "${LISP:(-2)}" = "32" ]; then
- sudo apt-get install -y libc6-dev-i386 libffi-dev:i386;
- fi
- - git clone --depth=1 git://github.com/trivial-features/trivial-features.git ~/lisp/trivial-features
- - git clone https://gitlab.common-lisp.net/alexandria/alexandria.git ~/lisp/alexandria
- - git clone --depth=1 git://github.com/cl-babel/babel.git ~/lisp/babel
-
-script:
- - cl -e '(ql:quickload :cffi-tests)
- (when (cffi-tests:run-all-cffi-tests)
- (uiop:quit 1))'
-
-sudo: required
(DIR) diff --git a/3rdparties/software/cffi_0.20.0/COPYRIGHT b/3rdparties/software/cffi_0.20.0/COPYRIGHT
@@ -1,21 +0,0 @@
-Copyright (C) 2005-2007, James Bielman <jamesjb@jamesjb.com>
-
-Permission is hereby granted, free of charge, to any person
-obtaining a copy of this software and associated documentation
-files (the "Software"), to deal in the Software without
-restriction, including without limitation the rights to use, copy,
-modify, merge, publish, distribute, sublicense, and/or sell copies
-of the Software, and to permit persons to whom the Software is
-furnished to do so, subject to the following conditions:
-
-The above copyright notice and this permission notice shall be
-included in all copies or substantial portions of the Software.
-
-THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
-EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
-MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
-NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
-HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
-WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
-DEALINGS IN THE SOFTWARE.
(DIR) diff --git a/3rdparties/software/cffi_0.20.0/HEADER b/3rdparties/software/cffi_0.20.0/HEADER
@@ -1,28 +0,0 @@
-;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
-;;;
-;;; filename --- description
-;;;
-;;; Copyright (C) 2007, James Bielman <jamesjb@jamesjb.com>
-;;;
-;;; Permission is hereby granted, free of charge, to any person
-;;; obtaining a copy of this software and associated documentation
-;;; files (the "Software"), to deal in the Software without
-;;; restriction, including without limitation the rights to use, copy,
-;;; modify, merge, publish, distribute, sublicense, and/or sell copies
-;;; of the Software, and to permit persons to whom the Software is
-;;; furnished to do so, subject to the following conditions:
-;;;
-;;; The above copyright notice and this permission notice shall be
-;;; included in all copies or substantial portions of the Software.
-;;;
-;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
-;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
-;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
-;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
-;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
-;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
-;;; DEALINGS IN THE SOFTWARE.
-;;;
-
-
(DIR) diff --git a/3rdparties/software/cffi_0.20.0/Makefile b/3rdparties/software/cffi_0.20.0/Makefile
@@ -1,72 +0,0 @@
-# -*- Mode: Makefile; tab-width: 3; indent-tabs-mode: t -*-
-#
-# Makefile --- Make targets for various tasks.
-#
-# Copyright (C) 2005-2006, James Bielman <jamesjb@jamesjb.com>
-#
-# Permission is hereby granted, free of charge, to any person
-# obtaining a copy of this software and associated documentation
-# files (the "Software"), to deal in the Software without
-# restriction, including without limitation the rights to use, copy,
-# modify, merge, publish, distribute, sublicense, and/or sell copies
-# of the Software, and to permit persons to whom the Software is
-# furnished to do so, subject to the following conditions:
-#
-# The above copyright notice and this permission notice shall be
-# included in all copies or substantial portions of the Software.
-#
-# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
-# EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
-# MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
-# NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
-# HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
-# WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-# OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
-# DEALINGS IN THE SOFTWARE.
-#
-
-# This way you can easily run the tests for different versions
-# of each lisp with, e.g. ALLEGRO=/path/to/some/lisp make test-allegro
-CMUCL ?= lisp
-OPENMCL ?= openmcl
-SBCL ?= sbcl
-CLISP ?= clisp
-ALLEGRO ?= alisp
-SCL ?= scl
-ECL ?= ecl
-
-shlibs:
- @$(MAKE) -wC tests shlibs
-
-clean:
- @$(MAKE) -wC tests clean
- find . -name ".fasls" | xargs rm -rf
- find . \( -name "*.dfsl" -o -name "*.fasl" -o -name "*.fas" -o -name "*.lib" -o -name "*.x86f" -o -name "*.amd64f" -o -name "*.sparcf" -o -name "*.sparc64f" -o -name "*.hpf" -o -name "*.hp64f" -o -name "*.ppcf" -o -name "*.nfasl" -o -name "*.ufsl" -o -name "*.fsl" -o -name "*.lx64fsl" \) -exec rm {} \;
-
-test-openmcl:
- @-$(OPENMCL) --load tests/run-tests.lisp
-
-test-sbcl:
- @-$(SBCL) --noinform --load tests/run-tests.lisp
-
-test-cmucl:
- @-$(CMUCL) -load tests/run-tests.lisp
-
-test-scl:
- @-$(SCL) -load tests/run-tests.lisp
-
-test-clisp:
- @-$(CLISP) -q -x '(load "tests/run-tests.lisp")'
-
-test-clisp-modern:
- @-$(CLISP) -modern -q -x '(load "tests/run-tests.lisp")'
-
-test-allegro:
- @-$(ALLEGRO) -L tests/run-tests.lisp
-
-test-ecl:
- @-$(ECL) --quiet --load tests/run-tests.lisp
-
-test: test-openmcl test-sbcl test-cmucl test-clisp test-ecl
-
-# vim: ft=make ts=3 noet
(DIR) diff --git a/3rdparties/software/cffi_0.20.0/README.md b/3rdparties/software/cffi_0.20.0/README.md
@@ -1,19 +0,0 @@
-[](https://travis-ci.org/cffi/cffi)
-
-CFFI, the Common Foreign Function Interface, purports to be a portable
-foreign function interface for Common Lisp. The CFFI library is
-composed of a Lisp-implementation-specific backend in the CFFI-SYS
-package, and a portable frontend in the CFFI package.
-
-The CFFI-SYS backend package defines a low-level interface to the
-native FFI support in the Lisp implementation. It offers operators for
-allocating and dereferencing foreign memory, calling foreign
-functions, and loading shared libraries. The CFFI frontend provides a
-declarative interface for defining foreign functions, structures,
-typedefs, enumerated types, etc. It is implemented in portable ANSI CL
-making use of the low-level operators exported by CFFI-SYS.
-
-Please consult [the manual][1] for further details, including
-installation instructions.
-
-[1]: http://common-lisp.net/project/cffi/manual/html_node/
(DIR) diff --git a/3rdparties/software/cffi_0.20.0/TODO b/3rdparties/software/cffi_0.20.0/TODO
@@ -1,115 +0,0 @@
--*- Text -*-
-
-This is a collection of TODO items and ideas in no particular order.
-
-### Testing
-
--> Test uffi-compat with more UFFI libraries.
--> Write more FOREIGN-GLOBALS.SET.* tests.
--> Finish tests/random-tester.lisp
--> Write benchmarks comparing CFFI vs. native FFIs and also demonstrating
- performance of each platform.
--> Write more STRUCT.ALIGNMENT.* tests (namely involving the :LONG-LONG
- and :UNSIGNED-LONG-LONG types) and test them in more ABIs.
--> Run tests with the different kinds of shared libraries available on
- MacOS X.
-
-### Ports
-
--> Finish GCL port, port to MCL.
--> Update Corman port. [2007-02-22 LO]
-
-### Features
-
--> Implement a declarative interface for FOREIGN-FUNCALL-PTR, similar to
- DEFCUN/FOREIGN-FUNCALL.
--> Implement the proposed interfaces (see doc/).
--> Extend FOREIGN-SLOT-VALUE and make it accept multiple "indices" for
- directly accessing structs inside structs, arrays inside structs, etc...
--> Implement EXPLAIN-FOREIGN-SLOT-VALUE.
--> Implement :in/:out/:in-out for DEFCFUN (and FOREIGN-FUNCALL?).
--> Add support for multiple memory allocation schemes (like CLISP), namely
- support for allocating with malloc() (so that it can be freed on the C
- side)>
--> Extend DEFCVAR's symbol macro in order to handle memory (de)allocation
- automatically (see CLISP).
--> Implement byte swapping routines (see /usr/include/linux/byteorder)
--> Warn about :void in places where it doesn't make sense.
-
-### Underspecified Semantics
-
--> (setf (mem-ref ptr <aggregate-type> offset) <value>)
--> Review the interface for coherence across Lisps with regard to
- behaviour in "exceptional" situations. Eg: threads, dumping cores,
- accessing foreign symbols that don't exist, etc...
--> On Lispworks a Lisp float is a double and therefore won't necessarily
- fit in a C float. Figure out a way to handle this.
--> Allegro: callbacks' return values.
--> Lack of uniformity with regard to pointers. Allegro: 0 -> NULL.
- CLISP/Lispworks: NIL -> NULL.
--> Some lisps will accept a lisp float being passed to :double
- and a lisp double to :float. We should either coerce on lisps that
- don't accept this or check-type on lisps that do. Probably the former
- is better since on lispworks/x86 double == float.
-
-### Possible Optimizations
-
--> More compiler macros on some of the CFFI-SYS implementations.
--> Optimize UFFI-COMPAT when the vector stuff is implemented.
--> Being able to declare that some C int will always fit in a Lisp
- fixnum. Allegro has a :fixnum ftype and CMUCL/SBCL can use
- (unsigned-byte 29) others could perhaps behave like :int?
--> An option for defcfun to expand into a compiler macro which would
- allow the macroexpansion-time translators to look at the forms
- passed to the functions.
-
-### Known Issues
-
--> CLISP FASL portability is broken. Fix this by placing LOAD-TIME-VALUE
- forms in the right places and moving other calculations to load-time.
- (eg: calculating struct size/alignment.) Ideally we'd only move them
- to load-time when we actually care about fasl portability.
- (defmacro maybe-load-time-value (form)
- (if <we care about fasl portability>
- `(load-time-value ,form)
- form))
--> cffi-tests.asd's :c-test-lib component is causing the whole testsuite
- to be recompiled everytime. Figure that out.
--> The (if (constantp foo) (do-something-with (eval foo)) ...) pattern
- used in many places throughout the code is apparently not 100% safe.
--> On ECL platforms without DFFI we need to build a non-linked version
- of libtest.
--> foreign-enum-keyword/value should have their own error condition?
- <http://article.gmane.org/gmane.lisp.cffi.devel/975> [2007-02-22 LO]
-
-### Documentation
-
--> Fill the missing sections in the CFFI User Manual.
--> Update the CFFI-SYS Specification.
--> have two versions of the manual on the website
-
-### CFFI-Grovel
-
--> Look into making the C output more concise.
-
-### CFFI-Toolchain
-
--> Port the toolchain parameter detection to more implementations
--> Port the static linking support to more implementations
--> Add a mechanism to configure and/or detect dynamic libraries against
- which to link for instance.
- It could be a variable in which flags are accumulated,
- or an autodetection after loading everything, see
- https://github.com/borodust/cl-bodge/blob/0.3.0/distribution/build.lisp#L79
-
-### CFFI/C2FFI
-
--> Generate wrappers for C inline function definitions (and maybe for some
- #define's?)
--> It would be nice if c2ffi emitted its output in a stable order
- for details see https://github.com/rpav/c2ffi/issues/28
--> Handle va_list. For now it's treated as any other argument.
-
-### Other
-
--> Type-checking pointer interface.
(DIR) diff --git a/3rdparties/software/cffi_0.20.0/cffi-examples.asd b/3rdparties/software/cffi_0.20.0/cffi-examples.asd
@@ -1,37 +0,0 @@
-;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
-;;;
-;;; cffi-examples.asd --- ASDF system definition for CFFI examples.
-;;;
-;;; Copyright (C) 2005-2006, James Bielman <jamesjb@jamesjb.com>
-;;;
-;;; Permission is hereby granted, free of charge, to any person
-;;; obtaining a copy of this software and associated documentation
-;;; files (the "Software"), to deal in the Software without
-;;; restriction, including without limitation the rights to use, copy,
-;;; modify, merge, publish, distribute, sublicense, and/or sell copies
-;;; of the Software, and to permit persons to whom the Software is
-;;; furnished to do so, subject to the following conditions:
-;;;
-;;; The above copyright notice and this permission notice shall be
-;;; included in all copies or substantial portions of the Software.
-;;;
-;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
-;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
-;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
-;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
-;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
-;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
-;;; DEALINGS IN THE SOFTWARE.
-;;;
-
-(defsystem cffi-examples
- :description "CFFI Examples"
- :author "James Bielman <jamesjb@jamesjb.com>"
- :components
- ((:module examples
- :components
- ((:file "examples")
- (:file "gethostname")
- (:file "gettimeofday"))))
- :depends-on (cffi))
(DIR) diff --git a/3rdparties/software/cffi_0.20.0/cffi-grovel.asd b/3rdparties/software/cffi_0.20.0/cffi-grovel.asd
@@ -1,41 +0,0 @@
-;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
-;;;
-;;; cffi-grovel.asd --- ASDF system definition for cffi-grovel.
-;;;
-;;; Copyright (C) 2007, Luis Oliveira <loliveira@common-lisp.net>
-;;;
-;;; Permission is hereby granted, free of charge, to any person
-;;; obtaining a copy of this software and associated documentation
-;;; files (the "Software"), to deal in the Software without
-;;; restriction, including without limitation the rights to use, copy,
-;;; modify, merge, publish, distribute, sublicense, and/or sell copies
-;;; of the Software, and to permit persons to whom the Software is
-;;; furnished to do so, subject to the following conditions:
-;;;
-;;; The above copyright notice and this permission notice shall be
-;;; included in all copies or substantial portions of the Software.
-;;;
-;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
-;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
-;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
-;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
-;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
-;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
-;;; DEALINGS IN THE SOFTWARE.
-;;;
-
-(defsystem "cffi-grovel"
- :description "The CFFI Groveller"
- :author "Dan Knapp <dankna@accela.net>"
- :depends-on ("cffi" "cffi-toolchain" "alexandria")
- :licence "MIT"
- :components
- ((:module "grovel"
- :components
- ((:static-file "common.h")
- (:file "package")
- (:file "grovel" :depends-on ("package"))
- (:file "asdf" :depends-on ("grovel"))))))
-
-;; vim: ft=lisp et
(DIR) diff --git a/3rdparties/software/cffi_0.20.0/cffi-libffi.asd b/3rdparties/software/cffi_0.20.0/cffi-libffi.asd
@@ -1,48 +0,0 @@
-;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
-;;;
-;;; cffi-libffi.asd --- Foreign Structures By Value
-;;;
-;;; Copyright (C) 2011 Liam M. Healy
-;;;
-;;; Permission is hereby granted, free of charge, to any person
-;;; obtaining a copy of this software and associated documentation
-;;; files (the "Software"), to deal in the Software without
-;;; restriction, including without limitation the rights to use, copy,
-;;; modify, merge, publish, distribute, sublicense, and/or sell copies
-;;; of the Software, and to permit persons to whom the Software is
-;;; furnished to do so, subject to the following conditions:
-;;;
-;;; The above copyright notice and this permission notice shall be
-;;; included in all copies or substantial portions of the Software.
-;;;
-;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
-;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
-;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
-;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
-;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
-;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
-;;; DEALINGS IN THE SOFTWARE.
-;;;
-
-(in-package :asdf)
-
-(eval-when (:compile-toplevel :execute)
- (asdf:oos 'asdf:load-op :cffi-grovel)
- (asdf:oos 'asdf:load-op :trivial-features))
-
-(defsystem cffi-libffi
- :description "Foreign structures by value"
- :author "Liam Healy <lhealy@common-lisp.net>"
- :maintainer "Liam Healy <lhealy@common-lisp.net>"
- :defsystem-depends-on (#:trivial-features #:cffi-grovel)
- :components
- ((:module libffi
- :serial t
- :components
- ((:file "libffi")
- (cffi-grovel:grovel-file "libffi-types")
- (:file "libffi-functions")
- (:file "type-descriptors")
- (:file "funcall"))))
- :depends-on (#:cffi #:cffi-grovel #:trivial-features))
(DIR) diff --git a/3rdparties/software/cffi_0.20.0/cffi-tests.asd b/3rdparties/software/cffi_0.20.0/cffi-tests.asd
@@ -1,91 +0,0 @@
-;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
-;;;
-;;; cffi-tests.asd --- ASDF system definition for CFFI unit tests.
-;;;
-;;; Copyright (C) 2005-2006, James Bielman <jamesjb@jamesjb.com>
-;;; Copyright (C) 2005-2011, Luis Oliveira <loliveira@common-lisp.net>
-;;;
-;;; Permission is hereby granted, free of charge, to any person
-;;; obtaining a copy of this software and associated documentation
-;;; files (the "Software"), to deal in the Software without
-;;; restriction, including without limitation the rights to use, copy,
-;;; modify, merge, publish, distribute, sublicense, and/or sell copies
-;;; of the Software, and to permit persons to whom the Software is
-;;; furnished to do so, subject to the following conditions:
-;;;
-;;; The above copyright notice and this permission notice shall be
-;;; included in all copies or substantial portions of the Software.
-;;;
-;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
-;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
-;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
-;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
-;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
-;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
-;;; DEALINGS IN THE SOFTWARE.
-;;;
-
-(load-systems "trivial-features" "cffi-grovel")
-
-(defclass c-test-lib (c-source-file)
- ())
-
-(defmethod perform ((o load-op) (c c-test-lib))
- nil)
-
-(defmethod perform ((o load-source-op) (c c-test-lib))
- nil)
-
-(defmethod output-files ((o compile-op) (c c-test-lib))
- (let ((p (component-pathname c)))
- (values
- (list (make-pathname :defaults p :type (asdf/bundle:bundle-pathname-type :object))
- (make-pathname :defaults p :type (asdf/bundle:bundle-pathname-type :shared-library)))
- t)))
-
-(defmethod perform ((o compile-op) (c c-test-lib))
- (let ((cffi-toolchain:*cc-flags* `(,@cffi-toolchain:*cc-flags* "-Wall" "-std=c99" "-pedantic")))
- (destructuring-bind (obj dll) (output-files o c)
- (cffi-toolchain:cc-compile obj (input-files o c))
- (cffi-toolchain:link-shared-library dll (list obj)))))
-
-(defsystem "cffi-tests"
- :description "Unit tests for CFFI."
- :depends-on ("cffi-grovel" "cffi-libffi" "bordeaux-threads" #-ecl "rt" #+ecl (:require "rt"))
- :components
- ((:module "tests"
- :components
- ((:c-test-lib "libtest")
- (:c-test-lib "libtest2")
- (:c-test-lib "libfsbv")
- (:file "package")
- (:file "bindings" :depends-on ("package" "libtest" "libtest2" "libfsbv"))
- (:file "funcall" :depends-on ("bindings"))
- (:file "defcfun" :depends-on ("bindings"))
- (:file "callbacks" :depends-on ("bindings"))
- (:file "foreign-globals" :depends-on ("package"))
- (:file "memory" :depends-on ("package"))
- (:file "strings" :depends-on ("package"))
- (:file "arrays" :depends-on ("package"))
- (:file "struct" :depends-on ("package"))
- (:file "union" :depends-on ("package"))
- (:file "enum" :depends-on ("package"))
- (:file "fsbv" :depends-on ("bindings" "enum"))
- (:file "misc-types" :depends-on ("bindings"))
- (:file "misc" :depends-on ("bindings"))
- (:file "test-asdf" :depends-on ("package"))
- (:file "grovel" :depends-on ("package")))))
- :perform (test-op (o c) (symbol-call :cffi-tests '#:run-all-cffi-tests)))
-
-(defsystem "cffi-tests/example"
- :defsystem-depends-on ("cffi-grovel")
- :entry-point "cffi-example::entry-point"
- :components
- ((:module "examples" :components
- ((:file "package")
- (:cffi-wrapper-file "wrapper-example" :depends-on ("package"))
- (:cffi-grovel-file "grovel-example" :depends-on ("package"))
- (:file "main-example" :depends-on ("package"))))))
-
-;;; vim: ft=lisp et
(DIR) diff --git a/3rdparties/software/cffi_0.20.0/cffi-toolchain.asd b/3rdparties/software/cffi_0.20.0/cffi-toolchain.asd
@@ -1,48 +0,0 @@
-;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
-;;;
-;;; cffi-toolchain.asd --- ASDF system definition for cffi-toolchain.
-;;;
-;;; Copyright (C) 2007, Luis Oliveira <loliveira@common-lisp.net>
-;;;
-;;; Permission is hereby granted, free of charge, to any person
-;;; obtaining a copy of this software and associated documentation
-;;; files (the "Software"), to deal in the Software without
-;;; restriction, including without limitation the rights to use, copy,
-;;; modify, merge, publish, distribute, sublicense, and/or sell copies
-;;; of the Software, and to permit persons to whom the Software is
-;;; furnished to do so, subject to the following conditions:
-;;;
-;;; The above copyright notice and this permission notice shall be
-;;; included in all copies or substantial portions of the Software.
-;;;
-;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
-;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
-;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
-;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
-;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
-;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
-;;; DEALINGS IN THE SOFTWARE.
-;;;
-
-;; Make sure to upgrade ASDF before the #.(if ...) below may be read.
-(load-system "asdf")
-#-asdf3.1 (error "CFFI-toolchain requires ASDF 3.1!")
-
-(defsystem "cffi-toolchain"
- :description "The CFFI toolchain"
- :long-description "Portable abstractions for using the C compiler, linker, etc."
- :author "Francois-Rene Rideau <fahree@gmail.com>"
- :depends-on ((:version "asdf" "3.1.2") "cffi")
- :licence "MIT"
- :components
- ((:module "toolchain"
- :components
- (;; This is a plain copy of bundle.lisp from ASDF 3.2.0
- ;; in case your asdf isn't up to snuff.
- (:file "bundle" :if-feature (#.(if (version< "3.2.0" (asdf-version)) :or :and)))
- (:file "package")
- (:file "c-toolchain" :depends-on ("package"))
- (:file "static-link" :depends-on ("bundle" "c-toolchain"))))))
-
-;; vim: ft=lisp et
(DIR) diff --git a/3rdparties/software/cffi_0.20.0/cffi-uffi-compat.asd b/3rdparties/software/cffi_0.20.0/cffi-uffi-compat.asd
@@ -1,41 +0,0 @@
-;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
-;;;
-;;; cffi-uffi-compat.asd --- ASDF system definition for CFFI-UFFI-COMPAT.
-;;;
-;;; Copyright (C) 2005-2006, James Bielman <jamesjb@jamesjb.com>
-;;;
-;;; Permission is hereby granted, free of charge, to any person
-;;; obtaining a copy of this software and associated documentation
-;;; files (the "Software"), to deal in the Software without
-;;; restriction, including without limitation the rights to use, copy,
-;;; modify, merge, publish, distribute, sublicense, and/or sell copies
-;;; of the Software, and to permit persons to whom the Software is
-;;; furnished to do so, subject to the following conditions:
-;;;
-;;; The above copyright notice and this permission notice shall be
-;;; included in all copies or substantial portions of the Software.
-;;;
-;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
-;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
-;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
-;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
-;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
-;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
-;;; DEALINGS IN THE SOFTWARE.
-;;;
-
-(defpackage #:cffi-uffi-compat-system
- (:use #:cl #:asdf))
-(in-package #:cffi-uffi-compat-system)
-
-(defsystem cffi-uffi-compat
- :description "UFFI Compatibility Layer for CFFI"
- :author "James Bielman <jamesjb@jamesjb.com>"
- :components
- ((:module uffi-compat
- :components
- ((:file "uffi-compat"))))
- :depends-on (cffi))
-
-;; vim: ft=lisp et
(DIR) diff --git a/3rdparties/software/cffi_0.20.0/cffi.asd b/3rdparties/software/cffi_0.20.0/cffi.asd
@@ -1,101 +0,0 @@
-;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
-;;;
-;;; cffi.asd --- ASDF system definition for CFFI.
-;;;
-;;; Copyright (C) 2005-2006, James Bielman <jamesjb@jamesjb.com>
-;;; Copyright (C) 2005-2010, Luis Oliveira <loliveira@common-lisp.net>
-;;;
-;;; Permission is hereby granted, free of charge, to any person
-;;; obtaining a copy of this software and associated documentation
-;;; files (the "Software"), to deal in the Software without
-;;; restriction, including without limitation the rights to use, copy,
-;;; modify, merge, publish, distribute, sublicense, and/or sell copies
-;;; of the Software, and to permit persons to whom the Software is
-;;; furnished to do so, subject to the following conditions:
-;;;
-;;; The above copyright notice and this permission notice shall be
-;;; included in all copies or substantial portions of the Software.
-;;;
-;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
-;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
-;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
-;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
-;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
-;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
-;;; DEALINGS IN THE SOFTWARE.
-;;;
-
-(in-package :asdf)
-
-#-(or openmcl mcl sbcl cmucl scl clisp lispworks ecl allegro cormanlisp abcl mkcl clasp)
-(error "Sorry, this Lisp is not yet supported. Patches welcome!")
-
-(defsystem "cffi"
- :description "The Common Foreign Function Interface"
- :author "James Bielman <jamesjb@jamesjb.com>"
- :maintainer "Luis Oliveira <loliveira@common-lisp.net>"
- :licence "MIT"
- :depends-on (:uiop :alexandria :trivial-features :babel)
- :in-order-to ((test-op (load-op :cffi-tests)))
- :perform (test-op (o c) (operate 'asdf:test-op :cffi-tests))
- :components
- ((:module "src"
- :serial t
- :components
- (#+openmcl (:file "cffi-openmcl")
- #+mcl (:file "cffi-mcl")
- #+sbcl (:file "cffi-sbcl")
- #+cmucl (:file "cffi-cmucl")
- #+scl (:file "cffi-scl")
- #+clisp (:file "cffi-clisp")
- #+lispworks (:file "cffi-lispworks")
- #+ecl (:file "cffi-ecl")
- #+allegro (:file "cffi-allegro")
- #+cormanlisp (:file "cffi-corman")
- #+abcl (:file "cffi-abcl")
- #+mkcl (:file "cffi-mkcl")
- #+clasp (:file "cffi-clasp")
- (:file "package")
- (:file "utils")
- (:file "libraries")
- (:file "early-types")
- (:file "types")
- (:file "enum")
- (:file "strings")
- (:file "structures")
- (:file "functions")
- (:file "foreign-vars")
- (:file "features")))))
-
-;; when you get CFFI from git, its defsystem doesn't have a version,
-;; so we assume it satisfies any version requirements whatsoever.
-(defmethod version-satisfies ((c (eql (find-system :cffi))) version)
- (declare (ignorable version))
- (or (null (component-version c))
- (call-next-method)))
-
-(defsystem "cffi/c2ffi"
- :description "CFFI definition generator from the FFI spec generated by c2ffi. This system is enough to use the ASDF machinery (as a :defsystem-depends-on)."
- :author "Attila Lendvai <attila@lendvai.name>"
- :depends-on (:alexandria
- :cffi)
- :licence "MIT"
- :components
- ((:module "src/c2ffi"
- :components
- ((:file "package")
- (:file "c2ffi" :depends-on ("package"))
- (:file "asdf" :depends-on ("package" "c2ffi"))))))
-
-(defsystem "cffi/c2ffi-generator"
- :description "This system gets loaded lazily when the CFFI bindings need to be regenerated."
- :author "Attila Lendvai <attila@lendvai.name>"
- :depends-on (:cffi/c2ffi
- :cl-ppcre
- :cl-json)
- :licence "MIT"
- :components
- ((:module "src/c2ffi"
- :components
- ((:file "generator")))))
(DIR) diff --git a/3rdparties/software/cffi_0.20.0/doc/Makefile b/3rdparties/software/cffi_0.20.0/doc/Makefile
@@ -1,46 +0,0 @@
-# -*- Mode: Makefile; tab-width: 3; indent-tabs-mode: t -*-
-#
-# Makefile --- Make targets for generating the documentation.
-#
-# Copyright (C) 2005-2007, Luis Oliveira <loliveira@common-lisp.net>
-#
-# Permission is hereby granted, free of charge, to any person
-# obtaining a copy of this software and associated documentation
-# files (the "Software"), to deal in the Software without
-# restriction, including without limitation the rights to use, copy,
-# modify, merge, publish, distribute, sublicense, and/or sell copies
-# of the Software, and to permit persons to whom the Software is
-# furnished to do so, subject to the following conditions:
-#
-# The above copyright notice and this permission notice shall be
-# included in all copies or substantial portions of the Software.
-#
-# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
-# EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
-# MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
-# NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
-# HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
-# WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-# OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
-# DEALINGS IN THE SOFTWARE.
-#
-
-export LC_ALL=C
-
-all: manual spec
-
-manual: cffi-manual.texinfo style.css
- sh gendocs.sh -o manual --html "--css-include=style.css" cffi-manual "CFFI User Manual"
-
-spec: cffi-sys-spec.texinfo style.css
- sh gendocs.sh -o spec --html "--css-include=style.css" cffi-sys-spec "CFFI-SYS Interface Specification"
-
-clean:
- find . \( -name "*.info" -o -name "*.aux" -o -name "*.cp" -o -name "*.fn" -o -name "*.fns" -o -name "*.ky" -o -name "*.log" -o -name "*.pg" -o -name "*.toc" -o -name "*.tp" -o -name "*.vr" -o -name "*.dvi" -o -name "*.cps" -o -name "*.vrs" \) -exec rm {} \;
- rm -rf manual spec dir
-
-upload-docs: manual spec
- rsync -av --delete -e ssh manual spec common-lisp.net:/project/cffi/public_html/
-# scp -r manual spec common-lisp.net:/project/cffi/public_html/
-
-# vim: ft=make ts=3 noet
(DIR) diff --git a/3rdparties/software/cffi_0.20.0/doc/allegro-internals.txt b/3rdparties/software/cffi_0.20.0/doc/allegro-internals.txt
@@ -1,132 +0,0 @@
-July 2005
-These details were kindly provided by Duane Rettig of Franz.
-
-Regarding the following snippet of the macro expansion of
-FF:DEF-FOREIGN-CALL:
-
- (SYSTEM::FF-FUNCALL
- (LOAD-TIME-VALUE (EXCL::DETERMINE-FOREIGN-ADDRESS
- '("foo" :LANGUAGE :C) 2 NIL))
- '(:INT (INTEGER * *)) ARG1
- '(:DOUBLE (DOUBLE-FLOAT * *)) ARG2
- '(:INT (INTEGER * *)))
-
-"
-... in Allegro CL, if you define a foreign call FOO with C entry point
-"foo" and with :call-direct t in the arguments, and if other things are
-satisfied, then if a lisp function BAR is compiled which has a call to
-FOO, that call will not go through ff-funcall (and thus a large amount
-of argument manipulation and processing) but will instead set up its
-arguments directly on the stack, and will then perform the "call" more
-or less directly, through the "entry vec" (a small structure which
-keeps track of a foreign entry's address and status)."
-
-This is the code that generates what the compiler expects to see:
-
-(setq call-direct-form
- (if* call-direct
- then `(setf (get ',lispname 'sys::direct-ff-call)
- (list ',external-name
- ,callback
- ,convention
- ',returning
- ',arg-types
- ,arg-checking
- ,entry-vec-flags))
- else `(remprop ',lispname 'sys::direct-ff-call)))
-
-Thus generating something like:
-
- (EVAL-WHEN (COMPILE LOAD EVAL)
- (SETF (GET 'FOO 'SYSTEM::DIRECT-FF-CALL)
- (LIST '("foo" :LANGUAGE :C) T :C
- '(:INT (INTEGER * *))
- '((:INT (INTEGER * *))
- (:FLOAT (SINGLE-FLOAT * *)))
- T
- 2 ; this magic value is explained later
- )))
-
-"
-(defun determine-foreign-address (name &optional (flags 0) method-index)
- ;; return an entry-vec struct suitable for the foreign-call of name.
- ;;
- ;; name is either a string, which is taken without conversion, or
- ;; a list consisting of a string to convert or a conversion function
- ;; call.
- ;; flags is an integer representing the flags to place into the entry-vec.
- ;; method-index, if non-nil, is a word-index into a vtbl (virtual table).
- ;; If method-index is true, then the name must be a string uniquely
- ;; represented by the index and by the flags field.
-
-Note that not all architectures implement the :method-index argument
-to def-foreign-call, but your interface likely won't support it
-anyway, so just leave it nil. As for the flags, they are constants
-stored into the entry-vec returned by d-f-a and are given here:
-
-(defconstant ep-flag-call-semidirect 1) ; Real address stored in alt-address slot
-(defconstant ep-flag-never-release 2) ; Never release the heap
-(defconstant ep-flag-always-release 4) ; Always release the heap
-(defconstant ep-flag-release-when-ok 8) ; Release the heap unless without-interrupts
-
-(defconstant ep-flag-tramp-calls #x70) ; Make calls through special trampolines
-(defconstant ep-flag-tramp-shift 4)
-
-(defconstant ep-flag-variable-address #x100) ; Entry-point contains address of C var
-(defconstant ep-flag-strings-convert #x200) ; Convert strings automatically
-
-(defconstant ep-flag-get-errno #x1000) ;; [rfe5060]: Get errno value after call
-(defconstant ep-flag-get-last-error #x2000) ;; [rfe5060]: call GetLastError after call
-;; Leave #x4000 and #x8000 open for expansion
-
-Mostly, you'll give the value 2 (never release the heap), but if you
-give 4 or 8, then d-f-a will automatically set the 1 bit as well,
-which takes the call through a heap-release/reacquire process.
-
-Some docs for entry-vec are:
-
-;; -- entry vec --
-;; An entry-vec is an entry-point descriptor, usually a pointer into
-;; a shared-library. It is represented as a 5-element struct of type
-;; foreign-vector. The reason for this represntation is
-;; that it allows the entry point to be stored in a table, called
-;; the .saved-entry-points. table, and to be used by a foreign
-;; function. When the location of the foreign function to which the entry
-;; point refers changes, it is simply a matter of changing the value in entry
-;; point vector and the foreign call code sees it immediately. There is
-;; even an address that can be put in the entry point vector that denotes
-;; a missing foreign function, thus lookup can happen dynamically.
-
-(defstruct (entry-vec
- (:type (vector excl::foreign (*)))
- (:constructor make-entry-vec-boa ()))
- name ; entry point name
- (address 0) ; jump address for foreign code
- (handle 0) ; shared-lib handle
- (flags 0) ; ep-* flags
- (alt-address 0) ; sometimes holds the real func addr
- )
-
-[...]
-"
-
-Regarding the arguments to SYSTEM::FF-FUNCALL:
- '(:int (integer * *)) argN
-
-"The type-spec is as it is given in the def-foreign-call
-syntax, with a C type optionally followed by a lisp type,
-followed optionally by a user-conversion function name[...]"
-
-
-Getting the alignment:
-
-CL-USER(2): (ff:get-foreign-type :int)
-#S(FOREIGN-FUNCTIONS::IFOREIGN-TYPE
- :ATTRIBUTES NIL
- :SFTYPE
- #S(FOREIGN-FUNCTIONS::SIZED-FTYPE-PRIM
- :KIND :INT
- :WIDTH 4
- :OFFSET 0
- :ALIGN 4)
- ...)
(DIR) diff --git a/3rdparties/software/cffi_0.20.0/doc/cffi-manual.texinfo b/3rdparties/software/cffi_0.20.0/doc/cffi-manual.texinfo
@@ -1,7113 +0,0 @@
-\input texinfo @c -*- Mode: Texinfo; Mode: auto-fill -*-
-@c %**start of header
-@setfilename cffi.info
-@settitle CFFI User Manual
-@exampleindent 2
-
-@c @documentencoding utf-8
-
-@c Style notes:
-@c
-@c * The reference section names and "See Also" list are roman, not
-@c @code. This is to follow the format of CLHS.
-@c
-@c * How it looks in HTML is the priority.
-
-@c ============================= Macros =============================
-@c The following macros are used throughout this manual.
-
-@macro Function {args}
-@defun \args\
-@end defun
-@end macro
-
-@macro Macro {args}
-@defmac \args\
-@end defmac
-@end macro
-
-@macro Accessor {args}
-@deffn {Accessor} \args\
-@end deffn
-@end macro
-
-@macro GenericFunction {args}
-@deffn {Generic Function} \args\
-@end deffn
-@end macro
-
-@macro ForeignType {args}
-@deftp {Foreign Type} \args\
-@end deftp
-@end macro
-
-@macro Variable {args}
-@defvr {Special Variable} \args\
-@end defvr
-@end macro
-
-@macro Condition {args}
-@deftp {Condition Type} \args\
-@end deftp
-@end macro
-
-@macro cffi
-@acronym{CFFI}
-@end macro
-
-@macro impnote {text}
-@quotation
-@strong{Implementor's note:} @emph{\text\}
-@end quotation
-@end macro
-
-@c Info "requires" that x-refs end in a period or comma, or ) in the
-@c case of @pxref. So the following implements that requirement for
-@c the "See also" subheadings that permeate this manual, but only in
-@c Info mode.
-@ifinfo
-@macro seealso {name}
-@ref{\name\}.
-@end macro
-@end ifinfo
-
-@ifnotinfo
-@alias seealso = ref
-@end ifnotinfo
-
-@c Typeset comments in roman font for the TeX output.
-@iftex
-@alias lispcmt = r
-@end iftex
-@ifnottex
-@alias lispcmt = asis
-@end ifnottex
-
-@alias res = result
-
-@c ============================= Macros =============================
-
-
-@c Show types, functions, and concepts in the same index.
-@syncodeindex tp cp
-@syncodeindex fn cp
-
-@copying
-Copyright @copyright{} 2005 James Bielman <jamesjb at jamesjb.com> @*
-Copyright @copyright{} 2005-2015 Lu@'{@dotless{i}}s Oliveira
- <loliveira at common-lisp.net> @*
-Copyright @copyright{} 2005-2006 Dan Knapp <danka at accela.net> @*
-Copyright @copyright{} 2005-2006 Emily Backes <lucca at accela.net> @*
-Copyright @copyright{} 2006 Stephen Compall <s11 at member.fsf.org>
-
-@quotation
-Permission is hereby granted, free of charge, to any person obtaining
-a copy of this software and associated documentation files (the
-``Software''), to deal in the Software without restriction, including
-without limitation the rights to use, copy, modify, merge, publish,
-distribute, sublicense, and/or sell copies of the Software, and to
-permit persons to whom the Software is furnished to do so, subject to
-the following conditions:
-
-The above copyright notice and this permission notice shall be
-included in all copies or substantial portions of the Software.
-
-@sc{The software is provided ``as is'', without warranty of any kind,
-express or implied, including but not limited to the warranties of
-merchantability, fitness for a particular purpose and noninfringement.
-In no event shall the authors or copyright holders be liable for any
-claim, damages or other liability, whether in an action of contract,
-tort or otherwise, arising from, out of or in connection with the
-software or the use or other dealings in the software.}
-@end quotation
-@end copying
-@c %**end of header
-
-@dircategory Software development
-@direntry
-* CFFI Manual: (cffi-manual). CFFI Manual.
-@end direntry
-
-@titlepage
-@title CFFI User Manual
-@c @subtitle Version X.X
-@c @author James Bielman
-
-@page
-@vskip 0pt plus 1filll
-@insertcopying
-@end titlepage
-
-@contents
-
-@ifnottex
-@node Top, Introduction, (dir), (dir)
-@top cffi
-@insertcopying
-@end ifnottex
-
-@menu
-* Introduction:: What is CFFI?
-* Installation::
-* Implementation Support::
-* Tutorial:: Interactive intro to using CFFI.
-* Wrapper generators:: CFFI forms from munging C source code.
-* Foreign Types::
-* Pointers::
-* Strings::
-* Variables::
-* Functions::
-* Libraries::
-* Callbacks::
-* The Groveller::
-* Static Linking::
-* Limitations::
-* Platform-specific features:: Details about the underlying system.
-* Glossary:: List of CFFI-specific terms and meanings.
-* Comprehensive Index::
-
-@detailmenu
- --- Dictionary ---
-
-Foreign Types
-
-* convert-from-foreign:: Outside interface to backward type translator.
-* convert-to-foreign:: Outside interface to forward type translator.
-* defbitfield:: Defines a bitfield.
-* defcstruct:: Defines a C structure type.
-* defcunion:: Defines a C union type.
-* defctype:: Defines a foreign typedef.
-* defcenum:: Defines a C enumeration.
-* define-foreign-type:: Defines a foreign type specifier.
-* define-parse-method:: Specifies how a type should be parsed.
-@c * explain-foreign-slot-value:: <unimplemented>
-* foreign-bitfield-symbols:: Returns a list of symbols for a bitfield type.
-* foreign-bitfield-value:: Calculates a value for a bitfield type.
-* foreign-enum-keyword:: Finds a keyword in an enum type.
-* foreign-enum-value:: Finds a value in an enum type.
-* foreign-slot-names:: Returns a list of slot names in a foreign struct.
-* foreign-slot-offset:: Returns the offset of a slot in a foreign struct.
-* foreign-slot-pointer:: Returns a pointer to a slot in a foreign struct.
-* foreign-slot-value:: Returns the value of a slot in a foreign struct.
-* foreign-type-alignment:: Returns the alignment of a foreign type.
-* foreign-type-size:: Returns the size of a foreign type.
-* free-converted-object:: Outside interface to typed object deallocators.
-* free-translated-object:: Defines how to free a oreign object.
-* translate-from-foreign:: Defines a foreign-to-Lisp object translation.
-* translate-to-foreign:: Defines a Lisp-to-foreign object translation.
-* with-foreign-object:: Allocates a foreign object with dynamic extent.
-* with-foreign-objects:: Plural form of @code{with-foreign-object}.
-* with-foreign-slots:: Accesses the slots of a foreign structure.
-
-Pointers
-
-* foreign-free:: Deallocates memory.
-* foreign-alloc:: Allocates memory.
-* foreign-symbol-pointer:: Returns a pointer to a foreign symbol.
-* inc-pointer:: Increments the address held by a pointer.
-* incf-pointer:: Increments the pointer address in a place.
-* make-pointer:: Returns a pointer to a given address.
-* mem-aptr:: The pointer to an element of an array.
-* mem-aref:: Accesses the value of an index in an array.
-* mem-ref:: Dereferences a pointer.
-* null-pointer:: Returns a NULL pointer.
-* null-pointer-p:: Tests a pointer for NULL value.
-* pointerp:: Tests whether an object is a pointer or not.
-* pointer-address:: Returns the address pointed to by a pointer.
-* pointer-eq:: Tests if two pointers point to the same address.
-* with-foreign-pointer:: Allocates memory with dynamic extent.
-
-Strings
-
-* *default-foreign-encoding*:: Default encoding for the string types.
-* foreign-string-alloc:: Converts a Lisp string to a foreign string.
-* foreign-string-free:: Deallocates memory used by a foreign string.
-* foreign-string-to-lisp:: Converts a foreign string to a Lisp string.
-* lisp-string-to-foreign:: Copies a Lisp string into a foreign string.
-* with-foreign-string:: Allocates a foreign string with dynamic extent.
-* with-foreign-strings:: Plural form of @code{with-foreign-string}.
-* with-foreign-pointer-as-string:: Similar to CL's with-output-to-string.
-
-Variables
-
-* defcvar:: Defines a C global variable.
-* get-var-pointer:: Returns a pointer to a defined global variable.
-
-Functions
-
-* defcfun:: Defines a foreign function.
-* foreign-funcall:: Performs a call to a foreign function.
-* foreign-funcall-pointer:: Performs a call through a foreign pointer.
-* translate-camelcase-name:: Converts a camelCase foreign name to/from a Lisp name.
-* translate-name-from-foreign:: Converts a foreign name to a Lisp name.
-* translate-name-to-foreign:: Converts a Lisp name to a foreign name.
-* translate-underscore-separated-name:: Converts an underscore_separated foreign name to/from a Lisp name.
-
-Libraries
-
-* close-foreign-library:: Closes a foreign library.
-* *darwin-framework-directories*:: Search path for Darwin frameworks.
-* define-foreign-library:: Explain how to load a foreign library.
-* *foreign-library-directories*:: Search path for shared libraries.
-* load-foreign-library:: Load a foreign library.
-* load-foreign-library-error:: Signalled on failure of its namesake.
-@c * reload-foreign-libraries:: Reload foreign libraries.
-* use-foreign-library:: Load a foreign library when needed.
-
-Callbacks
-
-* callback:: Returns a pointer to a defined callback.
-* defcallback:: Defines a Lisp callback.
-* get-callback:: Returns a pointer to a defined callback.
-
-@end detailmenu
-@end menu
-
-
-
-
-@c ===================================================================
-@c CHAPTER: Introduction
-
-@node Introduction, Installation, Top, Top
-@chapter Introduction
-
-@cffi{} is the Common Foreign Function Interface for @acronym{ANSI}
-Common Lisp systems. By @dfn{foreign function} we mean a function
-written in another programming language and having different data and
-calling conventions than Common Lisp, namely, C. @cffi{} allows you
-to call foreign functions and access foreign variables, all without
-leaving the Lisp image.
-
-We consider this manual ever a work in progress. If you have
-difficulty with anything @cffi{}-specific presented in the manual,
-please contact @email{cffi-devel@@common-lisp.net,the developers} with
-details.
-
-
-@heading Motivation
-
-@xref{Tutorial-Comparison,, What makes Lisp different}, for
-an argument in favor of @acronym{FFI} in general.
-
-@cffi{}'s primary role in any image is to mediate between Lisp
-developers and the widely varying @acronym{FFI}s present in the
-various Lisp implementations it supports. With @cffi{}, you can
-define foreign function interfaces while still maintaining portability
-between implementations. It is not the first Common Lisp package with
-this objective; however, it is meant to be a more malleable framework
-than similar packages.
-
-
-@heading Design Philosophy
-
-@itemize
-@item
-Pointers do not carry around type information. Instead, type
-information is supplied when pointers are dereferenced.
-
-@item
-A type safe pointer interface can be developed on top of an
-untyped one. It is difficult to do the opposite.
-
-@item
-Functions are better than macros. When a macro could be used
-for performance, use a compiler-macro instead.
-@end itemize
-
-
-@c ===================================================================
-@c CHAPTER: Installation
-
-@node Installation, Implementation Support, Introduction, Top
-@chapter Installation
-
-@cffi{} can be obtained through one of the following means available
-through its @uref{http://common-lisp.net/project/cffi/,,website}:
-
-@itemize
-@item
-@uref{http://common-lisp.net/project/cffi/releases/?M=D,,official release
-tarballs}
-
-@item
-@uref{http://common-lisp.net/gitweb?p=projects/cffi/cffi.git,,git
-repository}
-
-@c snapshots have been disabled as of
-@c @item
-@c @uref{http://common-lisp.net/project/cffi/tarballs/?M=D,,nightly-generated
-@c snapshots}
-
-@end itemize
-
-In addition, you will need to obtain and install the following
-dependencies:
-
-@itemize
-@item
-@uref{http://common-lisp.net/project/babel/,,Babel}, a charset
-encoding/decoding library.
-
-@item
-@uref{http://common-lisp.net/project/alexandria/,,Alexandria}, a
-collection of portable public-domain utilities.
-
-@item
-@uref{http://www.cliki.net/trivial-features,,trivial-features}, a
-portability layer that ensures consistent @code{*features*} across
-multiple Common Lisp implementations.
-
-@end itemize
-
-Furthermore, if you wish to run the testsuite,
-@uref{http://www.cliki.net/rt,,RT} is required.
-
-You may find mechanisms such as
-@uref{https://www.quicklisp.org/beta/,Quicklisp} (recommended)
-or @uref{http://common-lisp.net/project/clbuild/,,clbuild} (for advanced
-uses) helpful in getting and managing @cffi{} and its
-dependencies.
-
-
-@c ===================================================================
-@c CHAPTER: Implementation Support
-
-@node Implementation Support, Tutorial, Installation, Top
-@chapter Implementation Support
-
-@cffi{} supports various free and commercial Lisp implementations:
-@acronym{ABCL}, Allegro CL, Clasp, @sc{clisp}, Clozure CL,
-@acronym{CMUCL}, Corman CL, @acronym{ECL}, @acronym{GCL}, LispWorks,
-@acronym{MCL}, @acronym{SBCL} and the Scieneer CL.
-
-In general, you should work with the latest versions of each
-implementation since those will usually be tested against recent
-versions of CFFI more often and might include necessary features or
-bug fixes. Reasonable patches for compatibility with earlier versions
-are welcome nevertheless.
-
-@section Limitations
-
-Some features are not supported in all implementations.
-@c TODO: describe these features here.
-@c flat-namespace too
-
-@subheading Allegro CL
-
-@itemize
-@item
-Does not support the @code{:long-long} type natively.
-@item
-Unicode support is limited to the Basic Multilingual Plane (16-bit
-code points).
-@end itemize
-
-@subheading Clasp
-
-@itemize
-@item
-Only supports a flat namespace.
-@end itemize
-
-@subheading CMUCL
-
-@itemize
-@item
-No Unicode support. (8-bit code points)
-@end itemize
-
-@subheading Corman CL
-
-@itemize
-@item
-Does not support @code{foreign-funcall}.
-@end itemize
-
-@subheading @acronym{ECL}
-
-@itemize
-@item
-On platforms where ECL's dynamic FFI is not supported (ie. when
-@code{:dffi} is not present in @code{*features*}),
-@code{cffi:load-foreign-library} does not work and you must use ECL's
-own @code{ffi:load-foreign-library} with a constant string argument.
-@end itemize
-
-@subheading Lispworks
-
-@itemize
-@item
-Does not completely support the @code{:long-long} type natively in
-32-bit platforms.
-@item
-Unicode support is limited to the Basic Multilingual Plane (16-bit
-code points).
-@end itemize
-
-@subheading @acronym{SBCL}
-
-@itemize
-@item
-Not all platforms support callbacks.
-
-@end itemize
-
-
-@c ===================================================================
-@c CHAPTER: An Introduction to Foreign Interfaces and CFFI
-
-@c This macro is merely a marker that I don't think I'll use after
-@c all.
-@macro tutorialsource {text}
-@c \text\
-@end macro
-
-@c because I don't want to type this over and over
-@macro clikicffi
-http://www.cliki.net/CFFI
-@end macro
-@c TeX puts spurious newlines in when you use the above macro
-@c in @examples &c. So it is expanded below in some places.
-
-
-@node Tutorial, Wrapper generators, Implementation Support, Top
-@chapter An Introduction to Foreign Interfaces and @acronym{CFFI}
-
-@c Above, I don't use the cffi macro because it breaks TeX.
-
-@cindex tutorial, @cffi{}
-Users of many popular languages bearing semantic similarity to Lisp,
-such as Perl and Python, are accustomed to having access to popular C
-libraries, such as @acronym{GTK}, by way of ``bindings''. In Lisp, we
-do something similar, but take a fundamentally different approach.
-This tutorial first explains this difference, then explains how you
-can use @cffi{}, a powerful system for calling out to C and C++ and
-access C data from many Common Lisp implementations.
-
-@cindex foreign functions and data
-The concept can be generalized to other languages; at the time of
-writing, only @cffi{}'s C support is fairly complete. Therefore, we
-will interchangeably refer to @dfn{foreign functions} and @dfn{foreign
-data}, and ``C functions'' and ``C data''. At no time will the word
-``foreign'' carry its usual, non-programming meaning.
-
-This tutorial expects you to have a working understanding of both
-Common Lisp and C, including the Common Lisp macro system.
-
-@menu
-* Tutorial-Comparison:: Why FFI?
-* Tutorial-Getting a URL:: An FFI use case.
-* Tutorial-Loading:: Load libcurl.so.
-* Tutorial-Initializing:: Call a function in libcurl.so.
-* Tutorial-easy_setopt:: An advanced libcurl function.
-* Tutorial-Abstraction:: Why breaking it is necessary.
-* Tutorial-Lisp easy_setopt:: Semi-Lispy option interface.
-* Tutorial-Memory:: In C, you collect the garbage.
-* Tutorial-Callbacks:: Make useful C function pointers.
-* Tutorial-Completion:: Minimal get-url functionality.
-* Tutorial-Types:: Defining new foreign types.
-* Tutorial-Conclusion:: What's next?
-@end menu
-
-
-@node Tutorial-Comparison, Tutorial-Getting a URL, Tutorial, Tutorial
-@section What makes Lisp different
-
-The following sums up how bindings to foreign libraries are usually
-implemented in other languages, then in Common Lisp:
-
-@table @asis
-@item Perl, Python, Java, other one-implementation languages
-@cindex @acronym{SWIG}
-@cindex Perl
-@cindex Python
-Bindings are implemented as shared objects written in C. In some
-cases, the C code is generated by a tool, such as @acronym{SWIG}, but
-the result is the same: a new C library that manually translates
-between the language implementation's objects, such as @code{PyObject}
-in Python, and whatever C object is called for, often using C
-functions provided by the implementation. It also translates between
-the calling conventions of the language and C.
-
-@item Common Lisp
-@cindex @acronym{SLIME}
-Bindings are written in Lisp. They can be created at-will by Lisp
-programs. Lisp programmers can write new bindings and add them to the
-image, using a listener such as @acronym{SLIME}, as easily as with
-regular Lisp definitions. The only foreign library to load is the one
-being wrapped---the one with the pure C interface; no C or other
-non-Lisp compilation is required.
-@end table
-
-@cindex advantages of @acronym{FFI}
-@cindex benefits of @acronym{FFI}
-We believe the advantages of the Common Lisp approach far outweigh any
-disadvantages. Incremental development with a listener can be as
-productive for C binding development as it is with other Lisp
-development. Keeping it ``in the [Lisp] family'', as it were, makes
-it much easier for you and other Lisp programmers to load and use the
-bindings. Common Lisp implementations such as @acronym{CMUCL}, freed
-from having to provide a C interface to their own objects, are thus
-freed to be implemented in another language (as @acronym{CMUCL} is)
-while still allowing programmers to call foreign functions.
-
-@cindex minimal bindings
-Perhaps the greatest advantage is that using an @acronym{FFI} doesn't
-obligate you to become a professional binding developer. Writers of
-bindings for other languages usually end up maintaining or failing to
-maintain complete bindings to the foreign library. Using an
-@acronym{FFI}, however, means if you only need one or two functions,
-you can write bindings for only those functions, and be assured that
-you can just as easily add to the bindings if need be.
-
-@cindex C abstractions
-@cindex abstractions in C
-The removal of the C compiler, or C interpretation of any kind,
-creates the main disadvantage: some of C's ``abstractions'' are not
-available, violating information encapsulation. For example,
-@code{struct}s that must be passed on the stack, or used as return
-values, without corresponding functional abstractions to create and
-manage the @code{struct}s, must be declared explicitly in Lisp. This
-is fine for structs whose contents are ``public'', but is not so
-pleasant when a struct is supposed to be ``opaque'' by convention,
-even though it is not so defined.@footnote{Admittedly, this is an
-advanced issue, and we encourage you to leave this text until you are
-more familiar with how @cffi{} works.}
-
-Without an abstraction to create the struct, Lisp needs to be able to
-lay out the struct in memory, so must know its internal details.
-
-@cindex workaround for C
-In these cases, you can create a minimal C library to provide the
-missing abstractions, without destroying all the advantages of the
-Common Lisp approach discussed above. In the case of @code{struct}s,
-you can write simple, pure C functions that tell you how many bytes a
-struct requires or allocate new structs, read and write fields of the
-struct, or whatever operations are supposed to be
-public.@footnote{This does not apply to structs whose contents are
-intended to be part of the public library interface. In those cases,
-a pure Lisp struct definition is always preferred. In fact, many
-prefer to stay in Lisp and break the encapsulation anyway, placing the
-burden of correct library interface definition on the library.}
-@ref{The Groveller} automates this and other processes.
-
-Another disadvantage appears when you would rather use the foreign
-language than Lisp. However, someone who prefers C to Lisp is not a
-likely candidate for developing a Lisp interface to a C library.
-
-
-@node Tutorial-Getting a URL, Tutorial-Loading, Tutorial-Comparison, Tutorial
-@section Getting a @acronym{URL}
-
-@cindex c@acronym{URL}
-The widely available @code{libcurl} is a library for downloading files
-over protocols like @acronym{HTTP}. We will use @code{libcurl} with
-@cffi{} to download a web page.
-
-Please note that there are many other ways to download files from the
-web, not least the @sc{cl-curl} project to provide bindings to
-@code{libcurl} via a similar @acronym{FFI}.@footnote{Specifically,
-@acronym{UFFI}, an older @acronym{FFI} that takes a somewhat different
-approach compared to @cffi{}. I believe that these days (December
-2005) @cffi{} is more portable and actively developed, though not as
-mature yet. Consensus in the free @sc{unix} Common Lisp community
-seems to be that @cffi{} is preferred for new development, though
-@acronym{UFFI} will likely go on for quite some time as many projects
-already use it. @cffi{} includes the @code{UFFI-COMPAT} package for
-complete compatibility with @acronym{UFFI}.}
-
-@uref{http://curl.haxx.se/libcurl/c/libcurl-tutorial.html,,libcurl-tutorial(3)}
-is a tutorial for @code{libcurl} programming in C. We will follow
-that to develop a binding to download a file. We will also use
-@file{curl.h}, @file{easy.h}, and the @command{man} pages for the
-@code{libcurl} function, all available in the @samp{curl-dev} package
-or equivalent for your system, or in the c@acronym{URL} source code
-package. If you have the development package, the headers should be
-installed in @file{/usr/include/curl/}, and the @command{man} pages
-may be accessed through your favorite @command{man} facility.
-
-
-@node Tutorial-Loading, Tutorial-Initializing, Tutorial-Getting a URL, Tutorial
-@section Loading foreign libraries
-
-@cindex loading @cffi{}
-@cindex requiring @cffi{}
-First of all, we will create a package to work in. You can save these
-forms in a file, or just send them to the listener as they are. If
-creating bindings for an @acronym{ASDF} package of yours, you will
-want to add @code{:cffi} to the @code{:depends-on} list in your
-@file{.asd} file. Otherwise, just use the @code{asdf:load-system} function to
-load @cffi{}.
-
-@tutorialsource{Initialization}
-@lisp
-(asdf:load-system :cffi)
-
-;;; @lispcmt{Nothing special about the "CFFI-USER" package. We're just}
-;;; @lispcmt{using it as a substitute for your own CL package.}
-(defpackage :cffi-user
- (:use :common-lisp :cffi))
-
-(in-package :cffi-user)
-
-(define-foreign-library libcurl
- (:darwin (:or "libcurl.3.dylib" "libcurl.dylib"))
- (:unix (:or "libcurl.so.3" "libcurl.so"))
- (t (:default "libcurl")))
-
-(use-foreign-library libcurl)
-@end lisp
-
-@cindex foreign library load
-@cindex library, foreign
-Using @code{define-foreign-library} and @code{use-foreign-library}, we
-have loaded @code{libcurl} into Lisp, much as the linker does when you
-start a C program, or @code{common-lisp:load} does with a Lisp source
-file or @acronym{FASL} file. We special-cased for @sc{unix} machines
-to always load a particular version, the one this tutorial was tested
-with; for those who don't care, the @code{define-foreign-library}
-clause @code{(t (:default "libcurl"))} should be satisfactory, and
-will adapt to various operating systems.
-
-
-@node Tutorial-Initializing, Tutorial-easy_setopt, Tutorial-Loading, Tutorial
-@section Initializing @code{libcurl}
-
-@cindex function definition
-After the introductory matter, the tutorial goes on to present the
-first function you should use.
-
-@example
-CURLcode curl_global_init(long flags);
-@end example
-
-@noindent
-Let's pick this apart into appropriate Lisp code:
-
-@tutorialsource{First CURLcode}
-@lisp
-;;; @lispcmt{A CURLcode is the universal error code. curl/curl.h says}
-;;; @lispcmt{no return code will ever be removed, and new ones will be}
-;;; @lispcmt{added to the end.}
-(defctype curl-code :int)
-
-;;; @lispcmt{Initialize libcurl with FLAGS.}
-(defcfun "curl_global_init" curl-code
- (flags :long))
-@end lisp
-
-@impnote{By default, CFFI assumes the UNIX viewpoint that there is one
-C symbol namespace, containing all symbols in all loaded objects.
-This is not so on Windows and Darwin, but we emulate UNIX's behaviour
-there. @ref{defcfun} for more details.}
-
-Note the parallels with the original C declaration. We've defined
-@code{curl-code} as a wrapping type for @code{:int}; right now, it
-only marks it as special, but later we will do something more
-interesting with it. The point is that we don't have to do it yet.
-
-@cindex calling foreign functions
-Looking at @file{curl.h}, @code{CURL_GLOBAL_NOTHING}, a possible value
-for @code{flags} above, is defined as @samp{0}. So we can now call
-the function:
-
-@example
-@sc{cffi-user>} (curl-global-init 0)
-@result{} 0
-@end example
-
-@cindex looks like it worked
-Looking at @file{curl.h} again, @code{0} means @code{CURLE_OK}, so it
-looks like the call succeeded. Note that @cffi{} converted the
-function name to a Lisp-friendly name. You can specify your own name
-if you want; use @code{("curl_global_init" @var{your-name-here})} as
-the @var{name} argument to @code{defcfun}.
-
-The tutorial goes on to have us allocate a handle. For good measure,
-we should also include the deallocator. Let's look at these
-functions:
-
-@example
-CURL *curl_easy_init( );
-void curl_easy_cleanup(CURL *handle);
-@end example
-
-Advanced users may want to define special pointer types; we will
-explore this possibility later. For now, just treat every pointer as
-the same:
-
-@tutorialsource{curl_easy handles}
-@lisp
-(defcfun "curl_easy_init" :pointer)
-
-(defcfun "curl_easy_cleanup" :void
- (easy-handle :pointer))
-@end lisp
-
-Now we can continue with the tutorial:
-
-@example
-@sc{cffi-user>} (defparameter *easy-handle* (curl-easy-init))
-@result{} *EASY-HANDLE*
-@sc{cffi-user>} *easy-handle*
-@result{} #<FOREIGN-ADDRESS #x09844EE0>
-@end example
-
-@cindex pointers in Lisp
-Note the print representation of a pointer. It changes depending on
-what Lisp you are using, but that doesn't make any difference to
-@cffi{}.
-
-
-@node Tutorial-easy_setopt, Tutorial-Abstraction, Tutorial-Initializing, Tutorial
-@section Setting download options
-
-The @code{libcurl} tutorial says we'll want to set many options before
-performing any download actions. This is done through
-@code{curl_easy_setopt}:
-
-@c That is literally ..., not an ellipsis.
-@example
-CURLcode curl_easy_setopt(CURL *curl, CURLoption option, ...);
-@end example
-
-@cindex varargs
-@cindex foreign arguments
-We've introduced a new twist: variable arguments. There is no obvious
-translation to the @code{defcfun} form, particularly as there are four
-possible argument types. Because of the way C works, we could define
-four wrappers around @code{curl_easy_setopt}, one for each type; in
-this case, however, we'll use the general-purpose macro
-@code{foreign-funcall} to call this function.
-
-@cindex enumeration, C
-To make things easier on ourselves, we'll create an enumeration of the
-kinds of options we want to set. The @code{enum CURLoption} isn't the
-most straightforward, but reading the @code{CINIT} C macro definition
-should be enlightening.
-
-@tutorialsource{CURLoption enumeration}
-@lisp
-(defmacro define-curl-options (name type-offsets &rest enum-args)
- "As with CFFI:DEFCENUM, except each of ENUM-ARGS is as follows:
-
- (NAME TYPE NUMBER)
-
-Where the arguments are as they are with the CINIT macro defined
-in curl.h, except NAME is a keyword.
-
-TYPE-OFFSETS is a plist of TYPEs to their integer offsets, as
-defined by the CURLOPTTYPE_LONG et al constants in curl.h."
- (flet ((enumerated-value (type offset)
- (+ (getf type-offsets type) offset)))
- `(progn
- (defcenum ,name
- ,@@(loop for (name type number) in enum-args
- collect (list name (enumerated-value type number))))
- ',name))) ;@lispcmt{for REPL users' sanity}
-
-(define-curl-options curl-option
- (long 0 objectpoint 10000 functionpoint 20000 off-t 30000)
- (:noprogress long 43)
- (:nosignal long 99)
- (:errorbuffer objectpoint 10)
- (:url objectpoint 2))
-@end lisp
-
-With some well-placed Emacs @code{query-replace-regexp}s, you could
-probably similarly define the entire @code{CURLoption} enumeration. I
-have selected to transcribe a few that we will use in this tutorial.
-
-If you're having trouble following the macrology, just macroexpand the
-@code{curl-option} definition, or see the following macroexpansion,
-conveniently downcased and reformatted:
-
-@tutorialsource{DEFINE-CURL-OPTIONS macroexpansion}
-@lisp
-(progn
- (defcenum curl-option
- (:noprogress 43)
- (:nosignal 99)
- (:errorbuffer 10010)
- (:url 10002))
- 'curl-option)
-@end lisp
-
-@noindent
-That seems more than reasonable. You may notice that we only use the
-@var{type} to compute the real enumeration offset; we will also need
-the type information later.
-
-First, however, let's make sure a simple call to the foreign function
-works:
-
-@example
-@sc{cffi-user>} (foreign-funcall "curl_easy_setopt"
- :pointer *easy-handle*
- curl-option :nosignal :long 1 curl-code)
-@result{} 0
-@end example
-
-@code{foreign-funcall}, despite its surface simplicity, can be used to
-call any C function. Its first argument is a string, naming the
-function to be called. Next, for each argument, we pass the name of
-the C type, which is the same as in @code{defcfun}, followed by a Lisp
-object representing the data to be passed as the argument. The final
-argument is the return type, for which we use the @code{curl-code}
-type defined earlier.
-
-@code{defcfun} just puts a convenient fa@,cade on
-@code{foreign-funcall}.@footnote{This isn't entirely true; some Lisps
-don't support @code{foreign-funcall}, so @code{defcfun} is implemented
-without it. @code{defcfun} may also perform optimizations that
-@code{foreign-funcall} cannot.} Our earlier call to
-@code{curl-global-init} could have been written as follows:
-
-@example
-@sc{cffi-user>} (foreign-funcall "curl_global_init" :long 0
- curl-code)
-@result{} 0
-@end example
-
-Before we continue, we will take a look at what @cffi{} can and can't
-do, and why this is so.
-
-
-@node Tutorial-Abstraction, Tutorial-Lisp easy_setopt, Tutorial-easy_setopt, Tutorial
-@section Breaking the abstraction
-
-@cindex breaking the abstraction
-@cindex abstraction breaking
-In @ref{Tutorial-Comparison,, What makes Lisp different}, we mentioned
-that writing an @acronym{FFI} sometimes requires depending on
-information not provided as part of the interface. The easy option
-@code{CURLOPT_WRITEDATA}, which we will not provide as part of the
-Lisp interface, illustrates this issue.
-
-Strictly speaking, the @code{curl-option} enumeration is not
-necessary; we could have used @code{:int 99} instead of
-@code{curl-option :nosignal} in our call to @code{curl_easy_setopt}
-above. We defined it anyway, in part to hide the fact that we are
-breaking the abstraction that the C @code{enum} provides. If the
-c@acronym{URL} developers decide to change those numbers later, we
-must change the Lisp enumeration, because enumeration values are not
-provided in the compiled C library, @code{libcurl.so.3}.
-
-@cffi{} works because the most useful things in C libraries ---
-non-static functions and non-static variables --- are included
-accessibly in @code{libcurl.so.3}. A C compiler that violated this
-would be considered a worthless compiler.
-
-The other thing @code{define-curl-options} does is give the ``type''
-of the third argument passed to @code{curl_easy_setopt}. Using this
-information, we can tell that the @code{:nosignal} option should
-accept a long integer argument. We can implicitly assume @code{t}
-@equiv{} 1 and @code{nil} @equiv{} 0, as it is in C, which takes care
-of the fact that @code{CURLOPT_NOSIGNAL} is really asking for a
-boolean.
-
-The ``type'' of @code{CURLOPT_WRITEDATA} is @code{objectpoint}.
-However, it is really looking for a @code{FILE*}.
-@code{CURLOPT_ERRORBUFFER} is looking for a @code{char*}, so there is
-no obvious @cffi{} type but @code{:pointer}.
-
-The first thing to note is that nowhere in the C interface includes
-this information; it can only be found in the manual. We could
-disjoin these clearly different types ourselves, by splitting
-@code{objectpoint} into @code{filepoint} and @code{charpoint}, but we
-are still breaking the abstraction, because we have to augment the
-entire enumeration form with this additional
-information.@footnote{Another possibility is to allow the caller to
-specify the desired C type of the third argument. This is essentially
-what happens in a call to the function written in C.}
-
-@cindex streams and C
-@cindex @sc{file}* and streams
-The second is that the @code{CURLOPT_WRITEDATA} argument is completely
-incompatible with the desired Lisp data, a
-stream.@footnote{@xref{Other Kinds of Streams,,, libc, GNU C Library
-Reference}, for a @acronym{GNU}-only way to extend the @code{FILE*}
-type. You could use this to convert Lisp streams to the needed C
-data. This would be quite involved and far outside the scope of this
-tutorial.} It is probably acceptable if we are controlling every file
-we might want to use as this argument, in which case we can just call
-the foreign function @code{fopen}. Regardless, though, we can't write
-to arbitrary streams, which is exactly what we want to do for this
-application.
-
-Finally, note that the @code{curl_easy_setopt} interface itself is a
-hack, intended to work around some of the drawbacks of C. The
-definition of @code{Curl_setopt}, while long, is far less cluttered
-than the equivalent disjoint-function set would be; in addition,
-setting a new option in an old @code{libcurl} can generate a run-time
-error rather than breaking the compile. Lisp can just as concisely
-generate functions as compare values, and the ``undefined function''
-error is just as useful as any explicit error we could define here
-might be.
-
-
-@node Tutorial-Lisp easy_setopt, Tutorial-Memory, Tutorial-Abstraction, Tutorial
-@section Option functions in Lisp
-
-We could use @code{foreign-funcall} directly every time we wanted to
-call @code{curl_easy_setopt}. However, we can encapsulate some of the
-necessary information with the following.
-
-@lisp
-;;; @lispcmt{We will use this type later in a more creative way. For}
-;;; @lispcmt{now, just consider it a marker that this isn't just any}
-;;; @lispcmt{pointer.}
-(defctype easy-handle :pointer)
-
-(defmacro curl-easy-setopt (easy-handle enumerated-name
- value-type new-value)
- "Call `curl_easy_setopt' on EASY-HANDLE, using ENUMERATED-NAME
-as the OPTION. VALUE-TYPE is the CFFI foreign type of the third
-argument, and NEW-VALUE is the Lisp data to be translated to the
-third argument. VALUE-TYPE is not evaluated."
- `(foreign-funcall "curl_easy_setopt" easy-handle ,easy-handle
- curl-option ,enumerated-name
- ,value-type ,new-value curl-code))
-@end lisp
-
-Now we define a function for each kind of argument that encodes the
-correct @code{value-type} in the above. This can be done reasonably
-in the @code{define-curl-options} macroexpansion; after all, that is
-where the different options are listed!
-
-@cindex Lispy C functions
-We could make @code{cl:defun} forms in the expansion that simply call
-@code{curl-easy-setopt}; however, it is probably easier and clearer to
-use @code{defcfun}. @code{define-curl-options} was becoming unwieldy,
-so I defined some helpers in this new definition.
-
-@smalllisp
-(defun curry-curl-option-setter (function-name option-keyword)
- "Wrap the function named by FUNCTION-NAME with a version that
-curries the second argument as OPTION-KEYWORD.
-
-This function is intended for use in DEFINE-CURL-OPTION-SETTER."
- (setf (symbol-function function-name)
- (let ((c-function (symbol-function function-name)))
- (lambda (easy-handle new-value)
- (funcall c-function easy-handle option-keyword
- new-value)))))
-
-(defmacro define-curl-option-setter (name option-type
- option-value foreign-type)
- "Define (with DEFCFUN) a function NAME that calls
-curl_easy_setopt. OPTION-TYPE and OPTION-VALUE are the CFFI
-foreign type and value to be passed as the second argument to
-easy_setopt, and FOREIGN-TYPE is the CFFI foreign type to be used
-for the resultant function's third argument.
-
-This macro is intended for use in DEFINE-CURL-OPTIONS."
- `(progn
- (defcfun ("curl_easy_setopt" ,name) curl-code
- (easy-handle easy-handle)
- (option ,option-type)
- (new-value ,foreign-type))
- (curry-curl-option-setter ',name ',option-value)))
-
-(defmacro define-curl-options (type-name type-offsets &rest enum-args)
- "As with CFFI:DEFCENUM, except each of ENUM-ARGS is as follows:
-
- (NAME TYPE NUMBER)
-
-Where the arguments are as they are with the CINIT macro defined
-in curl.h, except NAME is a keyword.
-
-TYPE-OFFSETS is a plist of TYPEs to their integer offsets, as
-defined by the CURLOPTTYPE_LONG et al constants in curl.h.
-
-Also, define functions for each option named
-set-`TYPE-NAME'-`OPTION-NAME', where OPTION-NAME is the NAME from
-the above destructuring."
- (flet ((enumerated-value (type offset)
- (+ (getf type-offsets type) offset))
- ;; @lispcmt{map PROCEDURE, destructuring each of ENUM-ARGS}
- (map-enum-args (procedure)
- (mapcar (lambda (arg) (apply procedure arg)) enum-args))
- ;; @lispcmt{build a name like SET-CURL-OPTION-NOSIGNAL}
- (make-setter-name (option-name)
- (intern (concatenate
- 'string "SET-" (symbol-name type-name)
- "-" (symbol-name option-name)))))
- `(progn
- (defcenum ,type-name
- ,@@(map-enum-args
- (lambda (name type number)
- (list name (enumerated-value type number)))))
- ,@@(map-enum-args
- (lambda (name type number)
- (declare (ignore number))
- `(define-curl-option-setter ,(make-setter-name name)
- ,type-name ,name ,(ecase type
- (long :long)
- (objectpoint :pointer)
- (functionpoint :pointer)
- (off-t :long)))))
- ',type-name)))
-@end smalllisp
-
-@noindent
-Macroexpanding our @code{define-curl-options} form once more, we
-see something different:
-
-@lisp
-(progn
- (defcenum curl-option
- (:noprogress 43)
- (:nosignal 99)
- (:errorbuffer 10010)
- (:url 10002))
- (define-curl-option-setter set-curl-option-noprogress
- curl-option :noprogress :long)
- (define-curl-option-setter set-curl-option-nosignal
- curl-option :nosignal :long)
- (define-curl-option-setter set-curl-option-errorbuffer
- curl-option :errorbuffer :pointer)
- (define-curl-option-setter set-curl-option-url
- curl-option :url :pointer)
- 'curl-option)
-@end lisp
-
-@noindent
-Macroexpanding one of the new @code{define-curl-option-setter}
-forms yields the following:
-
-@lisp
-(progn
- (defcfun ("curl_easy_setopt" set-curl-option-nosignal) curl-code
- (easy-handle easy-handle)
- (option curl-option)
- (new-value :long))
- (curry-curl-option-setter 'set-curl-option-nosignal ':nosignal))
-@end lisp
-
-@noindent
-Finally, let's try this out:
-
-@example
-@sc{cffi-user>} (set-curl-option-nosignal *easy-handle* 1)
-@result{} 0
-@end example
-
-@noindent
-Looks like it works just as well. This interface is now reasonably
-high-level to wash out some of the ugliness of the thinnest possible
-@code{curl_easy_setopt} @acronym{FFI}, without obscuring the remaining
-C bookkeeping details we will explore.
-
-
-@node Tutorial-Memory, Tutorial-Callbacks, Tutorial-Lisp easy_setopt, Tutorial
-@section Memory management
-
-According to the documentation for @code{curl_easy_setopt}, the type
-of the third argument when @var{option} is @code{CURLOPT_ERRORBUFFER}
-is @code{char*}. Above, we've defined
-@code{set-curl-option-errorbuffer} to accept a @code{:pointer} as the
-new option value. However, there is a @cffi{} type @code{:string},
-which translates Lisp strings to C strings when passed as arguments to
-foreign function calls. Why not, then, use @code{:string} as the
-@cffi{} type of the third argument? There are two reasons, both
-related to the necessity of breaking abstraction described in
-@ref{Tutorial-Abstraction,, Breaking the abstraction}.
-
-The first reason also applies to @code{CURLOPT_URL}, which we will use
-to illustrate the point. Assuming we have changed the type of the
-third argument underlying @code{set-curl-option-url} to
-@code{:string}, look at these two equivalent forms.
-
-@lisp
-(set-curl-option-url *easy-handle* "http://www.cliki.net/CFFI")
-
-@equiv{} (with-foreign-string (url "http://www.cliki.net/CFFI")
- (foreign-funcall "curl_easy_setopt" easy-handle *easy-handle*
- curl-option :url :pointer url curl-code))
-@end lisp
-
-@noindent
-The latter, in fact, is mostly equivalent to what a foreign function
-call's macroexpansion actually does. As you can see, the Lisp string
-@code{"@clikicffi{}"} is copied into a @code{char} array and
-null-terminated; the pointer to beginning of this array, now a C
-string, is passed as a @cffi{} @code{:pointer} to the foreign
-function.
-
-@cindex dynamic extent
-@cindex foreign values with dynamic extent
-Unfortunately, the C abstraction has failed us, and we must break it.
-While @code{:string} works well for many @code{char*} arguments, it
-does not for cases like this. As the @code{curl_easy_setopt}
-documentation explains, ``The string must remain present until curl no
-longer needs it, as it doesn't copy the string.'' The C string
-created by @code{with-foreign-string}, however, only has dynamic
-extent: it is ``deallocated'' when the body (above containing the
-@code{foreign-funcall} form) exits.
-
-@cindex premature deallocation
-If we are supposed to keep the C string around, but it goes away, what
-happens when some @code{libcurl} function tries to access the
-@acronym{URL} string? We have reentered the dreaded world of C
-``undefined behavior''. In some Lisps, it will probably get a chunk
-of the Lisp/C stack. You may segfault. You may get some random piece
-of other data from the heap. Maybe, in a world where ``dynamic
-extent'' is defined to be ``infinite extent'', everything will turn
-out fine. Regardless, results are likely to be almost universally
-unpleasant.@footnote{``@i{But I thought Lisp was supposed to protect
-me from all that buggy C crap!}'' Before asking a question like that,
-remember that you are a stranger in a foreign land, whose residents
-have a completely different set of values.}
-
-Returning to the current @code{set-curl-option-url} interface, here is
-what we must do:
-
-@lisp
-(let (easy-handle)
- (unwind-protect
- (with-foreign-string (url "http://www.cliki.net/CFFI")
- (setf easy-handle (curl-easy-init))
- (set-curl-option-url easy-handle url)
- #|@lispcmt{do more with the easy-handle, like actually get the URL}|#)
- (when easy-handle
- (curl-easy-cleanup easy-handle))))
-@end lisp
-
-@c old comment to luis: I go on to say that this isn't obviously
-@c extensible to new option settings that require C strings to stick
-@c around, as it would involve re-evaluating the unwind-protect form
-@c with more dynamic memory allocation. So I plan to show how to
-@c write something similar to ObjC's NSAutoreleasePool, to be managed
-@c with a simple unwind-protect form.
-
-@noindent
-That is fine for the single string defined here, but for every string
-option we want to pass, we have to surround the body of
-@code{with-foreign-string} with another @code{with-foreign-string}
-wrapper, or else do some extremely error-prone pointer manipulation
-and size calculation in advance. We could alleviate some of the pain
-with a recursively expanding macro, but this would not remove the need
-to modify the block every time we want to add an option, anathema as
-it is to a modular interface.
-
-Before modifying the code to account for this case, consider the other
-reason we can't simply use @code{:string} as the foreign type. In C,
-a @code{char *} is a @code{char *}, not necessarily a string. The
-option @code{CURLOPT_ERRORBUFFER} accepts a @code{char *}, but does
-not expect anything about the data there. However, it does expect
-that some @code{libcurl} function we call later can write a C string
-of up to 255 characters there. We, the callers of the function, are
-expected to read the C string at a later time, exactly the opposite of
-what @code{:string} implies.
-
-With the semantics for an input string in mind --- namely, that the
-string should be kept around until we @code{curl_easy_cleanup} the
-easy handle --- we are ready to extend the Lisp interface:
-
-@lisp
-(defvar *easy-handle-cstrings* (make-hash-table)
- "Hashtable of easy handles to lists of C strings that may be
-safely freed after the handle is freed.")
-
-(defun make-easy-handle ()
- "Answer a new CURL easy interface handle, to which the lifetime
-of C strings may be tied. See `add-curl-handle-cstring'."
- (let ((easy-handle (curl-easy-init)))
- (setf (gethash easy-handle *easy-handle-cstrings*) '())
- easy-handle))
-
-(defun free-easy-handle (handle)
- "Free CURL easy interface HANDLE and any C strings created to
-be its options."
- (curl-easy-cleanup handle)
- (mapc #'foreign-string-free
- (gethash handle *easy-handle-cstrings*))
- (remhash handle *easy-handle-cstrings*))
-
-(defun add-curl-handle-cstring (handle cstring)
- "Add CSTRING to be freed when HANDLE is, answering CSTRING."
- (car (push cstring (gethash handle *easy-handle-cstrings*))))
-@end lisp
-
-@noindent
-Here we have redefined the interface to create and free handles, to
-associate a list of allocated C strings with each handle while it
-exists. The strategy of using different function names to wrap around
-simple foreign functions is more common than the solution implemented
-earlier with @code{curry-curl-option-setter}, which was to modify the
-function name's function slot.@footnote{There are advantages and
-disadvantages to each approach; I chose to @code{(setf
-symbol-function)} earlier because it entailed generating fewer magic
-function names.}
-
-Incidentally, the next step is to redefine
-@code{curry-curl-option-setter} to allocate C strings for the
-appropriate length of time, given a Lisp string as the
-@code{new-value} argument:
-
-@lisp
-(defun curry-curl-option-setter (function-name option-keyword)
- "Wrap the function named by FUNCTION-NAME with a version that
-curries the second argument as OPTION-KEYWORD.
-
-This function is intended for use in DEFINE-CURL-OPTION-SETTER."
- (setf (symbol-function function-name)
- (let ((c-function (symbol-function function-name)))
- (lambda (easy-handle new-value)
- (funcall c-function easy-handle option-keyword
- (if (stringp new-value)
- (add-curl-handle-cstring
- easy-handle
- (foreign-string-alloc new-value))
- new-value))))))
-@end lisp
-
-@noindent
-A quick analysis of the code shows that you need only reevaluate the
-@code{curl-option} enumeration definition to take advantage of these
-new semantics. Now, for good measure, let's reallocate the handle
-with the new functions we just defined, and set its @acronym{URL}:
-
-@example
-@sc{cffi-user>} (curl-easy-cleanup *easy-handle*)
-@result{} NIL
-@sc{cffi-user>} (setf *easy-handle* (make-easy-handle))
-@result{} #<FOREIGN-ADDRESS #x09844EE0>
-@sc{cffi-user>} (set-curl-option-nosignal *easy-handle* 1)
-@result{} 0
-@sc{cffi-user>} (set-curl-option-url *easy-handle*
- "http://www.cliki.net/CFFI")
-@result{} 0
-@end example
-
-@cindex strings
-For fun, let's inspect the Lisp value of the C string that was created
-to hold @code{"@clikicffi{}"}. By virtue of the implementation of
-@code{add-curl-handle-cstring}, it should be accessible through the
-hash table defined:
-
-@example
-@sc{cffi-user>} (foreign-string-to-lisp
- (car (gethash *easy-handle* *easy-handle-cstrings*)))
-@result{} "http://www.cliki.net/CFFI"
-@end example
-
-@noindent
-Looks like that worked, and @code{libcurl} now knows what
-@acronym{URL} we want to retrieve.
-
-Finally, we turn back to the @code{:errorbuffer} option mentioned at
-the beginning of this section. Whereas the abstraction added to
-support string inputs works fine for cases like @code{CURLOPT_URL}, it
-hides the detail of keeping the C string; for @code{:errorbuffer},
-however, we need that C string.
-
-In a moment, we'll define something slightly cleaner, but for now,
-remember that you can always hack around anything. We're modifying
-handle creation, so make sure you free the old handle before
-redefining @code{free-easy-handle}.
-
-@smalllisp
-(defvar *easy-handle-errorbuffers* (make-hash-table)
- "Hashtable of easy handles to C strings serving as error
-writeback buffers.")
-
-;;; @lispcmt{An extra byte is very little to pay for peace of mind.}
-(defparameter *curl-error-size* 257
- "Minimum char[] size used by cURL to report errors.")
-
-(defun make-easy-handle ()
- "Answer a new CURL easy interface handle, to which the lifetime
-of C strings may be tied. See `add-curl-handle-cstring'."
- (let ((easy-handle (curl-easy-init)))
- (setf (gethash easy-handle *easy-handle-cstrings*) '())
- (setf (gethash easy-handle *easy-handle-errorbuffers*)
- (foreign-alloc :char :count *curl-error-size*
- :initial-element 0))
- easy-handle))
-
-(defun free-easy-handle (handle)
- "Free CURL easy interface HANDLE and any C strings created to
-be its options."
- (curl-easy-cleanup handle)
- (foreign-free (gethash handle *easy-handle-errorbuffers*))
- (remhash handle *easy-handle-errorbuffers*)
- (mapc #'foreign-string-free
- (gethash handle *easy-handle-cstrings*))
- (remhash handle *easy-handle-cstrings*))
-
-(defun get-easy-handle-error (handle)
- "Answer a string containing HANDLE's current error message."
- (foreign-string-to-lisp
- (gethash handle *easy-handle-errorbuffers*)))
-@end smalllisp
-
-Be sure to once again set the options we've set thus far. You may
-wish to define yet another wrapper function to do this.
-
-
-@node Tutorial-Callbacks, Tutorial-Completion, Tutorial-Memory, Tutorial
-@section Calling Lisp from C
-
-If you have been reading
-@uref{http://curl.haxx.se/libcurl/c/curl_easy_setopt.html,,
-@code{curl_easy_setopt(3)}}, you should have noticed that some options
-accept a function pointer. In particular, we need one function
-pointer to set as @code{CURLOPT_WRITEFUNCTION}, to be called by
-@code{libcurl} rather than the reverse, in order to receive data as it
-is downloaded.
-
-A binding writer without the aid of @acronym{FFI} usually approaches
-this problem by writing a C function that accepts C data, converts to
-the language's internal objects, and calls the callback provided by
-the user, again in a reverse of usual practices.
-
-The @cffi{} approach to callbacks precisely mirrors its differences
-with the non-@acronym{FFI} approach on the ``calling C from Lisp''
-side, which we have dealt with exclusively up to now. That is, you
-define a callback function in Lisp using @code{defcallback}, and
-@cffi{} effectively creates a C function to be passed as a function
-pointer.
-
-@impnote{This is much trickier than calling C functions from Lisp, as
-it literally involves somehow generating a new C function that is as
-good as any created by the compiler. Therefore, not all Lisps support
-them. @xref{Implementation Support}, for information about @cffi{}
-support issues in this and other areas. You may want to consider
-changing to a Lisp that supports callbacks in order to continue with
-this tutorial.}
-
-@cindex callback definition
-@cindex defining callbacks
-Defining a callback is very similar to defining a callout; the main
-difference is that we must provide some Lisp forms to be evaluated as
-part of the callback. Here is the signature for the function the
-@code{:writefunction} option takes:
-
-@example
-size_t
-@var{function}(void *ptr, size_t size, size_t nmemb, void *stream);
-@end example
-
-@impnote{size_t is almost always an unsigned int. You can get this
-and many other types using feature tests for your system by using
-cffi-grovel.}
-
-The above signature trivially translates into a @cffi{}
-@code{defcallback} form, as follows.
-
-@lisp
-;;; @lispcmt{Alias in case size_t changes.}
-(defctype size :unsigned-int)
-
-;;; @lispcmt{To be set as the CURLOPT_WRITEFUNCTION of every easy handle.}
-(defcallback easy-write size ((ptr :pointer) (size size)
- (nmemb size) (stream :pointer))
- (let ((data-size (* size nmemb)))
- (handler-case
- ;; @lispcmt{We use the dynamically-bound *easy-write-procedure* to}
- ;; @lispcmt{call a closure with useful lexical context.}
- (progn (funcall (symbol-value '*easy-write-procedure*)
- (foreign-string-to-lisp ptr :count data-size))
- data-size) ;@lispcmt{indicates success}
- ;; @lispcmt{The WRITEFUNCTION should return something other than the}
- ;; @lispcmt{#bytes available to signal an error.}
- (error () (if (zerop data-size) 1 0)))))
-@end lisp
-
-First, note the correlation of the first few forms, used to declare
-the C function's signature, with the signature in C syntax. We
-provide a Lisp name for the function, its return type, and a name and
-type for each argument.
-
-In the body, we call the dynamically-bound
-@code{*easy-write-procedure*} with a ``finished'' translation, of
-pulling together the raw data and size into a Lisp string, rather than
-deal with the data directly. As part of calling
-@code{curl_easy_perform} later, we'll bind that variable to a closure
-with more useful lexical bindings than the top-level
-@code{defcallback} form.
-
-Finally, we make a halfhearted effort to prevent non-local exits from
-unwinding the C stack, covering the most likely case with an
-@code{error} handler, which is usually triggered
-unexpectedly.@footnote{Unfortunately, we can't protect against
-@emph{all} non-local exits, such as @code{return}s and @code{throw}s,
-because @code{unwind-protect} cannot be used to ``short-circuit'' a
-non-local exit in Common Lisp, due to proposal @code{minimal} in
-@uref{http://www.lisp.org/HyperSpec/Issues/iss152-writeup.html,
-@acronym{ANSI} issue @sc{Exit-Extent}}. Furthermore, binding an
-@code{error} handler prevents higher-up code from invoking restarts
-that may be provided under the callback's dynamic context. Such is
-the way of compromise.} The reason is that most C code is written to
-understand its own idiosyncratic error condition, implemented above in
-the case of @code{curl_easy_perform}, and more ``undefined behavior''
-can result if we just wipe C stack frames without allowing them to
-execute whatever cleanup actions as they like.
-
-Using the @code{CURLoption} enumeration in @file{curl.h} once more, we
-can describe the new option by modifying and reevaluating
-@code{define-curl-options}.
-
-@lisp
-(define-curl-options curl-option
- (long 0 objectpoint 10000 functionpoint 20000 off-t 30000)
- (:noprogress long 43)
- (:nosignal long 99)
- (:errorbuffer objectpoint 10)
- (:url objectpoint 2)
- (:writefunction functionpoint 11)) ;@lispcmt{new item here}
-@end lisp
-
-Finally, we can use the defined callback and the new
-@code{set-curl-option-writefunction} to finish configuring the easy
-handle, using the @code{callback} macro to retrieve a @cffi{}
-@code{:pointer}, which works like a function pointer in C code.
-
-@example
-@sc{cffi-user>} (set-curl-option-writefunction
- *easy-handle* (callback easy-write))
-@result{} 0
-@end example
-
-
-@node Tutorial-Completion, Tutorial-Types, Tutorial-Callbacks, Tutorial
-@section A complete @acronym{FFI}?
-
-@c TeX goes insane on @uref{@clikicffi{}}
-
-With all options finally set and a medium-level interface developed,
-we can finish the definition and retrieve
-@uref{http://www.cliki.net/CFFI}, as is done in the tutorial.
-
-@lisp
-(defcfun "curl_easy_perform" curl-code
- (handle easy-handle))
-@end lisp
-
-@example
-@sc{cffi-user>} (with-output-to-string (contents)
- (let ((*easy-write-procedure*
- (lambda (string)
- (write-string string contents))))
- (declare (special *easy-write-procedure*))
- (curl-easy-perform *easy-handle*)))
-@result{} "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01//EN\"
-@enddots{}
-Now fear, comprehensively</P>
-"
-@end example
-
-Of course, that itself is slightly unwieldy, so you may want to define
-a function around it that simply retrieves a @acronym{URL}. I will
-leave synthesis of all the relevant @acronym{REPL} forms presented
-thus far into a single function as an exercise for the reader.
-
-The remaining sections of this tutorial explore some advanced features
-of @cffi{}; the definition of new types will receive special
-attention. Some of these features are essential for particular
-foreign function calls; some are very helpful when trying to develop a
-Lispy interface to C.
-
-
-@node Tutorial-Types, Tutorial-Conclusion, Tutorial-Completion, Tutorial
-@section Defining new types
-
-We've occasionally used the @code{defctype} macro in previous sections
-as a kind of documentation, much what you'd use @code{typedef} for in
-C. We also tried one special kind of type definition, the
-@code{defcenum} type. @xref{defcstruct}, for a definition macro that
-may come in handy if you need to use C @code{struct}s as data.
-
-@cindex type definition
-@cindex data in Lisp and C
-@cindex translating types
-However, all of these are mostly sugar for the powerful underlying
-foreign type interface called @dfn{type translators}. You can easily
-define new translators for any simple named foreign type. Since we've
-defined the new type @code{curl-code} to use as the return type for
-various @code{libcurl} functions, we can use that to directly convert
-c@acronym{URL} errors to Lisp errors.
-
-@code{defctype}'s purpose is to define simple @code{typedef}-like
-aliases. In order to use @dfn{type translators} we must use the
-@code{define-foreign-type} macro. So let's redefine @code{curl-code}
-using it.
-
-@lisp
-(define-foreign-type curl-code-type ()
- ()
- (:actual-type :int)
- (:simple-parser curl-code))
-@end lisp
-
-@code{define-foreign-type} is a thin wrapper around @code{defclass}.
-For now, all you need to know in the context of this example is that
-it does what @code{(defctype curl-code :int)} would do and,
-additionally, defines a new class @code{curl-code-type} which we will
-take advantage of shortly.
-
-The @code{CURLcode} enumeration seems to follow the typical error code
-convention of @samp{0} meaning all is well, and each non-zero integer
-indicating a different kind of error. We can apply that trivially to
-differentiate between normal exits and error exits.
-
-@lisp
-(define-condition curl-code-error (error)
- (($code :initarg :curl-code :reader curl-error-code))
- (:report (lambda (c stream)
- (format stream "libcurl function returned error ~A"
- (curl-error-code c))))
- (:documentation "Signalled when a libcurl function answers
-a code other than CURLE_OK."))
-
-(defmethod translate-from-foreign (value (type curl-code-type))
- "Raise a CURL-CODE-ERROR if VALUE, a curl-code, is non-zero."
- (if (zerop value)
- :curle-ok
- (error 'curl-code-error :curl-code value)))
-@end lisp
-
-@noindent
-The heart of this translator is new method
-@code{translate-from-foreign}. By specializing the @var{type}
-parameter on @code{curl-code-type}, we immediately modify the behavior
-of every function that returns a @code{curl-code} to pass the result
-through this new method.
-
-To see the translator in action, try invoking a function that returns
-a @code{curl-code}. You need to reevaluate the respective
-@code{defcfun} form so that it picks up the new @code{curl-code}
-definition.
-
-@example
-@sc{cffi-user>} (set-curl-option-nosignal *easy-handle* 1)
-@result{} :CURLE-OK
-@end example
-
-@noindent
-As the result was @samp{0}, the new method returned @code{:curle-ok},
-just as specified.@footnote{It might be better to return
-@code{(values)} than @code{:curle-ok} in real code, but this is good
-for illustration.} I will leave disjoining the separate
-@code{CURLcode}s into condition types and improving the @code{:report}
-function as an exercise for you.
-
-The creation of @code{*easy-handle-cstrings*} and
-@code{*easy-handle-errorbuffers*} as properties of @code{easy-handle}s
-is a kluge. What we really want is a Lisp structure that stores these
-properties along with the C pointer. Unfortunately,
-@code{easy-handle} is currently just a fancy name for the foreign type
-@code{:pointer}; the actual pointer object varies from Common Lisp
-implementation to implementation, needing only to satisfy
-@code{pointerp} and be returned from @code{make-pointer} and friends.
-
-One solution that would allow us to define a new Lisp structure to
-represent @code{easy-handle}s would be to write a wrapper around every
-function that currently takes an @code{easy-handle}; the wrapper would
-extract the pointer and pass it to the foreign function. However, we
-can use type translators to more elegantly integrate this
-``translation'' into the foreign function calling framework, using
-@code{translate-to-foreign}.
-
-@smalllisp
-(defclass easy-handle ()
- ((pointer :initform (curl-easy-init)
- :documentation "Foreign pointer from curl_easy_init")
- (error-buffer
- :initform (foreign-alloc :char :count *curl-error-size*
- :initial-element 0)
- :documentation "C string describing last error")
- (c-strings :initform '()
- :documentation "C strings set as options"))
- (:documentation "I am a parameterization you may pass to
-curl-easy-perform to perform a cURL network protocol request."))
-
-(defmethod initialize-instance :after ((self easy-handle) &key)
- (set-curl-option-errorbuffer self (slot-value self 'error-buffer)))
-
-(defun add-curl-handle-cstring (handle cstring)
- "Add CSTRING to be freed when HANDLE is, answering CSTRING."
- (car (push cstring (slot-value handle 'c-strings))))
-
-(defun get-easy-handle-error (handle)
- "Answer a string containing HANDLE's current error message."
- (foreign-string-to-lisp
- (slot-value handle 'error-buffer)))
-
-(defun free-easy-handle (handle)
- "Free CURL easy interface HANDLE and any C strings created to
-be its options."
- (with-slots (pointer error-buffer c-strings) handle
- (curl-easy-cleanup pointer)
- (foreign-free error-buffer)
- (mapc #'foreign-string-free c-strings)))
-
-(define-foreign-type easy-handle-type ()
- ()
- (:actual-type :pointer)
- (:simple-parser easy-handle))
-
-(defmethod translate-to-foreign (handle (type easy-handle-type))
- "Extract the pointer from an easy-HANDLE."
- (slot-value handle 'pointer))
-@end smalllisp
-
-While we changed some of the Lisp functions defined earlier to use
-@acronym{CLOS} slots rather than hash tables, the foreign functions
-work just as well as they did before.
-
-@cindex limitations of type translators
-The greatest strength, and the greatest limitation, of the type
-translator comes from its generalized interface. As stated
-previously, we could define all foreign function calls in terms of the
-primitive foreign types provided by @cffi{}. The type translator
-interface allows us to cleanly specify the relationship between Lisp
-and C data, independent of where it appears in a function call. This
-independence comes at a price; for example, it cannot be used to
-modify translation semantics based on other arguments to a function
-call. In these cases, you should rely on other features of Lisp,
-rather than the powerful, yet domain-specific, type translator
-interface.
-
-
-@node Tutorial-Conclusion, , Tutorial-Types, Tutorial
-@section What's next?
-
-@cffi{} provides a rich and powerful foundation for communicating with
-foreign libraries; as we have seen, it is up to you to make that
-experience a pleasantly Lispy one. This tutorial does not cover all
-the features of @cffi{}; please see the rest of the manual for
-details. In particular, if something seems obviously missing, it is
-likely that either code or a good reason for lack of code is already
-present.
-
-@impnote{There are some other things in @cffi{} that might deserve
-tutorial sections, such as free-translated-object, or structs. Let us
-know which ones you care about.}
-
-
-@c ===================================================================
-@c CHAPTER: Wrapper generators
-
-@node Wrapper generators, Foreign Types, Tutorial, Top
-@chapter Wrapper generators
-
-@cffi{}'s interface is designed for human programmers, being aimed at
-aesthetic as well as technical sophistication. However, there are a
-few programs aimed at translating C and C++ header files, or
-approximations thereof, into @cffi{} forms constituting a foreign
-interface to the symbols in those files.
-
-These wrapper generators are known to support output of @cffi{} forms.
-
-@table @asis
-@item @uref{http://www.cliki.net/Verrazano,Verrazano}
-Designed specifically for Common Lisp. Uses @acronym{GCC}'s parser
-output in @acronym{XML} format to discover functions, variables, and
-other header file data. This means you need @acronym{GCC} to generate
-forms; on the other hand, the parser employed is mostly compliant with
-@acronym{ANSI} C.
-
-@item @uref{http://www.cliki.net/SWIG,SWIG}
-A foreign interface generator originally designed to generate Python
-bindings, it has been ported to many other systems, including @cffi{}
-in version 1.3.28. Includes its own C declaration munger, not
-intended to be fully-compliant with @acronym{ANSI} C.
-@end table
-
-First, this manual does not describe use of these other programs; they
-have documentation of their own. If you have problems using a
-generated interface, please look at the output @cffi{} forms and
-verify that they are a correct @cffi{} interface to the library in
-question; if they are correct, contact @cffi{} developers with
-details, keeping in mind that they communicate in terms of those forms
-rather than any particular wrapper generator. Otherwise, contact the
-maintainers of the wrapper generator you are using, provided you can
-reasonably expect more accuracy from the generator.
-
-When is more accuracy an unreasonable expectation? As described in
-the tutorial (@pxref{Tutorial-Abstraction,, Breaking the
-abstraction}), the information in C declarations is insufficient to
-completely describe every interface. In fact, it is quite common to
-run into an interface that cannot be handled automatically, and
-generators should be excused from generating a complete interface in
-these cases.
-
-As further described in the tutorial, the thinnest Lisp interface to a
-C function is not always the most pleasant one. In many cases, you
-will want to manually write a Lispier interface to the C functions
-that interest you.
-
-Wrapper generators should be treated as time-savers, not complete
-automation of the full foreign interface writing job. Reports of the
-amount of work done by generators vary from 30% to 90%. The
-incremental development style enabled by @cffi{} generally reduces
-this proportion below that for languages like Python.
-
-@c Where I got the above 30-90% figures:
-@c 30%: lemonodor's post about SWIG
-@c 90%: Balooga on #lisp. He said 99%, but that's probably an
-@c exaggeration (leave it to me to pass judgement :)
-@c -stephen
-
-
-@c ===================================================================
-@c CHAPTER: Foreign Types
-
-@node Foreign Types, Pointers, Wrapper generators, Top
-@chapter Foreign Types
-
-Foreign types describe how data is translated back and forth between C
-and Lisp. @cffi{} provides various built-in types and allows the user to
-define new types.
-
-@menu
-* Built-In Types::
-* Other Types::
-* Defining Foreign Types::
-* Foreign Type Translators::
-* Optimizing Type Translators::
-* Foreign Structure Types::
-* Allocating Foreign Objects::
-
-Dictionary
-
-* convert-from-foreign::
-* convert-to-foreign::
-* defbitfield::
-* defcstruct::
-* defcunion::
-* defctype::
-* defcenum::
-@c * define-type-spec-parser::
-* define-foreign-type::
-* define-parse-method::
-@c * explain-foreign-slot-value:
-* foreign-bitfield-symbols::
-* foreign-bitfield-value::
-* foreign-enum-keyword::
-* foreign-enum-value::
-* foreign-slot-names::
-* foreign-slot-offset::
-* foreign-slot-pointer::
-* foreign-slot-value::
-* foreign-type-alignment::
-* foreign-type-size::
-* free-converted-object::
-* free-translated-object::
-* translate-from-foreign::
-* translate-to-foreign::
-* translate-into-foreign-memory::
-* with-foreign-slots::
-@end menu
-
-@node Built-In Types, Other Types, Foreign Types, Foreign Types
-@section Built-In Types
-
-@ForeignType{:char}
-@ForeignType{:unsigned-char}
-@ForeignType{:short}
-@ForeignType{:unsigned-short}
-@ForeignType{:int}
-@ForeignType{:unsigned-int}
-@ForeignType{:long}
-@ForeignType{:unsigned-long}
-@ForeignType{:long-long}
-@ForeignType{:unsigned-long-long}
-
-These types correspond to the native C integer types according to the
-@acronym{ABI} of the Lisp implementation's host system.
-
-@code{:long-long} and @code{:unsigned-long-long} are not supported
-natively on all implementations. However, they are emulated by
-@code{mem-ref} and @code{mem-set}.
-
-When those types are @strong{not} available, the symbol
-@code{cffi-sys::no-long-long} is pushed into @code{*features*}.
-
-@ForeignType{:uchar}
-@ForeignType{:ushort}
-@ForeignType{:uint}
-@ForeignType{:ulong}
-@ForeignType{:llong}
-@ForeignType{:ullong}
-
-For convenience, the above types are provided as shortcuts for
-@code{unsigned-char}, @code{unsigned-short}, @code{unsigned-int},
-@code{unsigned-long}, @code{long-long} and @code{unsigned-long-long},
-respectively.
-
-@ForeignType{:int8}
-@ForeignType{:uint8}
-@ForeignType{:int16}
-@ForeignType{:uint16}
-@ForeignType{:int32}
-@ForeignType{:uint32}
-@ForeignType{:int64}
-@ForeignType{:uint64}
-
-Foreign integer types of specific sizes, corresponding to the C types
-defined in @code{stdint.h}.
-
-@c @ForeignType{:size}
-@c @ForeignType{:ssize}
-@c @ForeignType{:ptrdiff}
-@c @ForeignType{:time}
-
-@c Foreign integer types corresponding to the standard C types (without
-@c the @code{_t} suffix).
-
-@c @impnote{These are not implemented yet. --luis}
-
-@c @impnote{I'm sure there are more of these that could be useful, let's
-@c add any types that can't be defined portably to this list as
-@c necessary. --james}
-
-@ForeignType{:float}
-@ForeignType{:double}
-
-On all systems, the @code{:float} and @code{:double} types represent a
-C @code{float} and @code{double}, respectively. On most but not all
-systems, @code{:float} and @code{:double} represent a Lisp
-@code{single-float} and @code{double-float}, respectively. It is not
-so useful to consider the relationship between Lisp types and C types
-as isomorphic, as simply to recognize the relationship, and relative
-precision, among each respective category.
-
-@ForeignType{:long-double}
-
-This type is only supported on SCL.
-
-@ForeignType{:pointer &optional type}
-
-A foreign pointer to an object of any type, corresponding to
-@code{void *}. You can optionally specify type of pointer
-(e.g. @code{(:pointer :char)}). Although @cffi{} won't do anything
-with that information yet, it is useful for documentation purposes.
-
-@ForeignType{:void}
-
-No type at all. Only valid as the return type of a function.
-
-@node Other Types, Defining Foreign Types, Built-In Types, Foreign Types
-@section Other Types
-
-@cffi{} also provides a few useful types that aren't built-in C
-types.
-
-@ForeignType{:string}
-
-The @code{:string} type performs automatic conversion between Lisp and
-C strings. Note that, in the case of functions the converted C string
-will have dynamic extent (i.e.@: it will be automatically freed after
-the foreign function returns).
-
-In addition to Lisp strings, this type will accept foreign pointers
-and pass them unmodified.
-
-A method for @ref{free-translated-object} is specialized for this
-type. So, for example, foreign strings allocated by this type and
-passed to a foreign function will be freed after the function
-returns.
-
-@lisp
-CFFI> (foreign-funcall "getenv" :string "SHELL" :string)
-@result{} "/bin/bash"
-
-CFFI> (with-foreign-string (str "abcdef")
- (foreign-funcall "strlen" :string str :int))
-@result{} 6
-@end lisp
-
-@ForeignType{:string+ptr}
-
-Like @code{:string} but returns a list with two values when convert
-from C to Lisp: a Lisp string and the C string's foreign pointer.
-
-@lisp
-CFFI> (foreign-funcall "getenv" :string "SHELL" :string+ptr)
-@result{} ("/bin/bash" #.(SB-SYS:INT-SAP #XBFFFFC6F))
-@end lisp
-
-@ForeignType{:boolean &optional (base-type :int)}
-
-The @code{:boolean} type converts between a Lisp boolean and a C
-boolean. It canonicalizes to @var{base-type} which is @code{:int} by
-default.
-
-@lisp
-(convert-to-foreign nil :boolean) @result{} 0
-(convert-to-foreign t :boolean) @result{} 1
-(convert-from-foreign 0 :boolean) @result{} nil
-(convert-from-foreign 1 :boolean) @result{} t
-@end lisp
-
-@ForeignType{:bool}
-
-The @code{:bool} type represents the C99 @code{_Bool} or C++
-@code{bool}. Its size is usually 1 byte except on OSX where it's an
-@code{int}.
-
-@ForeignType{:wrapper base-type &key to-c from-c}
-
-The @code{:wrapper} type stores two symbols passed to the @var{to-c}
-and @var{from-c} arguments. When a value is being translated to or
-from C, this type @code{funcall}s the respective symbol.
-
-@code{:wrapper} types will be typedefs for @var{base-type} and will
-inherit its translators, if any.
-
-Here's an example of how the @code{:boolean} type could be defined in
-terms of @code{:wrapper}.
-
-@lisp
-(defun bool-c-to-lisp (value)
- (not (zerop value)))
-
-(defun bool-lisp-to-c (value)
- (if value 1 0))
-
-(defctype my-bool (:wrapper :int :from-c bool-c-to-lisp
- :to-c bool-lisp-to-c))
-
-(convert-to-foreign nil 'my-bool) @result{} 0
-(convert-from-foreign 1 'my-bool) @result{} t
-@end lisp
-
-@node Defining Foreign Types, Foreign Type Translators, Other Types, Foreign Types
-@section Defining Foreign Types
-
-You can define simple C-like @code{typedef}s through the
-@code{defctype} macro. Defining a typedef is as simple as giving
-@code{defctype} a new name and the name of the type to be wrapped.
-
-@lisp
-;;; @lispcmt{Define MY-INT as an alias for the built-in type :INT.}
-(defctype my-int :int)
-@end lisp
-
-With this type definition, one can, for instance, declare arguments to
-foreign functions as having the type @code{my-int}, and they will be
-passed as integers.
-
-@subheading More complex types
-
-@cffi{} offers another way to define types through
-@code{define-foreign-type}, a thin wrapper macro around
-@code{defclass}. As an example, let's go through the steps needed to
-define a @code{(my-string &key encoding)} type. First, we need to
-define our type class:
-
-@lisp
-(define-foreign-type my-string-type ()
- ((encoding :reader string-type-encoding :initarg :encoding))
- (:actual-type :pointer))
-@end lisp
-
-The @code{:actual-type} class option tells CFFI that this type will
-ultimately be passed to and received from foreign code as a
-@code{:pointer}. Now you need to tell CFFI how to parse a type
-specification such as @code{(my-string :encoding :utf8)} into an
-instance of @code{my-string-type}. We do that with
-@code{define-parse-method}:
-
-@lisp
-(define-parse-method my-string (&key (encoding :utf-8))
- (make-instance 'my-string-type :encoding encoding))
-@end lisp
-
-The next section describes how make this type actually translate
-between C and Lisp strings.
-
-@node Foreign Type Translators, Optimizing Type Translators, Defining Foreign Types, Foreign Types
-@section Foreign Type Translators
-
-Type translators are used to automatically convert Lisp values to or
-from foreign values. For example, using type translators, one can
-take the @code{my-string} type defined in the previous section and
-specify that it should:
-
-@itemize
-@item
-convert C strings to Lisp strings;
-@item
-convert Lisp strings to newly allocated C strings;
-@item
-free said C strings when they are no longer needed.
-@end itemize
-
-In order to tell @cffi{} how to automatically convert Lisp values to
-foreign values, define a specialized method for the
-@code{translate-to-foreign} generic function:
-
-@lisp
-;;; @lispcmt{Define a method that converts Lisp strings to C strings.}
-(defmethod translate-to-foreign (string (type my-string-type))
- (foreign-string-alloc string :encoding (string-type-encoding type)))
-@end lisp
-
-@noindent
-From now on, whenever an object is passed as a @code{my-string} to a
-foreign function, this method will be invoked to convert the Lisp
-value. To perform the inverse operation, which is needed for functions
-that return a @code{my-string}, specialize the
-@code{translate-from-foreign} generic function in the same manner:
-
-@lisp
-;;; @lispcmt{Define a method that converts C strings to Lisp strings.}
-(defmethod translate-from-foreign (pointer (type my-string-type))
- (foreign-string-to-lisp pointer :encoding (string-type-encoding type)))
-@end lisp
-
-@noindent
-When a @code{translate-to-foreign} method requires allocation of
-foreign memory, you must also define a @code{free-translated-object}
-method to free the memory once the foreign object is no longer needed,
-otherwise you'll be faced with memory leaks. This generic function is
-called automatically by @cffi{} when passing objects to foreign
-functions. Let's do that:
-
-@lisp
-;;; @lispcmt{Free strings allocated by translate-to-foreign.}
-(defmethod free-translated-object (pointer (type my-string-type) param)
- (declare (ignore param))
- (foreign-string-free pointer))
-@end lisp
-
-@noindent
-In this specific example, we don't need the @var{param} argument, so
-we ignore it. See @ref{free-translated-object}, for an explanation of
-its purpose and how you can use it.
-
-A type translator does not necessarily need to convert the value. For
-example, one could define a typedef for @code{:pointer} that ensures,
-in the @code{translate-to-foreign} method, that the value is not a
-null pointer, signalling an error if a null pointer is passed. This
-would prevent some pointer errors when calling foreign functions that
-cannot handle null pointers.
-
-@strong{Please note:} these methods are meant as extensible hooks
-only, and you should not call them directly. Use
-@code{convert-to-foreign}, @code{convert-from-foreign} and
-@code{free-converted-object} instead.
-
-@xref{Tutorial-Types,, Defining new types}, for another example of
-type translators.
-
-@node Optimizing Type Translators, Foreign Structure Types, Foreign Type Translators, Foreign Types
-@section Optimizing Type Translators
-
-@cindex type translators, optimizing
-@cindex compiler macros for type translation
-@cindex defining type-translation compiler macros
-Being based on generic functions, the type translation mechanism
-described above can add a bit of overhead. This is usually not
-significant, but we nevertheless provide a way of getting rid of the
-overhead for the cases where it matters.
-
-A good way to understand this issue is to look at the code generated
-by @code{defcfun}. Consider the following example using the previously
-defined @code{my-string} type:
-
-@lisp
-CFFI> (macroexpand-1 '(defcfun foo my-string (x my-string)))
-;; @lispcmt{(simplified, downcased, etc...)}
-(defun foo (x)
- (multiple-value-bind (#:G2019 #:PARAM3149)
- (translate-to-foreign x #<MY-STRING-TYPE @{11ED5A79@}>)
- (unwind-protect
- (translate-from-foreign
- (foreign-funcall "foo" :pointer #:G2019 :pointer)
- #<MY-STRING-TYPE @{11ED5659@}>)
- (free-translated-object #:G2019 #<MY-STRING-TYPE @{11ED51A79@}>
- #:PARAM3149))))
-@end lisp
-
-@noindent
-In order to get rid of those generic function calls, @cffi{} has
-another set of extensible generic functions that provide functionality
-similar to @acronym{CL}'s compiler macros:
-@code{expand-to-foreign-dyn}, @code{expand-to-foreign} and
-@code{expand-from-foreign}. Here's how one could define a
-@code{my-boolean} with them:
-
-@lisp
-(define-foreign-type my-boolean-type ()
- ()
- (:actual-type :int)
- (:simple-parser my-boolean))
-
-(defmethod expand-to-foreign (value (type my-boolean-type))
- `(if ,value 1 0))
-
-(defmethod expand-from-foreign (value (type my-boolean-type))
- `(not (zerop ,value)))
-@end lisp
-
-@noindent
-And here's what the macroexpansion of a function using this type would
-look like:
-
-@lisp
-CFFI> (macroexpand-1 '(defcfun bar my-boolean (x my-boolean)))
-;; @lispcmt{(simplified, downcased, etc...)}
-(defun bar (x)
- (let ((#:g3182 (if x 1 0)))
- (not (zerop (foreign-funcall "bar" :int #:g3182 :int)))))
-@end lisp
-
-@noindent
-No generic function overhead.
-
-Let's go back to our @code{my-string} type. The expansion interface
-has no equivalent of @code{free-translated-object}; you must instead
-define a method on @code{expand-to-foreign-dyn}, the third generic
-function in this interface. This is especially useful when you can
-allocate something much more efficiently if you know the object has
-dynamic extent, as is the case with function calls that don't save the
-relevant allocated arguments.
-
-This exactly what we need for the @code{my-string} type:
-
-@lisp
-(defmethod expand-from-foreign (form (type my-string-type))
- `(foreign-string-to-lisp ,form))
-
-(defmethod expand-to-foreign-dyn (value var body (type my-string-type))
- (let ((encoding (string-type-encoding type)))
- `(with-foreign-string (,var ,value :encoding ',encoding)
- ,@@body)))
-@end lisp
-
-@noindent
-So let's look at the macro expansion:
-
-@lisp
-CFFI> (macroexpand-1 '(defcfun foo my-string (x my-string)))
-;; @lispcmt{(simplified, downcased, etc...)}
-(defun foo (x)
- (with-foreign-string (#:G2021 X :encoding ':utf-8)
- (foreign-string-to-lisp
- (foreign-funcall "foo" :pointer #:g2021 :pointer))))
-@end lisp
-
-@noindent
-Again, no generic function overhead.
-
-@subheading Other details
-
-To short-circuit expansion and use the @code{translate-*} functions
-instead, simply call the next method. Return its result in cases
-where your method cannot generate an appropriate replacement for it.
-This analogous to the @code{&whole form} mechanism compiler macros
-provide.
-
-The @code{expand-*} methods have precedence over their
-@code{translate-*} counterparts and are guaranteed to be used in
-@code{defcfun}, @code{foreign-funcall}, @code{defcvar} and
-@code{defcallback}. If you define a method on each of the
-@code{expand-*} generic functions, you are guaranteed to have full
-control over the expressions generated for type translation in these
-macros.
-
-They may or may not be used in other @cffi{} operators that need to
-translate between Lisp and C data; you may only assume that
-@code{expand-*} methods will probably only be called during Lisp
-compilation.
-
-@code{expand-to-foreign-dyn} has precedence over
-@code{expand-to-foreign} and is only used in @code{defcfun} and
-@code{foreign-funcall}, only making sense in those contexts.
-
-@strong{Important note:} this set of generic functions is called at
-macroexpansion time. Methods are defined when loaded or evaluated,
-not compiled. You are responsible for ensuring that your
-@code{expand-*} methods are defined when the @code{foreign-funcall} or
-other forms that use them are compiled. One way to do this is to put
-the method definitions earlier in the file and inside an appropriate
-@code{eval-when} form; another way is to always load a separate Lisp
-or @acronym{FASL} file containing your @code{expand-*} definitions
-before compiling files with forms that ought to use them. Otherwise,
-they will not be found and the runtime translators will be used
-instead.
-
-@node Foreign Structure Types, Allocating Foreign Objects, Optimizing Type Translators, Foreign Types
-@section Foreign Structure Types
-
-For more involved C types than simple aliases to built-in types, such
-as you can make with @code{defctype}, @cffi{} allows declaration of
-structures and unions with @code{defcstruct} and @code{defcunion}.
-
-For example, consider this fictional C structure declaration holding
-some personal information:
-
-@example
-struct person @{
- int number;
- char* reason;
-@};
-@end example
-
-@noindent
-The equivalent @code{defcstruct} form follows:
-
-@lisp
-(defcstruct person
- (number :int)
- (reason :string))
-@end lisp
-
-@c LMH structure translation
-By default, @ref{convert-from-foreign} (and also @ref{mem-ref}) will
-make a plist with slot names as keys, and @ref{convert-to-foreign} will
-translate such a plist to a foreign structure. A user wishing to define
-other translations should use the @code{:class} argument to
-@ref{defcstruct}, and then define methods for
-@ref{translate-from-foreign} and
-@ref{translate-into-foreign-memory} that specialize on this class,
-possibly calling @code{call-next-method} to translate from and to the
-plists rather than provide a direct interface to the foreign object.
-The macro @code{translation-forms-for-class} will generate the forms
-necessary to translate a Lisp class into a foreign structure and vice
-versa.
-@c Write separate function doc section for translation-forms-for-class?
-@c Examples, perhaps taken from the tests?
-
-Please note that this interface is only for those that must know about
-the values contained in a relevant struct. If the library you are
-interfacing returns an opaque pointer that needs only be passed to
-other C library functions, by all means just use @code{:pointer} or a
-type-safe definition munged together with @code{defctype} and type
-translation. To pass or return a structure by value to a function, load
-the cffi-libffi system and specify the structure as @code{(:struct
-@var{structure-name})}. To pass or return the pointer, you can use
-either @code{:pointer} or @code{(:pointer (:struct
-@var{structure-name}))}.
-
-@subheading Optimizing translate-into-foreign-memory
-
-Just like how @ref{translate-from-foreign} had
-@code{expand-from-foreign} to optimize away the generic function call
-and @ref{translate-to-foreign} had the same in
-@code{expand-to-foreign}, @ref{translate-into-foreign-memory} has
-@code{expand-into-foreign-memory}.
-
-Let's use our @code{person} struct in an example. However, we are
-going to spice it up by using a lisp struct rather than a plist to
-represent the person in lisp.
-
-First we redefine @code{person} very slightly.
-
-@lisp
-(defcstruct (person :class c-person)
- (number :int)
- (reason :string))
-@end lisp
-
-By adding @code{:class} we can specialize the @code{translate-*}
-methods on the type @code{c-person}.
-
-Next we define a lisp struct to use instead of the plists.
-
-@lisp
-(defstruct lisp-person
- (number 0 :type integer)
- (reason "" :type string))
-@end lisp
-
-And now let's define the type translators we know already:
-
-@lisp
-(defmethod translate-from-foreign (ptr (type c-person))
- (with-foreign-slots ((number reason) ptr (:struct person))
- (make-lisp-person :number number :reason reason)))
-
-(defmethod expand-from-foreign (ptr (type c-person))
- `(with-foreign-slots ((number reason) ,ptr (:struct person))
- (make-lisp-person :number number :reason reason)))
-
-(defmethod translate-into-foreign-memory (value (type c-person) ptr)
- (with-foreign-slots ((number reason) ptr (:struct person))
- (setf number (lisp-person-number value)
- reason (lisp-person-reason value))))
-@end lisp
-
-At this point everything works, we can convert to and from our
-@code{lisp-person} and foreign @code{person}. If we macroexpand
-
-@lisp
-(setf (mem-aref ptr '(:struct person)) x)
-@end lisp
-
-we get something like:
-
-@lisp
-(let ((#:store879 x))
- (translate-into-foreign-memory #:store879 #<c-person person>
- (inc-pointer ptr 0))
- #:store879)
-@end lisp
-
-Which is good, but now we can do better and get rid of that generic
-function call to @code{translate-into-foreign-memory}.
-
-@lisp
-(defmethod expand-into-foreign-memory (value (type c-person) ptr)
- `(with-foreign-slots ((number reason) ,ptr (:struct person))
- (setf number (lisp-person-number ,value)
- reason (lisp-person-reason ,value))))
-@end lisp
-
-Now we can expand again so see the changes:
-
-@lisp
-;; this:
-(setf (mem-aref ptr '(:struct person)) x)
-
-;; expands to this
-;; (simplified, downcased, etc..)
-(let ((#:store887 x))
- (with-foreign-slots ((number reason) (inc-pointer ptr 0) (:struct person))
- (setf number (lisp-person-number #:store887)
- reason (lisp-person-reason #:store887))) #:store887)
-@end lisp
-
-And there we are, no generic function overhead.
-
-@subheading Compatibility note
-
-Previous versions of CFFI accepted the
-``bare'' @var{structure-name} as a type specification, which was
-interpreted as a pointer to the structure. This is deprecated and
-produces a style warning. Using this deprecated form means that
-@ref{mem-aref} retains its prior meaning and returns a pointer. Using
-the @code{(:struct @var{structure-name})} form for the type,
-@ref{mem-aref} provides a Lisp object translated from the
-structure (by default a plist). Thus the semantics are consistent with all
-types in returning the object as represented in Lisp, and not a pointer,
-with the exception of the ``bare'' structure compatibility retained.
-In order to obtain the pointer, you should use the function @ref{mem-aptr}.
-
-See @ref{defcstruct} for more details.
-
-@node Allocating Foreign Objects, convert-from-foreign, Foreign Structure Types, Foreign Types
-@section Allocating Foreign Objects
-
-@c I moved this because I moved with-foreign-object to the Pointers
-@c chapter, where foreign-alloc is.
-
-@xref{Allocating Foreign Memory}.
-
-
-@c ===================================================================
-@c CONVERT-FROM-FOREIGN
-
-@page
-@node convert-from-foreign, convert-to-foreign, Allocating Foreign Objects, Foreign Types
-@heading convert-from-foreign
-@subheading Syntax
-@Function{convert-from-foreign foreign-value type @res{} value}
-
-@subheading Arguments and Values
-
-@table @var
-@item foreign-value
-The primitive C value as returned from a primitive foreign function or
-from @code{convert-to-foreign}.
-
-@item type
-A @cffi{} type specifier.
-
-@item value
-The Lisp value translated from @var{foreign-value}.
-@end table
-
-@subheading Description
-
-This is an external interface to the type translation facility. In
-the implementation, all foreign functions are ultimately defined as
-type translation wrappers around primitive foreign function
-invocations.
-
-This function is available mostly for inspection of the type
-translation process, and possibly optimization of special cases of
-your foreign function calls.
-
-Its behavior is better described under @code{translate-from-foreign}'s
-documentation.
-
-@subheading Examples
-
-@lisp
-CFFI-USER> (convert-to-foreign "a boat" :string)
-@result{} #<FOREIGN-ADDRESS #x097ACDC0>
-@result{} T
-CFFI-USER> (convert-from-foreign * :string)
-@result{} "a boat"
-@end lisp
-
-@subheading See Also
-@seealso{convert-to-foreign} @*
-@seealso{free-converted-object} @*
-@seealso{translate-from-foreign}
-
-
-@c ===================================================================
-@c CONVERT-TO-FOREIGN
-
-@page
-@node convert-to-foreign, defbitfield, convert-from-foreign, Foreign Types
-@heading convert-to-foreign
-@subheading Syntax
-@Function{convert-to-foreign value type @res{} foreign-value, alloc-params}
-
-@subheading Arguments and Values
-
-@table @var
-@item value
-The Lisp object to be translated to a foreign object.
-
-@item type
-A @cffi{} type specifier.
-
-@item foreign-value
-The primitive C value, ready to be passed to a primitive foreign
-function.
-
-@item alloc-params
-Something of a translation state; you must pass it to
-@code{free-converted-object} along with the foreign value for that to
-work.
-@end table
-
-@subheading Description
-
-This is an external interface to the type translation facility. In
-the implementation, all foreign functions are ultimately defined as
-type translation wrappers around primitive foreign function
-invocations.
-
-This function is available mostly for inspection of the type
-translation process, and possibly optimization of special cases of
-your foreign function calls.
-
-Its behavior is better described under @code{translate-to-foreign}'s
-documentation.
-
-@subheading Examples
-
-@lisp
-CFFI-USER> (convert-to-foreign t :boolean)
-@result{} 1
-@result{} NIL
-CFFI-USER> (convert-to-foreign "hello, world" :string)
-@result{} #<FOREIGN-ADDRESS #x097C5F80>
-@result{} T
-CFFI-USER> (code-char (mem-aref * :char 5))
-@result{} #\,
-@end lisp
-
-@subheading See Also
-@seealso{convert-from-foreign} @*
-@seealso{free-converted-object} @*
-@seealso{translate-to-foreign}
-
-
-@c ===================================================================
-@c DEFBITFIELD
-
-@page
-@node defbitfield, defcstruct, convert-to-foreign, Foreign Types
-@heading defbitfield
-@subheading Syntax
-@Macro{defbitfield name-and-options &body masks}
-
-masks ::= [docstring] @{ (symbol value) @}* @*
-name-and-options ::= name | (name &optional (base-type :int))
-
-@subheading Arguments and Values
-
-@table @var
-@item name
-The name of the new bitfield type.
-
-@item docstring
-A documentation string, ignored.
-
-@item base-type
-A symbol denoting a foreign type.
-
-@item symbol
-A Lisp symbol.
-
-@item value
-An integer representing a bitmask.
-@end table
-
-@subheading Description
-The @code{defbitfield} macro is used to define foreign types that map
-lists of symbols to integer values.
-
-If @var{value} is omitted, it will be computed as follows: find the
-greatest @var{value} previously used, including those so computed,
-with only a single 1-bit in its binary representation (that is, powers
-of two), and left-shift it by one. This rule guarantees that a
-computed @var{value} cannot clash with previous values, but may clash
-with future explicitly specified values.
-
-Symbol lists will be automatically converted to values and vice versa
-when being passed as arguments to or returned from foreign functions,
-respectively. The same applies to any other situations where an object
-of a bitfield type is expected.
-
-Types defined with @code{defbitfield} canonicalize to @var{base-type}
-which is @code{:int} by default.
-
-@subheading Examples
-@lisp
-(defbitfield open-flags
- (:rdonly #x0000)
- :wronly ;@lispcmt{#x0001}
- :rdwr ;@lispcmt{@dots{}}
- :nonblock
- :append
- (:creat #x0200))
- ;; @lispcmt{etc@dots{}}
-
-CFFI> (foreign-bitfield-symbols 'open-flags #b1101)
-@result{} (:WRONLY :NONBLOCK :APPEND)
-
-CFFI> (foreign-bitfield-value 'open-flags '(:rdwr :creat))
-@result{} 514 ; #x0202
-
-(defcfun ("open" unix-open) :int
- (path :string)
- (flags open-flags)
- (mode :uint16)) ; unportable
-
-CFFI> (unix-open "/tmp/foo" '(:wronly :creat) #o644)
-@result{} #<an fd>
-
-;;; @lispcmt{Consider also the following lispier wrapper around open()}
-(defun lispier-open (path mode &rest flags)
- (unix-open path flags mode))
-@end lisp
-
-@subheading See Also
-@seealso{foreign-bitfield-value} @*
-@seealso{foreign-bitfield-symbols}
-
-
-@c ===================================================================
-@c DEFCSTRUCT
-
-@page
-@node defcstruct, defcunion, defbitfield, Foreign Types
-@heading defcstruct
-@subheading Syntax
-@Macro{defcstruct name-and-options &body doc-and-slots @res{} name}
-
-name-and-options ::= structure-name | (structure-name &key size)
-
-doc-and-slots ::= [docstring] @{ (slot-name slot-type &key count offset) @}*
-
-@subheading Arguments and Values
-
-@table @var
-@item structure-name
-The name of new structure type.
-
-@item docstring
-A documentation string, ignored.
-
-@item slot-name
-A symbol naming the slot. It must be unique among slot names in this
-structure.
-
-@item size
-Use this option to override the size (in bytes) of the struct.
-
-@item slot-type
-The type specifier for the slot.
-
-@item count
-Used to declare an array of size @var{count} inside the
-structure. Defaults to @code{1} as such an array and a single element
-are semantically equivalent.
-
-@item offset
-Overrides the slot's offset. The next slot's offset is calculated
-based on this one.
-@end table
-
-@subheading Description
-This defines a new @cffi{} aggregate type akin to C @code{struct}s.
-In other words, it specifies that foreign objects of the type
-@var{structure-name} are groups of different pieces of data, or
-``slots'', of the @var{slot-type}s, distinguished from each other by
-the @var{slot-name}s. Each structure is located in memory at a
-position, and the slots are allocated sequentially beginning at that
-point in memory (with some padding allowances as defined by the C
-@acronym{ABI}, unless otherwise requested by specifying an
-@var{offset} from the beginning of the structure (offset 0).
-
-In other words, it is isomorphic to the C @code{struct}, giving
-several extra features.
-
-There are two kinds of slots, for the two kinds of @cffi{} types:
-
-@table @dfn
-@item Simple
-Contain a single instance of a type that canonicalizes to a built-in
-type, such as @code{:long} or @code{:pointer}. Used for simple
-@cffi{} types.
-
-@item Aggregate
-Contain an embedded structure or union, or an array of objects. Used
-for aggregate @cffi{} types.
-@end table
-
-The use of @acronym{CLOS} terminology for the structure-related
-features is intentional; structure definitions are very much like
-classes with (far) fewer features.
-
-@subheading Examples
-@lisp
-(defcstruct point
- "Point structure."
- (x :int)
- (y :int))
-
-CFFI> (with-foreign-object (ptr 'point)
- ;; @lispcmt{Initialize the slots}
- (setf (foreign-slot-value ptr 'point 'x) 42
- (foreign-slot-value ptr 'point 'y) 42)
- ;; @lispcmt{Return a list with the coordinates}
- (with-foreign-slots ((x y) ptr point)
- (list x y)))
-@result{} (42 42)
-@end lisp
-
-@lisp
-;; @lispcmt{Using the :size and :offset options to define a partial structure.}
-;; @lispcmt{(this is useful when you are interested in only a few slots}
-;; @lispcmt{of a big foreign structure)}
-
-(defcstruct (foo :size 32)
- "Some struct with 32 bytes."
- ; @lispcmt{<16 bytes we don't care about>}
- (x :int :offset 16) ; @lispcmt{an int at offset 16}
- (y :int) ; @lispcmt{another int at offset 16+sizeof(int)}
- ; @lispcmt{<a couple more bytes we don't care about>}
- (z :char :offset 24)) ; @lispcmt{a char at offset 24}
- ; @lispcmt{<7 more bytes ignored (since size is 32)>}
-
-CFFI> (foreign-type-size 'foo)
-@result{} 32
-@end lisp
-
-@lisp
-;;; @lispcmt{Using :count to define arrays inside of a struct.}
-(defcstruct video_tuner
- (name :char :count 32))
-@end lisp
-
-@subheading See Also
-@seealso{foreign-slot-pointer} @*
-@seealso{foreign-slot-value} @*
-@seealso{with-foreign-slots}
-
-
-@c ===================================================================
-@c DEFCUNION
-
-@page
-@node defcunion, defctype, defcstruct, Foreign Types
-@heading defcunion
-@subheading Syntax
-@Macro{defcunion name &body doc-and-slots @res{} name}
-
-doc-and-slots ::= [docstring] @{ (slot-name slot-type &key count) @}*
-
-@subheading Arguments and Values
-
-@table @var
-@item name
-The name of new union type.
-
-@item docstring
-A documentation string, ignored.
-
-@item slot-name
-A symbol naming the slot.
-
-@item slot-type
-The type specifier for the slot.
-
-@item count
-Used to declare an array of size @var{count} inside the
-structure.
-@end table
-
-@subheading Description
-A union is a structure in which all slots have an offset of zero. It
-is isomorphic to the C @code{union}. Therefore, you should use the
-usual foreign structure operations for accessing a union's slots.
-
-@subheading Examples
-@lisp
-(defcunion uint32-bytes
- (int-value :unsigned-int)
- (bytes :unsigned-char :count 4))
-@end lisp
-
-@subheading See Also
-@seealso{foreign-slot-pointer} @*
-@seealso{foreign-slot-value}
-
-
-@c ===================================================================
-@c DEFCTYPE
-
-@page
-@node defctype, defcenum, defcunion, Foreign Types
-@heading defctype
-@subheading Syntax
-@Macro{defctype name base-type &optional documentation}
-
-@subheading Arguments and Values
-
-@table @var
-@item name
-The name of the new foreign type.
-
-@item base-type
-A symbol or a list defining the new type.
-
-@item documentation
-A documentation string, currently ignored.
-@end table
-
-@subheading Description
-The @code{defctype} macro provides a mechanism similar to C's
-@code{typedef} to define new types. The new type inherits
-@var{base-type}'s translators, if any. There is no way to define
-translations for types defined with @code{defctype}. For that,
-you should use @ref{define-foreign-type}.
-
-@subheading Examples
-@lisp
-(defctype my-string :string
- "My own string type.")
-
-(defctype long-bools (:boolean :long)
- "Booleans that map to C longs.")
-@end lisp
-
-@subheading See Also
-@seealso{define-foreign-type}
-
-
-@c ===================================================================
-@c DEFCENUM
-
-@page
-@node defcenum, define-foreign-type, defctype, Foreign Types
-@heading defcenum
-@subheading Syntax
-@Macro{defcenum name-and-options &body enum-list}
-
-enum-list ::= [docstring] @{ keyword | (keyword value) @}*
-name-and-options ::= name | (name &optional (base-type :int))
-
-@subheading Arguments and Values
-
-@table @var
-@item name
-The name of the new enum type.
-
-@item docstring
-A documentation string, ignored.
-
-@item base-type
-A symbol denoting a foreign type.
-
-@item keyword
-A keyword symbol.
-
-@item value
-An index value for a keyword.
-@end table
-
-@subheading Description
-The @code{defcenum} macro is used to define foreign types that map
-keyword symbols to integer values, similar to the C @code{enum} type.
-
-If @var{value} is omitted its value will either be 0, if it's the
-first entry, or it it will continue the progression from the last
-specified value.
-
-Keywords will be automatically converted to values and vice-versa when
-being passed as arguments to or returned from foreign functions,
-respectively. The same applies to any other situations where an object
-of an @code{enum} type is expected.
-
-Types defined with @code{defcenum} canonicalize to @var{base-type}
-which is @code{:int} by default.
-
-@subheading Examples
-@lisp
-(defcenum boolean
- :no
- :yes)
-
-CFFI> (foreign-enum-value 'boolean :no)
-@result{} 0
-@end lisp
-
-@lisp
-(defcenum numbers
- (:one 1)
- :two
- (:four 4))
-
-CFFI> (foreign-enum-keyword 'numbers 2)
-@result{} :TWO
-@end lisp
-
-@subheading See Also
-@seealso{foreign-enum-value} @*
-@seealso{foreign-enum-keyword}
-
-
-@c ===================================================================
-@c DEFINE-FOREIGN-TYPE
-
-@page
-@node define-foreign-type, define-parse-method, defcenum, Foreign Types
-@heading define-foreign-type
-@subheading Syntax
-@Macro{define-foreign-type class-name supers slots &rest options @res{} class-name}
-
-options ::= (@code{:actual-type} @var{type}) | @
- (@code{:simple-parser} @var{symbol}) | @
- @emph{regular defclass option}
-
-@subheading Arguments and Values
-
-@table @var
-@item class-name
-A symbol naming the new foreign type class.
-
-@item supers
-A list of symbols naming the super classes.
-
-@item slots
-A list of slot definitions, passed to @code{defclass}.
-@end table
-
-@subheading Description
-
-@c TODO rewrite
-
-The macro @code{define-foreign-type} defines a new class
-@var{class-name}. It is a thin wrapper around @code{defclass}. Among
-other things, it ensures that @var{class-name} becomes a subclass of
-@var{foreign-type}, what you need to know about that is that there's
-an initarg @code{:actual-type} which serves the same purpose as
-@code{defctype}'s @var{base-type} argument.
-
-@c TODO mention the type translators here
-@c FIX FIX
-
-@subheading Examples
-Taken from @cffi{}'s @code{:boolean} type definition:
-
-@lisp
-(define-foreign-type :boolean (&optional (base-type :int))
- "Boolean type. Maps to an :int by default. Only accepts integer types."
- (ecase base-type
- ((:char
- :unsigned-char
- :int
- :unsigned-int
- :long
- :unsigned-long) base-type)))
-
-CFFI> (canonicalize-foreign-type :boolean)
-@result{} :INT
-CFFI> (canonicalize-foreign-type '(:boolean :long))
-@result{} :LONG
-CFFI> (canonicalize-foreign-type '(:boolean :float))
-;; @lispcmt{@error{} signalled by ECASE.}
-@end lisp
-
-@subheading See Also
-@seealso{defctype} @*
-@seealso{define-parse-method}
-
-
-@c ===================================================================
-@c DEFINE-PARSE-METHOD
-
-@page
-@node define-parse-method, foreign-bitfield-symbols, define-foreign-type, Foreign Types
-@heading define-parse-method
-@subheading Syntax
-@Macro{define-parse-method name lambda-list &body body @res{} name}
-
-@subheading Arguments and Values
-
-@table @var
-@item type-name
-A symbol naming the new foreign type.
-
-@item lambda-list
-A lambda list which is the argument list of the new foreign type.
-
-@item body
-One or more forms that provide a definition of the new foreign type.
-@end table
-
-@subheading Description
-
-
-@c TODO: update example. The boolean type is probably a good choice.
-
-@subheading Examples
-Taken from @cffi{}'s @code{:boolean} type definition:
-
-@lisp
-(define-foreign-type :boolean (&optional (base-type :int))
- "Boolean type. Maps to an :int by default. Only accepts integer types."
- (ecase base-type
- ((:char
- :unsigned-char
- :int
- :unsigned-int
- :long
- :unsigned-long) base-type)))
-
-CFFI> (canonicalize-foreign-type :boolean)
-@result{} :INT
-CFFI> (canonicalize-foreign-type '(:boolean :long))
-@result{} :LONG
-CFFI> (canonicalize-foreign-type '(:boolean :float))
-;; @lispcmt{@error{} signalled by ECASE.}
-@end lisp
-
-@subheading See Also
-@seealso{define-foreign-type}
-
-
-@c ===================================================================
-@c EXPLAIN-FOREIGN-SLOT-VALUE
-
-@c @node explain-foreign-slot-value
-@c @heading explain-foreign-slot-value
-@c @subheading Syntax
-@c @Macro{explain-foreign-slot-value ptr type &rest slot-names}
-
-@c @subheading Arguments and Values
-
-@c @table @var
-@c @item ptr
-@c ...
-
-@c @item type
-@c ...
-
-@c @item slot-names
-@c ...
-@c @end table
-
-@c @subheading Description
-@c This macro translates the slot access that would occur by calling
-@c @code{foreign-slot-value} with the same arguments into an equivalent
-@c expression in C and prints it to @code{*standard-output*}.
-
-@c @emph{Note: this is not implemented yet.}
-
-@c @subheading Examples
-@c @lisp
-@c CFFI> (explain-foreign-slot-value ptr 'timeval 'tv-secs)
-@c @result{} ptr->tv_secs
-
-@c CFFI> (explain-foreign-slot-value emp 'employee 'hire-date 'tv-usecs)
-@c @result{} emp->hire_date.tv_usecs
-@c @end lisp
-
-@c @subheading See Also
-
-
-@c ===================================================================
-@c FOREIGN-BITFIELD-SYMBOLS
-
-@page
-@node foreign-bitfield-symbols, foreign-bitfield-value, define-parse-method, Foreign Types
-@heading foreign-bitfield-symbols
-@subheading Syntax
-@Function{foreign-bitfield-symbols type value @res{} symbols}
-
-@subheading Arguments and Values
-
-@table @var
-@item type
-A bitfield type.
-
-@item value
-An integer.
-
-@item symbols
-A potentially shared list of symbols.
-@code{nil}.
-@end table
-
-@subheading Description
-The function @code{foreign-bitfield-symbols} returns a possibly shared
-list of symbols that correspond to @var{value} in @var{type}.
-
-@subheading Examples
-@lisp
-(defbitfield flags
- (flag-a 1)
- (flag-b 2)
- (flag-c 4))
-
-CFFI> (foreign-bitfield-symbols 'flags #b101)
-@result{} (FLAG-A FLAG-C)
-@end lisp
-
-@subheading See Also
-@seealso{defbitfield} @*
-@seealso{foreign-bitfield-value}
-
-
-@c ===================================================================
-@c FOREIGN-BITFIELD-VALUE
-
-@page
-@node foreign-bitfield-value, foreign-enum-keyword, foreign-bitfield-symbols, Foreign Types
-@heading foreign-bitfield-value
-@subheading Syntax
-@Function{foreign-bitfield-value type symbols @res{} value}
-
-@subheading Arguments and Values
-
-@table @var
-@item type
-A @code{bitfield} type.
-
-@item symbol
-A Lisp symbol.
-
-@item value
-An integer.
-@end table
-
-@subheading Description
-The function @code{foreign-bitfield-value} returns the @var{value} that
-corresponds to the symbols in the @var{symbols} list.
-
-@subheading Examples
-@lisp
-(defbitfield flags
- (flag-a 1)
- (flag-b 2)
- (flag-c 4))
-
-CFFI> (foreign-bitfield-value 'flags '(flag-a flag-c))
-@result{} 5 ; #b101
-@end lisp
-
-@subheading See Also
-@seealso{defbitfield} @*
-@seealso{foreign-bitfield-symbols}
-
-
-@c ===================================================================
-@c FOREIGN-ENUM-KEYWORD
-
-@page
-@node foreign-enum-keyword, foreign-enum-value, foreign-bitfield-value, Foreign Types
-@heading foreign-enum-keyword
-@subheading Syntax
-@Function{foreign-enum-keyword type value &key errorp @res{} keyword}
-
-@subheading Arguments and Values
-
-@table @var
-@item type
-An @code{enum} type.
-
-@item value
-An integer.
-
-@item errorp
-If true (the default), signal an error if @var{value} is not defined
-in @var{type}. If false, @code{foreign-enum-keyword} returns
-@code{nil}.
-
-@item keyword
-A keyword symbol.
-@end table
-
-@subheading Description
-The function @code{foreign-enum-keyword} returns the keyword symbol
-that corresponds to @var{value} in @var{type}.
-
-An error is signaled if @var{type} doesn't contain such @var{value}
-and @var{errorp} is true.
-
-@subheading Examples
-@lisp
-(defcenum boolean
- :no
- :yes)
-
-CFFI> (foreign-enum-keyword 'boolean 1)
-@result{} :YES
-@end lisp
-
-@subheading See Also
-@seealso{defcenum} @*
-@seealso{foreign-enum-value}
-
-
-@c ===================================================================
-@c FOREIGN-ENUM-VALUE
-
-@page
-@node foreign-enum-value, foreign-slot-names, foreign-enum-keyword, Foreign Types
-@heading foreign-enum-value
-@subheading Syntax
-@Function{foreign-enum-value type keyword &key errorp @res{} value}
-
-@subheading Arguments and Values
-
-@table @var
-@item type
-An @code{enum} type.
-
-@item keyword
-A keyword symbol.
-
-@item errorp
-If true (the default), signal an error if @var{keyword} is not
-defined in @var{type}. If false, @code{foreign-enum-value} returns
-@code{nil}.
-
-@item value
-An integer.
-@end table
-
-@subheading Description
-The function @code{foreign-enum-value} returns the @var{value} that
-corresponds to @var{keyword} in @var{type}.
-
-An error is signaled if @var{type} doesn't contain such
-@var{keyword}, and @var{errorp} is true.
-
-@subheading Examples
-@lisp
-(defcenum boolean
- :no
- :yes)
-
-CFFI> (foreign-enum-value 'boolean :yes)
-@result{} 1
-@end lisp
-
-@subheading See Also
-@seealso{defcenum} @*
-@seealso{foreign-enum-keyword}
-
-
-@c ===================================================================
-@c FOREIGN-SLOT-NAMES
-
-@page
-@node foreign-slot-names, foreign-slot-offset, foreign-enum-value, Foreign Types
-@heading foreign-slot-names
-@subheading Syntax
-@Function{foreign-slot-names type @res{} names}
-
-@subheading Arguments and Values
-
-@table @var
-@item type
-A foreign struct type.
-
-@item names
-A list.
-@end table
-
-@subheading Description
-The function @code{foreign-slot-names} returns a potentially shared
-list of slot @var{names} for the given structure @var{type}. This list
-has no particular order.
-
-@subheading Examples
-@lisp
-(defcstruct timeval
- (tv-secs :long)
- (tv-usecs :long))
-
-CFFI> (foreign-slot-names '(:struct timeval))
-@result{} (TV-SECS TV-USECS)
-@end lisp
-
-@subheading See Also
-@seealso{defcstruct} @*
-@seealso{foreign-slot-offset} @*
-@seealso{foreign-slot-value} @*
-@seealso{foreign-slot-pointer}
-
-
-@c ===================================================================
-@c FOREIGN-SLOT-OFFSET
-
-@page
-@node foreign-slot-offset, foreign-slot-pointer, foreign-slot-names, Foreign Types
-@heading foreign-slot-offset
-@subheading Syntax
-@Function{foreign-slot-offset type slot-name @res{} offset}
-
-@subheading Arguments and Values
-
-@table @var
-@item type
-A foreign struct type.
-
-@item slot-name
-A symbol.
-
-@item offset
-An integer.
-@end table
-
-@subheading Description
-The function @code{foreign-slot-offset} returns the @var{offset} in
-bytes of a slot in a foreign struct type.
-
-@subheading Examples
-@lisp
-(defcstruct timeval
- (tv-secs :long)
- (tv-usecs :long))
-
-CFFI> (foreign-slot-offset '(:struct timeval) 'tv-secs)
-@result{} 0
-CFFI> (foreign-slot-offset '(:struct timeval) 'tv-usecs)
-@result{} 4
-@end lisp
-
-@subheading See Also
-@seealso{defcstruct} @*
-@seealso{foreign-slot-names} @*
-@seealso{foreign-slot-pointer} @*
-@seealso{foreign-slot-value}
-
-
-@c ===================================================================
-@c FOREIGN-SLOT-POINTER
-
-@page
-@node foreign-slot-pointer, foreign-slot-value, foreign-slot-offset, Foreign Types
-@heading foreign-slot-pointer
-@subheading Syntax
-@Function{foreign-slot-pointer ptr type slot-name @res{} pointer}
-
-@subheading Arguments and Values
-
-@table @var
-@item ptr
-A pointer to a structure.
-
-@item type
-A foreign structure type.
-
-@item slot-names
-A slot name in the @var{type}.
-
-@item pointer
-A pointer to the slot @var{slot-name}.
-@end table
-
-@subheading Description
-Returns a pointer to the location of the slot @var{slot-name} in a
-foreign object of type @var{type} at @var{ptr}. The returned pointer
-points inside the structure. Both the pointer and the memory it points
-to have the same extent as @var{ptr}.
-
-For aggregate slots, this is the same value returned by
-@code{foreign-slot-value}.
-
-@subheading Examples
-@lisp
-(defcstruct point
- "Pointer structure."
- (x :int)
- (y :int))
-
-CFFI> (with-foreign-object (ptr '(:struct point))
- (foreign-slot-pointer ptr '(:struct point) 'x))
-@result{} #<FOREIGN-ADDRESS #xBFFF6E60>
-;; @lispcmt{Note: the exact pointer representation varies from lisp to lisp.}
-@end lisp
-
-@subheading See Also
-@seealso{defcstruct} @*
-@seealso{foreign-slot-value} @*
-@seealso{foreign-slot-names} @*
-@seealso{foreign-slot-offset}
-
-
-@c ===================================================================
-@c FOREIGN-SLOT-VALUE
-
-@page
-@node foreign-slot-value, foreign-type-alignment, foreign-slot-pointer, Foreign Types
-@heading foreign-slot-value
-@subheading Syntax
-@Accessor{foreign-slot-value ptr type slot-name @res{} object}
-
-@subheading Arguments and Values
-
-@table @var
-@item ptr
-A pointer to a structure.
-
-@item type
-A foreign structure type.
-
-@item slot-name
-A symbol naming a slot in the structure type.
-
-@item object
-The object contained in the slot specified by @var{slot-name}.
-@end table
-
-@subheading Description
-For simple slots, @code{foreign-slot-value} returns the value of the
-object, such as a Lisp integer or pointer. In C, this would be
-expressed as @code{ptr->slot}.
-
-For aggregate slots, a pointer inside the structure to the beginning
-of the slot's data is returned. In C, this would be expressed as
-@code{&ptr->slot}. This pointer and the memory it points to have the
-same extent as @var{ptr}.
-
-There are compiler macros for @code{foreign-slot-value} and its
-@code{setf} expansion that open code the memory access when
-@var{type} and @var{slot-names} are constant at compile-time.
-
-@subheading Examples
-@lisp
-(defcstruct point
- "Pointer structure."
- (x :int)
- (y :int))
-
-CFFI> (with-foreign-object (ptr '(:struct point))
- ;; @lispcmt{Initialize the slots}
- (setf (foreign-slot-value ptr '(:struct point) 'x) 42
- (foreign-slot-value ptr '(:struct point) 'y) 42)
- ;; @lispcmt{Return a list with the coordinates}
- (with-foreign-slots ((x y) ptr (:struct point))
- (list x y)))
-@result{} (42 42)
-@end lisp
-
-@subheading See Also
-@seealso{defcstruct} @*
-@seealso{foreign-slot-names} @*
-@seealso{foreign-slot-offset} @*
-@seealso{foreign-slot-pointer} @*
-@seealso{with-foreign-slots}
-
-
-@c ===================================================================
-@c FOREIGN-TYPE-ALIGNMENT
-
-@page
-@node foreign-type-alignment, foreign-type-size, foreign-slot-value, Foreign Types
-@heading foreign-type-alignment
-@subheading Syntax
-@c XXX: This is actually a generic function.
-@Function{foreign-type-alignment type @res{} alignment}
-
-@subheading Arguments and Values
-
-@table @var
-@item type
-A foreign type.
-
-@item alignment
-An integer.
-@end table
-
-@subheading Description
-The function @code{foreign-type-alignment} returns the
-@var{alignment} of @var{type} in bytes.
-
-@subheading Examples
-@lisp
-CFFI> (foreign-type-alignment :char)
-@result{} 1
-CFFI> (foreign-type-alignment :short)
-@result{} 2
-CFFI> (foreign-type-alignment :int)
-@result{} 4
-@end lisp
-
-@lisp
-(defcstruct foo
- (a :char))
-
-CFFI> (foreign-type-alignment '(:struct foo))
-@result{} 1
-@end lisp
-
-@subheading See Also
-@seealso{foreign-type-size}
-
-
-@c ===================================================================
-@c FOREIGN-TYPE-SIZE
-
-@page
-@node foreign-type-size, free-converted-object, foreign-type-alignment, Foreign Types
-@heading foreign-type-size
-@subheading Syntax
-@c XXX: this is actually a generic function.
-@Function{foreign-type-size type @res{} size}
-
-@subheading Arguments and Values
-
-@table @var
-@item type
-A foreign type.
-
-@item size
-An integer.
-@end table
-
-@subheading Description
-The function @code{foreign-type-size} return the @var{size} of
-@var{type} in bytes. This includes any padding within and following
-the in-memory representation as needed to create an array of
-@var{type} objects.
-
-@subheading Examples
-@lisp
-(defcstruct foo
- (a :double)
- (c :char))
-
-CFFI> (foreign-type-size :double)
-@result{} 8
-CFFI> (foreign-type-size :char)
-@result{} 1
-CFFI> (foreign-type-size '(:struct foo))
-@result{} 16
-@end lisp
-
-@subheading See Also
-@seealso{foreign-type-alignment}
-
-
-@c ===================================================================
-@c FREE-CONVERTED-OBJECT
-
-@page
-@node free-converted-object, free-translated-object, foreign-type-size, Foreign Types
-@heading free-converted-object
-@subheading Syntax
-@Function{free-converted-object foreign-value type params}
-
-@subheading Arguments and Values
-
-@table @var
-@item foreign-value
-The C object to be freed.
-
-@item type
-A @cffi{} type specifier.
-
-@item params
-The state returned as the second value from @code{convert-to-foreign};
-used to implement the third argument to @code{free-translated-object}.
-@end table
-
-@subheading Description
-
-The return value is unspecified.
-
-This is an external interface to the type translation facility. In
-the implementation, all foreign functions are ultimately defined as
-type translation wrappers around primitive foreign function
-invocations.
-
-This function is available mostly for inspection of the type
-translation process, and possibly optimization of special cases of
-your foreign function calls.
-
-Its behavior is better described under @code{free-translated-object}'s
-documentation.
-
-@subheading Examples
-
-@lisp
-CFFI-USER> (convert-to-foreign "a boat" :string)
-@result{} #<FOREIGN-ADDRESS #x097ACDC0>
-@result{} T
-CFFI-USER> (free-converted-object * :string t)
-@result{} NIL
-@end lisp
-
-@subheading See Also
-@seealso{convert-from-foreign} @*
-@seealso{convert-to-foreign} @*
-@seealso{free-translated-object}
-
-
-@c ===================================================================
-@c FREE-TRANSLATED-OBJECT
-
-@c TODO: update
-
-@page
-@node free-translated-object, translate-from-foreign, free-converted-object, Foreign Types
-@heading free-translated-object
-@subheading Syntax
-@GenericFunction{free-translated-object value type-name param}
-
-@subheading Arguments and Values
-
-@table @var
-@item pointer
-The foreign value returned by @code{translate-to-foreign}.
-
-@item type-name
-A symbol naming a foreign type defined by @code{defctype}.
-
-@item param
-The second value, if any, returned by @code{translate-to-foreign}.
-@end table
-
-@subheading Description
-This generic function may be specialized by user code to perform
-automatic deallocation of foreign objects as they are passed to C
-functions.
-
-Any methods defined on this generic function must EQL-specialize the
-@var{type-name} parameter on a symbol defined as a foreign type by
-the @code{defctype} macro.
-
-@subheading See Also
-@seealso{Foreign Type Translators} @*
-@seealso{translate-to-foreign}
-
-
-@c ===================================================================
-@c TRANSLATE-FROM-FOREIGN
-
-@c TODO: update
-
-@page
-@node translate-from-foreign, translate-to-foreign, free-translated-object, Foreign Types
-@heading translate-from-foreign
-@subheading Syntax
-@GenericFunction{translate-from-foreign foreign-value type-name @
- @res{} lisp-value}
-
-@subheading Arguments and Values
-
-@table @var
-@item foreign-value
-The foreign value to convert to a Lisp object.
-
-@item type-name
-A symbol naming a foreign type defined by @code{defctype}.
-
-@item lisp-value
-The lisp value to pass in place of @code{foreign-value} to Lisp code.
-@end table
-
-@subheading Description
-This generic function is invoked by @cffi{} to convert a foreign value to
-a Lisp value, such as when returning from a foreign function, passing
-arguments to a callback function, or accessing a foreign variable.
-
-To extend the @cffi{} type system by performing custom translations, this
-method may be specialized by @sc{eql}-specializing @code{type-name} on a
-symbol naming a foreign type defined with @code{defctype}. This
-method should return the appropriate Lisp value to use in place of the
-foreign value.
-
-The results are undefined if the @code{type-name} parameter is
-specialized in any way except an @sc{eql} specializer on a foreign type
-defined with @code{defctype}. Specifically, translations may not be
-defined for built-in types.
-
-@subheading See Also
-@seealso{Foreign Type Translators} @*
-@seealso{translate-to-foreign} @*
-@seealso{free-translated-object}
-
-
-@c ===================================================================
-@c TRANSLATE-TO-FOREIGN
-
-@c TODO: update
-
-@page
-@node translate-to-foreign, translate-into-foreign-memory, translate-from-foreign, Foreign Types
-@heading translate-to-foreign
-@subheading Syntax
-@GenericFunction{translate-to-foreign lisp-value type-name @
- @res{} foreign-value, alloc-param}
-
-@subheading Arguments and Values
-
-@table @var
-@item lisp-value
-The Lisp value to convert to foreign representation.
-
-@item type-name
-A symbol naming a foreign type defined by @code{defctype}.
-
-@item foreign-value
-The foreign value to pass in place of @code{lisp-value} to foreign code.
-
-@item alloc-param
-If present, this value will be passed to
-@code{free-translated-object}.
-@end table
-
-@subheading Description
-This generic function is invoked by @cffi{} to convert a Lisp value to a
-foreign value, such as when passing arguments to a foreign function,
-returning a value from a callback, or setting a foreign variable. A
-``foreign value'' is one appropriate for passing to the next-lowest
-translator, including the low-level translators that are ultimately
-invoked invisibly with @cffi{}.
-
-To extend the @cffi{} type system by performing custom translations, this
-method may be specialized by @sc{eql}-specializing @code{type-name} on a
-symbol naming a foreign type defined with @code{defctype}. This
-method should return the appropriate foreign value to use in place of
-the Lisp value.
-
-In cases where @cffi{} can determine the lifetime of the foreign object
-returned by this method, it will invoke @code{free-translated-object}
-on the foreign object at the appropriate time. If
-@code{translate-to-foreign} returns a second value, it will be passed
-as the @code{param} argument to @code{free-translated-object}. This
-can be used to establish communication between the allocation and
-deallocation methods.
-
-The results are undefined if the @code{type-name} parameter is
-specialized in any way except an @sc{eql} specializer on a foreign type
-defined with @code{defctype}. Specifically, translations may not be
-defined for built-in types.
-
-@subheading See Also
-@seealso{Foreign Type Translators} @*
-@seealso{translate-from-foreign} @*
-@seealso{free-translated-object}
-
-
-@c ===================================================================
-@c TRANSLATE-INTO-FOREIGN-MEMORY
-
-@page
-@node translate-into-foreign-memory, with-foreign-slots, translate-to-foreign, Foreign Types
-@heading translate-into-foreign-memory
-@subheading Syntax
-@GenericFunction{translate-into-foreign-memory lisp-value type-name pointer}
-
-@subheading Arguments and Values
-
-@table @var
-@item lisp-value
-The Lisp value to convert to foreign representation.
-
-@item type-name
-A symbol or list @code{(:struct @var{structure-name})} naming a foreign type defined by @code{defctype}.
-
-@item pointer
-The foreign pointer where the translated object should be stored.
-@end table
-
-@subheading Description
-Translate the Lisp value into the foreign memory location given by
-pointer. The return value is not used.
-
-@c ===================================================================
-@c WITH-FOREIGN-SLOTS
-
-@page
-@node with-foreign-slots, , translate-into-foreign-memory, Foreign Types
-@heading with-foreign-slots
-@subheading Syntax
-@Macro{with-foreign-slots (vars ptr type) &body body}
-
-@subheading Arguments and Values
-
-@table @var
-@item vars
-A list with each element a symbol, or list of length two with the
-first element @code{:pointer} and the second a symbol.
-
-@item ptr
-A foreign pointer to a structure.
-
-@item type
-A structure type.
-
-@item body
-A list of forms to be executed.
-@end table
-
-@subheading Description
-The @code{with-foreign-slots} macro creates local symbol macros for each
-var in @var{vars} to reference foreign slots in @var{ptr} of @var{type}.
-If the var is a list starting with @code{:pointer}, it will bind the
-pointer to the slot (rather than the value). It is similar to Common
-Lisp's @code{with-slots} macro.
-
-@subheading Examples
-@lisp
-(defcstruct tm
- (sec :int)
- (min :int)
- (hour :int)
- (mday :int)
- (mon :int)
- (year :int)
- (wday :int)
- (yday :int)
- (isdst :boolean)
- (zone :string)
- (gmtoff :long))
-
-CFFI> (with-foreign-object (time :int)
- (setf (mem-ref time :int)
- (foreign-funcall "time" :pointer (null-pointer) :int))
- (foreign-funcall "gmtime" :pointer time (:pointer (:struct tm))))
-@result{} #<A Mac Pointer #x102A30>
-CFFI> (with-foreign-slots ((sec min hour mday mon year) * (:struct tm))
- (format nil "~A:~A:~A, ~A/~A/~A"
- hour min sec (+ 1900 year) mon mday))
-@result{} "7:22:47, 2005/8/2"
-@end lisp
-
-@subheading See Also
-@seealso{defcstruct} @*
-@seealso{defcunion} @*
-@seealso{foreign-slot-value}
-
-
-@c ===================================================================
-@c CHAPTER: Pointers
-
-@node Pointers, Strings, Foreign Types, Top
-@chapter Pointers
-
-All C data in @cffi{} is referenced through pointers. This includes
-defined C variables that hold immediate values, and integers.
-
-To see why this is, consider the case of the C integer. It is not
-only an arbitrary representation for an integer, congruent to Lisp's
-fixnums; the C integer has a specific bit pattern in memory defined by
-the C @acronym{ABI}. Lisp has no such constraint on its fixnums;
-therefore, it only makes sense to think of fixnums as C integers if
-you assume that @cffi{} converts them when necessary, such as when
-storing one for use in a C function call, or as the value of a C
-variable. This requires defining an area of memory@footnote{The
-definition of @dfn{memory} includes the @acronym{CPU} registers.},
-represented through an effective address, and storing it there.
-
-Due to this compartmentalization, it only makes sense to manipulate
-raw C data in Lisp through pointers to it. For example, while there
-may be a Lisp representation of a @code{struct} that is converted to C
-at store time, you may only manipulate its raw data through a pointer.
-The C compiler does this also, albeit informally.
-
-@menu
-* Basic Pointer Operations::
-* Allocating Foreign Memory::
-* Accessing Foreign Memory::
-
-Dictionary
-
-* foreign-free::
-* foreign-alloc::
-* foreign-symbol-pointer::
-* inc-pointer::
-* incf-pointer::
-* make-pointer::
-* mem-aptr::
-* mem-aref::
-* mem-ref::
-* null-pointer::
-* null-pointer-p::
-* pointerp::
-* pointer-address::
-* pointer-eq::
-* with-foreign-object::
-* with-foreign-objects::
-* with-foreign-pointer::
-@end menu
-
-@node Basic Pointer Operations, Allocating Foreign Memory, Pointers, Pointers
-@section Basic Pointer Operations
-
-Manipulating pointers proper can be accomplished through most of the
-other operations defined in the Pointers dictionary, such as
-@code{make-pointer}, @code{pointer-address}, and @code{pointer-eq}.
-When using them, keep in mind that they merely manipulate the Lisp
-representation of pointers, not the values they point to.
-
-@deftp {Lisp Type} foreign-pointer
-The pointers' representations differ from implementation to
-implementation and have different types. @code{foreign-pointer}
-provides a portable type alias to each of these types.
-@end deftp
-
-
-@node Allocating Foreign Memory, Accessing Foreign Memory, Basic Pointer Operations, Pointers
-@section Allocating Foreign Memory
-
-@cffi{} provides support for stack and heap C memory allocation.
-Stack allocation, done with @code{with-foreign-object}, is sometimes
-called ``dynamic'' allocation in Lisp, because memory allocated as
-such has dynamic extent, much as with @code{let} bindings of special
-variables.
-
-This should not be confused with what C calls ``dynamic'' allocation,
-or that done with @code{malloc} and friends. This sort of heap
-allocation is done with @code{foreign-alloc}, creating objects that
-exist until freed with @code{foreign-free}.
-
-
-@node Accessing Foreign Memory, foreign-free, Allocating Foreign Memory, Pointers
-@section Accessing Foreign Memory
-
-When manipulating raw C data, consider that all pointers are pointing
-to an array. When you only want one C value, such as a single
-@code{struct}, this array only has one such value. It is worthwhile
-to remember that everything is an array, though, because this is also
-the semantic that C imposes natively.
-
-C values are accessed as the @code{setf}-able places defined by
-@code{mem-aref} and @code{mem-ref}. Given a pointer and a @cffi{}
-type (@pxref{Foreign Types}), either of these will dereference the
-pointer, translate the C data there back to Lisp, and return the
-result of said translation, performing the reverse operation when
-@code{setf}-ing. To decide which one to use, consider whether you
-would use the array index operator @code{[@var{n}]} or the pointer
-dereference @code{*} in C; use @code{mem-aref} for array indexing and
-@code{mem-ref} for pointer dereferencing.
-
-
-@c ===================================================================
-@c FOREIGN-FREE
-
-@page
-@node foreign-free, foreign-alloc, Accessing Foreign Memory, Pointers
-@heading foreign-free
-@subheading Syntax
-@Function{foreign-free ptr @res{} undefined}
-
-@subheading Arguments and Values
-
-@table @var
-@item ptr
-A foreign pointer.
-@end table
-
-@subheading Description
-The @code{foreign-free} function frees a @code{ptr} previously
-allocated by @code{foreign-alloc}. The consequences of freeing a given
-pointer twice are undefined.
-
-@subheading Examples
-
-@lisp
-CFFI> (foreign-alloc :int)
-@result{} #<A Mac Pointer #x1022E0>
-CFFI> (foreign-free *)
-@result{} NIL
-@end lisp
-
-@subheading See Also
-@seealso{foreign-alloc} @*
-@seealso{with-foreign-pointer}
-
-
-@c ===================================================================
-@c FOREIGN-ALLOC
-
-@page
-@node foreign-alloc, foreign-symbol-pointer, foreign-free, Pointers
-@heading foreign-alloc
-@subheading Syntax
-@Function{foreign-alloc type &key initial-element initial-contents (count 1) @
- null-terminated-p @res{} pointer}
-
-@subheading Arguments and Values
-
-@table @var
-@item type
-A foreign type.
-
-@item initial-element
-A Lisp object.
-
-@item initial-contents
-A sequence.
-
-@item count
-An integer. Defaults to 1 or the length of @var{initial-contents} if
-supplied.
-
-@item null-terminated-p
-A boolean, false by default.
-
-@item pointer
-A foreign pointer to the newly allocated memory.
-@end table
-
-@subheading Description
-The @code{foreign-alloc} function allocates enough memory to hold
-@var{count} objects of type @var{type} and returns a
-@var{pointer}. This memory must be explicitly freed using
-@code{foreign-free} once it is no longer needed.
-
-If @var{initial-element} is supplied, it is used to initialize the
-@var{count} objects the newly allocated memory holds.
-
-If an @var{initial-contents} sequence is supplied, it must have a
-length less than or equal to @var{count} and each of its elements
-will be used to initialize the contents of the newly allocated
-memory.
-
-If @var{count} is omitted and @var{initial-contents} is specified, it
-will default to @code{(length @var{initial-contents})}.
-
-@var{initial-element} and @var{initial-contents} are mutually
-exclusive.
-
-When @var{null-terminated-p} is true,
-@code{(1+ (max @var{count} (length @var{initial-contents})))} elements
-are allocated and the last one is set to @code{NULL}. Note that in
-this case @var{type} must be a pointer type (ie. a type that
-canonicalizes to @code{:pointer}), otherwise an error is signaled.
-
-@subheading Examples
-@lisp
-CFFI> (foreign-alloc :char)
-@result{} #<A Mac Pointer #x102D80> ; @lispcmt{A pointer to 1 byte of memory.}
-
-CFFI> (foreign-alloc :char :count 20)
-@result{} #<A Mac Pointer #x1024A0> ; @lispcmt{A pointer to 20 bytes of memory.}
-
-CFFI> (foreign-alloc :int :initial-element 12)
-@result{} #<A Mac Pointer #x1028B0>
-CFFI> (mem-ref * :int)
-@result{} 12
-
-CFFI> (foreign-alloc :int :initial-contents '(1 2 3))
-@result{} #<A Mac Pointer #x102950>
-CFFI> (loop for i from 0 below 3
- collect (mem-aref * :int i))
-@result{} (1 2 3)
-
-CFFI> (foreign-alloc :int :initial-contents #(1 2 3))
-@result{} #<A Mac Pointer #x102960>
-CFFI> (loop for i from 0 below 3
- collect (mem-aref * :int i))
-@result{} (1 2 3)
-
-;;; @lispcmt{Allocate a char** pointer that points to newly allocated memory}
-;;; @lispcmt{by the :string type translator for the string "foo".}
-CFFI> (foreign-alloc :string :initial-element "foo")
-@result{} #<A Mac Pointer #x102C40>
-@end lisp
-
-@lisp
-;;; @lispcmt{Allocate a null-terminated array of strings.}
-;;; @lispcmt{(Note: FOREIGN-STRING-TO-LISP returns NIL when passed a null pointer)}
-CFFI> (foreign-alloc :string
- :initial-contents '("foo" "bar" "baz")
- :null-terminated-p t)
-@result{} #<A Mac Pointer #x102D20>
-CFFI> (loop for i from 0 below 4
- collect (mem-aref * :string i))
-@result{} ("foo" "bar" "baz" NIL)
-CFFI> (progn
- (dotimes (i 3)
- (foreign-free (mem-aref ** :pointer i)))
- (foreign-free **))
-@result{} nil
-@end lisp
-
-@subheading See Also
-@seealso{foreign-free} @*
-@seealso{with-foreign-object} @*
-@seealso{with-foreign-pointer}
-
-
-@c ===================================================================
-@c FOREIGN-SYMBOL-POINTER
-
-@page
-@node foreign-symbol-pointer, inc-pointer, foreign-alloc, Pointers
-@heading foreign-symbol-pointer
-@subheading Syntax
-@Function{foreign-symbol-pointer foreign-name &key library @res{} pointer}
-
-@subheading Arguments and Values
-
-@table @var
-@item foreign-name
-A string.
-
-@item pointer
-A foreign pointer, or @code{nil}.
-
-@item library
-A Lisp symbol or an instance of @code{foreign-library}.
-@end table
-
-@subheading Description
-The function @code{foreign-symbol-pointer} will return a foreign
-pointer corresponding to the foreign symbol denoted by the string
-@var{foreign-name}. If a foreign symbol named @var{foreign-name}
-doesn't exist, @code{nil} is returned.
-
-ABI name manglings will be performed on @var{foreign-name} by
-@code{foreign-symbol-pointer} if necessary. (eg: adding a leading
-underscore on darwin/ppc)
-
-@var{library} should name a foreign library as defined by
-@code{define-foreign-library}, @code{:default} (which is the default)
-or an instance of @code{foreign-library} as returned by
-@code{load-foreign-library}.
-
-@strong{Important note:} do not keep these pointers across saved Lisp
-cores as the foreign-library may move across sessions.
-
-@subheading Examples
-
-@lisp
-CFFI> (foreign-symbol-pointer "errno")
-@result{} #<A Mac Pointer #xA0008130>
-CFFI> (foreign-symbol-pointer "strerror")
-@result{} #<A Mac Pointer #x9002D0F8>
-CFFI> (foreign-funcall-pointer * () :int (mem-ref ** :int) :string)
-@result{} "No such file or directory"
-
-CFFI> (foreign-symbol-pointer "inexistent symbol")
-@result{} NIL
-@end lisp
-
-@subheading See Also
-@seealso{defcvar}
-
-
-@c ===================================================================
-@c INC-POINTER
-
-@page
-@node inc-pointer, incf-pointer, foreign-symbol-pointer, Pointers
-@heading inc-pointer
-@subheading Syntax
-@Function{inc-pointer pointer offset @res{} new-pointer}
-
-@subheading Arguments and Values
-
-@table @var
-@item pointer
-@itemx new-pointer
-A foreign pointer.
-
-@item offset
-An integer.
-@end table
-
-@subheading Description
-The function @code{inc-pointer} will return a @var{new-pointer} pointing
-@var{offset} bytes past @var{pointer}.
-
-@subheading Examples
-
-@lisp
-CFFI> (foreign-string-alloc "Common Lisp")
-@result{} #<A Mac Pointer #x102EA0>
-CFFI> (inc-pointer * 7)
-@result{} #<A Mac Pointer #x102EA7>
-CFFI> (foreign-string-to-lisp *)
-@result{} "Lisp"
-@end lisp
-
-@subheading See Also
-@seealso{incf-pointer} @*
-@seealso{make-pointer} @*
-@seealso{pointerp} @*
-@seealso{null-pointer} @*
-@seealso{null-pointer-p}
-
-
-@c ===================================================================
-@c INCF-POINTER
-
-@page
-@node incf-pointer, make-pointer, inc-pointer, Pointers
-@heading incf-pointer
-@subheading Syntax
-@Macro{incf-pointer place &optional (offset 1) @res{} new-pointer}
-
-@subheading Arguments and Values
-
-@table @var
-@item place
-A @code{setf} place.
-
-@item new-pointer
-A foreign pointer.
-
-@item offset
-An integer.
-@end table
-
-@subheading Description
-The @code{incf-pointer} macro takes the foreign pointer from
-@var{place} and creates a @var{new-pointer} incremented by
-@var{offset} bytes and which is stored in @var{place}.
-
-@subheading Examples
-
-@lisp
-CFFI> (defparameter *two-words* (foreign-string-alloc "Common Lisp"))
-@result{} *TWO-WORDS*
-CFFI> (defparameter *one-word* *two-words*)
-@result{} *ONE-WORD*
-CFFI> (incf-pointer *one-word* 7)
-@result{} #.(SB-SYS:INT-SAP #X00600457)
-CFFI> (foreign-string-to-lisp *one-word*)
-@result{} "Lisp"
-CFFI> (foreign-string-to-lisp *two-words*)
-@result{} "Common Lisp"
-@end lisp
-
-@subheading See Also
-@seealso{inc-pointer} @*
-@seealso{make-pointer} @*
-@seealso{pointerp} @*
-@seealso{null-pointer} @*
-@seealso{null-pointer-p}
-
-
-@c ===================================================================
-@c MAKE-POINTER
-
-@page
-@node make-pointer, mem-aptr, incf-pointer, Pointers
-@heading make-pointer
-@subheading Syntax
-@Function{make-pointer address @res{} ptr}
-
-@subheading Arguments and Values
-
-@table @var
-@item address
-An integer.
-
-@item ptr
-A foreign pointer.
-@end table
-
-@subheading Description
-The function @code{make-pointer} will return a foreign pointer
-pointing to @var{address}.
-
-@subheading Examples
-
-@lisp
-CFFI> (make-pointer 42)
-@result{} #<FOREIGN-ADDRESS #x0000002A>
-CFFI> (pointerp *)
-@result{} T
-CFFI> (pointer-address **)
-@result{} 42
-CFFI> (inc-pointer *** -42)
-@result{} #<FOREIGN-ADDRESS #x00000000>
-CFFI> (null-pointer-p *)
-@result{} T
-CFFI> (typep ** 'foreign-pointer)
-@result{} T
-@end lisp
-
-@subheading See Also
-@seealso{inc-pointer} @*
-@seealso{null-pointer} @*
-@seealso{null-pointer-p} @*
-@seealso{pointerp} @*
-@seealso{pointer-address} @*
-@seealso{pointer-eq} @*
-@seealso{mem-ref}
-
-
-@c ===================================================================
-@c MEM-APTR
-
-@page
-@node mem-aptr, mem-aref, make-pointer, Pointers
-@heading mem-aptr
-@subheading Syntax
-@Accessor{mem-aptr ptr type &optional (index 0)}
-
-@subheading Arguments and Values
-
-@table @var
-@item ptr
-A foreign pointer.
-
-@item type
-A foreign type.
-
-@item index
-An integer.
-
-@item new-value
-A Lisp value compatible with @var{type}.
-@end table
-
-@subheading Description
-The @code{mem-aptr} function finds the pointer to an element of the array.
-
-@lisp
-(mem-aptr ptr type n)
-
-;; @lispcmt{is identical to:}
-
-(inc-pointer ptr (* n (foreign-type-size type)))
-@end lisp
-
-@subheading Examples
-
-@lisp
-CFFI> (with-foreign-string (str "Hello, foreign world!")
- (mem-aptr str :char 6))
-@result{} #.(SB-SYS:INT-SAP #X0063D4B6)
-@end lisp
-
-@c ===================================================================
-@c MEM-AREF
-
-@page
-@node mem-aref, mem-ref, mem-aptr, Pointers
-@heading mem-aref
-@subheading Syntax
-@Accessor{mem-aref ptr type &optional (index 0)}
-
-(setf (@strong{mem-aref} @emph{ptr type &optional (index 0)) new-value})
-
-@subheading Arguments and Values
-
-@table @var
-@item ptr
-A foreign pointer.
-
-@item type
-A foreign type.
-
-@item index
-An integer.
-
-@item new-value
-A Lisp value compatible with @var{type}.
-@end table
-
-@subheading Description
-The @code{mem-aref} function is similar to @code{mem-ref} but will
-automatically calculate the offset from an @var{index}.
-
-@lisp
-(mem-aref ptr type n)
-
-;; @lispcmt{is identical to:}
-
-(mem-ref ptr type (* n (foreign-type-size type)))
-@end lisp
-
-@subheading Examples
-
-@lisp
-CFFI> (with-foreign-string (str "Hello, foreign world!")
- (mem-aref str :char 6))
-@result{} 32
-CFFI> (code-char *)
-@result{} #\Space
-
-CFFI> (with-foreign-object (array :int 10)
- (loop for i below 10
- do (setf (mem-aref array :int i) (random 100)))
- (loop for i below 10 collect (mem-aref array :int i)))
-@result{} (22 7 22 52 69 1 46 93 90 65)
-@end lisp
-
-@subheading Compatibility Note
-
-For compatibility with older versions of CFFI, @ref{mem-aref} will
-produce a pointer for the deprecated bare structure specification, but
-it is consistent with other types for the current specification form
-@code{(:struct @var{structure-name})} and provides a Lisp object
-translated from the structure (by default a plist). In order to obtain
-the pointer, you should use the new function @ref{mem-aptr}.
-
-@subheading See Also
-@seealso{mem-ref} @*
-@seealso{mem-aptr}
-
-@c ===================================================================
-@c MEM-REF
-
-@page
-@node mem-ref, null-pointer, mem-aref, Pointers
-@heading mem-ref
-@subheading Syntax
-@Accessor{mem-ref ptr type &optional offset @res{} object}
-
-@subheading Arguments and Values
-
-@table @var
-@item ptr
-A pointer.
-
-@item type
-A foreign type.
-
-@item offset
-An integer (in byte units).
-
-@item object
-The value @var{ptr} points to.
-@end table
-
-@subheading Description
-@subheading Examples
-
-@lisp
-CFFI> (with-foreign-string (ptr "Saluton")
- (setf (mem-ref ptr :char 3) (char-code #\a))
- (loop for i from 0 below 8
- collect (code-char (mem-ref ptr :char i))))
-@result{} (#\S #\a #\l #\a #\t #\o #\n #\Null)
-CFFI> (setq ptr-to-int (foreign-alloc :int))
-@result{} #<A Mac Pointer #x1047D0>
-CFFI> (mem-ref ptr-to-int :int)
-@result{} 1054619
-CFFI> (setf (mem-ref ptr-to-int :int) 1984)
-@result{} 1984
-CFFI> (mem-ref ptr-to-int :int)
-@result{} 1984
-@end lisp
-
-@subheading See Also
-@seealso{mem-aref}
-
-
-@c ===================================================================
-@c NULL-POINTER
-
-@page
-@node null-pointer, null-pointer-p, mem-ref, Pointers
-@heading null-pointer
-@subheading Syntax
-@Function{null-pointer @res{} pointer}
-
-@subheading Arguments and Values
-
-@table @var
-@item pointer
-A @code{NULL} pointer.
-@end table
-
-@subheading Description
-The function @code{null-pointer} returns a null pointer.
-
-@subheading Examples
-
-@lisp
-CFFI> (null-pointer)
-@result{} #<A Null Mac Pointer>
-CFFI> (pointerp *)
-@result{} T
-@end lisp
-
-@subheading See Also
-@seealso{null-pointer-p} @*
-@seealso{make-pointer}
-
-
-@c ===================================================================
-@c NULL-POINTER-P
-
-@page
-@node null-pointer-p, pointerp, null-pointer, Pointers
-@heading null-pointer-p
-@subheading Syntax
-@Function{null-pointer-p ptr @res{} boolean}
-
-@subheading Arguments and Values
-
-@table @var
-@item ptr
-A foreign pointer that may be a null pointer.
-
-@item boolean
-@code{T} or @code{NIL}.
-@end table
-
-@subheading Description
-The function @code{null-pointer-p} returns true if @var{ptr} is a null
-pointer and false otherwise.
-
-@subheading Examples
-
-@lisp
-CFFI> (null-pointer-p (null-pointer))
-@result{} T
-@end lisp
-
-@lisp
-(defun contains-str-p (big little)
- (not (null-pointer-p
- (foreign-funcall "strstr" :string big :string little :pointer))))
-
-CFFI> (contains-str-p "Popcorns" "corn")
-@result{} T
-CFFI> (contains-str-p "Popcorns" "salt")
-@result{} NIL
-@end lisp
-
-@subheading See Also
-@seealso{null-pointer} @*
-@seealso{pointerp}
-
-
-@c ===================================================================
-@c POINTERP
-
-@page
-@node pointerp, pointer-address, null-pointer-p, Pointers
-@heading pointerp
-@subheading Syntax
-@Function{pointerp ptr @res{} boolean}
-
-@subheading Arguments and Values
-
-@table @var
-@item ptr
-An object that may be a foreign pointer.
-
-@item boolean
-@code{T} or @code{NIL}.
-@end table
-
-@subheading Description
-The function @code{pointerp} returns true if @var{ptr} is a foreign
-pointer and false otherwise.
-
-@subheading Implementation-specific Notes
-In Allegro CL, foreign pointers are integers thus in this
-implementation @code{pointerp} will return true for any ordinary integer.
-
-@subheading Examples
-
-@lisp
-CFFI> (foreign-alloc 32)
-@result{} #<A Mac Pointer #x102D20>
-CFFI> (pointerp *)
-@result{} T
-CFFI> (pointerp "this is not a pointer")
-@result{} NIL
-@end lisp
-
-@subheading See Also
-@seealso{make-pointer}
-@seealso{null-pointer-p}
-
-
-@c ===================================================================
-@c POINTER-ADDRESS
-
-@page
-@node pointer-address, pointer-eq, pointerp, Pointers
-@heading pointer-address
-@subheading Syntax
-@Function{pointer-address ptr @res{} address}
-
-@subheading Arguments and Values
-
-@table @var
-@item ptr
-A foreign pointer.
-
-@item address
-An integer.
-@end table
-
-@subheading Description
-The function @code{pointer-address} will return the @var{address} of
-a foreign pointer @var{ptr}.
-
-@subheading Examples
-
-@lisp
-CFFI> (pointer-address (null-pointer))
-@result{} 0
-CFFI> (pointer-address (make-pointer 123))
-@result{} 123
-@end lisp
-
-@subheading See Also
-@seealso{make-pointer} @*
-@seealso{inc-pointer} @*
-@seealso{null-pointer} @*
-@seealso{null-pointer-p} @*
-@seealso{pointerp} @*
-@seealso{pointer-eq} @*
-@seealso{mem-ref}
-
-
-@c ===================================================================
-@c POINTER-EQ
-
-@page
-@node pointer-eq, with-foreign-object, pointer-address, Pointers
-@heading pointer-eq
-@subheading Syntax
-@Function{pointer-eq ptr1 ptr2 @res{} boolean}
-
-@subheading Arguments and Values
-
-@table @var
-@item ptr1
-@itemx ptr2
-A foreign pointer.
-
-@item boolean
-@code{T} or @code{NIL}.
-@end table
-
-@subheading Description
-The function @code{pointer-eq} returns true if @var{ptr1} and
-@var{ptr2} point to the same memory address and false otherwise.
-
-@subheading Implementation-specific Notes
-The representation of foreign pointers varies across the various Lisp
-implementations as does the behaviour of the built-in Common Lisp
-equality predicates. Comparing two pointers that point to the same
-address with @code{EQ} Lisps will return true on some Lisps, others require
-more general predicates like @code{EQL} or @code{EQUALP} and finally
-some will return false using any of these predicates. Therefore, for
-portability, you should use @code{POINTER-EQ}.
-
-@subheading Examples
-This is an example using @acronym{SBCL}, see the
-implementation-specific notes above.
-
-@lisp
-CFFI> (eql (null-pointer) (null-pointer))
-@result{} NIL
-CFFI> (pointer-eq (null-pointer) (null-pointer))
-@result{} T
-@end lisp
-
-@subheading See Also
-@seealso{inc-pointer}
-
-
-@c ===================================================================
-@c WITH-FOREIGN-OBJECT
-
-@page
-@node with-foreign-object, with-foreign-pointer, pointer-eq, Pointers
-@heading with-foreign-object, with-foreign-objects
-@subheading Syntax
-@Macro{with-foreign-object (var type &optional count) &body body}
-
-@anchor{with-foreign-objects}
-@Macro{with-foreign-objects (bindings) &body body}
-
-bindings ::= @{(var type &optional count)@}*
-
-@subheading Arguments and Values
-
-@table @var
-@item var
-A symbol.
-
-@item type
-A foreign type, evaluated.
-
-@item count
-An integer.
-@end table
-
-@subheading Description
-The macros @code{with-foreign-object} and @code{with-foreign-objects}
-bind @var{var} to a pointer to @var{count} newly allocated objects
-of type @var{type} during @var{body}. The buffer has dynamic extent
-and may be stack allocated if supported by the host Lisp.
-
-@subheading Examples
-
-@lisp
-CFFI> (with-foreign-object (array :int 10)
- (dotimes (i 10)
- (setf (mem-aref array :int i) (random 100)))
- (loop for i below 10
- collect (mem-aref array :int i)))
-@result{} (22 7 22 52 69 1 46 93 90 65)
-@end lisp
-
-@subheading See Also
-@seealso{foreign-alloc}
-
-
-@c ===================================================================
-@c WITH-FOREIGN-POINTER
-
-@page
-@node with-foreign-pointer, , with-foreign-object, Pointers
-@heading with-foreign-pointer
-@subheading Syntax
-@Macro{with-foreign-pointer (var size &optional size-var) &body body}
-
-@subheading Arguments and Values
-
-@table @var
-@item var
-@itemx size-var
-A symbol.
-
-@item size
-An integer.
-
-@item body
-A list of forms to be executed.
-@end table
-
-@subheading Description
-The @code{with-foreign-pointer} macro, binds @var{var} to @var{size}
-bytes of foreign memory during @var{body}. The pointer in @var{var}
-is invalid beyond the dynamic extend of @var{body} and may be
-stack-allocated if supported by the implementation.
-
-If @var{size-var} is supplied, it will be bound to @var{size} during
-@var{body}.
-
-@subheading Examples
-
-@lisp
-CFFI> (with-foreign-pointer (string 4 size)
- (setf (mem-ref string :char (1- size)) 0)
- (lisp-string-to-foreign "Popcorns" string size)
- (loop for i from 0 below size
- collect (code-char (mem-ref string :char i))))
-@result{} (#\P #\o #\p #\Null)
-@end lisp
-
-@subheading See Also
-@seealso{foreign-alloc} @*
-@seealso{foreign-free}
-
-
-@c ===================================================================
-@c CHAPTER: Strings
-
-@node Strings, Variables, Pointers, Top
-@chapter Strings
-
-As with many languages, Lisp and C have special support for logical
-arrays of characters, going so far as to give them a special name,
-``strings''. In that spirit, @cffi{} provides special support for
-translating between Lisp and C strings.
-
-The @code{:string} type and the symbols related below also serve as an
-example of what you can do portably with @cffi{}; were it not
-included, you could write an equally functional @file{strings.lisp}
-without referring to any implementation-specific symbols.
-
-@menu
-Dictionary
-
-* *default-foreign-encoding*::
-* foreign-string-alloc::
-* foreign-string-free::
-* foreign-string-to-lisp::
-* lisp-string-to-foreign::
-* with-foreign-string::
-* with-foreign-strings::
-* with-foreign-pointer-as-string::
-@end menu
-
-
-@c ===================================================================
-@c *DEFAULT-FOREIGN-ENCODING*
-
-@page
-@node *default-foreign-encoding*, foreign-string-alloc, Strings, Strings
-@heading *default-foreign-encoding*
-@subheading Syntax
-
-@Variable{*default-foreign-encoding*}
-
-@subheading Value type
-
-A keyword.
-
-@subheading Initial value
-
-@code{:utf-8}
-
-@subheading Description
-
-This special variable holds the default foreign encoding.
-
-@subheading Examples
-
-@lisp
-CFFI> *default-foreign-encoding*
-:utf-8
-CFFI> (foreign-funcall "strdup" (:string :encoding :utf-16) "foo" :string)
-"f"
-CFFI> (let ((*default-foreign-encoding* :utf-16))
- (foreign-funcall "strdup" (:string :encoding :utf-16) "foo" :string))
-"foo"
-@end lisp
-
-@subheading See also
-
-@seealso{Other Types} (@code{:string} type) @*
-@seealso{foreign-string-alloc} @*
-@seealso{foreign-string-to-lisp} @*
-@seealso{lisp-string-to-foreign} @*
-@seealso{with-foreign-string} @*
-@seealso{with-foreign-pointer-as-string}
-
-
-@c ===================================================================
-@c FOREIGN-STRING-ALLOC
-
-@page
-@node foreign-string-alloc, foreign-string-free, *default-foreign-encoding*, Strings
-@heading foreign-string-alloc
-@subheading Syntax
-@Function{foreign-string-alloc string &key encoding null-terminated-p @
- start end @res{} pointer}
-
-@subheading Arguments and Values
-
-@table @emph
-@item @var{string}
-A Lisp string.
-
-@item @var{encoding}
-Foreign encoding. Defaults to @code{*default-foreign-encoding*}.
-
-@item @var{null-terminated-p}
-Boolean, defaults to true.
-
-@item @var{start}, @var{end}
-Bounding index designators of @var{string}. 0 and @code{nil}, by
-default.
-
-@item @var{pointer}
-A pointer to the newly allocated foreign string.
-@end table
-
-@subheading Description
-The @code{foreign-string-alloc} function allocates foreign memory
-holding a copy of @var{string} converted using the specified
-@var{encoding}. @var{Start} specifies an offset into @var{string} and
-@var{end} marks the position following the last element of the foreign
-string.
-
-This string must be freed with @code{foreign-string-free}.
-
-If @var{null-terminated-p} is false, the string will not be
-null-terminated.
-
-@subheading Examples
-
-@lisp
-CFFI> (defparameter *str* (foreign-string-alloc "Hello, foreign world!"))
-@result{} #<FOREIGN-ADDRESS #x00400560>
-CFFI> (foreign-funcall "strlen" :pointer *str* :int)
-@result{} 21
-@end lisp
-
-@subheading See Also
-@seealso{foreign-string-free} @*
-@seealso{with-foreign-string}
-@c @seealso{:string}
-
-
-@c ===================================================================
-@c FOREIGN-STRING-FREE
-
-@page
-@node foreign-string-free, foreign-string-to-lisp, foreign-string-alloc, Strings
-@heading foreign-string-free
-@subheading Syntax
-@Function{foreign-string-free pointer}
-
-@subheading Arguments and Values
-
-@table @var
-@item pointer
-A pointer to a string allocated by @code{foreign-string-alloc}.
-@end table
-
-@subheading Description
-The @code{foreign-string-free} function frees a foreign string
-allocated by @code{foreign-string-alloc}.
-
-@subheading Examples
-
-@subheading See Also
-@seealso{foreign-string-alloc}
-
-
-@c ===================================================================
-@c FOREIGN-STRING-TO-LISP
-
-@page
-@node foreign-string-to-lisp, lisp-string-to-foreign, foreign-string-free, Strings
-@heading foreign-string-to-lisp
-@subheading Syntax
-@Function{foreign-string-to-lisp ptr &key offset count max-chars @
- encoding @res{} string}
-
-@subheading Arguments and Values
-
-@table @var
-@item ptr
-A pointer.
-
-@item offset
-An integer greater than or equal to 0. Defauls to 0.
-
-@item count
-Either @code{nil} (the default), or an integer greater than or equal to 0.
-
-@item max-chars
-An integer greater than or equal to 0.
-@code{(1- array-total-size-limit)}, by default.
-
-@item encoding
-Foreign encoding. Defaults to @code{*default-foreign-encoding*}.
-
-@item string
-A Lisp string.
-@end table
-
-@subheading Description
-The @code{foreign-string-to-lisp} function converts at most
-@var{count} octets from @var{ptr} into a Lisp string, using the
-defined @var{encoding}.
-
-If @var{count} is @code{nil} (the default), characters are copied
-until @var{max-chars} is reached or a @code{NULL} character is found.
-
-If @var{ptr} is a null pointer, returns @code{nil}.
-
-Note that the @code{:string} type will automatically convert between
-Lisp strings and foreign strings.
-
-@subheading Examples
-
-@lisp
-CFFI> (foreign-funcall "getenv" :string "HOME" :pointer)
-@result{} #<FOREIGN-ADDRESS #xBFFFFFD5>
-CFFI> (foreign-string-to-lisp *)
-@result{} "/Users/luis"
-@end lisp
-
-@subheading See Also
-@seealso{lisp-string-to-foreign} @*
-@seealso{foreign-string-alloc}
-@c @seealso{:string}
-
-
-@c ===================================================================
-@c LISP-STRING-TO-FOREIGN
-
-@page
-@node lisp-string-to-foreign, with-foreign-string, foreign-string-to-lisp, Strings
-@heading lisp-string-to-foreign
-@subheading Syntax
-@Function{lisp-string-to-foreign string buffer bufsize &key start @
- end offset encoding @res{} buffer}
-
-@subheading Arguments and Values
-
-@table @emph
-@item @var{string}
-A Lisp string.
-
-@item @var{buffer}
-A foreign pointer.
-
-@item @var{bufsize}
-An integer.
-
-@item @var{start}, @var{end}
-Bounding index designators of @var{string}. 0 and @code{nil}, by
-default.
-
-@item @var{offset}
-An integer greater than or equal to 0. Defauls to 0.
-
-@item @var{encoding}
-Foreign encoding. Defaults to @code{*default-foreign-encoding*}.
-@end table
-
-@subheading Description
-The @code{lisp-string-to-foreign} function copies at most
-@var{bufsize}-1 octets from a Lisp @var{string} using the specified
-@var{encoding} into @var{buffer}+@var{offset}. The foreign string will
-be null-terminated.
-
-@var{Start} specifies an offset into @var{string} and
-@var{end} marks the position following the last element of the foreign
-string.
-
-@subheading Examples
-
-@lisp
-CFFI> (with-foreign-pointer-as-string (str 255)
- (lisp-string-to-foreign "Hello, foreign world!" str 6))
-@result{} "Hello"
-@end lisp
-
-@subheading See Also
-@seealso{foreign-string-alloc} @*
-@seealso{foreign-string-to-lisp} @*
-@seealso{with-foreign-pointer-as-string}
-
-
-@c ===================================================================
-@c WITH-FOREIGN-STRING
-
-@page
-@node with-foreign-string, with-foreign-pointer-as-string, lisp-string-to-foreign, Strings
-@heading with-foreign-string, with-foreign-strings
-@subheading Syntax
-@Macro{with-foreign-string (var-or-vars string &rest args) &body body}
-
-@anchor{with-foreign-strings}
-@Macro{with-foreign-strings (bindings) &body body}
-
-var-or-vars ::= var | (var &optional octet-size-var)
-bindings ::= @{(var-or-vars string &rest args)@}*
-
-@subheading Arguments and Values
-
-@table @emph
-@item @var{var}, @var{byte-size-var}
-A symbol.
-
-@item @var{string}
-A Lisp string.
-
-@item @var{body}
-A list of forms to be executed.
-@end table
-
-@subheading Description
-The @code{with-foreign-string} macro will bind @var{var} to a newly
-allocated foreign string containing @var{string}. @var{Args} is passed
-to the underlying @code{foreign-string-alloc} call.
-
-If @var{octet-size-var} is provided, it will be bound the length of
-foreign string in octets including the null terminator.
-
-@subheading Examples
-
-@lisp
-CFFI> (with-foreign-string (foo "12345")
- (foreign-funcall "strlen" :pointer foo :int))
-@result{} 5
-
-CFFI> (let ((array (coerce #(84 117 114 97 110 103 97)
- '(array (unsigned-byte 8)))))
- (with-foreign-string (foreign-string array)
- (foreign-string-to-lisp foreign-string)))
-@result{} "Turanga"
-@end lisp
-
-@subheading See Also
-@seealso{foreign-string-alloc} @*
-@seealso{with-foreign-pointer-as-string}
-
-
-@c ===================================================================
-@c WITH-FOREIGN-POINTER-AS-STRING
-
-@page
-@node with-foreign-pointer-as-string, , with-foreign-string, Strings
-@heading with-foreign-pointer-as-string
-@subheading Syntax
-@Macro{with-foreign-pointer-as-string (var size &optional size-var @
- &rest args) &body body @res{} string}
-
-@subheading Arguments and Values
-
-@table @var
-@item var
-A symbol.
-
-@item string
-A Lisp string.
-
-@item body
-List of forms to be executed.
-@end table
-
-@subheading Description
-The @code{with-foreign-pointer-as-string} macro is similar to
-@code{with-foreign-pointer} except that @var{var} is used as the
-returned value of an implicit @code{progn} around @var{body}, after
-being converted to a Lisp string using the provided @var{args}.
-
-@subheading Examples
-
-@lisp
-CFFI> (with-foreign-pointer-as-string (str 6 str-size :encoding :ascii)
- (lisp-string-to-foreign "Hello, foreign world!" str str-size))
-@result{} "Hello"
-@end lisp
-
-@subheading See Also
-@seealso{foreign-string-alloc} @*
-@seealso{with-foreign-string}
-
-
-@c ===================================================================
-@c CHAPTER: Variables
-
-@node Variables, Functions, Strings, Top
-@chapter Variables
-
-@menu
-Dictionary
-
-* defcvar::
-* get-var-pointer::
-@end menu
-
-
-@c ===================================================================
-@c DEFCVAR
-
-@page
-@node defcvar, get-var-pointer, Variables, Variables
-@heading defcvar
-@subheading Syntax
-@Macro{defcvar name-and-options type &optional documentation @res{} lisp-name}
-
-@var{name-and-options} ::= name | (name &key read-only (library :default)) @*
-@var{name} ::= lisp-name [foreign-name] | foreign-name [lisp-name]
-
-@subheading Arguments and Values
-
-@table @var
-@item foreign-name
-A string denoting a foreign function.
-
-@item lisp-name
-A symbol naming the Lisp function to be created.
-
-@item type
-A foreign type.
-
-@item read-only
-A boolean.
-
-@item documentation
-A Lisp string; not evaluated.
-@end table
-
-@subheading Description
-The @code{defcvar} macro defines a symbol macro @var{lisp-name} that looks
-up @var{foreign-name} and dereferences it acording to @var{type}. It
-can also be @code{setf}ed, unless @var{read-only} is true, in which
-case an error will be signaled.
-
-When one of @var{lisp-name} or @var{foreign-name} is omitted, the
-other is automatically derived using the following rules:
-
-@itemize
-@item
-Foreign names are converted to Lisp names by uppercasing, replacing
-underscores with hyphens, and wrapping around asterisks.
-@item
-Lisp names are converted to foreign names by lowercasing, replacing
-hyphens with underscores, and removing asterisks, if any.
-@end itemize
-
-@subheading Examples
-
-@lisp
-CFFI> (defcvar "errno" :int)
-@result{} *ERRNO*
-CFFI> (foreign-funcall "strerror" :int *errno* :string)
-@result{} "Inappropriate ioctl for device"
-CFFI> (setf *errno* 1)
-@result{} 1
-CFFI> (foreign-funcall "strerror" :int *errno* :string)
-@result{} "Operation not permitted"
-@end lisp
-
-Trying to modify a read-only foreign variable:
-
-@lisp
-CFFI> (defcvar ("errno" +error-number+ :read-only t) :int)
-@result{} +ERROR-NUMBER+
-CFFI> (setf +error-number+ 12)
-;; @lispcmt{@error{} Trying to modify read-only foreign var: +ERROR-NUMBER+.}
-@end lisp
-
-@emph{Note that accessing @code{errno} this way won't work with every
-implementation of the C standard library.}
-
-@subheading See Also
-@seealso{get-var-pointer}
-
-
-@c ===================================================================
-@c GET-VAR-POINTER
-
-@page
-@node get-var-pointer, , defcvar, Variables
-@heading get-var-pointer
-@subheading Syntax
-@Function{get-var-pointer symbol @res{} pointer}
-
-@subheading Arguments and Values
-
-@table @var
-@item symbol
-A symbol denoting a foreign variable defined with @code{defcvar}.
-
-@item pointer
-A foreign pointer.
-@end table
-
-@subheading Description
-The function @code{get-var-pointer} will return a @var{pointer} to the
-foreign global variable @var{symbol} previously defined with
-@code{defcvar}.
-
-@subheading Examples
-
-@lisp
-CFFI> (defcvar "errno" :int :read-only t)
-@result{} *ERRNO*
-CFFI> *errno*
-@result{} 25
-CFFI> (get-var-pointer '*errno*)
-@result{} #<A Mac Pointer #xA0008130>
-CFFI> (mem-ref * :int)
-@result{} 25
-@end lisp
-
-@subheading See Also
-@seealso{defcvar}
-
-
-@c ===================================================================
-@c CHAPTER: Functions
-
-@node Functions, Libraries, Variables, Top
-@chapter Functions
-
-@menu
-@c * Defining Foreign Functions::
-@c * Calling Foreign Functions::
-
-Dictionary
-
-* defcfun::
-* foreign-funcall::
-* foreign-funcall-pointer::
-* foreign-funcall-varargs::
-* foreign-funcall-pointer-varargs::
-* translate-camelcase-name::
-* translate-name-from-foreign::
-* translate-name-to-foreign::
-* translate-underscore-separated-name::
-@end menu
-
-@c @node Calling Foreign Functions
-@c @section Calling Foreign Functions
-
-@c @node Defining Foreign Functions
-@c @section Defining Foreign Functions
-
-
-@c ===================================================================
-@c DEFCFUN
-
-@page
-@node defcfun, foreign-funcall, Functions, Functions
-@heading defcfun
-@subheading Syntax
-@Macro{defcfun name-and-options return-type &body [docstring] arguments [&rest] @
- @res{} lisp-name}
-
-@var{name-and-options} ::= @var{name} | (@var{name} &key @var{library} @var{convention}) @*
-@var{name} ::= @var{lisp-name} [@var{foreign-name}] | @var{foreign-name} [@var{lisp-name}] @*
-@var{arguments} ::= @{ (@var{arg-name} @var{arg-type}) @}* @*
-
-@subheading Arguments and Values
-
-@table @var
-@item foreign-name
-A string denoting a foreign function.
-
-@item lisp-name
-A symbol naming the Lisp function to be created.
-
-@item arg-name
-A symbol.
-
-@item return-type
-@itemx arg-type
-A foreign type.
-
-@item convention
-One of @code{:cdecl} (default) or @code{:stdcall}.
-
-@item library
-A symbol designating a foreign library.
-
-@item docstring
-A documentation string.
-@end table
-
-@subheading Description
-The @code{defcfun} macro provides a declarative interface for defining
-Lisp functions that call foreign functions.
-
-When one of @var{lisp-name} or @var{foreign-name} is omitted, the
-other is automatically derived using the following rules:
-
-@itemize
-@item
-Foreign names are converted to Lisp names by uppercasing and replacing
-underscores with hyphens.
-@item
-Lisp names are converted to foreign names by lowercasing and replacing
-hyphens with underscores.
-@end itemize
-
-If you place the symbol @code{&rest} in the end of the argument list
-after the fixed arguments, @code{defcfun} will treat the foreign
-function as a @strong{variadic function}. The variadic arguments
-should be passed in a way similar to what @code{foreign-funcall} would
-expect. Unlike @code{foreign-funcall} though, @code{defcfun} will take
-care of doing argument promotion. Note that in this case
-@code{defcfun} will generate a Lisp @emph{macro} instead of a
-function and will only work for Lisps that support
-@code{foreign-funcall.}
-
-If a foreign structure is to be passed or returned by value (that is,
-the type is of the form @code{(:struct ...)}), then the cffi-libffi system
-must be loaded, which in turn depends on
-@uref{http://sourceware.org/libffi/,libffi}, including the header files.
-Failure to load that system will result in an error.
-Variadic functions cannot at present accept or return structures by
-value.
-
-@subheading Examples
-
-@lisp
-(defcfun "strlen" :int
- "Calculate the length of a string."
- (n :string))
-
-CFFI> (strlen "123")
-@result{} 3
-@end lisp
-
-@lisp
-(defcfun ("abs" c-abs) :int (n :int))
-
-CFFI> (c-abs -42)
-@result{} 42
-@end lisp
-
-Function without arguments:
-
-@lisp
-(defcfun "rand" :int)
-
-CFFI> (rand)
-@result{} 1804289383
-@end lisp
-
-Variadic function example:
-
-@lisp
-(defcfun "sprintf" :int
- (str :pointer)
- (control :string)
- &rest)
-
-CFFI> (with-foreign-pointer-as-string (s 100)
- (sprintf s "%c %d %.2f %s" :char 90 :short 42 :float pi
- :string "super-locrian"))
-@result{} "A 42 3.14 super-locrian"
-@end lisp
-
-@subheading See Also
-@seealso{foreign-funcall} @*
-@seealso{foreign-funcall-pointer} @*
-@seealso{foreign-funcall-varargs} @*
-@seealso{foreign-funcall-pointer-varargs}
-
-
-@c ===================================================================
-@c FOREIGN-FUNCALL
-
-@page
-@node foreign-funcall, foreign-funcall-pointer, defcfun, Functions
-@heading foreign-funcall
-@subheading Syntax
-@Macro{foreign-funcall name-and-options &rest arguments @res{} return-value}
-
-@var{arguments} ::= @{ @var{arg-type} @var{arg} @}* [@var{return-type}] @*
-@var{name-and-options} ::= @var{name} | (@var{name} &key @var{library} @var{convention}) @*
-
-@subheading Arguments and Values
-
-@table @var
-@item name
-A Lisp string.
-
-@item arg-type
-A foreign type.
-
-@item arg
-An argument of type @var{arg-type}.
-
-@item return-type
-A foreign type, @code{:void} by default.
-
-@item return-value
-A lisp object.
-
-@item library
-A lisp symbol; not evaluated.
-
-@item convention
-One of @code{:cdecl} (default) or @code{:stdcall}.
-@end table
-
-@subheading Description
-The @code{foreign-funcall} macro is the main primitive for calling
-foreign functions.
-
-If a foreign structure is to be passed or returned by value (that is,
-the type is of the form @code{(:struct ...)}), then the cffi-libffi system
-must be loaded, which in turn depends on
-@uref{http://sourceware.org/libffi/,libffi}, including the header files.
-Failure to load that system will result in an error.
-Variadic functions cannot at present accept or return structures by
-value.
-
-@emph{Note: The return value of foreign-funcall on functions with a
-:void return type is still undefined.}
-
-@subheading Implementation-specific Notes
-@itemize
-@item
-Corman Lisp does not support @code{foreign-funcall}. On
-implementations that @strong{don't} support @code{foreign-funcall}
-@code{cffi-sys::no-foreign-funcall} will be present in
-@code{*features*}. Note: in these Lisps you can still use the
-@code{defcfun} interface.
-@end itemize
-
-@subheading Examples
-
-@lisp
-CFFI> (foreign-funcall "strlen" :string "foo" :int)
-@result{} 3
-@end lisp
-
-Given the C code:
-
-@example
-void print_number(int n)
-@{
- printf("N: %d\n", n);
-@}
-@end example
-
-@lisp
-CFFI> (foreign-funcall "print_number" :int 123456)
-@print{} N: 123456
-@result{} NIL
-@end lisp
-
-@noindent
-Or, equivalently:
-
-@lisp
-CFFI> (foreign-funcall "print_number" :int 123456 :void)
-@print{} N: 123456
-@result{} NIL
-@end lisp
-
-@lisp
-CFFI> (foreign-funcall "printf" :string (format nil "%s: %d.~%")
- :string "So long and thanks for all the fish"
- :int 42 :int)
-@print{} So long and thanks for all the fish: 42.
-@result{} 41
-@end lisp
-
-@subheading See Also
-@seealso{defcfun} @*
-@seealso{foreign-funcall-pointer}
-
-
-@c ===================================================================
-@c FOREIGN-FUNCALL-POINTER
-
-@page
-@node foreign-funcall-pointer, foreign-funcall-varargs, foreign-funcall, Functions
-@heading foreign-funcall-pointer
-@subheading Syntax
-@Macro{foreign-funcall-pointer pointer options &rest arguments @res{} return-value}
-
-@var{arguments} ::= @{ @var{arg-type} @var{arg} @}* [@var{return-type}] @*
-@var{options} ::= (&key @var{convention}) @*
-
-@subheading Arguments and Values
-
-@table @var
-@item pointer
-A foreign pointer.
-
-@item arg-type
-A foreign type.
-
-@item arg
-An argument of type @var{arg-type}.
-
-@item return-type
-A foreign type, @code{:void} by default.
-
-@item return-value
-A lisp object.
-
-@item convention
-One of @code{:cdecl} (default) or @code{:stdcall}.
-@end table
-
-@subheading Description
-The @code{foreign-funcall} macro is the main primitive for calling
-foreign functions.
-
-@emph{Note: The return value of foreign-funcall on functions with a
-:void return type is still undefined.}
-
-@subheading Implementation-specific Notes
-@itemize
-@item
-Corman Lisp does not support @code{foreign-funcall}. On
-implementations that @strong{don't} support @code{foreign-funcall}
-@code{cffi-sys::no-foreign-funcall} will be present in
-@code{*features*}. Note: in these Lisps you can still use the
-@code{defcfun} interface.
-@end itemize
-
-@subheading Examples
-
-@lisp
-CFFI> (foreign-funcall-pointer (foreign-symbol-pointer "abs") ()
- :int -42 :int)
-@result{} 42
-@end lisp
-
-@subheading See Also
-@seealso{defcfun} @*
-@seealso{foreign-funcall}
-
-
-@c ===================================================================
-@c FOREIGN-FUNCALL-VARARGS
-
-@page
-@node foreign-funcall-varargs, foreign-funcall-pointer-varargs, foreign-funcall-pointer, Functions
-@heading foreign-funcall-varargs
-@subheading Syntax
-@Macro{foreign-funcall-varargs name-and-options (fixed-arguments) &rest arguments @res{} return-value}
-
-@var{fixed-arguments} ::= @{ @var{arg-type} @var{arg} @}* [@var{return-type}] @*
-@var{arguments} ::= @{ @var{arg-type} @var{arg} @}* [@var{return-type}] @*
-@var{name-and-options} ::= @var{name} | (@var{name} &key @var{library} @var{convention}) @*
-
-@subheading Arguments and Values
-
-@table @var
-@item name
-A Lisp string.
-
-@item arg-type
-A foreign type.
-
-@item arg
-An argument of type @var{arg-type}.
-
-@item return-type
-A foreign type, @code{:void} by default.
-
-@item return-value
-A lisp object.
-
-@item library
-A lisp symbol; not evaluated.
-
-@item convention
-One of @code{:cdecl} (default) or @code{:stdcall}.
-@end table
-
-@subheading Description
-The @code{foreign-funcall-varargs} macro is the main primitive for
-calling foreign variadic functions. It behaves similarily to
-@code{foreign-funcall} except @code{fixed-arguments} are distinguished
-from the remaining arguments.
-
-@subheading Examples
-
-@lisp
-CFFI> (with-foreign-pointer-as-string (s 100)
- (setf (mem-ref s :char) 0)
- (foreign-funcall-varargs
- "sprintf" (:pointer s :string) "%.2f")
- :double (coerce pi 'double-float) :int))
-@result{} 3.14
-@end lisp
-
-
-@c ===================================================================
-@c FOREIGN-FUNCALL-POINTER-VARARGS
-
-@page
-@node foreign-funcall-pointer-varargs, translate-camelcase-name, foreign-funcall-varargs, Functions
-@heading foreign-funcall-pointer-varargs
-@subheading Syntax
-@Macro{foreign-funcall-pointer-varargs pointer options (fixed-arguments) &rest arguments @res{} return-value}
-
-@var{fixed-arguments} ::= @{ @var{arg-type} @var{arg} @}* [@var{return-type}] @*
-@var{arguments} ::= @{ @var{arg-type} @var{arg} @}* [@var{return-type}] @*
-@var{options} ::= (&key @var{convention}) @*
-
-@subheading Arguments and Values
-
-@table @var
-@item pointer
-A foreign pointer.
-
-@item arg-type
-A foreign type.
-
-@item arg
-An argument of type @var{arg-type}.
-
-@item return-type
-A foreign type, @code{:void} by default.
-
-@item return-value
-A lisp object.
-
-@item convention
-One of @code{:cdecl} (default) or @code{:stdcall}.
-@end table
-
-@subheading Description
-The @code{foreign-funcall-pointer-varargs} macro is the main primitive
-for calling foreign variadic functions. It behaves similarily to
-@code{foreign-funcall-pointer} except @code{fixed-arguments} are
-distinguished from the remaining arguments.
-
-@subheading Examples
-
-@lisp
-CFFI> (with-foreign-pointer-as-string (s 100)
- (setf (mem-ref s :char) 0)
- (foreign-funcall-pointer-varargs
- (foreign-symbol-pointer "sprintf") () (:pointer s :string "%.2f")
- :double (coerce pi 'double-float) :int))
-@result{} 3.14
-@end lisp
-
-
-@c ===================================================================
-@c TRANSLATE-CAMELCASE-NAME
-
-@page
-@node translate-camelcase-name, translate-name-from-foreign, foreign-funcall-pointer-varargs, Functions
-@heading translate-camelcase-name
-@subheading Syntax
-@Function{translate-camelcase-name name &key upper-initial-p special-words @res{} return-value}
-
-@subheading Arguments and Values
-
-@table @var
-@item name
-Either a symbol or a string.
-
-@item upper-initial-p
-A generalized boolean.
-
-@item special words
-A list of strings.
-
-@item return-value
-If @var{name} is a symbol, this is a string, and vice versa.
-@end table
-
-@subheading Description
-@code{translate-camelcase-name} is a helper function for
-specializations of @code{translate-name-from-foreign} and
-@code{translate-name-to-foreign}. It handles the common case of
-converting between foreign camelCase names and lisp
-names. @var{upper-initial-p} indicates whether the first letter of the
-foreign name should be uppercase. @var{special-words} is a list of
-strings that should be treated atomically in translation. This list is
-case-sensitive.
-
-@subheading Examples
-
-@lisp
-CFFI> (translate-camelcase-name some-xml-function)
-@result{} "someXmlFunction"
-CFFI> (translate-camelcase-name some-xml-function :upper-initial-p t)
-@result{} "SomeXmlFunction"
-CFFI> (translate-camelcase-name some-xml-function :special-words '("XML"))
-@result{} "someXMLFunction"
-CFFI> (translate-camelcase-name "someXMLFunction")
-@result{} SOME-X-M-L-FUNCTION
-CFFI> (translate-camelcase-name "someXMLFunction" :special-words '("XML"))
-@result{} SOME-XML-FUNCTION
-@end lisp
-
-@subheading See Also
-@seealso{translate-name-from-foreign} @*
-@seealso{translate-name-to-foreign} @*
-@seealso{translate-underscore-separated-name}
-
-
-@c ===================================================================
-@c TRANSLATE-NAME-FROM-FOREIGN
-
-@page
-@node translate-name-from-foreign, translate-name-to-foreign, translate-camelcase-name, Functions
-@heading translate-name-from-foreign
-@subheading Syntax
-@Function{translate-name-from-foreign foreign-name package &optional varp @res{} symbol}
-
-@subheading Arguments and Values
-
-@table @var
-@item foreign-name
-A string denoting a foreign function.
-
-@item package
-A Lisp package
-
-@item varp
-A generalized boolean.
-
-@item symbol
-The Lisp symbol to be used a function name.
-@end table
-
-@subheading Description
-@code{translate-name-from-foreign} is used by @ref{defcfun} to handle
-the conversion of foreign names to lisp names. By default, it
-translates using @ref{translate-underscore-separated-name}. However,
-you can create specialized methods on this function to make
-translating more closely match the foreign library's naming
-conventions.
-
-Specialize @var{package} on some package. This allows other packages
-to load libraries with different naming conventions.
-
-@subheading Examples
-
-@lisp
-CFFI> (defcfun "someXmlFunction" ...)
-@result{} SOMEXMLFUNCTION
-CFFI> (defmethod translate-name-from-foreign ((spec string)
- (package (eql *package*))
- &optional varp)
- (let ((name (translate-camelcase-name spec)))
- (if varp (intern (format nil "*~a*" name)) name)))
-@result{} #<STANDARD-METHOD TRANSLATE-NAME-FROM-FOREIGN (STRING (EQL #<Package "SOME-PACKAGE">))>
-CFFI> (defcfun "someXmlFunction" ...)
-@result{} SOME-XML-FUNCTION
-@end lisp
-
-@subheading See Also
-@seealso{defcfun} @*
-@seealso{translate-camelcase-name} @*
-@seealso{translate-name-to-foreign} @*
-@seealso{translate-underscore-separated-name}
-
-
-@c ===================================================================
-@c TRANSLATE-NAME-TO-FOREIGN
-
-@page
-@node translate-name-to-foreign, translate-underscore-separated-name, translate-name-from-foreign, Functions
-@heading translate-name-to-foreign
-@subheading Syntax
-@Function{translate-name-to-foreign lisp-name package &optional varp @res{} string}
-
-@subheading Arguments and Values
-
-@table @var
-@item lisp-name
-A symbol naming the Lisp function to be created.
-
-@item package
-A Lisp package
-
-@item varp
-A generalized boolean.
-
-@item string
-The string representing the foreign function name.
-@end table
-
-@subheading Description
-@code{translate-name-to-foreign} is used by @ref{defcfun} to handle
-the conversion of lisp names to foreign names. By default, it
-translates using @ref{translate-underscore-separated-name}. However,
-you can create specialized methods on this function to make
-translating more closely match the foreign library's naming
-conventions.
-
-Specialize @var{package} on some package. This allows other packages
-to load libraries with different naming conventions.
-
-@subheading Examples
-
-@lisp
-CFFI> (defcfun some-xml-function ...)
-@result{} "some_xml_function"
-CFFI> (defmethod translate-name-to-foreign ((spec symbol)
- (package (eql *package*))
- &optional varp)
- (let ((name (translate-camelcase-name spec)))
- (if varp (subseq name 1 (1- (length name))) name)))
-@result{} #<STANDARD-METHOD TRANSLATE-NAME-TO-FOREIGN (STRING (EQL #<Package "SOME-PACKAGE">))>
-CFFI> (defcfun some-xml-function ...)
-@result{} "someXmlFunction"
-@end lisp
-
-@subheading See Also
-@seealso{defcfun} @*
-@seealso{translate-camelcase-name} @*
-@seealso{translate-name-from-foreign} @*
-@seealso{translate-underscore-separated-name}
-
-
-@c ===================================================================
-@c TRANSLATE-UNDERSCORE-SEPARATED-NAME
-
-@page
-@node translate-underscore-separated-name, , translate-name-to-foreign, Functions
-@heading translate-underscore-separated-name
-@subheading Syntax
-@Function{translate-underscore-separated-name name @res{} return-value}
-
-@subheading Arguments and Values
-
-@table @var
-@item name
-Either a symbol or a string.
-
-@item return-value
-If @var{name} is a symbol, this is a string, and vice versa.
-@end table
-
-@subheading Description
-@code{translate-underscore-separated-name} is a helper function for
-specializations of @ref{translate-name-from-foreign} and
-@ref{translate-name-to-foreign}. It handles the common case of
-converting between foreign underscore_separated names and lisp names.
-
-@subheading Examples
-
-@lisp
-CFFI> (translate-underscore-separated-name some-xml-function)
-@result{} "some_xml_function"
-CFFI> (translate-camelcase-name "some_xml_function")
-@result{} SOME-XML-FUNCTION
-@end lisp
-
-@subheading See Also
-@seealso{translate-name-from-foreign} @*
-@seealso{translate-name-to-foreign} @*
-@seealso{translate-camelcase-name}
-
-
-@c ===================================================================
-@c CHAPTER: Libraries
-
-@node Libraries, Callbacks, Functions, Top
-@chapter Libraries
-
-@menu
-* Defining a library::
-* Library definition style::
-
-Dictionary
-
-* close-foreign-library:: Close a foreign library.
-* *darwin-framework-directories*:: Search path for Darwin frameworks.
-* define-foreign-library:: Explain how to load a foreign library.
-* *foreign-library-directories*:: Search path for shared libraries.
-* load-foreign-library:: Load a foreign library.
-* load-foreign-library-error:: Signalled on failure of its namesake.
-* use-foreign-library:: Load a foreign library when needed.
-@end menu
-
-
-@node Defining a library, Library definition style, Libraries, Libraries
-@section Defining a library
-
-Almost all foreign code you might want to access exists in some kind
-of shared library. The meaning of @dfn{shared library} varies among
-platforms, but for our purposes, we will consider it to include
-@file{.so} files on @sc{unix}, frameworks on Darwin (and derivatives
-like Mac @acronym{OS X}), and @file{.dll} files on Windows.
-
-Bringing one of these libraries into the Lisp image is normally a
-two-step process.
-
-@enumerate
-@item
-Describe to @cffi{} how to load the library at some future point,
-depending on platform and other factors, with a
-@code{define-foreign-library} top-level form.
-
-@item
-Load the library so defined with either a top-level
-@code{use-foreign-library} form or by calling the function
-@code{load-foreign-library}.
-@end enumerate
-
-@xref{Tutorial-Loading,, Loading foreign libraries}, for a working
-example of the above two steps.
-
-
-@node Library definition style, close-foreign-library, Defining a library, Libraries
-@section Library definition style
-
-Looking at the @code{libcurl} library definition presented earlier,
-you may ask why we did not simply do this:
-
-@lisp
-(define-foreign-library libcurl
- (t (:default "libcurl")))
-@end lisp
-
-@noindent
-Indeed, this would work just as well on the computer on which I tested
-the tutorial. There are a couple of good reasons to provide the
-@file{.so}'s current version number, however. Namely, the versionless
-@file{.so} is not packaged on most @sc{unix} systems along with the
-actual, fully-versioned library; instead, it is included in the
-``development'' package along with C headers and static @file{.a}
-libraries.
-
-The reason @cffi{} does not try to account for this lies in the
-meaning of the version numbers. A full treatment of shared library
-versions is beyond this manual's scope; see @ref{Versioning,, Library
-interface versions, libtool, @acronym{GNU} Libtool}, for helpful
-information for the unfamiliar. For our purposes, consider that a
-mismatch between the library version with which you tested and the
-installed library version may cause undefined
-behavior.@footnote{Windows programmers may chafe at adding a
-@sc{unix}-specific clause to @code{define-foreign-library}. Instead,
-ask why the Windows solution to library incompatibility is ``include
-your own version of every library you use with every program''.}
-
-@impnote{Maybe some notes should go here about OS X, which I know
-little about. --stephen}
-
-
-@c ===================================================================
-@c CLOSE-FOREIGN-LIBRARY
-
-@page
-@node close-foreign-library, *darwin-framework-directories*, Library definition style, Libraries
-@heading close-foreign-library
-@subheading Syntax
-@Function{close-foreign-library library @res{} success}
-
-@subheading Arguments and Values
-
-@table @var
-@item library
-A symbol or an instance of @code{foreign-library}.
-
-@item success
-A Lisp boolean.
-@end table
-
-@subheading Description
-
-Closes @var{library} which can be a symbol designating a library
-define through @code{define-foreign-library} or an instance of
-@code{foreign-library} as returned by @code{load-foreign-library}.
-
-@c @subheading Examples
-@c @xref{Tutorial-Loading,, Loading foreign libraries}.
-
-@subheading See Also
-
-@seealso{define-foreign-library} @*
-@seealso{load-foreign-library} @*
-@seealso{use-foreign-library}
-
-
-@c ===================================================================
-@c *DARWIN-FRAMEWORK-DIRECTORIES*
-
-@page
-@node *darwin-framework-directories*, define-foreign-library, close-foreign-library, Libraries
-@heading *darwin-framework-directories*
-@subheading Syntax
-
-@Variable{*darwin-framework-directories*}
-
-@subheading Value type
-
-A list, in which each element is a string, a pathname, or a simple
-Lisp expression.
-
-@subheading Initial value
-
-A list containing the following, in order: an expression corresponding
-to Darwin path @file{~/Library/Frameworks/},
-@code{#P"/Library/Frameworks/"}, and
-@code{#P"/System/Library/Frameworks/"}.
-
-@subheading Description
-
-The meaning of ``simple Lisp expression'' is explained in
-@ref{*foreign-library-directories*}. In contrast to that variable,
-this is not a fallback search path; the default value described above
-is intended to be a reasonably complete search path on Darwin systems.
-
-@subheading Examples
-
-@lisp
-CFFI> (let ((lib (load-foreign-library '(:framework "OpenGL"))))
- (foreign-library-pathname lib))
-@result{} #P"/System/Library/Frameworks/OpenGL.framework/OpenGL"
-@end lisp
-
-@subheading See also
-
-@seealso{*foreign-library-directories*} @*
-@seealso{define-foreign-library}
-
-
-@c ===================================================================
-@c DEFINE-FOREIGN-LIBRARY
-
-@page
-@node define-foreign-library, *foreign-library-directories*, *darwin-framework-directories*, Libraries
-@heading define-foreign-library
-
-@subheading Syntax
-
-@Macro{define-foreign-library name-and-options @{ load-clause @}* @res{} name}
-
-name-and-options ::= name | (name &key convention search-path)
-load-clause ::= (feature library &key convention search-path)
-
-@subheading Arguments and Values
-
-@table @var
-@item name
-A symbol.
-
-@item feature
-A feature expression.
-
-@item library
-A library designator.
-
-@item convention
-One of @code{:cdecl} (default) or @code{:stdcall}
-
-@item search-path
-A path or list of paths where the library will be searched if not found in
-system-global directories. Paths specified in a load clause take priority over
-paths specified as library option, with *foreign-library-directories* having
-lowest priority.
-@end table
-
-@subheading Description
-
-Creates a new library designator called @var{name}. The
-@var{load-clause}s describe how to load that designator when passed to
-@code{load-foreign-library} or @code{use-foreign-library}.
-
-When trying to load the library @var{name}, the relevant function
-searches the @var{load-clause}s in order for the first one where
-@var{feature} evaluates to true. That happens for any of the
-following situations:
-
-@enumerate 1
-@item
-If @var{feature} is a symbol present in @code{common-lisp:*features*}.
-
-@item
-If @var{feature} is a list, depending on @code{(first @var{feature})},
-a keyword:
-
-@table @code
-@item :and
-All of the feature expressions in @code{(rest @var{feature})} are
-true.
-
-@item :or
-At least one of the feature expressions in @code{(rest @var{feature})}
-is true.
-
-@item :not
-The feature expression @code{(second @var{feature})} is not true.
-@end table
-
-@item
-Finally, if @var{feature} is @code{t}, this @var{load-clause} is
-picked unconditionally.
-@end enumerate
-
-Upon finding the first true @var{feature}, the library loader then
-loads the @var{library}. The meaning of ``library designator'' is
-described in @ref{load-foreign-library}.
-
-Functions associated to a library defined by
-@code{define-foreign-library} (e.g. through @code{defcfun}'s
-@code{:library} option, will inherit the library's options. The
-precedence is as follows:
-
-@enumerate 1
-@item
-@code{defcfun}/@code{foreign-funcall} specific options;
-
-@item
-@var{load-clause} options;
-
-@item
-global library options (the @var{name-and-options} argument)
-@end enumerate
-
-
-@subheading Examples
-
-@xref{Tutorial-Loading,, Loading foreign libraries}.
-
-
-@subheading See Also
-
-@seealso{close-foreign-library} @*
-@seealso{load-foreign-library}
-
-
-@c ===================================================================
-@c *FOREIGN-LIBRARY-DIRECTORIES*
-
-@page
-@node *foreign-library-directories*, load-foreign-library, define-foreign-library, Libraries
-@heading *foreign-library-directories*
-@subheading Syntax
-
-@Variable{*foreign-library-directories*}
-
-@subheading Value type
-
-A list, in which each element is a string, a pathname, or a simple
-Lisp expression.
-
-@subheading Initial value
-
-The empty list.
-
-@subheading Description
-
-You should not have to use this variable.
-
-Most, if not all, Lisps supported by @cffi{} have a reasonable default
-search algorithm for foreign libraries. For example, Lisps for
-@sc{unix} usually call
-@uref{http://www.opengroup.org/onlinepubs/009695399/functions/dlopen.html,,
-@code{dlopen(3)}}, which in turn looks in the system library
-directories. Only if that fails does @cffi{} look for the named
-library file in these directories, and load it from there if found.
-
-Thus, this is intended to be a @cffi{}-only fallback to the library
-search configuration provided by your operating system. For example,
-if you distribute a foreign library with your Lisp package, you can
-add the library's containing directory to this list and portably
-expect @cffi{} to find it.
-
-A @dfn{simple Lisp expression} is intended to provide functionality
-commonly used in search paths such as
-@acronym{ASDF}'s@footnote{@xref{Using asdf to load systems,,, asdf,
-asdf: another system definition facility}, for information on
-@code{asdf:*central-registry*}.}, and is defined recursively as
-follows:@footnote{See @code{mini-eval} in @file{libraries.lisp} for
-the source of this definition. As is always the case with a Lisp
-@code{eval}, it's easier to understand the Lisp definition than the
-english.}
-
-@enumerate
-@item
-A list, whose @samp{first} is a function designator, and whose
-@samp{rest} is a list of simple Lisp expressions to be evaluated and
-passed to the so-designated function. The result is the result of the
-function call.
-
-@item
-A symbol, whose result is its symbol value.
-
-@item
-Anything else evaluates to itself.
-@end enumerate
-
-The result of evaluating the @dfn{simple Lisp expression} should yield
-a @emph{designator} for a @emph{list} of @emph{pathname designators}.
-
-@strong{Note}: in Common Lisp, @code{#p"/foo/bar"} designates the
-@emph{bar} file within the @emph{/foo} directory whereas
-@code{#p"/foo/bar/"} designates the @emph{/foo/bar} directory. Keep
-that in mind when customising the value of
-@code{*foreign-library-directories*}.
-
-
-@subheading Examples
-
-@example
-$ ls
-@print{} liblibli.so libli.lisp
-@end example
-
-@noindent
-In @file{libli.lisp}:
-
-@lisp
-(pushnew #P"/home/sirian/lisp/libli/" *foreign-library-directories*
- :test #'equal)
-
-(load-foreign-library '(:default "liblibli"))
-@end lisp
-
-@noindent
-The following example would achieve the same effect:
-
-@lisp
-(pushnew '(merge-pathnames #p"lisp/libli/" (user-homedir-pathname))
- *foreign-library-directories*
- :test #'equal)
-@result{} ((MERGE-PATHNAMES #P"lisp/libli/" (USER-HOMEDIR-PATHNAME)))
-
-(load-foreign-library '(:default "liblibli"))
-@end lisp
-
-@subheading See also
-
-@seealso{*darwin-framework-directories*} @*
-@seealso{define-foreign-library}
-
-
-@c ===================================================================
-@c LOAD-FOREIGN-LIBRARY
-
-@page
-@node load-foreign-library, load-foreign-library-error, *foreign-library-directories*, Libraries
-@heading load-foreign-library
-@subheading Syntax
-@Function{load-foreign-library library-designator @res{} library}
-
-@subheading Arguments and Values
-
-@table @var
-@item library-designator
-A library designator.
-
-@item library-designator
-An instance of @code{foreign-library}.
-@end table
-
-@subheading Description
-
-Load the library indicated by @var{library-designator}. A @dfn{library
-designator} is defined as follows:
-
-@enumerate
-@item
-If a symbol, is considered a name previously defined with
-@code{define-foreign-library}.
-
-@item
-If a string or pathname, passed as a namestring directly to the
-implementation's foreign library loader. If that fails, search the
-directories in @code{*foreign-library-directories*} with
-@code{cl:probe-file}; if found, the absolute path is passed to the
-implementation's loader.
-
-@item
-If a list, the meaning depends on @code{(first @var{library})}:
-
-@table @code
-@item :framework
-The second list element is taken to be a Darwin framework name, which
-is then searched in @code{*darwin-framework-directories*}, and loaded
-when found.
-
-@item :or
-Each remaining list element, itself a @dfn{library designator}, is loaded in
-order, until one succeeds.
-
-@item :default
-The name is transformed according to the platform's naming convention
-to shared libraries, and the resultant string is loaded as a @dfn{library
-designator}. For example, on @sc{unix}, the name is suffixed with
-@file{.so}.
-@end table
-@end enumerate
-
-If the library is already loaded it will be reloaded.
-
-If the load fails, signal a @code{load-foreign-library-error}.
-
-@strong{Please note:} For system libraries, you should not need to
-specify the directory containing the library. Each operating system
-has its own idea of a default search path, and you should rely on it
-when it is reasonable.
-
-@subheading Implementation-specific Notes
-On ECL platforms where its dynamic FFI is not supported (ie. when
-@code{:dffi} is not present in @code{*features*}),
-@code{cffi:load-foreign-library} does not work and you must use ECL's
-own @code{ffi:load-foreign-library} with a constant string argument.
-
-@subheading Examples
-
-@xref{Tutorial-Loading,, Loading foreign libraries}.
-
-@subheading See Also
-
-@seealso{close-foreign-library} @*
-@seealso{*darwin-framework-directories*} @*
-@seealso{define-foreign-library} @*
-@seealso{*foreign-library-directories*} @*
-@seealso{load-foreign-library-error} @*
-@seealso{use-foreign-library}
-
-
-@c ===================================================================
-@c LOAD-FOREIGN-LIBRARY-ERROR
-
-@page
-@node load-foreign-library-error, use-foreign-library, load-foreign-library, Libraries
-@heading load-foreign-library-error
-
-@subheading Syntax
-
-@Condition{load-foreign-library-error}
-
-@subheading Class precedence list
-
-@code{load-foreign-library-error}, @code{error},
-@code{serious-condition}, @code{condition}, @code{t}
-
-@subheading Description
-
-Signalled when a foreign library load completely fails. The exact
-meaning of this varies depending on the real conditions at work, but
-almost universally, the implementation's error message is useless.
-However, @cffi{} does provide the useful restarts @code{retry} and
-@code{use-value}; invoke the @code{retry} restart to try loading the
-foreign library again, or the @code{use-value} restart to try loading
-a different foreign library designator.
-
-@subheading See also
-
-@seealso{load-foreign-library}
-
-
-@c ===================================================================
-@c USE-FOREIGN-LIBRARY
-
-@page
-@node use-foreign-library, , load-foreign-library-error, Libraries
-@heading use-foreign-library
-
-@subheading Syntax
-
-@Macro{use-foreign-library name}
-
-@subheading Arguments and values
-
-@table @var
-@item name
-A library designator; unevaluated.
-@end table
-
-
-@subheading Description
-
-@xref{load-foreign-library}, for the meaning of ``library
-designator''. This is intended to be the top-level form used
-idiomatically after a @code{define-foreign-library} form to go ahead
-and load the library. @c ; it also sets the ``current foreign library''.
-Finally, on implementations where the regular evaluation rule is
-insufficient for foreign library loading, it loads it at the required
-time.@footnote{Namely, @acronym{CMUCL}. See
-@code{use-foreign-library} in @file{libraries.lisp} for details.}
-
-@c current foreign library is a concept created a few hours ago as of
-@c this writing. It is not actually used yet, but probably will be.
-
-@subheading Examples
-
-@xref{Tutorial-Loading,, Loading foreign libraries}.
-
-
-@subheading See also
-
-@seealso{load-foreign-library}
-
-
-@c ===================================================================
-@c CHAPTER: Callbacks
-
-@node Callbacks, The Groveller, Libraries, Top
-@chapter Callbacks
-
-@menu
-Dictionary
-
-* callback::
-* defcallback::
-* get-callback::
-@end menu
-
-
-@c ===================================================================
-@c CALLBACK
-
-@page
-@node callback, defcallback, Callbacks, Callbacks
-@heading callback
-@subheading Syntax
-@Macro{callback symbol @res{} pointer}
-
-@subheading Arguments and Values
-
-@table @var
-@item symbol
-A symbol denoting a callback.
-
-@item pointer
-@itemx new-value
-A pointer.
-@end table
-
-@subheading Description
-The @code{callback} macro is analogous to the standard CL special
-operator @code{function} and will return a pointer to the callback
-denoted by the symbol @var{name}.
-
-@subheading Examples
-
-@lisp
-CFFI> (defcallback sum :int ((a :int) (b :int))
- (+ a b))
-@result{} SUM
-CFFI> (callback sum)
-@result{} #<A Mac Pointer #x102350>
-@end lisp
-
-@subheading See Also
-@seealso{get-callback} @*
-@seealso{defcallback}
-
-
-@c ===================================================================
-@c DEFCALLBACK
-
-@page
-@node defcallback, get-callback, callback, Callbacks
-@heading defcallback
-@subheading Syntax
-@Macro{defcallback name-and-options return-type arguments &body body @res{} name}
-
-name-and-options ::= name | (name &key convention)
-arguments ::= (@{ (arg-name arg-type) @}*)
-
-@subheading Arguments and Values
-
-@table @var
-@item name
-A symbol naming the callback created.
-
-@item return-type
-The foreign type for the callback's return value.
-
-@item arg-name
-A symbol.
-
-@item arg-type
-A foreign type.
-
-@item convention
-One of @code{:cdecl} (default) or @code{:stdcall}.
-@end table
-
-@subheading Description
-The @code{defcallback} macro defines a Lisp function that can be called
-from C. The arguments passed to this function will be converted to the
-appropriate Lisp representation and its return value will be converted
-to its C representation.
-
-This Lisp function can be accessed by the @code{callback} macro or the
-@code{get-callback} function.
-
-@strong{Portability note:} @code{defcallback} will not work correctly
-on some Lisps if it's not a top-level form.
-
-@subheading Examples
-
-@lisp
-(defcfun "qsort" :void
- (base :pointer)
- (nmemb :int)
- (size :int)
- (fun-compar :pointer))
-
-(defcallback < :int ((a :pointer) (b :pointer))
- (let ((x (mem-ref a :int))
- (y (mem-ref b :int)))
- (cond ((> x y) 1)
- ((< x y) -1)
- (t 0))))
-
-CFFI> (with-foreign-object (array :int 10)
- ;; @lispcmt{Initialize array.}
- (loop for i from 0 and n in '(7 2 10 4 3 5 1 6 9 8)
- do (setf (mem-aref array :int i) n))
- ;; @lispcmt{Sort it.}
- (qsort array 10 (foreign-type-size :int) (callback <))
- ;; @lispcmt{Return it as a list.}
- (loop for i from 0 below 10
- collect (mem-aref array :int i)))
-@result{} (1 2 3 4 5 6 7 8 9 10)
-@end lisp
-
-@subheading See Also
-@seealso{callback} @*
-@seealso{get-callback}
-
-
-@c ===================================================================
-@c GET-CALLBACK
-
-@page
-@node get-callback, , defcallback, Callbacks
-@heading get-callback
-@subheading Syntax
-@Accessor{get-callback symbol @res{} pointer}
-
-@subheading Arguments and Values
-
-@table @var
-@item symbol
-A symbol denoting a callback.
-
-@item pointer
-A pointer.
-@end table
-
-@subheading Description
-This is the functional version of the @code{callback} macro. It
-returns a pointer to the callback named by @var{symbol} suitable, for
-example, to pass as arguments to foreign functions.
-
-@subheading Examples
-
-@lisp
-CFFI> (defcallback sum :int ((a :int) (b :int))
- (+ a b))
-@result{} SUM
-CFFI> (get-callback 'sum)
-@result{} #<A Mac Pointer #x102350>
-@end lisp
-
-@subheading See Also
-@seealso{callback} @*
-@seealso{defcallback}
-
-
-@c ===================================================================
-@c CHAPTER: The Groveller
-
-@node The Groveller, Limitations, Callbacks, Top
-@chapter The Groveller
-
-@cffi{}-Grovel is a tool which makes it easier to write @cffi{}
-declarations for libraries that are implemented in C. That is, it
-grovels through the system headers, getting information about types
-and structures, so you don't have to. This is especially important
-for libraries which are implemented in different ways by different
-vendors, such as the @sc{unix}/@sc{posix} functions. The @cffi{}
-declarations are usually quite different from platform to platform,
-but the information you give to @cffi{}-Grovel is the same. Hence,
-much less work is required!
-
-If you use @acronym{ASDF}, @cffi{}-Grovel is integrated, so that it
-will run automatically when your system is building. This feature was
-inspired by SB-Grovel, a similar @acronym{SBCL}-specific project.
-@cffi{}-Grovel can also be used without @acronym{ASDF}.
-
-@section Building FFIs with CFFI-Grovel
-
-@cffi{}-Grovel uses a specification file (*.lisp) describing the
-features that need groveling. The C compiler is used to retrieve this
-data and write a Lisp file (*.cffi.lisp) which contains the necessary
-@cffi{} definitions to access the variables, structures, constants, and
-enums mentioned in the specification.
-
-@c This is most similar to the SB-Grovel package, upon which it is
-@c based. Unlike SB-Grovel, we do not currently support defining
-@c regular foreign functions in the specification file; those are best
-@c defined in normal Lisp code.
-
-@cffi{}-Grovel provides an @acronym{ASDF} component for handling the
-necessary calls to the C compiler and resulting file management.
-
-@c See the included CFFI-Unix package for an example of how to
-@c integrate a specification file with ASDF-built packages.
-
-@menu
-* Groveller Syntax:: How grovel files should look like.
-* Groveller ASDF Integration:: ASDF components for grovel files.
-* Groveller Implementation Notes:: Implementation notes.
-* Wrapper for Inline/Static Functions and Macros:: Wrapper
-@end menu
-
-@node Groveller Syntax, Groveller ASDF Integration, The Groveller, The Groveller
-@section Specification File Syntax
-
-The specification files are read by the normal Lisp reader, so they
-have syntax very similar to normal Lisp code. In particular,
-semicolon-comments and reader-macros will work as expected.
-
-There are several forms recognized by @cffi{}-Grovel:
-
-@deffn {Grovel Form} progn &rest forms
-
-Processes a list of forms. Useful for conditionalizing several
-forms. For example:
-@end deffn
-
-@lisp
-#+freebsd
-(progn
- (constant (ev-enable "EV_ENABLE"))
- (constant (ev-disable "EV_DISABLE")))
-@end lisp
-
-@deffn {Grovel Form} include &rest files
-
-Include the specified files (specified as strings) in the generated C
-source code.
-@end deffn
-
-@deffn {Grovel Form} in-package symbol
-
-Set the package to be used for the final Lisp output.
-@end deffn
-
-@deffn {Grovel Form} ctype lisp-name size-designator
-
-Define a @cffi{} foreign type for the string in @var{size-designator},
-e.g. @code{(ctype :pid "pid_t")}.
-@end deffn
-
-@deffn {Grovel Form} constant (lisp-name &rest c-names) &key type documentation optional
-
-Search for the constant named by the first @var{c-name} string found
-to be known to the C preprocessor and define it as @var{lisp-name}.
-
-The @var{type} keyword argument specifies how to grovel the constant:
-either @code{integer} (the default) or @code{double-float}. If
-@var{optional} is true, no error will be raised if all the
-@var{c-names} are unknown. If @var{lisp-name} is a keyword, the actual
-constant will be a symbol of the same name interned in the current
-package.
-@end deffn
-
-@deffn {Grovel Form} feature lisp-feature-name c-name &key feature-list
-
-Adds @var{lisp-feature-name} to the list @var{feature-list} if the @var{c-name}
-string is known to the C preprocessor. @var{feature-list} defaults
-to @code{cl:*features*}.
-@end deffn
-
-@deffn {Grovel Form} define name &optional value
-
-Defines an additional C preprocessor symbol, which is useful for
-altering the behavior of included system headers.
-@end deffn
-
-@deffn {Grovel Form} cc-flags &rest flags
-
-Adds @var{cc-flags} to the command line arguments used for the C compiler
-invocation.
-@end deffn
-
-@deffn {Grovel Form} pkg-config-cflags pkg &key optional
-
-Adds @var{pkg} to the command line arguments for the external program
-@code{pkg-config} and runs it to retrieve the relevant include flags
-used for the C compiler invocation. This syntax can be used instead of
-hard-coding paths using @code{cc-flags}, and ensures that include
-flags are added correctly on the build system. Assumes
-@code{pkg-config} is installed and working. @var{pkg} is a string
-that identifies an installed @code{pkg-config} package. See the
-pkg-config manual for more information. If @var{optional} is true,
-failure to execute @code{pkg-config} does @emph{not} abort
-compilation.
-@end deffn
-
-@deffn {Grovel Form} cstruct lisp-name c-name slots
-
-Define a @cffi{} foreign struct with the slot data specfied. Slots
-are of the form @code{(lisp-name c-name &key type count (signed t))}.
-@end deffn
-
-@deffn {Grovel Form} cunion lisp-name c-name slots
-
-Identical to @code{cstruct}, but defines a @cffi{} foreign union.
-@end deffn
-
-@deffn {Grovel Form} cstruct-and-class c-name slots
-
-Defines a @cffi{} foreign struct, as with @code{cstruct} and defines a
-@acronym{CLOS} class to be used with it. This is useful for mapping
-foreign structures to application-layer code that shouldn't need to
-worry about memory allocation issues.
-@end deffn
-
-@deffn {Grovel Form} cvar namespec type &key read-only
-
-Defines a foreign variable of the specified type, even if that
-variable is potentially a C preprocessor pseudo-variable. e.g.
-@code{(cvar ("errno" errno) errno-values)}, assuming that errno-values
-is an enum or equivalent to type @code{:int}.
-
-The @var{namespec} is similar to the one used in @ref{defcvar}.
-@end deffn
-
-@deffn {Grovel Form} cenum name-and-opts &rest elements
-
-Defines a true C enum, with elements specified as @code{((lisp-name
-&rest c-names) &key optional documentation)}.
-@var{name-and-opts} can be either a symbol as name, or a list
-@code{(name &key base-type define-constants)}. If @var{define-constants}
-is non-null, a Lisp constant will be defined for each enum member.
-@end deffn
-
-@deffn {Grovel Form} constantenum name-and-opts &rest elements
-
-Defines an enumeration of pre-processor constants, with elements
-specified as @code{((lisp-name &rest c-names) &key optional
-documentation)}.
-@var{name-and-opts} can be either a symbol as name, or a list
-@code{(name &key base-type define-constants)}. If @var{define-constants}
-is non-null, a Lisp constant will be defined for each enum member.
-
-This example defines @code{:af-inet} to represent the value held by
-@code{AF_INET} or @code{PF_INET}, whichever the pre-processor finds
-first. Similarly for @code{:af-packet}, but no error will be
-signalled if the platform supports neither @code{AF_PACKET} nor
-@code{PF_PACKET}.
-@end deffn
-
-@lisp
-(constantenum address-family
- ((:af-inet "AF_INET" "PF_INET")
- :documentation "IPv4 Protocol family")
- ((:af-local "AF_UNIX" "AF_LOCAL" "PF_UNIX" "PF_LOCAL")
- :documentation "File domain sockets")
- ((:af-inet6 "AF_INET6" "PF_INET6")
- :documentation "IPv6 Protocol family")
- ((:af-packet "AF_PACKET" "PF_PACKET")
- :documentation "Raw packet access"
- :optional t))
-@end lisp
-
-@deffn {Grovel Form} bitfield name-and-opts &rest elements
-
-Defines a bitfield, with elements specified as @code{((lisp-name &rest
-c-names) &key optional documentation)}. @var{name-and-opts} can be either a
-symbol as name, or a list @code{(name &key base-type)}. For example:
-@end deffn
-
-@lisp
-(bitfield flags-ctype
- ((:flag-a "FLAG_A")
- :documentation "DOCU_A")
- ((:flag-b "FLAG_B" "FLAG_B_ALT")
- :documentation "DOCU_B")
- ((:flag-c "FLAG_C")
- :documentation "DOCU_C"
- :optional t))
-@end lisp
-
-
-@c ===================================================================
-@c SECTION: Groveller ASDF Integration
-
-@node Groveller ASDF Integration, Groveller Implementation Notes, Groveller Syntax, The Groveller
-@section ASDF Integration
-
-An example software project might contain four files; an
-@acronym{ASDF} file, a package definition file, an implementation
-file, and a @cffi{}-Grovel specification file.
-
-The @acronym{ASDF} file defines the system and its dependencies.
-Notice the use of @code{eval-when} to ensure @cffi{}-Grovel is present
-and the use of @code{(cffi-grovel:grovel-file name &key cc-flags)}
-instead of @code{(:file name)}.
-
-The @file{example-software.asd} file would look like that:
-
-@lisp
-;;; @lispcmt{CFFI-Grovel is needed for processing grovel-file components}
-(defsystem "example-software"
- :defsystem-depends-on ("cffi-grovel")
- :depends-on ("cffi")
- :serial t
- :components
- ((:file "package")
- (:cffi-grovel-file "example-grovelling")
- (:cffi-wrapper-file "example-wrappers")
- (:file "example")))
-@end lisp
-
-The @file{package.lisp} file would contain one or several
-@code{defpackage} forms, to remove circular dependencies and make
-building the project easier. Note that you may or may not want to
-@code{:use} your internal package.
-
-@impnote{Note that it's a not a good idea to @code{:use} when names may
-clash with, say, CL symbols.
-Or you could use @code{uiop:define-package} and its @code{:mix} option.}
-
-@lisp
-(defpackage #:example-internal
- (:use)
- (:nicknames #:exampleint))
-
-(defpackage #:example-software
- (:export ...)
- (:use #:cl #:cffi #:exampleint))
-@end lisp
-
-The internal package is created by Lisp code output from the C program
-written by @cffi{}-Grovel; if your specification file is
-@file{exampleint.lisp}, the @file{exampleint.cffi.lisp} file will contain the
-@cffi{} definitions needed by the rest of your project.
-@xref{Groveller Syntax}.
-
-@node Groveller Implementation Notes, Wrapper for Inline/Static Functions and Macros, Groveller ASDF Integration, The Groveller
-@section Implementation Notes
-
-@cffi{}-Grovel will generate many files that not only architecture-specific,
-but also implementation-specific, and should not be distributed.
-ASDF will generate these files in its output cache;
-if you build with multiple architectures (e.g. with NFS/AFS home
-directories) or implementations, it is critical for avoiding clashes
-to keep this cache in an implementation-dependent directory (as is the
-default).
-
-For @code{foo-internal.lisp}, the resulting @code{foo-internal.c},
-@code{foo-internal}, and @code{foo-internal.cffi.lisp} are all
-platform-specific, either because of possible reader-macros in
-foo-internal.lisp, or because of varying C environments on the host
-system. For this reason, it is not helpful to distribute any of those
-files; end users building @cffi{}-Grovel based software will need
-@code{cffi}-Grovel anyway.
-
-@impnote{For now, after some experimentation with @sc{clisp} having no
-long-long, it seems appropriate to assert that the generated @code{.c}
-files are architecture and operating-system dependent, but
-lisp-implementation independent. This way the same @code{.c} file
-(and so the same @code{.grovel-tmp.lisp} file) will be shareable
-between the implementations running on a given system.}
-
-@c TODO: document the new wrapper stuff.
-
-@node Wrapper for Inline/Static Functions and Macros, , Groveller Implementation Notes, The Groveller
-@section Wrapper for Inline/Static Functions and Macros
-
-In a shared library, information in static/inlined functions and
-macros are already removed during the compilation. Wrapper file
-enables to write an uninlined function wrapping the call to them.
-
-A wrapper file compilation/loading proceeds as follows:
-Unlike groveller which generates C code that emits lisp files
-containing cffi definitions, it generates C code, compiles it as a
-shared library, loads the library, generate the cffi definitions (as
-lisp code) and then loads the lisp code.
-
-It has asdf integration similar to groveller.
-
-@lisp
-(defsystem "example-software"
- :defsystem-depends-on ("cffi-grovel")
- :depends-on ("cffi")
- :serial t
- :components
- ((:file "package")
- (:cffi-grovel-file "example-grovelling")
- (:cffi-wrapper-file "example-wrappers") ;; <<--- this part
- (:file "example")))
-@end lisp
-
-@deffn {Wrapper Form} defwrapper name-and-options return-type &rest args
-@end deffn
-
-@example
-static inline int foo(int i) @{
- return 1+i;
-@};
-#define bar(i) (1+(i))
-@end example
-
-@lisp
-(in-package :mypackage)
-(defwrapper ("foo" foo) :int
- (i :int))
-(defwrapper ("bar" bar) :int
- (i :int))
-@end lisp
-
-Other forms are similar to grovel files.
-
-@deffn {Wrapper Form} progn &rest forms
-
-Processes a list of forms. Useful for conditionalizing several
-forms. For example:
-@end deffn
-
-@lisp
-#+freebsd
-(progn
- (constant (ev-enable "EV_ENABLE"))
- (constant (ev-disable "EV_DISABLE")))
-@end lisp
-
-@deffn {Wrapper Form} include &rest files
-
-Include the specified files (specified as strings) in the generated C
-source code.
-@end deffn
-
-@deffn {Wrapper Form} in-package symbol
-
-Set the package to be used for the final Lisp output.
-@end deffn
-
-@deffn {Wrapper Form} flags &rest flags
-
-Adds @var{cc-flags} to the command line arguments used for the C compiler
-invocation.
-@end deffn
-
-@deffn {Wrapper Form} proclaim &rest proclaimations
-@end deffn
-@deffn {Wrapper Form} declaim &rest declaimations
-@end deffn
-
-
-
-@c ===================================================================
-@c CHAPTER: Static Linking
-
-@node Static Linking, Limitations, The Groveller, Top
-@chapter Static Linking
-
-On recent enough versions of supported implementations (currently,
-GNU CLISP 2.49, CMUCL 2015-11, and SBCL 1.2.17), and with a recent
-enough ASDF (3.1.2 or later), you can create a statically linked
-Lisp executable image that includes all the C extensions
-(wrappers and any other objects output by @code{compile-op})
-as well as your Lisp code --- or a standalone application executable.
-This makes it easier to deliver your code as a single file.
-
-To dump a statically linked executable image, use:
-
-@lisp
-(asdf:load-system :cffi-grovel)
-(asdf:operate :static-image-op :example-software)
-@end lisp
-
-To dump a statically linked executable standalone application, use:
-
-@lisp
-(asdf:load-system :cffi-grovel)
-(asdf:operate :static-program-op :example-software)
-@end lisp
-
-See @uref{https://common-lisp.net/project/asdf/,,the ASDF
-manual} for documentation about @code{image-op} and @code{program-op}
-which are the parent operation classes that behave similarly except
-they don't statically link C code.
-
-@impnote{There is also an operation @code{:static-runtime-op} to create the
-statically linked runtime alone, but it's admittedly not very useful
-except as an intermediate step dependency towards building
-@code{:static-image-op} or @code{:static-program-op}.}
-
-
-
-@c ===================================================================
-@c CHAPTER: Limitations
-
-@node Limitations, Platform-specific features, The Groveller, Top
-@chapter Limitations
-
-These are @cffi{}'s limitations across all platforms; for information
-on the warts on particular Lisp implementations, see
-@ref{Implementation Support}.
-
-@itemize @bullet
-@item
-The tutorial includes a treatment of the primary, intractable
-limitation of @cffi{}, or any @acronym{FFI}: that the abstractions
-commonly used by C are insufficiently expressive.
-@xref{Tutorial-Abstraction,, Breaking the abstraction}, for more
-details.
-
-@end itemize
-
-
-@node Platform-specific features, Glossary, Limitations, Top
-@appendix Platform-specific features
-
-Whenever a backend doesn't support one of @cffi{}'s features, a
-specific symbol is pushed onto @code{common-lisp:*features*}. The
-meanings of these symbols follow.
-
-@table @var
-@item cffi-sys::flat-namespace
-This Lisp has a flat namespace for foreign symbols meaning that you
-won't be able to load two different libraries with homograph functions
-and successfully differentiate them through the @code{:library}
-option to @code{defcfun}, @code{defcvar}, etc@dots{}
-
-@item cffi-sys::no-foreign-funcall
-The macro @code{foreign-funcall} is @strong{not} available. On such
-platforms, the only way to call a foreign function is through
-@code{defcfun}. @xref{foreign-funcall}, and @ref{defcfun}.
-
-@item cffi-sys::no-long-long
-The C @code{long long} type is @strong{not} available as a foreign
-type.
-
-However, on such platforms @cffi{} provides its own implementation of
-the @code{long long} type for all of operations in chapters
-@ref{Foreign Types}, @ref{Pointers} and @ref{Variables}. The
-functionality described in @ref{Functions} and @ref{Callbacks} will
-not be available.
-
-32-bit Lispworks 5.0+ is an exception. In addition to the @cffi{}
-implementation described above, Lispworks itself implements the
-@code{long long} type for @ref{Functions}. @ref{Callbacks} are still
-missing @code{long long} support, though.
-
-@item cffi-sys::no-stdcall
-This Lisp doesn't support the @code{stdcall} calling convention. Note
-that it only makes sense to support @code{stdcall} on (32-bit) x86
-platforms.
-
-@end table
-
-
-@node Glossary, Comprehensive Index, Platform-specific features, Top
-@appendix Glossary
-
-@table @dfn
-@item aggregate type
-A @cffi{} type for C data defined as an organization of data of simple
-type; in structures and unions, which are themselves aggregate types,
-they are represented by value.
-
-@item foreign value
-This has two meanings; in any context, only one makes sense.
-
-When using type translators, the foreign value is the lower-level Lisp
-value derived from the object passed to @code{translate-to-foreign}
-(@pxref{translate-to-foreign}). This value should be a Lisp number or
-a pointer (satisfies @code{pointerp}), and it can be treated like any
-general Lisp object; it only completes the transformation to a true
-foreign value when passed through low-level code in the Lisp
-implementation, such as the foreign function caller or indirect memory
-addressing combined with a data move.
-
-In other contexts, this refers to a value accessible by C, but which
-may only be accessed through @cffi{} functions. The closest you can
-get to such a foreign value is through a pointer Lisp object, which
-itself counts as a foreign value in only the previous sense.
-
-@item simple type
-A @cffi{} type that is ultimately represented as a builtin type;
-@cffi{} only provides extra semantics for Lisp that are invisible to C
-code or data.
-@end table
-
-@node Comprehensive Index, , Glossary, Top
-@unnumbered Index
-@printindex cp
-
-@bye
(DIR) diff --git a/3rdparties/software/cffi_0.20.0/doc/cffi-sys-spec.texinfo b/3rdparties/software/cffi_0.20.0/doc/cffi-sys-spec.texinfo
@@ -1,334 +0,0 @@
-\input texinfo @c -*-texinfo-*-
-@c %**start of header
-@setfilename cffi-sys.info
-@settitle CFFI-SYS Interface Specification
-
-@c Show types in the same index as the functions.
-@synindex tp fn
-
-@copying
-Copyright @copyright{} 2005-2006, James Bielman <jamesjb at jamesjb.com>
-
-@quotation
-Permission is hereby granted, free of charge, to any person
-obtaining a copy of this software and associated documentation
-files (the ``Software''), to deal in the Software without
-restriction, including without limitation the rights to use, copy,
-modify, merge, publish, distribute, sublicense, and/or sell copies
-of the Software, and to permit persons to whom the Software is
-furnished to do so, subject to the following conditions:
-
-The above copyright notice and this permission notice shall be
-included in all copies or substantial portions of the Software.
-
-@sc{The software is provided ``as is'', without warranty of any kind,
-express or implied, including but not limited to the warranties of
-merchantability, fitness for a particular purpose and
-noninfringement. In no event shall the authors or copyright
-holders be liable for any claim, damages or other liability,
-whether in an action of contract, tort or otherwise, arising from,
-out of or in connection with the software or the use or other
-dealings in the software.}
-@end quotation
-@end copying
-
-@macro impnote {text}
-@emph{Implementor's note: \text\}
-@end macro
-@c %**end of header
-
-@dircategory Software development
-@direntry
-* CFFI Sys spec: (cffi-sys-spec). CFFI Sys spec.
-@end direntry
-
-@titlepage
-@title CFFI-SYS Interface Specification
-@c @subtitle Version X.X
-@c @author James Bielman
-
-@page
-@vskip 0pt plus 1filll
-@insertcopying
-@end titlepage
-
-@contents
-
-@ifnottex
-@node Top
-@top cffi-sys
-@insertcopying
-@end ifnottex
-
-@menu
-* Introduction::
-* Built-In Foreign Types::
-* Operations on Foreign Types::
-* Basic Pointer Operations::
-* Foreign Memory Allocation::
-* Memory Access::
-* Foreign Function Calling::
-* Loading Foreign Libraries::
-* Foreign Globals::
-* Symbol Index::
-@end menu
-
-@node Introduction
-@chapter Introduction
-
-@acronym{CFFI}, the Common Foreign Function Interface, purports to be
-a portable foreign function interface for Common Lisp.
-
-This specification defines a set of low-level primitives that must be
-defined for each Lisp implementation supported by @acronym{CFFI}.
-These operators are defined in the @code{CFFI-SYS} package.
-
-The @code{CFFI} package uses the @code{CFFI-SYS} interface
-to implement an extensible foreign type system with support for
-typedefs, structures, and unions, a declarative interface for
-defining foreign function calls, and automatic conversion of
-foreign function arguments to/from Lisp types.
-
-Please note the following conventions that apply to everything in
-@code{CFFI-SYS}:
-
-@itemize @bullet
-@item
-Functions in @code{CFFI-SYS} that are low-level versions of functions
-exported from the @code{CFFI} package begin with a leading
-percent-sign (eg. @code{%mem-ref}).
-
-@item
-Where ``foreign type'' is mentioned as the kind of an argument, the
-meaning is restricted to that subset of all foreign types defined in
-@ref{Built-In Foreign Types}. Support for higher-level types is
-always defined in terms of those lower-level types in @code{CFFI}
-proper.
-@end itemize
-
-
-@node Built-In Foreign Types
-@chapter Built-In Foreign Types
-
-@deftp {Foreign Type} :char
-@deftpx {Foreign Type} :unsigned-char
-@deftpx {Foreign Type} :short
-@deftpx {Foreign Type} :unsigned-short
-@deftpx {Foreign Type} :int
-@deftpx {Foreign Type} :unsigned-int
-@deftpx {Foreign Type} :long
-@deftpx {Foreign Type} :unsigned-long
-@deftpx {Foreign Type} :long-long
-@deftpx {Foreign Type} :unsigned-long-long
-These types correspond to the native C integer types according to the
-ABI of the system the Lisp implementation is compiled against.
-@end deftp
-
-@deftp {Foreign Type} :int8
-@deftpx {Foreign Type} :uint8
-@deftpx {Foreign Type} :int16
-@deftpx {Foreign Type} :uint16
-@deftpx {Foreign Type} :int32
-@deftpx {Foreign Type} :uint32
-@deftpx {Foreign Type} :int64
-@deftpx {Foreign Type} :uint64
-Foreign integer types of specific sizes, corresponding to the C types
-defined in @code{stdint.h}.
-@end deftp
-
-@deftp {Foreign Type} :size
-@deftpx {Foreign Type} :ssize
-@deftpx {Foreign Type} :ptrdiff
-@deftpx {Foreign Type} :time
-Foreign integer types corresponding to the standard C types (without
-the @code{_t} suffix).
-@end deftp
-
-@impnote{I'm sure there are more of these that could be useful, let's
-add any types that can't be defined portably to this list as
-necessary.}
-
-@deftp {Foreign Type} :float
-@deftpx {Foreign Type} :double
-The @code{:float} type represents a C @code{float} and a Lisp
-@code{single-float}. @code{:double} represents a C @code{double} and a
-Lisp @code{double-float}.
-@end deftp
-
-@deftp {Foreign Type} :pointer
-A foreign pointer to an object of any type, corresponding to
-@code{void *}.
-@end deftp
-
-@deftp {Foreign Type} :void
-No type at all. Only valid as the return type of a function.
-@end deftp
-
-
-@node Operations on Foreign Types
-@chapter Operations on Built-in Foreign Types
-
-@defun %foreign-type-size type @result{} size
-Return the @var{size}, in bytes, of objects having foreign type
-@var{type}. An error is signalled if @var{type} is not a known
-built-in foreign type.
-@end defun
-
-@defun %foreign-type-alignment type @result{} alignment
-Return the default alignment in bytes for structure members of foreign
-type @var{type}. An error is signalled if @var{type} is not a known
-built-in foreign type.
-
-@impnote{Maybe this should take an optional keyword argument specifying an
-alternate alignment system, eg. :mac68k for 68000-compatible alignment
-on Darwin.}
-@end defun
-
-
-@node Basic Pointer Operations
-@chapter Basic Pointer Operations
-
-@defun pointerp ptr @result{} boolean
-Return true if @var{ptr} is a foreign pointer.
-@end defun
-
-@defun null-pointer @result{} pointer
-Return a null foreign pointer.
-@end defun
-
-@defun null-pointer-p ptr @result{} boolean
-Return true if @var{ptr} is a null foreign pointer.
-@end defun
-
-@defun make-pointer address @result{} pointer
-Return a pointer corresponding to the numeric integer @var{address}.
-@end defun
-
-@defun inc-pointer ptr offset @result{} pointer
-Return the result of numerically incrementing @var{ptr} by @var{offset}.
-@end defun
-
-
-@node Foreign Memory Allocation
-@chapter Foreign Memory Allocation
-
-@defun foreign-alloc size @result{} pointer
-Allocate @var{size} bytes of foreign-addressable memory and return
-a @var{pointer} to the allocated block. An implementation-specific
-error is signalled if the memory cannot be allocated.
-@end defun
-
-@defun foreign-free ptr @result{} unspecified
-Free a pointer @var{ptr} allocated by @code{foreign-alloc}. The
-results are undefined if @var{ptr} is used after being freed.
-@end defun
-
-@defmac with-foreign-pointer (var size &optional size-var) &body body
-Bind @var{var} to a pointer to @var{size} bytes of
-foreign-accessible memory during @var{body}. Both @var{ptr} and the
-memory block it points to have dynamic extent and may be stack
-allocated if supported by the implementation. If @var{size-var} is
-supplied, it will be bound to @var{size} during @var{body}.
-@end defmac
-
-
-@node Memory Access
-@chapter Memory Access
-
-@deffn {Accessor} %mem-ref ptr type &optional offset
-Dereference a pointer @var{offset} bytes from @var{ptr} to an object
-for reading (or writing when used with @code{setf}) of built-in type
-@var{type}.
-@end deffn
-
-@heading Example
-
-@lisp
-;; An impractical example, since time returns the time as well,
-;; but it demonstrates %MEM-REF. Better (simple) examples wanted!
-(with-foreign-pointer (p (foreign-type-size :time))
- (foreign-funcall "time" :pointer p :time)
- (%mem-ref p :time))
-@end lisp
-
-
-@node Foreign Function Calling
-@chapter Foreign Function Calling
-
-@defmac %foreign-funcall name @{arg-type arg@}* &optional result-type @result{} object
-@defmacx %foreign-funcall-pointer ptr @{arg-type arg@}* &optional result-type @result{} object
-Invoke a foreign function called @var{name} in the foreign source code.
-
-Each @var{arg-type} is a foreign type specifier, followed by
-@var{arg}, Lisp data to be converted to foreign data of type
-@var{arg-type}. @var{result-type} is the foreign type of the
-function's return value, and is assumed to be @code{:void} if not
-supplied.
-
-@code{%foreign-funcall-pointer} takes a pointer @var{ptr} to the
-function, as returned by @code{foreign-symbol-pointer}, rather than a
-string @var{name}.
-@end defmac
-
-@defmac %foreign-funcall-varargs name (@{fixed-type arg@}*) @{vararg-type arg@}* &optional result-type @result{} object
-@defmacx %foreign-funcall-varargs-pointer ptr (@{fixed-type arg@}*) @{vararg-type arg@}* &optional result-type @result{} object
-Invoke a foreign variadic function called @var{name} in the foreign
-source code.
-
-Each @var{fixed-type} and @var{vararg-type} is a foreign type
-specifier, followed by @var{arg}, Lisp data to be converted to foreign
-data of type @var{arg-type}. @var{result-type} is the foreign type of
-the function's return value, and is assumed to be @code{:void} if not
-supplied.
-
-@code{%foreign-funcall-pointer-varargs} takes a pointer @var{ptr} to
-the variadic function, as returned by @code{foreign-symbol-pointer},
-rather than a string @var{name}.
-
-Both functions have default implementation which call
-@code{%foreign-funcall} and @code{%foreign-funcall-pointer}
-approprietly.
-@end defmac
-
-@heading Examples
-
-@lisp
-;; Calling a standard C library function:
-(%foreign-funcall "sqrtf" :float 16.0 :float) @result{} 4.0
-@end lisp
-
-@lisp
-;; Dynamic allocation of a buffer and passing to a function:
-(with-foreign-ptr (buf 255 buf-size)
- (%foreign-funcall "gethostname" :pointer buf :size buf-size :int)
- ;; Convert buf to a Lisp string using MAKE-STRING and %MEM-REF or
- ;; a portable CFFI function such as CFFI:FOREIGN-STRING-TO-LISP.
- )
-@end lisp
-
-
-@node Loading Foreign Libraries
-@chapter Loading Foreign Libraries
-
-@defun %load-foreign-library name @result{} unspecified
-Load the foreign shared library @var{name}.
-
-@impnote{There is a lot of behavior to decide here. Currently I lean
-toward not requiring NAME to be a full path to the library so
-we can search the system library directories (maybe even get
-LD_LIBRARY_PATH from the environment) as necessary.}
-@end defun
-
-
-@node Foreign Globals
-@chapter Foreign Globals
-
-@defun foreign-symbol-pointer name @result{} pointer
-Return a pointer to a foreign symbol @var{name}.
-@end defun
-
-@node Symbol Index
-@unnumbered Symbol Index
-@printindex fn
-
-@bye
(DIR) diff --git a/3rdparties/software/cffi_0.20.0/doc/colorize-lisp-examples.lisp b/3rdparties/software/cffi_0.20.0/doc/colorize-lisp-examples.lisp
@@ -1,1058 +0,0 @@
-;;; This is code was taken from lisppaste2 and is a quick hack
-;;; to colorize lisp examples in the html generated by Texinfo.
-;;; It is not general-purpose utility, though it could easily be
-;;; turned into one.
-
-;;;; colorize-package.lisp
-
-(defpackage :colorize
- (:use :common-lisp)
- (:export :scan-string :format-scan :html-colorization
- :find-coloring-type :autodetect-coloring-type
- :coloring-types :scan :scan-any :advance :call-parent-formatter
- :*coloring-css* :make-background-css :*css-background-class*
- :colorize-file :colorize-file-to-stream :*version-token*))
-
-;;;; coloring-css.lisp
-
-(in-package :colorize)
-
-(defparameter *coloring-css*
- ".symbol { color: #770055; background-color: transparent; border: 0px; margin: 0px;}
-a.symbol:link { color: #229955; background-color : transparent; text-decoration: none; border: 0px; margin: 0px; }
-a.symbol:active { color : #229955; background-color : transparent; text-decoration: none; border: 0px; margin: 0px; }
-a.symbol:visited { color : #229955; background-color : transparent; text-decoration: none; border: 0px; margin: 0px; }
-a.symbol:hover { color : #229955; background-color : transparent; text-decoration: none; border: 0px; margin: 0px; }
-.special { color : #FF5000; background-color : inherit; }
-.keyword { color : #770000; background-color : inherit; }
-.comment { color : #007777; background-color : inherit; }
-.string { color : #777777; background-color : inherit; }
-.character { color : #0055AA; background-color : inherit; }
-.syntaxerror { color : #FF0000; background-color : inherit; }
-span.paren1:hover { color : inherit; background-color : #BAFFFF; }
-span.paren2:hover { color : inherit; background-color : #FFCACA; }
-span.paren3:hover { color : inherit; background-color : #FFFFBA; }
-span.paren4:hover { color : inherit; background-color : #CACAFF; }
-span.paren5:hover { color : inherit; background-color : #CAFFCA; }
-span.paren6:hover { color : inherit; background-color : #FFBAFF; }
-")
-
-(defvar *css-background-class* "lisp-bg")
-
-(defun for-css (thing)
- (if (symbolp thing) (string-downcase (symbol-name thing))
- thing))
-
-(defun make-background-css (color &key (class *css-background-class*) (extra nil))
- (format nil ".~A { background-color: ~A; color: black; ~{~A; ~}}~:*~:*~:*
-.~A:hover { background-color: ~A; color: black; ~{~A; ~}}~%"
- class color
- (mapcar #'(lambda (extra)
- (format nil "~A : ~{~A ~}"
- (for-css (first extra))
- (mapcar #'for-css (cdr extra))))
- extra)))
-
-;;;; colorize.lisp
-
-;(in-package :colorize)
-
-(eval-when (:compile-toplevel :load-toplevel :execute)
- (defparameter *coloring-types* nil)
- (defparameter *version-token* (gensym)))
-
-(defclass coloring-type ()
- ((modes :initarg :modes :accessor coloring-type-modes)
- (default-mode :initarg :default-mode :accessor coloring-type-default-mode)
- (transition-functions :initarg :transition-functions :accessor coloring-type-transition-functions)
- (fancy-name :initarg :fancy-name :accessor coloring-type-fancy-name)
- (term-formatter :initarg :term-formatter :accessor coloring-type-term-formatter)
- (formatter-initial-values :initarg :formatter-initial-values :accessor coloring-type-formatter-initial-values :initform nil)
- (formatter-after-hook :initarg :formatter-after-hook :accessor coloring-type-formatter-after-hook :initform (constantly ""))
- (autodetect-function :initarg :autodetect-function :accessor coloring-type-autodetect-function
- :initform (constantly nil))
- (parent-type :initarg :parent-type :accessor coloring-type-parent-type
- :initform nil)
- (visible :initarg :visible :accessor coloring-type-visible
- :initform t)))
-
-(defun find-coloring-type (type)
- (if (typep type 'coloring-type)
- type
- (cdr (assoc (symbol-name type) *coloring-types* :test #'string-equal :key #'symbol-name))))
-
-(defun autodetect-coloring-type (name)
- (car
- (find name *coloring-types*
- :key #'cdr
- :test #'(lambda (name type)
- (and (coloring-type-visible type)
- (funcall (coloring-type-autodetect-function type) name))))))
-
-(defun coloring-types ()
- (loop for type-pair in *coloring-types*
- if (coloring-type-visible (cdr type-pair))
- collect (cons (car type-pair)
- (coloring-type-fancy-name (cdr type-pair)))))
-
-(defun (setf find-coloring-type) (new-value type)
- (if new-value
- (let ((found (assoc type *coloring-types*)))
- (if found
- (setf (cdr found) new-value)
- (setf *coloring-types*
- (nconc *coloring-types*
- (list (cons type new-value))))))
- (setf *coloring-types* (remove type *coloring-types* :key #'car))))
-
-(defvar *scan-calls* 0)
-
-(defvar *reset-position* nil)
-
-(defmacro with-gensyms ((&rest names) &body body)
- `(let ,(mapcar #'(lambda (name)
- (list name `(make-symbol ,(symbol-name name)))) names)
- ,@body))
-
-(defmacro with-scanning-functions (string-param position-place mode-place mode-wait-place &body body)
- (with-gensyms (num items position not-preceded-by string item new-mode until advancing)
- `(labels ((advance (,num)
- (setf ,position-place (+ ,position-place ,num))
- t)
- (peek-any (,items &key ,not-preceded-by)
- (incf *scan-calls*)
- (let* ((,items (if (stringp ,items)
- (coerce ,items 'list) ,items))
- (,not-preceded-by (if (characterp ,not-preceded-by)
- (string ,not-preceded-by) ,not-preceded-by))
- (,position ,position-place)
- (,string ,string-param))
- (let ((,item (and
- (< ,position (length ,string))
- (find ,string ,items
- :test #'(lambda (,string ,item)
- #+nil
- (format t "looking for ~S in ~S starting at ~S~%"
- ,item ,string ,position)
- (if (characterp ,item)
- (char= (elt ,string ,position)
- ,item)
- (search ,item ,string :start2 ,position
- :end2 (min (length ,string)
- (+ ,position (length ,item))))))))))
- (if (characterp ,item)
- (setf ,item (string ,item)))
- (if
- (if ,item
- (if ,not-preceded-by
- (if (>= (- ,position (length ,not-preceded-by)) 0)
- (not (string= (subseq ,string
- (- ,position (length ,not-preceded-by))
- ,position)
- ,not-preceded-by))
- t)
- t)
- nil)
- ,item
- (progn
- (and *reset-position*
- (setf ,position-place *reset-position*))
- nil)))))
- (scan-any (,items &key ,not-preceded-by)
- (let ((,item (peek-any ,items :not-preceded-by ,not-preceded-by)))
- (and ,item (advance (length ,item)))))
- (peek (,item &key ,not-preceded-by)
- (peek-any (list ,item) :not-preceded-by ,not-preceded-by))
- (scan (,item &key ,not-preceded-by)
- (scan-any (list ,item) :not-preceded-by ,not-preceded-by)))
- (macrolet ((set-mode (,new-mode &key ,until (,advancing t))
- (list 'progn
- (list 'setf ',mode-place ,new-mode)
- (list 'setf ',mode-wait-place
- (list 'lambda (list ',position)
- (list 'let (list (list '*reset-position* ',position))
- (list 'values ,until ,advancing)))))))
- ,@body))))
-
-(defvar *formatter-local-variables*)
-
-(defmacro define-coloring-type (name fancy-name &key modes default-mode transitions formatters
- autodetect parent formatter-variables (formatter-after-hook '(constantly ""))
- invisible)
- (with-gensyms (parent-type term type string current-mode position position-foobage mode-wait new-position advance)
- `(let ((,parent-type (or (find-coloring-type ,parent)
- (and ,parent
- (error "No such coloring type: ~S" ,parent)))))
- (setf (find-coloring-type ,name)
- (make-instance 'coloring-type
- :fancy-name ',fancy-name
- :modes (append ',modes (if ,parent-type (coloring-type-modes ,parent-type)))
- :default-mode (or ',default-mode
- (if ,parent-type (coloring-type-default-mode ,parent-type)))
- ,@(if autodetect
- `(:autodetect-function ,autodetect))
- :parent-type ,parent-type
- :visible (not ,invisible)
- :formatter-initial-values (lambda nil
- (list* ,@(mapcar #'(lambda (e)
- `(cons ',(car e) ,(second e)))
- formatter-variables)
- (if ,parent-type
- (funcall (coloring-type-formatter-initial-values ,parent-type))
- nil)))
- :formatter-after-hook (lambda nil
- (symbol-macrolet ,(mapcar #'(lambda (e)
- `(,(car e) (cdr (assoc ',(car e) *formatter-local-variables*))))
- formatter-variables)
- (concatenate 'string
- (funcall ,formatter-after-hook)
- (if ,parent-type
- (funcall (coloring-type-formatter-after-hook ,parent-type))
- ""))))
- :term-formatter
- (symbol-macrolet ,(mapcar #'(lambda (e)
- `(,(car e) (cdr (assoc ',(car e) *formatter-local-variables*))))
- formatter-variables)
- (lambda (,term)
- (labels ((call-parent-formatter (&optional (,type (car ,term))
- (,string (cdr ,term)))
- (if ,parent-type
- (funcall (coloring-type-term-formatter ,parent-type)
- (cons ,type ,string))))
- (call-formatter (&optional (,type (car ,term))
- (,string (cdr ,term)))
- (funcall
- (case (first ,type)
- ,@formatters
- (t (lambda (,type text)
- (call-parent-formatter ,type text))))
- ,type ,string)))
- (call-formatter))))
- :transition-functions
- (list
- ,@(loop for transition in transitions
- collect (destructuring-bind (mode &rest table) transition
- `(cons ',mode
- (lambda (,current-mode ,string ,position)
- (let ((,mode-wait (constantly nil))
- (,position-foobage ,position))
- (with-scanning-functions ,string ,position-foobage
- ,current-mode ,mode-wait
- (let ((*reset-position* ,position))
- (cond ,@table))
- (values ,position-foobage ,current-mode
- (lambda (,new-position)
- (setf ,position-foobage ,new-position)
- (let ((,advance (nth-value 1 (funcall ,mode-wait ,position-foobage))))
- (values ,position-foobage ,advance)))))
- )))))))))))
-
-(defun full-transition-table (coloring-type-object)
- (let ((parent (coloring-type-parent-type coloring-type-object)))
- (if parent
- (append (coloring-type-transition-functions coloring-type-object)
- (full-transition-table parent))
- (coloring-type-transition-functions coloring-type-object))))
-
-(defun scan-string (coloring-type string)
- (let* ((coloring-type-object (or (find-coloring-type coloring-type)
- (error "No such coloring type: ~S" coloring-type)))
- (transitions (full-transition-table coloring-type-object))
- (result nil)
- (low-bound 0)
- (current-mode (coloring-type-default-mode coloring-type-object))
- (mode-stack nil)
- (current-wait (constantly nil))
- (wait-stack nil)
- (current-position 0)
- (*scan-calls* 0))
- (flet ((finish-current (new-position new-mode new-wait &key (extend t) push pop)
- (let ((to (if extend new-position current-position)))
- (if (> to low-bound)
- (setf result (nconc result
- (list (cons (cons current-mode mode-stack)
- (subseq string low-bound
- to))))))
- (setf low-bound to)
- (when pop
- (pop mode-stack)
- (pop wait-stack))
- (when push
- (push current-mode mode-stack)
- (push current-wait wait-stack))
- (setf current-mode new-mode
- current-position new-position
- current-wait new-wait))))
- (loop
- (if (> current-position (length string))
- (return-from scan-string
- (progn
- (format *trace-output* "Scan was called ~S times.~%"
- *scan-calls*)
- (finish-current (length string) nil (constantly nil))
- result))
- (or
- (loop for transition in
- (mapcar #'cdr
- (remove current-mode transitions
- :key #'car
- :test-not #'(lambda (a b)
- (or (eql a b)
- (if (listp b)
- (member a b))))))
- if
- (and transition
- (multiple-value-bind
- (new-position new-mode new-wait)
- (funcall transition current-mode string current-position)
- (when (> new-position current-position)
- (finish-current new-position new-mode new-wait :extend nil :push t)
- t)))
- return t)
- (multiple-value-bind
- (pos advance)
- (funcall current-wait current-position)
- #+nil
- (format t "current-wait returns ~S ~S (mode is ~S, pos is ~S)~%" pos advance current-mode current-position)
- (and pos
- (when (> pos current-position)
- (finish-current (if advance
- pos
- current-position)
- (car mode-stack)
- (car wait-stack)
- :extend advance
- :pop t)
- t)))
- (progn
- (incf current-position)))
- )))))
-
-(defun format-scan (coloring-type scan)
- (let* ((coloring-type-object (or (find-coloring-type coloring-type)
- (error "No such coloring type: ~S" coloring-type)))
- (color-formatter (coloring-type-term-formatter coloring-type-object))
- (*formatter-local-variables* (funcall (coloring-type-formatter-initial-values coloring-type-object))))
- (format nil "~{~A~}~A"
- (mapcar color-formatter scan)
- (funcall (coloring-type-formatter-after-hook coloring-type-object)))))
-
-(defun encode-for-pre (string)
- (declare (simple-string string))
- (let ((output (make-array (truncate (length string) 2/3)
- :element-type 'character
- :adjustable t
- :fill-pointer 0)))
- (with-output-to-string (out output)
- (loop for char across string
- do (case char
- ((#\&) (write-string "&" out))
- ((#\<) (write-string "<" out))
- ((#\>) (write-string ">" out))
- ((#\") (write-string """ out))
- ((#\RIGHTWARDS_DOUBLE_ARROW) (write-string "⇒" out))
- (t (write-char char out)))))
- (coerce output 'simple-string)))
-
-(defun string-substitute (string substring replacement-string)
- "String substitute by Larry Hunter. Obtained from Google"
- (let ((substring-length (length substring))
- (last-end 0)
- (new-string ""))
- (do ((next-start
- (search substring string)
- (search substring string :start2 last-end)))
- ((null next-start)
- (concatenate 'string new-string (subseq string last-end)))
- (setq new-string
- (concatenate 'string
- new-string
- (subseq string last-end next-start)
- replacement-string))
- (setq last-end (+ next-start substring-length)))))
-
-(defun decode-from-tt (string)
- (string-substitute
- (string-substitute
- (string-substitute
- (string-substitute
- (string-substitute string "&" "&")
- "<" "<")
- ">" ">")
- "⇒" (string #\RIGHTWARDS_DOUBLE_ARROW))
- """ "\""))
-
-(defun html-colorization (coloring-type string)
- (format-scan coloring-type
- (mapcar #'(lambda (p)
- (cons (car p)
- (let ((tt (encode-for-pre (cdr p))))
- (if (and (> (length tt) 0)
- (char= (elt tt (1- (length tt))) #\>))
- (format nil "~A~%" tt) tt))))
- (scan-string coloring-type string))))
-
-(defun colorize-file-to-stream (coloring-type input-file-name s2 &key (wrap t) (css-background "default"))
- (let* ((input-file (if (pathname-type (merge-pathnames input-file-name))
- (merge-pathnames input-file-name)
- (make-pathname :type "lisp"
- :defaults (merge-pathnames input-file-name))))
- (*css-background-class* css-background))
- (with-open-file (s input-file :direction :input)
- (let ((lines nil)
- (string nil))
- (block done
- (loop (let ((line (read-line s nil nil)))
- (if line
- (push line lines)
- (return-from done)))))
- (setf string (format nil "~{~A~%~}"
- (nreverse lines)))
- (if wrap
- (format s2
- "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\" \"http://www.w3.org/TR/html4/loose.dtd\">
-<html><head><style type=\"text/css\">~A~%~A</style><body>
-<table width=\"100%\"><tr><td class=\"~A\">
-<tt>~A</tt>
-</tr></td></table></body></html>"
- *coloring-css*
- (make-background-css "white")
- *css-background-class*
- (html-colorization coloring-type string))
- (write-string (html-colorization coloring-type string) s2))))))
-
-(defun colorize-file (coloring-type input-file-name &optional output-file-name)
- (let* ((input-file (if (pathname-type (merge-pathnames input-file-name))
- (merge-pathnames input-file-name)
- (make-pathname :type "lisp"
- :defaults (merge-pathnames input-file-name))))
- (output-file (or output-file-name
- (make-pathname :type "html"
- :defaults input-file))))
- (with-open-file (s2 output-file :direction :output :if-exists :supersede)
- (colorize-file-to-stream coloring-type input-file-name s2))))
-
-;; coloring-types.lisp
-
-;(in-package :colorize)
-
-(eval-when (:compile-toplevel :load-toplevel :execute)
- (defparameter *version-token* (gensym)))
-
-(defparameter *symbol-characters*
- "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ*!%$&+-1234567890")
-
-(defparameter *non-constituent*
- '(#\space #\tab #\newline #\linefeed #\page #\return
- #\" #\' #\( #\) #\, #\; #\` #\[ #\]))
-
-(defparameter *special-forms*
- '("let" "load-time-value" "quote" "macrolet" "progn" "progv" "go" "flet" "the"
- "if" "throw" "eval-when" "multiple-value-prog1" "unwind-protect" "let*"
- "labels" "function" "symbol-macrolet" "block" "tagbody" "catch" "locally"
- "return-from" "setq" "multiple-value-call"))
-
-(defparameter *common-macros*
- '("loop" "cond" "lambda"))
-
-(defparameter *open-parens* '(#\())
-(defparameter *close-parens* '(#\)))
-
-(define-coloring-type :lisp "Basic Lisp"
- :modes (:first-char-on-line :normal :symbol :escaped-symbol :keyword :string :comment
- :multiline :character
- :single-escaped :in-list :syntax-error)
- :default-mode :first-char-on-line
- :transitions
- (((:in-list)
- ((or
- (scan-any *symbol-characters*)
- (and (scan #\.) (scan-any *symbol-characters*))
- (and (scan #\\) (advance 1)))
- (set-mode :symbol
- :until (scan-any *non-constituent*)
- :advancing nil))
- ((or (scan #\:) (scan "#:"))
- (set-mode :keyword
- :until (scan-any *non-constituent*)
- :advancing nil))
- ((scan "#\\")
- (let ((count 0))
- (set-mode :character
- :until (progn
- (incf count)
- (if (> count 1)
- (scan-any *non-constituent*)))
- :advancing nil)))
- ((scan #\")
- (set-mode :string
- :until (scan #\")))
- ((scan #\;)
- (set-mode :comment
- :until (scan #\newline)))
- ((scan "#|")
- (set-mode :multiline
- :until (scan "|#")))
- ((scan #\()
- (set-mode :in-list
- :until (scan #\)))))
- ((:normal :first-char-on-line)
- ((scan #\()
- (set-mode :in-list
- :until (scan #\)))))
- (:first-char-on-line
- ((scan #\;)
- (set-mode :comment
- :until (scan #\newline)))
- ((scan "#|")
- (set-mode :multiline
- :until (scan "|#")))
- ((advance 1)
- (set-mode :normal
- :until (scan #\newline))))
- (:multiline
- ((scan "#|")
- (set-mode :multiline
- :until (scan "|#"))))
- ((:symbol :keyword :escaped-symbol :string)
- ((scan #\\)
- (let ((count 0))
- (set-mode :single-escaped
- :until (progn
- (incf count)
- (if (< count 2)
- (advance 1))))))))
- :formatter-variables ((paren-counter 0))
- :formatter-after-hook (lambda nil
- (format nil "~{~A~}"
- (loop for i from paren-counter downto 1
- collect "</span></span>")))
- :formatters
- (((:normal :first-char-on-line)
- (lambda (type s)
- (declare (ignore type))
- s))
- ((:in-list)
- (lambda (type s)
- (declare (ignore type))
- (labels ((color-parens (s)
- (let ((paren-pos (find-if-not #'null
- (mapcar #'(lambda (c)
- (position c s))
- (append *open-parens*
- *close-parens*)))))
- (if paren-pos
- (let ((before-paren (subseq s 0 paren-pos))
- (after-paren (subseq s (1+ paren-pos)))
- (paren (elt s paren-pos))
- (open nil)
- (count 0))
- (when (member paren *open-parens* :test #'char=)
- (setf count (mod paren-counter 6))
- (incf paren-counter)
- (setf open t))
- (when (member paren *close-parens* :test #'char=)
- (decf paren-counter))
- (if open
- (format nil "~A<span class=\"paren~A\">~C<span class=\"~A\">~A"
- before-paren
- (1+ count)
- paren *css-background-class*
- (color-parens after-paren))
- (format nil "~A</span>~C</span>~A"
- before-paren
- paren (color-parens after-paren))))
- s))))
- (color-parens s))))
- ((:symbol :escaped-symbol)
- (lambda (type s)
- (declare (ignore type))
- (let* ((colon (position #\: s :from-end t))
- (new-s (or (and colon (subseq s (1+ colon))) s)))
- (cond
- ((or
- (member new-s *common-macros* :test #'string-equal)
- (member new-s *special-forms* :test #'string-equal)
- (some #'(lambda (e)
- (and (> (length new-s) (length e))
- (string-equal e (subseq new-s 0 (length e)))))
- '("WITH-" "DEF")))
- (format nil "<i><span class=\"symbol\">~A</span></i>" s))
- ((and (> (length new-s) 2)
- (char= (elt new-s 0) #\*)
- (char= (elt new-s (1- (length new-s))) #\*))
- (format nil "<span class=\"special\">~A</span>" s))
- (t s)))))
- (:keyword (lambda (type s)
- (declare (ignore type))
- (format nil "<span class=\"keyword\">~A</span>"
- s)))
- ((:comment :multiline)
- (lambda (type s)
- (declare (ignore type))
- (format nil "<span class=\"comment\">~A</span>"
- s)))
- ((:character)
- (lambda (type s)
- (declare (ignore type))
- (format nil "<span class=\"character\">~A</span>"
- s)))
- ((:string)
- (lambda (type s)
- (declare (ignore type))
- (format nil "<span class=\"string\">~A</span>"
- s)))
- ((:single-escaped)
- (lambda (type s)
- (call-formatter (cdr type) s)))
- ((:syntax-error)
- (lambda (type s)
- (declare (ignore type))
- (format nil "<span class=\"syntaxerror\">~A</span>"
- s)))))
-
-(define-coloring-type :scheme "Scheme"
- :autodetect (lambda (text)
- (or
- (search "scheme" text :test #'char-equal)
- (search "chicken" text :test #'char-equal)))
- :parent :lisp
- :transitions
- (((:normal :in-list)
- ((scan "...")
- (set-mode :symbol
- :until (scan-any *non-constituent*)
- :advancing nil))
- ((scan #\[)
- (set-mode :in-list
- :until (scan #\])))))
- :formatters
- (((:in-list)
- (lambda (type s)
- (declare (ignore type s))
- (let ((*open-parens* (cons #\[ *open-parens*))
- (*close-parens* (cons #\] *close-parens*)))
- (call-parent-formatter))))
- ((:symbol :escaped-symbol)
- (lambda (type s)
- (declare (ignore type))
- (let ((result (if (find-package :r5rs-lookup)
- (funcall (symbol-function (intern "SYMBOL-LOOKUP" :r5rs-lookup))
- s))))
- (if result
- (format nil "<a href=\"~A\" class=\"symbol\">~A</a>"
- result (call-parent-formatter))
- (call-parent-formatter)))))))
-
-(define-coloring-type :elisp "Emacs Lisp"
- :autodetect (lambda (name)
- (member name '("emacs")
- :test #'(lambda (name ext)
- (search ext name :test #'char-equal))))
- :parent :lisp
- :formatters
- (((:symbol :escaped-symbol)
- (lambda (type s)
- (declare (ignore type))
- (let ((result (if (find-package :elisp-lookup)
- (funcall (symbol-function (intern "SYMBOL-LOOKUP" :elisp-lookup))
- s))))
- (if result
- (format nil "<a href=\"~A\" class=\"symbol\">~A</a>"
- result (call-parent-formatter))
- (call-parent-formatter)))))))
-
-(define-coloring-type :common-lisp "Common Lisp"
- :autodetect (lambda (text)
- (search "lisp" text :test #'char-equal))
- :parent :lisp
- :transitions
- (((:normal :in-list)
- ((scan #\|)
- (set-mode :escaped-symbol
- :until (scan #\|)))))
- :formatters
- (((:symbol :escaped-symbol)
- (lambda (type s)
- (declare (ignore type))
- (let* ((colon (position #\: s :from-end t :test #'char=))
- (to-lookup (if colon (subseq s (1+ colon)) s))
- (result (if (find-package :clhs-lookup)
- (funcall (symbol-function (intern "SYMBOL-LOOKUP" :clhs-lookup))
- to-lookup))))
- (if result
- (format nil "<a href=\"~A\" class=\"symbol\">~A</a>"
- result (call-parent-formatter))
- (call-parent-formatter)))))))
-
-(define-coloring-type :common-lisp-file "Common Lisp File"
- :parent :common-lisp
- :default-mode :in-list
- :invisible t)
-
-(defvar *c-open-parens* "([{")
-(defvar *c-close-parens* ")]}")
-
-(defvar *c-reserved-words*
- '("auto" "break" "case" "char" "const"
- "continue" "default" "do" "double" "else"
- "enum" "extern" "float" "for" "goto"
- "if" "int" "long" "register" "return"
- "short" "signed" "sizeof" "static" "struct"
- "switch" "typedef" "union" "unsigned" "void"
- "volatile" "while" "__restrict" "_Bool"))
-
-(defparameter *c-begin-word* "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ_0123456789")
-(defparameter *c-terminators* '(#\space #\return #\tab #\newline #\. #\/ #\- #\* #\+ #\{ #\} #\( #\) #\' #\" #\[ #\] #\< #\> #\#))
-
-(define-coloring-type :basic-c "Basic C"
- :modes (:normal :comment :word-ish :paren-ish :string :char :single-escape :preprocessor)
- :default-mode :normal
- :invisible t
- :transitions
- ((:normal
- ((scan-any *c-begin-word*)
- (set-mode :word-ish
- :until (scan-any *c-terminators*)
- :advancing nil))
- ((scan "/*")
- (set-mode :comment
- :until (scan "*/")))
- ((or
- (scan-any *c-open-parens*)
- (scan-any *c-close-parens*))
- (set-mode :paren-ish
- :until (advance 1)
- :advancing nil))
- ((scan #\")
- (set-mode :string
- :until (scan #\")))
- ((or (scan "'\\")
- (scan #\'))
- (set-mode :character
- :until (advance 2))))
- (:string
- ((scan #\\)
- (set-mode :single-escape
- :until (advance 1)))))
- :formatter-variables
- ((paren-counter 0))
- :formatter-after-hook (lambda nil
- (format nil "~{~A~}"
- (loop for i from paren-counter downto 1
- collect "</span></span>")))
- :formatters
- ((:normal
- (lambda (type s)
- (declare (ignore type))
- s))
- (:comment
- (lambda (type s)
- (declare (ignore type))
- (format nil "<span class=\"comment\">~A</span>"
- s)))
- (:string
- (lambda (type s)
- (declare (ignore type))
- (format nil "<span class=\"string\">~A</span>"
- s)))
- (:character
- (lambda (type s)
- (declare (ignore type))
- (format nil "<span class=\"character\">~A</span>"
- s)))
- (:single-escape
- (lambda (type s)
- (call-formatter (cdr type) s)))
- (:paren-ish
- (lambda (type s)
- (declare (ignore type))
- (let ((open nil)
- (count 0))
- (if (eql (length s) 1)
- (progn
- (when (member (elt s 0) (coerce *c-open-parens* 'list))
- (setf open t)
- (setf count (mod paren-counter 6))
- (incf paren-counter))
- (when (member (elt s 0) (coerce *c-close-parens* 'list))
- (setf open nil)
- (decf paren-counter)
- (setf count (mod paren-counter 6)))
- (if open
- (format nil "<span class=\"paren~A\">~A<span class=\"~A\">"
- (1+ count) s *css-background-class*)
- (format nil "</span>~A</span>"
- s)))
- s))))
- (:word-ish
- (lambda (type s)
- (declare (ignore type))
- (if (member s *c-reserved-words* :test #'string=)
- (format nil "<span class=\"symbol\">~A</span>" s)
- s)))
- ))
-
-(define-coloring-type :c "C"
- :parent :basic-c
- :transitions
- ((:normal
- ((scan #\#)
- (set-mode :preprocessor
- :until (scan-any '(#\return #\newline))))))
- :formatters
- ((:preprocessor
- (lambda (type s)
- (declare (ignore type))
- (format nil "<span class=\"special\">~A</span>" s)))))
-
-(defvar *c++-reserved-words*
- '("asm" "auto" "bool" "break" "case"
- "catch" "char" "class" "const" "const_cast"
- "continue" "default" "delete" "do" "double"
- "dynamic_cast" "else" "enum" "explicit" "export"
- "extern" "false" "float" "for" "friend"
- "goto" "if" "inline" "int" "long"
- "mutable" "namespace" "new" "operator" "private"
- "protected" "public" "register" "reinterpret_cast" "return"
- "short" "signed" "sizeof" "static" "static_cast"
- "struct" "switch" "template" "this" "throw"
- "true" "try" "typedef" "typeid" "typename"
- "union" "unsigned" "using" "virtual" "void"
- "volatile" "wchar_t" "while"))
-
-(define-coloring-type :c++ "C++"
- :parent :c
- :transitions
- ((:normal
- ((scan "//")
- (set-mode :comment
- :until (scan-any '(#\return #\newline))))))
- :formatters
- ((:word-ish
- (lambda (type s)
- (declare (ignore type))
- (if (member s *c++-reserved-words* :test #'string=)
- (format nil "<span class=\"symbol\">~A</span>"
- s)
- s)))))
-
-(defvar *java-reserved-words*
- '("abstract" "boolean" "break" "byte" "case"
- "catch" "char" "class" "const" "continue"
- "default" "do" "double" "else" "extends"
- "final" "finally" "float" "for" "goto"
- "if" "implements" "import" "instanceof" "int"
- "interface" "long" "native" "new" "package"
- "private" "protected" "public" "return" "short"
- "static" "strictfp" "super" "switch" "synchronized"
- "this" "throw" "throws" "transient" "try"
- "void" "volatile" "while"))
-
-(define-coloring-type :java "Java"
- :parent :c++
- :formatters
- ((:word-ish
- (lambda (type s)
- (declare (ignore type))
- (if (member s *java-reserved-words* :test #'string=)
- (format nil "<span class=\"symbol\">~A</span>"
- s)
- s)))))
-
-(let ((terminate-next nil))
- (define-coloring-type :objective-c "Objective C"
- :autodetect (lambda (text) (search "mac" text :test #'char=))
- :modes (:begin-message-send :end-message-send)
- :transitions
- ((:normal
- ((scan #\[)
- (set-mode :begin-message-send
- :until (advance 1)
- :advancing nil))
- ((scan #\])
- (set-mode :end-message-send
- :until (advance 1)
- :advancing nil))
- ((scan-any *c-begin-word*)
- (set-mode :word-ish
- :until (or
- (and (peek-any '(#\:))
- (setf terminate-next t))
- (and terminate-next (progn
- (setf terminate-next nil)
- (advance 1)))
- (scan-any *c-terminators*))
- :advancing nil)))
- (:word-ish
- #+nil
- ((scan #\:)
- (format t "hi~%")
- (set-mode :word-ish :until (advance 1) :advancing nil)
- (setf terminate-next t))))
- :parent :c++
- :formatter-variables ((is-keyword nil) (in-message-send nil))
- :formatters
- ((:begin-message-send
- (lambda (type s)
- (setf is-keyword nil)
- (setf in-message-send t)
- (call-formatter (cons :paren-ish type) s)))
- (:end-message-send
- (lambda (type s)
- (setf is-keyword nil)
- (setf in-message-send nil)
- (call-formatter (cons :paren-ish type) s)))
- (:word-ish
- (lambda (type s)
- (declare (ignore type))
- (prog1
- (let ((result (if (find-package :cocoa-lookup)
- (funcall (symbol-function (intern "SYMBOL-LOOKUP" :cocoa-lookup))
- s))))
- (if result
- (format nil "<a href=\"~A\" class=\"symbol\">~A</a>"
- result s)
- (if (member s *c-reserved-words* :test #'string=)
- (format nil "<span class=\"symbol\">~A</span>" s)
- (if in-message-send
- (if is-keyword
- (format nil "<span class=\"keyword\">~A</span>" s)
- s)
- s))))
- (setf is-keyword (not is-keyword))))))))
-
-
-;#!/usr/bin/clisp
-;#+sbcl
-;(require :asdf)
-;(asdf:oos 'asdf:load-op :colorize)
-
-(defmacro with-each-stream-line ((var stream) &body body)
- (let ((eof (gensym))
- (eof-value (gensym))
- (strm (gensym)))
- `(let ((,strm ,stream)
- (,eof ',eof-value))
- (do ((,var (read-line ,strm nil ,eof) (read-line ,strm nil ,eof)))
- ((eql ,var ,eof))
- ,@body))))
-
-(defun system (control-string &rest args)
- "Interpolate ARGS into CONTROL-STRING as if by FORMAT, and
-synchronously execute the result using a Bourne-compatible shell, with
-output to *verbose-out*. Returns the shell's exit code."
- (let ((command (apply #'format nil control-string args)))
- (format t "; $ ~A~%" command)
- #+sbcl
- (sb-impl::process-exit-code
- (sb-ext:run-program
- "/bin/sh"
- (list "-c" command)
- :input nil :output *standard-output*))
- #+(or cmucl scl)
- (ext:process-exit-code
- (ext:run-program
- "/bin/sh"
- (list "-c" command)
- :input nil :output *verbose-out*))
- #+clisp ;XXX not exactly *verbose-out*, I know
- (ext:run-shell-command command :output :terminal :wait t)
- ))
-
-(defun strcat (&rest strings)
- (apply #'concatenate 'string strings))
-
-(defun string-starts-with (start str)
- (and (>= (length str) (length start))
- (string-equal start str :end2 (length start))))
-
-(defmacro string-append (outputstr &rest args)
- `(setq ,outputstr (concatenate 'string ,outputstr ,@args)))
-
-(defconstant +indent+ 0
- "Indentation used in the examples.")
-
-(defun texinfo->raw-lisp (code)
- "Answer CODE with spurious Texinfo output removed. For use in
-preprocessing output in a @lisp block before passing to colorize."
- (decode-from-tt
- (with-output-to-string (output)
- (do* ((last-position 0)
- (next-position
- #0=(search #1="<span class=\"roman\">" code
- :start2 last-position :test #'char-equal)
- #0#))
- ((eq nil next-position)
- (write-string code output :start last-position))
- (write-string code output :start last-position :end next-position)
- (let ((end (search #2="</span>" code
- :start2 (+ next-position (length #1#))
- :test #'char-equal)))
- (assert (integerp end) ()
- "Missing ~A tag in HTML for @lisp block~%~
- HTML contents of block:~%~A" #2# code)
- (write-string code output
- :start (+ next-position (length #1#))
- :end end)
- (setf last-position (+ end (length #2#))))))))
-
-(defun process-file (from to)
- (with-open-file (output to :direction :output :if-exists :error)
- (with-open-file (input from :direction :input)
- (let ((line-processor nil)
- (piece-of-code '()))
- (labels
- ((process-line-inside-pre (line)
- (cond ((string-starts-with "</pre>" line)
- (with-input-from-string
- (stream (colorize:html-colorization
- :common-lisp
- (texinfo->raw-lisp
- (apply #'concatenate 'string
- (nreverse piece-of-code)))))
- (with-each-stream-line (cline stream)
- (format output " ~A~%" cline)))
- (write-line line output)
- (setq piece-of-code '()
- line-processor #'process-regular-line))
- (t (let ((to-append (subseq line +indent+)))
- (push (if (string= "" to-append)
- " "
- to-append) piece-of-code)
- (push (string #\Newline) piece-of-code)))))
- (process-regular-line (line)
- (let ((len (some (lambda (test-string)
- (when (string-starts-with test-string line)
- (length test-string)))
- '("<pre class=\"lisp\">"
- "<pre class=\"smalllisp\">"))))
- (cond (len
- (setq line-processor #'process-line-inside-pre)
- (write-string "<pre class=\"lisp\">" output)
- (push (subseq line (+ len +indent+)) piece-of-code)
- (push (string #\Newline) piece-of-code))
- (t (write-line line output))))))
- (setf line-processor #'process-regular-line)
- (with-each-stream-line (line input)
- (funcall line-processor line)))))))
-
-(defun process-dir (dir)
- (dolist (html-file (directory dir))
- (let* ((name (namestring html-file))
- (temp-name (strcat name ".temp")))
- (process-file name temp-name)
- (system "mv ~A ~A" temp-name name))))
-
-;; (go "/tmp/doc/manual/html_node/*.html")
-
-#+clisp
-(progn
- (assert (first ext:*args*))
- (process-dir (first ext:*args*)))
-
-#+sbcl
-(progn
- (assert (second sb-ext:*posix-argv*))
- (process-dir (second sb-ext:*posix-argv*))
- (sb-ext:quit))
(DIR) diff --git a/3rdparties/software/cffi_0.20.0/doc/gendocs.sh b/3rdparties/software/cffi_0.20.0/doc/gendocs.sh
@@ -1,313 +0,0 @@
-#!/bin/sh
-# gendocs.sh -- generate a GNU manual in many formats. This script is
-# mentioned in maintain.texi. See the help message below for usage details.
-# $Id: gendocs.sh,v 1.16 2005/05/15 00:00:08 karl Exp $
-#
-# Copyright (C) 2003, 2004, 2005 Free Software Foundation, Inc.
-#
-# This program is free software; you can redistribute it and/or modify
-# it under the terms of the GNU General Public License as published by
-# the Free Software Foundation; either version 2, or (at your option)
-# any later version.
-#
-# This program is distributed in the hope that it will be useful,
-# but WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-# GNU General Public License for more details.
-#
-# You should have received a copy of the GNU General Public License
-# along with this program; if not, you can either send email to this
-# program's maintainer or write to: The Free Software Foundation,
-# Inc.; 51 Franklin Street, Fifth Floor; Boston, MA 02110-1301, USA.
-#
-# Original author: Mohit Agarwal.
-# Send bug reports and any other correspondence to bug-texinfo@gnu.org.
-
-#set -e
-
-prog="`basename \"$0\"`"
-srcdir=`pwd`
-
-scripturl="https://github.com/cffi/cffi/blob/master/doc/gendocs.sh"
-templateurl="http://savannah.gnu.org/cgi-bin/viewcvs/texinfo/texinfo/util/gendocs_template"
-
-: ${MAKEINFO="makeinfo"}
-: ${TEXI2DVI="texi2dvi -t @finalout"}
-: ${DVIPS="dvips"}
-: ${DOCBOOK2TXT="docbook2txt"}
-: ${DOCBOOK2HTML="docbook2html"}
-: ${DOCBOOK2PDF="docbook2pdf"}
-: ${DOCBOOK2PS="docbook2ps"}
-: ${GENDOCS_TEMPLATE_DIR="."}
-unset CDPATH
-
-rcs_revision='$Revision: 1.16 $'
-rcs_version=`set - $rcs_revision; echo $2`
-program=`echo $0 | sed -e 's!.*/!!'`
-version="gendocs.sh $rcs_version
-
-Copyright (C) 2005 Free Software Foundation, Inc.
-There is NO warranty. You may redistribute this software
-under the terms of the GNU General Public License.
-For more information about these matters, see the files named COPYING."
-
-usage="Usage: $prog [OPTION]... PACKAGE MANUAL-TITLE
-
-Generate various output formats from PACKAGE.texinfo (or .texi or .txi) source.
-See the GNU Maintainers document for a more extensive discussion:
- http://www.gnu.org/prep/maintain_toc.html
-
-Options:
- -o OUTDIR write files into OUTDIR, instead of manual/.
- --docbook convert to DocBook too (xml, txt, html, pdf and ps).
- --html ARG pass indicated ARG to makeinfo for HTML targets.
- --help display this help and exit successfully.
- --version display version information and exit successfully.
-
-Simple example: $prog emacs \"GNU Emacs Manual\"
-
-Typical sequence:
- cd YOURPACKAGESOURCE/doc
- wget \"$scripturl\"
- wget \"$templateurl\"
- $prog YOURMANUAL \"GNU YOURMANUAL - One-line description\"
-
-Output will be in a new subdirectory \"manual\" (by default, use -o OUTDIR
-to override). Move all the new files into your web CVS tree, as
-explained in the Web Pages node of maintain.texi.
-
-MANUAL-TITLE is included as part of the HTML <title> of the overall
-manual/index.html file. It should include the name of the package being
-documented. manual/index.html is created by substitution from the file
-$GENDOCS_TEMPLATE_DIR/gendocs_template. (Feel free to modify the
-generic template for your own purposes.)
-
-If you have several manuals, you'll need to run this script several
-times with different YOURMANUAL values, specifying a different output
-directory with -o each time. Then write (by hand) an overall index.html
-with links to them all.
-
-You can set the environment variables MAKEINFO, TEXI2DVI, and DVIPS to
-control the programs that get executed, and GENDOCS_TEMPLATE_DIR to
-control where the gendocs_template file is looked for.
-
-Email bug reports or enhancement requests to bug-texinfo@gnu.org.
-"
-
-calcsize()
-{
- size="`ls -ksl $1 | awk '{print $1}'`"
- echo $size
-}
-
-outdir=manual
-html=
-PACKAGE=
-MANUAL_TITLE=
-
-while test $# -gt 0; do
- case $1 in
- --help) echo "$usage"; exit 0;;
- --version) echo "$version"; exit 0;;
- -o) shift; outdir=$1;;
- --docbook) docbook=yes;;
- --html) shift; html=$1;;
- -*)
- echo "$0: Unknown or ambiguous option \`$1'." >&2
- echo "$0: Try \`--help' for more information." >&2
- exit 1;;
- *)
- if test -z "$PACKAGE"; then
- PACKAGE=$1
- elif test -z "$MANUAL_TITLE"; then
- MANUAL_TITLE=$1
- else
- echo "$0: extra non-option argument \`$1'." >&2
- exit 1
- fi;;
- esac
- shift
-done
-
-if test -s $srcdir/$PACKAGE.texinfo; then
- srcfile=$srcdir/$PACKAGE.texinfo
-elif test -s $srcdir/$PACKAGE.texi; then
- srcfile=$srcdir/$PACKAGE.texi
-elif test -s $srcdir/$PACKAGE.txi; then
- srcfile=$srcdir/$PACKAGE.txi
-else
- echo "$0: cannot find .texinfo or .texi or .txi for $PACKAGE in $srcdir." >&2
- exit 1
-fi
-
-if test ! -r $GENDOCS_TEMPLATE_DIR/gendocs_template; then
- echo "$0: cannot read $GENDOCS_TEMPLATE_DIR/gendocs_template." >&2
- echo "$0: it is available from $templateurl." >&2
- exit 1
-fi
-
-echo Generating output formats for $srcfile
-
-cmd="${MAKEINFO} -o $PACKAGE.info $srcfile"
-echo "Generating info files... ($cmd)"
-eval $cmd
-install-info $PACKAGE.info dir
-mkdir -p $outdir/
-tar czf $outdir/$PACKAGE.info.tar.gz $PACKAGE.info*
-info_tgz_size="`calcsize $outdir/$PACKAGE.info.tar.gz`"
-# do not mv the info files, there's no point in having them available
-# separately on the web.
-
-cmd="${TEXI2DVI} $srcfile"
-echo "Generating dvi ... ($cmd)"
-eval $cmd
-
-# now, before we compress dvi:
-echo Generating postscript...
-${DVIPS} $PACKAGE -o
-gzip -f -9 $PACKAGE.ps
-ps_gz_size="`calcsize $PACKAGE.ps.gz`"
-mv $PACKAGE.ps.gz $outdir/
-
-# compress/finish dvi:
-gzip -f -9 $PACKAGE.dvi
-dvi_gz_size="`calcsize $PACKAGE.dvi.gz`"
-mv $PACKAGE.dvi.gz $outdir/
-
-cmd="${TEXI2DVI} --pdf $srcfile"
-echo "Generating pdf ... ($cmd)"
-eval $cmd
-pdf_size="`calcsize $PACKAGE.pdf`"
-mv $PACKAGE.pdf $outdir/
-
-cmd="${MAKEINFO} -o $PACKAGE.txt --no-split --no-headers $srcfile"
-echo "Generating ASCII... ($cmd)"
-eval $cmd
-ascii_size="`calcsize $PACKAGE.txt`"
-gzip -f -9 -c $PACKAGE.txt >$outdir/$PACKAGE.txt.gz
-ascii_gz_size="`calcsize $outdir/$PACKAGE.txt.gz`"
-mv $PACKAGE.txt $outdir/
-
-# Print a SED expression that will translate references to MANUAL to
-# the proper page on gnu.org. This is a horrible shell hack done
-# because \| in sed regexps is a GNU extension.
-monognuorg () {
- case "$1" in
- libtool) echo "s!$1.html!http://www.gnu.org/software/$1/manual.html!" ;;
- *) echo "s!$1.html!http://www.gnu.org/software/$1/manual/html_mono/$1.html!" ;;
- esac
-}
-polygnuorg () {
- case "$1" in
- libtool) echo 's!\.\./'"$1/.*\.html!http://www.gnu.org/software/$1/manual.html!" ;;
- *) echo 's!\.\./'"$1!http://www.gnu.org/software/$1/manual/html_node!" ;;
- esac
-}
-
-cmd="${MAKEINFO} --no-split --html -o $PACKAGE.html $html $srcfile"
-echo "Generating monolithic html... ($cmd)"
-rm -rf $PACKAGE.html # in case a directory is left over
-eval $cmd
-sbcl --no-sysinit --no-userinit --load colorize-lisp-examples.lisp $PACKAGE.html
-#fix libc/libtool xrefs
-sed -e `monognuorg libc` -e `monognuorg libtool` $PACKAGE.html >$outdir/$PACKAGE.html
-rm $PACKAGE.html
-html_mono_size="`calcsize $outdir/$PACKAGE.html`"
-gzip -f -9 -c $outdir/$PACKAGE.html >$outdir/$PACKAGE.html.gz
-html_mono_gz_size="`calcsize $outdir/$PACKAGE.html.gz`"
-
-cmd="${MAKEINFO} --html -o $PACKAGE.html $html $srcfile"
-echo "Generating html by node... ($cmd)"
-eval $cmd
-split_html_dir=$PACKAGE.html
-sbcl --no-userinit --no-sysinit --load colorize-lisp-examples.lisp "${split_html_dir}"/\*.html
-(
- cd ${split_html_dir} || exit 1
- #fix libc xrefs
- for broken_file in *.html; do
- sed -e `polygnuorg libc` -e `polygnuorg libtool` "$broken_file" > "$broken_file".temp
- mv -f "$broken_file".temp "$broken_file"
- done
- tar -czf ../$outdir/${PACKAGE}.html_node.tar.gz -- *.html
-)
-html_node_tgz_size="`calcsize $outdir/${PACKAGE}.html_node.tar.gz`"
-rm -f $outdir/html_node/*.html
-mkdir -p $outdir/html_node/
-mv ${split_html_dir}/*.html $outdir/html_node/
-rmdir ${split_html_dir}
-
-echo Making .tar.gz for sources...
-srcfiles=`ls *.texinfo *.texi *.txi *.eps 2>/dev/null`
-tar cvzfh $outdir/$PACKAGE.texi.tar.gz $srcfiles
-texi_tgz_size="`calcsize $outdir/$PACKAGE.texi.tar.gz`"
-
-if test -n "$docbook"; then
- cmd="${MAKEINFO} -o - --docbook $srcfile > ${srcdir}/$PACKAGE-db.xml"
- echo "Generating docbook XML... $(cmd)"
- eval $cmd
- docbook_xml_size="`calcsize $PACKAGE-db.xml`"
- gzip -f -9 -c $PACKAGE-db.xml >$outdir/$PACKAGE-db.xml.gz
- docbook_xml_gz_size="`calcsize $outdir/$PACKAGE-db.xml.gz`"
- mv $PACKAGE-db.xml $outdir/
-
- cmd="${DOCBOOK2HTML} -o $split_html_db_dir ${outdir}/$PACKAGE-db.xml"
- echo "Generating docbook HTML... ($cmd)"
- eval $cmd
- split_html_db_dir=html_node_db
- (
- cd ${split_html_db_dir} || exit 1
- tar -czf ../$outdir/${PACKAGE}.html_node_db.tar.gz -- *.html
- )
- html_node_db_tgz_size="`calcsize $outdir/${PACKAGE}.html_node_db.tar.gz`"
- rm -f $outdir/html_node_db/*.html
- mkdir -p $outdir/html_node_db
- mv ${split_html_db_dir}/*.html $outdir/html_node_db/
- rmdir ${split_html_db_dir}
-
- cmd="${DOCBOOK2TXT} ${outdir}/$PACKAGE-db.xml"
- echo "Generating docbook ASCII... ($cmd)"
- eval $cmd
- docbook_ascii_size="`calcsize $PACKAGE-db.txt`"
- mv $PACKAGE-db.txt $outdir/
-
- cmd="${DOCBOOK2PS} ${outdir}/$PACKAGE-db.xml"
- echo "Generating docbook PS... $(cmd)"
- eval $cmd
- gzip -f -9 -c $PACKAGE-db.ps >$outdir/$PACKAGE-db.ps.gz
- docbook_ps_gz_size="`calcsize $outdir/$PACKAGE-db.ps.gz`"
- mv $PACKAGE-db.ps $outdir/
-
- cmd="${DOCBOOK2PDF} ${outdir}/$PACKAGE-db.xml"
- echo "Generating docbook PDF... ($cmd)"
- eval $cmd
- docbook_pdf_size="`calcsize $PACKAGE-db.pdf`"
- mv $PACKAGE-db.pdf $outdir/
-fi
-
-echo Writing index file...
-curdate="`date '+%B %d, %Y'`"
-sed \
- -e "s!%%TITLE%%!$MANUAL_TITLE!g" \
- -e "s!%%DATE%%!$curdate!g" \
- -e "s!%%PACKAGE%%!$PACKAGE!g" \
- -e "s!%%HTML_MONO_SIZE%%!$html_mono_size!g" \
- -e "s!%%HTML_MONO_GZ_SIZE%%!$html_mono_gz_size!g" \
- -e "s!%%HTML_NODE_TGZ_SIZE%%!$html_node_tgz_size!g" \
- -e "s!%%INFO_TGZ_SIZE%%!$info_tgz_size!g" \
- -e "s!%%DVI_GZ_SIZE%%!$dvi_gz_size!g" \
- -e "s!%%PDF_SIZE%%!$pdf_size!g" \
- -e "s!%%PS_GZ_SIZE%%!$ps_gz_size!g" \
- -e "s!%%ASCII_SIZE%%!$ascii_size!g" \
- -e "s!%%ASCII_GZ_SIZE%%!$ascii_gz_size!g" \
- -e "s!%%TEXI_TGZ_SIZE%%!$texi_tgz_size!g" \
- -e "s!%%DOCBOOK_HTML_NODE_TGZ_SIZE%%!$html_node_db_tgz_size!g" \
- -e "s!%%DOCBOOK_ASCII_SIZE%%!$docbook_ascii_size!g" \
- -e "s!%%DOCBOOK_PS_GZ_SIZE%%!$docbook_ps_gz_size!g" \
- -e "s!%%DOCBOOK_PDF_SIZE%%!$docbook_pdf_size!g" \
- -e "s!%%DOCBOOK_XML_SIZE%%!$docbook_xml_size!g" \
- -e "s!%%DOCBOOK_XML_GZ_SIZE%%!$docbook_xml_gz_size!g" \
- -e "s,%%SCRIPTURL%%,$scripturl,g" \
- -e "s!%%SCRIPTNAME%%!$prog!g" \
-$GENDOCS_TEMPLATE_DIR/gendocs_template >$outdir/index.html
-
-echo "Done! See $outdir/ subdirectory for new files."
(DIR) diff --git a/3rdparties/software/cffi_0.20.0/doc/gendocs_template b/3rdparties/software/cffi_0.20.0/doc/gendocs_template
@@ -1,259 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN"
- "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
-<!-- $Id: gendocs_template,v 1.7 2005/05/15 00:00:08 karl Exp $ -->
-<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en">
-
-<!--
-
- This template was adapted from Texinfo:
- http://savannah.gnu.org/cgi-bin/viewcvs/texinfo/texinfo/util/gendocs_template
-
--->
-
-
-<head>
-<title>%%TITLE%%</title>
-<meta http-equiv="content-type" content='text/html; charset=utf-8' />
-<!-- <link rel="stylesheet" type="text/css" href="/gnu.css" /> -->
-<!-- <link rev="made" href="webmasters@gnu.org" /> -->
-<style>
-/* CSS style taken from http://gnu.org/gnu.css */
-
-html, body {
- background-color: #FFFFFF;
- color: #000000;
- font-family: sans-serif;
-}
-
-a:link {
- color: #1f00ff;
- background-color: transparent;
- text-decoration: underline;
- }
-
-a:visited {
- color: #9900dd;
- background-color: transparent;
- text-decoration: underline;
- }
-
-a:hover {
- color: #9900dd;
- background-color: transparent;
- text-decoration: none;
- }
-
-.center {
- text-align: center;
-}
-
-.italic {
- font-style: italic;
- }
-
-.bold {
- font-weight: bold;
- }
-
-.quote {
- margin-left: 40px;
- margin-right: 40px;
-}
-
-.hrsmall {
- width: 80px;
- height: 1px;
- margin-left: 20px;
-}
-
-.td_title {
- border-color: #3366cc;
- border-style: solid;
- border-width: thin;
- color: #3366cc;
- background-color : #f2f2f9;
- font-weight: bold;
-}
-
-.td_con {
- padding-top: 3px;
- padding-left: 8px;
- padding-bottom: 3px;
- color : #303030;
- background-color : #fefefe;
- font-size: smaller;
-}
-
-.translations {
- background-color: transparent;
- color: black;
- font-family: serif;
- font-size: smaller;
-}
-
-.fsflink {
- font-size: smaller;
- font-family: monospace;
- color : #000000;
- border-left: #3366cc thin solid;
- border-bottom: #3366cc thin solid;
- padding-left: 5px;
- padding-bottom: 5px;
-}
-
-/*
- * rtl stands for right-to-left layout, as in farsi/persian,
- * arabic, etc. See also trans_rtl.
- */
-.fsflink_rtl {
- font-size: smaller;
- font-family: monospace;
- color : #000000;
- border-right: #3366cc thin solid;
- border-bottom: #3366cc thin solid;
- padding-right: 5px;
- padding-bottom: 5px;
-}
-
-.trans {
- font-size: smaller;
- color : #000000;
- border-left: #3366cc thin solid;
- padding-left: 20px;
-}
-
-.trans_rtl {
- font-size: smaller;
- color : #000000;
- border-right: #3366cc thin solid;
- padding-right: 20px;
-}
-
-img {
- border: none 0;
-}
-
-td.side {
- color: #3366cc;
-/* background: #f2f2f9;
- border-color: #3366cc;
- border-style: solid;
- border-width: thin; */
- border-color: white;
- border-style: none;
- vertical-align: top;
- width: 150px;
-}
-
-div.copyright {
- font-size: 80%;
- border: 2px solid #3366cc;
- padding: 4px;
- background: #f2f2f9;
- border-style: solid;
- border-width: thin;
-}
-
-.footnoteref {
- font-size: smaller;
- vertical-align: text-top;
-}
-</style>
-</head>
-
-<!-- This document is in XML, and xhtml 1.0 -->
-<!-- Please make sure to properly nest your tags -->
-<!-- and ensure that your final document validates -->
-<!-- consistent with W3C xhtml 1.0 and CSS standards -->
-<!-- See validator.w3.org -->
-
-<body>
-
-<h3>%%TITLE%%</h3>
-
-<!-- <address>Free Software Foundation</address> -->
-<address>last updated %%DATE%%</address>
-
-<!--
-<p>
-<a href="/graphics/gnu-head.jpg">
- <img src="/graphics/gnu-head-sm.jpg"
- alt=" [image of the head of a GNU] "
- width="129" height="122" />
-</a>
-<a href="/philosophy/gif.html">(no gifs due to patent problems)</a>
-</p>
--->
-
-<hr />
-
-<p>This document <!--(%%PACKAGE%%)--> is available in the following formats:</p>
-
-<ul>
- <li><a href="%%PACKAGE%%.html">HTML
- (%%HTML_MONO_SIZE%%K characters)</a> - entirely on one web page.</li>
- <li><a href="html_node/index.html">HTML</a> - with one web page per
- node.</li>
- <li><a href="%%PACKAGE%%.html.gz">HTML compressed
- (%%HTML_MONO_GZ_SIZE%%K gzipped characters)</a> - entirely on
- one web page.</li>
- <li><a href="%%PACKAGE%%.html_node.tar.gz">HTML compressed
- (%%HTML_NODE_TGZ_SIZE%%K gzipped tar file)</a> -
- with one web page per node.</li>
- <li><a href="%%PACKAGE%%.info.tar.gz">Info document
- (%%INFO_TGZ_SIZE%%K characters gzipped tar file)</a>.</li>
- <li><a href="%%PACKAGE%%.txt">ASCII text
- (%%ASCII_SIZE%%K characters)</a>.</li>
- <li><a href="%%PACKAGE%%.txt.gz">ASCII text compressed
- (%%ASCII_GZ_SIZE%%K gzipped characters)</a>.</li>
- <li><a href="%%PACKAGE%%.dvi.gz">TeX dvi file
- (%%DVI_GZ_SIZE%%K characters gzipped)</a>.</li>
- <li><a href="%%PACKAGE%%.ps.gz">PostScript file
- (%%PS_GZ_SIZE%%K characters gzipped)</a>.</li>
- <li><a href="%%PACKAGE%%.pdf">PDF file
- (%%PDF_SIZE%%K characters)</a>.</li>
- <li><a href="%%PACKAGE%%.texi.tar.gz">Texinfo source
- (%%TEXI_TGZ_SIZE%%K characters gzipped tar file)</a></li>
-</ul>
-
-<p>(This page was generated by the <a href="%%SCRIPTURL%%">%%SCRIPTNAME%%
-script</a>.)</p>
-
-<div class="copyright">
-<p>
-Return to <a href="/project/cffi/">CFFI's home page</a>.
-</p>
-
-<!--
-<p>
-Please send FSF & GNU inquiries to
-<a href="mailto:gnu@gnu.org"><em>gnu@gnu.org</em></a>.
-There are also <a href="/home.html#ContactInfo">other ways to contact</a>
-the FSF.
-<br />
-Please send broken links and other corrections (or suggestions) to
-<a href="mailto:webmasters@gnu.org"><em>webmasters@gnu.org</em></a>.
-</p>
--->
-
-<p>
-Copyright (C) 2005 James Bielman <jamesjb at jamesjb.com><br />
-Copyright (C) 2005 Luís Oliveira <loliveira at common-lisp.net>
-<!--
-<br />
-Verbatim copying and distribution of this entire article is
-permitted in any medium, provided this notice is preserved.
--->
-</p>
-
-<p>
-Updated: %%DATE%%
-<!-- timestamp start -->
-<!-- $Date: 2005/05/15 00:00:08 $ $Author: karl $ -->
-<!-- timestamp end -->
-</p>
-</div>
-
-</body>
-</html>
(DIR) diff --git a/3rdparties/software/cffi_0.20.0/doc/mem-vector.txt b/3rdparties/software/cffi_0.20.0/doc/mem-vector.txt
@@ -1,75 +0,0 @@
-
-# Block Memory Operations
-
-Function: mem-fill ptr type count value &optional (offset 0)
-
-Fill COUNT objects of TYPE, starting at PTR plus offset, with VALUE.
-
-;; Equivalent to (but possibly more efficient than):
-(loop for i below count
- for off from offset by (%foreign-type-size type)
- do (setf (%mem-ref ptr type off) value))
-
-Function: mem-read-vector vector ptr type count &optional (offset 0)
-
-Copy COUNT objects of TYPE from foreign memory at PTR plus OFFSET into
-VECTOR. If VECTOR is not large enough to contain COUNT objects, it
-will copy as many objects as necessary to fill the vector. The
-results are undefined if the foreign memory block is not large enough
-to supply the data to copy.
-
-TYPE must be a built-in foreign type (integer, float, double, or
-pointer).
-
-Returns the number of objects copied.
-
-;; Equivalent to (but possibly more efficient than):
-(loop for i below (min count (length vector))
- for off from offset by (%foreign-type-size type)
- do (setf (aref vector i) (%mem-ref ptr type off))
- finally (return i))
-
-
-Function: mem-read-c-string string ptr &optional (offset 0)
-
-Copy a null-terminated C string from PTR plus OFFSET into STRING, a
-Lisp string. If STRING is not large enough to contain the data at PTR
-it will be truncated.
-
-Returns the number of characters copied into STRING.
-
-;; Equivalent to (but possibly more efficient than):
-(loop for i below (length string)
- for off from offset
- for char = (%mem-ref ptr :char off)
- until (zerop char)
- do (setf (char string i) char)
- finally (return i))
-
-Function: mem-write-vector vector ptr type &optional
- (count (length vector)) (offset 0)
-
-Copy COUNT objects from VECTOR into objects of TYPE in foreign memory,
-starting at PTR plus OFFSET. The results are undefined if PTR does
-not point to a memory block large enough to hold the data copied.
-
-TYPE must be a built-in type (integer, float, double, or pointer).
-
-Returns the number of objects copied from VECTOR to PTR.
-
-;; Equivalent to (but possibly more efficient than):
-(loop for i below count
- for off from offset by (%foreign-type-size type)
- do (setf (%mem-ref ptr type off) (aref vector i))
- finally (return i))
-
-
-Function: mem-write-c-string string ptr &optional (offset 0)
-
-Copy the characters from a Lisp STRING to PTR plus OFFSET, adding a
-final null terminator at the end. The results are undefined if the
-memory at PTR is not large enough to accomodate the data.
-
-This interface is currently equivalent to MEM-WRITE-VECTOR with a TYPE
-of :CHAR, but will be useful when proper support for Unicode strings
-is implemented.
(DIR) diff --git a/3rdparties/software/cffi_0.20.0/doc/shareable-vectors.txt b/3rdparties/software/cffi_0.20.0/doc/shareable-vectors.txt
@@ -1,44 +0,0 @@
-
-# Shareable Byte Vectors
-
-Function: make-shareable-byte-vector size
-
-Create a vector of element type (UNSIGNED-BYTE 8) suitable for passing
-to WITH-POINTER-TO-VECTOR-DATA.
-
-;; Minimal implementation:
-(defun make-shareable-byte-vector (size)
- (make-array size :element-type '(unsigned-byte 8)))
-
-
-Macro: with-pointer-to-vector-data (ptr-var vector) &body body
-
-Bind PTR-VAR to a pointer to the data contained in a shareable byte
-vector.
-
-VECTOR must be a shareable vector created by MAKE-SHAREABLE-BYTE-VECTOR.
-
-PTR-VAR may point directly into the Lisp vector data, or it may point
-to a temporary block of foreign memory which will be copied to and
-from VECTOR.
-
-Both the pointer object in PTR-VAR and the memory it points to have
-dynamic extent. The results are undefined if foreign code attempts to
-access this memory outside this dynamic contour.
-
-The implementation must guarantee the memory pointed to by PTR-VAR
-will not be moved during the dynamic contour of this operator, either
-by creating the vector in a static area or temporarily disabling the
-garbage collector.
-
-;; Minimal (copying) implementation:
-(defmacro with-pointer-to-vector-data ((ptr-var vector) &body body)
- (let ((vector-var (gensym))
- (size-var (gensym)))
- `(let* ((,vector-var ,vector)
- (,size-var (length ,vector-var)))
- (with-foreign-ptr (,ptr-var ,size-var)
- (mem-write-vector ,vector-var ,ptr :uint8)
- (prog1
- (progn ,@body)
- (mem-read-vector ,vector-var ,ptr-var :uint8 ,size-var))))))
(DIR) diff --git a/3rdparties/software/cffi_0.20.0/doc/style.css b/3rdparties/software/cffi_0.20.0/doc/style.css
@@ -1,48 +0,0 @@
-body {font-family: Georgia, serif;
- line-height: 1.3;
- padding-left: 5em; padding-right: 1em;
- padding-bottom: 1em; max-width: 60em;}
-table {border-collapse: collapse}
-span.roman { font-family: century schoolbook, serif; font-weight: normal; }
-h1, h2, h3, h4, h5, h6 {font-family: Helvetica, sans-serif}
-h4 { margin-top: 2.5em; }
-dfn {font-family: inherit; font-variant: italic; font-weight: bolder }
-kbd {font-family: monospace; text-decoration: underline}
-/*var {font-family: Helvetica, sans-serif; font-variant: slanted}*/
-var {font-variant: slanted;}
-td {padding-right: 1em; padding-left: 1em}
-sub {font-size: smaller}
-.node {padding: 0; margin: 0}
-
-pre.lisp { font-family: monospace;
- background-color: #F4F4F4; border: 1px solid #AAA;
- padding-top: 0.5em; padding-bottom: 0.5em; }
-
-/* coloring */
-
-.lisp-bg { background-color: #F4F4F4 ; color: black; }
-.lisp-bg:hover { background-color: #F4F4F4 ; color: black; }
-
-.symbol { font-weight: bold; color: #770055; background-color : transparent; border: 0px; margin: 0px;}
-a.symbol:link { font-weight: bold; color : #229955; background-color : transparent; text-decoration: none; border: 0px; margin: 0px; }
-a.symbol:active { font-weight: bold; color : #229955; background-color : transparent; text-decoration: none; border: 0px; margin: 0px; }
-a.symbol:visited { font-weight: bold; color : #229955; background-color : transparent; text-decoration: none; border: 0px; margin: 0px; }
-a.symbol:hover { font-weight: bold; color : #229955; background-color : transparent; text-decoration: none; border: 0px; margin: 0px; }
-.special { font-weight: bold; color: #FF5000; background-color: inherit; }
-.keyword { font-weight: bold; color: #770000; background-color: inherit; }
-.comment { font-weight: normal; color: #007777; background-color: inherit; }
-.string { font-weight: bold; color: #777777; background-color: inherit; }
-.character { font-weight: bold; color: #0055AA; background-color: inherit; }
-.syntaxerror { font-weight: bold; color: #FF0000; background-color: inherit; }
-span.paren1 { font-weight: bold; color: #777777; }
-span.paren1:hover { color: #777777; background-color: #BAFFFF; }
-span.paren2 { color: #777777; }
-span.paren2:hover { color: #777777; background-color: #FFCACA; }
-span.paren3 { color: #777777; }
-span.paren3:hover { color: #777777; background-color: #FFFFBA; }
-span.paren4 { color: #777777; }
-span.paren4:hover { color: #777777; background-color: #CACAFF; }
-span.paren5 { color: #777777; }
-span.paren5:hover { color: #777777; background-color: #CAFFCA; }
-span.paren6 { color: #777777; }
-span.paren6:hover { color: #777777; background-color: #FFBAFF; }
(DIR) diff --git a/3rdparties/software/cffi_0.20.0/examples/examples.lisp b/3rdparties/software/cffi_0.20.0/examples/examples.lisp
@@ -1,78 +0,0 @@
-;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
-;;;
-;;; examples.lisp --- Simple test examples of CFFI.
-;;;
-;;; Copyright (C) 2005-2006, James Bielman <jamesjb@jamesjb.com>
-;;;
-;;; Permission is hereby granted, free of charge, to any person
-;;; obtaining a copy of this software and associated documentation
-;;; files (the "Software"), to deal in the Software without
-;;; restriction, including without limitation the rights to use, copy,
-;;; modify, merge, publish, distribute, sublicense, and/or sell copies
-;;; of the Software, and to permit persons to whom the Software is
-;;; furnished to do so, subject to the following conditions:
-;;;
-;;; The above copyright notice and this permission notice shall be
-;;; included in all copies or substantial portions of the Software.
-;;;
-;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
-;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
-;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
-;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
-;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
-;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
-;;; DEALINGS IN THE SOFTWARE.
-;;;
-
-(defpackage #:cffi-examples
- (:use #:cl #:cffi)
- (:export
- #:run-examples
- #:sqrtf
- #:getenv))
-
-(in-package #:cffi-examples)
-
-;; A simple libc function.
-(defcfun "sqrtf" :float
- (n :float))
-
-;; This definition uses the STRING type translator to automatically
-;; convert Lisp strings to foreign strings and vice versa.
-(defcfun "getenv" :string
- (name :string))
-
-;; Calling a varargs function.
-(defun sprintf-test ()
- "Test calling a varargs function."
- (with-foreign-pointer-as-string ((buf buf-size) 255)
- (foreign-funcall
- "snprintf" :pointer buf :int buf-size
- :string "%d %f #x%x!" :int 666
- :double (coerce pi 'double-float)
- :unsigned-int #xcafebabe
- :void)))
-
-;; Defining an emerated type.
-(defcenum test-enum
- (:invalid 0)
- (:positive 1)
- (:negative -1))
-
-;; Use the absolute value function to test keyword/enum translation.
-(defcfun ("abs" c-abs) test-enum
- (n test-enum))
-
-(defun cffi-version ()
- (asdf:component-version (asdf:find-system 'cffi)))
-
-(defun run-examples ()
- (format t "~&;;; CFFI version ~A on ~A ~A:~%"
- (cffi-version) (lisp-implementation-type)
- (lisp-implementation-version))
- (format t "~&;; shell: ~A~%" (getenv "SHELL"))
- (format t "~&;; sprintf test: ~A~%" (sprintf-test))
- (format t "~&;; (c-abs :positive): ~A~%" (c-abs :positive))
- (format t "~&;; (c-abs :negative): ~A~%" (c-abs :negative))
- (force-output))
(DIR) diff --git a/3rdparties/software/cffi_0.20.0/examples/gethostname.lisp b/3rdparties/software/cffi_0.20.0/examples/gethostname.lisp
@@ -1,51 +0,0 @@
-;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
-;;;
-;;; gethostname.lisp --- A simple CFFI example.
-;;;
-;;; Copyright (C) 2005-2006, James Bielman <jamesjb@jamesjb.com>
-;;;
-;;; Permission is hereby granted, free of charge, to any person
-;;; obtaining a copy of this software and associated documentation
-;;; files (the "Software"), to deal in the Software without
-;;; restriction, including without limitation the rights to use, copy,
-;;; modify, merge, publish, distribute, sublicense, and/or sell copies
-;;; of the Software, and to permit persons to whom the Software is
-;;; furnished to do so, subject to the following conditions:
-;;;
-;;; The above copyright notice and this permission notice shall be
-;;; included in all copies or substantial portions of the Software.
-;;;
-;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
-;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
-;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
-;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
-;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
-;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
-;;; DEALINGS IN THE SOFTWARE.
-;;;
-
-;;;# CFFI Example: gethostname binding
-;;;
-;;; This is a very simple CFFI example that illustrates calling a C
-;;; function that fills in a user-supplied string buffer.
-
-(defpackage #:cffi-example-gethostname
- (:use #:common-lisp #:cffi)
- (:export #:gethostname))
-
-(in-package #:cffi-example-gethostname)
-
-;;; Define the Lisp function %GETHOSTNAME to call the C 'gethostname'
-;;; function, which will fill BUF with up to BUFSIZE characters of the
-;;; system's hostname.
-(defcfun ("gethostname" %gethostname) :int
- (buf :pointer)
- (bufsize :int))
-
-;;; Define a Lispy interface to 'gethostname'. The utility macro
-;;; WITH-FOREIGN-POINTER-AS-STRING is used to allocate a temporary
-;;; buffer and return it as a Lisp string.
-(defun gethostname ()
- (with-foreign-pointer-as-string ((buf bufsize) 255)
- (%gethostname buf bufsize)))
(DIR) diff --git a/3rdparties/software/cffi_0.20.0/examples/gettimeofday.lisp b/3rdparties/software/cffi_0.20.0/examples/gettimeofday.lisp
@@ -1,93 +0,0 @@
-;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
-;;;
-;;; gettimeofday.lisp --- Example CFFI binding to gettimeofday(2)
-;;;
-;;; Copyright (C) 2005-2006, James Bielman <jamesjb@jamesjb.com>
-;;;
-;;; Permission is hereby granted, free of charge, to any person
-;;; obtaining a copy of this software and associated documentation
-;;; files (the "Software"), to deal in the Software without
-;;; restriction, including without limitation the rights to use, copy,
-;;; modify, merge, publish, distribute, sublicense, and/or sell copies
-;;; of the Software, and to permit persons to whom the Software is
-;;; furnished to do so, subject to the following conditions:
-;;;
-;;; The above copyright notice and this permission notice shall be
-;;; included in all copies or substantial portions of the Software.
-;;;
-;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
-;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
-;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
-;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
-;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
-;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
-;;; DEALINGS IN THE SOFTWARE.
-;;;
-
-;;;# CFFI Example: gettimeofday binding
-;;;
-;;; This example illustrates the use of foreign structures, typedefs,
-;;; and using type translators to do checking of input and output
-;;; arguments to a foreign function.
-
-(defpackage #:cffi-example-gettimeofday
- (:use #:common-lisp #:cffi)
- (:export #:gettimeofday))
-
-(in-package #:cffi-example-gettimeofday)
-
-;;; Define the TIMEVAL structure used by 'gettimeofday'. This assumes
-;;; that 'time_t' is a 'long' --- it would be nice if CFFI could
-;;; provide a proper :TIME-T type to help make this portable.
-(defcstruct timeval
- (tv-sec :long)
- (tv-usec :long))
-
-;;; A NULL-POINTER is a foreign :POINTER that must always be NULL.
-;;; Both a NULL pointer and NIL are legal values---any others will
-;;; result in a runtime error.
-(define-foreign-type null-pointer-type ()
- ()
- (:actual-type :pointer)
- (:simple-parser null-pointer))
-
-;;; This type translator is used to ensure that a NULL-POINTER has a
-;;; null value. It also converts NIL to a null pointer.
-(defmethod translate-to-foreign (value (type null-pointer-type))
- (cond
- ((null value) (null-pointer))
- ((null-pointer-p value) value)
- (t (error "~A is not a null pointer." value))))
-
-;;; The SYSCALL-RESULT type is an integer type used for the return
-;;; value of C functions that return -1 and set errno on errors.
-;;; Someday when CFFI has a portable interface for dealing with
-;;; 'errno', this error reporting can be more useful.
-(define-foreign-type syscall-result-type ()
- ()
- (:actual-type :int)
- (:simple-parser syscall-result))
-
-;;; Type translator to check a SYSCALL-RESULT and signal a Lisp error
-;;; if the value is negative.
-(defmethod translate-from-foreign (value (type syscall-result-type))
- (if (minusp value)
- (error "System call failed with return value ~D." value)
- value))
-
-;;; Define the Lisp function %GETTIMEOFDAY to call the C function
-;;; 'gettimeofday', passing a pointer to the TIMEVAL structure to fill
-;;; in. The TZP parameter is deprecated and should be NULL --- we can
-;;; enforce this by using our NULL-POINTER type defined above.
-(defcfun ("gettimeofday" %gettimeofday) syscall-result
- (tp :pointer)
- (tzp null-pointer))
-
-;;; Define a Lispy interface to 'gettimeofday' that returns the
-;;; seconds and microseconds as multiple values.
-(defun gettimeofday ()
- (with-foreign-object (tv 'timeval)
- (%gettimeofday tv nil)
- (with-foreign-slots ((tv-sec tv-usec) tv timeval)
- (values tv-sec tv-usec))))
(DIR) diff --git a/3rdparties/software/cffi_0.20.0/examples/grovel-example.lisp b/3rdparties/software/cffi_0.20.0/examples/grovel-example.lisp
@@ -1,20 +0,0 @@
-(in-package #:cffi-example)
-
-(define "a0(x)" "+x+x")
-(define "a1(x)" "a0(+x+x)")
-(define "a2(x)" "a1(+x+x)")
-(define "a3(x)" "a2(+x+x)")
-(define "a4(x)" "a3(+x+x)")
-(define "a5(x)" "a4(+x+x)")
-
-(define "A0" "a0(1)")
-(define "A1" "a1(1)")
-(define "A2" "a2(1)")
-(define "A3" "a3(1)")
-(define "A4" "a4(1)")
-
-(constant (+a0+ "A0"))
-(constant (+a1+ "A1"))
-(constant (+a2+ "A2"))
-(constant (+a3+ "A3"))
-(constant (+a4+ "A4"))
(DIR) diff --git a/3rdparties/software/cffi_0.20.0/examples/main-example.lisp b/3rdparties/software/cffi_0.20.0/examples/main-example.lisp
@@ -1,17 +0,0 @@
-(in-package #:cffi-example)
-
-(defcfun "puts" :int
- "Put a string to standard output, return non-negative length output, or EOF"
- (string :string))
-
-(defun check-groveller ()
- (assert (equal (list +a0+ +a1+ +a2+ +a3+ +a4+) '(2 4 8 16 32)))
- (assert (equal (bn 1) 32)))
-
-(defun entry-point ()
- (when uiop:*command-line-arguments*
- (uiop:format! t "Arguments: ~A~%" (uiop:escape-command uiop:*command-line-arguments*)))
- (puts "hello, world!")
- (check-groveller)
- (uiop:finish-outputs)
- (uiop:quit 0))
(DIR) diff --git a/3rdparties/software/cffi_0.20.0/examples/mapping.lisp b/3rdparties/software/cffi_0.20.0/examples/mapping.lisp
@@ -1,76 +0,0 @@
-;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
-;;;
-;;; mapping.lisp --- An example for mapping Lisp objects to ints.
-;;;
-;;; Copyright (C) 2007, Luis Oliveira <loliveira@common-lisp.net>
-;;;
-;;; Permission is hereby granted, free of charge, to any person
-;;; obtaining a copy of this software and associated documentation
-;;; files (the "Software"), to deal in the Software without
-;;; restriction, including without limitation the rights to use, copy,
-;;; modify, merge, publish, distribute, sublicense, and/or sell copies
-;;; of the Software, and to permit persons to whom the Software is
-;;; furnished to do so, subject to the following conditions:
-;;;
-;;; The above copyright notice and this permission notice shall be
-;;; included in all copies or substantial portions of the Software.
-;;;
-;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
-;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
-;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
-;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
-;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
-;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
-;;; DEALINGS IN THE SOFTWARE.
-;;;
-
-;;; This is an example on how to tackle the problem of passing Lisp
-;;; object identifiers to foreign code. It is not a great example,
-;;; but might be useful nevertheless.
-;;;
-;;; Requires trivial-garbage: <http://cliki.net/trivial-garbage>
-
-(defpackage #:cffi-mapping-test
- (:use #:common-lisp #:cffi #:trivial-garbage)
- (:export #:run))
-
-(in-package #:cffi-mapping-test)
-
-(define-foreign-type lisp-object-type ()
- ((weakp :initarg :weakp))
- (:actual-type :unsigned-int))
-
-(define-parse-method lisp-object (&key weak-mapping)
- (make-instance 'lisp-object-type :weakp weak-mapping))
-
-(defvar *regular-hashtable* (make-hash-table))
-(defvar *weak-hashtable* (make-weak-hash-table :weakness :value))
-(defvar *regular-counter* 0)
-(defvar *weak-counter* 0)
-
-(defun increment-counter (value)
- (mod (1+ value) (expt 2 (* 8 (foreign-type-size :unsigned-int)))))
-
-(define-modify-macro incf-counter () increment-counter)
-
-(defmethod translate-to-foreign (value (type lisp-object-type))
- (with-slots (weakp) type
- (let ((id (if weakp
- (incf-counter *weak-counter*)
- (incf-counter *regular-counter*)))
- (ht (if weakp *weak-hashtable* *regular-hashtable*)))
- (setf (gethash id ht) value)
- id)))
-
-(defmethod translate-from-foreign (int (type lisp-object-type))
- (with-slots (weakp) type
- (gethash int (if weakp *weak-hashtable* *regular-hashtable*))))
-
-;;;; Silly example.
-
-(defctype weak-mapping (lisp-object :weak-mapping t))
-
-;;; (run) => #<FUNCTION (LAMBDA (X)) {11AB46F5}>
-(defun run ()
- (foreign-funcall "abs" weak-mapping (lambda (x) x) weak-mapping))
(DIR) diff --git a/3rdparties/software/cffi_0.20.0/examples/package.lisp b/3rdparties/software/cffi_0.20.0/examples/package.lisp
@@ -1,30 +0,0 @@
-;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
-;;;
-;;; package.lisp --- CFFI-EXAMPLES package definition.
-;;;
-;;; Copyright (C) 2005-2006, James Bielman <jamesjb@jamesjb.com>
-;;;
-;;; Permission is hereby granted, free of charge, to any person
-;;; obtaining a copy of this software and associated documentation
-;;; files (the "Software"), to deal in the Software without
-;;; restriction, including without limitation the rights to use, copy,
-;;; modify, merge, publish, distribute, sublicense, and/or sell copies
-;;; of the Software, and to permit persons to whom the Software is
-;;; furnished to do so, subject to the following conditions:
-;;;
-;;; The above copyright notice and this permission notice shall be
-;;; included in all copies or substantial portions of the Software.
-;;;
-;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
-;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
-;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
-;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
-;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
-;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
-;;; DEALINGS IN THE SOFTWARE.
-;;;
-
-(defpackage #:cffi-example
- (:use #:cl #:cffi #:cffi-sys)
- (:export #:check-groveller #:entry-point))
(DIR) diff --git a/3rdparties/software/cffi_0.20.0/examples/run-examples.lisp b/3rdparties/software/cffi_0.20.0/examples/run-examples.lisp
@@ -1,39 +0,0 @@
-;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
-;;;
-;;; run-examples.lisp --- Simple script to run the examples.
-;;;
-;;; Copyright (C) 2005-2006, James Bielman <jamesjb@jamesjb.com>
-;;;
-;;; Permission is hereby granted, free of charge, to any person
-;;; obtaining a copy of this software and associated documentation
-;;; files (the "Software"), to deal in the Software without
-;;; restriction, including without limitation the rights to use, copy,
-;;; modify, merge, publish, distribute, sublicense, and/or sell copies
-;;; of the Software, and to permit persons to whom the Software is
-;;; furnished to do so, subject to the following conditions:
-;;;
-;;; The above copyright notice and this permission notice shall be
-;;; included in all copies or substantial portions of the Software.
-;;;
-;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
-;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
-;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
-;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
-;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
-;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
-;;; DEALINGS IN THE SOFTWARE.
-;;;
-
-(setf *load-verbose* nil *compile-verbose* nil)
-
-#-asdf
-(ignore-errors (require "asdf"))
-#-asdf
-(load "~/common-lisp/asdf/build/asdf.lisp")
-
-(asdf:load-system 'cffi-examples :verbose nil)
-(cffi-examples:run-examples)
-(force-output)
-
-(quit)
(DIR) diff --git a/3rdparties/software/cffi_0.20.0/examples/translator-test.lisp b/3rdparties/software/cffi_0.20.0/examples/translator-test.lisp
@@ -1,88 +0,0 @@
-;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
-;;;
-;;; translator-test.lisp --- Testing type translators.
-;;;
-;;; Copyright (C) 2005-2006, James Bielman <jamesjb@jamesjb.com>
-;;;
-;;; Permission is hereby granted, free of charge, to any person
-;;; obtaining a copy of this software and associated documentation
-;;; files (the "Software"), to deal in the Software without
-;;; restriction, including without limitation the rights to use, copy,
-;;; modify, merge, publish, distribute, sublicense, and/or sell copies
-;;; of the Software, and to permit persons to whom the Software is
-;;; furnished to do so, subject to the following conditions:
-;;;
-;;; The above copyright notice and this permission notice shall be
-;;; included in all copies or substantial portions of the Software.
-;;;
-;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
-;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
-;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
-;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
-;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
-;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
-;;; DEALINGS IN THE SOFTWARE.
-;;;
-
-(defpackage #:cffi-translator-test
- (:use #:common-lisp #:cffi))
-
-(in-package #:cffi-translator-test)
-
-;;;# Verbose Pointer Translator
-;;;
-;;; This is a silly type translator that doesn't actually do any
-;;; translating, but it prints out a debug message when the pointer is
-;;; converted to/from its foreign representation.
-
-(define-foreign-type verbose-pointer-type ()
- ()
- (:actual-type :pointer))
-
-(defmethod translate-to-foreign (value (type verbose-pointer-type))
- (format *debug-io* "~&;; to foreign: VERBOSE-POINTER: ~S~%" value)
- value)
-
-(defmethod translate-from-foreign (value (type verbose-pointer-type))
- (format *debug-io* "~&;; from foreign: VERBOSE-POINTER: ~S~%" value)
- value)
-
-;;;# Verbose String Translator
-;;;
-;;; A VERBOSE-STRING extends VERBOSE-POINTER and converts Lisp strings
-;;; C strings. If things are working properly, both type translators
-;;; should be called when converting a Lisp string to/from a C string.
-;;;
-;;; The translators should be called most-specific-first when
-;;; translating to C, and most-specific-last when translating from C.
-
-(define-foreign-type verbose-string-type (verbose-pointer-type)
- ()
- (:simple-parser verbose-string))
-
-(defmethod translate-to-foreign ((s string) (type verbose-string-type))
- (let ((value (foreign-string-alloc s)))
- (format *debug-io* "~&;; to foreign: VERBOSE-STRING: ~S -> ~S~%" s value)
- (values (call-next-method value type) t)))
-
-(defmethod translate-to-foreign (value (type verbose-string-type))
- (if (pointerp value)
- (progn
- (format *debug-io* "~&;; to foreign: VERBOSE-STRING: ~S -> ~:*~S~%" value)
- (values (call-next-method) nil))
- (error "Cannot convert ~S to a foreign string: it is not a Lisp ~
- string or pointer." value)))
-
-(defmethod translate-from-foreign (ptr (type verbose-string-type))
- (let ((value (foreign-string-to-lisp (call-next-method))))
- (format *debug-io* "~&;; from foreign: VERBOSE-STRING: ~S -> ~S~%" ptr value)
- value))
-
-(defmethod free-translated-object (ptr (type verbose-string-type) free-p)
- (when free-p
- (format *debug-io* "~&;; freeing VERBOSE-STRING: ~S~%" ptr)
- (foreign-string-free ptr)))
-
-(defun test-verbose-string ()
- (foreign-funcall "getenv" verbose-string "SHELL" verbose-string))
(DIR) diff --git a/3rdparties/software/cffi_0.20.0/examples/wrapper-example.lisp b/3rdparties/software/cffi_0.20.0/examples/wrapper-example.lisp
@@ -1,20 +0,0 @@
-(in-package #:cffi-example)
-
-(defwrapper* "b0" :long ((x :long)) "return x;")
-(defwrapper* "b1" :long ((x :long)) "return x;")
-(defwrapper* "b2" :long ((x :long)) "return x;")
-(defwrapper* "b3" :long ((x :long)) "return x;")
-(defwrapper* "b4" :long ((x :long)) "return x;")
-
-(define "b0_cffi_wrap(x)"
- "b0_cffi_wrap(b1_cffi_wrap(b2_cffi_wrap(b3_cffi_wrap(b4_cffi_wrap(+x+x)))))")
-(define "b1_cffi_wrap(x)"
- "b0_cffi_wrap(b1_cffi_wrap(b2_cffi_wrap(b3_cffi_wrap(b4_cffi_wrap(+x+x)))))")
-(define "b2_cffi_wrap(x)"
- "b0_cffi_wrap(b1_cffi_wrap(b2_cffi_wrap(b3_cffi_wrap(b4_cffi_wrap(+x+x)))))")
-;;(define "b3_cffi_wrap(x)"
-;; "b0_cffi_wrap(b1_cffi_wrap(b2_cffi_wrap(b3_cffi_wrap(b4_cffi_wrap(+x+x)))))")
-;;(define "b4_cffi_wrap(x)"
-;; "b0_cffi_wrap(b1_cffi_wrap(b2_cffi_wrap(b3_cffi_wrap(b4_cffi_wrap(+x+x)))))")
-
-(defwrapper* "bn" :long ((x :long)) "return b0_cffi_wrap(x);")
(DIR) diff --git a/3rdparties/software/cffi_0.20.0/grovel/asdf.lisp b/3rdparties/software/cffi_0.20.0/grovel/asdf.lisp
@@ -1,152 +0,0 @@
-;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
-;;;
-;;; asdf.lisp --- ASDF components for cffi-grovel.
-;;;
-;;; Copyright (C) 2005-2006, Dan Knap <dankna@accela.net>
-;;; Copyright (C) 2005-2006, Emily Backes <lucca@accela.net>
-;;; Copyright (C) 2007, Stelian Ionescu <sionescu@cddr.org>
-;;; Copyright (C) 2007, Luis Oliveira <loliveira@common-lisp.net>
-;;;
-;;; Permission is hereby granted, free of charge, to any person
-;;; obtaining a copy of this software and associated documentation
-;;; files (the "Software"), to deal in the Software without
-;;; restriction, including without limitation the rights to use, copy,
-;;; modify, merge, publish, distribute, sublicense, and/or sell copies
-;;; of the Software, and to permit persons to whom the Software is
-;;; furnished to do so, subject to the following conditions:
-;;;
-;;; The above copyright notice and this permission notice shall be
-;;; included in all copies or substantial portions of the Software.
-;;;
-;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
-;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
-;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
-;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
-;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
-;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
-;;; DEALINGS IN THE SOFTWARE.
-;;;
-
-(in-package #:cffi-grovel)
-
-(defclass cc-flags-mixin ()
- ((cc-flags :initform nil :accessor cc-flags-of :initarg :cc-flags)))
-
-(defclass process-op (downward-operation)
- ()
- (:documentation "This ASDF operation performs the steps necessary
- to generate a compilable and loadable lisp file from a
- PROCESS-OP-INPUT component."))
-
-(defclass process-op-input (cl-source-file)
- ((generated-lisp-file-type
- :initarg :generated-lisp-file-type
- :accessor generated-lisp-file-type
- :documentation "The :TYPE argument to use for the generated lisp file."))
- (:default-initargs
- :generated-lisp-file-type "generated-lisp-file")
- (:documentation "This ASDF component represents a file that is
- used as input to a function that generates lisp source file. This
- component acts as if it is a CL-SOURCE-FILE by applying the
- COMPILE-OP and LOAD-SOURCE-OP operations to the file generated by
- PROCESS-OP."))
-
-(defmethod perform :around ((op process-op) (file cc-flags-mixin))
- (let ((*cc-flags* (append (ensure-list (cc-flags-of file))
- *cc-flags*)))
- (call-next-method)))
-
-(defmethod input-files ((op process-op) (c process-op-input))
- (list (component-pathname c)))
-
-(defmethod input-files ((op compile-op) (c process-op-input))
- (list (first (output-files 'process-op c))))
-
-(defmethod component-depends-on ((op process-op) (c process-op-input))
- `((prepare-op ,c) ,@(call-next-method)))
-
-(defmethod component-depends-on ((op compile-op) (c process-op-input))
- `((process-op ,c) ,@(call-next-method)))
-
-(defmethod component-depends-on ((op load-source-op) (c process-op-input))
- `((process-op ,c) ,@(call-next-method)))
-
-;;;# ASDF component: GROVEL-FILE
-
-(defclass grovel-file (process-op-input cc-flags-mixin)
- ()
- (:default-initargs
- :generated-lisp-file-type "processed-grovel-file")
- (:documentation
- "This ASDF component represents an input file that is processed
- by PROCESS-GROVEL-FILE."))
-
-(defmethod output-files ((op process-op) (c grovel-file))
- (let* ((input-file (first (input-files op c)))
- (output-file (make-pathname :type (generated-lisp-file-type c)
- :defaults input-file))
- (c-file (make-c-file-name output-file "__grovel")))
- (list output-file
- c-file
- (make-exe-file-name c-file))))
-
-(defmethod perform ((op process-op) (c grovel-file))
- (let* ((output-file (first (output-files op c)))
- (input-file (first (input-files op c)))
- (tmp-file (process-grovel-file input-file output-file)))
- (rename-file-overwriting-target tmp-file output-file)))
-
-
-;;;# ASDF component: WRAPPER-FILE
-
-(defclass wrapper-file (process-op-input cc-flags-mixin)
- ((soname :initform nil :initarg :soname :accessor soname-of))
- (:default-initargs
- :generated-lisp-file-type "processed-wrapper-file")
- (:documentation
- "This ASDF component represents an input file that is processed
- by PROCESS-WRAPPER-FILE. This generates a foreign library and
- matching CFFI bindings that are subsequently compiled and
- loaded."))
-
-(defun wrapper-soname (c)
- (or (soname-of c)
- (component-name c)))
-
-(defmethod output-files ((op process-op) (c wrapper-file))
- (let* ((input-file (first (input-files op c)))
- (output-file (make-pathname :type (generated-lisp-file-type c)
- :defaults input-file))
- (c-file (make-c-file-name output-file "__wrapper"))
- (o-file (make-o-file-name output-file "__wrapper"))
- (lib-soname (wrapper-soname c)))
- (list output-file
- (make-so-file-name (make-soname lib-soname output-file))
- c-file
- o-file)))
-
-;;; Declare the .o and .so files as compilation outputs,
-;;; so they get picked up by bundle operations.
-#.(when (version<= "3.1.6" (asdf-version))
- '(defmethod output-files ((op compile-op) (c wrapper-file))
- (destructuring-bind (generated-lisp lib-file c-file o-file) (output-files 'process-op c)
- (declare (ignore generated-lisp c-file))
- (multiple-value-bind (files translatedp) (call-next-method)
- (values (append files (list lib-file o-file)) translatedp)))))
-
-(defmethod perform ((op process-op) (c wrapper-file))
- (let* ((output-file (first (output-files op c)))
- (input-file (first (input-files op c)))
- (tmp-file (process-wrapper-file
- input-file
- :output-defaults output-file
- :lib-soname (wrapper-soname c))))
- (unwind-protect
- (alexandria:copy-file tmp-file output-file :if-to-exists :supersede)
- (delete-file tmp-file))))
-
-;; Allow for naked :cffi-grovel-file and :cffi-wrapper-file in asdf definitions.
-(setf (find-class 'asdf::cffi-grovel-file) (find-class 'grovel-file))
-(setf (find-class 'asdf::cffi-wrapper-file) (find-class 'wrapper-file))
-
(DIR) diff --git a/3rdparties/software/cffi_0.20.0/grovel/common.h b/3rdparties/software/cffi_0.20.0/grovel/common.h
@@ -1,57 +0,0 @@
-#include <stdio.h>
-#include <stdlib.h>
-#include <stdint.h>
-#include <string.h>
-#include <inttypes.h>
-
-#ifndef offsetof
-#define offsetof(type, slot) ((long) ((char *) &(((type *) 0)->slot)))
-#endif
-#define getslot(type, slot) (((type *) 0)->slot)
-#define sizeofslot(type, slot) (sizeof(getslot(type, slot)))
-#define countofslot(type, slot) \
- (sizeof(getslot(type, slot)) / sizeof(getslot(type, slot)[0]))
-#define stringify(x) #x
-#define indirect_stringify(x) stringify(x)
-
-#define TYPE_SIGNED_P(type) (((type)-1)<0LL)
-#define _64_BIT_VALUE_FITS_SIGNED_P(value) ( (value) <= 0x7FFFFFFFFFFFFFFFLL )
-#define SLOT_SIGNED_P(result, type, slot) \
- do { \
- type slot_signed_p_struct; \
- slot_signed_p_struct.slot = -1; \
- (result) = slot_signed_p_struct.slot < 0; \
- } while (0)
-
-void type_name(FILE *output, int signed_p, int size) {
- if (signed_p) {
- switch (size) {
- case 1: fprintf(output, ":int8"); break;
- case 2: fprintf(output, ":int16"); break;
- case 4: fprintf(output, ":int32"); break;
- case 8: fprintf(output, ":int64"); break;
- default: goto error;
- }
- } else {
- switch(size) {
- case 1: fprintf(output, ":uint8"); break;
- case 2: fprintf(output, ":uint16"); break;
- case 4: fprintf(output, ":uint32"); break;
- case 8: fprintf(output, ":uint64"); break;
- default: goto error;
- }
- }
-
- return;
-
-error:
- fprintf(output, "(cl:error \"No type of size ~D.\" %i)\n", size);
-}
-
-char* print_double_for_lisp(double n)
-{
- static char buf[256];
- memset(buf, 0, 256);
- snprintf(buf, 255, "(let ((*read-default-float-format* 'double-float)) (coerce (read-from-string \"%.20E\") 'double-float))", n);
- return buf;
-}
(DIR) diff --git a/3rdparties/software/cffi_0.20.0/grovel/grovel.lisp b/3rdparties/software/cffi_0.20.0/grovel/grovel.lisp
@@ -1,913 +0,0 @@
-;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
-;;;
-;;; grovel.lisp --- The CFFI Groveller.
-;;;
-;;; Copyright (C) 2005-2006, Dan Knap <dankna@accela.net>
-;;; Copyright (C) 2005-2006, Emily Backes <lucca@accela.net>
-;;; Copyright (C) 2007, Stelian Ionescu <sionescu@cddr.org>
-;;; Copyright (C) 2007, Luis Oliveira <loliveira@common-lisp.net>
-;;;
-;;; Permission is hereby granted, free of charge, to any person
-;;; obtaining a copy of this software and associated documentation
-;;; files (the "Software"), to deal in the Software without
-;;; restriction, including without limitation the rights to use, copy,
-;;; modify, merge, publish, distribute, sublicense, and/or sell copies
-;;; of the Software, and to permit persons to whom the Software is
-;;; furnished to do so, subject to the following conditions:
-;;;
-;;; The above copyright notice and this permission notice shall be
-;;; included in all copies or substantial portions of the Software.
-;;;
-;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
-;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
-;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
-;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
-;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
-;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
-;;; DEALINGS IN THE SOFTWARE.
-;;;
-
-(in-package #:cffi-grovel)
-
-;;;# Error Conditions
-
-(define-condition grovel-error (simple-error) ())
-
-(defun grovel-error (format-control &rest format-arguments)
- (error 'grovel-error
- :format-control format-control
- :format-arguments format-arguments))
-
-;;; This warning is signalled when cffi-grovel can't find some macro.
-;;; Signalled by CONSTANT or CONSTANTENUM.
-(define-condition missing-definition (warning)
- ((%name :initarg :name :reader name-of))
- (:report (lambda (condition stream)
- (format stream "No definition for ~A"
- (name-of condition)))))
-
-;;;# Grovelling
-
-;;; The header of the intermediate C file.
-(defparameter *header*
- "/*
- * This file has been automatically generated by cffi-grovel.
- * Do not edit it by hand.
- */
-
-")
-
-;;; C code generated by cffi-grovel is inserted between the contents
-;;; of *PROLOGUE* and *POSTSCRIPT*, inside the main function's body.
-
-(defparameter *prologue*
- "
-#include <grovel/common.h>
-
-int main(int argc, char**argv) {
- int autotype_tmp;
- FILE *output = argc > 1 ? fopen(argv[1], \"w\") : stdout;
- fprintf(output, \";;;; This file has been automatically generated by \"
- \"cffi-grovel.\\n;;;; Do not edit it by hand.\\n\\n\");
-")
-
-(defparameter *postscript*
- "
- if (output != stdout)
- fclose(output);
- return 0;
-}
-")
-
-(defun unescape-for-c (text)
- (with-output-to-string (result)
- (loop for i below (length text)
- for char = (char text i) do
- (cond ((eql char #\") (princ "\\\"" result))
- ((eql char #\newline) (princ "\\n" result))
- (t (princ char result))))))
-
-(defun c-format (out fmt &rest args)
- (let ((text (unescape-for-c (format nil "~?" fmt args))))
- (format out "~& fputs(\"~A\", output);~%" text)))
-
-(defun c-printf (out fmt &rest args)
- (flet ((item (item)
- (format out "~A" (unescape-for-c (format nil item)))))
- (format out "~& fprintf(output, \"")
- (item fmt)
- (format out "\"")
- (loop for arg in args do
- (format out ", ")
- (item arg))
- (format out ");~%")))
-
-(defun c-print-integer-constant (out arg &optional foreign-type)
- (let ((foreign-type (or foreign-type :int)))
- (c-format out "#.(cffi-grovel::convert-intmax-constant ")
- (format out "~& fprintf(output, \"%\"PRIiMAX, (intmax_t)~A);~%"
- arg)
- (c-format out " ")
- (c-write out `(quote ,foreign-type))
- (c-format out ")")))
-
-;;; TODO: handle packages in a better way. One way is to process each
-;;; grovel form as it is read (like we already do for wrapper
-;;; forms). This way in can expect *PACKAGE* to have sane values.
-;;; This would require that "header forms" come before any other
-;;; forms.
-(defun c-print-symbol (out symbol &optional no-package)
- (c-format out
- (let ((package (symbol-package symbol)))
- (cond
- ((eq (find-package '#:keyword) package) ":~(~A~)")
- (no-package "~(~A~)")
- ((eq (find-package '#:cl) package) "cl:~(~A~)")
- (t "~(~A~)")))
- symbol))
-
-(defun c-write (out form &optional no-package)
- (cond
- ((and (listp form)
- (eq 'quote (car form)))
- (c-format out "'")
- (c-write out (cadr form) no-package))
- ((listp form)
- (c-format out "(")
- (loop for subform in form
- for first-p = t then nil
- unless first-p do (c-format out " ")
- do (c-write out subform no-package))
- (c-format out ")"))
- ((symbolp form)
- (c-print-symbol out form no-package))))
-
-;;; Always NIL for now, add {ENABLE,DISABLE}-AUTO-EXPORT grovel forms
-;;; later, if necessary.
-(defvar *auto-export* nil)
-
-(defun c-export (out symbol)
- (when (and *auto-export* (not (keywordp symbol)))
- (c-format out "(cl:export '")
- (c-print-symbol out symbol t)
- (c-format out ")~%")))
-
-(defun c-section-header (out section-type section-symbol)
- (format out "~% /* ~A section for ~S */~%"
- section-type
- section-symbol))
-
-(defun remove-suffix (string suffix)
- (let ((suffix-start (- (length string) (length suffix))))
- (if (and (> suffix-start 0)
- (string= string suffix :start1 suffix-start))
- (subseq string 0 suffix-start)
- string)))
-
-(defgeneric %process-grovel-form (name out arguments)
- (:method (name out arguments)
- (declare (ignore out arguments))
- (grovel-error "Unknown Grovel syntax: ~S" name)))
-
-(defun process-grovel-form (out form)
- (%process-grovel-form (form-kind form) out (cdr form)))
-
-(defun form-kind (form)
- ;; Using INTERN here instead of FIND-SYMBOL will result in less
- ;; cryptic error messages when an undefined grovel/wrapper form is
- ;; found.
- (intern (symbol-name (car form)) '#:cffi-grovel))
-
-(defvar *header-forms* '(c include define flag typedef))
-
-(defun header-form-p (form)
- (member (form-kind form) *header-forms*))
-
-(defun generate-c-file (input-file output-defaults)
- (nest
- (with-standard-io-syntax)
- (let ((c-file (make-c-file-name output-defaults "__grovel"))
- (*print-readably* nil)
- (*print-escape* t)))
- (with-open-file (out c-file :direction :output :if-exists :supersede))
- (with-open-file (in input-file :direction :input))
- (flet ((read-forms (s)
- (do ((forms ())
- (form (read s nil nil) (read s nil nil)))
- ((null form) (nreverse forms))
- (labels
- ((process-form (f)
- (case (form-kind f)
- (flag (warn "Groveler clause FLAG is deprecated, use CC-FLAGS instead.")))
- (case (form-kind f)
- (in-package
- (setf *package* (find-package (second f)))
- (push f forms))
- (progn
- ;; flatten progn forms
- (mapc #'process-form (rest f)))
- (t (push f forms)))))
- (process-form form))))))
- (let* ((forms (read-forms in))
- (header-forms (remove-if-not #'header-form-p forms))
- (body-forms (remove-if #'header-form-p forms)))
- (write-string *header* out)
- (dolist (form header-forms)
- (process-grovel-form out form))
- (write-string *prologue* out)
- (dolist (form body-forms)
- (process-grovel-form out form))
- (write-string *postscript* out)
- c-file)))
-
-(defun tmp-lisp-file-name (defaults)
- (make-pathname :name (strcat (pathname-name defaults) ".grovel-tmp")
- :type "lisp" :defaults defaults))
-
-
-
-;;; *PACKAGE* is rebound so that the IN-PACKAGE form can set it during
-;;; *the extent of a given grovel file.
-(defun process-grovel-file (input-file &optional (output-defaults input-file))
- (with-standard-io-syntax
- (let* ((c-file (generate-c-file input-file output-defaults))
- (o-file (make-o-file-name c-file))
- (exe-file (make-exe-file-name c-file))
- (lisp-file (tmp-lisp-file-name c-file))
- (inputs (list (cc-include-grovel-argument) c-file)))
- (handler-case
- (progn
- ;; at least MKCL wants to separate compile and link
- (cc-compile o-file inputs)
- (link-executable exe-file (list o-file)))
- (error (e)
- (grovel-error "~a" e)))
- (invoke exe-file lisp-file)
- lisp-file)))
-
-;;; OUT is lexically bound to the output stream within BODY.
-(defmacro define-grovel-syntax (name lambda-list &body body)
- (with-unique-names (name-var args)
- `(defmethod %process-grovel-form ((,name-var (eql ',name)) out ,args)
- (declare (ignorable out))
- (destructuring-bind ,lambda-list ,args
- ,@body))))
-
-(define-grovel-syntax c (body)
- (format out "~%~A~%" body))
-
-(define-grovel-syntax include (&rest includes)
- (format out "~{#include <~A>~%~}" includes))
-
-(define-grovel-syntax define (name &optional value)
- (format out "#define ~A~@[ ~A~]~%" name value))
-
-(define-grovel-syntax typedef (base-type new-type)
- (format out "typedef ~A ~A;~%" base-type new-type))
-
-;;; Is this really needed?
-(define-grovel-syntax ffi-typedef (new-type base-type)
- (c-format out "(cffi:defctype ~S ~S)~%" new-type base-type))
-
-(define-grovel-syntax flag (&rest flags)
- (appendf *cc-flags* (parse-command-flags-list flags)))
-
-(define-grovel-syntax cc-flags (&rest flags)
- (appendf *cc-flags* (parse-command-flags-list flags)))
-
-(define-grovel-syntax pkg-config-cflags (pkg &key optional)
- (let ((output-stream (make-string-output-stream))
- (program+args (list "pkg-config" pkg "--cflags")))
- (format *debug-io* "~&;~{ ~a~}~%" program+args)
- (handler-case
- (progn
- (run-program program+args
- :output (make-broadcast-stream output-stream *debug-io*)
- :error-output output-stream)
- (appendf *cc-flags*
- (parse-command-flags (get-output-stream-string output-stream))))
- (error (e)
- (let ((message (format nil "~a~&~%~a~&"
- e (get-output-stream-string output-stream))))
- (cond (optional
- (format *debug-io* "~&; ERROR: ~a" message)
- (format *debug-io* "~&~%; Attempting to continue anyway.~%"))
- (t
- (grovel-error "~a" message))))))))
-
-;;; This form also has some "read time" effects. See GENERATE-C-FILE.
-(define-grovel-syntax in-package (name)
- (c-format out "(cl:in-package #:~A)~%~%" name))
-
-(define-grovel-syntax ctype (lisp-name size-designator)
- (c-section-header out "ctype" lisp-name)
- (c-export out lisp-name)
- (c-format out "(cffi:defctype ")
- (c-print-symbol out lisp-name t)
- (c-format out " ")
- (format out "~& type_name(output, TYPE_SIGNED_P(~A), ~:[sizeof(~A)~;~D~]);~%"
- size-designator
- (etypecase size-designator
- (string nil)
- (integer t))
- size-designator)
- (c-format out ")~%")
- (unless (keywordp lisp-name)
- (c-export out lisp-name))
- (let ((size-of-constant-name (symbolicate '#:size-of- lisp-name)))
- (c-export out size-of-constant-name)
- (c-format out "(cl:defconstant "
- size-of-constant-name lisp-name)
- (c-print-symbol out size-of-constant-name)
- (c-format out " (cffi:foreign-type-size '")
- (c-print-symbol out lisp-name)
- (c-format out "))~%")))
-
-;;; Syntax differs from anything else in CFFI. Fix?
-(define-grovel-syntax constant ((lisp-name &rest c-names)
- &key (type 'integer) documentation optional)
- (when (keywordp lisp-name)
- (setf lisp-name (format-symbol "~A" lisp-name)))
- (c-section-header out "constant" lisp-name)
- (dolist (c-name c-names)
- (format out "~&#ifdef ~A~%" c-name)
- (c-export out lisp-name)
- (c-format out "(cl:defconstant ")
- (c-print-symbol out lisp-name t)
- (c-format out " ")
- (ecase type
- (integer
- (format out "~& if(_64_BIT_VALUE_FITS_SIGNED_P(~A))~%" c-name)
- (format out " fprintf(output, \"%lli\", (long long signed) ~A);" c-name)
- (format out "~& else~%")
- (format out " fprintf(output, \"%llu\", (long long unsigned) ~A);" c-name))
- (double-float
- (format out "~& fprintf(output, \"%s\", print_double_for_lisp((double)~A));~%" c-name)))
- (when documentation
- (c-format out " ~S" documentation))
- (c-format out ")~%")
- (format out "~&#else~%"))
- (unless optional
- (c-format out "(cl:warn 'cffi-grovel:missing-definition :name '~A)~%"
- lisp-name))
- (dotimes (i (length c-names))
- (format out "~&#endif~%")))
-
-(define-grovel-syntax feature (lisp-feature-name c-name &key (feature-list 'cl:*features*))
- (c-section-header out "feature" lisp-feature-name)
- (format out "~&#ifdef ~A~%" c-name)
- (c-format out "(cl:pushnew '")
- (c-print-symbol out lisp-feature-name t)
- (c-format out " ")
- (c-print-symbol out feature-list)
- (c-format out ")~%")
- (format out "~&#endif~%"))
-
-(define-grovel-syntax cunion (union-lisp-name union-c-name &rest slots)
- (let ((documentation (when (stringp (car slots)) (pop slots))))
- (c-section-header out "cunion" union-lisp-name)
- (c-export out union-lisp-name)
- (dolist (slot slots)
- (let ((slot-lisp-name (car slot)))
- (c-export out slot-lisp-name)))
- (c-format out "(cffi:defcunion (")
- (c-print-symbol out union-lisp-name t)
- (c-printf out " :size %llu)" (format nil "(long long unsigned) sizeof(~A)" union-c-name))
- (when documentation
- (c-format out "~% ~S" documentation))
- (dolist (slot slots)
- (destructuring-bind (slot-lisp-name slot-c-name &key type count)
- slot
- (declare (ignore slot-c-name))
- (c-format out "~% (")
- (c-print-symbol out slot-lisp-name t)
- (c-format out " ")
- (c-write out type)
- (etypecase count
- (integer
- (c-format out " :count ~D" count))
- ((eql :auto)
- ;; nb, works like :count :auto does in cstruct below
- (c-printf out " :count %llu"
- (format nil "(long long unsigned) sizeof(~A)" union-c-name)))
- (null t))
- (c-format out ")")))
- (c-format out ")~%")))
-
-(defun make-from-pointer-function-name (type-name)
- (symbolicate '#:make- type-name '#:-from-pointer))
-
-;;; DEFINE-C-STRUCT-WRAPPER (in ../src/types.lisp) seems like a much
-;;; cleaner way to do this. Unless I can find any advantage in doing
-;;; it this way I'll delete this soon. --luis
-(define-grovel-syntax cstruct-and-class-item (&rest arguments)
- (process-grovel-form out (cons 'cstruct arguments))
- (destructuring-bind (struct-lisp-name struct-c-name &rest slots)
- arguments
- (declare (ignore struct-c-name))
- (let* ((slot-names (mapcar #'car slots))
- (reader-names (mapcar
- (lambda (slot-name)
- (intern
- (strcat (symbol-name struct-lisp-name) "-"
- (symbol-name slot-name))))
- slot-names))
- (initarg-names (mapcar
- (lambda (slot-name)
- (intern (symbol-name slot-name) "KEYWORD"))
- slot-names))
- (slot-decoders (mapcar (lambda (slot)
- (destructuring-bind
- (lisp-name c-name
- &key type count
- &allow-other-keys)
- slot
- (declare (ignore lisp-name c-name))
- (cond ((and (eq type :char) count)
- 'cffi:foreign-string-to-lisp)
- (t nil))))
- slots))
- (defclass-form
- `(defclass ,struct-lisp-name ()
- ,(mapcar (lambda (slot-name initarg-name reader-name)
- `(,slot-name :initarg ,initarg-name
- :reader ,reader-name))
- slot-names
- initarg-names
- reader-names)))
- (make-function-name
- (make-from-pointer-function-name struct-lisp-name))
- (make-defun-form
- ;; this function is then used as a constructor for this class.
- `(defun ,make-function-name (pointer)
- (cffi:with-foreign-slots
- (,slot-names pointer ,struct-lisp-name)
- (make-instance ',struct-lisp-name
- ,@(loop for slot-name in slot-names
- for initarg-name in initarg-names
- for slot-decoder in slot-decoders
- collect initarg-name
- if slot-decoder
- collect `(,slot-decoder ,slot-name)
- else collect slot-name))))))
- (c-export out make-function-name)
- (dolist (reader-name reader-names)
- (c-export out reader-name))
- (c-write out defclass-form)
- (c-write out make-defun-form))))
-
-(define-grovel-syntax cstruct (struct-lisp-name struct-c-name &rest slots)
- (let ((documentation (when (stringp (car slots)) (pop slots))))
- (c-section-header out "cstruct" struct-lisp-name)
- (c-export out struct-lisp-name)
- (dolist (slot slots)
- (let ((slot-lisp-name (car slot)))
- (c-export out slot-lisp-name)))
- (c-format out "(cffi:defcstruct (")
- (c-print-symbol out struct-lisp-name t)
- (c-printf out " :size %llu)"
- (format nil "(long long unsigned) sizeof(~A)" struct-c-name))
- (when documentation
- (c-format out "~% ~S" documentation))
- (dolist (slot slots)
- (destructuring-bind (slot-lisp-name slot-c-name &key type count)
- slot
- (c-format out "~% (")
- (c-print-symbol out slot-lisp-name t)
- (c-format out " ")
- (etypecase type
- ((eql :auto)
- (format out "~& SLOT_SIGNED_P(autotype_tmp, ~A, ~A~@[[0]~]);~@*~%~
- ~& type_name(output, autotype_tmp, sizeofslot(~A, ~A~@[[0]~]));~%"
- struct-c-name
- slot-c-name
- (not (null count))))
- ((or cons symbol)
- (c-write out type))
- (string
- (c-format out "~A" type)))
- (etypecase count
- (null t)
- (integer
- (c-format out " :count ~D" count))
- ((eql :auto)
- (c-printf out " :count %llu"
- (format nil "(long long unsigned) countofslot(~A, ~A)"
- struct-c-name
- slot-c-name)))
- ((or symbol string)
- (format out "~&#ifdef ~A~%" count)
- (c-printf out " :count %llu"
- (format nil "(long long unsigned) (~A)" count))
- (format out "~&#endif~%")))
- (c-printf out " :offset %lli)"
- (format nil "(long long signed) offsetof(~A, ~A)"
- struct-c-name
- slot-c-name))))
- (c-format out ")~%")
- (let ((size-of-constant-name
- (symbolicate '#:size-of- struct-lisp-name)))
- (c-export out size-of-constant-name)
- (c-format out "(cl:defconstant "
- size-of-constant-name struct-lisp-name)
- (c-print-symbol out size-of-constant-name)
- (c-format out " (cffi:foreign-type-size '(:struct ")
- (c-print-symbol out struct-lisp-name)
- (c-format out ")))~%"))))
-
-(defmacro define-pseudo-cvar (str name type &key read-only)
- (let ((c-parse (let ((*read-eval* nil)
- (*readtable* (copy-readtable nil)))
- (setf (readtable-case *readtable*) :preserve)
- (read-from-string str))))
- (typecase c-parse
- (symbol `(cffi:defcvar (,(symbol-name c-parse) ,name
- :read-only ,read-only)
- ,type))
- (list (unless (and (= (length c-parse) 2)
- (null (second c-parse))
- (symbolp (first c-parse))
- (eql #\* (char (symbol-name (first c-parse)) 0)))
- (grovel-error "Unable to parse c-string ~s." str))
- (let ((func-name (symbolicate "%" name '#:-accessor)))
- `(progn
- (declaim (inline ,func-name))
- (cffi:defcfun (,(string-trim "*" (symbol-name (first c-parse)))
- ,func-name) :pointer)
- (define-symbol-macro ,name
- (cffi:mem-ref (,func-name) ',type)))))
- (t (grovel-error "Unable to parse c-string ~s." str)))))
-
-(defun foreign-name-to-symbol (s)
- (intern (substitute #\- #\_ (string-upcase s))))
-
-(defun choose-lisp-and-foreign-names (string-or-list)
- (etypecase string-or-list
- (string (values string-or-list (foreign-name-to-symbol string-or-list)))
- (list (destructuring-bind (fname lname &rest args) string-or-list
- (declare (ignore args))
- (assert (and (stringp fname) (symbolp lname)))
- (values fname lname)))))
-
-(define-grovel-syntax cvar (name type &key read-only)
- (multiple-value-bind (c-name lisp-name)
- (choose-lisp-and-foreign-names name)
- (c-section-header out "cvar" lisp-name)
- (c-export out lisp-name)
- (c-printf out "(cffi-grovel::define-pseudo-cvar \"%s\" "
- (format nil "indirect_stringify(~A)" c-name))
- (c-print-symbol out lisp-name t)
- (c-format out " ")
- (c-write out type)
- (when read-only
- (c-format out " :read-only t"))
- (c-format out ")~%")))
-
-;;; FIXME: where would docs on enum elements go?
-(define-grovel-syntax cenum (name &rest enum-list)
- (destructuring-bind (name &key base-type define-constants)
- (ensure-list name)
- (c-section-header out "cenum" name)
- (c-export out name)
- (c-format out "(cffi:defcenum (")
- (c-print-symbol out name t)
- (when base-type
- (c-printf out " ")
- (c-print-symbol out base-type t))
- (c-format out ")")
- (dolist (enum enum-list)
- (destructuring-bind ((lisp-name &rest c-names) &key documentation)
- enum
- (declare (ignore documentation))
- (check-type lisp-name keyword)
- (loop for c-name in c-names do
- (check-type c-name string)
- (c-format out " (")
- (c-print-symbol out lisp-name)
- (c-format out " ")
- (c-print-integer-constant out c-name base-type)
- (c-format out ")~%"))))
- (c-format out ")~%")
- (when define-constants
- (define-constants-from-enum out enum-list))))
-
-(define-grovel-syntax constantenum (name &rest enum-list)
- (destructuring-bind (name &key base-type define-constants)
- (ensure-list name)
- (c-section-header out "constantenum" name)
- (c-export out name)
- (c-format out "(cffi:defcenum (")
- (c-print-symbol out name t)
- (when base-type
- (c-printf out " ")
- (c-print-symbol out base-type t))
- (c-format out ")")
- (dolist (enum enum-list)
- (destructuring-bind ((lisp-name &rest c-names)
- &key optional documentation) enum
- (declare (ignore documentation))
- (check-type lisp-name keyword)
- (c-format out "~% (")
- (c-print-symbol out lisp-name)
- (loop for c-name in c-names do
- (check-type c-name string)
- (format out "~&#ifdef ~A~%" c-name)
- (c-format out " ")
- (c-print-integer-constant out c-name base-type)
- (format out "~&#else~%"))
- (unless optional
- (c-format out
- "~% #.(cl:progn ~
- (cl:warn 'cffi-grovel:missing-definition :name '~A) ~
- -1)"
- lisp-name))
- (dotimes (i (length c-names))
- (format out "~&#endif~%"))
- (c-format out ")")))
- (c-format out ")~%")
- (when define-constants
- (define-constants-from-enum out enum-list))))
-
-(defun define-constants-from-enum (out enum-list)
- (dolist (enum enum-list)
- (destructuring-bind ((lisp-name &rest c-names) &rest options)
- enum
- (%process-grovel-form
- 'constant out
- `((,(intern (string lisp-name)) ,(car c-names))
- ,@options)))))
-
-(defun convert-intmax-constant (constant base-type)
- "Convert the C CONSTANT to an integer of BASE-TYPE. The constant is
-assumed to be an integer printed using the PRIiMAX printf(3) format
-string."
- ;; | C Constant | Type | Return Value | Notes |
- ;; |------------+---------+--------------+---------------------------------------|
- ;; | -1 | :int32 | -1 | |
- ;; | 0xffffffff | :int32 | -1 | CONSTANT may be a positive integer if |
- ;; | | | | sizeof(intmax_t) > sizeof(int32_t) |
- ;; | 0xffffffff | :uint32 | 4294967295 | |
- ;; | -1 | :uint32 | 4294967295 | |
- ;; |------------+---------+--------------+---------------------------------------|
- (let* ((canonical-type (cffi::canonicalize-foreign-type base-type))
- (type-bits (* 8 (cffi:foreign-type-size canonical-type)))
- (2^n (ash 1 type-bits)))
- (ecase canonical-type
- ((:unsigned-char :unsigned-short :unsigned-int
- :unsigned-long :unsigned-long-long)
- (mod constant 2^n))
- ((:char :short :int :long :long-long)
- (let ((v (mod constant 2^n)))
- (if (logbitp (1- type-bits) v)
- (- (mask-field (byte (1- type-bits) 0) v)
- (ash 1 (1- type-bits)))
- v))))))
-
-(defun foreign-type-to-printf-specification (type)
- "Return the printf specification associated with the foreign type TYPE."
- (ecase (cffi::canonicalize-foreign-type type)
- (:char "\"%hhd\"")
- (:unsigned-char "\"%hhu\"")
- (:short "\"%hd\"")
- (:unsigned-short "\"%hu\"")
- (:int "\"%d\"")
- (:unsigned-int "\"%u\"")
- (:long "\"%ld\"")
- (:unsigned-long "\"%lu\"")
- (:long-long "\"%lld\"")
- (:unsigned-long-long "\"%llu\"")))
-
-;; Defines a bitfield, with elements specified as ((LISP-NAME C-NAME)
-;; &key DOCUMENTATION). NAME-AND-OPTS can be either a symbol as name,
-;; or a list (NAME &key BASE-TYPE).
-(define-grovel-syntax bitfield (name-and-opts &rest masks)
- (destructuring-bind (name &key base-type)
- (ensure-list name-and-opts)
- (c-section-header out "bitfield" name)
- (c-export out name)
- (c-format out "(cffi:defbitfield (")
- (c-print-symbol out name t)
- (when base-type
- (c-printf out " ")
- (c-print-symbol out base-type t))
- (c-format out ")")
- (dolist (mask masks)
- (destructuring-bind ((lisp-name &rest c-names)
- &key optional documentation) mask
- (declare (ignore documentation))
- (check-type lisp-name symbol)
- (c-format out "~% (")
- (c-print-symbol out lisp-name)
- (c-format out " ")
- (dolist (c-name c-names)
- (check-type c-name string)
- (format out "~&#ifdef ~A~%" c-name)
- (format out "~& fprintf(output, ~A, ~A);~%"
- (foreign-type-to-printf-specification (or base-type :int))
- c-name)
- (format out "~&#else~%"))
- (unless optional
- (c-format out
- "~% #.(cl:progn ~
- (cl:warn 'cffi-grovel:missing-definition :name '~A) ~
- -1)"
- lisp-name))
- (dotimes (i (length c-names))
- (format out "~&#endif~%"))
- (c-format out ")")))
- (c-format out ")~%")))
-
-
-;;;# Wrapper Generation
-;;;
-;;; Here we generate a C file from a s-exp specification but instead
-;;; of compiling and running it, we compile it as a shared library
-;;; that can be subsequently loaded with LOAD-FOREIGN-LIBRARY.
-;;;
-;;; Useful to get at macro functionality, errno, system calls,
-;;; functions that handle structures by value, etc...
-;;;
-;;; Matching CFFI bindings are generated along with said C file.
-
-(defun process-wrapper-form (out form)
- (%process-wrapper-form (form-kind form) out (cdr form)))
-
-;;; The various operators push Lisp forms onto this list which will be
-;;; written out by PROCESS-WRAPPER-FILE once everything is processed.
-(defvar *lisp-forms*)
-
-(defun generate-c-lib-file (input-file output-defaults)
- (let ((*lisp-forms* nil)
- (c-file (make-c-file-name output-defaults "__wrapper")))
- (with-open-file (out c-file :direction :output :if-exists :supersede)
- (with-open-file (in input-file :direction :input)
- (write-string *header* out)
- (loop for form = (read in nil nil) while form
- do (process-wrapper-form out form))))
- (values c-file (nreverse *lisp-forms*))))
-
-(defun make-soname (lib-soname output-defaults)
- (make-pathname :name lib-soname
- :defaults output-defaults))
-
-(defun generate-bindings-file (lib-file lib-soname lisp-forms output-defaults)
- (with-standard-io-syntax
- (let ((lisp-file (tmp-lisp-file-name output-defaults))
- (*print-readably* nil)
- (*print-escape* t))
- (with-open-file (out lisp-file :direction :output :if-exists :supersede)
- (format out ";;;; This file was automatically generated by cffi-grovel.~%~
- ;;;; Do not edit by hand.~%")
- (let ((*package* (find-package '#:cl))
- (named-library-name
- (let ((*package* (find-package :keyword))
- (*read-eval* nil))
- (read-from-string lib-soname))))
- (pprint `(progn
- (cffi:define-foreign-library
- (,named-library-name
- :type :grovel-wrapper
- :search-path ,(directory-namestring lib-file))
- (t ,(namestring (make-so-file-name lib-soname))))
- (cffi:use-foreign-library ,named-library-name))
- out)
- (fresh-line out))
- (dolist (form lisp-forms)
- (print form out))
- (terpri out))
- lisp-file)))
-
-(defun cc-include-grovel-argument ()
- (format nil "-I~A" (truename (system-source-directory :cffi-grovel))))
-
-;;; *PACKAGE* is rebound so that the IN-PACKAGE form can set it during
-;;; *the extent of a given wrapper file.
-(defun process-wrapper-file (input-file
- &key
- (output-defaults (make-pathname :defaults input-file :type "processed"))
- lib-soname)
- (with-standard-io-syntax
- (multiple-value-bind (c-file lisp-forms)
- (generate-c-lib-file input-file output-defaults)
- (let ((lib-file (make-so-file-name (make-soname lib-soname output-defaults)))
- (o-file (make-o-file-name output-defaults "__wrapper")))
- (cc-compile o-file (list (cc-include-grovel-argument) c-file))
- (link-shared-library lib-file (list o-file))
- ;; FIXME: hardcoded library path.
- (values (generate-bindings-file lib-file lib-soname lisp-forms output-defaults)
- lib-file)))))
-
-(defgeneric %process-wrapper-form (name out arguments)
- (:method (name out arguments)
- (declare (ignore out arguments))
- (grovel-error "Unknown Grovel syntax: ~S" name)))
-
-;;; OUT is lexically bound to the output stream within BODY.
-(defmacro define-wrapper-syntax (name lambda-list &body body)
- (with-unique-names (name-var args)
- `(defmethod %process-wrapper-form ((,name-var (eql ',name)) out ,args)
- (declare (ignorable out))
- (destructuring-bind ,lambda-list ,args
- ,@body))))
-
-(define-wrapper-syntax progn (&rest forms)
- (dolist (form forms)
- (process-wrapper-form out form)))
-
-(define-wrapper-syntax in-package (name)
- (assert (find-package name) (name)
- "Wrapper file specified (in-package ~s)~%~
- however that does not name a known package."
- name)
- (setq *package* (find-package name))
- (push `(in-package ,name) *lisp-forms*))
-
-(define-wrapper-syntax c (&rest strings)
- (dolist (string strings)
- (write-line string out)))
-
-(define-wrapper-syntax flag (&rest flags)
- (appendf *cc-flags* (parse-command-flags-list flags)))
-
-(define-wrapper-syntax proclaim (&rest proclamations)
- (push `(proclaim ,@proclamations) *lisp-forms*))
-
-(define-wrapper-syntax declaim (&rest declamations)
- (push `(declaim ,@declamations) *lisp-forms*))
-
-(define-wrapper-syntax define (name &optional value)
- (format out "#define ~A~@[ ~A~]~%" name value))
-
-(define-wrapper-syntax include (&rest includes)
- (format out "~{#include <~A>~%~}" includes))
-
-;;; FIXME: this function is not complete. Should probably follow
-;;; typedefs? Should definitely understand pointer types.
-(defun c-type-name (typespec)
- (let ((spec (ensure-list typespec)))
- (if (stringp (car spec))
- (car spec)
- (case (car spec)
- ((:uchar :unsigned-char) "unsigned char")
- ((:unsigned-short :ushort) "unsigned short")
- ((:unsigned-int :uint) "unsigned int")
- ((:unsigned-long :ulong) "unsigned long")
- ((:long-long :llong) "long long")
- ((:unsigned-long-long :ullong) "unsigned long long")
- (:pointer "void*")
- (:string "char*")
- (t (cffi::foreign-name (car spec) nil))))))
-
-(defun cffi-type (typespec)
- (if (and (listp typespec) (stringp (car typespec)))
- (second typespec)
- typespec))
-
-(defun symbol* (s)
- (check-type s (and symbol (not null)))
- s)
-
-(define-wrapper-syntax defwrapper (name-and-options rettype &rest args)
- (multiple-value-bind (lisp-name foreign-name options)
- (cffi::parse-name-and-options name-and-options)
- (let* ((foreign-name-wrap (strcat foreign-name "_cffi_wrap"))
- (fargs (mapcar (lambda (arg)
- (list (c-type-name (second arg))
- (cffi::foreign-name (first arg) nil)))
- args))
- (fargnames (mapcar #'second fargs)))
- ;; output C code
- (format out "~A ~A" (c-type-name rettype) foreign-name-wrap)
- (format out "(~{~{~A ~A~}~^, ~})~%" fargs)
- (format out "{~% return ~A(~{~A~^, ~});~%}~%~%" foreign-name fargnames)
- ;; matching bindings
- (push `(cffi:defcfun (,foreign-name-wrap ,lisp-name ,@options)
- ,(cffi-type rettype)
- ,@(mapcar (lambda (arg)
- (list (symbol* (first arg))
- (cffi-type (second arg))))
- args))
- *lisp-forms*))))
-
-(define-wrapper-syntax defwrapper* (name-and-options rettype args &rest c-lines)
- ;; output C code
- (multiple-value-bind (lisp-name foreign-name options)
- (cffi::parse-name-and-options name-and-options)
- (let ((foreign-name-wrap (strcat foreign-name "_cffi_wrap"))
- (fargs (mapcar (lambda (arg)
- (list (c-type-name (second arg))
- (cffi::foreign-name (first arg) nil)))
- args)))
- (format out "~A ~A" (c-type-name rettype)
- foreign-name-wrap)
- (format out "(~{~{~A ~A~}~^, ~})~%" fargs)
- (format out "{~%~{ ~A~%~}}~%~%" c-lines)
- ;; matching bindings
- (push `(cffi:defcfun (,foreign-name-wrap ,lisp-name ,@options)
- ,(cffi-type rettype)
- ,@(mapcar (lambda (arg)
- (list (symbol* (first arg))
- (cffi-type (second arg))))
- args))
- *lisp-forms*))))
(DIR) diff --git a/3rdparties/software/cffi_0.20.0/grovel/package.lisp b/3rdparties/software/cffi_0.20.0/grovel/package.lisp
@@ -1,36 +0,0 @@
-;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
-;;;
-;;; package.lisp --- Groveler DEFPACKAGE.
-;;;
-;;; Permission is hereby granted, free of charge, to any person
-;;; obtaining a copy of this software and associated documentation
-;;; files (the "Software"), to deal in the Software without
-;;; restriction, including without limitation the rights to use, copy,
-;;; modify, merge, publish, distribute, sublicense, and/or sell copies
-;;; of the Software, and to permit persons to whom the Software is
-;;; furnished to do so, subject to the following conditions:
-;;;
-;;; The above copyright notice and this permission notice shall be
-;;; included in all copies or substantial portions of the Software.
-;;;
-;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
-;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
-;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
-;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
-;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
-;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
-;;; DEALINGS IN THE SOFTWARE.
-;;;
-
-(uiop:define-package #:cffi-grovel
- (:mix #:cffi-toolchain #:asdf #:uiop #:alexandria #:common-lisp)
- (:export
- ;; Class name
- #:grovel-file
- #:process-grovel-file
- #:wrapper-file
- #:process-wrapper-file
- ;; Error conditions
- #:grovel-error
- #:missing-definition))
(DIR) diff --git a/3rdparties/software/cffi_0.20.0/libffi/funcall.lisp b/3rdparties/software/cffi_0.20.0/libffi/funcall.lisp
@@ -1,132 +0,0 @@
-;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
-;;;
-;;; funcall.lisp -- FOREIGN-FUNCALL implementation using libffi
-;;;
-;;; Copyright (C) 2009, 2010, 2011 Liam M. Healy <lhealy@common-lisp.net>
-;;;
-;;; Permission is hereby granted, free of charge, to any person
-;;; obtaining a copy of this software and associated documentation
-;;; files (the "Software"), to deal in the Software without
-;;; restriction, including without limitation the rights to use, copy,
-;;; modify, merge, publish, distribute, sublicense, and/or sell copies
-;;; of the Software, and to permit persons to whom the Software is
-;;; furnished to do so, subject to the following conditions:
-;;;
-;;; The above copyright notice and this permission notice shall be
-;;; included in all copies or substantial portions of the Software.
-;;;
-;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
-;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
-;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
-;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
-;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
-;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
-;;; DEALINGS IN THE SOFTWARE.
-;;;
-
-(in-package #:cffi)
-
-(define-condition libffi-error (cffi-error)
- ((function-name
- :initarg :function-name :reader function-name)))
-
-(define-condition simple-libffi-error (simple-error libffi-error)
- ())
-
-(defun libffi-error (function-name format-control &rest format-arguments)
- (error 'simple-libffi-error
- :function-name function-name
- :format-control format-control
- :format-arguments format-arguments))
-
-(defun make-libffi-cif (function-name return-type argument-types
- &optional (abi :default-abi))
- "Generate or retrieve the Call InterFace needed to call the function through libffi."
- (let* ((argument-count (length argument-types))
- (cif (foreign-alloc '(:struct ffi-cif)))
- (ffi-argtypes (foreign-alloc :pointer :count argument-count)))
- (loop
- :for type :in argument-types
- :for index :from 0
- :do (setf (mem-aref ffi-argtypes :pointer index)
- (make-libffi-type-descriptor (parse-type type))))
- (unless (eql :ok (libffi/prep-cif cif abi argument-count
- (make-libffi-type-descriptor (parse-type return-type))
- ffi-argtypes))
- (libffi-error function-name
- "The 'ffi_prep_cif' libffi call failed for function ~S."
- function-name))
- cif))
-
-(defun free-libffi-cif (ptr)
- (foreign-free (foreign-slot-value ptr '(:struct ffi-cif) 'argument-types))
- (foreign-free ptr))
-
-(defun translate-objects-ret (symbols function-arguments types return-type call-form)
- (translate-objects
- symbols
- function-arguments
- types
- return-type
- (if (or (eql return-type :void)
- (typep (parse-type return-type) 'translatable-foreign-type))
- call-form
- ;; built-in types won't be translated by
- ;; expand-from-foreign, we have to do it here
- `(mem-ref
- ,call-form
- ',(canonicalize-foreign-type return-type)))
- t))
-
-(defun foreign-funcall-form/fsbv-with-libffi (function function-arguments symbols types
- return-type argument-types
- &optional pointerp (abi :default-abi))
- "A body of foreign-funcall calling the libffi function #'call (ffi_call)."
- (let ((argument-count (length argument-types)))
- `(with-foreign-objects ((argument-values :pointer ,argument-count)
- ,@(unless (eql return-type :void)
- `((result ',return-type))))
- ,(translate-objects-ret
- symbols function-arguments types return-type
- ;; NOTE: We must delay the cif creation until the first call
- ;; because it's FOREIGN-ALLOC'd, i.e. it gets corrupted by an
- ;; image save/restore cycle. This way a lib will remain usable
- ;; through a save/restore cycle if the save happens before any
- ;; FFI calls will have been made, i.e. nothing is malloc'd yet.
- `(progn
- (loop
- :for arg :in (list ,@symbols)
- :for count :from 0
- :do (setf (mem-aref argument-values :pointer count) arg))
- (let* ((libffi-cif-cache (load-time-value (cons 'libffi-cif-cache nil)))
- (libffi-cif (or (cdr libffi-cif-cache)
- (setf (cdr libffi-cif-cache)
- ;; FIXME ideally we should install a finalizer on the cons
- ;; that calls FREE-LIBFFI-CIF on the cif (when the function
- ;; gets redefined, and the cif becomes unreachable). but a
- ;; finite world is full of compromises... - attila
- (make-libffi-cif ,function ',return-type
- ',argument-types ',abi)))))
- (libffi/call libffi-cif
- ,(if pointerp
- function
- `(foreign-symbol-pointer ,function))
- ,(if (eql return-type :void) '(null-pointer) 'result)
- argument-values)
- ,(if (eql return-type :void)
- '(values)
- 'result)))))))
-
-(setf *foreign-structures-by-value* 'foreign-funcall-form/fsbv-with-libffi)
-
-;; DEPRECATED Its presence encourages the use of #+fsbv which may lead to the
-;; situation where a fasl was produced by an image that has fsbv feature
-;; and then ends up being loaded into an image later that has no fsbv support
-;; loaded. Use explicit ASDF dependencies instead and assume the presence
-;; of the feature accordingly.
-(pushnew :fsbv *features*)
-
-;; DEPRECATED This is here only for backwards compatibility until its fate is
-;; decided. See the mailing list discussion for details.
-(defctype :sizet size-t)
(DIR) diff --git a/3rdparties/software/cffi_0.20.0/libffi/libffi-functions.lisp b/3rdparties/software/cffi_0.20.0/libffi/libffi-functions.lisp
@@ -1,43 +0,0 @@
-;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
-;;;
-;;; init.lisp --- Load libffi and define basics
-;;;
-;;; Copyright (C) 2009, 2010, 2011 Liam Healy <lhealy@common-lisp.net>
-;;;
-;;; Permission is hereby granted, free of charge, to any person
-;;; obtaining a copy of this software and associated documentation
-;;; files (the "Software"), to deal in the Software without
-;;; restriction, including without limitation the rights to use, copy,
-;;; modify, merge, publish, distribute, sublicense, and/or sell copies
-;;; of the Software, and to permit persons to whom the Software is
-;;; furnished to do so, subject to the following conditions:
-;;;
-;;; The above copyright notice and this permission notice shall be
-;;; included in all copies or substantial portions of the Software.
-;;;
-;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
-;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
-;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
-;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
-;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
-;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
-;;; DEALINGS IN THE SOFTWARE.
-;;;
-
-(in-package #:cffi)
-
-;;; See file:///usr/share/doc/libffi-dev/html/The-Basics.html#The-Basics
-
-(defcfun ("ffi_prep_cif" libffi/prep-cif) status
- (ffi-cif :pointer)
- (ffi-abi abi)
- (nargs :uint)
- (rtype :pointer)
- (argtypes :pointer))
-
-(defcfun ("ffi_call" libffi/call) :void
- (ffi-cif :pointer)
- (function :pointer)
- (rvalue :pointer)
- (avalues :pointer))
(DIR) diff --git a/3rdparties/software/cffi_0.20.0/libffi/libffi-types.lisp b/3rdparties/software/cffi_0.20.0/libffi/libffi-types.lisp
@@ -1,109 +0,0 @@
-;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
-;;;
-;;; libffi-types.lisp -- CFFI-Grovel definitions for libffi
-;;;
-;;; Copyright (C) 2009, 2010, 2011, 2017 Liam M. Healy <lhealy@common-lisp.net>
-;;;
-;;; Permission is hereby granted, free of charge, to any person
-;;; obtaining a copy of this software and associated documentation
-;;; files (the "Software"), to deal in the Software without
-;;; restriction, including without limitation the rights to use, copy,
-;;; modify, merge, publish, distribute, sublicense, and/or sell copies
-;;; of the Software, and to permit persons to whom the Software is
-;;; furnished to do so, subject to the following conditions:
-;;;
-;;; The above copyright notice and this permission notice shall be
-;;; included in all copies or substantial portions of the Software.
-;;;
-;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
-;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
-;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
-;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
-;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
-;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
-;;; DEALINGS IN THE SOFTWARE.
-;;;
-
-(in-package #:cffi)
-
-#+linux
-(define "_GNU_SOURCE")
-
-;; When installed through Mac Ports, libffi include files
-;; will be found in /opt/local/include.
-#+darwin
-(cc-flags "-I/opt/local/include/")
-
-#+openbsd
-(cc-flags "-I/usr/local/include")
-
-#+freebsd
-(cc-flags "-I/usr/local/include")
-
-(pkg-config-cflags "libffi" :optional t)
-
-#+darwin
-(include "ffi/ffi.h")
-#-darwin
-(include "ffi.h")
-
-(cenum status
- ((:ok "FFI_OK"))
- ((:bad-typedef "FFI_BAD_TYPEDEF"))
- ((:bad-abi "FFI_BAD_ABI")))
-
-#+freebsd
-(cenum abi
- ((:default-abi "FFI_DEFAULT_ABI")))
-
-#+(and windows x86-64)
-(cenum abi
- ((:default-abi "FFI_DEFAULT_ABI"))
- ((:win64 "FFI_WIN64")))
-
-#+(and windows (not x86-64))
-(cenum abi
- ((:default-abi "FFI_DEFAULT_ABI"))
- ((:sysv "FFI_SYSV"))
- ((:stdcall "FFI_STDCALL")))
-
-#-(or freebsd windows)
-(cenum abi
- ((:default-abi "FFI_DEFAULT_ABI"))
- ((:sysv "FFI_SYSV"))
- ((:unix64 "FFI_UNIX64")))
-
-(ctype ffi-abi "ffi_abi")
-
-(ctype size-t "size_t")
-
-(cstruct ffi-type "struct _ffi_type"
- (size "size" :type size-t)
- (alignment "alignment" :type :unsigned-short)
- (type "type" :type :unsigned-short)
- (elements "elements" :type :pointer))
-
-(cstruct ffi-cif "ffi_cif"
- (abi "abi" :type ffi-abi)
- (argument-count "nargs" :type :unsigned-int)
- (argument-types "arg_types" :type :pointer)
- (return-type "rtype" :type :pointer)
- (bytes "bytes" :type :unsigned-int)
- (flags "flags" :type :unsigned-int))
-
-(constant (+type-void+ "FFI_TYPE_VOID"))
-(constant (+type-int+ "FFI_TYPE_INT"))
-(constant (+type-float+ "FFI_TYPE_FLOAT"))
-(constant (+type-double+ "FFI_TYPE_DOUBLE"))
-(constant (+type-longdouble+ "FFI_TYPE_LONGDOUBLE"))
-(constant (+type-uint8+ "FFI_TYPE_UINT8"))
-(constant (+type-sint8+ "FFI_TYPE_SINT8"))
-(constant (+type-uint16+ "FFI_TYPE_UINT16"))
-(constant (+type-sint16+ "FFI_TYPE_SINT16"))
-(constant (+type-uint32+ "FFI_TYPE_UINT32"))
-(constant (+type-sint32+ "FFI_TYPE_SINT32"))
-(constant (+type-uint64+ "FFI_TYPE_UINT64"))
-(constant (+type-sint64+ "FFI_TYPE_SINT64"))
-(constant (+type-struct+ "FFI_TYPE_STRUCT"))
-(constant (+type-pointer+ "FFI_TYPE_POINTER"))
(DIR) diff --git a/3rdparties/software/cffi_0.20.0/libffi/libffi.lisp b/3rdparties/software/cffi_0.20.0/libffi/libffi.lisp
@@ -1,38 +0,0 @@
-;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
-;;;
-;;; libffi.lisp --- Load libffi
-;;;
-;;; Copyright (C) 2009, 2011 Liam M. Healy
-;;;
-;;; Permission is hereby granted, free of charge, to any person
-;;; obtaining a copy of this software and associated documentation
-;;; files (the "Software"), to deal in the Software without
-;;; restriction, including without limitation the rights to use, copy,
-;;; modify, merge, publish, distribute, sublicense, and/or sell copies
-;;; of the Software, and to permit persons to whom the Software is
-;;; furnished to do so, subject to the following conditions:
-;;;
-;;; The above copyright notice and this permission notice shall be
-;;; included in all copies or substantial portions of the Software.
-;;;
-;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
-;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
-;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
-;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
-;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
-;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
-;;; DEALINGS IN THE SOFTWARE.
-;;;
-
-(in-package #:cffi)
-
-(define-foreign-library (libffi)
- (:darwin (:or "libffi.dylib" "libffi32.dylib" "/usr/lib/libffi.dylib"))
- (:solaris (:or "/usr/lib/amd64/libffi.so" "/usr/lib/libffi.so"))
- (:openbsd "libffi.so")
- (:unix (:or "libffi.so.6" "libffi32.so.6" "libffi.so.5" "libffi32.so.5"))
- (:windows (:or "libffi-6.dll" "libffi-5.dll" "libffi.dll"))
- (t (:default "libffi")))
-
-(load-foreign-library 'libffi)
(DIR) diff --git a/3rdparties/software/cffi_0.20.0/libffi/type-descriptors.lisp b/3rdparties/software/cffi_0.20.0/libffi/type-descriptors.lisp
@@ -1,106 +0,0 @@
-;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
-;;;
-;;; type-descriptors.lisp --- Build malloc'd libffi type descriptors
-;;;
-;;; Copyright (C) 2009, 2011 Liam M. Healy
-;;;
-;;; Permission is hereby granted, free of charge, to any person
-;;; obtaining a copy of this software and associated documentation
-;;; files (the "Software"), to deal in the Software without
-;;; restriction, including without limitation the rights to use, copy,
-;;; modify, merge, publish, distribute, sublicense, and/or sell copies
-;;; of the Software, and to permit persons to whom the Software is
-;;; furnished to do so, subject to the following conditions:
-;;;
-;;; The above copyright notice and this permission notice shall be
-;;; included in all copies or substantial portions of the Software.
-;;;
-;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
-;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
-;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
-;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
-;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
-;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
-;;; DEALINGS IN THE SOFTWARE.
-;;;
-
-(in-package #:cffi)
-
-(defmacro type-descriptor-ptr (type)
- `(foreign-symbol-pointer ,(format nil "ffi_type_~(~A~)" type)))
-
-(defmacro type-descriptor-ptr/integer (type)
- `(foreign-symbol-pointer
- ,(format nil "ffi_type_~Aint~D"
- (if (string-equal type "unsigned"
- :end1 (min 8 (length (string type))))
- "u" "s")
- (* 8 (foreign-type-size type)))))
-
-(defun %make-libffi-type-descriptor/struct (type)
- (labels
- ((slot-multiplicity (slot)
- (if (typep slot 'aggregate-struct-slot)
- (slot-count slot)
- 1))
- (number-of-items (structure-type)
- "Total number of items in the foreign structure."
- (loop for val being the hash-value of (structure-slots structure-type)
- sum (slot-multiplicity val))))
- (let* ((ptr (foreign-alloc '(:struct ffi-type)))
- (nitems (number-of-items type))
- (type-pointer-array
- (foreign-alloc :pointer :count (1+ nitems))))
- (loop for slot in (slots-in-order type)
- for ltp = (make-libffi-type-descriptor
- (parse-type (slot-type slot)))
- with slot-counter = 0
- do (if ltp
- (loop
- repeat (slot-multiplicity slot)
- do (setf
- (mem-aref
- type-pointer-array :pointer slot-counter)
- ltp)
- (incf slot-counter))
- (libffi-error nil
- "Slot type ~A in foreign structure is unknown to libffi."
- (unparse-type (slot-type slot)))))
- (setf (mem-aref type-pointer-array :pointer nitems)
- (null-pointer))
- (macrolet ((store (slot value)
- `(setf (foreign-slot-value ptr '(:struct ffi-type) ',slot) ,value)))
- (store size 0)
- (store alignment 0)
- (store type +type-struct+)
- (store elements type-pointer-array))
- ptr)))
-
-(defgeneric make-libffi-type-descriptor (object)
- (:documentation "Build a libffi struct that describes the type for libffi. This will be used as a cached static read-only argument when the actual call happens.")
- (:method ((object foreign-built-in-type))
- (let ((type-keyword (type-keyword object)))
- #.`(case type-keyword
- ,@(loop
- :for type :in (append *built-in-float-types*
- *other-builtin-types*)
- :collect `(,type (type-descriptor-ptr ,type)))
- ,@(loop
- :for type :in *built-in-integer-types*
- :collect `(,type (type-descriptor-ptr/integer ,type)))
- ;; there's a generic error report in an :around method
- )))
- (:method ((type foreign-pointer-type))
- ;; simplify all pointer types into a void*
- (type-descriptor-ptr :pointer))
- (:method ((type foreign-struct-type))
- (%make-libffi-type-descriptor/struct type))
- (:method :around (object)
- (let ((result (call-next-method)))
- (assert result () "~S failed on ~S. That's bad."
- 'make-libffi-type-descriptor object)
- result))
- (:method ((type foreign-type-alias))
- ;; Set the type pointer on demand for alias types (e.g. typedef, enum, etc)
- (make-libffi-type-descriptor (actual-type type))))
(DIR) diff --git a/3rdparties/software/cffi_0.20.0/scripts/release.lisp b/3rdparties/software/cffi_0.20.0/scripts/release.lisp
@@ -1,248 +0,0 @@
-#!/usr/bin/env clisp
-;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
-
-(defpackage :release-script (:use #:cl #:regexp))
-(in-package :release-script)
-
-;;;; Configuration ------------------------------------------------------------
-
-(defparameter *project-name* "cffi")
-(defparameter *asdf-file* (format nil "~A.asd" *project-name*))
-
-(defparameter *host* "common-lisp.net")
-(defparameter *release-dir*
- (format nil "/project/~A/public_html/releases" *project-name*))
-
-(defparameter *version-file* "VERSION")
-(defparameter *version-file-dir*
- (format nil "/project/~A/public_html" *project-name*))
-
-;;;; --------------------------------------------------------------------------
-
-;;;; Utilities
-
-(defun ensure-list (x)
- (if (listp x) x (list x)))
-
-(defmacro string-case (expression &body clauses)
- `(let ((it ,expression)) ; yes, anaphoric, deal with it.
- (cond
- ,@(loop for clause in clauses collect
- `((or ,@(loop for alternative in (ensure-list (first clause))
- collect (or (eq t alternative)
- `(string= it ,alternative))))
- ,@(rest clause))))))
-
-(defparameter *development-mode* nil)
-
-(defun die (format-control &rest format-args)
- (format *error-output* "~?" format-control format-args)
- (if *development-mode*
- (cerror "continue" "die")
- (ext:quit 1)))
-
-(defun numeric-split (string)
- (if (digit-char-p (char string 0))
- (multiple-value-bind (number next-position)
- (parse-integer string :junk-allowed t)
- (cons number (when (< next-position (length string))
- (numeric-split (subseq string next-position)))))
- (let ((next-digit-position (position-if #'digit-char-p string)))
- (if next-digit-position
- (cons (subseq string 0 next-digit-position)
- (numeric-split (subseq string next-digit-position)))
- (list string)))))
-
-(defun natural-string-< (s1 s2)
- (labels ((aux< (l1 l2)
- (cond ((null l1) (not (null l2)))
- ((null l2) nil)
- (t (destructuring-bind (x . xs) l1
- (destructuring-bind (y . ys) l2
- (cond ((and (numberp x) (stringp y))
- t)
- ((and (numberp y) (stringp x))
- nil)
- ((and (numberp x) (numberp y))
- (or (< x y) (and (= x y) (aux< xs ys))))
- (t
- (or (string-lessp x y)
- (and (string-equal x y)
- (aux< xs ys)))))))))))
- (aux< (numeric-split s1)
- (numeric-split s2))))
-
-;;;; Running commands
-
-(defparameter *dry-run* nil)
-
-(defun cmd? (format-control &rest format-args)
- (let ((cmd (format nil "~?" format-control format-args)))
- (with-open-stream (s1 (ext:run-shell-command cmd :output :stream))
- (loop for line = (read-line s1 nil nil)
- while line
- collect line))))
-
-;; XXX: quote arguments.
-(defun cmd (format-control &rest format-args)
- (when *development-mode*
- (format *debug-io* "CMD: ~?~%" format-control format-args))
- (let ((ret (ext:run-shell-command (format nil "~?" format-control format-args))))
- (or (null ret)
- (zerop ret))))
-
-(defun cmd! (format-control &rest format-args)
- (or (apply #'cmd format-control format-args)
- (die "cmd '~?' failed." format-control format-args)))
-
-(defun maybe-cmd! (format-control &rest format-args)
- (if *dry-run*
- (format t "SUPPRESSING: ~?~%" format-control format-args)
- (apply #'cmd! format-control format-args)))
-
-;;;;
-
-(defun find-current-version ()
- (subseq (reduce (lambda (x y) (if (natural-string-< x y) y x))
- (or (cmd? "git tag -l v\\*")
- (die "no version tags found. Please specify initial version.")))
- 1))
-
-(defun parse-version (string)
- (mapcar (lambda (x)
- (parse-integer x :junk-allowed t))
- (loop repeat 3 ; XXX: parameterize
- for el in (regexp-split "\\." (find-current-version))
- collect el)))
-
-(defun check-for-unrecorded-changes (&optional force)
- (unless (cmd "git diff --exit-code")
- (write-line "Unrecorded changes.")
- (if force
- (write-line "Continuing anyway.")
- (die "Aborting.~@
- Use -f or --force if you want to make a release anyway."))))
-
-(defun new-version-number-candidates (current-version)
- (labels ((alternatives (before after)
- (when after
- (cons (append before
- (list (1+ (first after)))
- (mapcar (constantly 0) (rest after)))
- (alternatives (append before (list (first after)))
- (rest after))))))
- (loop for alt in (alternatives nil (parse-version current-version))
- collect (format nil "~{~d~^.~}" alt))))
-
-(defun ask-user-for-version (current-version next-versions)
- (format *query-io* "Current version is ~A. Which will be the next one?~%"
- current-version)
- (loop for i from 1 and version in next-versions
- do (format *query-io* "~T~A) ~A~%" i version))
- (format *query-io* "? ")
- (finish-output *query-io*)
- (nth (1- (parse-integer (read-line) :junk-allowed t))
- next-versions))
-
-(defun git-tag-tree (version)
- (write-line "Tagging the tree...")
- (maybe-cmd! "git tag \"v~A\"" version))
-
-(defun add-version-to-system-file (version path-in path-out)
- (let ((defsystem-line (format nil "(defsystem :~A" *project-name*)))
- (with-open-file (in path-in :direction :input)
- (with-open-file (out path-out :direction :output)
- (loop for line = (read-line in nil nil) while line
- do (write-line line out)
- when (string= defsystem-line line)
- do (format out " :version ~s~%" version))))))
-
-(defun create-dist (version distname)
- (write-line "Creating distribution...")
- (cmd! "mkdir \"~a\"" distname)
- (cmd! "git archive master | tar xC \"~A\"" distname)
- (format t "Updating ~A with new version: ~A~%" *asdf-file* version)
- (let* ((asdf-file-path (format nil "~A/~A" distname *asdf-file*))
- (tmp-asdf-file-path (format nil "~a.tmp" asdf-file-path)))
- (add-version-to-system-file version asdf-file-path tmp-asdf-file-path)
- (cmd! "mv \"~a\" \"~a\"" tmp-asdf-file-path asdf-file-path)))
-
-(defun tar-and-sign (distname tarball)
- (write-line "Creating and signing tarball...")
- (cmd! "tar czf \"~a\" \"~a\"" tarball distname)
- (cmd! "gpg -b -a \"~a\"" tarball))
-
-(defparameter *remote-directory* (format nil "~A:~A" *host* *release-dir*))
-
-(defun upload-tarball (tarball signature remote-directory)
- (write-line "Copying tarball to web server...")
- (maybe-cmd! "scp \"~A\" \"~A\" \"~A\"" tarball signature remote-directory)
- (format t "Uploaded ~A and ~A.~%" tarball signature))
-
-(defun update-remote-links (tarball signature host release-dir project-name)
- (format t "Updating ~A_latest links...~%" project-name)
- (maybe-cmd! "ssh \"~A\" ln -sf \"~A\" \"~A/~A_latest.tar.gz\""
- host tarball release-dir project-name)
- (maybe-cmd! "ssh \"~A\" ln -sf \"~A\" \"~A/~A_latest.tar.gz.asc\""
- host signature release-dir project-name))
-
-(defun upload-version-file (version version-file host version-file-dir)
- (format t "Uploading ~A...~%" version-file)
- (with-open-file (out version-file :direction :output)
- (write-string version out))
- (maybe-cmd! "scp \"~A\" \"~A\":\"~A\"" version-file host version-file-dir)
- (maybe-cmd! "rm \"~A\"" version-file))
-
-(defun maybe-clean-things-up (tarball signature)
- (when (y-or-n-p "Clean local tarball and signature?")
- (cmd! "rm \"~A\" \"~A\"" tarball signature)))
-
-(defun run (force version)
- (check-for-unrecorded-changes force)
- ;; figure out what version we'll be preparing.
- (unless version
- (let* ((current-version (find-current-version))
- (next-versions (new-version-number-candidates current-version)))
- (setf version (or (ask-user-for-version current-version next-versions)
- (die "invalid selection.")))))
- (git-tag-tree version)
- (let* ((distname (format nil "~A_~A" *project-name* version))
- (tarball (format nil "~A.tar.gz" distname))
- (signature (format nil "~A.asc" tarball)))
- ;; package things up.
- (create-dist version distname)
- (tar-and-sign distname tarball)
- ;; upload.
- (upload-tarball tarball signature *remote-directory*)
- (update-remote-links tarball signature *host* *release-dir* *project-name*)
- (when *version-file*
- (upload-version-file version *version-file* *host* *version-file-dir*))
- ;; clean up.
- (maybe-clean-things-up tarball signature)
- ;; documentation.
- (write-line "Building and uploading documentation...")
- (maybe-cmd! "make -C doc upload-docs")
- ;; push tags and any outstanding changes.
- (write-line "Pushing tags and changes...")
- (maybe-cmd! "git push --tags origin master")))
-
-
-;;;; Do it to it
-
-(let ((force nil)
- (version nil)
- (args ext:*args*))
- (loop while args
- do (string-case (pop args)
- (("-h" "--help")
- (write-line "No help, sorry. Read the source.")
- (ext:quit 0))
- (("-f" "--force")
- (setf force t))
- (("-v" "--version")
- (setf version (pop args)))
- (("-n" "--dry-run")
- (setf *dry-run* t))
- (t
- (die "Unrecognized argument '~a'" it))))
- (run force version))
(DIR) diff --git a/3rdparties/software/cffi_0.20.0/src/c2ffi/asdf.lisp b/3rdparties/software/cffi_0.20.0/src/c2ffi/asdf.lisp
@@ -1,211 +0,0 @@
-;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
-;;;
-;;; asdf.lisp --- ASDF components for cffi/c2ffi.
-;;;
-;;; Copyright (C) 2015, Attila Lendvai <attila@lendvai.name>
-;;;
-;;; Permission is hereby granted, free of charge, to any person
-;;; obtaining a copy of this software and associated documentation
-;;; files (the "Software"), to deal in the Software without
-;;; restriction, including without limitation the rights to use, copy,
-;;; modify, merge, publish, distribute, sublicense, and/or sell copies
-;;; of the Software, and to permit persons to whom the Software is
-;;; furnished to do so, subject to the following conditions:
-;;;
-;;; The above copyright notice and this permission notice shall be
-;;; included in all copies or substantial portions of the Software.
-;;;
-;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
-;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
-;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
-;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
-;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
-;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
-;;; DEALINGS IN THE SOFTWARE.
-;;;
-
-(in-package #:cffi/c2ffi)
-
-(defclass c2ffi-file (cl-source-file)
- ((package :initarg :package
- :initform nil
- :accessor c2ffi-file/package)
- (c2ffi-executable :initarg :c2ffi-executable
- :accessor c2ffi-file/c2ffi-executable)
- (trace-c2ffi :initarg :trace-c2ffi
- :accessor c2ffi-file/trace-c2ffi)
- (prelude :initform nil
- :initarg :prelude
- :accessor c2ffi-file/prelude)
- (sys-include-paths :initarg :sys-include-paths
- :initform nil
- :accessor c2ffi-file/sys-include-paths)
- (exclude-archs :initarg :exclude-archs
- :initform nil
- :accessor c2ffi-file/exclude-archs)
- ;; The following slots correspond to an arg of the same name for
- ;; the generator function. No accessors are needed, they just hold
- ;; the data until it gets delegated to the generator function using
- ;; SLOT-VALUE and a LOOP.
- (ffi-name-transformer :initarg :ffi-name-transformer
- :initform 'default-ffi-name-transformer)
- (ffi-name-export-predicate :initarg :ffi-name-export-predicate
- :initform 'default-ffi-name-export-predicate)
- (ffi-type-transformer :initarg :ffi-type-transformer
- :initform 'default-ffi-type-transformer)
- (callback-factory :initarg :callback-factory
- :initform 'default-callback-factory)
- (foreign-library-name :initarg :foreign-library-name
- :initform nil)
- (foreign-library-spec :initarg :foreign-library-spec
- :initform nil)
- (emit-generated-name-mappings :initarg :emit-generated-name-mappings
- :initform :t)
- (include-sources :initarg :include-sources
- :initform :all)
- (exclude-sources :initarg :exclude-sources
- :initform nil)
- (include-definitions :initarg :include-definitions
- :initform :all)
- (exclude-definitions :initarg :exclude-definitions
- :initform nil))
- (:default-initargs
- :type nil)
- (:documentation
- "The input of this ASDF component is a C header file and the configuration for
-the binding generation process. This header file will define the initial scope of
-the generation process, which can be further filtered by other configuration
-parameters.
-
-A clang/llvm based external program called 'c2ffi' is used to process this header
-file and generate a json spec file for each supported architecture triplet. Normally
-these .spec files are only (re)generated by the author of the lib and are checked into
-the corresponding source repository. It needs to be done manually by invoking the
-following command:
-
-(cffi/c2ffi:generate-spec :your-system)
-
-which is a shorthand for:
-
-(asdf:operate 'cffi/c2ffi::generate-spec-op :your-system)
-
-The generation of the underlying platform's json file must succeed, but the
-generation for the other arch's is allowed to fail
-\(see ENSURE-SPEC-FILE-IS-UP-TO-DATE for details).
-
-During the normal build process the json file is used as the input to generate
-a lisp file containing the CFFI definitions (see PROCESS-C2FFI-SPEC-FILE).
-This file will be placed next to the .spec file, and will be compiled as any
-other lisp file. This process requires loading the ASDF system called
-\"cffi/c2ffi-generator\" that has more dependencies than CFFI itself. If you
-want to avoid those extra dependencies in your project, then you can check in
-these generated lisp files into your source repository, but keep in mind that
-you'll need to manually force their regeneration if CFFI/C2FFI itself gets
-updated (by e.g. deleting them from the filesystem) ."))
-
-(defun input-file (operation component)
- (let ((files (input-files operation component)))
- (assert (length=n-p files 1))
- (first files)))
-
-(defclass generate-spec-op (downward-operation)
- ())
-
-(defun generate-spec (system)
- (asdf:operate 'generate-spec-op system))
-
-(defmethod input-files ((op generate-spec-op) (c c2ffi-file))
- (list (component-pathname c)))
-
-(defmethod component-depends-on ((op generate-spec-op) (c c2ffi-file))
- `((prepare-op ,c) ,@(call-next-method)))
-
-(defmethod output-files ((op generate-spec-op) (c c2ffi-file))
- (let* ((input-file (input-file op c))
- (spec-file (spec-path input-file)))
- (values
- (list spec-file)
- ;; Tell ASDF not to apply output translation.
- t)))
-
-(defmethod perform ((op generate-spec-op) (c asdf:component))
- (values))
-
-(defmethod perform ((op generate-spec-op) (c c2ffi-file))
- (let ((input-file (input-file op c))
- (*c2ffi-executable* (if (slot-boundp c 'c2ffi-executable)
- (c2ffi-file/c2ffi-executable c)
- *c2ffi-executable*))
- (*trace-c2ffi* (if (slot-boundp c 'trace-c2ffi)
- (c2ffi-file/trace-c2ffi c)
- *trace-c2ffi*)))
- ;; NOTE: we don't call OUTPUT-FILE here, which may be a violation
- ;; of the ASDF contract, that promises that OUTPUT-FILE can be
- ;; customized by users.
- (ensure-spec-file-is-up-to-date
- input-file
- :exclude-archs (c2ffi-file/exclude-archs c)
- :sys-include-paths (c2ffi-file/sys-include-paths c))))
-
-(defclass generate-lisp-op (downward-operation)
- ())
-
-(defmethod component-depends-on ((op generate-lisp-op) (c c2ffi-file))
- `((load-op ,(find-system "cffi/c2ffi-generator"))
- ,@(call-next-method)))
-
-(defmethod component-depends-on ((op compile-op) (c c2ffi-file))
- `((generate-lisp-op ,c) ,@(call-next-method)))
-
-(defmethod component-depends-on ((op load-source-op) (c c2ffi-file))
- `((generate-lisp-op ,c) ,@(call-next-method)))
-
-(defmethod input-files ((op generate-lisp-op) (c c2ffi-file))
- (list (output-file 'generate-spec-op c)))
-
-(defmethod input-files ((op compile-op) (c c2ffi-file))
- (list (output-file 'generate-lisp-op c)))
-
-(defmethod output-files ((op generate-lisp-op) (c c2ffi-file))
- (let* ((spec-file (input-file op c))
- (generated-lisp-file (make-pathname :type "lisp"
- :defaults spec-file)))
- (values
- (list generated-lisp-file)
- ;; Tell ASDF not to apply output translation.
- t)))
-
-(defmethod perform ((op generate-lisp-op) (c c2ffi-file))
- (let ((spec-file (input-file op c))
- (generated-lisp-file (output-file op c)))
- (with-staging-pathname (tmp-output generated-lisp-file)
- (format *debug-io* "~&; CFFI/C2FFI is generating the file ~S~%" generated-lisp-file)
- (apply 'process-c2ffi-spec-file
- spec-file (c2ffi-file/package c)
- :output tmp-output
- :output-encoding (asdf:component-encoding c)
- :prelude (let ((prelude (c2ffi-file/prelude c)))
- (if (and (pathnamep prelude)
- (not (absolute-pathname-p prelude)))
- (merge-pathnames* prelude (component-pathname c))
- prelude))
- ;; The following slots and keyword args have the same name in the ASDF
- ;; component and in PROCESS-C2FFI-SPEC-FILE, and this loop copies them.
- (loop
- :for arg :in '(ffi-name-transformer
- ffi-name-export-predicate
- ffi-type-transformer
- callback-factory
- foreign-library-name
- foreign-library-spec
- emit-generated-name-mappings
- include-sources
- exclude-sources
- include-definitions
- exclude-definitions)
- :append (list (make-keyword arg)
- (slot-value c arg)))))))
-
-;; Allow for naked :cffi/c2ffi-file in asdf definitions.
-(setf (find-class 'asdf::cffi/c2ffi-file) (find-class 'c2ffi-file))
(DIR) diff --git a/3rdparties/software/cffi_0.20.0/src/c2ffi/c2ffi.lisp b/3rdparties/software/cffi_0.20.0/src/c2ffi/c2ffi.lisp
@@ -1,194 +0,0 @@
-;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
-;;;
-;;; c2ffi.lisp --- c2ffi related code
-;;;
-;;; Copyright (C) 2013, Ryan Pavlik <rpavlik@gmail.com>
-;;; Copyright (C) 2015, Attila Lendvai <attila@lendvai.name>
-;;;
-;;; Permission is hereby granted, free of charge, to any person
-;;; obtaining a copy of this software and associated documentation
-;;; files (the "Software"), to deal in the Software without
-;;; restriction, including without limitation the rights to use, copy,
-;;; modify, merge, publish, distribute, sublicense, and/or sell copies
-;;; of the Software, and to permit persons to whom the Software is
-;;; furnished to do so, subject to the following conditions:
-;;;
-;;; The above copyright notice and this permission notice shall be
-;;; included in all copies or substantial portions of the Software.
-;;;
-;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
-;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
-;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
-;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
-;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
-;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
-;;; DEALINGS IN THE SOFTWARE.
-;;;
-
-(in-package #:cffi/c2ffi)
-
-;;; NOTE: Most of this has been taken over from cl-autowrap.
-
-;;; Note this is rather untested and not very extensive at the moment;
-;;; it should probably work on linux/win/osx though. Patches welcome.
-
-(defun local-cpu ()
- #+x86-64 "x86_64"
- #+(and (not (or x86-64 freebsd)) x86) "i686"
- #+(and (not x86-64) x86 freebsd) "i386"
- #+arm "arm")
-
-(defun local-vendor ()
- #+(or linux windows) "-pc"
- #+darwin "-apple"
- #+(not (or linux windows darwin)) "-unknown")
-
-(defun local-os ()
- #+linux "-linux"
- #+windows "-windows-msvc"
- #+darwin "-darwin9"
- #+freebsd "-freebsd")
-
-(defun local-environment ()
- #+linux "-gnu"
- #-linux "")
-
-(defun local-arch ()
- (strcat (local-cpu) (local-vendor) (local-os) (local-environment)))
-
-(defparameter *known-archs*
- '("i686-pc-linux-gnu"
- "x86_64-pc-linux-gnu"
- "i686-pc-windows-msvc"
- "x86_64-pc-windows-msvc"
- "i686-apple-darwin9"
- "x86_64-apple-darwin9"
- "i386-unknown-freebsd"
- "x86_64-unknown-freebsd"))
-
-(defvar *c2ffi-executable* "c2ffi")
-
-(defvar *trace-c2ffi* nil)
-
-(defun c2ffi-executable-available? ()
- ;; This is a hack to determine if c2ffi exists; it assumes if it
- ;; doesn't exist, we will get a return code other than 0.
- (zerop (nth-value 2 (uiop:run-program `(,*c2ffi-executable* "-h")
- :ignore-error-status t))))
-
-(defun run-program* (program args &key (output (if *trace-c2ffi* *standard-output* nil))
- (error-output (if *trace-c2ffi* *error-output* nil))
- ignore-error-status)
- (when *trace-c2ffi*
- (format *debug-io* "~&; Invoking: ~A~{ ~A~}~%" program args))
- (zerop (nth-value 2 (uiop:run-program (list* program args) :output output
- :error-output error-output
- :ignore-error-status ignore-error-status))))
-
-(defun generate-spec-with-c2ffi (input-header-file output-spec-path
- &key arch sys-include-paths ignore-error-status)
- "Run c2ffi on `INPUT-HEADER-FILE`, outputting to `OUTPUT-FILE` and
-`MACRO-OUTPUT-FILE`, optionally specifying a target triple `ARCH`."
- (uiop:with-temporary-file (:pathname tmp-macro-file
- :keep *trace-c2ffi*)
- nil ; workaround for an UIOP bug; delme eventually (attila, 2016-01-27).
- :close-stream
- (let* ((arch (when arch (list "--arch" arch)))
- (sys-include-paths (loop
- :for dir :in sys-include-paths
- :append (list "--sys-include" dir))))
- ;; Invoke c2ffi to first emit C #define's into TMP-MACRO-FILE. We ask c2ffi
- ;; to first generate a file of C global variables that are assigned the
- ;; value of the corresponding #define's, so that in the second pass below
- ;; the C compiler evaluates for us their right hand side and thus we can
- ;; get hold of their value. This is a kludge and eventually we could/should
- ;; support generating cffi-grovel files, and in grovel mode not rely
- ;; on this kludge anymore.
- (when (run-program* *c2ffi-executable* (list* (namestring input-header-file)
- "--driver" "null"
- "--macro-file" (namestring tmp-macro-file)
- (append arch sys-include-paths))
- :output *standard-output*
- :ignore-error-status ignore-error-status)
- ;; Write a tmp header file that #include's the original input file and
- ;; the above generated macros file which will form the input for our
- ;; final, second pass.
- (uiop:with-temporary-file (:stream tmp-include-file-stream
- :pathname tmp-include-file
- :keep *trace-c2ffi*)
- (format tmp-include-file-stream "#include \"~A\"~%" input-header-file)
- (format tmp-include-file-stream "#include \"~A\"~%" tmp-macro-file)
- :close-stream
- ;; Invoke c2ffi again to generate the final output.
- (run-program* *c2ffi-executable* (list* (namestring tmp-include-file)
- "--output" (namestring output-spec-path)
- (append arch sys-include-paths))
- :output *standard-output*
- :ignore-error-status ignore-error-status))))))
-
-(defun spec-path (base-name &key version (arch (local-arch)))
- (check-type base-name pathname)
- (make-pathname :defaults base-name
- :name (strcat (pathname-name base-name)
- (if version
- (strcat "-" version)
- "")
- "."
- arch)
- :type "spec"))
-
-(defun find-local-spec (base-name &optional (errorp t))
- (let* ((spec-path (spec-path base-name))
- (probed (probe-file spec-path)))
- (if probed
- spec-path
- (when errorp
- (error "c2ffi spec file not found for base name ~S" base-name)))))
-
-(defun ensure-spec-file-is-up-to-date (header-file-path
- &key exclude-archs sys-include-paths version)
- (let ((spec-path (find-local-spec header-file-path nil)))
- (flet ((regenerate-spec-file ()
- (let ((local-arch (local-arch)))
- (unless (c2ffi-executable-available?)
- (error "No spec found for ~S on arch '~A' and c2ffi not found"
- header-file-path local-arch))
- (generate-spec-with-c2ffi header-file-path
- (spec-path header-file-path
- :arch local-arch
- :version version)
- :arch local-arch
- :sys-include-paths sys-include-paths)
- ;; Try to run c2ffi for other architectures, but tolerate failure
- (dolist (arch *known-archs*)
- (unless (or (string= local-arch arch)
- (member arch exclude-archs :test #'string=))
- (unless (generate-spec-with-c2ffi header-file-path
- (spec-path header-file-path
- :arch arch
- :version version)
- :arch arch
- :sys-include-paths sys-include-paths
- :ignore-error-status t)
- (warn "Failed to generate spec for other arch: ~S" arch))))
- (find-local-spec header-file-path))))
- (if (and spec-path
- (uiop:timestamp< (file-write-date header-file-path)
- (file-write-date spec-path)))
- spec-path ; it's up to date, just return it as is
- (restart-case
- (regenerate-spec-file)
- (touch-old-copy ()
- :report (lambda (stream)
- (format stream "Update the modification time of the out-of-date copy ~S" spec-path))
- ;; Make it only be visible when the spec file exists (but it's out of date)
- :test (lambda (condition)
- (declare (ignore condition))
- (not (null spec-path)))
- ;; Update the last modification time. Yes, it's convoluted and wasteful,
- ;; but I can't see any other way.
- (with-staging-pathname (tmp-file spec-path)
- (copy-file spec-path tmp-file))
- ;; The return value of RESTART-CASE
- spec-path))))))
(DIR) diff --git a/3rdparties/software/cffi_0.20.0/src/c2ffi/generator.lisp b/3rdparties/software/cffi_0.20.0/src/c2ffi/generator.lisp
@@ -1,838 +0,0 @@
-;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
-;;;
-;;; generator.lisp --- Generate CFFI bindings for a c2ffi output.
-;;;
-;;; Copyright (C) 2015, Attila Lendvai <attila@lendvai.name>
-;;;
-;;; Permission is hereby granted, free of charge, to any person
-;;; obtaining a copy of this software and associated documentation
-;;; files (the "Software"), to deal in the Software without
-;;; restriction, including without limitation the rights to use, copy,
-;;; modify, merge, publish, distribute, sublicense, and/or sell copies
-;;; of the Software, and to permit persons to whom the Software is
-;;; furnished to do so, subject to the following conditions:
-;;;
-;;; The above copyright notice and this permission notice shall be
-;;; included in all copies or substantial portions of the Software.
-;;;
-;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
-;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
-;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
-;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
-;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
-;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
-;;; DEALINGS IN THE SOFTWARE.
-;;;
-
-(in-package #:cffi/c2ffi)
-
-;;; Output generation happens in one phase, straight into the output
-;;; stream. There's minimal look-ahead (for source-location and name)
-;;; which is needed to apply user specified filters in time.
-;;;
-;;; Each CFFI form is also EVAL'd during generation because the CFFI
-;;; type lookup/parsing mechanism is used while generating the output.
-;;;
-;;; Nomenclature:
-;;;
-;;; - variable names in this file are to be interpreted in the
-;;; C,c2ffi,json context, and 'cffi' is added to names that denote
-;;; the cffi name.
-;;;
-;;; Possible improvments:
-;;;
-;;; - generate an additional grovel file for C inline function
-;;; declarations found in header files
-;;;
-;;; - generate struct-by-value DEFCFUN's into a separate file so that
-;;; users can decide whether to depend on libffi, or they can make do
-;;; without those definitions
-
-(defvar *allow-pointer-type-simplification* t)
-(defvar *allow-skipping-struct-fields* t)
-(defvar *assume-struct-by-value-support* t)
-;; Called on the json name and may return a symbol to be used, or a string.
-(defvar *ffi-name-transformer* 'default-ffi-name-transformer)
-;; Called on the already transformed name to decide whether to export it
-(defvar *ffi-name-export-predicate* 'default-ffi-name-export-predicate)
-;; Called on the CFFI type, e.g. to turn (:pointer :char) into a :string.
-(defvar *ffi-type-transformer* 'default-ffi-type-transformer)
-;; May return up to two closures using VALUES. The first one will be called
-;; with each emitted form, and the second one once, at the end. They both may
-;; return a list of forms that will be emitted using OUTPUT/CODE.
-(defvar *callback-factory* 'default-callback-factory)
-
-(define-constant +generated-file-header+
- ";;; -*- Mode: lisp -*-~%~
- ;;;~%~
- ;;; This file has been automatically generated by cffi/c2ffi. Editing it by hand is not wise.~%~
- ;;;~%~%"
- :test 'equal)
-
-(defvar *c2ffi-output-stream*)
-
-(defun output/export (names package)
- (let ((names (uiop:ensure-list names)))
- ;; Make sure we have something PRINT-READABLY as a package name,
- ;; i.e. not a SIMPLE-BASE-STRING on SBCL.
- (output/code `(export ',names ',(make-symbol (package-name package))))))
-
-(defun output/code (form)
- (check-type form cons)
- (format *c2ffi-output-stream* "~&")
- (write form
- :stream *c2ffi-output-stream*
- :circle t
- :pretty t
- :escape t
- :readably t)
- (format *c2ffi-output-stream* "~%~%")
- (unless (member (first form) '(cffi:defcfun alexandria:define-constant) :test 'eq)
- (eval form)))
-
-(defun output/string (message-control &rest message-arguments)
- (apply 'format *c2ffi-output-stream* message-control message-arguments))
-
-;; NOTE: as per c2ffi json output. A notable difference to
-;; CFFI::*BUILT-IN-FOREIGN-TYPES* is the presence of :SIGNED-CHAR.
-(define-constant +c-builtin-types+ '(":void" ":_Bool" ":char" ":signed-char" ":unsigned-char" ":short"
- ":unsigned-short" ":int" ":unsigned-int" ":long" ":unsigned-long"
- ":long-long" ":unsigned-long-long" ":float" ":double" ":long-double")
- :test 'equal)
-
-(define-condition unsupported-type (cffi::foreign-type-error)
- ((json-definition :initarg :json-definition
- :accessor json-definition-of)))
-
-(defun unsupported-type (json-entry)
- (error 'unsupported-type :type-name nil :json-definition json-entry))
-
-;;;;;;
-;;; Utilities
-
-(defun compile-rules (rules)
- (case rules
- (:all rules)
- (t (mapcar (lambda (pattern)
- (check-type pattern string "Patterns in the inclusion/exclusion rules must be strings.")
- (let ((scanner (cl-ppcre:create-scanner pattern)))
- (named-lambda cffi/c2ffi/cl-ppcre-rule-matcher
- (string)
- (funcall scanner string 0 (length string)))))
- rules))))
-
-(defun include-definition? (name source-location
- include-definitions exclude-definitions
- include-sources exclude-sources)
- (labels
- ((covered-by-a-rule? (name rules)
- (or (eq rules :all)
- (not (null (some (rcurry #'funcall name) rules)))))
- (weak? (rules)
- (eq :all rules))
- (strong? (name rules)
- (and name
- (not (weak? rules))
- (covered-by-a-rule? name rules))))
- (let* ((excl-def/weak (weak? exclude-definitions))
- (excl-def/strong (strong? name exclude-definitions))
- (incl-def/weak (weak? include-definitions))
- (incl-def/strong (strong? name include-definitions))
- (excl-src/weak (weak? exclude-sources))
- (excl-src/strong (strong? source-location exclude-sources))
- (incl-src/weak (weak? include-sources))
- (incl-src/strong (strong? source-location include-sources))
- (incl/strong (or incl-def/strong
- incl-src/strong))
- (excl/strong (or excl-def/strong
- excl-src/strong))
- (incl/weak (or incl-def/weak
- incl-src/weak))
- (excl/weak (or excl-def/weak
- excl-src/weak)))
- (or incl-def/strong
- (and (not excl/strong)
- (or incl/strong
- (and incl/weak
- ;; we want src exclude rules to be stronger
- (not excl-src/weak))
- (not excl/weak)))))))
-
-(defun coerce-to-byte-size (bit-size)
- (let ((byte-size (/ bit-size 8)))
- (unless (integerp byte-size)
- (error "Non-byte size encountered where it wasn't expected (~A bits)" bit-size))
- byte-size))
-
-(defmacro assume (condition &optional format-control &rest format-arguments)
- "Similar to ASSERT, but WARN's only."
- `(unless ,condition
- ,(if format-control
- `(warn ,format-control ,@format-arguments)
- `(warn "ASSUME failed: ~S" ',condition))))
-
-(defun canonicalize-transformer-hook (hook)
- (etypecase hook
- ((and (or function symbol)
- (not null))
- hook)
- (string
- (the symbol (safe-read-from-string hook)))))
-
-;;;;;;
-;;; Json access
-
-(defun json-value (alist key &key (otherwise nil otherwise?))
- (check-type alist list)
- (check-type key (and symbol (not null)))
- (let* ((entry (assoc key alist))
- (result (cond
- (entry
- (cdr entry))
- (otherwise?
- otherwise)
- (t (error "Key ~S not found in json entry ~S." key alist)))))
- (if (equal result "")
- nil
- result)))
-
-(defmacro with-json-values ((json-entry &rest args) &body body)
- (if (null args)
- `(progn
- ,@body)
- (once-only (json-entry)
- `(let (,@(loop
- :for entry :in args
- :collect (let* ((args (ensure-list entry))
- (name (pop args))
- (key (or (pop args)
- (make-keyword (symbol-name name)))))
- (destructuring-bind
- ;; using &optional would trigger a warning (on SBCL)
- (&key (otherwise nil otherwise?))
- args
- `(,name
- (json-value ,json-entry ,key ,@(when otherwise?
- `(:otherwise ,otherwise))))))))
- ,@body))))
-
-(defun expected-json-keys (alist &rest keys)
- (let* ((keys (list* :location keys))
- (outliers (remove-if (lambda (el)
- (member (car el) keys :test 'eq))
- alist)))
- (when outliers
- (warn "Unexpected key(s) in json entry ~S: ~S" alist outliers))))
-
-;;;;;;
-;;; Namespaces, names and conversions
-
-;; an alist of (name . hashtable)
-(defvar *generated-names*)
-(defvar *anon-name-counter*)
-(defvar *anon-entities*)
-
-(defun register-anon-entity (id name)
- (check-type id integer)
- (check-type name string)
- (assert (not (zerop (length name))))
- (setf (gethash id *anon-entities*) name)
- name)
-
-(defun lookup-anon-entity (id)
- (or (gethash id *anon-entities*)
- (error "Could not find anonymous entity with id ~S." id)))
-
-(defun generate-anon-name (base-name)
- (format nil "~A"
- (strcat (symbol-name base-name)
- (princ-to-string (incf *anon-name-counter*)))))
-
-(defun valid-name-or-die (name)
- ;; checks for valid json names (*not* CFFI names)
- (etypecase name
- (string
- (assert (not (zerop (length name)))))
- (cons
- (assert (= 2 (length name)))
- (assert (member (first name) '(:struct :union :enum)))
- (valid-name-or-die (second name)))))
-
-(defun call-hook (hook &rest args)
- (apply hook
- ;; indiscriminately add one keyword arg entry to warn
- (append args '(just-a-warning "Make sure your transformer hook has &key &allow-other-keys for future extendability."))))
-
-(defun find-cffi-type-or-die (type-name &optional (namespace :default))
- (when (eq namespace :enum)
- ;; TODO FIXME this should be cleaned up in CFFI. more about namespace confusion at:
- ;; https://bugs.launchpad.net/cffi/+bug/1527947
- (setf namespace :default))
- (cffi::find-type-parser type-name namespace))
-
-(define-constant +name-kinds+ '(:struct :union :function :variable :type
- :constant :field :argument :enum :member)
- :test 'equal)
-
-(deftype ffi-name-kind ()
- '#.(list* 'member +name-kinds+))
-
-(defun json-name-to-cffi-name (name kind &optional anonymous)
- (check-type name string)
- (check-type kind ffi-name-kind)
- (when *ffi-name-transformer*
- (setf name (call-hook *ffi-name-transformer* name kind))
- (unless (or (and (symbolp name)
- (not (null name)))
- (stringp name))
- (error "The FFI-NAME-TRANSFORMER ~S returned with ~S which is not a valid name."
- *ffi-name-transformer* name)))
- (let ((cffi-name (if (symbolp name)
- name
- (intern name))))
- (when (and (not anonymous)
- (boundp '*generated-names*))
- ;; TODO FIXME this function also gets called for e.g. argument types of a function. and
- ;; if the function ends up *not* getting emitted, e.g. because of a missing type, then
- ;; we wrongly record here the missing type in the *generated-names* registry.
- (setf (gethash name (cdr (assoc kind *generated-names*)))
- cffi-name))
- cffi-name))
-
-(defun default-callback-factory (&key &allow-other-keys)
- (values))
-
-(defun default-ffi-name-transformer (name kind &key &allow-other-keys)
- (check-type name string)
- (case kind
- #+nil
- ((:constant :member)
- (assert (not (symbolp name)))
- (format nil "+~A+" name))
- (t name)))
-
-(defun change-case-to-readtable-case (name &optional (reatable *readtable*))
- (ecase (readtable-case reatable)
- (:upcase (string-upcase name))
- (:downcase (string-downcase name))
- (:preserve name)
- ;; (:invert no, you don't)
- ))
-
-(defun camelcased? (name)
- (and (>= (length name) 3)
- (let ((lower 0)
- (upper 0))
- (loop
- :for char :across name
- :do (cond
- ((upper-case-p char)
- (incf upper))
- ((lower-case-p char)
- (incf lower))))
- (unless (or (zerop lower)
- (zerop upper))
- (let ((ratio (/ upper lower)))
- (and (<= 0.05 ratio 0.5)))))))
-
-(defun camelcase-to-dash-separated (name)
- (coerce (loop
- :for char :across name
- :for index :from 0
- :when (and (upper-case-p char)
- (not (zerop index)))
- :collect #\-
- :collect (char-downcase char))
- 'string))
-
-(defun maybe-camelcase-to-dash-separated (name)
- (if (camelcased? name)
- (camelcase-to-dash-separated name)
- name))
-
-(defun default-ffi-name-export-predicate (symbol &key &allow-other-keys)
- (declare (ignore symbol))
- nil)
-
-(defun default-ffi-type-transformer (type context &key &allow-other-keys)
- (declare (ignore context))
- (cond
- ((and (consp type)
- (eq :pointer (first type)))
- (let ((pointed-to-type (second type)))
- (if (eq pointed-to-type :char)
- :string
- type)))
- (t
- type)))
-
-(defun function-pointer-type-name ()
- (symbolicate '#:function-pointer))
-
-(defmacro with-allowed-foreign-type-errors ((on-failure-form &key (enabled t)) &body body)
- (with-unique-names (type-block)
- `(block ,type-block
- (handler-bind
- ((cffi::foreign-type-error
- (lambda (_)
- (declare (ignore _))
- (when ,enabled
- (return-from ,type-block ,on-failure-form)))))
- ,@body))))
-
-(defun %json-type-to-cffi-type (json-entry)
- (with-json-values (json-entry tag)
- (let ((cffi-type
- (cond
- ((switch (tag :test 'equal)
- (":void" :void)
- (":_Bool" :bool)
- ;; regarding :signed-char see https://stackoverflow.com/questions/436513/char-signed-char-char-unsigned-char
- (":char" :char)
- (":signed-char" :char)
- (":unsigned-char" :unsigned-char)
- (":short" :short)
- (":unsigned-short" :unsigned-short)
- (":int" :int)
- (":unsigned-int" :unsigned-int)
- (":long" :long)
- (":unsigned-long" :unsigned-long)
- (":long-long" :long-long)
- (":unsigned-long-long" :unsigned-long-long)
- (":float" :float)
- (":double" :double)
- ;; TODO FIXME
- ;;(":long-double" :long-double)
- )
- ;; return the result of the condition expression
- )
- ((or (progn
- (assert (not (member tag +c-builtin-types+ :test 'equal)) ()
- "Not all C basic types are covered! The outlier is: ~S" tag)
- nil)
- (equal tag ":struct")
- (equal tag ":union"))
- ;; ":struct" is a "struct foo-struct var" kind of reference
- (expected-json-keys json-entry :name :tag :id)
- (with-json-values (json-entry name id)
- (let* ((kind (if (equal tag ":struct")
- :struct
- :union))
- (cffi-name (if name
- (json-name-to-cffi-name name kind)
- (lookup-anon-entity id))))
- (find-cffi-type-or-die cffi-name kind)
- `(,kind ,cffi-name))))
- ((or (equal tag "struct")
- (equal tag "union"))
- ;; "struct" denotes a "struct {} var", or "typedef struct {} my_type"
- ;; kind of inline anonymous declaration. Let's call PROCESS-C2FFI-ENTRY
- ;; to emit it for us, and return with the generated name (first value)
- ;; as if it was a standalone toplevel struct definition.
- ;; TODO is it a problem that we don't invoke the CALLBACK-FACTORY stuff here?
- (let ((form (process-c2ffi-entry json-entry))
- (kind (if (equal tag "struct")
- :struct
- :union)))
- (assert (and (consp form)
- (member (first form) '(cffi:defcstruct cffi:defcunion))))
- `(,kind ,(first (ensure-list (second form))))))
- ((equal tag ":enum")
- ;; ":enum" is an "enum foo var" kind of reference
- (expected-json-keys json-entry :name :tag :id)
- (with-json-values (json-entry name id)
- (let ((cffi-name (json-name-to-cffi-name (or name
- (lookup-anon-entity id))
- :enum)))
- (find-cffi-type-or-die cffi-name :enum)
- ;; TODO FIXME this would be the proper one, but CFFI is broken: `(:enum ,cffi-name)
- cffi-name)))
- ((equal tag "enum")
- ;; "enum" is an inline "typedef enum {m1, m2} var" kind of inline declaration
- (expected-json-keys json-entry :name :tag :id)
- ;; TODO FIXME similarly to struct, but it would be nice to see an example
- (error "not yet implemented"))
- ((equal tag ":array")
- (expected-json-keys json-entry :tag :type :size)
- (with-json-values (json-entry type size)
- (check-type size integer)
- `(:array ,(json-type-to-cffi-type type) ,size)))
- ((equal tag ":pointer")
- (expected-json-keys json-entry :tag :type :id)
- (with-json-values (json-entry type)
- `(:pointer ,(with-allowed-foreign-type-errors
- (:void :enabled *allow-pointer-type-simplification*)
- (json-type-to-cffi-type type)))))
- ((equal tag ":function-pointer")
- (expected-json-keys json-entry :tag)
- (function-pointer-type-name))
- ((equal tag ":function")
- (unsupported-type json-entry))
- (t
- (assert (not (starts-with #\: tag)))
- (let ((cffi-name (json-name-to-cffi-name tag :type)))
- ;; TODO FIXME json-name-to-cffi-name collects the mentioned
- ;; types to later emit +TYPE-NAMES+, but if this next
- ;; find-cffi-type-or-die dies then the entire function is
- ;; skipped.
- (find-cffi-type-or-die cffi-name)
- cffi-name)))))
- (assert cffi-type () "Failed to map ~S to a cffi type" json-entry)
- cffi-type)))
-
-(defun should-export-p (symbol)
- (and symbol
- (symbolp symbol)
- (not (keywordp symbol))
- *ffi-name-export-predicate*
- (call-hook *ffi-name-export-predicate* symbol)))
-
-(defun json-type-to-cffi-type (json-entry &optional (context nil context?))
- (let ((cffi-type (%json-type-to-cffi-type json-entry)))
- (if context?
- (call-hook *ffi-type-transformer* cffi-type context)
- cffi-type)))
-
-;;;;;;
-;;; Entry point, the "API"
-
-(defun process-c2ffi-spec-file (c2ffi-spec-file package-name
- &key
- (allow-pointer-type-simplification *allow-pointer-type-simplification*)
- (allow-skipping-struct-fields *allow-skipping-struct-fields*)
- (assume-struct-by-value-support *assume-struct-by-value-support*)
- ;; either a pathname or a string (will be copied as is),
- ;; or a function that will be funcall'd with one argument
- ;; to emit a form (i.e. OUTPUT/CODE).
- prelude
- (output (make-pathname :name (strcat (pathname-name c2ffi-spec-file) ".cffi-tmp")
- :type "lisp" :defaults c2ffi-spec-file))
- (output-encoding asdf:*default-encoding*)
- ;; The args following this point are mirrored in the ASDF
- ;; component on the same name.
- (ffi-name-transformer *ffi-name-transformer*)
- (ffi-name-export-predicate *ffi-name-export-predicate*)
- ;; as per CFFI:DEFINE-FOREIGN-LIBRARY and CFFI:LOAD-FOREIGN-LIBRARY
- (ffi-type-transformer *ffi-type-transformer*)
- (callback-factory *callback-factory*)
- foreign-library-name
- foreign-library-spec
- (emit-generated-name-mappings t)
- (include-sources :all)
- exclude-sources
- (include-definitions :all)
- exclude-definitions)
- "Generates a lisp file with CFFI definitions from C2FFI-SPEC-FILE.
-PACKAGE-NAME will be overwritten, it assumes full control over the
-target package."
- (check-type c2ffi-spec-file (or pathname string))
- (macrolet ((@ (var)
- `(setf ,var (compile-rules ,var))))
- (@ include-sources)
- (@ exclude-sources)
- (@ include-definitions)
- (@ exclude-definitions))
- (with-standard-io-syntax
- (with-input-from-file (in c2ffi-spec-file :external-format (asdf/driver:encoding-external-format :utf-8))
- (with-output-to-file (*c2ffi-output-stream* output :if-exists :supersede
- :external-format (asdf/driver:encoding-external-format output-encoding))
- (let* ((*package* (or (find-package package-name)
- (make-package package-name)))
- ;; Make sure we use an uninterned symbol, so that it's neutral to READTABLE-CASE.
- (package-name (make-symbol (package-name *package*)))
- ;; Let's rebind a copy, so that when we are done with
- ;; the generation (which also EVAL's the forms) then
- ;; the CFFI type repository is also reverted back to
- ;; the previous state. This avoids redefinition warning
- ;; when the generated file gets compiled and loaded
- ;; later.
- (cffi::*type-parsers* (copy-hash-table cffi::*type-parsers*))
- (*anon-name-counter* 0)
- (*anon-entities* (make-hash-table))
- (*generated-names* (mapcar (lambda (key)
- `(,key . ,(make-hash-table :test 'equal)))
- +name-kinds+))
- (*allow-pointer-type-simplification* allow-pointer-type-simplification)
- (*allow-skipping-struct-fields* allow-skipping-struct-fields)
- (*assume-struct-by-value-support* assume-struct-by-value-support)
- (*ffi-name-transformer* (canonicalize-transformer-hook ffi-name-transformer))
- (*ffi-name-export-predicate* (canonicalize-transformer-hook ffi-name-export-predicate))
- (*ffi-type-transformer* (canonicalize-transformer-hook ffi-type-transformer))
- (*callback-factory* (canonicalize-transformer-hook callback-factory))
- (*read-default-float-format* 'double-float)
- (json (json:decode-json in)))
- (output/string +generated-file-header+)
- ;; some forms that are always emitted
- (mapc 'output/code
- ;; Make sure the package exists. We don't even want to :use COMMON-LISP here,
- ;; to avoid any possible name clashes.
- `((uiop:define-package ,package-name (:use))
- (in-package ,package-name)
- (cffi:defctype ,(function-pointer-type-name) :pointer)))
- (when (and foreign-library-name
- foreign-library-spec)
- (when (stringp foreign-library-name)
- (setf foreign-library-name (safe-read-from-string foreign-library-name)))
- (output/code `(cffi:define-foreign-library ,foreign-library-name
- ,@foreign-library-spec))
- ;; TODO: Unconditionally emitting a USE-FOREIGN-LIBRARY may not be smart.
- ;; For details see: https://bugs.launchpad.net/cffi/+bug/1593635
- (output/code `(cffi:use-foreign-library ,foreign-library-name)))
- (etypecase prelude
- (null)
- (string
- (output/string prelude))
- (pathname
- (with-input-from-file (prelude-stream prelude)
- (alexandria:copy-stream prelude-stream *c2ffi-output-stream*
- :element-type 'character)))
- ((or symbol function)
- (funcall prelude 'output/code)))
- ;;
- ;; Let's enumerate the entries
- (multiple-value-bind (form-callback epilogue-callback)
- (funcall *callback-factory*)
- (dolist (json-entry json)
- (with-json-values (json-entry name location)
- (let ((source-location-file (subseq location
- 0
- (or (position #\: location)
- 0))))
- (if (include-definition?
- name source-location-file
- include-definitions exclude-definitions
- include-sources exclude-sources)
- (progn
- (output/string "~&~%;; ~S" location)
- (let ((emitted-definition (process-c2ffi-entry json-entry)))
- ;;
- ;; Call the plugin to let the user emit a form after the given
- ;; definition
- (when (and emitted-definition
- form-callback)
- (map nil 'output/code (call-hook form-callback emitted-definition)))))
- (output/string "~&;; Skipped ~S due to filters" name)))))
- ;;
- ;; Call the plugin to let the user append multiple forms after the
- ;; emitted definitions
- (when epilogue-callback
- (map nil 'output/code (call-hook epilogue-callback))))
- ;;
- ;; emit optional exports
- (maphash
- (lambda (package-name symbols)
- (output/export (sort (remove-if-not #'should-export-p symbols) #'string<)
- package-name))
- (get-all-names-by-package *generated-names*))
-
- ;;
- ;; emit optional mappings
- (when emit-generated-name-mappings
- (mapcar (lambda (entry)
- (destructuring-bind (kind variable-name) entry
- (output/code `(defparameter
- ,(intern (symbol-name variable-name))
- ',(hash-table-alist (cdr (assoc kind *generated-names*)))))))
- `((:function #:+function-names+)
- (:struct #:+struct-names+)
- (:union #:+union-names+)
- (:variable #:+variable-names+)
- (:type #:+type-names+)
- (:constant #:+constant-names+)
- (:argument #:+argument-names+)
- (:field #:+field-names+))))))))
- output)
-
-(defun get-all-names-by-package (name-collection)
- (let ((tables (mapcar #'cdr name-collection))
- all
- (grouped (make-hash-table)))
- (loop :for table :in tables :do
- (loop :for s :being :the :hash-values :of table :do
- (push s all)))
- (remove-duplicates all :test #'eq)
- (loop :for name :in all
- :for package-name := (package-name (symbol-package name))
- :do (setf (gethash package-name grouped)
- (cons name (gethash package-name grouped))))
- grouped))
-
-;;;;;;
-;;; Processors for various definitions
-
-(defvar *c2ffi-entry-processors* (make-hash-table :test 'equal))
-
-(defun process-c2ffi-entry (json-entry)
- (let* ((kind (json-value json-entry :tag))
- (processor (gethash kind *c2ffi-entry-processors*)))
- (if processor
- (let ((definition-form
- (handler-bind
- ((unsupported-type
- (lambda (e)
- (warn "Skip definition because cannot map ~S to any CFFI type. The definition is ~S"
- (json-definition-of e) json-entry)
- (return-from process-c2ffi-entry (values))))
- (cffi::undefined-foreign-type-error
- (lambda (e)
- (output/string "~&;; Skipping definition ~S because of missing type ~S"
- json-entry (cffi::foreign-type-error/compound-name e))
- (return-from process-c2ffi-entry (values)))))
- (funcall processor json-entry))))
- (when definition-form
- (output/code definition-form)
- definition-form))
- (progn
- (warn "No cffi/c2ffi processor defined for ~A" json-entry)
- (values)))))
-
-(defmacro define-processor (kind args &body body)
- `(setf (gethash ,(string-downcase kind) *c2ffi-entry-processors*)
- (named-lambda ,(symbolicate 'c2ffi-processor/ kind) (-json-entry-)
- (with-json-values (-json-entry- ,@args)
- ,@body))))
-
-(defun %process-struct-like (json-entry kind definer anon-base-name)
- (expected-json-keys json-entry :tag :ns :name :id :bit-size :bit-alignment :fields)
- (with-json-values (json-entry tag (struct-name :name) fields bit-size id)
- (assert (member tag '(":struct" "struct" ":union" "union") :test 'equal))
- (flet ((process-field (json-entry)
- (with-json-values (json-entry (field-name :name) bit-offset type)
- (let ((cffi-type (with-allowed-foreign-type-errors
- ('failed :enabled *allow-skipping-struct-fields*)
- (json-type-to-cffi-type type `(,kind ,struct-name ,field-name)))))
- (if (eq cffi-type 'failed)
- (output/string "~&;; skipping field due to missing type ~S, full json entry: ~S" type json-entry)
- `(,(json-name-to-cffi-name field-name :field)
- ,cffi-type
- ,@(unless (eq kind :union)
- `(:offset ,(coerce-to-byte-size bit-offset)))))))))
- `(,definer (,(json-name-to-cffi-name (or struct-name
- (register-anon-entity
- id
- (generate-anon-name anon-base-name)))
- kind
- (null struct-name))
- :size ,(coerce-to-byte-size bit-size))
- ,@(remove nil (mapcar #'process-field fields))))))
-
-(define-processor struct ()
- (%process-struct-like -json-entry- :struct 'cffi:defcstruct '#:anon-struct-))
-
-(define-processor union ()
- (%process-struct-like -json-entry- :union 'cffi:defcunion '#:anon-union-))
-
-(define-processor typedef (name type)
- (expected-json-keys -json-entry- :tag :name :ns :type)
- `(cffi:defctype ,(json-name-to-cffi-name name :type)
- ,(json-type-to-cffi-type type `(:typedef ,name))))
-
-(define-processor function (return-type (function-name :name) parameters inline variadic storage-class)
- (declare (ignore storage-class))
- ;; TODO does storage-class matter for FFI accessibility?
- #+nil
- (assume (equal "extern" storage-class)
- "Unexpected function STORAGE-CLASS: ~S for function ~S" storage-class function-name)
- (expected-json-keys -json-entry- :tag :name :return-type :parameters :variadic :inline :storage-class :ns)
- (let ((uses-struct-by-value? nil))
- (flet ((process-arg (json-entry index)
- (expected-json-keys json-entry :tag :name :type)
- (with-json-values (json-entry tag (argument-name :name) type)
- (assert (equal tag "parameter"))
- (let* ((cffi-type (json-type-to-cffi-type type `(:function ,function-name ,argument-name)))
- (canonicalized-type (cffi::canonicalize-foreign-type cffi-type)))
- (when (and (consp canonicalized-type)
- (member (first canonicalized-type) '(:struct :union)))
- (setf uses-struct-by-value? t))
- `(,(if argument-name
- (json-name-to-cffi-name argument-name :argument)
- (symbolicate '#:arg (princ-to-string index)))
- ,cffi-type)))))
- (let ((cffi-args (loop
- :for arg :in parameters
- :for index :upfrom 1
- :collect (process-arg arg index))))
- (cond
- ((and uses-struct-by-value?
- (not *assume-struct-by-value-support*))
- (values))
- (inline
- ;; TODO inline functions should go into a separate grovel file?
- (output/string "~&;; Skipping inline function ~S" function-name)
- (values))
- (t `(cffi:defcfun (,function-name ,(json-name-to-cffi-name function-name :function))
- ,(json-type-to-cffi-type return-type `(:function ,function-name :return-type))
- ,@(append cffi-args
- (when variadic
- '(&rest))))))))))
-
-(define-processor extern (name type)
- (expected-json-keys -json-entry- :tag :name :type)
- `(cffi:defcvar (,name ,(json-name-to-cffi-name name :variable))
- ,(json-type-to-cffi-type type `(:variable ,name))))
-
-;; ((TAG . enum) (NS . 0) (NAME . ) (ID . 3) (LOCATION . /usr/include/bits/confname.h:24:1) (FIELDS ((TAG . field) (NAME . _PC_LINK_MAX) (VALUE . 0)) ((TAG . field) (NAME . _PC_MAX_CANON) (VALUE . 1)) ((TAG . field) (NAME . _PC_MAX_INPUT) (VALUE . 2)) ((TAG . field) (NAME . _PC_NAME_MAX) (VALUE . 3)) ((TAG . field) (NAME . _PC_PATH_MAX) (VALUE . 4)) ((TAG . field) (NAME . _PC_PIPE_BUF) (VALUE . 5)) ((TAG . field) (NAME . _PC_CHOWN_RESTRICTED) (VALUE . 6)) ((TAG . field) (NAME . _PC_NO_TRUNC) (VALUE . 7)) ((TAG . field) (NAME . _PC_VDISABLE) (VALUE . 8)) ((TAG . field) (NAME . _PC_SYNC_IO) (VALUE . 9)) ((TAG . field) (NAME . _PC_ASYNC_IO) (VALUE . 10)) ((TAG . field) (NAME . _PC_PRIO_IO) (VALUE . 11)) ((TAG . field) (NAME . _PC_SOCK_MAXBUF) (VALUE . 12)) ((TAG . field) (NAME . _PC_FILESIZEBITS) (VALUE . 13)) ((TAG . field) (NAME . _PC_REC_INCR_XFER_SIZE) (VALUE . 14)) ((TAG . field) (NAME . _PC_REC_MAX_XFER_SIZE) (VALUE . 15)) ((TAG . field) (NAME . _PC_REC_MIN_XFER_SIZE) (VALUE . 16)) ((TAG . field) (NAME . _PC_REC_XFER_ALIGN) (VALUE . 17)) ((TAG . field) (NAME . _PC_ALLOC_SIZE_MIN) (VALUE . 18)) ((TAG . field) (NAME . _PC_SYMLINK_MAX) (VALUE . 19)) ((TAG . field) (NAME . _PC_2_SYMLINKS) (VALUE . 20))))
-(define-processor enum (name fields id)
- (let ((bitmasks 0)
- (non-bitmasks 0))
- (labels
- ((for-bitmask-statistics (name value)
- (declare (ignore name))
- (if (cffi::single-bit-p value)
- (incf bitmasks)
- (incf non-bitmasks)))
- (for-enum-body (name value)
- `(,(json-name-to-cffi-name name :member)
- ,value))
- (process-fields (visitor)
- (loop
- :for json-entry :in fields
- :do (expected-json-keys json-entry :tag :name :value)
- :collect
- (with-json-values (json-entry tag name value)
- (assert (equal tag "field"))
- (check-type value integer)
- (funcall visitor name value)))))
- (process-fields #'for-bitmask-statistics)
- `(,(if (> (/ bitmasks
- (+ non-bitmasks bitmasks))
- 0.8)
- 'cffi:defbitfield
- 'cffi:defcenum)
- ,(json-name-to-cffi-name (or name
- (register-anon-entity
- id
- (generate-anon-name '#:anon-enum-)))
- :enum
- (null name))
- ,@(process-fields #'for-enum-body)))))
-
-(defun make-define-constant-form (name value)
- (valid-name-or-die name)
- (let ((test-fn (typecase value
- (number)
- (t 'equal))))
- `(alexandria:define-constant ,(json-name-to-cffi-name name :constant)
- ,value ,@(when test-fn `(:test ',test-fn)))))
-
-(define-processor const (name type (value :value :otherwise nil))
- (expected-json-keys -json-entry- :tag :name :type :value :ns)
- (let ((cffi-type (json-type-to-cffi-type type `(:contant ,name))))
- (cond
- ((not value)
- ;; #define __FOO_H and friends... just ignore them.
- (values))
- ((and (member cffi-type '(:int :unsigned-int
- :long :unsigned-long
- :long-long :unsigned-long-long))
- (integerp value))
- (make-define-constant-form name value))
- ((and (member cffi-type '(:float :double))
- (floatp value))
- (make-define-constant-form name value))
- ((member cffi-type '(:string (:pointer :char)) :test 'equal)
- (make-define-constant-form name value))
- (t
- (warn "Don't know how to emit a constant of CFFI type ~S, with value ~S (json type is ~S)." cffi-type value type)
- (values)))))
(DIR) diff --git a/3rdparties/software/cffi_0.20.0/src/c2ffi/package.lisp b/3rdparties/software/cffi_0.20.0/src/c2ffi/package.lisp
@@ -1,54 +0,0 @@
-;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
-;;;
-;;; Copyright (C) 2015, Attila Lendvai <attila@lendvai.name>
-;;;
-;;; Permission is hereby granted, free of charge, to any person
-;;; obtaining a copy of this software and associated documentation
-;;; files (the "Software"), to deal in the Software without
-;;; restriction, including without limitation the rights to use, copy,
-;;; modify, merge, publish, distribute, sublicense, and/or sell copies
-;;; of the Software, and to permit persons to whom the Software is
-;;; furnished to do so, subject to the following conditions:
-;;;
-;;; The above copyright notice and this permission notice shall be
-;;; included in all copies or substantial portions of the Software.
-;;;
-;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
-;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
-;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
-;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
-;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
-;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
-;;; DEALINGS IN THE SOFTWARE.
-;;;
-
-(uiop:define-package #:cffi/c2ffi
- (:mix #:uiop
- #:alexandria
- #:common-lisp)
- (:import-from :asdf
- #:cl-source-file
- #:find-system
- #:output-file
- #:output-files
- #:input-files
- #:perform
- #:compile-op
- #:load-op
- #:load-source-op
- #:prepare-op
- #:component-pathname
- #:component-depends-on
- #:downward-operation
- #:load-system
- #:component-loaded-p)
- (:export
- #:c2ffi-file
- #:camelcased?
- #:camelcase-to-dash-separated
- #:change-case-to-readtable-case
- #:default-ffi-name-transformer
- #:default-ffi-type-transformer
- #:generate-spec
- #:maybe-camelcase-to-dash-separated))
(DIR) diff --git a/3rdparties/software/cffi_0.20.0/src/cffi-abcl.lisp b/3rdparties/software/cffi_0.20.0/src/cffi-abcl.lisp
@@ -1,664 +0,0 @@
-;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
-;;;
-;;; cffi-abcl.lisp --- CFFI-SYS implementation for ABCL/JNA.
-;;;
-;;; Copyright (C) 2009, Luis Oliveira <loliveira@common-lisp.net>
-;;; Copyright (C) 2012, Mark Evenson <evenson.not.org@gmail.com>
-;;;
-;;; Permission is hereby granted, free of charge, to any person
-;;; obtaining a copy of this software and associated documentation
-;;; files (the "Software"), to deal in the Software without
-;;; restriction, including without limitation the rights to use, copy,
-;;; modify, merge, publish, distribute, sublicense, and/or sell copies
-;;; of the Software, and to permit persons to whom the Software is
-;;; furnished to do so, subject to the following conditions:
-;;;
-;;; The above copyright notice and this permission notice shall be
-;;; included in all copies or substantial portions of the Software.
-;;;
-;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
-;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
-;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
-;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
-;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
-;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
-;;; DEALINGS IN THE SOFTWARE.
-;;;
-
-;;; This implementation requires the Java Native Access (JNA) library.
-;;; <http://jna.dev.java.net/>
-;;;
-;;; JNA may be automatically loaded into the current JVM process from
-;;; abcl-1.1.0-dev via the contrib mechanism.
-
-(eval-when (:compile-toplevel :load-toplevel :execute)
- (require :abcl-contrib)
- (require :jna)
- (require :jss))
-
-;;; This is a preliminary version that will have to be cleaned up,
-;;; optimized, etc. Nevertheless, it passes all of the relevant CFFI
-;;; tests except MAKE-POINTER.HIGH. Shareable Vectors are not
-;;; implemented yet.
-
-;;;# Administrivia
-
-(defpackage #:cffi-sys
- (:use #:cl #:java)
- (:import-from #:alexandria #:hash-table-values #:length= #:format-symbol)
- (:export
- #:canonicalize-symbol-name-case
- #:foreign-pointer
- #:pointerp
- #:pointer-eq
- #:null-pointer
- #:null-pointer-p
- #:inc-pointer
- #:make-pointer
- #:pointer-address
- #:%foreign-alloc
- #:foreign-free
- #:with-foreign-pointer
- #:%foreign-funcall
- #:%foreign-funcall-pointer
- #:%foreign-type-alignment
- #:%foreign-type-size
- #:%load-foreign-library
- #:%close-foreign-library
- #:native-namestring
- #:%mem-ref
- #:%mem-set
- ;; #:make-shareable-byte-vector
- ;; #:with-pointer-to-vector-data
- #:%foreign-symbol-pointer
- #:%defcallback
- #:%callback
- #:with-pointer-to-vector-data
- #:make-shareable-byte-vector))
-
-(in-package #:cffi-sys)
-
-;;;# Loading and Closing Foreign Libraries
-
-(defparameter *loaded-libraries* (make-hash-table))
-
-(defun %load-foreign-library (name path)
- "Load a foreign library, signals a simple error on failure."
- (flet ((load-and-register (name path)
- (let ((lib (jstatic "getInstance" "com.sun.jna.NativeLibrary" path)))
- (setf (gethash name *loaded-libraries*) lib)
- lib))
- (foreign-library-type-p (type)
- (find type '("so" "dll" "dylib") :test #'string=))
- (java-error (e)
- (error (jcall (jmethod "java.lang.Exception" "getMessage")
- (java-exception-cause e)))))
- (handler-case
- (load-and-register name path)
- (java-exception (e)
- ;; From JNA http://jna.java.net/javadoc/com/sun/jna/NativeLibrary.html
- ;; ``[The name] can be short form (e.g. "c"), an explicit
- ;; version (e.g. "libc.so.6"), or the full path to the library
- ;; (e.g. "/lib/libc.so.6")''
- ;;
- ;; Try to deal with the occurance "libXXX" and "libXXX.so" as
- ;; "libXXX.so.6" and "XXX" should have succesfully loaded.
- (let ((p (pathname path)))
- (if (and (not (pathname-directory p))
- (= (search "lib" (pathname-name p)) 0))
- (let ((short-name (if (foreign-library-type-p (pathname-type p))
- (subseq (pathname-name p) 3)
- (pathname-name p))))
- (handler-case
- (load-and-register name short-name)
- (java-exception (e) (java-error e))))
- (java-error e)))))))
-
-;;; FIXME. Should remove libraries from the hash table.
-(defun %close-foreign-library (handle)
- "Closes a foreign library."
- #+#:ignore (setf *loaded-libraries* (remove handle *loaded-libraries*))
- (jcall-raw (jmethod "com.sun.jna.NativeLibrary" "dispose") handle))
-
-;;;
-
-;;; FIXME! We should probably define a private-jfield-accessor that does the hard work once!
-(let ((get-declared-fields-jmethod (jmethod "java.lang.Class" "getDeclaredFields")))
- (defun private-jfield (class-name field-name instance)
- (let ((field (find field-name
- (jcall get-declared-fields-jmethod
- (jclass class-name))
- :key #'jfield-name
- :test #'string=)))
- (jcall (jmethod "java.lang.reflect.Field" "setAccessible" "boolean")
- field +true+)
- (jcall (jmethod "java.lang.reflect.Field" "get" "java.lang.Object")
- field instance))))
-
-;;; XXX: doesn't match jmethod-arguments.
-
-(let ((get-declared-methods-jmethod (jmethod "java.lang.Class" "getDeclaredMethods")))
- (defun private-jmethod (class-name method-name)
- (let ((method (find method-name
- (jcall get-declared-methods-jmethod
- (jclass class-name))
- :key #'jmethod-name
- :test #'string=)))
- (jcall (jmethod "java.lang.reflect.Method" "setAccessible" "boolean")
- method +true+)
- method)))
-
-(let ((get-declared-constructors-jmethod (jmethod "java.lang.Class"
- "getDeclaredConstructors"))
- (set-accessible-jmethod (jmethod "java.lang.reflect.Constructor" "setAccessible" "boolean")))
- (defun private-jconstructor (class-name &rest params)
- (let* ((param-classes (mapcar #'jclass params))
- (cons (find-if (lambda (x &aux (cons-params (jconstructor-params x)))
- (and (length= param-classes cons-params)
- (loop for param in param-classes
- and param-x across cons-params
- always (string= (jclass-name param)
- (jclass-name param-x)))))
- (jcall get-declared-constructors-jmethod (jclass class-name)))))
- (jcall set-accessible-jmethod cons +true+)
- cons)))
-
-;;;# Symbol Case
-
-(defun canonicalize-symbol-name-case (name)
- (string-upcase name))
-
-;;;# Pointers
-
-(deftype foreign-pointer ()
- '(satisfies pointerp))
-
-(defun pointerp (ptr)
- "Return true if PTR is a foreign pointer."
- (let ((jclass (jclass-of ptr)))
- (when jclass
- (jclass-superclass-p (jclass "com.sun.jna.Pointer") jclass))))
-
-(let ((jconstructor (private-jconstructor "com.sun.jna.Pointer" "long")))
- (defun make-pointer (address)
- "Return a pointer pointing to ADDRESS."
- (jnew jconstructor address)))
-
-(defun make-private-jfield-accessor (class-name field-name)
- (let ((field (find field-name
- (jcall (jmethod "java.lang.Class" "getDeclaredFields")
- (jclass class-name))
- :key #'jfield-name
- :test #'string=)))
- (jcall (jmethod "java.lang.reflect.Field" "setAccessible" "boolean")
- field +true+)
- (let ((get-jmethod (jmethod "java.lang.reflect.Field" "get" "java.lang.Object")))
- (lambda (instance)
- (jcall get-jmethod field instance)))))
-
-(let ((accessor (make-private-jfield-accessor "com.sun.jna.Pointer" "peer")))
- (defun %pointer-address (pointer)
- (funcall accessor pointer)))
-
-(defun pointer-address (pointer)
- "Return the address pointed to by PTR."
- (let ((peer (%pointer-address pointer)))
- (if (< peer 0)
- (+ #.(ash 1 64) peer)
- peer)))
-
-(defun pointer-eq (ptr1 ptr2)
- "Return true if PTR1 and PTR2 point to the same address."
- (= (%pointer-address ptr1) (%pointer-address ptr2)))
-
-(defun null-pointer ()
- "Construct and return a null pointer."
- (make-pointer 0))
-
-(defun null-pointer-p (ptr)
- "Return true if PTR is a null pointer."
- (zerop (%pointer-address ptr)))
-
-(defun inc-pointer (ptr offset)
- "Return a fresh pointer pointing OFFSET bytes past PTR."
- (make-pointer (+ (%pointer-address ptr) offset)))
-
-;;;# Allocation
-
-(let ((malloc-jmethod (private-jmethod "com.sun.jna.Memory" "malloc")))
- (defun %foreign-alloc (size)
- "Allocate SIZE bytes on the heap and return a pointer."
- (make-pointer
- (jstatic-raw malloc-jmethod nil size))))
-
-(let ((free-jmethod (private-jmethod "com.sun.jna.Memory" "free")))
- (defun foreign-free (ptr)
- "Free a PTR allocated by FOREIGN-ALLOC."
- (jstatic-raw free-jmethod nil (%pointer-address ptr))
- nil))
-
-;;; TODO: stack allocation.
-(defmacro with-foreign-pointer ((var size &optional size-var) &body body)
- "Bind VAR to SIZE bytes of foreign memory during BODY. The pointer
-in VAR is invalid beyond the dynamic extent of BODY, and may be
-stack-allocated if supported by the implementation. If SIZE-VAR is
-supplied, it will be bound to SIZE during BODY."
- (unless size-var
- (setf size-var (gensym "SIZE")))
- `(let* ((,size-var ,size)
- (,var (%foreign-alloc ,size-var)))
- (unwind-protect
- (progn ,@body)
- (foreign-free ,var))))
-
-;;;# Shareable Vectors
-;;;
-;;; This interface is very experimental. WITH-POINTER-TO-VECTOR-DATA
-;;; should be defined to perform a copy-in/copy-out if the Lisp
-;;; implementation can't do this.
-
-(defun jna-setter (type)
- (ecase type
- ((:char :unsigned-char) "setByte")
- (:double "setDouble")
- (:float "setFloat")
- ((:int :unsigned-int) "setInt")
- ((:long :unsigned-long) "setNativeLong")
- ((:long-long :unsigned-long-long) "setLong")
- (:pointer "setPointer")
- ((:short :unsigned-short) "setShort")))
-
-(defun jna-setter-arg-type (type)
- (ecase type
- ((:char :unsigned-char) "byte")
- (:double "double")
- (:float "float")
- ((:int :unsigned-int) "int")
- ((:long :unsigned-long) "com.sun.jna.NativeLong")
- ((:long-long :unsigned-long-long) "long")
- (:pointer "com.sun.jna.Pointer")
- ((:short :unsigned-short) "short")))
-
-(defun jna-getter (type)
- (ecase type
- ((:char :unsigned-char) "getByte")
- (:double "getDouble")
- (:float "getFloat")
- ((:int :unsigned-int) "getInt")
- ((:long :unsigned-long) "getNativeLong")
- ((:long-long :unsigned-long-long) "getLong")
- (:pointer "getPointer")
- ((:short :unsigned-short) "getShort")))
-
-(defun make-shareable-byte-vector (size)
- "Create a Lisp vector of SIZE bytes can passed to
-WITH-POINTER-TO-VECTOR-DATA."
- (make-array size :element-type '(unsigned-byte 8)))
-
-(let ((method (jmethod "com.sun.jna.Pointer"
- (jna-setter :char) "long" (jna-setter-arg-type :char))))
- (defun copy-to-foreign-vector (vector foreign-pointer)
- (loop for i below (length vector)
- do
- (jcall-raw method
- foreign-pointer i
- (aref vector i)))))
-
-;; hand-roll the jna-getter method instead of calling %mem-ref every time through
-(let ((method (jmethod "com.sun.jna.Pointer" (jna-getter :char) "long")))
- (defun copy-from-foreign-vector (vector foreign-pointer)
- (loop for i below (length vector)
- do (setf (aref vector i)
- (java:jobject-lisp-value (jcall-raw method foreign-pointer i))))))
-
-(defmacro with-pointer-to-vector-data ((ptr-var vector) &body body)
- "Bind PTR-VAR to a foreign pointer to the data in VECTOR."
- (let ((vector-sym (gensym "VECTOR")))
- `(let ((,vector-sym ,vector))
- (with-foreign-pointer (,ptr-var (length ,vector-sym))
- (copy-to-foreign-vector ,vector-sym ,ptr-var)
- (unwind-protect
- (progn ,@body)
- (copy-from-foreign-vector ,vector-sym ,ptr-var))))))
-
-;;;# Dereferencing
-
-(defun foreign-type-to-java-class (type)
- (jclass
- (ecase type
- ((:int :unsigned-int) "java.lang.Integer")
- ((:long :unsigned-long) "com.sun.jna.NativeLong")
- ((:long-long :unsigned-long-long) "java.lang.Long")
- (:pointer "com.sun.jna.Pointer") ;; void * is pointer?
- (:float "java.lang.Float")
- (:double "java.lang.Double")
- ((:char :unsigned-char) "java.lang.Byte")
- ((:short :unsigned-short) "java.lang.Short"))))
-
-(defun %foreign-type-size (type)
- "Return the size in bytes of a foreign type."
- (jstatic "getNativeSize" "com.sun.jna.Native"
- (foreign-type-to-java-class type)))
-
-;;; FIXME.
-(defun %foreign-type-alignment (type)
- "Return the alignment in bytes of a foreign type."
- (%foreign-type-size type))
-
-(defun unsigned-type-p (type)
- (case type
- ((:unsigned-char
- :unsigned-int
- :unsigned-short
- :unsigned-long
- :unsigned-long-long) t)
- (t nil)))
-
-(defun lispify-value (value type)
- (when (and (eq type :pointer) (or (null (java:jobject-lisp-value value))
- (eq +null+ (java:jobject-lisp-value value))))
- (return-from lispify-value (null-pointer)))
- (when (or (eq type :long) (eq type :unsigned-long))
- (setq value (jcall-raw (jmethod "com.sun.jna.NativeLong" "longValue")
- (java:jobject-lisp-value value))))
- (let ((bit-size (* 8 (%foreign-type-size type))))
- (let ((lisp-value (java:jobject-lisp-value value)))
- (if (and (unsigned-type-p type)
- (logbitp (1- bit-size) lisp-value))
- (lognot (logxor lisp-value (1- (expt 2 bit-size))))
- lisp-value))))
-
-(defun %mem-ref (ptr type &optional (offset 0))
- (lispify-value
- (jcall-raw (jmethod "com.sun.jna.Pointer" (jna-getter type) "long")
- ptr offset)
- type))
-
-(defun %mem-set (value ptr type &optional (offset 0))
- (let* ((bit-size (* 8 (%foreign-type-size type)))
- (val (if (and (unsigned-type-p type) (logbitp (1- bit-size) value))
- (lognot (logxor value (1- (expt 2 bit-size))))
- value)))
- (jcall-raw (jmethod "com.sun.jna.Pointer"
- (jna-setter type) "long" (jna-setter-arg-type type))
- ptr
- offset
- (if (or (eq type :long) (eq type :unsigned-long))
- (jnew (jconstructor "com.sun.jna.NativeLong" "long") val)
- val)))
- value)
-
-;;;# Foreign Globals
-(let ((get-symbol-address-jmethod (private-jmethod "com.sun.jna.NativeLibrary" "getSymbolAddress")))
- (defun %foreign-symbol-pointer (name library)
- "Returns a pointer to a foreign symbol NAME."
- (flet ((find-it (library)
- (ignore-errors
- (make-pointer
- (jcall-raw get-symbol-address-jmethod library name)))))
- (if (eq library :default)
- (or (find-it
- (jstatic "getProcess" "com.sun.jna.NativeLibrary"))
- ;; The above should find it, but I'm not exactly sure, so
- ;; let's still do it manually just in case.
- (loop for lib being the hash-values of *loaded-libraries*
- thereis (find-it lib)))
- (find-it library)))))
-
-;;;# Calling Foreign Functions
-
-(defun find-foreign-function (name library)
- (flet ((find-it (library)
- (ignore-errors
- (jcall-raw (jmethod "com.sun.jna.NativeLibrary" "getFunction"
- "java.lang.String")
- library name))))
- (if (eq library :default)
- (or (find-it
- (jstatic "getProcess" "com.sun.jna.NativeLibrary"))
- ;; The above should find it, but I'm not exactly sure, so
- ;; let's still do it manually just in case.
- (loop for lib being the hash-values of *loaded-libraries*
- thereis (find-it lib)))
- (find-it (gethash library *loaded-libraries*)))))
-
-(defun convert-calling-convention (convention)
- (ecase convention
- (:stdcall "ALT_CONVENTION")
- (:cdecl "C_CONVENTION")))
-
-(defparameter *jna-string-encoding* "UTF-8"
- "Encoding for conversion between Java and native strings that occurs within JNA.
-
-Used with jna-4.0.0 or later.")
-
-;;; c.f. <http://twall.github.io/jna/4.0/javadoc/com/sun/jna/Function.html#Function%28com.sun.jna.Pointer,%20int,%20java.lang.String%29>
-(defvar *jna-4.0.0-or-later-p*
- (ignore-errors (private-jconstructor "com.sun.jna.Function"
- "com.sun.jna.Pointer" "int" "java.lang.String")))
-
-(let ((jconstructor
- (if *jna-4.0.0-or-later-p*
- (private-jconstructor "com.sun.jna.Function"
- "com.sun.jna.Pointer" "int" "java.lang.String")
- (private-jconstructor "com.sun.jna.Function"
- "com.sun.jna.Pointer" "int"))))
- (defun make-function-pointer (pointer convention)
- (apply
- #'jnew jconstructor pointer
- (jfield "com.sun.jna.Function" (convert-calling-convention convention))
- (when *jna-4.0.0-or-later-p*
- (list *jna-string-encoding*)))))
-
-(defun lisp-value-to-java (value foreign-type)
- (case foreign-type
- (:pointer value)
- (:void nil)
- (t (jnew (ecase foreign-type
- ((:int :unsigned-int) (jconstructor "java.lang.Integer" "int"))
- ((:long-long :unsigned-long-long)
- (jconstructor "java.lang.Long" "long"))
- ((:long :unsigned-long)
- (jconstructor "com.sun.jna.NativeLong" "long"))
- ((:short :unsigned-short) (jconstructor "java.lang.Short" "short"))
- ((:char :unsigned-char) (jconstructor "java.lang.Byte" "byte"))
- (:float (jconstructor "java.lang.Float" "float"))
- (:double (jconstructor "java.lang.Double" "double")))
- value))))
-
-(defun %%foreign-funcall (function args arg-types return-type)
- (let ((jargs (jnew-array "java.lang.Object" (length args))))
- (loop for arg in args and type in arg-types and i from 0
- do (setf (jarray-ref jargs i)
- (lisp-value-to-java arg type)))
- (if (eq return-type :void)
- (progn
- (jcall-raw (jmethod "com.sun.jna.Function" "invoke" "[Ljava.lang.Object;")
- function jargs)
- (values))
- (lispify-value
- (jcall-raw (jmethod "com.sun.jna.Function" "invoke"
- "java.lang.Class" "[Ljava.lang.Object;")
- function
- (foreign-type-to-java-class return-type)
- jargs)
- return-type))))
-
-(defun foreign-funcall-type-and-args (args)
- (let ((return-type :void))
- (loop for (type arg) on args by #'cddr
- if arg collect type into types
- and collect arg into fargs
- else do (setf return-type type)
- finally (return (values types fargs return-type)))))
-
-(defmacro %foreign-funcall (name args &key library convention)
- (declare (ignore convention))
- (multiple-value-bind (types fargs rettype)
- (foreign-funcall-type-and-args args)
- `(%%foreign-funcall (find-foreign-function ',name ',library)
- (list ,@fargs) ',types ',rettype)))
-
-(defmacro %foreign-funcall-pointer (ptr args &key convention)
- (multiple-value-bind (types fargs rettype)
- (foreign-funcall-type-and-args args)
- `(%%foreign-funcall (make-function-pointer ,ptr ',convention)
- (list ,@fargs) ',types ',rettype)))
-
-;;;# Callbacks
-
-(defun foreign-to-callback-type (type)
- (ecase type
- ((:int :unsigned-int)
- :int)
- ((:long :unsigned-long)
- (jvm::make-jvm-class-name "com.sun.jna.NativeLong"))
- ((:long-long :unsigned-long-long)
- (jvm::make-jvm-class-name "java.lang.Long"))
- (:pointer
- (jvm::make-jvm-class-name "com.sun.jna.Pointer"))
- (:float
- :float)
- (:double
- :double)
- ((:char :unsigned-char)
- :byte)
- ((:short :unsigned-short)
- :short)
- (:wchar_t
- :int)
- (:void
- :void)))
-
-(defvar *callbacks* (make-hash-table))
-
-(defmacro convert-args-to-lisp-values (arg-names arg-types &body body)
- (let ((gensym-args (loop for name in arg-names
- collect (format-symbol t '#:callback-arg-~a- name))))
- `(lambda (,@gensym-args)
- (let ,(loop for arg in arg-names
- for type in arg-types
- for gensym-arg in gensym-args
- collecting `(,arg (if (typep ,gensym-arg 'java:java-object)
- (lispify-value ,gensym-arg ,type)
- ,gensym-arg)))
- ,@body))))
-
-(defmacro %defcallback (name return-type arg-names arg-types body
- &key convention)
- (declare (ignore convention)) ;; I'm always up for ignoring convention, but this is probably wrong.
- `(setf (gethash ',name *callbacks*)
- (jinterface-implementation
- (ensure-callback-interface ',return-type ',arg-types)
- "callback"
- (convert-args-to-lisp-values ,arg-names ,arg-types (lisp-value-to-java ,body ',return-type)))))
-;; (lambda (,@arg-names) ,body))))
-
-(jvm::define-class-name +callback-object+ "com.sun.jna.Callback")
-(defconstant
- +dynamic-callback-package+
- "org/armedbear/jna/dynamic/callbacks"
- "The slash-delimited Java package in which we create classes dynamically to specify callback interfaces.")
-
-(defun ensure-callback-interface (returns args)
- "Ensure that the jvm interface for the callback exists in the current JVM.
-
-Returns the fully dot qualified name of the interface."
- (let* ((jvm-returns (foreign-to-callback-type returns))
- (jvm-args (mapcar #'foreign-to-callback-type args))
- (interface-name (qualified-callback-interface-classname jvm-returns jvm-args)))
- (handler-case
- (jss:find-java-class interface-name)
- (java-exception (e)
- (when (jinstance-of-p (java:java-exception-cause e)
- "java.lang.ClassNotFoundException")
- (let ((interface-class-bytes (%define-jna-callback-interface jvm-returns jvm-args))
- (simple-interface-name (callback-interface-classname jvm-returns jvm-args)))
- (load-class interface-name interface-class-bytes)))))
- interface-name))
-
-(defun qualified-callback-interface-classname (returns args)
- (format nil "~A.~A"
- (substitute #\. #\/ +dynamic-callback-package+)
- (callback-interface-classname returns args)))
-
-(defun callback-interface-classname (returns args)
- (flet ((stringify (thing)
- (typecase thing
- (jvm::jvm-class-name
- (substitute #\_ #\/
- (jvm::class-name-internal thing)))
- (t (string thing)))))
- (format nil "~A__~{~A~^__~}"
- (stringify returns)
- (mapcar #'stringify args))))
-
-(defun %define-jna-callback-interface (returns args)
- "Returns the Java byte[] array of a class representing a Java
- interface descending form +CALLBACK-OBJECT+ which contains the
- single function 'callback' which takes ARGS returning RETURNS.
-
-The fully qualified dotted name of the generated class is returned as
-the second value."
- (let ((name (callback-interface-classname returns args)))
- (values
- (define-java-interface name +dynamic-callback-package+
- `(("callback" ,returns ,args))
- `(,+callback-object+))
- (qualified-callback-interface-classname returns args))))
-
-(defun define-java-interface (name package methods
- &optional (superinterfaces nil))
-"Returns the bytes of the Java class interface called NAME in PACKAGE with METHODS.
-
-METHODS is a list of (NAME RETURN-TYPE (ARG-TYPES)) entries. NAME is
-a string. The values of RETURN-TYPE and the list of ARG-TYPES for the
-defined method follow the are either references to Java objects as
-created by JVM::MAKE-JVM-CLASS-NAME, or keywords representing Java
-primtive types as contained in JVM::MAP-PRIMITIVE-TYPE.
-
-SUPERINTERFACES optionally contains a list of interfaces that this
-interface extends specified as fully qualifed dotted Java names."
- (let* ((class-name-string (format nil "~A/~A" package name))
- (class-name (jvm::make-jvm-class-name class-name-string))
- (class (jvm::make-class-interface-file class-name)))
- (dolist (superinterface superinterfaces)
- (jvm::class-add-superinterface
- class
- (if (typep superinterface 'jvm::jvm-class-name)
- superinterface
- (jvm::make-jvm-class-name superinterface))))
- (dolist (method methods)
- (let ((name (first method))
- (returns (second method))
- (args (third method)))
- (jvm::class-add-method
- class
- (jvm::make-jvm-method name returns args
- :flags '(:public :abstract)))))
- (jvm::finalize-class-file class)
- (let ((s (sys::%make-byte-array-output-stream)))
- (jvm::write-class-file class s)
- (sys::%get-output-stream-bytes s))))
-
-(defun load-class (name bytes)
- "Load the byte[] array BYTES as a Java class called NAME."
- (#"loadClassFromByteArray" java::*classloader* name bytes))
-
-;;; Test function: unused in CFFI
-(defun write-class (class-bytes pathname)
- "Write the Java byte[] array CLASS-BYTES to PATHNAME."
- (with-open-file (stream pathname
- :direction :output
- :element-type '(signed-byte 8))
- (dotimes (i (jarray-length class-bytes))
- (write-byte (jarray-ref class-bytes i) stream))))
-
-(defun %callback (name)
- (or (#"getFunctionPointer" 'com.sun.jna.CallbackReference
- (gethash name *callbacks*))
- (error "Undefined callback: ~S" name)))
-
-(defun native-namestring (pathname)
- (namestring pathname))
(DIR) diff --git a/3rdparties/software/cffi_0.20.0/src/cffi-allegro.lisp b/3rdparties/software/cffi_0.20.0/src/cffi-allegro.lisp
@@ -1,446 +0,0 @@
-;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
-;;;
-;;; cffi-allegro.lisp --- CFFI-SYS implementation for Allegro CL.
-;;;
-;;; Copyright (C) 2005-2009, Luis Oliveira <loliveira(@)common-lisp.net>
-;;;
-;;; Permission is hereby granted, free of charge, to any person
-;;; obtaining a copy of this software and associated documentation
-;;; files (the "Software"), to deal in the Software without
-;;; restriction, including without limitation the rights to use, copy,
-;;; modify, merge, publish, distribute, sublicense, and/or sell copies
-;;; of the Software, and to permit persons to whom the Software is
-;;; furnished to do so, subject to the following conditions:
-;;;
-;;; The above copyright notice and this permission notice shall be
-;;; included in all copies or substantial portions of the Software.
-;;;
-;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
-;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
-;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
-;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
-;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
-;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
-;;; DEALINGS IN THE SOFTWARE.
-;;;
-
-;;;# Administrivia
-
-(defpackage #:cffi-sys
- (:use #:common-lisp)
- (:import-from #:alexandria #:if-let #:with-unique-names #:once-only)
- (:export
- #:canonicalize-symbol-name-case
- #:foreign-pointer
- #:pointerp
- #:pointer-eq
- #:null-pointer
- #:null-pointer-p
- #:inc-pointer
- #:make-pointer
- #:pointer-address
- #:%foreign-alloc
- #:foreign-free
- #:with-foreign-pointer
- #:%foreign-funcall
- #:%foreign-funcall-pointer
- #:%foreign-type-alignment
- #:%foreign-type-size
- #:%load-foreign-library
- #:%close-foreign-library
- #:native-namestring
- #:%mem-ref
- #:%mem-set
- #:make-shareable-byte-vector
- #:with-pointer-to-vector-data
- #:%foreign-symbol-pointer
- #:defcfun-helper-forms
- #:%defcallback
- #:%callback))
-
-(in-package #:cffi-sys)
-
-;;;# Mis-features
-
-#-64bit (pushnew 'no-long-long *features*)
-(pushnew 'flat-namespace *features*)
-
-;;;# Symbol Case
-
-(defun canonicalize-symbol-name-case (name)
- (declare (string name))
- (if (eq excl:*current-case-mode* :case-sensitive-lower)
- (string-downcase name)
- (string-upcase name)))
-
-;;;# Basic Pointer Operations
-
-(deftype foreign-pointer ()
- 'ff:foreign-address)
-
-(defun pointerp (ptr)
- "Return true if PTR is a foreign pointer."
- (ff:foreign-address-p ptr))
-
-(defun pointer-eq (ptr1 ptr2)
- "Return true if PTR1 and PTR2 point to the same address."
- (eql ptr1 ptr2))
-
-(defun null-pointer ()
- "Return a null pointer."
- 0)
-
-(defun null-pointer-p (ptr)
- "Return true if PTR is a null pointer."
- (zerop ptr))
-
-(defun inc-pointer (ptr offset)
- "Return a pointer pointing OFFSET bytes past PTR."
- (+ ptr offset))
-
-(defun make-pointer (address)
- "Return a pointer pointing to ADDRESS."
- (check-type address ff:foreign-address)
- address)
-
-(defun pointer-address (ptr)
- "Return the address pointed to by PTR."
- (check-type ptr ff:foreign-address)
- ptr)
-
-;;;# Allocation
-;;;
-;;; Functions and macros for allocating foreign memory on the stack
-;;; and on the heap. The main CFFI package defines macros that wrap
-;;; FOREIGN-ALLOC and FOREIGN-FREE in UNWIND-PROTECT for the common usage
-;;; when the memory has dynamic extent.
-
-(defun %foreign-alloc (size)
- "Allocate SIZE bytes on the heap and return a pointer."
- (ff:allocate-fobject :char :c size))
-
-(defun foreign-free (ptr)
- "Free a PTR allocated by FOREIGN-ALLOC."
- (ff:free-fobject ptr))
-
-(defmacro with-foreign-pointer ((var size &optional size-var) &body body)
- "Bind VAR to SIZE bytes of foreign memory during BODY. The
-pointer in VAR is invalid beyond the dynamic extent of BODY, and
-may be stack-allocated if supported by the implementation. If
-SIZE-VAR is supplied, it will be bound to SIZE during BODY."
- (unless size-var
- (setf size-var (gensym "SIZE")))
- #+(version>= 8 1)
- (when (and (constantp size) (<= (eval size) ff:*max-stack-fobject-bytes*))
- (return-from with-foreign-pointer
- `(let ((,size-var ,(eval size)))
- (declare (ignorable ,size-var))
- (ff:with-static-fobject (,var '(:array :char ,(eval size))
- :allocation :foreign-static-gc)
- ;; (excl::stack-allocated-p var) => T
- (let ((,var (ff:fslot-address ,var)))
- ,@body)))))
- `(let* ((,size-var ,size)
- (,var (ff:allocate-fobject :char :c ,size-var)))
- (unwind-protect
- (progn ,@body)
- (ff:free-fobject ,var))))
-
-;;;# Shareable Vectors
-;;;
-;;; This interface is very experimental. WITH-POINTER-TO-VECTOR-DATA
-;;; should be defined to perform a copy-in/copy-out if the Lisp
-;;; implementation can't do this.
-
-(defun make-shareable-byte-vector (size)
- "Create a Lisp vector of SIZE bytes can passed to
-WITH-POINTER-TO-VECTOR-DATA."
- (make-array size :element-type '(unsigned-byte 8)
- :allocation :static-reclaimable))
-
-(defmacro with-pointer-to-vector-data ((ptr-var vector) &body body)
- "Bind PTR-VAR to a foreign pointer to the data in VECTOR."
- ;; An array allocated in static-reclamable is a non-simple array in
- ;; the normal Lisp allocation area, pointing to a simple array in
- ;; the static-reclaimable allocation area. Therefore we have to get
- ;; out the simple-array to find the pointer to the actual contents.
- (with-unique-names (simple-vec)
- `(excl:with-underlying-simple-vector (,vector ,simple-vec)
- (let ((,ptr-var (ff:fslot-address-typed :unsigned-char :lisp
- ,simple-vec)))
- ,@body))))
-
-;;;# Dereferencing
-
-(defun convert-foreign-type (type-keyword)
- "Convert a CFFI type keyword to an Allegro type."
- (ecase type-keyword
- (:char :char)
- (:unsigned-char :unsigned-char)
- (:short :short)
- (:unsigned-short :unsigned-short)
- (:int :int)
- (:unsigned-int :unsigned-int)
- (:long :long)
- (:unsigned-long :unsigned-long)
- (:long-long
- #+64bit :nat
- #-64bit (error "this platform does not support :long-long."))
- (:unsigned-long-long
- #+64bit :unsigned-nat
- #-64bit (error "this platform does not support :unsigned-long-long"))
- (:float :float)
- (:double :double)
- (:pointer :unsigned-nat)
- (:void :void)))
-
-(defun %mem-ref (ptr type &optional (offset 0))
- "Dereference an object of TYPE at OFFSET bytes from PTR."
- (unless (zerop offset)
- (setf ptr (inc-pointer ptr offset)))
- (ff:fslot-value-typed (convert-foreign-type type) :c ptr))
-
-;;; Compiler macro to open-code the call to FSLOT-VALUE-TYPED when the
-;;; CFFI type is constant. Allegro does its own transformation on the
-;;; call that results in efficient code.
-(define-compiler-macro %mem-ref (&whole form ptr type &optional (off 0))
- (if (constantp type)
- (let ((ptr-form (if (eql off 0) ptr `(+ ,ptr ,off))))
- `(ff:fslot-value-typed ',(convert-foreign-type (eval type))
- :c ,ptr-form))
- form))
-
-(defun %mem-set (value ptr type &optional (offset 0))
- "Set the object of TYPE at OFFSET bytes from PTR."
- (unless (zerop offset)
- (setf ptr (inc-pointer ptr offset)))
- (setf (ff:fslot-value-typed (convert-foreign-type type) :c ptr) value))
-
-;;; Compiler macro to open-code the call to (SETF FSLOT-VALUE-TYPED)
-;;; when the CFFI type is constant. Allegro does its own
-;;; transformation on the call that results in efficient code.
-(define-compiler-macro %mem-set (&whole form val ptr type &optional (off 0))
- (if (constantp type)
- (once-only (val)
- (let ((ptr-form (if (eql off 0) ptr `(+ ,ptr ,off))))
- `(setf (ff:fslot-value-typed ',(convert-foreign-type (eval type))
- :c ,ptr-form) ,val)))
- form))
-
-;;;# Calling Foreign Functions
-
-(defun %foreign-type-size (type-keyword)
- "Return the size in bytes of a foreign type."
- (ff:sizeof-fobject (convert-foreign-type type-keyword)))
-
-(defun %foreign-type-alignment (type-keyword)
- "Returns the alignment in bytes of a foreign type."
- #+(and powerpc macosx32)
- (when (eq type-keyword :double)
- (return-from %foreign-type-alignment 8))
- ;; No override necessary for the remaining types....
- (ff::sized-ftype-prim-align
- (ff::iforeign-type-sftype
- (ff:get-foreign-type
- (convert-foreign-type type-keyword)))))
-
-(defun foreign-funcall-type-and-args (args)
- "Returns a list of types, list of args and return type."
- (let ((return-type :void))
- (loop for (type arg) on args by #'cddr
- if arg collect type into types
- and collect arg into fargs
- else do (setf return-type type)
- finally (return (values types fargs return-type)))))
-
-(defun convert-to-lisp-type (type)
- (ecase type
- ((:char :short :int :long :nat)
- `(signed-byte ,(* 8 (ff:sizeof-fobject type))))
- ((:unsigned-char :unsigned-short :unsigned-int :unsigned-long :unsigned-nat)
- `(unsigned-byte ,(* 8 (ff:sizeof-fobject type))))
- (:float 'single-float)
- (:double 'double-float)
- (:void 'null)))
-
-(defun allegro-type-pair (cffi-type)
- ;; the :FOREIGN-ADDRESS pseudo-type accepts both pointers and
- ;; arrays. We need the latter for shareable byte vector support.
- (if (eq cffi-type :pointer)
- (list :foreign-address)
- (let ((ftype (convert-foreign-type cffi-type)))
- (list ftype (convert-to-lisp-type ftype)))))
-
-#+ignore
-(defun note-named-foreign-function (symbol name types rettype)
- "Give Allegro's compiler a hint to perform a direct call."
- `(eval-when (:compile-toplevel :load-toplevel :execute)
- (setf (get ',symbol 'system::direct-ff-call)
- (list '(,name :language :c)
- t ; callback
- :c ; convention
- ;; return type '(:c-type lisp-type)
- ',(allegro-type-pair rettype)
- ;; arg types '({(:c-type lisp-type)}*)
- '(,@(mapcar #'allegro-type-pair types))
- nil ; arg-checking
- ff::ep-flag-never-release))))
-
-(defmacro %foreign-funcall (name args &key convention library)
- (declare (ignore convention library))
- (multiple-value-bind (types fargs rettype)
- (foreign-funcall-type-and-args args)
- `(system::ff-funcall
- (load-time-value (excl::determine-foreign-address
- '(,name :language :c)
- #-(version>= 8 1) ff::ep-flag-never-release
- #+(version>= 8 1) ff::ep-flag-always-release
- nil ; method-index
- ))
- ;; arg types {'(:c-type lisp-type) argN}*
- ,@(mapcan (lambda (type arg)
- `(',(allegro-type-pair type) ,arg))
- types fargs)
- ;; return type '(:c-type lisp-type)
- ',(allegro-type-pair rettype))))
-
-(defun defcfun-helper-forms (name lisp-name rettype args types options)
- "Return 2 values for DEFCFUN. A prelude form and a caller form."
- (declare (ignore options))
- (let ((ff-name (intern (format nil "%cffi-foreign-function/~A" lisp-name))))
- (values
- `(ff:def-foreign-call (,ff-name ,name)
- ,(loop for type in types
- collect (list* (gensym) (allegro-type-pair type)))
- :returning ,(allegro-type-pair rettype)
- ;; Don't use call-direct when there are no arguments.
- ,@(unless (null args) '(:call-direct t))
- :arg-checking nil
- :strings-convert nil
- #+(version>= 8 1) ,@'(:release-heap :when-ok
- :release-heap-ignorable t)
- #+smp ,@'(:release-heap-implies-allow-gc t))
- `(,ff-name ,@args))))
-
-;;; See doc/allegro-internals.txt for a clue about entry-vec.
-(defmacro %foreign-funcall-pointer (ptr args &key convention)
- (declare (ignore convention))
- (multiple-value-bind (types fargs rettype)
- (foreign-funcall-type-and-args args)
- (with-unique-names (entry-vec)
- `(let ((,entry-vec (excl::make-entry-vec-boa)))
- (setf (aref ,entry-vec 1) ,ptr) ; set jump address
- (system::ff-funcall
- ,entry-vec
- ;; arg types {'(:c-type lisp-type) argN}*
- ,@(mapcan (lambda (type arg)
- `(',(allegro-type-pair type) ,arg))
- types fargs)
- ;; return type '(:c-type lisp-type)
- ',(allegro-type-pair rettype))))))
-
-;;;# Callbacks
-
-;;; The *CALLBACKS* hash table contains information about a callback
-;;; for the Allegro FFI. The key is the name of the CFFI callback,
-;;; and the value is a cons, the car containing the symbol the
-;;; callback was defined on in the CFFI-CALLBACKS package, the cdr
-;;; being an Allegro FFI pointer (a fixnum) that can be passed to C
-;;; functions.
-;;;
-;;; These pointers must be restored when a saved Lisp image is loaded.
-;;; The RESTORE-CALLBACKS function is added to *RESTART-ACTIONS* to
-;;; re-register the callbacks during Lisp startup.
-(defvar *callbacks* (make-hash-table))
-
-;;; Register a callback in the *CALLBACKS* hash table.
-(defun register-callback (cffi-name callback-name)
- (setf (gethash cffi-name *callbacks*)
- (cons callback-name (ff:register-foreign-callable
- callback-name :reuse t))))
-
-;;; Restore the saved pointers in *CALLBACKS* when loading an image.
-(defun restore-callbacks ()
- (maphash (lambda (key value)
- (register-callback key (car value)))
- *callbacks*))
-
-;;; Arrange for RESTORE-CALLBACKS to run when a saved image containing
-;;; CFFI is restarted.
-(eval-when (:load-toplevel :execute)
- (pushnew 'restore-callbacks excl:*restart-actions*))
-
-;;; Create a package to contain the symbols for callback functions.
-(defpackage #:cffi-callbacks
- (:use))
-
-(defun intern-callback (name)
- (intern (format nil "~A::~A"
- (if-let (package (symbol-package name))
- (package-name package)
- "#")
- (symbol-name name))
- '#:cffi-callbacks))
-
-(defun convert-calling-convention (convention)
- (ecase convention
- (:cdecl :c)
- (:stdcall :stdcall)))
-
-(defmacro %defcallback (name rettype arg-names arg-types body
- &key convention)
- (declare (ignore rettype))
- (let ((cb-name (intern-callback name)))
- `(progn
- (ff:defun-foreign-callable ,cb-name
- ,(mapcar (lambda (sym type) (list sym (convert-foreign-type type)))
- arg-names arg-types)
- (declare (:convention ,(convert-calling-convention convention)))
- ,body)
- (register-callback ',name ',cb-name))))
-
-;;; Return the saved Lisp callback pointer from *CALLBACKS* for the
-;;; CFFI callback named NAME.
-(defun %callback (name)
- (or (cdr (gethash name *callbacks*))
- (error "Undefined callback: ~S" name)))
-
-;;;# Loading and Closing Foreign Libraries
-
-(defun %load-foreign-library (name path)
- "Load a foreign library."
- ;; ACL 8.0 honors the :FOREIGN option and always tries to foreign load
- ;; the argument. However, previous versions do not and will only
- ;; foreign load the argument if its type is a member of the
- ;; EXCL::*LOAD-FOREIGN-TYPES* list. Therefore, we bind that special
- ;; to a list containing whatever type NAME has.
- (declare (ignore name))
- (let ((excl::*load-foreign-types*
- (list (pathname-type (parse-namestring path)))))
- (handler-case
- (progn
- #+(version>= 7) (load path :foreign t)
- #-(version>= 7) (load path))
- (file-error (fe)
- (error (change-class fe 'simple-error))))
- path))
-
-(defun %close-foreign-library (name)
- "Close the foreign library NAME."
- (ff:unload-foreign-library name))
-
-(defun native-namestring (pathname)
- (namestring pathname))
-
-;;;# Foreign Globals
-
-(defun convert-external-name (name)
- "Add an underscore to NAME if necessary for the ABI."
- #+macosx (concatenate 'string "_" name)
- #-macosx name)
-
-(defun %foreign-symbol-pointer (name library)
- "Returns a pointer to a foreign symbol NAME."
- (declare (ignore library))
- (prog1 (ff:get-entry-point (convert-external-name name))))
(DIR) diff --git a/3rdparties/software/cffi_0.20.0/src/cffi-clasp.lisp b/3rdparties/software/cffi_0.20.0/src/cffi-clasp.lisp
@@ -1,201 +0,0 @@
-;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
-;;;
-;;; cffi-clasp.lisp --- CFFI-SYS implementation for Clasp.
-;;;
-;;; Copyright (C) 2017 Frank Goenninger <frank.goenninger@goenninger.net>
-;;;
-;;; Permission is hereby granted, free of charge, to any person
-;;; obtaining a copy of this software and associated documentation
-;;; files (the "Software"), to deal in the Software without
-;;; restriction, including without limitation the rights to use, copy,
-;;; modify, merge, publish, distribute, sublicense, and/or sell copies
-;;; of the Software, and to permit persons to whom the Software is
-;;; furnished to do so, subject to the following conditions:
-;;;
-;;; The above copyright notice and this permission notice shall be
-;;; included in all copies or substantial portions of the Software.
-;;;
-;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
-;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
-;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
-;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
-;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
-;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
-;;; DEALINGS IN THE SOFTWARE.
-;;;
-
-;;;# Administrivia
-
-(defpackage #:cffi-sys
- (:use #:common-lisp #:alexandria)
- (:export
- #:canonicalize-symbol-name-case
- #:foreign-pointer
- #:pointerp
- #:pointer-eq
- #:%foreign-alloc
- #:foreign-free
- #:with-foreign-pointer
- #:null-pointer
- #:null-pointer-p
- #:inc-pointer
- #:make-pointer
- #:pointer-address
- #:%mem-ref
- #:%mem-set
- #:%foreign-funcall
- #:%foreign-funcall-pointer
- #:%foreign-type-alignment
- #:%foreign-type-size
- #:%load-foreign-library
- #:%close-foreign-library
- #:native-namestring
- #:make-shareable-byte-vector
- #:with-pointer-to-vector-data
- #:%defcallback
- #:%callback
- #:%foreign-symbol-pointer))
-
-(in-package #:cffi-sys)
-
-;;;# Mis-features
-
-(pushnew 'flat-namespace cl:*features*)
-
-;;;# Symbol Case
-
-(defun canonicalize-symbol-name-case (name)
- (declare (string name))
- (string-upcase name))
-
-;;;# Allocation
-
-(defun %foreign-alloc (size)
- "Allocate SIZE bytes of foreign-addressable memory."
- (clasp-ffi:%foreign-alloc size))
-
-(defun foreign-free (ptr)
- "Free a pointer PTR allocated by FOREIGN-ALLOC."
- (clasp-ffi:%foreign-free ptr))
-
-(defmacro with-foreign-pointer ((var size &optional size-var) &body body)
- "Bind VAR to SIZE bytes of foreign memory during BODY. The
-pointer in VAR is invalid beyond the dynamic extent of BODY, and
-may be stack-allocated if supported by the implementation. If
-SIZE-VAR is supplied, it will be bound to SIZE during BODY."
- (unless size-var
- (setf size-var (gensym "SIZE")))
- `(let* ((,size-var ,size)
- (,var (%foreign-alloc ,size-var)))
- (unwind-protect
- (progn ,@body)
- (foreign-free ,var))))
-
-;;;# Misc. Pointer Operations
-
-(deftype foreign-pointer ()
- 'clasp-ffi:foreign-data)
-
-(defun null-pointer-p (ptr)
- "Test if PTR is a null pointer."
- (clasp-ffi:%null-pointer-p ptr))
-
-(defun null-pointer ()
- "Construct and return a null pointer."
- (clasp-ffi:%make-nullpointer))
-
-(defun make-pointer (address)
- "Return a pointer pointing to ADDRESS."
- (clasp-ffi:%make-pointer address))
-
-(defun inc-pointer (ptr offset)
- "Return a pointer OFFSET bytes past PTR."
- (clasp-ffi:%inc-pointer ptr offset))
-
-(defun pointer-address (ptr)
- "Return the address pointed to by PTR."
- (clasp-ffi:%foreign-data-address ptr))
-
-(defun pointerp (ptr)
- "Return true if PTR is a foreign pointer."
- (typep ptr 'clasp-ffi:foreign-data))
-
-(defun pointer-eq (ptr1 ptr2)
- "Return true if PTR1 and PTR2 point to the same address."
- (check-type ptr1 clasp-ffi:foreign-data)
- (check-type ptr2 clasp-ffi:foreign-data)
- (eql (pointer-address ptr1) (pointer-address ptr2)))
-
-
-;;;# Shareable Vectors
-;;;
-;;; This interface is very experimental. WITH-POINTER-TO-VECTOR-DATA
-;;; should be defined to perform a copy-in/copy-out if the Lisp
-;;; implementation can't do this.
-
-(defun make-shareable-byte-vector (size)
- "Create a Lisp vector of SIZE bytes that can passed to
-WITH-POINTER-TO-VECTOR-DATA."
- (make-array size :element-type '(unsigned-byte 8)))
-
-;; frgo, 2016-07-02: TODO: Implemenent!
-;; (defmacro with-pointer-to-vector-data ((ptr-var vector) &body body)
-;; "Bind PTR-VAR to a foreign pointer to the data in VECTOR."
-;; `(let ((,ptr-var (si:make-foreign-data-from-array ,vector)))
-;; ,@body))
-
-(defun %foreign-type-size (type-keyword)
- "Return the size in bytes of a foreign type."
- (clasp-ffi:%foreign-type-size type-keyword))
-
-(defun %foreign-type-alignment (type-keyword)
- "Return the alignment in bytes of a foreign type."
- (clasp-ffi:%foreign-type-alignment type-keyword))
-
-;;;# Dereferencing
-
-(defun %mem-ref (ptr type &optional (offset 0))
- "Dereference an object of TYPE at OFFSET bytes from PTR."
- (clasp-ffi:%mem-ref ptr type offset))
-
-(defun %mem-set (value ptr type &optional (offset 0))
- "Set an object of TYPE at OFFSET bytes from PTR."
- (clasp-ffi:%mem-set ptr type value offset))
-
-(defmacro %foreign-funcall (name args &key library convention)
- "Call a foreign function."
- (declare (ignore library convention))
- `(clasp-ffi:%foreign-funcall ,name ,@args))
-
-(defmacro %foreign-funcall-pointer (ptr args &key convention)
- "Funcall a pointer to a foreign function."
- (declare (ignore convention))
- `(clasp-ffi:%foreign-funcall-pointer ,ptr ,@args))
-
-;;;# Foreign Libraries
-
-(defun %load-foreign-library (name path)
- "Load a foreign library."
- (clasp-ffi:%load-foreign-library name path))
-
-(defun %close-foreign-library (handle)
- "Close a foreign library."
- (clasp-ffi:%close-foreign-library handle))
-
-(defun %foreign-symbol-pointer (name library)
- "Returns a pointer to a foreign symbol NAME."
- (clasp-ffi:%foreign-symbol-pointer name library))
-
-(defun native-namestring (pathname)
- (namestring pathname))
-
-;;;# Callbacks
-
-(defmacro %defcallback (name rettype arg-names arg-types body
- &key convention)
- `(clasp-ffi:%defcallback (,name ,@(when convention `(:convention ,convention)))
- ,rettype ,arg-names ,arg-types ,body))
-
-(defun %callback (name)
- (clasp-ffi:%get-callback name))
(DIR) diff --git a/3rdparties/software/cffi_0.20.0/src/cffi-clisp.lisp b/3rdparties/software/cffi_0.20.0/src/cffi-clisp.lisp
@@ -1,432 +0,0 @@
-;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
-;;;
-;;; cffi-clisp.lisp --- CFFI-SYS implementation for CLISP.
-;;;
-;;; Copyright (C) 2005-2006, James Bielman <jamesjb@jamesjb.com>
-;;; Copyright (C) 2005-2006, Joerg Hoehle <hoehle@users.sourceforge.net>
-;;;
-;;; Permission is hereby granted, free of charge, to any person
-;;; obtaining a copy of this software and associated documentation
-;;; files (the "Software"), to deal in the Software without
-;;; restriction, including without limitation the rights to use, copy,
-;;; modify, merge, publish, distribute, sublicense, and/or sell copies
-;;; of the Software, and to permit persons to whom the Software is
-;;; furnished to do so, subject to the following conditions:
-;;;
-;;; The above copyright notice and this permission notice shall be
-;;; included in all copies or substantial portions of the Software.
-;;;
-;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
-;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
-;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
-;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
-;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
-;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
-;;; DEALINGS IN THE SOFTWARE.
-;;;
-
-;;;# Administrivia
-
-(defpackage #:cffi-sys
- (:use #:common-lisp #:alexandria)
- (:export
- #:canonicalize-symbol-name-case
- #:foreign-pointer
- #:pointerp
- #:pointer-eq
- #:null-pointer
- #:null-pointer-p
- #:inc-pointer
- #:make-pointer
- #:pointer-address
- #:%foreign-alloc
- #:foreign-free
- #:with-foreign-pointer
- #:%foreign-funcall
- #:%foreign-funcall-pointer
- #:%foreign-type-alignment
- #:%foreign-type-size
- #:%load-foreign-library
- #:%close-foreign-library
- #:native-namestring
- #:%mem-ref
- #:%mem-set
- #:make-shareable-byte-vector
- #:with-pointer-to-vector-data
- #:%foreign-symbol-pointer
- #:%defcallback
- #:%callback))
-
-(in-package #:cffi-sys)
-
-(eval-when (:compile-toplevel :load-toplevel :execute)
- (unless (find-package :ffi)
- (error "CFFI requires CLISP compiled with dynamic FFI support.")))
-
-;;;# Symbol Case
-
-(defun canonicalize-symbol-name-case (name)
- (declare (string name))
- (string-upcase name))
-
-;;;# Built-In Foreign Types
-
-(defun convert-foreign-type (type)
- "Convert a CFFI built-in type keyword to a CLisp FFI type."
- (ecase type
- (:char 'ffi:char)
- (:unsigned-char 'ffi:uchar)
- (:short 'ffi:short)
- (:unsigned-short 'ffi:ushort)
- (:int 'ffi:int)
- (:unsigned-int 'ffi:uint)
- (:long 'ffi:long)
- (:unsigned-long 'ffi:ulong)
- (:long-long 'ffi:sint64)
- (:unsigned-long-long 'ffi:uint64)
- (:float 'ffi:single-float)
- (:double 'ffi:double-float)
- ;; Clisp's FFI:C-POINTER converts NULL to NIL. For now
- ;; we have a workaround in the pointer operations...
- (:pointer 'ffi:c-pointer)
- (:void nil)))
-
-(defun %foreign-type-size (type)
- "Return the size in bytes of objects having foreign type TYPE."
- (nth-value 0 (ffi:sizeof (convert-foreign-type type))))
-
-;; Remind me to buy a beer for whoever made getting the alignment
-;; of foreign types part of the public interface in CLisp. :-)
-(defun %foreign-type-alignment (type)
- "Return the structure alignment in bytes of foreign TYPE."
- #+(and darwin ppc)
- (case type
- ((:double :long-long :unsigned-long-long)
- (return-from %foreign-type-alignment 8)))
- ;; Override not necessary for the remaining types...
- (nth-value 1 (ffi:sizeof (convert-foreign-type type))))
-
-;;;# Basic Pointer Operations
-
-(deftype foreign-pointer ()
- 'ffi:foreign-address)
-
-(defun pointerp (ptr)
- "Return true if PTR is a foreign pointer."
- (typep ptr 'ffi:foreign-address))
-
-(defun pointer-eq (ptr1 ptr2)
- "Return true if PTR1 and PTR2 point to the same address."
- (eql (ffi:foreign-address-unsigned ptr1)
- (ffi:foreign-address-unsigned ptr2)))
-
-(defun null-pointer ()
- "Return a null foreign pointer."
- (ffi:unsigned-foreign-address 0))
-
-(defun null-pointer-p (ptr)
- "Return true if PTR is a null foreign pointer."
- (zerop (ffi:foreign-address-unsigned ptr)))
-
-(defun inc-pointer (ptr offset)
- "Return a pointer pointing OFFSET bytes past PTR."
- (ffi:unsigned-foreign-address
- (+ offset (ffi:foreign-address-unsigned ptr))))
-
-(defun make-pointer (address)
- "Return a pointer pointing to ADDRESS."
- (ffi:unsigned-foreign-address address))
-
-(defun pointer-address (ptr)
- "Return the address pointed to by PTR."
- (ffi:foreign-address-unsigned ptr))
-
-;;;# Foreign Memory Allocation
-
-(defun %foreign-alloc (size)
- "Allocate SIZE bytes of foreign-addressable memory and return a
-pointer to the allocated block. An implementation-specific error
-is signalled if the memory cannot be allocated."
- (ffi:foreign-address
- (ffi:allocate-shallow 'ffi:uint8 :count (if (zerop size) 1 size))))
-
-(defun foreign-free (ptr)
- "Free a pointer PTR allocated by FOREIGN-ALLOC. The results
-are undefined if PTR is used after being freed."
- (ffi:foreign-free ptr))
-
-(defmacro with-foreign-pointer ((var size &optional size-var) &body body)
- "Bind VAR to a pointer to SIZE bytes of foreign-addressable
-memory during BODY. Both PTR and the memory block pointed to
-have dynamic extent and may be stack allocated if supported by
-the implementation. If SIZE-VAR is supplied, it will be bound to
-SIZE during BODY."
- (unless size-var
- (setf size-var (gensym "SIZE")))
- (let ((obj-var (gensym)))
- `(let ((,size-var ,size))
- (ffi:with-foreign-object
- (,obj-var `(ffi:c-array ffi:uint8 ,,size-var))
- (let ((,var (ffi:foreign-address ,obj-var)))
- ,@body)))))
-
-;;;# Memory Access
-
-;;; %MEM-REF and its compiler macro work around CLISP's FFI:C-POINTER
-;;; type and convert NILs back to null pointers.
-(defun %mem-ref (ptr type &optional (offset 0))
- "Dereference a pointer OFFSET bytes from PTR to an object of
-built-in foreign TYPE. Returns the object as a foreign pointer
-or Lisp number."
- (let ((value (ffi:memory-as ptr (convert-foreign-type type) offset)))
- (if (eq type :pointer)
- (or value (null-pointer))
- value)))
-
-(define-compiler-macro %mem-ref (&whole form ptr type &optional (offset 0))
- "Compiler macro to open-code when TYPE is constant."
- (if (constantp type)
- (let* ((ftype (convert-foreign-type (eval type)))
- (form `(ffi:memory-as ,ptr ',ftype ,offset)))
- (if (eq type :pointer)
- `(or ,form (null-pointer))
- form))
- form))
-
-(defun %mem-set (value ptr type &optional (offset 0))
- "Set a pointer OFFSET bytes from PTR to an object of built-in
-foreign TYPE to VALUE."
- (setf (ffi:memory-as ptr (convert-foreign-type type) offset) value))
-
-(define-compiler-macro %mem-set
- (&whole form value ptr type &optional (offset 0))
- (if (constantp type)
- ;; (setf (ffi:memory-as) value) is exported, but not so nice
- ;; w.r.t. the left to right evaluation rule
- `(ffi::write-memory-as
- ,value ,ptr ',(convert-foreign-type (eval type)) ,offset)
- form))
-
-;;;# Shareable Vectors
-;;;
-;;; This interface is very experimental. WITH-POINTER-TO-VECTOR-DATA
-;;; should be defined to perform a copy-in/copy-out if the Lisp
-;;; implementation can't do this.
-
-(declaim (inline make-shareable-byte-vector))
-(defun make-shareable-byte-vector (size)
- "Create a Lisp vector of SIZE bytes can passed to
-WITH-POINTER-TO-VECTOR-DATA."
- (make-array size :element-type '(unsigned-byte 8)))
-
-(deftype shareable-byte-vector ()
- `(vector (unsigned-byte 8)))
-
-(defmacro with-pointer-to-vector-data ((ptr-var vector) &body body)
- "Bind PTR-VAR to a foreign pointer to the data in VECTOR."
- (with-unique-names (vector-var size-var)
- `(let ((,vector-var ,vector))
- (check-type ,vector-var shareable-byte-vector)
- (with-foreign-pointer (,ptr-var (length ,vector-var) ,size-var)
- ;; copy-in
- (loop for i below ,size-var do
- (%mem-set (aref ,vector-var i) ,ptr-var :unsigned-char i))
- (unwind-protect (progn ,@body)
- ;; copy-out
- (loop for i below ,size-var do
- (setf (aref ,vector-var i)
- (%mem-ref ,ptr-var :unsigned-char i))))))))
-
-;;;# Foreign Function Calling
-
-(defun parse-foreign-funcall-args (args)
- "Return three values, a list of CLISP FFI types, a list of
-values to pass to the function, and the CLISP FFI return type."
- (let ((return-type nil))
- (loop for (type arg) on args by #'cddr
- if arg collect (list (gensym) (convert-foreign-type type)) into types
- and collect arg into fargs
- else do (setf return-type (convert-foreign-type type))
- finally (return (values types fargs return-type)))))
-
-(defun convert-calling-convention (convention)
- (ecase convention
- (:stdcall :stdc-stdcall)
- (:cdecl :stdc)))
-
-(defun c-function-type (arg-types rettype convention)
- "Generate the apropriate CLISP foreign type specification. Also
-takes care of converting the calling convention names."
- `(ffi:c-function (:arguments ,@arg-types)
- (:return-type ,rettype)
- (:language ,(convert-calling-convention convention))))
-
-;;; Quick hack around the fact that the CFFI package is not yet
-;;; defined when this file is loaded. I suppose we could arrange for
-;;; the CFFI package to be defined a bit earlier, though.
-(defun library-handle-form (name)
- (flet ((find-cffi-symbol (symbol)
- (find-symbol (symbol-name symbol) '#:cffi)))
- `(,(find-cffi-symbol '#:foreign-library-handle)
- (,(find-cffi-symbol '#:get-foreign-library) ',name))))
-
-(eval-when (:compile-toplevel :load-toplevel :execute)
- ;; version 2.40 (CVS 2006-09-03, to be more precise) added a
- ;; PROPERTIES argument to FFI::FOREIGN-LIBRARY-FUNCTION.
- (defun post-2.40-ffi-interface-p ()
- (let ((f-l-f (find-symbol (string '#:foreign-library-function) '#:ffi)))
- (if (and f-l-f (= (length (ext:arglist f-l-f)) 5))
- '(:and)
- '(:or))))
- ;; FFI::FOREIGN-LIBRARY-FUNCTION and FFI::FOREIGN-LIBRARY-VARIABLE
- ;; were deprecated in 2.41 and removed in 2.45.
- (defun post-2.45-ffi-interface-p ()
- (if (find-symbol (string '#:foreign-library-function) '#:ffi)
- '(:or)
- '(:and))))
-
-#+#.(cffi-sys::post-2.45-ffi-interface-p)
-(defun %foreign-funcall-aux (name type library)
- `(ffi::find-foreign-function ,name ,type nil ,library nil nil))
-
-#-#.(cffi-sys::post-2.45-ffi-interface-p)
-(defun %foreign-funcall-aux (name type library)
- `(ffi::foreign-library-function
- ,name ,library nil
- #+#.(cffi-sys::post-2.40-ffi-interface-p)
- nil
- ,type))
-
-(defmacro %foreign-funcall (name args &key library convention)
- "Invoke a foreign function called NAME, taking pairs of
-foreign-type/value pairs from ARGS. If a single element is left
-over at the end of ARGS, it specifies the foreign return type of
-the function call."
- (multiple-value-bind (types fargs rettype)
- (parse-foreign-funcall-args args)
- (let* ((fn (%foreign-funcall-aux
- name
- `(ffi:parse-c-type
- ',(c-function-type types rettype convention))
- (if (eq library :default)
- :default
- (library-handle-form library))))
- (form `(funcall
- (load-time-value
- (handler-case ,fn
- (error (err)
- (warn "~A" err))))
- ,@fargs)))
- (if (eq rettype 'ffi:c-pointer)
- `(or ,form (null-pointer))
- form))))
-
-(defmacro %foreign-funcall-pointer (ptr args &key convention)
- "Similar to %foreign-funcall but takes a pointer instead of a string."
- (multiple-value-bind (types fargs rettype)
- (parse-foreign-funcall-args args)
- `(funcall (ffi:foreign-function
- ,ptr (load-time-value
- (ffi:parse-c-type ',(c-function-type
- types rettype convention))))
- ,@fargs)))
-
-;;;# Callbacks
-
-;;; *CALLBACKS* contains the callbacks defined by the CFFI DEFCALLBACK
-;;; macro. The symbol naming the callback is the key, and the value
-;;; is a list containing a Lisp function, the parsed CLISP FFI type of
-;;; the callback, and a saved pointer that should not persist across
-;;; saved images.
-(defvar *callbacks* (make-hash-table))
-
-;;; Return a CLISP FFI function type for a CFFI callback function
-;;; given a return type and list of argument names and types.
-(eval-when (:compile-toplevel :load-toplevel :execute)
- (defun callback-type (rettype arg-names arg-types convention)
- (ffi:parse-c-type
- `(ffi:c-function
- (:arguments ,@(mapcar (lambda (sym type)
- (list sym (convert-foreign-type type)))
- arg-names arg-types))
- (:return-type ,(convert-foreign-type rettype))
- (:language ,(convert-calling-convention convention))))))
-
-;;; Register and create a callback function.
-(defun register-callback (name function parsed-type)
- (setf (gethash name *callbacks*)
- (list function parsed-type
- (ffi:with-foreign-object (ptr 'ffi:c-pointer)
- ;; Create callback by converting Lisp function to foreign
- (setf (ffi:memory-as ptr parsed-type) function)
- (ffi:foreign-value ptr)))))
-
-;;; Restore all saved callback pointers when restarting the Lisp
-;;; image. This is pushed onto CUSTOM:*INIT-HOOKS*.
-;;; Needs clisp > 2.35, bugfix 2005-09-29
-(defun restore-callback-pointers ()
- (maphash
- (lambda (name list)
- (register-callback name (first list) (second list)))
- *callbacks*))
-
-;;; Add RESTORE-CALLBACK-POINTERS to the lists of functions to run
-;;; when an image is restarted.
-(eval-when (:load-toplevel :execute)
- (pushnew 'restore-callback-pointers custom:*init-hooks*))
-
-;;; Define a callback function NAME to run BODY with arguments
-;;; ARG-NAMES translated according to ARG-TYPES and the return type
-;;; translated according to RETTYPE. Obtain a pointer that can be
-;;; passed to C code for this callback by calling %CALLBACK.
-(defmacro %defcallback (name rettype arg-names arg-types body
- &key convention)
- `(register-callback
- ',name
- (lambda ,arg-names
- ;; Work around CLISP's FFI:C-POINTER type and convert NIL values
- ;; back into a null pointers.
- (let (,@(loop for name in arg-names
- and type in arg-types
- when (eq type :pointer)
- collect `(,name (or ,name (null-pointer)))))
- ,body))
- ,(callback-type rettype arg-names arg-types convention)))
-
-;;; Look up the name of a callback and return a pointer that can be
-;;; passed to a C function. Signals an error if no callback is
-;;; defined called NAME.
-(defun %callback (name)
- (multiple-value-bind (list winp) (gethash name *callbacks*)
- (unless winp
- (error "Undefined callback: ~S" name))
- (third list)))
-
-;;;# Loading and Closing Foreign Libraries
-
-(defun %load-foreign-library (name path)
- "Load a foreign library from PATH."
- (declare (ignore name))
- #+#.(cffi-sys::post-2.45-ffi-interface-p)
- (ffi:open-foreign-library path)
- #-#.(cffi-sys::post-2.45-ffi-interface-p)
- (ffi::foreign-library path))
-
-(defun %close-foreign-library (handle)
- "Close a foreign library."
- (ffi:close-foreign-library handle))
-
-(defun native-namestring (pathname)
- (namestring pathname))
-
-;;;# Foreign Globals
-
-(defun %foreign-symbol-pointer (name library)
- "Returns a pointer to a foreign symbol NAME."
- (prog1 (ignore-errors
- (ffi:foreign-address
- #+#.(cffi-sys::post-2.45-ffi-interface-p)
- (ffi::find-foreign-variable name nil library nil nil)
- #-#.(cffi-sys::post-2.45-ffi-interface-p)
- (ffi::foreign-library-variable name library nil nil)))))
(DIR) diff --git a/3rdparties/software/cffi_0.20.0/src/cffi-cmucl.lisp b/3rdparties/software/cffi_0.20.0/src/cffi-cmucl.lisp
@@ -1,384 +0,0 @@
-;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
-;;;
-;;; cffi-cmucl.lisp --- CFFI-SYS implementation for CMU CL.
-;;;
-;;; Copyright (C) 2005-2006, James Bielman <jamesjb@jamesjb.com>
-;;;
-;;; Permission is hereby granted, free of charge, to any person
-;;; obtaining a copy of this software and associated documentation
-;;; files (the "Software"), to deal in the Software without
-;;; restriction, including without limitation the rights to use, copy,
-;;; modify, merge, publish, distribute, sublicense, and/or sell copies
-;;; of the Software, and to permit persons to whom the Software is
-;;; furnished to do so, subject to the following conditions:
-;;;
-;;; The above copyright notice and this permission notice shall be
-;;; included in all copies or substantial portions of the Software.
-;;;
-;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
-;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
-;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
-;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
-;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
-;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
-;;; DEALINGS IN THE SOFTWARE.
-;;;
-
-;;;# Administrivia
-
-(defpackage #:cffi-sys
- (:use #:common-lisp #:alien #:c-call)
- (:import-from #:alexandria #:once-only #:with-unique-names #:if-let)
- (:export
- #:canonicalize-symbol-name-case
- #:foreign-pointer
- #:pointerp
- #:pointer-eq
- #:null-pointer
- #:null-pointer-p
- #:inc-pointer
- #:make-pointer
- #:pointer-address
- #:%foreign-alloc
- #:foreign-free
- #:with-foreign-pointer
- #:%foreign-funcall
- #:%foreign-funcall-pointer
- #:%foreign-type-alignment
- #:%foreign-type-size
- #:%load-foreign-library
- #:%close-foreign-library
- #:native-namestring
- #:%mem-ref
- #:%mem-set
- #:make-shareable-byte-vector
- #:with-pointer-to-vector-data
- #:%foreign-symbol-pointer
- #:%defcallback
- #:%callback))
-
-(in-package #:cffi-sys)
-
-;;;# Misfeatures
-
-(pushnew 'flat-namespace *features*)
-
-;;;# Symbol Case
-
-(defun canonicalize-symbol-name-case (name)
- (declare (string name))
- (string-upcase name))
-
-;;;# Basic Pointer Operations
-
-(deftype foreign-pointer ()
- 'sys:system-area-pointer)
-
-(declaim (inline pointerp))
-(defun pointerp (ptr)
- "Return true if PTR is a foreign pointer."
- (sys:system-area-pointer-p ptr))
-
-(declaim (inline pointer-eq))
-(defun pointer-eq (ptr1 ptr2)
- "Return true if PTR1 and PTR2 point to the same address."
- (sys:sap= ptr1 ptr2))
-
-(declaim (inline null-pointer))
-(defun null-pointer ()
- "Construct and return a null pointer."
- (sys:int-sap 0))
-
-(declaim (inline null-pointer-p))
-(defun null-pointer-p (ptr)
- "Return true if PTR is a null pointer."
- (zerop (sys:sap-int ptr)))
-
-(declaim (inline inc-pointer))
-(defun inc-pointer (ptr offset)
- "Return a pointer pointing OFFSET bytes past PTR."
- (sys:sap+ ptr offset))
-
-(declaim (inline make-pointer))
-(defun make-pointer (address)
- "Return a pointer pointing to ADDRESS."
- (sys:int-sap address))
-
-(declaim (inline pointer-address))
-(defun pointer-address (ptr)
- "Return the address pointed to by PTR."
- (sys:sap-int ptr))
-
-(defmacro with-foreign-pointer ((var size &optional size-var) &body body)
- "Bind VAR to SIZE bytes of foreign memory during BODY. The
-pointer in VAR is invalid beyond the dynamic extent of BODY, and
-may be stack-allocated if supported by the implementation. If
-SIZE-VAR is supplied, it will be bound to SIZE during BODY."
- (unless size-var
- (setf size-var (gensym "SIZE")))
- ;; If the size is constant we can stack-allocate.
- (if (constantp size)
- (let ((alien-var (gensym "ALIEN")))
- `(with-alien ((,alien-var (array (unsigned 8) ,(eval size))))
- (let ((,size-var ,(eval size))
- (,var (alien-sap ,alien-var)))
- (declare (ignorable ,size-var))
- ,@body)))
- `(let* ((,size-var ,size)
- (,var (%foreign-alloc ,size-var)))
- (unwind-protect
- (progn ,@body)
- (foreign-free ,var)))))
-
-;;;# Allocation
-;;;
-;;; Functions and macros for allocating foreign memory on the stack
-;;; and on the heap. The main CFFI package defines macros that wrap
-;;; FOREIGN-ALLOC and FOREIGN-FREE in UNWIND-PROTECT for the common usage
-;;; when the memory has dynamic extent.
-
-(defun %foreign-alloc (size)
- "Allocate SIZE bytes on the heap and return a pointer."
- (declare (type (unsigned-byte 32) size))
- (alien-funcall
- (extern-alien
- "malloc"
- (function system-area-pointer unsigned))
- size))
-
-(defun foreign-free (ptr)
- "Free a PTR allocated by FOREIGN-ALLOC."
- (declare (type system-area-pointer ptr))
- (alien-funcall
- (extern-alien
- "free"
- (function (values) system-area-pointer))
- ptr))
-
-;;;# Shareable Vectors
-;;;
-;;; This interface is very experimental. WITH-POINTER-TO-VECTOR-DATA
-;;; should be defined to perform a copy-in/copy-out if the Lisp
-;;; implementation can't do this.
-
-(defun make-shareable-byte-vector (size)
- "Create a Lisp vector of SIZE bytes that can passed to
-WITH-POINTER-TO-VECTOR-DATA."
- (make-array size :element-type '(unsigned-byte 8)))
-
-(defmacro with-pointer-to-vector-data ((ptr-var vector) &body body)
- "Bind PTR-VAR to a foreign pointer to the data in VECTOR."
- `(sys:without-gcing
- (let ((,ptr-var (sys:vector-sap ,vector)))
- ,@body)))
-
-;;;# Dereferencing
-
-;;; Define the %MEM-REF and %MEM-SET functions, as well as compiler
-;;; macros that optimize the case where the type keyword is constant
-;;; at compile-time.
-(defmacro define-mem-accessors (&body pairs)
- `(progn
- (defun %mem-ref (ptr type &optional (offset 0))
- (ecase type
- ,@(loop for (keyword fn) in pairs
- collect `(,keyword (,fn ptr offset)))))
- (defun %mem-set (value ptr type &optional (offset 0))
- (ecase type
- ,@(loop for (keyword fn) in pairs
- collect `(,keyword (setf (,fn ptr offset) value)))))
- (define-compiler-macro %mem-ref
- (&whole form ptr type &optional (offset 0))
- (if (constantp type)
- (ecase (eval type)
- ,@(loop for (keyword fn) in pairs
- collect `(,keyword `(,',fn ,ptr ,offset))))
- form))
- (define-compiler-macro %mem-set
- (&whole form value ptr type &optional (offset 0))
- (if (constantp type)
- (once-only (value)
- (ecase (eval type)
- ,@(loop for (keyword fn) in pairs
- collect `(,keyword `(setf (,',fn ,ptr ,offset)
- ,value)))))
- form))))
-
-(define-mem-accessors
- (:char sys:signed-sap-ref-8)
- (:unsigned-char sys:sap-ref-8)
- (:short sys:signed-sap-ref-16)
- (:unsigned-short sys:sap-ref-16)
- (:int sys:signed-sap-ref-32)
- (:unsigned-int sys:sap-ref-32)
- (:long sys:signed-sap-ref-32)
- (:unsigned-long sys:sap-ref-32)
- (:long-long sys:signed-sap-ref-64)
- (:unsigned-long-long sys:sap-ref-64)
- (:float sys:sap-ref-single)
- (:double sys:sap-ref-double)
- (:pointer sys:sap-ref-sap))
-
-;;;# Calling Foreign Functions
-
-(defun convert-foreign-type (type-keyword)
- "Convert a CFFI type keyword to an ALIEN type."
- (ecase type-keyword
- (:char 'char)
- (:unsigned-char 'unsigned-char)
- (:short 'short)
- (:unsigned-short 'unsigned-short)
- (:int 'int)
- (:unsigned-int 'unsigned-int)
- (:long 'long)
- (:unsigned-long 'unsigned-long)
- (:long-long '(signed 64))
- (:unsigned-long-long '(unsigned 64))
- (:float 'single-float)
- (:double 'double-float)
- (:pointer 'system-area-pointer)
- (:void 'void)))
-
-(defun %foreign-type-size (type-keyword)
- "Return the size in bytes of a foreign type."
- (/ (alien-internals:alien-type-bits
- (alien-internals:parse-alien-type
- (convert-foreign-type type-keyword))) 8))
-
-(defun %foreign-type-alignment (type-keyword)
- "Return the alignment in bytes of a foreign type."
- (/ (alien-internals:alien-type-alignment
- (alien-internals:parse-alien-type
- (convert-foreign-type type-keyword))) 8))
-
-(defun foreign-funcall-type-and-args (args)
- "Return an ALIEN function type for ARGS."
- (let ((return-type nil))
- (loop for (type arg) on args by #'cddr
- if arg collect (convert-foreign-type type) into types
- and collect arg into fargs
- else do (setf return-type (convert-foreign-type type))
- finally (return (values types fargs return-type)))))
-
-(defmacro %%foreign-funcall (name types fargs rettype)
- "Internal guts of %FOREIGN-FUNCALL."
- `(alien-funcall
- (extern-alien ,name (function ,rettype ,@types))
- ,@fargs))
-
-(defmacro %foreign-funcall (name args &key library convention)
- "Perform a foreign function call, document it more later."
- (declare (ignore library convention))
- (multiple-value-bind (types fargs rettype)
- (foreign-funcall-type-and-args args)
- `(%%foreign-funcall ,name ,types ,fargs ,rettype)))
-
-(defmacro %foreign-funcall-pointer (ptr args &key convention)
- "Funcall a pointer to a foreign function."
- (declare (ignore convention))
- (multiple-value-bind (types fargs rettype)
- (foreign-funcall-type-and-args args)
- (with-unique-names (function)
- `(with-alien ((,function (* (function ,rettype ,@types)) ,ptr))
- (alien-funcall ,function ,@fargs)))))
-
-;;;# Callbacks
-
-(defvar *callbacks* (make-hash-table))
-
-;;; Create a package to contain the symbols for callback functions. We
-;;; want to redefine callbacks with the same symbol so the internal data
-;;; structures are reused.
-(defpackage #:cffi-callbacks
- (:use))
-
-;;; Intern a symbol in the CFFI-CALLBACKS package used to name the internal
-;;; callback for NAME.
-(eval-when (:compile-toplevel :load-toplevel :execute)
- (defun intern-callback (name)
- (intern (format nil "~A::~A"
- (if-let (package (symbol-package name))
- (package-name package)
- name)
- (symbol-name name))
- '#:cffi-callbacks)))
-
-(defmacro %defcallback (name rettype arg-names arg-types body
- &key convention)
- (declare (ignore convention))
- (let ((cb-name (intern-callback name)))
- `(progn
- (def-callback ,cb-name
- (,(convert-foreign-type rettype)
- ,@(mapcar (lambda (sym type)
- (list sym (convert-foreign-type type)))
- arg-names arg-types))
- ,body)
- (setf (gethash ',name *callbacks*) (callback ,cb-name)))))
-
-(defun %callback (name)
- (multiple-value-bind (pointer winp)
- (gethash name *callbacks*)
- (unless winp
- (error "Undefined callback: ~S" name))
- pointer))
-
-;;; CMUCL makes new callback trampolines when it reloads, so we need
-;;; to update CFFI's copies.
-(defun reset-callbacks ()
- (loop for k being the hash-keys of *callbacks*
- do (setf (gethash k *callbacks*)
- (alien::symbol-trampoline (intern-callback k)))))
-
-;; Needs to be after cmucl's restore-callbacks, so put at the end...
-(unless (member 'reset-callbacks ext:*after-save-initializations*)
- (setf ext:*after-save-initializations*
- (append ext:*after-save-initializations* (list 'reset-callbacks))))
-
-;;;# Loading and Closing Foreign Libraries
-
-;;; Work-around for compiling ffi code without loading the
-;;; respective library at compile-time.
-(setf c::top-level-lambda-max 0)
-
-(defun %load-foreign-library (name path)
- "Load the foreign library NAME."
- ;; On some platforms SYS::LOAD-OBJECT-FILE signals an error when
- ;; loading fails, but on others (Linux for instance) it returns
- ;; two values: NIL and an error string.
- (declare (ignore name))
- (multiple-value-bind (ret message)
- (sys::load-object-file path)
- (cond
- ;; Loading failed.
- ((stringp message) (error "~A" message))
- ;; The library was already loaded.
- ((null ret) (cdr (rassoc path sys::*global-table* :test #'string=)))
- ;; The library has been loaded, but since SYS::LOAD-OBJECT-FILE
- ;; returns an alist of *all* loaded libraries along with their addresses
- ;; we return only the handler associated with the library just loaded.
- (t (cdr (rassoc path ret :test #'string=))))))
-
-;;; XXX: doesn't work on Darwin; does not check for errors. I suppose we'd
-;;; want something like SBCL's dlclose-or-lose in foreign-load.lisp:66
-(defun %close-foreign-library (handler)
- "Closes a foreign library."
- (let ((lib (rassoc (ext:unix-namestring handler) sys::*global-table*
- :test #'string=)))
- (sys::dlclose (car lib))
- (setf (car lib) (sys:int-sap 0))))
-
-(defun native-namestring (pathname)
- (ext:unix-namestring pathname nil))
-
-;;;# Foreign Globals
-
-(defun %foreign-symbol-pointer (name library)
- "Returns a pointer to a foreign symbol NAME."
- (declare (ignore library))
- (let ((address (sys:alternate-get-global-address
- (vm:extern-alien-name name))))
- (if (zerop address)
- nil
- (sys:int-sap address))))
(DIR) diff --git a/3rdparties/software/cffi_0.20.0/src/cffi-corman.lisp b/3rdparties/software/cffi_0.20.0/src/cffi-corman.lisp
@@ -1,331 +0,0 @@
-;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
-;;;
-;;; cffi-corman.lisp --- CFFI-SYS implementation for Corman Lisp.
-;;;
-;;; Copyright (C) 2005-2008, Luis Oliveira <loliveira(@)common-lisp.net>
-;;;
-;;; Permission is hereby granted, free of charge, to any person
-;;; obtaining a copy of this software and associated documentation
-;;; files (the "Software"), to deal in the Software without
-;;; restriction, including without limitation the rights to use, copy,
-;;; modify, merge, publish, distribute, sublicense, and/or sell copies
-;;; of the Software, and to permit persons to whom the Software is
-;;; furnished to do so, subject to the following conditions:
-;;;
-;;; The above copyright notice and this permission notice shall be
-;;; included in all copies or substantial portions of the Software.
-;;;
-;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
-;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
-;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
-;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
-;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
-;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
-;;; DEALINGS IN THE SOFTWARE.
-;;;
-
-;;; This port is suffering from bitrot as of 2007-03-29. Corman Lisp
-;;; is too funky with ASDF, crashes easily, makes it very painful to
-;;; do any testing. -- luis
-
-;;;# Administrivia
-
-(defpackage #:cffi-sys
- (:use #:common-lisp #:c-types)
- (:import-from #:alexandria #:with-unique-names)
- (:export
- #:canonicalize-symbol-name-case
- #:foreign-pointer
- #:pointerp
- #:pointer-eq
- #:null-pointer
- #:null-pointer-p
- #:inc-pointer
- #:make-pointer
- #:pointer-address
- #:%foreign-alloc
- #:foreign-free
- #:with-foreign-pointer
- #:%foreign-funcall
- #:%foreign-type-alignment
- #:%foreign-type-size
- #:%load-foreign-library
- #:native-namestring
- #:%mem-ref
- #:%mem-set
- ;#:make-shareable-byte-vector
- ;#:with-pointer-to-vector-data
- #:foreign-symbol-pointer
- #:defcfun-helper-forms
- #:%defcallback
- #:%callback))
-
-(in-package #:cffi-sys)
-
-;;;# Misfeatures
-
-(pushnew 'no-long-long *features*)
-(pushnew 'no-foreign-funcall *features*)
-
-;;;$ Symbol Case
-
-(defun canonicalize-symbol-name-case (name)
- (declare (string name))
- (string-upcase name))
-
-;;;# Basic Pointer Operations
-
-(deftype foreign-pointer ()
- 'cl::foreign)
-
-(defun pointerp (ptr)
- "Return true if PTR is a foreign pointer."
- (cpointerp ptr))
-
-(defun pointer-eq (ptr1 ptr2)
- "Return true if PTR1 and PTR2 point to the same address."
- (cpointer= ptr1 ptr2))
-
-(defun null-pointer ()
- "Return a null pointer."
- (create-foreign-ptr))
-
-(defun null-pointer-p (ptr)
- "Return true if PTR is a null pointer."
- (cpointer-null ptr))
-
-(defun inc-pointer (ptr offset)
- "Return a pointer pointing OFFSET bytes past PTR."
- (let ((new-ptr (create-foreign-ptr)))
- (setf (cpointer-value new-ptr)
- (+ (cpointer-value ptr) offset))
- new-ptr))
-
-(defun make-pointer (address)
- "Return a pointer pointing to ADDRESS."
- (int-to-foreign-ptr address))
-
-(defun pointer-address (ptr)
- "Return the address pointed to by PTR."
- (foreign-ptr-to-int ptr))
-
-;;;# Allocation
-;;;
-;;; Functions and macros for allocating foreign memory on the stack
-;;; and on the heap. The main CFFI package defines macros that wrap
-;;; FOREIGN-ALLOC and FOREIGN-FREE in UNWIND-PROTECT for the common usage
-;;; when the memory has dynamic extent.
-
-(defun %foreign-alloc (size)
- "Allocate SIZE bytes on the heap and return a pointer."
- (malloc size))
-
-(defun foreign-free (ptr)
- "Free a PTR allocated by FOREIGN-ALLOC."
- (free ptr))
-
-(defmacro with-foreign-pointer ((var size &optional size-var) &body body)
- "Bind VAR to SIZE bytes of foreign memory during BODY. The
-pointer in VAR is invalid beyond the dynamic extent of BODY, and
-may be stack-allocated if supported by the implementation. If
-SIZE-VAR is supplied, it will be bound to SIZE during BODY."
- (unless size-var
- (setf size-var (gensym "SIZE")))
- `(let* ((,size-var ,size)
- (,var (malloc ,size-var)))
- (unwind-protect
- (progn ,@body)
- (free ,var))))
-
-;;;# Shareable Vectors
-;;;
-;;; This interface is very experimental. WITH-POINTER-TO-VECTOR-DATA
-;;; should be defined to perform a copy-in/copy-out if the Lisp
-;;; implementation can't do this.
-
-;(defun make-shareable-byte-vector (size)
-; "Create a Lisp vector of SIZE bytes can passed to
-;WITH-POINTER-TO-VECTOR-DATA."
-; (make-array size :element-type '(unsigned-byte 8)))
-;
-;(defmacro with-pointer-to-vector-data ((ptr-var vector) &body body)
-; "Bind PTR-VAR to a foreign pointer to the data in VECTOR."
-; `(sb-sys:without-gcing
-; (let ((,ptr-var (sb-sys:vector-sap ,vector)))
-; ,@body)))
-
-;;;# Dereferencing
-
-;;; According to the docs, Corman's C Function Definition Parser
-;;; converts int to long, so we'll assume that.
-(defun convert-foreign-type (type-keyword)
- "Convert a CFFI type keyword to a CormanCL type."
- (ecase type-keyword
- (:char :char)
- (:unsigned-char :unsigned-char)
- (:short :short)
- (:unsigned-short :unsigned-short)
- (:int :long)
- (:unsigned-int :unsigned-long)
- (:long :long)
- (:unsigned-long :unsigned-long)
- (:float :single-float)
- (:double :double-float)
- (:pointer :handle)
- (:void :void)))
-
-(defun %mem-ref (ptr type &optional (offset 0))
- "Dereference an object of TYPE at OFFSET bytes from PTR."
- (unless (eql offset 0)
- (setq ptr (inc-pointer ptr offset)))
- (ecase type
- (:char (cref (:char *) ptr 0))
- (:unsigned-char (cref (:unsigned-char *) ptr 0))
- (:short (cref (:short *) ptr 0))
- (:unsigned-short (cref (:unsigned-short *) ptr 0))
- (:int (cref (:long *) ptr 0))
- (:unsigned-int (cref (:unsigned-long *) ptr 0))
- (:long (cref (:long *) ptr 0))
- (:unsigned-long (cref (:unsigned-long *) ptr 0))
- (:float (cref (:single-float *) ptr 0))
- (:double (cref (:double-float *) ptr 0))
- (:pointer (cref (:handle *) ptr 0))))
-
-;(define-compiler-macro %mem-ref (&whole form ptr type &optional (offset 0))
-; (if (constantp type)
-; `(cref (,(convert-foreign-type type) *) ,ptr ,offset)
-; form))
-
-(defun %mem-set (value ptr type &optional (offset 0))
- "Set the object of TYPE at OFFSET bytes from PTR."
- (unless (eql offset 0)
- (setq ptr (inc-pointer ptr offset)))
- (ecase type
- (:char (setf (cref (:char *) ptr 0) value))
- (:unsigned-char (setf (cref (:unsigned-char *) ptr 0) value))
- (:short (setf (cref (:short *) ptr 0) value))
- (:unsigned-short (setf (cref (:unsigned-short *) ptr 0) value))
- (:int (setf (cref (:long *) ptr 0) value))
- (:unsigned-int (setf (cref (:unsigned-long *) ptr 0) value))
- (:long (setf (cref (:long *) ptr 0) value))
- (:unsigned-long (setf (cref (:unsigned-long *) ptr 0) value))
- (:float (setf (cref (:single-float *) ptr 0) value))
- (:double (setf (cref (:double-float *) ptr 0) value))
- (:pointer (setf (cref (:handle *) ptr 0) value))))
-
-;;;# Calling Foreign Functions
-
-(defun %foreign-type-size (type-keyword)
- "Return the size in bytes of a foreign type."
- (sizeof (convert-foreign-type type-keyword)))
-
-;;; Couldn't find anything in sys/ffi.lisp and the C declaration parser
-;;; doesn't seem to care about alignment so we'll assume that it's the
-;;; same as its size.
-(defun %foreign-type-alignment (type-keyword)
- (sizeof (convert-foreign-type type-keyword)))
-
-(defun find-dll-containing-function (name)
- "Searches for NAME in the loaded DLLs. If found, returns
-the DLL's name (a string), else returns NIL."
- (dolist (dll ct::*dlls-loaded*)
- (when (ignore-errors
- (ct::get-dll-proc-address name (ct::dll-record-handle dll)))
- (return (ct::dll-record-name dll)))))
-
-;;; This won't work at all...
-#||
-(defmacro %foreign-funcall (name &rest args)
- (let ((sym (gensym)))
- `(let (,sym)
- (ct::install-dll-function ,(find-dll-containing-function name)
- ,name ,sym)
- (funcall ,sym ,@(loop for (type arg) on args by #'cddr
- if arg collect arg)))))
-||#
-
-;;; It *might* be possible to implement by copying most of the code
-;;; from Corman's DEFUN-DLL. Alternatively, it could implemented the
-;;; same way as Lispworks' foreign-funcall. In practice, nobody uses
-;;; Corman with CFFI, apparently. :)
-(defmacro %foreign-funcall (name &rest args)
- "Call a foreign function NAME passing arguments ARGS."
- `(format t "~&;; Calling ~A with args ~S.~%" ,name ',args))
-
-(defun defcfun-helper-forms (name lisp-name rettype args types)
- "Return 2 values for DEFCFUN. A prelude form and a caller form."
- (let ((ff-name (intern (format nil "%cffi-foreign-function/~A" lisp-name)))
- ;; XXX This will only work if the dll is already loaded, fix this.
- (dll (find-dll-containing-function name)))
- (values
- `(defun-dll ,ff-name
- ,(mapcar (lambda (type)
- (list (gensym) (convert-foreign-type type)))
- types)
- :return-type ,(convert-foreign-type rettype)
- :library-name ,dll
- :entry-name ,name
- ;; we want also :pascal linkage type to access
- ;; the win32 api for instance..
- :linkage-type :c)
- `(,ff-name ,@args))))
-
-;;;# Callbacks
-
-;;; defun-c-callback vs. defun-direct-c-callback?
-;;; same issue as Allegro, no return type declaration, should we coerce?
-(defmacro %defcallback (name rettype arg-names arg-types body-form)
- (declare (ignore rettype))
- (with-unique-names (cb-sym)
- `(progn
- (defun-c-callback ,cb-sym
- ,(mapcar (lambda (sym type) (list sym (convert-foreign-type type)))
- arg-names arg-types)
- ,body-form)
- (setf (get ',name 'callback-ptr)
- (get-callback-procinst ',cb-sym)))))
-
-;;; Just continue to use the plist for now even though this really
-;;; should use a *CALLBACKS* hash table and not define the callbacks
-;;; as gensyms. Someone with access to Corman should update this.
-(defun %callback (name)
- (get name 'callback-ptr))
-
-;;;# Loading Foreign Libraries
-
-(defun %load-foreign-library (name)
- "Load the foreign library NAME."
- (ct::get-dll-record name))
-
-(defun %close-foreign-library (name)
- "Close the foreign library NAME."
- (error "Not implemented."))
-
-(defun native-namestring (pathname)
- (namestring pathname)) ; TODO: confirm
-
-;;;# Foreign Globals
-
-;;; FFI to GetProcAddress from the Win32 API.
-;;; "The GetProcAddress function retrieves the address of an exported
-;;; function or variable from the specified dynamic-link library (DLL)."
-(defun-dll get-proc-address
- ((module HMODULE)
- (name LPCSTR))
- :return-type FARPROC
- :library-name "Kernel32.dll"
- :entry-name "GetProcAddress"
- :linkage-type :pascal)
-
-(defun foreign-symbol-pointer (name)
- "Returns a pointer to a foreign symbol NAME."
- (let ((str (lisp-string-to-c-string name)))
- (unwind-protect
- (dolist (dll ct::*dlls-loaded*)
- (let ((ptr (get-proc-address
- (int-to-foreign-ptr (ct::dll-record-handle dll))
- str)))
- (when (not (cpointer-null ptr))
- (return ptr))))
- (free str))))
(DIR) diff --git a/3rdparties/software/cffi_0.20.0/src/cffi-ecl.lisp b/3rdparties/software/cffi_0.20.0/src/cffi-ecl.lisp
@@ -1,454 +0,0 @@
-;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
-;;;
-;;; cffi-ecl.lisp --- ECL backend for CFFI.
-;;;
-;;; Copyright (C) 2005-2006, James Bielman <jamesjb@jamesjb.com>
-;;;
-;;; Permission is hereby granted, free of charge, to any person
-;;; obtaining a copy of this software and associated documentation
-;;; files (the "Software"), to deal in the Software without
-;;; restriction, including without limitation the rights to use, copy,
-;;; modify, merge, publish, distribute, sublicense, and/or sell copies
-;;; of the Software, and to permit persons to whom the Software is
-;;; furnished to do so, subject to the following conditions:
-;;;
-;;; The above copyright notice and this permission notice shall be
-;;; included in all copies or substantial portions of the Software.
-;;;
-;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
-;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
-;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
-;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
-;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
-;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
-;;; DEALINGS IN THE SOFTWARE.
-;;;
-
-;;;# Administrivia
-
-(defpackage #:cffi-sys
- (:use #:common-lisp #:alexandria)
- (:import-from #:si #:null-pointer-p)
- (:export
- #:*cffi-ecl-method*
- #:canonicalize-symbol-name-case
- #:foreign-pointer
- #:pointerp
- #:pointer-eq
- #:%foreign-alloc
- #:foreign-free
- #:with-foreign-pointer
- #:null-pointer
- #:null-pointer-p
- #:inc-pointer
- #:make-pointer
- #:pointer-address
- #:%mem-ref
- #:%mem-set
- #:%foreign-funcall
- #:%foreign-funcall-pointer
- #:%foreign-funcall-varargs
- #:%foreign-funcall-pointer-varargs
- #:%foreign-type-alignment
- #:%foreign-type-size
- #:%load-foreign-library
- #:%close-foreign-library
- #:native-namestring
- #:make-shareable-byte-vector
- #:with-pointer-to-vector-data
- #:%defcallback
- #:%callback
- #:%foreign-symbol-pointer))
-
-(in-package #:cffi-sys)
-
-;;;
-;;; ECL allows many ways of calling a foreign function, and also many
-;;; ways of finding the pointer associated to a function name. They
-;;; depend on whether the FFI relies on libffi or on the C/C++ compiler,
-;;; and whether they use the shared library loader to locate symbols
-;;; or they are linked by the linker.
-;;;
-;;; :DFFI
-;;;
-;;; ECL uses libffi to call foreign functions. The only way to find out
-;;; foreign symbols is by loading shared libraries and using dlopen()
-;;; or similar.
-;;;
-;;; :DLOPEN
-;;;
-;;; ECL compiles FFI code as C/C++ statements. The names are resolved
-;;; at run time by the shared library loader every time the function
-;;; is called
-;;;
-;;; :C/C++
-;;;
-;;; ECL compiles FFI code as C/C++ statements, but the name resolution
-;;; happens at link time. In this case you have to tell the ECL
-;;; compiler which are the right ld-flags (c:*ld-flags*) to link in
-;;; the library.
-;;;
-(defvar *cffi-ecl-method*
- #+dffi :dffi
- #+(and dlopen (not dffi)) :dlopen
- #-(or dffi dlopen) :c/c++
- "The type of code that CFFI generates for ECL: :DFFI when using the
-dynamical foreign function interface; :DLOPEN when using C code and
-dynamical references to symbols; :C/C++ for C/C++ code with static
-references to symbols.")
-
-;;;# Mis-features
-
-#-long-long
-(pushnew 'no-long-long *features*)
-(pushnew 'flat-namespace *features*)
-
-;;;# Symbol Case
-
-(defun canonicalize-symbol-name-case (name)
- (declare (string name))
- (string-upcase name))
-
-;;;# Allocation
-
-(defun %foreign-alloc (size)
- "Allocate SIZE bytes of foreign-addressable memory."
- (si:allocate-foreign-data :void size))
-
-(defun foreign-free (ptr)
- "Free a pointer PTR allocated by FOREIGN-ALLOC."
- (si:free-foreign-data ptr))
-
-(defmacro with-foreign-pointer ((var size &optional size-var) &body body)
- "Bind VAR to SIZE bytes of foreign memory during BODY. The
-pointer in VAR is invalid beyond the dynamic extent of BODY, and
-may be stack-allocated if supported by the implementation. If
-SIZE-VAR is supplied, it will be bound to SIZE during BODY."
- (unless size-var
- (setf size-var (gensym "SIZE")))
- `(let* ((,size-var ,size)
- (,var (%foreign-alloc ,size-var)))
- (unwind-protect
- (progn ,@body)
- (foreign-free ,var))))
-
-;;;# Misc. Pointer Operations
-
-(deftype foreign-pointer ()
- 'si:foreign-data)
-
-(defun null-pointer ()
- "Construct and return a null pointer."
- (si:allocate-foreign-data :void 0))
-
-(defun inc-pointer (ptr offset)
- "Return a pointer OFFSET bytes past PTR."
- (ffi:make-pointer (+ (ffi:pointer-address ptr) offset) :void))
-
-(defun pointerp (ptr)
- "Return true if PTR is a foreign pointer."
- (typep ptr 'si:foreign-data))
-
-(defun pointer-eq (ptr1 ptr2)
- "Return true if PTR1 and PTR2 point to the same address."
- (= (ffi:pointer-address ptr1) (ffi:pointer-address ptr2)))
-
-(defun make-pointer (address)
- "Return a pointer pointing to ADDRESS."
- (ffi:make-pointer address :void))
-
-(defun pointer-address (ptr)
- "Return the address pointed to by PTR."
- (ffi:pointer-address ptr))
-
-;;;# Shareable Vectors
-;;;
-;;; This interface is very experimental. WITH-POINTER-TO-VECTOR-DATA
-;;; should be defined to perform a copy-in/copy-out if the Lisp
-;;; implementation can't do this.
-
-(defun make-shareable-byte-vector (size)
- "Create a Lisp vector of SIZE bytes that can passed to
-WITH-POINTER-TO-VECTOR-DATA."
- (make-array size :element-type '(unsigned-byte 8)))
-
-(defmacro with-pointer-to-vector-data ((ptr-var vector) &body body)
- "Bind PTR-VAR to a foreign pointer to the data in VECTOR."
- `(let ((,ptr-var (si:make-foreign-data-from-array ,vector)))
- ,@body))
-
-;;;# Type Operations
-
-(defconstant +translation-table+
- '((:char :byte "char")
- (:unsigned-char :unsigned-byte "unsigned char")
- (:short :short "short")
- (:unsigned-short :unsigned-short "unsigned short")
- (:int :int "int")
- (:unsigned-int :unsigned-int "unsigned int")
- (:long :long "long")
- (:unsigned-long :unsigned-long "unsigned long")
- #+long-long
- (:long-long :long-long "long long")
- #+long-long
- (:unsigned-long-long :unsigned-long-long "unsigned long long")
- (:float :float "float")
- (:double :double "double")
- (:pointer :pointer-void "void*")
- (:void :void "void")))
-
-(defun cffi-type->ecl-type (type-keyword)
- "Convert a CFFI type keyword to an ECL type keyword."
- (or (second (find type-keyword +translation-table+ :key #'first))
- (error "~S is not a valid CFFI type" type-keyword)))
-
-(defun ecl-type->c-type (type-keyword)
- "Convert a CFFI type keyword to an valid C type keyword."
- (or (third (find type-keyword +translation-table+ :key #'second))
- (error "~S is not a valid CFFI type" type-keyword)))
-
-(defun %foreign-type-size (type-keyword)
- "Return the size in bytes of a foreign type."
- (nth-value 0 (ffi:size-of-foreign-type
- (cffi-type->ecl-type type-keyword))))
-
-(defun %foreign-type-alignment (type-keyword)
- "Return the alignment in bytes of a foreign type."
- (nth-value 1 (ffi:size-of-foreign-type
- (cffi-type->ecl-type type-keyword))))
-
-;;;# Dereferencing
-
-(defun %mem-ref (ptr type &optional (offset 0))
- "Dereference an object of TYPE at OFFSET bytes from PTR."
- (let* ((type (cffi-type->ecl-type type))
- (type-size (ffi:size-of-foreign-type type)))
- (si:foreign-data-ref-elt
- (si:foreign-data-recast ptr (+ offset type-size) :void) offset type)))
-
-(defun %mem-set (value ptr type &optional (offset 0))
- "Set an object of TYPE at OFFSET bytes from PTR."
- (let* ((type (cffi-type->ecl-type type))
- (type-size (ffi:size-of-foreign-type type)))
- (si:foreign-data-set-elt
- (si:foreign-data-recast ptr (+ offset type-size) :void)
- offset type value)))
-
-;;; Inline versions that use C expressions instead of function calls.
-
-(defparameter +mem-ref-strings+
- (loop for (cffi-type ecl-type c-string) in +translation-table+
- for string = (format nil "*((~A *)(((char*)#0)+#1))" c-string)
- collect (list cffi-type ecl-type string)))
-
-(defparameter +mem-set-strings+
- (loop for (cffi-type ecl-type c-string) in +translation-table+
- for string = (format nil "*((~A *)(((char*)#0)+#1))=#2" c-string)
- collect (list cffi-type ecl-type string)))
-
-(define-compiler-macro %mem-ref (&whole whole ptr type &optional (offset 0))
- (if (and (constantp type) (constantp offset))
- (let ((record (assoc (eval type) +mem-ref-strings+)))
- `(ffi:c-inline (,ptr ,offset)
- (:pointer-void :cl-index) ; argument types
- ,(second record) ; return type
- ,(third record) ; the precomputed expansion
- :one-liner t))
- whole))
-
-(define-compiler-macro %mem-set (&whole whole value ptr type &optional (offset 0))
- (if (and (constantp type) (constantp offset))
- (let ((record (assoc (eval type) +mem-set-strings+)))
- `(ffi:c-inline (,ptr ,offset ,value) ; arguments with type translated
- (:pointer-void :cl-index ,(second record))
- :void ; does not return anything
- ,(third record) ; precomputed expansion
- :one-liner t))
- whole))
-
-;;;# Calling Foreign Functions
-
-(defconstant +ecl-inline-codes+ "#0,#1,#2,#3,#4,#5,#6,#7,#8,#9,#a,#b,#c,#d,#e,#f,#g,#h,#i,#j,#k,#l,#m,#n,#o,#p,#q,#r,#s,#t,#u,#v,#w,#x,#y,#z")
-
-(defun c-inline-function-call (thing fixed-types types values return-type dynamic-call variadic)
- (when dynamic-call
- (when (stringp thing)
- (setf thing `(%foreign-symbol-pointer ,thing nil)))
- (push thing values)
- (push :pointer-void types))
- (let* ((decl-args
- (format nil "~{~A~^, ~}~A"
- (mapcar #'ecl-type->c-type fixed-types) (if (null variadic) "" ", ...")))
- (call-args
- (if dynamic-call
- ;; #0 is already used in a cast (it is a function pointer)
- (subseq +ecl-inline-codes+ 3 (max 3 (1- (* (length values) 3))))
- ;; #0 is not used, so we start from the beginning
- (subseq +ecl-inline-codes+ 0 (max 0 (1- (* (length values) 3))))))
- (clines
- (if dynamic-call
- nil
- (format nil "extern ~A ~A(~A);"
- (ecl-type->c-type return-type) thing decl-args)))
- (call-code
- (if dynamic-call
- (format nil "((~A (*)(~A))(#0))(~A)"
- (ecl-type->c-type return-type) decl-args call-args)
- (format nil "~A(~A)" thing call-args))))
- `(progn
- (ffi:clines ,@(ensure-list clines))
- (ffi:c-inline ,values ,types ,return-type ,call-code :one-liner t :side-effects t))))
-
-(defun dffi-function-pointer-call (pointer types values return-type)
- (when (stringp pointer)
- (setf pointer `(%foreign-symbol-pointer ,pointer nil)))
- #-dffi
- `(error "In interpreted code, attempted to call a foreign function~% ~A~%~
- but ECL was built without support for that." ,pointer)
- #+dffi
- `(si::call-cfun ,pointer ,return-type (list ,@types) (list ,@values)))
-
-(defun foreign-funcall-parse-args (args)
- "Return three values, lists of arg types, values, and result type."
- (let ((return-type :void))
- (loop for (type arg) on args by #'cddr
- if arg collect (cffi-type->ecl-type type) into types
- and collect arg into values
- else do (setf return-type (cffi-type->ecl-type type))
- finally (return (values types values return-type)))))
-
-(defmacro %foreign-funcall (name args &key library convention)
- "Call a foreign function."
- (declare (ignore library convention))
- (multiple-value-bind (types values return-type)
- (foreign-funcall-parse-args args)
- `(ext:with-backend
- :bytecodes
- ,(dffi-function-pointer-call name types values return-type)
- :c/c++
- ,(ecase *cffi-ecl-method*
- (:dffi (dffi-function-pointer-call name types values return-type))
- (:dlopen (c-inline-function-call name types types values return-type t nil))
- (:c/c++ (c-inline-function-call name types types values return-type nil nil))))))
-
-(defmacro %foreign-funcall-pointer (pointer args &key convention)
- "Funcall a pointer to a foreign function."
- (declare (ignore convention))
- (multiple-value-bind (types values return-type)
- (foreign-funcall-parse-args args)
- `(ext:with-backend
- :bytecodes
- ,(dffi-function-pointer-call pointer types values return-type)
- :c/c++
- ,(if (eq *cffi-ecl-method* :dffi)
- (dffi-function-pointer-call pointer types values return-type)
- (c-inline-function-call pointer types types values return-type t nil)))))
-
-(defmacro %foreign-funcall-varargs (name args varargs &key library convention)
- (declare (ignore library convention))
- (multiple-value-bind (fixed-types fixed-values)
- (foreign-funcall-parse-args args)
- (multiple-value-bind (varargs-types varargs-values return-type)
- (foreign-funcall-parse-args varargs)
- (let ((all-types (append fixed-types varargs-types))
- (values (append fixed-values varargs-values)))
- `(ext:with-backend
- :bytecodes
- ,(dffi-function-pointer-call name all-types values return-type)
- :c/c++
- ,(ecase *cffi-ecl-method*
- (:dffi (dffi-function-pointer-call name all-types values return-type))
- (:dlopen (c-inline-function-call name fixed-types all-types values return-type t t))
- (:c/c++ (c-inline-function-call name fixed-types all-types values return-type nil t))))))))
-
-(defmacro %foreign-funcall-pointer-varargs (pointer args varargs &key convention)
- (declare (ignore convention))
- (multiple-value-bind (fixed-types fixed-values)
- (foreign-funcall-parse-args args)
- (multiple-value-bind (varargs-types varargs-values return-type)
- (foreign-funcall-parse-args varargs)
- (let ((all-types (append fixed-types varargs-types))
- (values (append fixed-values varargs-values)))
- `(ext:with-backend
- :bytecodes
- ,(dffi-function-pointer-call pointer all-types values return-type)
- :c/c++
- ,(if (eq *cffi-ecl-method* :dffi)
- (dffi-function-pointer-call pointer all-types values return-type)
- (c-inline-function-call pointer fixed-types all-types values return-type t t)))))))
-
-;;;# Foreign Libraries
-
-(defun %load-foreign-library (name path)
- "Load a foreign library."
- (declare (ignore name))
- #-dffi (error "LOAD-FOREIGN-LIBRARY requires ECL's DFFI support. Use ~
- FFI:LOAD-FOREIGN-LIBRARY with a constant argument instead.")
- #+dffi
- (handler-case (si:load-foreign-module path)
- (file-error ()
- (error "file error while trying to load `~A'" path))))
-
-(defun %close-foreign-library (handle)
- "Close a foreign library."
- (handler-case (si::unload-foreign-module handle)
- (undefined-function ()
- (restart-case (error "Detected ECL prior to version 15.2.21. ~
- Function CFFI:CLOSE-FOREIGN-LIBRARY isn't implemented yet.")
- (ignore () :report "Continue anyway (foreign library will remain opened).")))))
-
-(defun native-namestring (pathname)
- (namestring pathname))
-
-;;;# Callbacks
-
-;;; Create a package to contain the symbols for callback functions.
-;;; We want to redefine callbacks with the same symbol so the internal
-;;; data structures are reused.
-(defpackage #:cffi-callbacks
- (:use))
-
-(defvar *callbacks* (make-hash-table))
-
-;;; Intern a symbol in the CFFI-CALLBACKS package used to name the
-;;; internal callback for NAME.
-(eval-when (:compile-toplevel :load-toplevel :execute)
- (defun intern-callback (name)
- (intern (format nil "~A::~A"
- (if-let (package (symbol-package name))
- (package-name package)
- "#")
- (symbol-name name))
- '#:cffi-callbacks)))
-
-(defmacro %defcallback (name rettype arg-names arg-types body
- &key convention)
- (declare (ignore convention))
- (let ((cb-name (intern-callback name))
- (cb-type #.(if (> ext:+ecl-version-number+ 160102)
- :default :cdecl)))
- `(progn
- (ffi:defcallback (,cb-name ,cb-type)
- ,(cffi-type->ecl-type rettype)
- ,(mapcar #'list arg-names
- (mapcar #'cffi-type->ecl-type arg-types))
- ,body)
- (setf (gethash ',name *callbacks*) ',cb-name))))
-
-(defun %callback (name)
- (multiple-value-bind (symbol winp)
- (gethash name *callbacks*)
- (unless winp
- (error "Undefined callback: ~S" name))
- (ffi:callback symbol)))
-
-;;;# Foreign Globals
-
-(defun %foreign-symbol-pointer (name library)
- "Returns a pointer to a foreign symbol NAME."
- (declare (ignore library))
- (handler-case
- (si:find-foreign-symbol (coerce name 'base-string)
- :default :pointer-void 0)
- (error (c) nil)))
(DIR) diff --git a/3rdparties/software/cffi_0.20.0/src/cffi-gcl.lisp b/3rdparties/software/cffi_0.20.0/src/cffi-gcl.lisp
@@ -1,313 +0,0 @@
-;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
-;;;
-;;; cffi-gcl.lisp --- CFFI-SYS implementation for GNU Common Lisp.
-;;;
-;;; Copyright (C) 2005-2006, Luis Oliveira <loliveira(@)common-lisp.net>
-;;;
-;;; Permission is hereby granted, free of charge, to any person
-;;; obtaining a copy of this software and associated documentation
-;;; files (the "Software"), to deal in the Software without
-;;; restriction, including without limitation the rights to use, copy,
-;;; modify, merge, publish, distribute, sublicense, and/or sell copies
-;;; of the Software, and to permit persons to whom the Software is
-;;; furnished to do so, subject to the following conditions:
-;;;
-;;; The above copyright notice and this permission notice shall be
-;;; included in all copies or substantial portions of the Software.
-;;;
-;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
-;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
-;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
-;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
-;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
-;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
-;;; DEALINGS IN THE SOFTWARE.
-;;;
-
-;;; GCL specific notes:
-;;;
-;;; On ELF systems, a library can be loaded with the help of this:
-;;; http://www.copyleft.de/lisp/gcl-elf-loader.html
-;;;
-;;; Another way is to link the library when creating a new image:
-;;; (compiler::link nil "new_image" "" "-lfoo")
-;;;
-;;; As GCL's FFI is not dynamic, CFFI declarations will only work
-;;; after compiled and loaded.
-
-;;; *** this port is broken ***
-;;; gcl doesn't compile the rest of CFFI anyway..
-
-;;;# Administrivia
-
-(defpackage #:cffi-sys
- (:use #:common-lisp #:alexandria)
- (:export
- #:canonicalize-symbol-name-case
- #:pointerp
- #:%foreign-alloc
- #:foreign-free
- #:with-foreign-ptr
- #:null-ptr
- #:null-ptr-p
- #:inc-ptr
- #:%mem-ref
- #:%mem-set
- #:%foreign-funcall
- #:%foreign-type-alignment
- #:%foreign-type-size
- #:%load-foreign-library
- ;#:make-shareable-byte-vector
- ;#:with-pointer-to-vector-data
- #:foreign-var-ptr
- #:make-callback))
-
-(in-package #:cffi-sys)
-
-;;;# Mis-*features*
-(eval-when (:compile-toplevel :load-toplevel :execute)
- (pushnew :cffi/no-foreign-funcall *features*))
-
-;;; Symbol case.
-
-(defun canonicalize-symbol-name-case (name)
- (declare (string name))
- (string-upcase name))
-
-;;;# Allocation
-;;;
-;;; Functions and macros for allocating foreign memory on the stack
-;;; and on the heap. The main CFFI package defines macros that wrap
-;;; FOREIGN-ALLOC and FOREIGN-FREE in UNWIND-PROTECT for the common
-;;; usage when the memory has dynamic extent.
-
-(defentry %foreign-alloc (int) (int "malloc"))
-
-;(defun foreign-alloc (size)
-; "Allocate SIZE bytes on the heap and return a pointer."
-; (%foreign-alloc size))
-
-(defentry foreign-free (int) (void "free"))
-
-;(defun foreign-free (ptr)
-; "Free a PTR allocated by FOREIGN-ALLOC."
-; (%free ptr))
-
-(defmacro with-foreign-ptr ((var size &optional size-var) &body body)
- "Bind VAR to SIZE bytes of foreign memory during BODY. The
-pointer in VAR is invalid beyond the dynamic extent of BODY, and
-may be stack-allocated if supported by the implementation. If
-SIZE-VAR is supplied, it will be bound to SIZE during BODY."
- (unless size-var
- (setf size-var (gensym "SIZE")))
- `(let* ((,size-var ,size)
- (,var (foreign-alloc ,size-var)))
- (unwind-protect
- (progn ,@body)
- (foreign-free ,var))))
-
-;;;# Misc. Pointer Operations
-
-(defun pointerp (ptr)
- "Return true if PTR is a foreign pointer."
- (integerp ptr))
-
-(defun null-ptr ()
- "Construct and return a null pointer."
- 0)
-
-(defun null-ptr-p (ptr)
- "Return true if PTR is a null pointer."
- (= ptr 0))
-
-(defun inc-ptr (ptr offset)
- "Return a pointer OFFSET bytes past PTR."
- (+ ptr offset))
-
-;;;# Shareable Vectors
-;;;
-;;; This interface is very experimental. WITH-POINTER-TO-VECTOR-DATA
-;;; should be defined to perform a copy-in/copy-out if the Lisp
-;;; implementation can't do this.
-
-;(defun make-shareable-byte-vector (size)
-; "Create a Lisp vector of SIZE bytes that can passed to
-;WITH-POINTER-TO-VECTOR-DATA."
-; (make-array size :element-type '(unsigned-byte 8)))
-
-;(defmacro with-pointer-to-vector-data ((ptr-var vector) &body body)
-; "Bind PTR-VAR to a foreign pointer to the data in VECTOR."
-; `(ccl:with-pointer-to-ivector (,ptr-var ,vector)
-; ,@body))
-
-;;;# Dereferencing
-
-(defmacro define-mem-ref/set (type gcl-type &optional c-name)
- (unless c-name
- (setq c-name (substitute #\_ #\Space type)))
- (let ((ref-fn (concatenate 'string "ref_" c-name))
- (set-fn (concatenate 'string "set_" c-name)))
- `(progn
- ;; ref
- (defcfun ,(format nil "~A ~A(~A *ptr)" type ref-fn type)
- 0 "return *ptr;")
- (defentry ,(intern (string-upcase (substitute #\- #\_ ref-fn)))
- (int) (,gcl-type ,ref-fn))
- ;; set
- (defcfun ,(format nil "void ~A(~A *ptr, ~A value)" set-fn type type)
- 0 "*ptr = value;")
- (defentry ,(intern (string-upcase (substitute #\- #\_ set-fn)))
- (int ,gcl-type) (void ,set-fn)))))
-
-(define-mem-ref/set "char" char)
-(define-mem-ref/set "unsigned char" char)
-(define-mem-ref/set "short" int)
-(define-mem-ref/set "unsigned short" int)
-(define-mem-ref/set "int" int)
-(define-mem-ref/set "unsigned int" int)
-(define-mem-ref/set "long" int)
-(define-mem-ref/set "unsigned long" int)
-(define-mem-ref/set "float" float)
-(define-mem-ref/set "double" double)
-(define-mem-ref/set "void *" int "ptr")
-
-(defun %mem-ref (ptr type &optional (offset 0))
- "Dereference an object of TYPE at OFFSET bytes from PTR."
- (unless (zerop offset)
- (incf ptr offset))
- (ecase type
- (:char (ref-char ptr))
- (:unsigned-char (ref-unsigned-char ptr))
- (:short (ref-short ptr))
- (:unsigned-short (ref-unsigned-short ptr))
- (:int (ref-int ptr))
- (:unsigned-int (ref-unsigned-int ptr))
- (:long (ref-long ptr))
- (:unsigned-long (ref-unsigned-long ptr))
- (:float (ref-float ptr))
- (:double (ref-double ptr))
- (:pointer (ref-ptr ptr))))
-
-(defun %mem-set (value ptr type &optional (offset 0))
- (unless (zerop offset)
- (incf ptr offset))
- (ecase type
- (:char (set-char ptr value))
- (:unsigned-char (set-unsigned-char ptr value))
- (:short (set-short ptr value))
- (:unsigned-short (set-unsigned-short ptr value))
- (:int (set-int ptr value))
- (:unsigned-int (set-unsigned-int ptr value))
- (:long (set-long ptr value))
- (:unsigned-long (set-unsigned-long ptr value))
- (:float (set-float ptr value))
- (:double (set-double ptr value))
- (:pointer (set-ptr ptr value)))
- value)
-
-;;;# Calling Foreign Functions
-
-;; TODO: figure out if these type conversions make any sense...
-(defun convert-foreign-type (type-keyword)
- "Convert a CFFI type keyword to a GCL type."
- (ecase type-keyword
- (:char 'char)
- (:unsigned-char 'char)
- (:short 'int)
- (:unsigned-short 'int)
- (:int 'int)
- (:unsigned-int 'int)
- (:long 'int)
- (:unsigned-long 'int)
- (:float 'float)
- (:double 'double)
- (:pointer 'int)
- (:void 'void)))
-
-(defparameter +cffi-types+
- '(:char :unsigned-char :short :unsigned-short :int :unsigned-int
- :long :unsigned-long :float :double :pointer))
-
-(defcfun "int size_of(int type)" 0
- "switch (type) {
- case 0: return sizeof(char);
- case 1: return sizeof(unsigned char);
- case 2: return sizeof(short);
- case 3: return sizeof(unsigned short);
- case 4: return sizeof(int);
- case 5: return sizeof(unsigned int);
- case 6: return sizeof(long);
- case 7: return sizeof(unsigned long);
- case 8: return sizeof(float);
- case 9: return sizeof(double);
- case 10: return sizeof(void *);
- default: return -1;
- }")
-
-(defentry size-of (int) (int "size_of"))
-
-;; TODO: all this is doable inside the defcfun; figure that out..
-(defun %foreign-type-size (type-keyword)
- "Return the size in bytes of a foreign type."
- (size-of (position type-keyword +cffi-types+)))
-
-(defcfun "int align_of(int type)" 0
- "switch (type) {
- case 0: return __alignof__(char);
- case 1: return __alignof__(unsigned char);
- case 2: return __alignof__(short);
- case 3: return __alignof__(unsigned short);
- case 4: return __alignof__(int);
- case 5: return __alignof__(unsigned int);
- case 6: return __alignof__(long);
- case 7: return __alignof__(unsigned long);
- case 8: return __alignof__(float);
- case 9: return __alignof__(double);
- case 10: return __alignof__(void *);
- default: return -1;
- }")
-
-(defentry align-of (int) (int "align_of"))
-
-;; TODO: like %foreign-type-size
-(defun %foreign-type-alignment (type-keyword)
- "Return the alignment in bytes of a foreign type."
- (align-of (position type-keyword +cffi-types+)))
-
-#+ignore
-(defun convert-external-name (name)
- "Add an underscore to NAME if necessary for the ABI."
- #+darwinppc-target (concatenate 'string "_" name)
- #-darwinppc-target name)
-
-(defmacro %foreign-funcall (function-name &rest args)
- "Perform a foreign function all, document it more later."
- `(format t "~&;; Calling ~A with args ~S.~%" ,name ',args))
-
-(defun defcfun-helper-forms (name rettype args types)
- "Return 2 values for DEFCFUN. A prelude form and a caller form."
- (let ((ff-name (intern (format nil "%foreign-function/TildeA:~A" name))))
- (values
- `(defentry ,ff-name ,(mapcar #'convert-foreign-type types)
- (,(convert-foreign-type rettype) ,name))
- `(,ff-name ,@args))))
-
-;;;# Callbacks
-
-;;; XXX unimplemented
-(defmacro make-callback (name rettype arg-names arg-types body-form)
- 0)
-
-;;;# Loading Foreign Libraries
-
-(defun %load-foreign-library (name)
- "_Won't_ load the foreign library NAME."
- (declare (ignore name)))
-
-;;;# Foreign Globals
-
-;;; XXX unimplemented
-(defmacro foreign-var-ptr (name)
- "Return a pointer pointing to the foreign symbol NAME."
- 0)
(DIR) diff --git a/3rdparties/software/cffi_0.20.0/src/cffi-lispworks.lisp b/3rdparties/software/cffi_0.20.0/src/cffi-lispworks.lisp
@@ -1,417 +0,0 @@
-;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
-;;;
-;;; cffi-lispworks.lisp --- Lispworks CFFI-SYS implementation.
-;;;
-;;; Copyright (C) 2005-2006, James Bielman <jamesjb@jamesjb.com>
-;;;
-;;; Permission is hereby granted, free of charge, to any person
-;;; obtaining a copy of this software and associated documentation
-;;; files (the "Software"), to deal in the Software without
-;;; restriction, including without limitation the rights to use, copy,
-;;; modify, merge, publish, distribute, sublicense, and/or sell copies
-;;; of the Software, and to permit persons to whom the Software is
-;;; furnished to do so, subject to the following conditions:
-;;;
-;;; The above copyright notice and this permission notice shall be
-;;; included in all copies or substantial portions of the Software.
-;;;
-;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
-;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
-;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
-;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
-;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
-;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
-;;; DEALINGS IN THE SOFTWARE.
-;;;
-
-;;;# Administrivia
-
-(defpackage #:cffi-sys
- (:use #:cl #:alexandria)
- (:export
- #:canonicalize-symbol-name-case
- #:foreign-pointer
- #:pointerp
- #:pointer-eq
- #:null-pointer
- #:null-pointer-p
- #:inc-pointer
- #:make-pointer
- #:pointer-address
- #:%foreign-alloc
- #:foreign-free
- #:with-foreign-pointer
- #:%foreign-funcall
- #:%foreign-funcall-pointer
- #:%foreign-type-alignment
- #:%foreign-type-size
- #:%load-foreign-library
- #:%close-foreign-library
- #:native-namestring
- #:%mem-ref
- #:%mem-set
- #:make-shareable-byte-vector
- #:with-pointer-to-vector-data
- #:%foreign-symbol-pointer
- #:defcfun-helper-forms
- #:%defcallback
- #:%callback))
-
-(in-package #:cffi-sys)
-
-;;;# Misfeatures
-
-#-lispworks-64bit (pushnew 'no-long-long *features*)
-
-;;;# Symbol Case
-
-(defun canonicalize-symbol-name-case (name)
- (declare (string name))
- (string-upcase name))
-
-;;;# Basic Pointer Operations
-
-(deftype foreign-pointer ()
- 'fli::pointer)
-
-(defun pointerp (ptr)
- "Return true if PTR is a foreign pointer."
- (fli:pointerp ptr))
-
-(defun pointer-eq (ptr1 ptr2)
- "Return true if PTR1 and PTR2 point to the same address."
- (fli:pointer-eq ptr1 ptr2))
-
-;; We use FLI:MAKE-POINTER here instead of FLI:*NULL-POINTER* since old
-;; versions of Lispworks don't seem to have it.
-(defun null-pointer ()
- "Return a null foreign pointer."
- (fli:make-pointer :address 0 :type :void))
-
-(defun null-pointer-p (ptr)
- "Return true if PTR is a null pointer."
- (check-type ptr fli::pointer)
- (fli:null-pointer-p ptr))
-
-;; FLI:INCF-POINTER won't work on FLI pointers to :void so we
-;; increment "manually."
-(defun inc-pointer (ptr offset)
- "Return a pointer OFFSET bytes past PTR."
- (fli:make-pointer :type :void :address (+ (fli:pointer-address ptr) offset)))
-
-(defun make-pointer (address)
- "Return a pointer pointing to ADDRESS."
- (fli:make-pointer :type :void :address address))
-
-(defun pointer-address (ptr)
- "Return the address pointed to by PTR."
- (fli:pointer-address ptr))
-
-;;;# Allocation
-
-(defun %foreign-alloc (size)
- "Allocate SIZE bytes of memory and return a pointer."
- (fli:allocate-foreign-object :type :byte :nelems size))
-
-(defun foreign-free (ptr)
- "Free a pointer PTR allocated by FOREIGN-ALLOC."
- (fli:free-foreign-object ptr))
-
-(defmacro with-foreign-pointer ((var size &optional size-var) &body body)
- "Bind VAR to SIZE bytes of foreign memory during BODY. Both the
-pointer in VAR and the memory it points to have dynamic extent and may
-be stack allocated if supported by the implementation."
- (unless size-var
- (setf size-var (gensym "SIZE")))
- `(fli:with-dynamic-foreign-objects ()
- (let* ((,size-var ,size)
- (,var (fli:alloca :type :byte :nelems ,size-var)))
- ,@body)))
-
-;;;# Shareable Vectors
-
-(defun make-shareable-byte-vector (size)
- "Create a shareable byte vector."
- #+(or lispworks3 lispworks4 lispworks5.0)
- (sys:in-static-area
- (make-array size :element-type '(unsigned-byte 8)))
- #-(or lispworks3 lispworks4 lispworks5.0)
- (make-array size :element-type '(unsigned-byte 8) :allocation :static))
-
-(defmacro with-pointer-to-vector-data ((ptr-var vector) &body body)
- "Bind PTR-VAR to a pointer at the data in VECTOR."
- `(fli:with-dynamic-lisp-array-pointer (,ptr-var ,vector)
- ,@body))
-
-;;;# Dereferencing
-
-(defun convert-foreign-type (cffi-type)
- "Convert a CFFI type keyword to an FLI type."
- (ecase cffi-type
- (:char :byte)
- (:unsigned-char '(:unsigned :byte))
- (:short :short)
- (:unsigned-short '(:unsigned :short))
- (:int :int)
- (:unsigned-int '(:unsigned :int))
- (:long :long)
- (:unsigned-long '(:unsigned :long))
- ;; On 32-bit platforms, Lispworks 5.0+ supports long-long for
- ;; DEFCFUN and FOREIGN-FUNCALL.
- (:long-long '(:long :long))
- (:unsigned-long-long '(:unsigned :long :long))
- (:float :float)
- (:double :double)
- (:pointer :pointer)
- (:void :void)))
-
-;;; Convert a CFFI type keyword to a symbol suitable for passing to
-;;; FLI:FOREIGN-TYPED-AREF.
-#+#.(cl:if (cl:find-symbol "FOREIGN-TYPED-AREF" "FLI") '(and) '(or))
-(defun convert-foreign-typed-aref-type (cffi-type)
- (ecase cffi-type
- ((:char :short :int :long #+lispworks-64bit :long-long)
- `(signed-byte ,(* 8 (%foreign-type-size cffi-type))))
- ((:unsigned-char :unsigned-short :unsigned-int :unsigned-long
- #+lispworks-64bit :unsigned-long-long)
- `(unsigned-byte ,(* 8 (%foreign-type-size cffi-type))))
- (:float 'single-float)
- (:double 'double-float)))
-
-(defun %mem-ref (ptr type &optional (offset 0))
- "Dereference an object of type TYPE OFFSET bytes from PTR."
- (unless (zerop offset)
- (setf ptr (inc-pointer ptr offset)))
- (fli:dereference ptr :type (convert-foreign-type type)))
-
-;; Lispworks 5.0 on 64-bit platforms doesn't have [u]int64 support in
-;; FOREIGN-TYPED-AREF. That was implemented in 5.1.
-#+(and lispworks-64bit lispworks5.0)
-(defun 64-bit-type-p (type)
- (member type '(:long :unsigned-long :long-long :unsigned-long-long)))
-
-;;; In LispWorks versions where FLI:FOREIGN-TYPED-AREF is fbound, use
-;;; it instead of FLI:DEREFERENCE in the optimizer for %MEM-REF.
-#+#.(cl:if (cl:find-symbol "FOREIGN-TYPED-AREF" "FLI") '(and) '(or))
-(define-compiler-macro %mem-ref (&whole form ptr type &optional (off 0))
- (if (constantp type)
- (let ((type (eval type)))
- (if (or #+(and lispworks-64bit lispworks5.0) (64-bit-type-p type)
- (eql type :pointer))
- (let ((fli-type (convert-foreign-type type))
- (ptr-form (if (eql off 0) ptr `(inc-pointer ,ptr ,off))))
- `(fli:dereference ,ptr-form :type ',fli-type))
- (let ((lisp-type (convert-foreign-typed-aref-type type)))
- `(locally
- (declare (optimize (speed 3) (safety 0)))
- (fli:foreign-typed-aref ',lisp-type ,ptr (the fixnum ,off))))))
- form))
-
-;;; Open-code the call to FLI:DEREFERENCE when TYPE is constant at
-;;; macroexpansion time, when FLI:FOREIGN-TYPED-AREF is not available.
-#-#.(cl:if (cl:find-symbol "FOREIGN-TYPED-AREF" "FLI") '(and) '(or))
-(define-compiler-macro %mem-ref (&whole form ptr type &optional (off 0))
- (if (constantp type)
- (let ((ptr-form (if (eql off 0) ptr `(inc-pointer ,ptr ,off)))
- (type (convert-foreign-type (eval type))))
- `(fli:dereference ,ptr-form :type ',type))
- form))
-
-(defun %mem-set (value ptr type &optional (offset 0))
- "Set the object of TYPE at OFFSET bytes from PTR."
- (unless (zerop offset)
- (setf ptr (inc-pointer ptr offset)))
- (setf (fli:dereference ptr :type (convert-foreign-type type)) value))
-
-;;; In LispWorks versions where FLI:FOREIGN-TYPED-AREF is fbound, use
-;;; it instead of FLI:DEREFERENCE in the optimizer for %MEM-SET.
-#+#.(cl:if (cl:find-symbol "FOREIGN-TYPED-AREF" "FLI") '(and) '(or))
-(define-compiler-macro %mem-set (&whole form val ptr type &optional (off 0))
- (if (constantp type)
- (once-only (val)
- (let ((type (eval type)))
- (if (or #+(and lispworks-64bit lispworks5.0) (64-bit-type-p type)
- (eql type :pointer))
- (let ((fli-type (convert-foreign-type type))
- (ptr-form (if (eql off 0) ptr `(inc-pointer ,ptr ,off))))
- `(setf (fli:dereference ,ptr-form :type ',fli-type) ,val))
- (let ((lisp-type (convert-foreign-typed-aref-type type)))
- `(locally
- (declare (optimize (speed 3) (safety 0)))
- (setf (fli:foreign-typed-aref ',lisp-type ,ptr
- (the fixnum ,off))
- ,val))))))
- form))
-
-;;; Open-code the call to (SETF FLI:DEREFERENCE) when TYPE is constant
-;;; at macroexpansion time.
-#-#.(cl:if (cl:find-symbol "FOREIGN-TYPED-AREF" "FLI") '(and) '(or))
-(define-compiler-macro %mem-set (&whole form val ptr type &optional (off 0))
- (if (constantp type)
- (once-only (val)
- (let ((ptr-form (if (eql off 0) ptr `(inc-pointer ,ptr ,off)))
- (type (convert-foreign-type (eval type))))
- `(setf (fli:dereference ,ptr-form :type ',type) ,val)))
- form))
-
-;;;# Foreign Type Operations
-
-(defun %foreign-type-size (type)
- "Return the size in bytes of a foreign type."
- (fli:size-of (convert-foreign-type type)))
-
-(defun %foreign-type-alignment (type)
- "Return the structure alignment in bytes of foreign type."
- #+(and darwin harp::powerpc)
- (when (eq type :double)
- (return-from %foreign-type-alignment 8))
- ;; Override not necessary for the remaining types...
- (fli:align-of (convert-foreign-type type)))
-
-;;;# Calling Foreign Functions
-
-(defvar *foreign-funcallable-cache* (make-hash-table :test 'equal)
- "Caches foreign funcallables created by %FOREIGN-FUNCALL or
-%FOREIGN-FUNCALL-POINTER. We only need to have one per each
-signature.")
-
-(defun foreign-funcall-type-and-args (args)
- "Returns a list of types, list of args and return type."
- (let ((return-type :void))
- (loop for (type arg) on args by #'cddr
- if arg collect (convert-foreign-type type) into types
- and collect arg into fargs
- else do (setf return-type (convert-foreign-type type))
- finally (return (values types fargs return-type)))))
-
-(defun create-foreign-funcallable (types rettype convention)
- "Creates a foreign funcallable for the signature TYPES -> RETTYPE."
- #+mac (declare (ignore convention))
- (format t "~&Creating foreign funcallable for signature ~S -> ~S~%"
- types rettype)
- ;; yes, ugly, this most likely wants to be a top-level form...
- (let ((internal-name (gensym)))
- (funcall
- (compile nil
- `(lambda ()
- (fli:define-foreign-funcallable ,internal-name
- ,(loop for type in types
- collect (list (gensym) type))
- :result-type ,rettype
- :language :ansi-c
- ;; avoid warning about cdecl not being supported on mac
- #-mac ,@(list :calling-convention convention)))))
- internal-name))
-
-(defun get-foreign-funcallable (types rettype convention)
- "Returns a foreign funcallable for the signature TYPES -> RETTYPE -
-either from the cache or newly created."
- (let ((signature (cons rettype types)))
- (or (gethash signature *foreign-funcallable-cache*)
- ;; (SETF GETHASH) is supposed to be thread-safe
- (setf (gethash signature *foreign-funcallable-cache*)
- (create-foreign-funcallable types rettype convention)))))
-
-(defmacro %%foreign-funcall (foreign-function args convention)
- "Does the actual work for %FOREIGN-FUNCALL-POINTER and %FOREIGN-FUNCALL.
-Checks if a foreign funcallable which fits ARGS already exists and creates
-and caches it if necessary. Finally calls it."
- (multiple-value-bind (types fargs rettype)
- (foreign-funcall-type-and-args args)
- `(funcall (load-time-value
- (get-foreign-funcallable ',types ',rettype ',convention))
- ,foreign-function ,@fargs)))
-
-(defmacro %foreign-funcall (name args &key library convention)
- "Calls a foreign function named NAME passing arguments ARGS."
- `(%%foreign-funcall
- (fli:make-pointer :symbol-name ,name
- :module ',(if (eq library :default) nil library))
- ,args ,convention))
-
-(defmacro %foreign-funcall-pointer (ptr args &key convention)
- "Calls a foreign function pointed at by PTR passing arguments ARGS."
- `(%%foreign-funcall ,ptr ,args ,convention))
-
-(defun defcfun-helper-forms (name lisp-name rettype args types options)
- "Return 2 values for DEFCFUN. A prelude form and a caller form."
- (let ((ff-name (intern (format nil "%cffi-foreign-function/~A" lisp-name))))
- (values
- `(fli:define-foreign-function (,ff-name ,name :source)
- ,(mapcar (lambda (ty) (list (gensym) (convert-foreign-type ty)))
- types)
- :result-type ,(convert-foreign-type rettype)
- :language :ansi-c
- :module ',(let ((lib (getf options :library)))
- (if (eq lib :default) nil lib))
- ;; avoid warning about cdecl not being supported on mac platforms
- #-mac ,@(list :calling-convention (getf options :convention)))
- `(,ff-name ,@args))))
-
-;;;# Callbacks
-
-(defvar *callbacks* (make-hash-table))
-
-;;; Create a package to contain the symbols for callback functions. We
-;;; want to redefine callbacks with the same symbol so the internal data
-;;; structures are reused.
-(defpackage #:cffi-callbacks
- (:use))
-
-;;; Intern a symbol in the CFFI-CALLBACKS package used to name the internal
-;;; callback for NAME.
-(eval-when (:compile-toplevel :load-toplevel :execute)
- (defun intern-callback (name)
- (intern (format nil "~A::~A"
- (if-let (package (symbol-package name))
- (package-name package)
- "#")
- (symbol-name name))
- '#:cffi-callbacks)))
-
-(defmacro %defcallback (name rettype arg-names arg-types body
- &key convention)
- (let ((cb-name (intern-callback name)))
- `(progn
- (fli:define-foreign-callable
- (,cb-name :encode :lisp
- :result-type ,(convert-foreign-type rettype)
- :calling-convention ,convention
- :language :ansi-c
- :no-check nil)
- ,(mapcar (lambda (sym type)
- (list sym (convert-foreign-type type)))
- arg-names arg-types)
- ,body)
- (setf (gethash ',name *callbacks*) ',cb-name))))
-
-(defun %callback (name)
- (multiple-value-bind (symbol winp)
- (gethash name *callbacks*)
- (unless winp
- (error "Undefined callback: ~S" name))
- (fli:make-pointer :symbol-name symbol :module :callbacks)))
-
-;;;# Loading Foreign Libraries
-
-(defun %load-foreign-library (name path)
- "Load the foreign library NAME."
- (fli:register-module (or name path) :connection-style :immediate
- :real-name path))
-
-(defun %close-foreign-library (name)
- "Close the foreign library NAME."
- (fli:disconnect-module name :remove t))
-
-(defun native-namestring (pathname)
- (namestring pathname))
-
-;;;# Foreign Globals
-
-(defun %foreign-symbol-pointer (name library)
- "Returns a pointer to a foreign symbol NAME."
- (values
- (ignore-errors
- (fli:make-pointer :symbol-name name :type :void
- :module (if (eq library :default) nil library)))))
(DIR) diff --git a/3rdparties/software/cffi_0.20.0/src/cffi-mcl.lisp b/3rdparties/software/cffi_0.20.0/src/cffi-mcl.lisp
@@ -1,396 +0,0 @@
-;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
-;;;
-;;; cffi-mcl.lisp --- CFFI-SYS implementation for Digitool MCL.
-;;;
-;;; Copyright 2010 james.anderson@setf.de
-;;; Copyright 2005-2006, James Bielman <jamesjb@jamesjb.com>
-;;;
-;;; Permission is hereby granted, free of charge, to any person
-;;; obtaining a copy of this software and associated documentation
-;;; files (the "Software"), to deal in the Software without
-;;; restriction, including without limitation the rights to use, copy,
-;;; modify, merge, publish, distribute, sublicense, and/or sell copies
-;;; of the Software, and to permit persons to whom the Software is
-;;; furnished to do so, subject to the following conditions:
-;;;
-;;; The above copyright notice and this permission notice shall be
-;;; included in all copies or substantial portions of the Software.
-;;;
-;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
-;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
-;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
-;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
-;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
-;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
-;;; DEALINGS IN THE SOFTWARE.
-;;;
-
-;;; this is a stop-gap emulation. (at least) three things are not right
-;;; - integer vector arguments are copied
-;;; - return values are not typed
-;;; - a shared library must be packaged as a framework and statically loaded
-;;;
-;;; on the topic of shared libraries, see
-;;; http://developer.apple.com/library/mac/#documentation/DeveloperTools/Conceptual/MachOTopics/1-Articles/loading_code.html
-;;; which describes how to package a shared library as a framework.
-;;; once a framework exists, load it as, eg.
-;;; (ccl::add-framework-bundle "fftw.framework" :pathname "ccl:frameworks;" )
-
-;;;# Administrivia
-
-(defpackage #:cffi-sys
- (:use #:common-lisp #:ccl)
- (:import-from #:alexandria #:once-only #:if-let)
- (:export
- #:canonicalize-symbol-name-case
- #:foreign-pointer
- #:pointerp ; ccl:pointerp
- #:pointer-eq
- #:%foreign-alloc
- #:foreign-free
- #:with-foreign-pointer
- #:null-pointer
- #:null-pointer-p
- #:inc-pointer
- #:make-pointer
- #:pointer-address
- #:%mem-ref
- #:%mem-set
- #:%foreign-funcall
- #:%foreign-funcall-pointer
- #:%foreign-type-alignment
- #:%foreign-type-size
- #:%load-foreign-library
- #:%close-foreign-library
- #:native-namestring
- #:make-shareable-byte-vector
- #:with-pointer-to-vector-data
- #:%foreign-symbol-pointer
- #:%defcallback
- #:%callback))
-
-(in-package #:cffi-sys)
-
-;;;# Misfeatures
-
-(pushnew 'flat-namespace *features*)
-
-;;;# Symbol Case
-
-(defun canonicalize-symbol-name-case (name)
- (declare (string name))
- (string-upcase name))
-
-;;;# Allocation
-;;;
-;;; Functions and macros for allocating foreign memory on the stack
-;;; and on the heap. The main CFFI package defines macros that wrap
-;;; FOREIGN-ALLOC and FOREIGN-FREE in UNWIND-PROTECT for the common
-;;; usage when the memory has dynamic extent.
-
-(defun %foreign-alloc (size)
- "Allocate SIZE bytes on the heap and return a pointer."
- (#_newPtr size))
-
-(defun foreign-free (ptr)
- "Free a PTR allocated by FOREIGN-ALLOC."
- ;; TODO: Should we make this a dead macptr?
- (#_disposePtr ptr))
-
-(defmacro with-foreign-pointer ((var size &optional size-var) &body body)
- "Bind VAR to SIZE bytes of foreign memory during BODY. The
-pointer in VAR is invalid beyond the dynamic extent of BODY, and
-may be stack-allocated if supported by the implementation. If
-SIZE-VAR is supplied, it will be bound to SIZE during BODY."
- (unless size-var
- (setf size-var (gensym "SIZE")))
- `(let ((,size-var ,size))
- (ccl:%stack-block ((,var ,size-var))
- ,@body)))
-
-;;;# Misc. Pointer Operations
-
-(deftype foreign-pointer ()
- 'ccl:macptr)
-
-(defun null-pointer ()
- "Construct and return a null pointer."
- (ccl:%null-ptr))
-
-(defun null-pointer-p (ptr)
- "Return true if PTR is a null pointer."
- (ccl:%null-ptr-p ptr))
-
-(defun inc-pointer (ptr offset)
- "Return a pointer OFFSET bytes past PTR."
- (ccl:%inc-ptr ptr offset))
-
-(defun pointer-eq (ptr1 ptr2)
- "Return true if PTR1 and PTR2 point to the same address."
- (ccl:%ptr-eql ptr1 ptr2))
-
-(defun make-pointer (address)
- "Return a pointer pointing to ADDRESS."
- (ccl:%int-to-ptr address))
-
-(defun pointer-address (ptr)
- "Return the address pointed to by PTR."
- (ccl:%ptr-to-int ptr))
-
-;;;# Shareable Vectors
-;;;
-;;; This interface is very experimental. WITH-POINTER-TO-VECTOR-DATA
-;;; should be defined to perform a copy-in/copy-out if the Lisp
-;;; implementation can't do this.
-
-(defun make-shareable-byte-vector (size)
- "Create a Lisp vector of SIZE bytes that can passed to
-WITH-POINTER-TO-VECTOR-DATA."
- (make-array size :element-type '(unsigned-byte 8)))
-
-;;; from openmcl::macros.lisp
-
-(defmacro with-pointer-to-vector-data ((ptr ivector) &body body)
- "Bind PTR-VAR to a foreign pointer to the data in VECTOR."
- (let* ((v (gensym))
- (l (gensym)))
- `(let* ((,v ,ivector)
- (,l (length ,v)))
- (unless (typep ,v 'ccl::ivector) (ccl::report-bad-arg ,v 'ccl::ivector))
- ;;;!!! this, unless it's possible to suppress gc
- (let ((,ptr (#_newPtr ,l)))
- (unwind-protect (progn (ccl::%copy-ivector-to-ptr ,v 0 ,ptr 0 ,l)
- (mutliple-value-prog1
- (locally ,@body)
- (ccl::%copy-ptr-to-ivector ,ptr 0 ,v 0 ,l)))
- (#_disposePtr ,ptr))))))
-
-;;;# Dereferencing
-
-;;; Define the %MEM-REF and %MEM-SET functions, as well as compiler
-;;; macros that optimize the case where the type keyword is constant
-;;; at compile-time.
-(defmacro define-mem-accessors (&body pairs)
- `(progn
- (defun %mem-ref (ptr type &optional (offset 0))
- (ecase type
- ,@(loop for (keyword fn) in pairs
- collect `(,keyword (,fn ptr offset)))))
- (defun %mem-set (value ptr type &optional (offset 0))
- (ecase type
- ,@(loop for (keyword fn) in pairs
- collect `(,keyword (setf (,fn ptr offset) value)))))
- (define-compiler-macro %mem-ref
- (&whole form ptr type &optional (offset 0))
- (if (constantp type)
- (ecase (eval type)
- ,@(loop for (keyword fn) in pairs
- collect `(,keyword `(,',fn ,ptr ,offset))))
- form))
- (define-compiler-macro %mem-set
- (&whole form value ptr type &optional (offset 0))
- (if (constantp type)
- (once-only (value)
- (ecase (eval type)
- ,@(loop for (keyword fn) in pairs
- collect `(,keyword `(setf (,',fn ,ptr ,offset)
- ,value)))))
- form))))
-
-(define-mem-accessors
- (:char %get-signed-byte)
- (:unsigned-char %get-unsigned-byte)
- (:short %get-signed-word)
- (:unsigned-short %get-unsigned-word)
- (:int %get-signed-long)
- (:unsigned-int %get-unsigned-long)
- (:long %get-signed-long)
- (:unsigned-long %get-unsigned-long)
- (:long-long ccl::%get-signed-long-long)
- (:unsigned-long-long ccl::%get-unsigned-long-long)
- (:float %get-single-float)
- (:double %get-double-float)
- (:pointer %get-ptr))
-
-
-(defun ccl::%get-unsigned-long-long (ptr offset)
- (let ((value 0) (bit 0))
- (dotimes (i 8)
- (setf (ldb (byte 8 (shiftf bit (+ bit 8))) value)
- (ccl:%get-unsigned-byte ptr (+ offset i))))
- value))
-
-(setf (fdefinition 'ccl::%get-signed-long-long)
- (fdefinition 'ccl::%get-unsigned-long-long))
-
-(defun (setf ccl::%get-unsigned-long-long) (value ptr offset)
- (let ((bit 0))
- (dotimes (i 8)
- (setf (ccl:%get-unsigned-byte ptr (+ offset i))
- (ldb (byte 8 (shiftf bit (+ bit 8))) value))))
- ptr)
-
-(setf (fdefinition '(setf ccl::%get-signed-long-long))
- (fdefinition '(setf ccl::%get-unsigned-long-long)))
-
-
-;;;# Calling Foreign Functions
-
-(defun convert-foreign-type (type-keyword)
- "Convert a CFFI type keyword to a ppc-ff-call type."
- (ecase type-keyword
- (:char :signed-byte)
- (:unsigned-char :unsigned-byte)
- (:short :signed-short)
- (:unsigned-short :unsigned-short)
- (:int :signed-fullword)
- (:unsigned-int :unsigned-fullword)
- (:long :signed-fullword)
- (:unsigned-long :unsigned-fullword)
- (:long-long :signed-doubleword)
- (:unsigned-long-long :unsigned-doubleword)
- (:float :single-float)
- (:double :double-float)
- (:pointer :address)
- (:void :void)))
-
-(defun ppc-ff-call-type=>mactype-name (type-keyword)
- (ecase type-keyword
- (:signed-byte :sint8)
- (:unsigned-byte :uint8)
- (:signed-short :sint16)
- (:unsigned-short :uint16)
- (:signed-halfword :sint16)
- (:unsigned-halfword :uint16)
- (:signed-fullword :sint32)
- (:unsigned-fullword :uint32)
- ;(:signed-doubleword :long-long)
- ;(:unsigned-doubleword :unsigned-long-long)
- (:single-float :single-float)
- (:double-float :double-float)
- (:address :pointer)
- (:void :void)))
-
-
-
-(defun %foreign-type-size (type-keyword)
- "Return the size in bytes of a foreign type."
- (case type-keyword
- ((:long-long :unsigned-long-long) 8)
- (t (ccl::mactype-record-size
- (ccl::find-mactype
- (ppc-ff-call-type=>mactype-name (convert-foreign-type type-keyword)))))))
-
-;; There be dragons here. See the following thread for details:
-;; http://clozure.com/pipermail/openmcl-devel/2005-June/002777.html
-(defun %foreign-type-alignment (type-keyword)
- "Return the alignment in bytes of a foreign type."
- (case type-keyword
- ((:long-long :unsigned-long-long) 4)
- (t (ccl::mactype-record-size
- (ccl::find-mactype
- (ppc-ff-call-type=>mactype-name (convert-foreign-type type-keyword)))))))
-
-(defun convert-foreign-funcall-types (args)
- "Convert foreign types for a call to FOREIGN-FUNCALL."
- (loop for (type arg) on args by #'cddr
- collect (convert-foreign-type type)
- if arg collect arg))
-
-(defun convert-external-name (name)
- "no '_' is necessary here, the internal lookup operators handle it"
- name)
-
-(defmacro %foreign-funcall (function-name args &key library convention)
- "Perform a foreign function call, document it more later."
- (declare (ignore library convention))
- `(ccl::ppc-ff-call
- (ccl::macho-address ,(ccl::get-macho-entry-point (convert-external-name function-name)))
- ,@(convert-foreign-funcall-types args)))
-
-(defmacro %foreign-funcall-pointer (ptr args &key convention)
- (declare (ignore convention))
- `(ccl::ppc-ff-call ,ptr ,@(convert-foreign-funcall-types args)))
-
-;;;# Callbacks
-
-;;; The *CALLBACKS* hash table maps CFFI callback names to OpenMCL "macptr"
-;;; entry points. It is safe to store the pointers directly because
-;;; OpenMCL will update the address of these pointers when a saved image
-;;; is loaded (see CCL::RESTORE-PASCAL-FUNCTIONS).
-(defvar *callbacks* (make-hash-table))
-
-;;; Create a package to contain the symbols for callback functions. We
-;;; want to redefine callbacks with the same symbol so the internal data
-;;; structures are reused.
-(defpackage #:cffi-callbacks
- (:use))
-
-;;; Intern a symbol in the CFFI-CALLBACKS package used to name the internal
-;;; callback for NAME.
-(defun intern-callback (name)
- (intern (format nil "~A::~A"
- (if-let (package (symbol-package name))
- (package-name package)
- "#")
- (symbol-name name))
- '#:cffi-callbacks))
-
-(defmacro %defcallback (name rettype arg-names arg-types body
- &key convention)
- (declare (ignore convention))
- (let ((cb-name (intern-callback name)))
- `(progn
- (ccl::ppc-defpascal ,cb-name
- (;; ? ,@(when (eq convention :stdcall) '(:discard-stack-args))
- ,@(mapcan (lambda (sym type)
- (list (ppc-ff-call-type=>mactype-name (convert-foreign-type type)) sym))
- arg-names arg-types)
- ,(ppc-ff-call-type=>mactype-name (convert-foreign-type rettype)))
- ,body)
- (setf (gethash ',name *callbacks*) (symbol-value ',cb-name)))))
-
-(defun %callback (name)
- (or (gethash name *callbacks*)
- (error "Undefined callback: ~S" name)))
-
-;;;# Loading Foreign Libraries
-
-(defun %load-foreign-library (name path)
- "Load the foreign library NAME."
- (declare (ignore path))
- (setf name (string name))
- ;; for mcl emulate this wrt frameworks
- (unless (and (> (length name) 10)
- (string-equal name ".framework" :start1 (- (length name) 10)))
- (setf name (concatenate 'string name ".framework")))
- ;; if the framework was not registered, add it
- (unless (gethash name ccl::*framework-descriptors*)
- (ccl::add-framework-bundle name :pathname "ccl:frameworks;" ))
- (ccl::load-framework-bundle name))
-
-(defun %close-foreign-library (name)
- "Close the foreign library NAME."
- ;; for mcl do nothing
- (declare (ignore name))
- nil)
-
-(defun native-namestring (pathname)
- (ccl::posix-namestring (ccl:full-pathname pathname)))
-
-
-;;;# Foreign Globals
-
-(deftrap-inline "_findsymbol"
- ((map :pointer)
- (name :pointer))
- :pointer
- ())
-
-
-(defun %foreign-symbol-pointer (name library)
- "Returns a pointer to a foreign symbol NAME."
- (declare (ignore library))
- (ccl::macho-address
- (ccl::get-macho-entry-point (convert-external-name name))))
(DIR) diff --git a/3rdparties/software/cffi_0.20.0/src/cffi-mkcl.lisp b/3rdparties/software/cffi_0.20.0/src/cffi-mkcl.lisp
@@ -1,342 +0,0 @@
-;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
-;;;
-;;; cffi-mkcl.lisp --- MKCL backend for CFFI.
-;;;
-;;; Copyright (C) 2010-2012, Jean-Claude Beaudoin
-;;; Copyright (C) 2005-2006, James Bielman <jamesjb@jamesjb.com>
-;;;
-;;; Permission is hereby granted, free of charge, to any person
-;;; obtaining a copy of this software and associated documentation
-;;; files (the "Software"), to deal in the Software without
-;;; restriction, including without limitation the rights to use, copy,
-;;; modify, merge, publish, distribute, sublicense, and/or sell copies
-;;; of the Software, and to permit persons to whom the Software is
-;;; furnished to do so, subject to the following conditions:
-;;;
-;;; The above copyright notice and this permission notice shall be
-;;; included in all copies or substantial portions of the Software.
-;;;
-;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
-;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
-;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
-;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
-;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
-;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
-;;; DEALINGS IN THE SOFTWARE.
-;;;
-
-;;;# Administrivia
-
-(defpackage #:cffi-sys
- (:use #:common-lisp #:alexandria)
- (:export
- #:canonicalize-symbol-name-case
- #:foreign-pointer
- #:pointerp
- #:pointer-eq
- #:null-pointer
- #:null-pointer-p
- #:inc-pointer
- #:make-pointer
- #:pointer-address
- #:%foreign-alloc
- #:foreign-free
- #:with-foreign-pointer
- #:%foreign-funcall
- #:%foreign-funcall-pointer
- #:%foreign-type-alignment
- #:%foreign-type-size
- #:%load-foreign-library
- #:%close-foreign-library
- #:native-namestring
- #:%mem-ref
- #:%mem-set
- #:make-shareable-byte-vector
- #:with-pointer-to-vector-data
- #:%foreign-symbol-pointer
- #:%defcallback
- #:%callback))
-
-(in-package #:cffi-sys)
-
-;;;# Mis-features
-
-(pushnew 'flat-namespace *features*)
-
-;;;# Symbol Case
-
-(defun canonicalize-symbol-name-case (name)
- (declare (string name))
- (string-upcase name))
-
-;;;# Allocation
-
-(defun %foreign-alloc (size)
- "Allocate SIZE bytes of foreign-addressable memory."
- (si:allocate-foreign-data :void size))
-
-(defun foreign-free (ptr)
- "Free a pointer PTR allocated by FOREIGN-ALLOC."
- (si:free-foreign-data ptr)
- nil)
-
-(defmacro with-foreign-pointer ((var size &optional size-var) &body body)
- "Bind VAR to SIZE bytes of foreign memory during BODY. The
-pointer in VAR is invalid beyond the dynamic extent of BODY, and
-may be stack-allocated if supported by the implementation. If
-SIZE-VAR is supplied, it will be bound to SIZE during BODY."
- (unless size-var
- (setf size-var (gensym "SIZE")))
- `(let* ((,size-var ,size)
- (,var (%foreign-alloc ,size-var)))
- (unwind-protect
- (progn ,@body)
- (foreign-free ,var))))
-
-;;;# Misc. Pointer Operations
-
-(deftype foreign-pointer ()
- 'si:foreign)
-
-(defun null-pointer ()
- "Construct and return a null pointer."
- (si:make-foreign-null-pointer))
-
-(defun null-pointer-p (ptr)
- "Return true if PTR is a null pointer."
- (si:null-pointer-p ptr))
-
-(defun inc-pointer (ptr offset)
- "Return a pointer OFFSET bytes past PTR."
- (ffi:make-pointer (+ (ffi:pointer-address ptr) offset) :void))
-
-(defun pointerp (ptr)
- "Return true if PTR is a foreign pointer."
- ;;(typep ptr 'si:foreign)
- (si:foreignp ptr))
-
-(defun pointer-eq (ptr1 ptr2)
- "Return true if PTR1 and PTR2 point to the same address."
- (= (ffi:pointer-address ptr1) (ffi:pointer-address ptr2)))
-
-(defun make-pointer (address)
- "Return a pointer pointing to ADDRESS."
- (ffi:make-pointer address :void))
-
-(defun pointer-address (ptr)
- "Return the address pointed to by PTR."
- (ffi:pointer-address ptr))
-
-;;;# Shareable Vectors
-;;;
-;;; This interface is very experimental. WITH-POINTER-TO-VECTOR-DATA
-;;; should be defined to perform a copy-in/copy-out if the Lisp
-;;; implementation can't do this.
-
-(defun make-shareable-byte-vector (size)
- "Create a Lisp vector of SIZE bytes that can passed to
-WITH-POINTER-TO-VECTOR-DATA."
- (make-array size :element-type '(unsigned-byte 8)))
-
-;;; MKCL, built with the Boehm GC never moves allocated data, so this
-;;; isn't nearly as hard to do.
-(defun %vector-address (vector)
- "Return the address of VECTOR's data."
- (check-type vector (vector (unsigned-byte 8)))
- #-mingw64
- (ffi:c-inline (vector) (object)
- :unsigned-long
- "(uintptr_t) #0->vector.self.b8"
- :side-effects nil
- :one-liner t)
- #+mingw64
- (ffi:c-inline (vector) (object)
- :unsigned-long-long
- "(uintptr_t) #0->vector.self.b8"
- :side-effects nil
- :one-liner t))
-
-(defmacro with-pointer-to-vector-data ((ptr-var vector) &body body)
- "Bind PTR-VAR to a foreign pointer to the data in VECTOR."
- `(let ((,ptr-var (make-pointer (%vector-address ,vector))))
- ,@body))
-
-;;;# Dereferencing
-
-(defun %mem-ref (ptr type &optional (offset 0))
- "Dereference an object of TYPE at OFFSET bytes from PTR."
- (let* ((type (cffi-type->mkcl-type type))
- (type-size (ffi:size-of-foreign-type type)))
- (si:foreign-ref-elt
- (si:foreign-recast ptr (+ offset type-size) :void) offset type)))
-
-(defun %mem-set (value ptr type &optional (offset 0))
- "Set an object of TYPE at OFFSET bytes from PTR."
- (let* ((type (cffi-type->mkcl-type type))
- (type-size (ffi:size-of-foreign-type type)))
- (si:foreign-set-elt
- (si:foreign-recast ptr (+ offset type-size) :void)
- offset type value)))
-
-;;;# Type Operations
-
-(defconstant +translation-table+
- '((:char :byte "char")
- (:unsigned-char :unsigned-byte "unsigned char")
- (:short :short "short")
- (:unsigned-short :unsigned-short "unsigned short")
- (:int :int "int")
- (:unsigned-int :unsigned-int "unsigned int")
- (:long :long "long")
- (:unsigned-long :unsigned-long "unsigned long")
- (:long-long :long-long "long long")
- (:unsigned-long-long :unsigned-long-long "unsigned long long")
- (:float :float "float")
- (:double :double "double")
- (:pointer :pointer-void "void*")
- (:void :void "void")))
-
-(defun cffi-type->mkcl-type (type-keyword)
- "Convert a CFFI type keyword to an MKCL type keyword."
- (or (second (find type-keyword +translation-table+ :key #'first))
- (error "~S is not a valid CFFI type" type-keyword)))
-
-(defun mkcl-type->c-type (type-keyword)
- "Convert a CFFI type keyword to an valid C type keyword."
- (or (third (find type-keyword +translation-table+ :key #'second))
- (error "~S is not a valid CFFI type" type-keyword)))
-
-(defun %foreign-type-size (type-keyword)
- "Return the size in bytes of a foreign type."
- (nth-value 0 (ffi:size-of-foreign-type
- (cffi-type->mkcl-type type-keyword))))
-
-(defun %foreign-type-alignment (type-keyword)
- "Return the alignment in bytes of a foreign type."
- (nth-value 1 (ffi:size-of-foreign-type
- (cffi-type->mkcl-type type-keyword))))
-
-;;;# Calling Foreign Functions
-
-#|
-(defconstant +mkcl-inline-codes+ "#0,#1,#2,#3,#4,#5,#6,#7,#8,#9,#a,#b,#c,#d,#e,#f,#g,#h,#i,#j,#k,#l,#m,#n,#o,#p,#q,#r,#s,#t,#u,#v,#w,#x,#y,#z")
-|#
-
-(defun produce-function-pointer-call (pointer types values return-type)
-#|
- (if (stringp pointer)
- (produce-function-pointer-call
- `(%foreign-symbol-pointer ,pointer nil) types values return-type)
- `(ffi:c-inline
- ,(list* pointer values)
- ,(list* :pointer-void types) ,return-type
- ,(with-output-to-string (s)
- (let ((types (mapcar #'mkcl-type->c-type types)))
- ;; On AMD64, the following code only works with the extra
- ;; argument ",...". If this is not present, functions
- ;; like sprintf do not work
- (format s "((~A (*)(~@[~{~A,~}...~]))(#0))(~A)"
- (mkcl-type->c-type return-type) types
- (subseq +mkcl-inline-codes+ 3
- (max 3 (+ 2 (* (length values) 3)))))))
- :one-liner t :side-effects t))
-|#
- ;; The version here below is definitely not as efficient as the one above
- ;; but it has the great vertue of working in all cases, (contrary to the
- ;; silent and unsafe limitations of the one above). JCB
- ;; I should re-optimize this one day, when I get time... JCB
- (progn
- (when (stringp pointer)
- (setf pointer `(%foreign-symbol-pointer ,pointer nil)))
- `(si:call-cfun ,pointer ,return-type (list ,@types) (list ,@values))))
-
-
-(defun foreign-funcall-parse-args (args)
- "Return three values, lists of arg types, values, and result type."
- (let ((return-type :void))
- (loop for (type arg) on args by #'cddr
- if arg collect (cffi-type->mkcl-type type) into types
- and collect arg into values
- else do (setf return-type (cffi-type->mkcl-type type))
- finally (return (values types values return-type)))))
-
-(defmacro %foreign-funcall (name args &key library convention)
- "Call a foreign function."
- (declare (ignore library convention))
- (multiple-value-bind (types values return-type)
- (foreign-funcall-parse-args args)
- (produce-function-pointer-call name types values return-type)))
-
-(defmacro %foreign-funcall-pointer (ptr args &key convention)
- "Funcall a pointer to a foreign function."
- (declare (ignore convention))
- (multiple-value-bind (types values return-type)
- (foreign-funcall-parse-args args)
- (produce-function-pointer-call ptr types values return-type)))
-
-;;;# Foreign Libraries
-
-(defun %load-foreign-library (name path)
- "Load a foreign library."
- (declare (ignore name))
- (handler-case (si:load-foreign-module path)
- (file-error ()
- (error "file error while trying to load `~A'" path))))
-
-(defun %close-foreign-library (handle)
- ;;(declare (ignore handle))
- ;;(error "%CLOSE-FOREIGN-LIBRARY unimplemented.")
- (si:unload-foreign-module handle))
-
-(defun native-namestring (pathname)
- (namestring pathname))
-
-;;;# Callbacks
-
-;;; Create a package to contain the symbols for callback functions.
-;;; We want to redefine callbacks with the same symbol so the internal
-;;; data structures are reused.
-(defpackage #:cffi-callbacks
- (:use))
-
-(defvar *callbacks* (make-hash-table))
-
-;;; Intern a symbol in the CFFI-CALLBACKS package used to name the
-;;; internal callback for NAME.
-(eval-when (:compile-toplevel :load-toplevel :execute)
- (defun intern-callback (name)
- (intern (format nil "~A::~A"
- (if-let (package (symbol-package name))
- (package-name package)
- "#")
- (symbol-name name))
- '#:cffi-callbacks)))
-
-(defmacro %defcallback (name rettype arg-names arg-types body
- &key convention)
- (declare (ignore convention))
- (let ((cb-name (intern-callback name)))
- `(progn
- (ffi:defcallback (,cb-name :cdecl)
- ,(cffi-type->mkcl-type rettype)
- ,(mapcar #'list arg-names
- (mapcar #'cffi-type->mkcl-type arg-types))
- ;;(block ,cb-name ,@body)
- (block ,cb-name ,body))
- (setf (gethash ',name *callbacks*) ',cb-name))))
-
-(defun %callback (name)
- (multiple-value-bind (symbol winp)
- (gethash name *callbacks*)
- (unless winp
- (error "Undefined callback: ~S" name))
- (ffi:callback symbol)))
-
-;;;# Foreign Globals
-
-(defun %foreign-symbol-pointer (name library)
- "Returns a pointer to a foreign symbol NAME."
- (declare (ignore library))
- (values (ignore-errors (si:find-foreign-symbol name :default :pointer-void 0))))
-
(DIR) diff --git a/3rdparties/software/cffi_0.20.0/src/cffi-openmcl.lisp b/3rdparties/software/cffi_0.20.0/src/cffi-openmcl.lisp
@@ -1,314 +0,0 @@
-;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
-;;;
-;;; cffi-openmcl.lisp --- CFFI-SYS implementation for OpenMCL.
-;;;
-;;; Copyright (C) 2005-2006, James Bielman <jamesjb@jamesjb.com>
-;;;
-;;; Permission is hereby granted, free of charge, to any person
-;;; obtaining a copy of this software and associated documentation
-;;; files (the "Software"), to deal in the Software without
-;;; restriction, including without limitation the rights to use, copy,
-;;; modify, merge, publish, distribute, sublicense, and/or sell copies
-;;; of the Software, and to permit persons to whom the Software is
-;;; furnished to do so, subject to the following conditions:
-;;;
-;;; The above copyright notice and this permission notice shall be
-;;; included in all copies or substantial portions of the Software.
-;;;
-;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
-;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
-;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
-;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
-;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
-;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
-;;; DEALINGS IN THE SOFTWARE.
-;;;
-
-;;;# Administrivia
-
-(defpackage #:cffi-sys
- (:use #:common-lisp #:ccl)
- (:import-from #:alexandria #:once-only #:if-let)
- (:export
- #:canonicalize-symbol-name-case
- #:foreign-pointer
- #:pointerp ; ccl:pointerp
- #:pointer-eq
- #:%foreign-alloc
- #:foreign-free
- #:with-foreign-pointer
- #:null-pointer
- #:null-pointer-p
- #:inc-pointer
- #:make-pointer
- #:pointer-address
- #:%mem-ref
- #:%mem-set
- #:%foreign-funcall
- #:%foreign-funcall-pointer
- #:%foreign-type-alignment
- #:%foreign-type-size
- #:%load-foreign-library
- #:%close-foreign-library
- #:native-namestring
- #:make-shareable-byte-vector
- #:with-pointer-to-vector-data
- #:%foreign-symbol-pointer
- #:%defcallback
- #:%callback))
-
-(in-package #:cffi-sys)
-
-;;;# Misfeatures
-
-(pushnew 'flat-namespace *features*)
-
-;;;# Symbol Case
-
-(defun canonicalize-symbol-name-case (name)
- (declare (string name))
- (string-upcase name))
-
-;;;# Allocation
-;;;
-;;; Functions and macros for allocating foreign memory on the stack
-;;; and on the heap. The main CFFI package defines macros that wrap
-;;; FOREIGN-ALLOC and FOREIGN-FREE in UNWIND-PROTECT for the common
-;;; usage when the memory has dynamic extent.
-
-(defun %foreign-alloc (size)
- "Allocate SIZE bytes on the heap and return a pointer."
- (ccl::malloc size))
-
-(defun foreign-free (ptr)
- "Free a PTR allocated by FOREIGN-ALLOC."
- ;; TODO: Should we make this a dead macptr?
- (ccl::free ptr))
-
-(defmacro with-foreign-pointer ((var size &optional size-var) &body body)
- "Bind VAR to SIZE bytes of foreign memory during BODY. The
-pointer in VAR is invalid beyond the dynamic extent of BODY, and
-may be stack-allocated if supported by the implementation. If
-SIZE-VAR is supplied, it will be bound to SIZE during BODY."
- (unless size-var
- (setf size-var (gensym "SIZE")))
- `(let ((,size-var ,size))
- (%stack-block ((,var ,size-var))
- ,@body)))
-
-;;;# Misc. Pointer Operations
-
-(deftype foreign-pointer ()
- 'ccl:macptr)
-
-(defun null-pointer ()
- "Construct and return a null pointer."
- (ccl:%null-ptr))
-
-(defun null-pointer-p (ptr)
- "Return true if PTR is a null pointer."
- (ccl:%null-ptr-p ptr))
-
-(defun inc-pointer (ptr offset)
- "Return a pointer OFFSET bytes past PTR."
- (ccl:%inc-ptr ptr offset))
-
-(defun pointer-eq (ptr1 ptr2)
- "Return true if PTR1 and PTR2 point to the same address."
- (ccl:%ptr-eql ptr1 ptr2))
-
-(defun make-pointer (address)
- "Return a pointer pointing to ADDRESS."
- (ccl:%int-to-ptr address))
-
-(defun pointer-address (ptr)
- "Return the address pointed to by PTR."
- (ccl:%ptr-to-int ptr))
-
-;;;# Shareable Vectors
-;;;
-;;; This interface is very experimental. WITH-POINTER-TO-VECTOR-DATA
-;;; should be defined to perform a copy-in/copy-out if the Lisp
-;;; implementation can't do this.
-
-(defun make-shareable-byte-vector (size)
- "Create a Lisp vector of SIZE bytes that can passed to
-WITH-POINTER-TO-VECTOR-DATA."
- (make-array size :element-type '(unsigned-byte 8)))
-
-(defmacro with-pointer-to-vector-data ((ptr-var vector) &body body)
- "Bind PTR-VAR to a foreign pointer to the data in VECTOR."
- `(ccl:with-pointer-to-ivector (,ptr-var ,vector)
- ,@body))
-
-;;;# Dereferencing
-
-;;; Define the %MEM-REF and %MEM-SET functions, as well as compiler
-;;; macros that optimize the case where the type keyword is constant
-;;; at compile-time.
-(defmacro define-mem-accessors (&body pairs)
- `(progn
- (defun %mem-ref (ptr type &optional (offset 0))
- (ecase type
- ,@(loop for (keyword fn) in pairs
- collect `(,keyword (,fn ptr offset)))))
- (defun %mem-set (value ptr type &optional (offset 0))
- (ecase type
- ,@(loop for (keyword fn) in pairs
- collect `(,keyword (setf (,fn ptr offset) value)))))
- (define-compiler-macro %mem-ref
- (&whole form ptr type &optional (offset 0))
- (if (constantp type)
- (ecase (eval type)
- ,@(loop for (keyword fn) in pairs
- collect `(,keyword `(,',fn ,ptr ,offset))))
- form))
- (define-compiler-macro %mem-set
- (&whole form value ptr type &optional (offset 0))
- (if (constantp type)
- (once-only (value)
- (ecase (eval type)
- ,@(loop for (keyword fn) in pairs
- collect `(,keyword `(setf (,',fn ,ptr ,offset)
- ,value)))))
- form))))
-
-(define-mem-accessors
- (:char %get-signed-byte)
- (:unsigned-char %get-unsigned-byte)
- (:short %get-signed-word)
- (:unsigned-short %get-unsigned-word)
- (:int %get-signed-long)
- (:unsigned-int %get-unsigned-long)
- #+(or 32-bit-target windows-target) (:long %get-signed-long)
- #+(and (not windows-target) 64-bit-target) (:long ccl::%%get-signed-longlong)
- #+(or 32-bit-target windows-target) (:unsigned-long %get-unsigned-long)
- #+(and 64-bit-target (not windows-target)) (:unsigned-long ccl::%%get-unsigned-longlong)
- (:long-long ccl::%get-signed-long-long)
- (:unsigned-long-long ccl::%get-unsigned-long-long)
- (:float %get-single-float)
- (:double %get-double-float)
- (:pointer %get-ptr))
-
-;;;# Calling Foreign Functions
-
-(defun convert-foreign-type (type-keyword)
- "Convert a CFFI type keyword to an OpenMCL type."
- (ecase type-keyword
- (:char :signed-byte)
- (:unsigned-char :unsigned-byte)
- (:short :signed-short)
- (:unsigned-short :unsigned-short)
- (:int :signed-int)
- (:unsigned-int :unsigned-int)
- (:long :signed-long)
- (:unsigned-long :unsigned-long)
- (:long-long :signed-doubleword)
- (:unsigned-long-long :unsigned-doubleword)
- (:float :single-float)
- (:double :double-float)
- (:pointer :address)
- (:void :void)))
-
-(defun %foreign-type-size (type-keyword)
- "Return the size in bytes of a foreign type."
- (/ (ccl::foreign-type-bits
- (ccl::parse-foreign-type
- (convert-foreign-type type-keyword)))
- 8))
-
-;; There be dragons here. See the following thread for details:
-;; http://clozure.com/pipermail/openmcl-devel/2005-June/002777.html
-(defun %foreign-type-alignment (type-keyword)
- "Return the alignment in bytes of a foreign type."
- (/ (ccl::foreign-type-alignment
- (ccl::parse-foreign-type
- (convert-foreign-type type-keyword))) 8))
-
-(defun convert-foreign-funcall-types (args)
- "Convert foreign types for a call to FOREIGN-FUNCALL."
- (loop for (type arg) on args by #'cddr
- collect (convert-foreign-type type)
- if arg collect arg))
-
-(defun convert-external-name (name)
- "Add an underscore to NAME if necessary for the ABI."
- #+darwin (concatenate 'string "_" name)
- #-darwin name)
-
-(defmacro %foreign-funcall (function-name args &key library convention)
- "Perform a foreign function call, document it more later."
- (declare (ignore library convention))
- `(external-call
- ,(convert-external-name function-name)
- ,@(convert-foreign-funcall-types args)))
-
-(defmacro %foreign-funcall-pointer (ptr args &key convention)
- (declare (ignore convention))
- `(ff-call ,ptr ,@(convert-foreign-funcall-types args)))
-
-;;;# Callbacks
-
-;;; The *CALLBACKS* hash table maps CFFI callback names to OpenMCL "macptr"
-;;; entry points. It is safe to store the pointers directly because
-;;; OpenMCL will update the address of these pointers when a saved image
-;;; is loaded (see CCL::RESTORE-PASCAL-FUNCTIONS).
-(defvar *callbacks* (make-hash-table))
-
-;;; Create a package to contain the symbols for callback functions. We
-;;; want to redefine callbacks with the same symbol so the internal data
-;;; structures are reused.
-(defpackage #:cffi-callbacks
- (:use))
-
-;;; Intern a symbol in the CFFI-CALLBACKS package used to name the internal
-;;; callback for NAME.
-(defun intern-callback (name)
- (intern (format nil "~A::~A"
- (if-let (package (symbol-package name))
- (package-name package)
- "#")
- (symbol-name name))
- '#:cffi-callbacks))
-
-(defmacro %defcallback (name rettype arg-names arg-types body
- &key convention)
- (let ((cb-name (intern-callback name)))
- `(progn
- (defcallback ,cb-name
- (,@(when (eq convention :stdcall)
- '(:discard-stack-args))
- ,@(mapcan (lambda (sym type)
- (list (convert-foreign-type type) sym))
- arg-names arg-types)
- ,(convert-foreign-type rettype))
- ,body)
- (setf (gethash ',name *callbacks*) (symbol-value ',cb-name)))))
-
-(defun %callback (name)
- (or (gethash name *callbacks*)
- (error "Undefined callback: ~S" name)))
-
-;;;# Loading Foreign Libraries
-
-(defun %load-foreign-library (name path)
- "Load the foreign library NAME."
- (declare (ignore name))
- (open-shared-library path))
-
-(defun %close-foreign-library (name)
- "Close the foreign library NAME."
- ;; C-S-L sometimes ends in an endless loop
- ;; with :COMPLETELY T
- (close-shared-library name :completely nil))
-
-(defun native-namestring (pathname)
- (ccl::native-translated-namestring pathname))
-
-;;;# Foreign Globals
-
-(defun %foreign-symbol-pointer (name library)
- "Returns a pointer to a foreign symbol NAME."
- (declare (ignore library))
- (foreign-symbol-address (convert-external-name name)))
(DIR) diff --git a/3rdparties/software/cffi_0.20.0/src/cffi-sbcl.lisp b/3rdparties/software/cffi_0.20.0/src/cffi-sbcl.lisp
@@ -1,408 +0,0 @@
-;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
-;;;
-;;; cffi-sbcl.lisp --- CFFI-SYS implementation for SBCL.
-;;;
-;;; Copyright (C) 2005-2006, James Bielman <jamesjb@jamesjb.com>
-;;;
-;;; Permission is hereby granted, free of charge, to any person
-;;; obtaining a copy of this software and associated documentation
-;;; files (the "Software"), to deal in the Software without
-;;; restriction, including without limitation the rights to use, copy,
-;;; modify, merge, publish, distribute, sublicense, and/or sell copies
-;;; of the Software, and to permit persons to whom the Software is
-;;; furnished to do so, subject to the following conditions:
-;;;
-;;; The above copyright notice and this permission notice shall be
-;;; included in all copies or substantial portions of the Software.
-;;;
-;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
-;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
-;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
-;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
-;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
-;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
-;;; DEALINGS IN THE SOFTWARE.
-;;;
-
-;;;# Administrivia
-
-(defpackage #:cffi-sys
- (:use #:common-lisp #:sb-alien)
- (:import-from #:alexandria
- #:once-only #:with-unique-names #:when-let #:removef)
- (:export
- #:canonicalize-symbol-name-case
- #:foreign-pointer
- #:pointerp
- #:pointer-eq
- #:null-pointer
- #:null-pointer-p
- #:inc-pointer
- #:make-pointer
- #:pointer-address
- #:%foreign-alloc
- #:foreign-free
- #:with-foreign-pointer
- #:%foreign-funcall
- #:%foreign-funcall-pointer
- #:%foreign-type-alignment
- #:%foreign-type-size
- #:%load-foreign-library
- #:%close-foreign-library
- #:native-namestring
- #:%mem-ref
- #:%mem-set
- #:make-shareable-byte-vector
- #:with-pointer-to-vector-data
- #:%foreign-symbol-pointer
- #:%defcallback
- #:%callback))
-
-(in-package #:cffi-sys)
-
-;;;# Misfeatures
-
-(pushnew 'flat-namespace *features*)
-
-;;;# Symbol Case
-
-(declaim (inline canonicalize-symbol-name-case))
-(defun canonicalize-symbol-name-case (name)
- (declare (string name))
- (string-upcase name))
-
-;;;# Basic Pointer Operations
-
-(deftype foreign-pointer ()
- 'sb-sys:system-area-pointer)
-
-(declaim (inline pointerp))
-(defun pointerp (ptr)
- "Return true if PTR is a foreign pointer."
- (sb-sys:system-area-pointer-p ptr))
-
-(declaim (inline pointer-eq))
-(defun pointer-eq (ptr1 ptr2)
- "Return true if PTR1 and PTR2 point to the same address."
- (declare (type system-area-pointer ptr1 ptr2))
- (sb-sys:sap= ptr1 ptr2))
-
-(declaim (inline null-pointer))
-(defun null-pointer ()
- "Construct and return a null pointer."
- (sb-sys:int-sap 0))
-
-(declaim (inline null-pointer-p))
-(defun null-pointer-p (ptr)
- "Return true if PTR is a null pointer."
- (declare (type system-area-pointer ptr))
- (zerop (sb-sys:sap-int ptr)))
-
-(declaim (inline inc-pointer))
-(defun inc-pointer (ptr offset)
- "Return a pointer pointing OFFSET bytes past PTR."
- (declare (type system-area-pointer ptr)
- (type integer offset))
- (sb-sys:sap+ ptr offset))
-
-(declaim (inline make-pointer))
-(defun make-pointer (address)
- "Return a pointer pointing to ADDRESS."
- ;; (declare (type (unsigned-byte 32) address))
- (sb-sys:int-sap address))
-
-(declaim (inline pointer-address))
-(defun pointer-address (ptr)
- "Return the address pointed to by PTR."
- (declare (type system-area-pointer ptr))
- (sb-sys:sap-int ptr))
-
-;;;# Allocation
-;;;
-;;; Functions and macros for allocating foreign memory on the stack
-;;; and on the heap. The main CFFI package defines macros that wrap
-;;; FOREIGN-ALLOC and FOREIGN-FREE in UNWIND-PROTECT for the common usage
-;;; when the memory has dynamic extent.
-
-(declaim (inline %foreign-alloc))
-(defun %foreign-alloc (size)
- "Allocate SIZE bytes on the heap and return a pointer."
- ;; (declare (type (unsigned-byte 32) size))
- (alien-sap (make-alien (unsigned 8) size)))
-
-(declaim (inline foreign-free))
-(defun foreign-free (ptr)
- "Free a PTR allocated by FOREIGN-ALLOC."
- (declare (type system-area-pointer ptr)
- (optimize speed))
- (free-alien (sap-alien ptr (* (unsigned 8)))))
-
-(defmacro with-foreign-pointer ((var size &optional size-var) &body body)
- "Bind VAR to SIZE bytes of foreign memory during BODY. The
-pointer in VAR is invalid beyond the dynamic extent of BODY, and
-may be stack-allocated if supported by the implementation. If
-SIZE-VAR is supplied, it will be bound to SIZE during BODY."
- (unless size-var
- (setf size-var (gensym "SIZE")))
- ;; If the size is constant we can stack-allocate.
- (if (constantp size)
- (let ((alien-var (gensym "ALIEN")))
- `(with-alien ((,alien-var (array (unsigned 8) ,(eval size))))
- (let ((,size-var ,(eval size))
- (,var (alien-sap ,alien-var)))
- (declare (ignorable ,size-var))
- ,@body)))
- `(let* ((,size-var ,size)
- (,var (%foreign-alloc ,size-var)))
- (unwind-protect
- (progn ,@body)
- (foreign-free ,var)))))
-
-;;;# Shareable Vectors
-;;;
-;;; This interface is very experimental. WITH-POINTER-TO-VECTOR-DATA
-;;; should be defined to perform a copy-in/copy-out if the Lisp
-;;; implementation can't do this.
-
-(declaim (inline make-shareable-byte-vector))
-(defun make-shareable-byte-vector (size)
- "Create a Lisp vector of SIZE bytes can passed to
-WITH-POINTER-TO-VECTOR-DATA."
- ; (declare (type sb-int:index size))
- (make-array size :element-type '(unsigned-byte 8)))
-
-(defmacro with-pointer-to-vector-data ((ptr-var vector) &body body)
- "Bind PTR-VAR to a foreign pointer to the data in VECTOR."
- (let ((vector-var (gensym "VECTOR")))
- `(let ((,vector-var ,vector))
- (declare (type (sb-kernel:simple-unboxed-array (*)) ,vector-var))
- (sb-sys:with-pinned-objects (,vector-var)
- (let ((,ptr-var (sb-sys:vector-sap ,vector-var)))
- ,@body)))))
-
-;;;# Dereferencing
-
-;;; Define the %MEM-REF and %MEM-SET functions, as well as compiler
-;;; macros that optimize the case where the type keyword is constant
-;;; at compile-time.
-(defmacro define-mem-accessors (&body pairs)
- `(progn
- (defun %mem-ref (ptr type &optional (offset 0))
- (ecase type
- ,@(loop for (keyword fn) in pairs
- collect `(,keyword (,fn ptr offset)))))
- (defun %mem-set (value ptr type &optional (offset 0))
- (ecase type
- ,@(loop for (keyword fn) in pairs
- collect `(,keyword (setf (,fn ptr offset) value)))))
- (define-compiler-macro %mem-ref
- (&whole form ptr type &optional (offset 0))
- (if (constantp type)
- (ecase (eval type)
- ,@(loop for (keyword fn) in pairs
- collect `(,keyword `(,',fn ,ptr ,offset))))
- form))
- (define-compiler-macro %mem-set
- (&whole form value ptr type &optional (offset 0))
- (if (constantp type)
- (once-only (value)
- (ecase (eval type)
- ,@(loop for (keyword fn) in pairs
- collect `(,keyword `(setf (,',fn ,ptr ,offset)
- ,value)))))
- form))))
-
-;;; Look up alien type information and build both define-mem-accessors form
-;;; and convert-foreign-type function definition.
-(defmacro define-type-mapping (accessor-table alien-table)
- (let* ((accessible-types
- (remove 'void alien-table :key #'second))
- (size-and-signedp-forms
- (mapcar (lambda (name)
- (list (eval `(alien-size ,(second name)))
- (typep -1 `(alien ,(second name)))))
- accessible-types)))
- `(progn
- (define-mem-accessors
- ,@(loop for (cffi-keyword alien-type fixed-accessor)
- in accessible-types
- and (alien-size signedp)
- in size-and-signedp-forms
- for (signed-ref unsigned-ref)
- = (cdr (assoc alien-size accessor-table))
- collect
- `(,cffi-keyword
- ,(or fixed-accessor
- (if signedp signed-ref unsigned-ref)
- (error "No accessor found for ~S"
- alien-type)))))
- (defun convert-foreign-type (type-keyword)
- (ecase type-keyword
- ,@(loop for (cffi-keyword alien-type) in alien-table
- collect `(,cffi-keyword (quote ,alien-type))))))))
-
-(define-type-mapping
- ((8 sb-sys:signed-sap-ref-8 sb-sys:sap-ref-8)
- (16 sb-sys:signed-sap-ref-16 sb-sys:sap-ref-16)
- (32 sb-sys:signed-sap-ref-32 sb-sys:sap-ref-32)
- (64 sb-sys:signed-sap-ref-64 sb-sys:sap-ref-64))
- ((:char char)
- (:unsigned-char unsigned-char)
- (:short short)
- (:unsigned-short unsigned-short)
- (:int int)
- (:unsigned-int unsigned-int)
- (:long long)
- (:unsigned-long unsigned-long)
- (:long-long long-long)
- (:unsigned-long-long unsigned-long-long)
- (:float single-float
- sb-sys:sap-ref-single)
- (:double double-float
- sb-sys:sap-ref-double)
- (:pointer system-area-pointer
- sb-sys:sap-ref-sap)
- (:void void)))
-
-;;;# Calling Foreign Functions
-
-(defun %foreign-type-size (type-keyword)
- "Return the size in bytes of a foreign type."
- (/ (sb-alien-internals:alien-type-bits
- (sb-alien-internals:parse-alien-type
- (convert-foreign-type type-keyword) nil)) 8))
-
-(defun %foreign-type-alignment (type-keyword)
- "Return the alignment in bytes of a foreign type."
- #+(and darwin ppc (not ppc64))
- (case type-keyword
- ((:double :long-long :unsigned-long-long)
- (return-from %foreign-type-alignment 8)))
- ;; No override necessary for other types...
- (/ (sb-alien-internals:alien-type-alignment
- (sb-alien-internals:parse-alien-type
- (convert-foreign-type type-keyword) nil)) 8))
-
-(defun foreign-funcall-type-and-args (args)
- "Return an SB-ALIEN function type for ARGS."
- (let ((return-type 'void))
- (loop for (type arg) on args by #'cddr
- if arg collect (convert-foreign-type type) into types
- and collect arg into fargs
- else do (setf return-type (convert-foreign-type type))
- finally (return (values types fargs return-type)))))
-
-(defmacro %%foreign-funcall (name types fargs rettype)
- "Internal guts of %FOREIGN-FUNCALL."
- `(alien-funcall
- (extern-alien ,name (function ,rettype ,@types))
- ,@fargs))
-
-(defmacro %foreign-funcall (name args &key library convention)
- "Perform a foreign function call, document it more later."
- (declare (ignore library convention))
- (multiple-value-bind (types fargs rettype)
- (foreign-funcall-type-and-args args)
- `(%%foreign-funcall ,name ,types ,fargs ,rettype)))
-
-(defmacro %foreign-funcall-pointer (ptr args &key convention)
- "Funcall a pointer to a foreign function."
- (declare (ignore convention))
- (multiple-value-bind (types fargs rettype)
- (foreign-funcall-type-and-args args)
- (with-unique-names (function)
- `(with-alien ((,function (* (function ,rettype ,@types)) ,ptr))
- (alien-funcall ,function ,@fargs)))))
-
-;;;# Callbacks
-
-;;; The *CALLBACKS* hash table contains a direct mapping of CFFI
-;;; callback names to SYSTEM-AREA-POINTERs obtained by ALIEN-LAMBDA.
-;;; SBCL will maintain the addresses of the callbacks across saved
-;;; images, so it is safe to store the pointers directly.
-(defvar *callbacks* (make-hash-table))
-
-(defmacro %defcallback (name rettype arg-names arg-types body
- &key convention)
- (check-type convention (member :stdcall :cdecl))
- `(setf (gethash ',name *callbacks*)
- (alien-sap
- (sb-alien::alien-lambda
- #+alien-callback-conventions
- (,convention ,(convert-foreign-type rettype))
- #-alien-callback-conventions
- ,(convert-foreign-type rettype)
- ,(mapcar (lambda (sym type)
- (list sym (convert-foreign-type type)))
- arg-names arg-types)
- ,body))))
-
-(defun %callback (name)
- (or (gethash name *callbacks*)
- (error "Undefined callback: ~S" name)))
-
-;;;# Loading and Closing Foreign Libraries
-
-#+darwin
-(defun call-within-initial-thread (fn &rest args)
- (let (result
- error
- (sem (sb-thread:make-semaphore)))
- (sb-thread:interrupt-thread
- ;; KLUDGE: find a better way to get the initial thread.
- (car (last (sb-thread:list-all-threads)))
- (lambda ()
- (multiple-value-setq (result error)
- (ignore-errors (apply fn args)))
- (sb-thread:signal-semaphore sem)))
- (sb-thread:wait-on-semaphore sem)
- (if error
- (signal error)
- result)))
-
-(declaim (inline %load-foreign-library))
-(defun %load-foreign-library (name path)
- "Load a foreign library."
- (declare (ignore name))
- ;; As of MacOS X 10.6.6, loading things like CoreFoundation from a
- ;; thread other than the initial one results in a crash.
- #+darwin (call-within-initial-thread 'load-shared-object path)
- #-darwin (load-shared-object path))
-
-;;; SBCL 1.0.21.15 renamed SB-ALIEN::SHARED-OBJECT-FILE but introduced
-;;; SB-ALIEN:UNLOAD-SHARED-OBJECT which we can use instead.
-(eval-when (:compile-toplevel :load-toplevel :execute)
- (defun unload-shared-object-present-p ()
- (multiple-value-bind (foundp kind)
- (find-symbol "UNLOAD-SHARED-OBJECT" "SB-ALIEN")
- (if (and foundp (eq kind :external))
- '(:and)
- '(:or)))))
-
-(defun %close-foreign-library (handle)
- "Closes a foreign library."
- #+#.(cffi-sys::unload-shared-object-present-p)
- (sb-alien:unload-shared-object handle)
- #-#.(cffi-sys::unload-shared-object-present-p)
- (sb-thread:with-mutex (sb-alien::*shared-objects-lock*)
- (let ((obj (find (sb-ext:native-namestring handle)
- sb-alien::*shared-objects*
- :key #'sb-alien::shared-object-file
- :test #'string=)))
- (when obj
- (sb-alien::dlclose-or-lose obj)
- (removef sb-alien::*shared-objects* obj)
- #+(and linkage-table (not win32))
- (sb-alien::update-linkage-table)))))
-
-(defun native-namestring (pathname)
- (sb-ext:native-namestring pathname))
-
-;;;# Foreign Globals
-
-(defun %foreign-symbol-pointer (name library)
- "Returns a pointer to a foreign symbol NAME."
- (declare (ignore library))
- (when-let (address (sb-sys:find-foreign-symbol-address name))
- (sb-sys:int-sap address)))
(DIR) diff --git a/3rdparties/software/cffi_0.20.0/src/cffi-scl.lisp b/3rdparties/software/cffi_0.20.0/src/cffi-scl.lisp
@@ -1,322 +0,0 @@
-;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
-;;;
-;;; cffi-scl.lisp --- CFFI-SYS implementation for the Scieneer Common Lisp.
-;;;
-;;; Copyright (C) 2005-2006, James Bielman <jamesjb@jamesjb.com>
-;;; Copyright (C) 2006-2007, Scieneer Pty Ltd.
-;;;
-;;; Permission is hereby granted, free of charge, to any person
-;;; obtaining a copy of this software and associated documentation
-;;; files (the "Software"), to deal in the Software without
-;;; restriction, including without limitation the rights to use, copy,
-;;; modify, merge, publish, distribute, sublicense, and/or sell copies
-;;; of the Software, and to permit persons to whom the Software is
-;;; furnished to do so, subject to the following conditions:
-;;;
-;;; The above copyright notice and this permission notice shall be
-;;; included in all copies or substantial portions of the Software.
-;;;
-;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
-;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
-;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
-;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
-;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
-;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
-;;; DEALINGS IN THE SOFTWARE.
-;;;
-
-;;;# Administrivia
-
-(defpackage #:cffi-sys
- (:use #:common-lisp #:alien #:c-call)
- (:import-from #:alexandria #:once-only #:with-unique-names)
- (:export
- #:canonicalize-symbol-name-case
- #:foreign-pointer
- #:pointerp
- #:pointer-eq
- #:null-pointer
- #:null-pointer-p
- #:inc-pointer
- #:make-pointer
- #:pointer-address
- #:%foreign-alloc
- #:foreign-free
- #:with-foreign-pointer
- #:%foreign-funcall
- #:%foreign-funcall-pointer
- #:%foreign-type-alignment
- #:%foreign-type-size
- #:%load-foreign-library
- #:%close-foreign-library
- #:native-namestring
- #:%mem-ref
- #:%mem-set
- #:make-shareable-byte-vector
- #:with-pointer-to-vector-data
- #:%foreign-symbol-pointer
- #:%defcallback
- #:%callback))
-
-(in-package #:cffi-sys)
-
-;;;# Mis-features
-
-(pushnew 'flat-namespace *features*)
-
-;;;# Symbol Case
-
-(defun canonicalize-symbol-name-case (name)
- (declare (string name))
- (if (eq ext:*case-mode* :upper)
- (string-upcase name)
- (string-downcase name)))
-
-;;;# Basic Pointer Operations
-
-(deftype foreign-pointer ()
- 'sys:system-area-pointer)
-
-(declaim (inline pointerp))
-(defun pointerp (ptr)
- "Return true if 'ptr is a foreign pointer."
- (sys:system-area-pointer-p ptr))
-
-(declaim (inline pointer-eq))
-(defun pointer-eq (ptr1 ptr2)
- "Return true if 'ptr1 and 'ptr2 point to the same address."
- (sys:sap= ptr1 ptr2))
-
-(declaim (inline null-pointer))
-(defun null-pointer ()
- "Construct and return a null pointer."
- (sys:int-sap 0))
-
-(declaim (inline null-pointer-p))
-(defun null-pointer-p (ptr)
- "Return true if 'ptr is a null pointer."
- (zerop (sys:sap-int ptr)))
-
-(declaim (inline inc-pointer))
-(defun inc-pointer (ptr offset)
- "Return a pointer pointing 'offset bytes past 'ptr."
- (sys:sap+ ptr offset))
-
-(declaim (inline make-pointer))
-(defun make-pointer (address)
- "Return a pointer pointing to 'address."
- (sys:int-sap address))
-
-(declaim (inline pointer-address))
-(defun pointer-address (ptr)
- "Return the address pointed to by 'ptr."
- (sys:sap-int ptr))
-
-(defmacro with-foreign-pointer ((var size &optional size-var) &body body)
- "Bind 'var to 'size bytes of foreign memory during 'body. The
- pointer in 'var is invalid beyond the dynamic extent of 'body, and
- may be stack-allocated if supported by the implementation. If
- 'size-var is supplied, it will be bound to 'size during 'body."
- (unless size-var
- (setf size-var (gensym (symbol-name '#:size))))
- ;; If the size is constant we can stack-allocate.
- (cond ((constantp size)
- (let ((alien-var (gensym (symbol-name '#:alien))))
- `(with-alien ((,alien-var (array (unsigned 8) ,(eval size))))
- (let ((,size-var ,size)
- (,var (alien-sap ,alien-var)))
- (declare (ignorable ,size-var))
- ,@body))))
- (t
- `(let ((,size-var ,size))
- (alien:with-bytes (,var ,size-var)
- ,@body)))))
-
-;;;# Allocation
-;;;
-;;; Functions and macros for allocating foreign memory on the stack and on the
-;;; heap. The main CFFI package defines macros that wrap 'foreign-alloc and
-;;; 'foreign-free in 'unwind-protect for the common usage when the memory has
-;;; dynamic extent.
-
-(defun %foreign-alloc (size)
- "Allocate 'size bytes on the heap and return a pointer."
- (declare (type (unsigned-byte #-64bit 32 #+64bit 64) size))
- (alien-funcall (extern-alien "malloc"
- (function system-area-pointer unsigned))
- size))
-
-(defun foreign-free (ptr)
- "Free a 'ptr allocated by 'foreign-alloc."
- (declare (type system-area-pointer ptr))
- (alien-funcall (extern-alien "free"
- (function (values) system-area-pointer))
- ptr))
-
-;;;# Shareable Vectors
-
-(defun make-shareable-byte-vector (size)
- "Create a Lisp vector of 'size bytes that can passed to
- 'with-pointer-to-vector-data."
- (make-array size :element-type '(unsigned-byte 8)))
-
-(defmacro with-pointer-to-vector-data ((ptr-var vector) &body body)
- "Bind 'ptr-var to a foreign pointer to the data in 'vector."
- (let ((vector-var (gensym (symbol-name '#:vector))))
- `(let ((,vector-var ,vector))
- (ext:with-pinned-object (,vector-var)
- (let ((,ptr-var (sys:vector-sap ,vector-var)))
- ,@body)))))
-
-;;;# Dereferencing
-
-;;; Define the %MEM-REF and %MEM-SET functions, as well as compiler
-;;; macros that optimize the case where the type keyword is constant
-;;; at compile-time.
-(defmacro define-mem-accessors (&body pairs)
- `(progn
- (defun %mem-ref (ptr type &optional (offset 0))
- (ecase type
- ,@(loop for (keyword fn) in pairs
- collect `(,keyword (,fn ptr offset)))))
- (defun %mem-set (value ptr type &optional (offset 0))
- (ecase type
- ,@(loop for (keyword fn) in pairs
- collect `(,keyword (setf (,fn ptr offset) value)))))
- (define-compiler-macro %mem-ref
- (&whole form ptr type &optional (offset 0))
- (if (constantp type)
- (ecase (eval type)
- ,@(loop for (keyword fn) in pairs
- collect `(,keyword `(,',fn ,ptr ,offset))))
- form))
- (define-compiler-macro %mem-set
- (&whole form value ptr type &optional (offset 0))
- (if (constantp type)
- (once-only (value)
- (ecase (eval type)
- ,@(loop for (keyword fn) in pairs
- collect `(,keyword `(setf (,',fn ,ptr ,offset)
- ,value)))))
- form))))
-
-(define-mem-accessors
- (:char sys:signed-sap-ref-8)
- (:unsigned-char sys:sap-ref-8)
- (:short sys:signed-sap-ref-16)
- (:unsigned-short sys:sap-ref-16)
- (:int sys:signed-sap-ref-32)
- (:unsigned-int sys:sap-ref-32)
- (:long #-64bit sys:signed-sap-ref-32 #+64bit sys:signed-sap-ref-64)
- (:unsigned-long #-64bit sys:sap-ref-32 #+64bit sys:sap-ref-64)
- (:long-long sys:signed-sap-ref-64)
- (:unsigned-long-long sys:sap-ref-64)
- (:float sys:sap-ref-single)
- (:double sys:sap-ref-double)
- #+long-float (:long-double sys:sap-ref-long)
- (:pointer sys:sap-ref-sap))
-
-;;;# Calling Foreign Functions
-
-(defun convert-foreign-type (type-keyword)
- "Convert a CFFI type keyword to an ALIEN type."
- (ecase type-keyword
- (:char 'char)
- (:unsigned-char 'unsigned-char)
- (:short 'short)
- (:unsigned-short 'unsigned-short)
- (:int 'int)
- (:unsigned-int 'unsigned-int)
- (:long 'long)
- (:unsigned-long 'unsigned-long)
- (:long-long '(signed 64))
- (:unsigned-long-long '(unsigned 64))
- (:float 'single-float)
- (:double 'double-float)
- #+long-float
- (:long-double 'long-float)
- (:pointer 'system-area-pointer)
- (:void 'void)))
-
-(defun %foreign-type-size (type-keyword)
- "Return the size in bytes of a foreign type."
- (values (truncate (alien-internals:alien-type-bits
- (alien-internals:parse-alien-type
- (convert-foreign-type type-keyword)))
- 8)))
-
-(defun %foreign-type-alignment (type-keyword)
- "Return the alignment in bytes of a foreign type."
- (values (truncate (alien-internals:alien-type-alignment
- (alien-internals:parse-alien-type
- (convert-foreign-type type-keyword)))
- 8)))
-
-(defun foreign-funcall-type-and-args (args)
- "Return an 'alien function type for 'args."
- (let ((return-type nil))
- (loop for (type arg) on args by #'cddr
- if arg collect (convert-foreign-type type) into types
- and collect arg into fargs
- else do (setf return-type (convert-foreign-type type))
- finally (return (values types fargs return-type)))))
-
-(defmacro %%foreign-funcall (name types fargs rettype)
- "Internal guts of '%foreign-funcall."
- `(alien-funcall (extern-alien ,name (function ,rettype ,@types))
- ,@fargs))
-
-(defmacro %foreign-funcall (name args &key library convention)
- "Perform a foreign function call, document it more later."
- (declare (ignore library convention))
- (multiple-value-bind (types fargs rettype)
- (foreign-funcall-type-and-args args)
- `(%%foreign-funcall ,name ,types ,fargs ,rettype)))
-
-(defmacro %foreign-funcall-pointer (ptr args &key convention)
- "Funcall a pointer to a foreign function."
- (declare (ignore convention))
- (multiple-value-bind (types fargs rettype)
- (foreign-funcall-type-and-args args)
- (with-unique-names (function)
- `(with-alien ((,function (* (function ,rettype ,@types)) ,ptr))
- (alien-funcall ,function ,@fargs)))))
-
-;;; Callbacks
-
-(defmacro %defcallback (name rettype arg-names arg-types body
- &key convention)
- (declare (ignore convention))
- `(alien:defcallback ,name
- (,(convert-foreign-type rettype)
- ,@(mapcar (lambda (sym type)
- (list sym (convert-foreign-type type)))
- arg-names arg-types))
- ,body))
-
-(declaim (inline %callback))
-(defun %callback (name)
- (alien:callback-sap name))
-
-;;;# Loading and Closing Foreign Libraries
-
-(defun %load-foreign-library (name path)
- "Load the foreign library 'name."
- (declare (ignore name))
- (ext:load-dynamic-object path))
-
-(defun %close-foreign-library (name)
- "Closes the foreign library 'name."
- (ext:close-dynamic-object name))
-
-(defun native-namestring (pathname)
- (ext:unix-namestring pathname nil))
-
-;;;# Foreign Globals
-
-(defun %foreign-symbol-pointer (name library)
- "Returns a pointer to a foreign symbol 'name."
- (declare (ignore library))
- (let ((sap (sys:foreign-symbol-address name)))
- (if (zerop (sys:sap-int sap)) nil sap)))
(DIR) diff --git a/3rdparties/software/cffi_0.20.0/src/early-types.lisp b/3rdparties/software/cffi_0.20.0/src/early-types.lisp
@@ -1,713 +0,0 @@
-;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
-;;;
-;;; early-types.lisp --- Low-level foreign type operations.
-;;;
-;;; Copyright (C) 2005-2006, James Bielman <jamesjb@jamesjb.com>
-;;; Copyright (C) 2005-2007, Luis Oliveira <loliveira@common-lisp.net>
-;;;
-;;; Permission is hereby granted, free of charge, to any person
-;;; obtaining a copy of this software and associated documentation
-;;; files (the "Software"), to deal in the Software without
-;;; restriction, including without limitation the rights to use, copy,
-;;; modify, merge, publish, distribute, sublicense, and/or sell copies
-;;; of the Software, and to permit persons to whom the Software is
-;;; furnished to do so, subject to the following conditions:
-;;;
-;;; The above copyright notice and this permission notice shall be
-;;; included in all copies or substantial portions of the Software.
-;;;
-;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
-;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
-;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
-;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
-;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
-;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
-;;; DEALINGS IN THE SOFTWARE.
-;;;
-
-;;;# Early Type Definitions
-;;;
-;;; This module contains basic operations on foreign types. These
-;;; definitions are in a separate file because they may be used in
-;;; compiler macros defined later on.
-
-(in-package #:cffi)
-
-;;;# Foreign Types
-;;;
-;;; Type specifications are of the form (type {args}*). The type
-;;; parser can specify how its arguments should look like through a
-;;; lambda list.
-;;;
-;;; "type" is a shortcut for "(type)", ie, no args were specified.
-;;;
-;;; Examples of such types: boolean, (boolean), (boolean :int) If the
-;;; boolean type parser specifies the lambda list: &optional
-;;; (base-type :int), then all of the above three type specs would be
-;;; parsed to an identical type.
-;;;
-;;; Type parsers, defined with DEFINE-PARSE-METHOD should return a
-;;; subtype of the foreign-type class.
-
-(defvar *type-parsers* (make-hash-table :test 'equal)
- "Hash table of defined type parsers.")
-
-(define-condition cffi-error (error)
- ())
-
-(define-condition foreign-type-error (cffi-error)
- ((type-name :initarg :type-name
- :initform (error "Must specify TYPE-NAME.")
- :accessor foreign-type-error/type-name)
- (namespace :initarg :namespace
- :initform :default
- :accessor foreign-type-error/namespace)))
-
-(defun foreign-type-error/compound-name (e)
- (let ((name (foreign-type-error/type-name e))
- (namespace (foreign-type-error/namespace e)))
- (if (eq namespace :default)
- name
- `(,namespace ,name))))
-
-(define-condition simple-foreign-type-error (simple-error foreign-type-error)
- ())
-
-(defun simple-foreign-type-error (type-name namespace format-control &rest format-arguments)
- (error 'simple-foreign-type-error
- :type-name type-name :namespace namespace
- :format-control format-control :format-arguments format-arguments))
-
-(define-condition undefined-foreign-type-error (foreign-type-error)
- ()
- (:report (lambda (e stream)
- (format stream "Unknown CFFI type ~S" (foreign-type-error/compound-name e)))))
-
-(defun undefined-foreign-type-error (type-name &optional (namespace :default))
- (error 'undefined-foreign-type-error :type-name type-name :namespace namespace))
-
-;; TODO this is not according to the C namespace rules,
-;; see bug: https://bugs.launchpad.net/cffi/+bug/1527947
-(deftype c-namespace-name ()
- '(member :default :struct :union))
-
-;; for C namespaces read: https://stackoverflow.com/questions/12579142/type-namespace-in-c
-;; (section 6.2.3 Name spaces of identifiers)
-;; NOTE: :struct is probably an unfortunate name for the tagged (?) namespace
-(defun find-type-parser (symbol &optional (namespace :default))
- "Return the type parser for SYMBOL. NAMESPACE is either :DEFAULT (for
-variables, functions, and typedefs) or :STRUCT (for structs, unions, and enums)."
- (check-type symbol (and symbol (not null)))
- (check-type namespace c-namespace-name)
- (or (gethash (cons namespace symbol) *type-parsers*)
- (undefined-foreign-type-error symbol namespace)))
-
-(defun (setf find-type-parser) (func symbol &optional (namespace :default))
- "Set the type parser for SYMBOL."
- (check-type symbol (and symbol (not null)))
- (check-type namespace c-namespace-name)
- ;; TODO Shall we signal a redefinition warning here?
- (setf (gethash (cons namespace symbol) *type-parsers*) func))
-
-(defun undefine-foreign-type (symbol &optional (namespace :default))
- (remhash (cons namespace symbol) *type-parsers*)
- (values))
-
-;;; Using a generic function would have been nicer but generates lots
-;;; of style warnings in SBCL. (Silly reason, yes.)
-(defmacro define-parse-method (name lambda-list &body body)
- "Define a type parser on NAME and lists whose CAR is NAME."
- (discard-docstring body)
- (warn-if-kw-or-belongs-to-cl name)
- `(eval-when (:compile-toplevel :load-toplevel :execute)
- (setf (find-type-parser ',name)
- (lambda ,lambda-list ,@body))
- ',name))
-
-;;; Utility function for the simple case where the type takes no
-;;; arguments.
-(defun notice-foreign-type (name type &optional (namespace :default))
- (setf (find-type-parser name namespace) (lambda () type))
- name)
-
-;;;# Generic Functions on Types
-
-(defgeneric canonicalize (foreign-type)
- (:documentation
- "Return the most primitive foreign type for FOREIGN-TYPE, either a built-in
-type--a keyword--or a struct/union type--a list of the form (:STRUCT/:UNION name).
-Signals an error if FOREIGN-TYPE is undefined."))
-
-(defgeneric aggregatep (foreign-type)
- (:documentation
- "Return true if FOREIGN-TYPE is an aggregate type."))
-
-(defgeneric foreign-type-alignment (foreign-type)
- (:documentation
- "Return the structure alignment in bytes of a foreign type."))
-
-(defgeneric foreign-type-size (foreign-type)
- (:documentation
- "Return the size in bytes of a foreign type."))
-
-(defgeneric unparse-type (foreign-type)
- (:documentation
- "Unparse FOREIGN-TYPE to a type specification (symbol or list)."))
-
-;;;# Foreign Types
-
-(defclass foreign-type ()
- ()
- (:documentation "Base class for all foreign types."))
-
-(defmethod make-load-form ((type foreign-type) &optional env)
- "Return the form used to dump types to a FASL file."
- (declare (ignore env))
- `(parse-type ',(unparse-type type)))
-
-(defmethod foreign-type-size (type)
- "Return the size in bytes of a foreign type."
- (foreign-type-size (parse-type type)))
-
-(defclass named-foreign-type (foreign-type)
- ((name
- ;; Name of this foreign type, a symbol.
- :initform (error "Must specify a NAME.")
- :initarg :name
- :accessor name)))
-
-(defmethod print-object ((type named-foreign-type) stream)
- "Print a FOREIGN-TYPEDEF instance to STREAM unreadably."
- (print-unreadable-object (type stream :type t :identity nil)
- (format stream "~S" (name type))))
-
-;;; Return the type's name which can be passed to PARSE-TYPE. If
-;;; that's not the case for some subclass of NAMED-FOREIGN-TYPE then
-;;; it should specialize UNPARSE-TYPE.
-(defmethod unparse-type ((type named-foreign-type))
- (name type))
-
-;;;# Built-In Foreign Types
-
-(defclass foreign-built-in-type (foreign-type)
- ((type-keyword
- ;; Keyword in CFFI-SYS representing this type.
- :initform (error "A type keyword is required.")
- :initarg :type-keyword
- :accessor type-keyword))
- (:documentation "A built-in foreign type."))
-
-(defmethod canonicalize ((type foreign-built-in-type))
- "Return the built-in type keyword for TYPE."
- (type-keyword type))
-
-(defmethod aggregatep ((type foreign-built-in-type))
- "Returns false, built-in types are never aggregate types."
- nil)
-
-(defmethod foreign-type-alignment ((type foreign-built-in-type))
- "Return the alignment of a built-in type."
- (%foreign-type-alignment (type-keyword type)))
-
-(defmethod foreign-type-size ((type foreign-built-in-type))
- "Return the size of a built-in type."
- (%foreign-type-size (type-keyword type)))
-
-(defmethod unparse-type ((type foreign-built-in-type))
- "Returns the symbolic representation of a built-in type."
- (type-keyword type))
-
-(defmethod print-object ((type foreign-built-in-type) stream)
- "Print a FOREIGN-TYPE instance to STREAM unreadably."
- (print-unreadable-object (type stream :type t :identity nil)
- (format stream "~S" (type-keyword type))))
-
-(defvar *built-in-foreign-types* nil)
-
-(defmacro define-built-in-foreign-type (keyword)
- "Defines a built-in foreign-type."
- `(eval-when (:compile-toplevel :load-toplevel :execute)
- (pushnew ,keyword *built-in-foreign-types*)
- (notice-foreign-type
- ,keyword (make-instance 'foreign-built-in-type :type-keyword ,keyword))))
-
-;;;# Foreign Pointer Types
-
-(defclass foreign-pointer-type (foreign-built-in-type)
- ((pointer-type
- ;; Type of object pointed at by this pointer, or nil for an
- ;; untyped (void) pointer.
- :initform nil
- :initarg :pointer-type
- :accessor pointer-type))
- (:default-initargs :type-keyword :pointer))
-
-;;; Define the type parser for the :POINTER type. If no type argument
-;;; is provided, a void pointer will be created.
-(let ((void-pointer (make-instance 'foreign-pointer-type)))
- (define-parse-method :pointer (&optional type)
- (if type
- (make-instance 'foreign-pointer-type :pointer-type (parse-type type))
- ;; A bit of premature optimization here.
- void-pointer)))
-
-;;; Unparse a foreign pointer type when dumping to a fasl.
-(defmethod unparse-type ((type foreign-pointer-type))
- (if (pointer-type type)
- `(:pointer ,(unparse-type (pointer-type type)))
- :pointer))
-
-;;; Print a foreign pointer type unreadably in unparsed form.
-(defmethod print-object ((type foreign-pointer-type) stream)
- (print-unreadable-object (type stream :type t :identity nil)
- (format stream "~S" (unparse-type type))))
-
-;;;# Structure Type
-
-(defgeneric bare-struct-type-p (foreign-type)
- (:documentation
- "Return true if FOREIGN-TYPE is a bare struct type or an alias of a bare struct type. "))
-
-(defmethod bare-struct-type-p ((type foreign-type))
- "Return true if FOREIGN-TYPE is a bare struct type or an alias of a bare struct type. "
- nil)
-
-(defclass foreign-struct-type (named-foreign-type)
- ((slots
- ;; Hash table of slots in this structure, keyed by name.
- :initform (make-hash-table)
- :initarg :slots
- :accessor slots)
- (size
- ;; Cached size in bytes of this structure.
- :initarg :size
- :accessor size)
- (alignment
- ;; This struct's alignment requirements
- :initarg :alignment
- :accessor alignment)
- (bare
- ;; we use this flag to support the (old, deprecated) semantics of
- ;; bare struct types. FOO means (:POINTER (:STRUCT FOO) in
- ;; functions declarations whereas FOO in a structure definition is
- ;; a proper aggregate type: (:STRUCT FOO), etc.
- :initform nil
- :initarg :bare
- :reader bare-struct-type-p)))
-
-(defun slots-in-order (structure-type)
- "A list of the structure's slots in order."
- (sort (loop for slots being the hash-value of (structure-slots structure-type)
- collect slots)
- #'<
- :key 'slot-offset))
-
-(defmethod canonicalize ((type foreign-struct-type))
- (if (bare-struct-type-p type)
- :pointer
- `(:struct ,(name type))))
-
-(defmethod unparse-type ((type foreign-struct-type))
- (if (bare-struct-type-p type)
- (name type)
- (canonicalize type)))
-
-(defmethod aggregatep ((type foreign-struct-type))
- "Returns true, structure types are aggregate."
- t)
-
-(defmethod foreign-type-size ((type foreign-struct-type))
- "Return the size in bytes of a foreign structure type."
- (size type))
-
-(defmethod foreign-type-alignment ((type foreign-struct-type))
- "Return the alignment requirements for this struct."
- (alignment type))
-
-(defclass foreign-union-type (foreign-struct-type) ())
-
-(defmethod canonicalize ((type foreign-union-type))
- (if (bare-struct-type-p type)
- :pointer
- `(:union ,(name type))))
-
-;;;# Foreign Typedefs
-
-(defclass foreign-type-alias (foreign-type)
- ((actual-type
- ;; The FOREIGN-TYPE instance this type is an alias for.
- :initarg :actual-type
- :accessor actual-type
- :initform (error "Must specify an ACTUAL-TYPE.")))
- (:documentation "A type that aliases another type."))
-
-(defmethod canonicalize ((type foreign-type-alias))
- "Return the built-in type keyword for TYPE."
- (canonicalize (actual-type type)))
-
-(defmethod aggregatep ((type foreign-type-alias))
- "Return true if TYPE's actual type is aggregate."
- (aggregatep (actual-type type)))
-
-(defmethod foreign-type-alignment ((type foreign-type-alias))
- "Return the alignment of a foreign typedef."
- (foreign-type-alignment (actual-type type)))
-
-(defmethod foreign-type-size ((type foreign-type-alias))
- "Return the size in bytes of a foreign typedef."
- (foreign-type-size (actual-type type)))
-
-(defclass foreign-typedef (foreign-type-alias named-foreign-type)
- ())
-
-(defun follow-typedefs (type)
- (if (typep type 'foreign-typedef)
- (follow-typedefs (actual-type type))
- type))
-
-(defmethod bare-struct-type-p ((type foreign-typedef))
- (bare-struct-type-p (follow-typedefs type)))
-
-(defun structure-slots (type)
- "The hash table of slots for the structure type."
- (slots (follow-typedefs type)))
-
-;;;# Type Translators
-;;;
-;;; Type translation is done with generic functions at runtime for
-;;; subclasses of TRANSLATABLE-FOREIGN-TYPE.
-;;;
-;;; The main interface for defining type translations is through the
-;;; generic functions TRANSLATE-{TO,FROM}-FOREIGN and
-;;; FREE-TRANSLATED-OBJECT.
-
-(defclass translatable-foreign-type (foreign-type) ())
-
-;;; ENHANCED-FOREIGN-TYPE is used to define translations on top of
-;;; previously defined foreign types.
-(defclass enhanced-foreign-type (translatable-foreign-type
- foreign-type-alias)
- ((unparsed-type :accessor unparsed-type)))
-
-;;; If actual-type isn't parsed already, let's parse it. This way we
-;;; don't have to export PARSE-TYPE and users don't have to worry
-;;; about this in DEFINE-FOREIGN-TYPE or DEFINE-PARSE-METHOD.
-(defmethod initialize-instance :after ((type enhanced-foreign-type) &key)
- (unless (typep (actual-type type) 'foreign-type)
- (setf (actual-type type) (parse-type (actual-type type)))))
-
-(defmethod unparse-type ((type enhanced-foreign-type))
- (unparsed-type type))
-
-;;; Checks NAMEs, not object identity.
-(defun check-for-typedef-cycles (type)
- (let ((seen (make-hash-table :test 'eq)))
- (labels ((%check (cur-type)
- (when (typep cur-type 'foreign-typedef)
- (when (gethash (name cur-type) seen)
- (simple-foreign-type-error type :default
- "Detected cycle in type ~S." type))
- (setf (gethash (name cur-type) seen) t)
- (%check (actual-type cur-type)))))
- (%check type))))
-
-;;; Only now we define PARSE-TYPE because it needs to do some extra
-;;; work for ENHANCED-FOREIGN-TYPES.
-(defun parse-type (type)
- (let* ((spec (ensure-list type))
- (ptype (apply (find-type-parser (car spec)) (cdr spec))))
- (when (typep ptype 'foreign-typedef)
- (check-for-typedef-cycles ptype))
- (when (typep ptype 'enhanced-foreign-type)
- (setf (unparsed-type ptype) type))
- ptype))
-
-(defun ensure-parsed-base-type (type)
- (follow-typedefs
- (if (typep type 'foreign-type)
- type
- (parse-type type))))
-
-(defun canonicalize-foreign-type (type)
- "Convert TYPE to a built-in type by following aliases.
-Signals an error if the type cannot be resolved."
- (canonicalize (parse-type type)))
-
-;;; Translate VALUE to a foreign object of the type represented by
-;;; TYPE, which will be a subclass of TRANSLATABLE-FOREIGN-TYPE.
-;;; Returns the foreign value and an optional second value which will
-;;; be passed to FREE-TRANSLATED-OBJECT as the PARAM argument.
-(defgeneric translate-to-foreign (value type)
- (:method (value type)
- (declare (ignore type))
- value))
-
-(defgeneric translate-into-foreign-memory (value type pointer)
- (:documentation
- "Translate the Lisp value into the foreign memory location given by pointer. Return value is not used.")
- (:argument-precedence-order type value pointer))
-
-;;; Similar to TRANSLATE-TO-FOREIGN, used exclusively by
-;;; (SETF FOREIGN-STRUCT-SLOT-VALUE).
-(defgeneric translate-aggregate-to-foreign (ptr value type))
-
-;;; Translate the foreign object VALUE from the type repsented by
-;;; TYPE, which will be a subclass of TRANSLATABLE-FOREIGN-TYPE.
-;;; Returns the converted Lisp value.
-(defgeneric translate-from-foreign (value type)
- (:argument-precedence-order type value)
- (:method (value type)
- (declare (ignore type))
- value))
-
-;;; Free an object allocated by TRANSLATE-TO-FOREIGN. VALUE is a
-;;; foreign object of the type represented by TYPE, which will be a
-;;; TRANSLATABLE-FOREIGN-TYPE subclass. PARAM, if present, contains
-;;; the second value returned by TRANSLATE-TO-FOREIGN, and is used to
-;;; communicate between the two functions.
-;;;
-;;; FIXME: I don't think this PARAM argument is necessary anymore
-;;; because the TYPE object can contain that information. [2008-12-31 LO]
-(defgeneric free-translated-object (value type param)
- (:method (value type param)
- (declare (ignore value type param))))
-
-;;;## Macroexpansion Time Translation
-;;;
-;;; The following EXPAND-* generic functions are similar to their
-;;; TRANSLATE-* counterparts but are usually called at macroexpansion
-;;; time. They offer a way to optimize the runtime translators.
-
-;;; This special variable is bound by the various :around methods
-;;; below to the respective form generated by the above %EXPAND-*
-;;; functions. This way, an expander can "bail out" by calling the
-;;; next method. All 6 of the below-defined GFs have a default method
-;;; that simply answers the rtf bound by the default :around method.
-(defvar *runtime-translator-form*)
-
-;;; EXPAND-FROM-FOREIGN
-
-(defgeneric expand-from-foreign (value type)
- (:method (value type)
- (declare (ignore type))
- value))
-
-(defmethod expand-from-foreign :around (value (type translatable-foreign-type))
- (let ((*runtime-translator-form* `(translate-from-foreign ,value ,type)))
- (call-next-method)))
-
-(defmethod expand-from-foreign (value (type translatable-foreign-type))
- (declare (ignore value))
- *runtime-translator-form*)
-
-;;; EXPAND-TO-FOREIGN
-
-;; The second return value is used to tell EXPAND-TO-FOREIGN-DYN that
-;; an unspecialized method was called.
-(defgeneric expand-to-foreign (value type)
- (:method (value type)
- (declare (ignore type))
- (values value t)))
-
-(defmethod expand-to-foreign :around (value (type translatable-foreign-type))
- (let ((*runtime-translator-form* `(translate-to-foreign ,value ,type)))
- (call-next-method)))
-
-(defmethod expand-to-foreign (value (type translatable-foreign-type))
- (declare (ignore value))
- (values *runtime-translator-form* t))
-
-;;; EXPAND-INTO-FOREIGN-MEMORY
-
-(defgeneric expand-into-foreign-memory (value type ptr)
- (:method (value type ptr)
- (declare (ignore type))
- value))
-
-(defmethod expand-into-foreign-memory :around
- (value (type translatable-foreign-type) ptr)
- (let ((*runtime-translator-form*
- `(translate-into-foreign-memory ,value ,type ,ptr)))
- (call-next-method)))
-
-(defmethod expand-into-foreign-memory (value (type translatable-foreign-type) ptr)
- (declare (ignore value))
- *runtime-translator-form*)
-
-;;; EXPAND-TO-FOREIGN-DYN
-
-(defgeneric expand-to-foreign-dyn (value var body type)
- (:method (value var body type)
- (declare (ignore type))
- `(let ((,var ,value)) ,@body)))
-
-(defmethod expand-to-foreign-dyn :around
- (value var body (type enhanced-foreign-type))
- (let ((*runtime-translator-form*
- (with-unique-names (param)
- `(multiple-value-bind (,var ,param)
- (translate-to-foreign ,value ,type)
- (unwind-protect
- (progn ,@body)
- (free-translated-object ,var ,type ,param))))))
- (call-next-method)))
-
-;;; If this method is called it means the user hasn't defined a
-;;; to-foreign-dyn expansion, so we use the to-foreign expansion.
-;;;
-;;; However, we do so *only* if there's a specialized
-;;; EXPAND-TO-FOREIGN for TYPE because otherwise we want to use the
-;;; above *RUNTIME-TRANSLATOR-FORM* which includes a call to
-;;; FREE-TRANSLATED-OBJECT. (Or else there would occur no translation
-;;; at all.)
-(defun foreign-expand-runtime-translator-or-binding (value var body type)
- (multiple-value-bind (expansion default-etp-p)
- (expand-to-foreign value type)
- (if default-etp-p
- *runtime-translator-form*
- `(let ((,var ,expansion))
- ,@body))))
-
-(defmethod expand-to-foreign-dyn (value var body (type enhanced-foreign-type))
- (foreign-expand-runtime-translator-or-binding value var body type))
-
-;;; EXPAND-TO-FOREIGN-DYN-INDIRECT
-;;; Like expand-to-foreign-dyn, but always give form that returns a
-;;; pointer to the object, even if it's directly representable in
-;;; CL, e.g. numbers.
-
-(defgeneric expand-to-foreign-dyn-indirect (value var body type)
- (:method (value var body type)
- (declare (ignore type))
- `(let ((,var ,value)) ,@body)))
-
-(defmethod expand-to-foreign-dyn-indirect :around
- (value var body (type translatable-foreign-type))
- (let ((*runtime-translator-form*
- `(with-foreign-object (,var ',(unparse-type type))
- (translate-into-foreign-memory ,value ,type ,var)
- ,@body)))
- (call-next-method)))
-
-(defmethod expand-to-foreign-dyn-indirect
- (value var body (type foreign-pointer-type))
- `(with-foreign-object (,var :pointer)
- (translate-into-foreign-memory ,value ,type ,var)
- ,@body))
-
-(defmethod expand-to-foreign-dyn-indirect
- (value var body (type foreign-built-in-type))
- `(with-foreign-object (,var ,type)
- (translate-into-foreign-memory ,value ,type ,var)
- ,@body))
-
-(defmethod expand-to-foreign-dyn-indirect
- (value var body (type translatable-foreign-type))
- (foreign-expand-runtime-translator-or-binding value var body type))
-
-(defmethod expand-to-foreign-dyn-indirect (value var body (type foreign-type-alias))
- (expand-to-foreign-dyn-indirect value var body (actual-type type)))
-
-;;; User interface for converting values from/to foreign using the
-;;; type translators. The compiler macros use the expanders when
-;;; possible.
-
-(defun convert-to-foreign (value type)
- (translate-to-foreign value (parse-type type)))
-
-(define-compiler-macro convert-to-foreign (value type)
- (if (constantp type)
- (expand-to-foreign value (parse-type (eval type)))
- `(translate-to-foreign ,value (parse-type ,type))))
-
-(defun convert-from-foreign (value type)
- (translate-from-foreign value (parse-type type)))
-
-(define-compiler-macro convert-from-foreign (value type)
- (if (constantp type)
- (expand-from-foreign value (parse-type (eval type)))
- `(translate-from-foreign ,value (parse-type ,type))))
-
-(defun convert-into-foreign-memory (value type ptr)
- (translate-into-foreign-memory value (parse-type type) ptr))
-
-(define-compiler-macro convert-into-foreign-memory (value type ptr)
- (if (constantp type)
- (expand-into-foreign-memory value (parse-type (eval type)) ptr)
- `(translate-into-foreign-memory ,value (parse-type ,type) ,ptr)))
-
-(defun free-converted-object (value type param)
- (free-translated-object value (parse-type type) param))
-
-;;;# Enhanced typedefs
-
-(defclass enhanced-typedef (foreign-typedef)
- ())
-
-(defmethod translate-to-foreign (value (type enhanced-typedef))
- (translate-to-foreign value (actual-type type)))
-
-(defmethod translate-into-foreign-memory (value (type enhanced-typedef) pointer)
- (translate-into-foreign-memory value (actual-type type) pointer))
-
-(defmethod translate-from-foreign (value (type enhanced-typedef))
- (translate-from-foreign value (actual-type type)))
-
-(defmethod free-translated-object (value (type enhanced-typedef) param)
- (free-translated-object value (actual-type type) param))
-
-(defmethod expand-from-foreign (value (type enhanced-typedef))
- (expand-from-foreign value (actual-type type)))
-
-(defmethod expand-to-foreign (value (type enhanced-typedef))
- (expand-to-foreign value (actual-type type)))
-
-(defmethod expand-to-foreign-dyn (value var body (type enhanced-typedef))
- (expand-to-foreign-dyn value var body (actual-type type)))
-
-(defmethod expand-into-foreign-memory (value (type enhanced-typedef) ptr)
- (expand-into-foreign-memory value (actual-type type) ptr))
-
-;;;# User-defined Types and Translations.
-
-(defmacro define-foreign-type (name supers slots &rest options)
- (multiple-value-bind (new-options simple-parser actual-type initargs)
- (let ((keywords '(:simple-parser :actual-type :default-initargs)))
- (apply #'values
- (remove-if (lambda (opt) (member (car opt) keywords)) options)
- (mapcar (lambda (kw) (cdr (assoc kw options))) keywords)))
- `(eval-when (:compile-toplevel :load-toplevel :execute)
- (defclass ,name ,(or supers '(enhanced-foreign-type))
- ,slots
- (:default-initargs ,@(when actual-type `(:actual-type ',actual-type))
- ,@initargs)
- ,@new-options)
- ,(when simple-parser
- `(define-parse-method ,(car simple-parser) (&rest args)
- (apply #'make-instance ',name args)))
- ',name)))
-
-(defmacro defctype (name base-type &optional documentation)
- "Utility macro for simple C-like typedefs."
- (declare (ignore documentation))
- (warn-if-kw-or-belongs-to-cl name)
- (let* ((btype (parse-type base-type))
- (dtype (if (typep btype 'enhanced-foreign-type)
- 'enhanced-typedef
- 'foreign-typedef)))
- `(eval-when (:compile-toplevel :load-toplevel :execute)
- (notice-foreign-type
- ',name (make-instance ',dtype :name ',name :actual-type ,btype)))))
-
-;;; For Verrazano. We memoize the type this way to help detect cycles.
-(defmacro defctype* (name base-type)
- "Like DEFCTYPE but defers instantiation until parse-time."
- `(eval-when (:compile-toplevel :load-toplevel :execute)
- (let (memoized-type)
- (define-parse-method ,name ()
- (unless memoized-type
- (setf memoized-type (make-instance 'foreign-typedef :name ',name
- :actual-type nil)
- (actual-type memoized-type) (parse-type ',base-type)))
- memoized-type))))
(DIR) diff --git a/3rdparties/software/cffi_0.20.0/src/enum.lisp b/3rdparties/software/cffi_0.20.0/src/enum.lisp
@@ -1,369 +0,0 @@
-;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
-;;;
-;;; enum.lisp --- Defining foreign constants as Lisp keywords.
-;;;
-;;; Copyright (C) 2005-2006, James Bielman <jamesjb@jamesjb.com>
-;;;
-;;; Permission is hereby granted, free of charge, to any person
-;;; obtaining a copy of this software and associated documentation
-;;; files (the "Software"), to deal in the Software without
-;;; restriction, including without limitation the rights to use, copy,
-;;; modify, merge, publish, distribute, sublicense, and/or sell copies
-;;; of the Software, and to permit persons to whom the Software is
-;;; furnished to do so, subject to the following conditions:
-;;;
-;;; The above copyright notice and this permission notice shall be
-;;; included in all copies or substantial portions of the Software.
-;;;
-;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
-;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
-;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
-;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
-;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
-;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
-;;; DEALINGS IN THE SOFTWARE.
-;;;
-
-(in-package #:cffi)
-
-;; TODO the accessors names are rather inconsistent:
-;; FOREIGN-ENUM-VALUE FOREIGN-BITFIELD-VALUE
-;; FOREIGN-ENUM-KEYWORD FOREIGN-BITFIELD-SYMBOLS
-;; FOREIGN-ENUM-KEYWORD-LIST FOREIGN-BITFIELD-SYMBOL-LIST
-;; I'd rename them to: FOREIGN-*-KEY(S) and FOREIGN-*-ALL-KEYS -- attila
-
-;; TODO bitfield is a confusing name, because the C standard calls
-;; the "int foo : 3" type as a bitfield. Maybe rename to defbitmask?
-;; -- attila
-
-;;;# Foreign Constants as Lisp Keywords
-;;;
-;;; This module defines the DEFCENUM macro, which provides an
-;;; interface for defining a type and associating a set of integer
-;;; constants with keyword symbols for that type.
-;;;
-;;; The keywords are automatically translated to the appropriate
-;;; constant for the type by a type translator when passed as
-;;; arguments or a return value to a foreign function.
-
-(defclass foreign-enum (named-foreign-type enhanced-foreign-type)
- ((keyword-values
- :initform (error "Must specify KEYWORD-VALUES.")
- :initarg :keyword-values
- :reader keyword-values)
- (value-keywords
- :initform (error "Must specify VALUE-KEYWORDS.")
- :initarg :value-keywords
- :reader value-keywords))
- (:documentation "Describes a foreign enumerated type."))
-
-(deftype enum-key ()
- '(and symbol (not null)))
-
-(defparameter +valid-enum-base-types+ *built-in-integer-types*)
-
-(defun parse-foreign-enum-like (type-name base-type values
- &optional field-mode-p)
- (let ((keyword-values (make-hash-table :test 'eq))
- (value-keywords (make-hash-table))
- (field-keywords (list))
- (bit-index->keyword (make-array 0 :adjustable t
- :element-type t))
- (default-value (if field-mode-p 1 0))
- (most-extreme-value 0)
- (has-negative-value? nil))
- (dolist (pair values)
- (destructuring-bind (keyword &optional (value default-value valuep))
- (ensure-list pair)
- (check-type keyword enum-key)
- ;;(check-type value integer)
- (when (> (abs value) (abs most-extreme-value))
- (setf most-extreme-value value))
- (when (minusp value)
- (setf has-negative-value? t))
- (if field-mode-p
- (if valuep
- (when (and (>= value default-value)
- (single-bit-p value))
- (setf default-value (ash value 1)))
- (setf default-value (ash default-value 1)))
- (setf default-value (1+ value)))
- (if (gethash keyword keyword-values)
- (error "A foreign enum cannot contain duplicate keywords: ~S."
- keyword)
- (setf (gethash keyword keyword-values) value))
- ;; This is completely arbitrary behaviour: we keep the last
- ;; value->keyword mapping. I suppose the opposite would be
- ;; just as good (keeping the first). Returning a list with all
- ;; the keywords might be a solution too? Suggestions
- ;; welcome. --luis
- (setf (gethash value value-keywords) keyword)
- (when (and field-mode-p
- (single-bit-p value))
- (let ((bit-index (1- (integer-length value))))
- (push keyword field-keywords)
- (when (<= (array-dimension bit-index->keyword 0)
- bit-index)
- (setf bit-index->keyword
- (adjust-array bit-index->keyword (1+ bit-index)
- :initial-element nil)))
- (setf (aref bit-index->keyword bit-index)
- keyword)))))
- (if base-type
- (progn
- (setf base-type (canonicalize-foreign-type base-type))
- ;; I guess we don't lose much by not strictly adhering to
- ;; the C standard here, and some libs out in the wild are
- ;; already using e.g. :double.
- #+nil
- (assert (member base-type +valid-enum-base-types+ :test 'eq) ()
- "Invalid base type ~S for enum type ~S. Must be one of ~S."
- base-type type-name +valid-enum-base-types+))
- ;; details: https://stackoverflow.com/questions/1122096/what-is-the-underlying-type-of-a-c-enum
- (let ((bits (integer-length most-extreme-value)))
- (setf base-type
- (let ((most-uint-bits (load-time-value (* (foreign-type-size :unsigned-int) 8)))
- (most-ulong-bits (load-time-value (* (foreign-type-size :unsigned-long) 8)))
- (most-ulonglong-bits (load-time-value (* (foreign-type-size :unsigned-long-long) 8))))
- (or (if has-negative-value?
- (cond
- ((<= (1+ bits) most-uint-bits)
- :int)
- ((<= (1+ bits) most-ulong-bits)
- :long)
- ((<= (1+ bits) most-ulonglong-bits)
- :long-long))
- (cond
- ((<= bits most-uint-bits)
- :unsigned-int)
- ((<= bits most-ulong-bits)
- :unsigned-long)
- ((<= bits most-ulonglong-bits)
- :unsigned-long-long)))
- (error "Enum value ~S of enum ~S is too large to store."
- most-extreme-value type-name))))))
- (values base-type keyword-values value-keywords
- field-keywords (when field-mode-p
- (alexandria:copy-array
- bit-index->keyword :adjustable nil
- :fill-pointer nil)))))
-
-(defun make-foreign-enum (type-name base-type values)
- "Makes a new instance of the foreign-enum class."
- (multiple-value-bind
- (base-type keyword-values value-keywords)
- (parse-foreign-enum-like type-name base-type values)
- (make-instance 'foreign-enum
- :name type-name
- :actual-type (parse-type base-type)
- :keyword-values keyword-values
- :value-keywords value-keywords)))
-
-(defun %defcenum-like (name-and-options enum-list type-factory)
- (discard-docstring enum-list)
- (destructuring-bind (name &optional base-type)
- (ensure-list name-and-options)
- (let ((type (funcall type-factory name base-type enum-list)))
- `(eval-when (:compile-toplevel :load-toplevel :execute)
- (notice-foreign-type ',name
- ;; ,type is not enough here, someone needs to
- ;; define it when we're being loaded from a fasl.
- (,type-factory ',name ',base-type ',enum-list))
- ,@(remove nil
- (mapcar (lambda (key)
- (unless (keywordp key)
- `(defconstant ,key ,(foreign-enum-value type key))))
- (foreign-enum-keyword-list type)))))))
-
-(defmacro defcenum (name-and-options &body enum-list)
- "Define an foreign enumerated type."
- (%defcenum-like name-and-options enum-list 'make-foreign-enum))
-
-(defun hash-keys-to-list (ht)
- (loop for k being the hash-keys in ht collect k))
-
-(defun foreign-enum-keyword-list (enum-type)
- "Return a list of KEYWORDS defined in ENUM-TYPE."
- (hash-keys-to-list (keyword-values (ensure-parsed-base-type enum-type))))
-
-;;; These [four] functions could be good canditates for compiler macros
-;;; when the value or keyword is constant. I am not going to bother
-;;; until someone has a serious performance need to do so though. --jamesjb
-(defun %foreign-enum-value (type keyword &key errorp)
- (check-type keyword enum-key)
- (or (gethash keyword (keyword-values type))
- (when errorp
- (error "~S is not defined as a keyword for enum type ~S."
- keyword type))))
-
-(defun foreign-enum-value (type keyword &key (errorp t))
- "Convert a KEYWORD into an integer according to the enum TYPE."
- (let ((type-obj (ensure-parsed-base-type type)))
- (if (not (typep type-obj 'foreign-enum))
- (error "~S is not a foreign enum type." type)
- (%foreign-enum-value type-obj keyword :errorp errorp))))
-
-(defun %foreign-enum-keyword (type value &key errorp)
- (check-type value integer)
- (or (gethash value (value-keywords type))
- (when errorp
- (error "~S is not defined as a value for enum type ~S."
- value type))))
-
-(defun foreign-enum-keyword (type value &key (errorp t))
- "Convert an integer VALUE into a keyword according to the enum TYPE."
- (let ((type-obj (ensure-parsed-base-type type)))
- (if (not (typep type-obj 'foreign-enum))
- (error "~S is not a foreign enum type." type)
- (%foreign-enum-keyword type-obj value :errorp errorp))))
-
-(defmethod translate-to-foreign (value (type foreign-enum))
- (if (keywordp value)
- (%foreign-enum-value type value :errorp t)
- value))
-
-(defmethod translate-into-foreign-memory
- (value (type foreign-enum) pointer)
- (setf (mem-aref pointer (unparse-type (actual-type type)))
- (translate-to-foreign value type)))
-
-(defmethod translate-from-foreign (value (type foreign-enum))
- (%foreign-enum-keyword type value :errorp t))
-
-(defmethod expand-to-foreign (value (type foreign-enum))
- (once-only (value)
- `(if (keywordp ,value)
- (%foreign-enum-value ,type ,value :errorp t)
- ,value)))
-
-;;; There are two expansions necessary for an enum: first, the enum
-;;; keyword needs to be translated to an int, and then the int needs
-;;; to be made indirect.
-(defmethod expand-to-foreign-dyn-indirect (value var body (type foreign-enum))
- (expand-to-foreign-dyn-indirect ; Make the integer indirect
- (with-unique-names (feint)
- (call-next-method value feint (list feint) type)) ; TRANSLATABLE-FOREIGN-TYPE method
- var
- body
- (actual-type type)))
-
-;;;# Foreign Bitfields as Lisp keywords
-;;;
-;;; DEFBITFIELD is an abstraction similar to the one provided by DEFCENUM.
-;;; With some changes to DEFCENUM, this could certainly be implemented on
-;;; top of it.
-
-(defclass foreign-bitfield (foreign-enum)
- ((field-keywords
- :initform (error "Must specify FIELD-KEYWORDS.")
- :initarg :field-keywords
- :reader field-keywords)
- (bit-index->keyword
- :initform (error "Must specify BIT-INDEX->KEYWORD")
- :initarg :bit-index->keyword
- :reader bit-index->keyword))
- (:documentation "Describes a foreign bitfield type."))
-
-(defun make-foreign-bitfield (type-name base-type values)
- "Makes a new instance of the foreign-bitfield class."
- (multiple-value-bind
- (base-type keyword-values value-keywords
- field-keywords bit-index->keyword)
- (parse-foreign-enum-like type-name base-type values t)
- (make-instance 'foreign-bitfield
- :name type-name
- :actual-type (parse-type base-type)
- :keyword-values keyword-values
- :value-keywords value-keywords
- :field-keywords field-keywords
- :bit-index->keyword bit-index->keyword)))
-
-(defmacro defbitfield (name-and-options &body masks)
- "Define an foreign enumerated type."
- (%defcenum-like name-and-options masks 'make-foreign-bitfield))
-
-(defun foreign-bitfield-symbol-list (bitfield-type)
- "Return a list of SYMBOLS defined in BITFIELD-TYPE."
- (field-keywords (ensure-parsed-base-type bitfield-type)))
-
-(defun %foreign-bitfield-value (type symbols)
- (declare (optimize speed))
- (labels ((process-one (symbol)
- (check-type symbol symbol)
- (or (gethash symbol (keyword-values type))
- (error "~S is not a valid symbol for bitfield type ~S."
- symbol type))))
- (declare (dynamic-extent #'process-one))
- (cond
- ((consp symbols)
- (reduce #'logior symbols :key #'process-one))
- ((null symbols)
- 0)
- (t
- (process-one symbols)))))
-
-(defun foreign-bitfield-value (type symbols)
- "Convert a list of symbols into an integer according to the TYPE bitfield."
- (let ((type-obj (ensure-parsed-base-type type)))
- (assert (typep type-obj 'foreign-bitfield) ()
- "~S is not a foreign bitfield type." type)
- (%foreign-bitfield-value type-obj symbols)))
-
-(define-compiler-macro foreign-bitfield-value (&whole form type symbols)
- "Optimize for when TYPE and SYMBOLS are constant."
- (declare (notinline foreign-bitfield-value))
- (if (and (constantp type) (constantp symbols))
- (foreign-bitfield-value (eval type) (eval symbols))
- form))
-
-(defun %foreign-bitfield-symbols (type value)
- (check-type value integer)
- (check-type type foreign-bitfield)
- (loop
- :with bit-index->keyword = (bit-index->keyword type)
- :for bit-index :from 0 :below (array-dimension bit-index->keyword 0)
- :for mask = 1 :then (ash mask 1)
- :for key = (aref bit-index->keyword bit-index)
- :when (and key
- (= (logand value mask) mask))
- :collect key))
-
-(defun foreign-bitfield-symbols (type value)
- "Convert an integer VALUE into a list of matching symbols according to
-the bitfield TYPE."
- (let ((type-obj (ensure-parsed-base-type type)))
- (if (not (typep type-obj 'foreign-bitfield))
- (error "~S is not a foreign bitfield type." type)
- (%foreign-bitfield-symbols type-obj value))))
-
-(define-compiler-macro foreign-bitfield-symbols (&whole form type value)
- "Optimize for when TYPE and SYMBOLS are constant."
- (declare (notinline foreign-bitfield-symbols))
- (if (and (constantp type) (constantp value))
- `(quote ,(foreign-bitfield-symbols (eval type) (eval value)))
- form))
-
-(defmethod translate-to-foreign (value (type foreign-bitfield))
- (if (integerp value)
- value
- (%foreign-bitfield-value type (ensure-list value))))
-
-(defmethod translate-from-foreign (value (type foreign-bitfield))
- (%foreign-bitfield-symbols type value))
-
-(defmethod expand-to-foreign (value (type foreign-bitfield))
- (flet ((expander (value type)
- `(if (integerp ,value)
- ,value
- (%foreign-bitfield-value ,type (ensure-list ,value)))))
- (if (constantp value)
- (eval (expander value type))
- (expander value type))))
-
-(defmethod expand-from-foreign (value (type foreign-bitfield))
- (flet ((expander (value type)
- `(%foreign-bitfield-symbols ,type ,value)))
- (if (constantp value)
- (eval (expander value type))
- (expander value type))))
(DIR) diff --git a/3rdparties/software/cffi_0.20.0/src/features.lisp b/3rdparties/software/cffi_0.20.0/src/features.lisp
@@ -1,111 +0,0 @@
-;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
-;;;
-;;; features.lisp --- CFFI-specific features (DEPRECATED).
-;;;
-;;; Copyright (C) 2006-2007, Luis Oliveira <loliveira@common-lisp.net>
-;;;
-;;; Permission is hereby granted, free of charge, to any person
-;;; obtaining a copy of this software and associated documentation
-;;; files (the "Software"), to deal in the Software without
-;;; restriction, including without limitation the rights to use, copy,
-;;; modify, merge, publish, distribute, sublicense, and/or sell copies
-;;; of the Software, and to permit persons to whom the Software is
-;;; furnished to do so, subject to the following conditions:
-;;;
-;;; The above copyright notice and this permission notice shall be
-;;; included in all copies or substantial portions of the Software.
-;;;
-;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
-;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
-;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
-;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
-;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
-;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
-;;; DEALINGS IN THE SOFTWARE.
-;;;
-
-(in-package #:cl-user)
-
-(eval-when (:compile-toplevel :load-toplevel :execute)
- (pushnew :cffi *features*))
-
-;;; CFFI-SYS backends take care of pushing the appropriate features to
-;;; *features*. See each cffi-*.lisp file.
-;;;
-;;; Not anymore, I think we should use TRIVIAL-FEATURES for the
-;;; platform features instead. Less pain. CFFI-FEATURES is now
-;;; deprecated and this code will stay here for a while for backwards
-;;; compatibility purposes, to be removed in a future release.
-
-(defpackage #:cffi-features
- (:use #:cl)
- (:export
- #:cffi-feature-p
-
- ;; Features related to the CFFI-SYS backend. Why no-*? This
- ;; reflects the hope that these symbols will go away completely
- ;; meaning that at some point all lisps will support long-longs,
- ;; the foreign-funcall primitive, etc...
- #:no-long-long
- #:no-foreign-funcall
- #:no-stdcall
- #:flat-namespace
-
- ;; Only SCL supports long-double...
- ;;#:no-long-double
-
- ;; Features related to the operating system.
- ;; More should be added.
- #:darwin
- #:unix
- #:windows
-
- ;; Features related to the processor.
- ;; More should be added.
- #:ppc32
- #:x86
- #:x86-64
- #:sparc
- #:sparc64
- #:hppa
- #:hppa64))
-
-(in-package #:cffi-features)
-
-(defun cffi-feature-p (feature-expression)
- "Matches a FEATURE-EXPRESSION against those symbols in *FEATURES*
-that belong to the CFFI-FEATURES package."
- (when (eql feature-expression t)
- (return-from cffi-feature-p t))
- (let ((features-package (find-package '#:cffi-features)))
- (flet ((cffi-feature-eq (name feature-symbol)
- (and (eq (symbol-package feature-symbol) features-package)
- (string= name (symbol-name feature-symbol)))))
- (etypecase feature-expression
- (symbol
- (not (null (member (symbol-name feature-expression) *features*
- :test #'cffi-feature-eq))))
- (cons
- (ecase (first feature-expression)
- (:and (every #'cffi-feature-p (rest feature-expression)))
- (:or (some #'cffi-feature-p (rest feature-expression)))
- (:not (not (cffi-feature-p (cadr feature-expression))))))))))
-
-;;; for backwards compatibility
-(mapc (lambda (sym) (pushnew sym *features*))
- '(#+darwin darwin
- #+unix unix
- #+windows windows
- #+ppc ppc32
- #+x86 x86
- #+x86-64 x86-64
- #+sparc sparc
- #+sparc64 sparc64
- #+hppa hppa
- #+hppa64 hppa64
- #+cffi-sys::no-long-long no-long-long
- #+cffi-sys::flat-namespace flat-namespace
- #+cffi-sys::no-foreign-funcall no-foreign-funcall
- #+cffi-sys::no-stdcall no-stdcall
- ))
(DIR) diff --git a/3rdparties/software/cffi_0.20.0/src/foreign-vars.lisp b/3rdparties/software/cffi_0.20.0/src/foreign-vars.lisp
@@ -1,90 +0,0 @@
-;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
-;;;
-;;; foreign-vars.lisp --- High-level interface to foreign globals.
-;;;
-;;; Copyright (C) 2005-2008, Luis Oliveira <loliveira(@)common-lisp.net>
-;;;
-;;; Permission is hereby granted, free of charge, to any person
-;;; obtaining a copy of this software and associated documentation
-;;; files (the "Software"), to deal in the Software without
-;;; restriction, including without limitation the rights to use, copy,
-;;; modify, merge, publish, distribute, sublicense, and/or sell copies
-;;; of the Software, and to permit persons to whom the Software is
-;;; furnished to do so, subject to the following conditions:
-;;;
-;;; The above copyright notice and this permission notice shall be
-;;; included in all copies or substantial portions of the Software.
-;;;
-;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
-;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
-;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
-;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
-;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
-;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
-;;; DEALINGS IN THE SOFTWARE.
-;;;
-
-(in-package #:cffi)
-
-;;;# Accessing Foreign Globals
-
-;;; Called by FOREIGN-OPTIONS in functions.lisp.
-(defun parse-defcvar-options (options)
- (destructuring-bind (&key (library :default) read-only) options
- (list :library library :read-only read-only)))
-
-(defun get-var-pointer (symbol)
- "Return a pointer to the foreign global variable relative to SYMBOL."
- (foreign-symbol-pointer (get symbol 'foreign-var-name)
- :library (get symbol 'foreign-var-library)))
-
-;;; Note: this will lookup not only variables but also functions.
-(defun foreign-symbol-pointer (name &key (library :default))
- (check-type name string)
- (%foreign-symbol-pointer
- name (if (eq library :default)
- :default
- (foreign-library-handle
- (get-foreign-library library)))))
-
-(defun fs-pointer-or-lose (foreign-name library)
- "Like foreign-symbol-ptr but throws an error instead of
-returning nil when foreign-name is not found."
- (or (foreign-symbol-pointer foreign-name :library library)
- (error "Trying to access undefined foreign variable ~S." foreign-name)))
-
-(defmacro defcvar (name-and-options type &optional documentation)
- "Define a foreign global variable."
- (multiple-value-bind (lisp-name foreign-name options)
- (parse-name-and-options name-and-options t)
- (let ((fn (symbolicate '#:%var-accessor- lisp-name))
- (read-only (getf options :read-only))
- (library (getf options :library)))
- ;; We can't really setf an aggregate type.
- (when (aggregatep (parse-type type))
- (setq read-only t))
- `(progn
- (setf (documentation ',lisp-name 'variable) ,documentation)
- ;; Save foreign-name and library for posterior access by
- ;; GET-VAR-POINTER.
- (setf (get ',lisp-name 'foreign-var-name) ,foreign-name)
- (setf (get ',lisp-name 'foreign-var-library) ',library)
- ;; Getter
- (defun ,fn ()
- (mem-ref (fs-pointer-or-lose ,foreign-name ',library) ',type))
- ;; Setter
- (defun (setf ,fn) (value)
- ,(if read-only '(declare (ignore value)) (values))
- ,(if read-only
- `(error ,(format nil
- "Trying to modify read-only foreign var: ~A."
- lisp-name))
- `(setf (mem-ref (fs-pointer-or-lose ,foreign-name ',library)
- ',type)
- value)))
- ;; While most Lisps already expand DEFINE-SYMBOL-MACRO to an
- ;; EVAL-WHEN form like this, that is not required by the
- ;; standard so we do it ourselves.
- (eval-when (:compile-toplevel :load-toplevel :execute)
- (define-symbol-macro ,lisp-name (,fn)))))))
(DIR) diff --git a/3rdparties/software/cffi_0.20.0/src/functions.lisp b/3rdparties/software/cffi_0.20.0/src/functions.lisp
@@ -1,441 +0,0 @@
-;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
-;;;
-;;; functions.lisp --- High-level interface to foreign functions.
-;;;
-;;; Copyright (C) 2005-2006, James Bielman <jamesjb@jamesjb.com>
-;;; Copyright (C) 2005-2007, Luis Oliveira <loliveira@common-lisp.net>
-;;;
-;;; Permission is hereby granted, free of charge, to any person
-;;; obtaining a copy of this software and associated documentation
-;;; files (the "Software"), to deal in the Software without
-;;; restriction, including without limitation the rights to use, copy,
-;;; modify, merge, publish, distribute, sublicense, and/or sell copies
-;;; of the Software, and to permit persons to whom the Software is
-;;; furnished to do so, subject to the following conditions:
-;;;
-;;; The above copyright notice and this permission notice shall be
-;;; included in all copies or substantial portions of the Software.
-;;;
-;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
-;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
-;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
-;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
-;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
-;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
-;;; DEALINGS IN THE SOFTWARE.
-;;;
-
-(in-package #:cffi)
-
-;;;# Calling Foreign Functions
-;;;
-;;; FOREIGN-FUNCALL is the main primitive for calling foreign
-;;; functions. It converts each argument based on the installed
-;;; translators for its type, then passes the resulting list to
-;;; CFFI-SYS:%FOREIGN-FUNCALL.
-;;;
-;;; For implementation-specific reasons, DEFCFUN doesn't use
-;;; FOREIGN-FUNCALL directly and might use something else (passed to
-;;; TRANSLATE-OBJECTS as the CALL-FORM argument) instead of
-;;; CFFI-SYS:%FOREIGN-FUNCALL to call the foreign-function.
-
-(defun translate-objects (syms args types rettype call-form &optional indirect)
- "Helper function for FOREIGN-FUNCALL and DEFCFUN. If 'indirect is T, all arguments are represented by foreign pointers, even those that can be represented by CL objects."
- (if (null args)
- (expand-from-foreign call-form (parse-type rettype))
- (funcall
- (if indirect
- #'expand-to-foreign-dyn-indirect
- #'expand-to-foreign-dyn)
- (car args) (car syms)
- (list (translate-objects (cdr syms) (cdr args)
- (cdr types) rettype call-form indirect))
- (parse-type (car types)))))
-
-(defun parse-args-and-types (args)
- "Returns 4 values: types, canonicalized types, args and return type."
- (let* ((len (length args))
- (return-type (if (oddp len) (lastcar args) :void)))
- (loop repeat (floor len 2)
- for (type arg) on args by #'cddr
- collect type into types
- collect (canonicalize-foreign-type type) into ctypes
- collect arg into fargs
- finally (return (values types ctypes fargs return-type)))))
-
-;;; While the options passed directly to DEFCFUN/FOREIGN-FUNCALL have
-;;; precedence, we also grab its library's options, if possible.
-(defun parse-function-options (options &key pointer)
- (destructuring-bind (&key (library :default libraryp)
- (cconv nil cconv-p)
- (calling-convention cconv calling-convention-p)
- (convention calling-convention))
- options
- (when cconv-p
- (warn-obsolete-argument :cconv :convention))
- (when calling-convention-p
- (warn-obsolete-argument :calling-convention :convention))
- (list* :convention
- (or convention
- (when libraryp
- (let ((lib-options (foreign-library-options
- (get-foreign-library library))))
- (getf lib-options :convention)))
- :cdecl)
- ;; Don't pass the library option if we're dealing with
- ;; FOREIGN-FUNCALL-POINTER.
- (unless pointer
- (list :library library)))))
-
-(defun structure-by-value-p (ctype)
- "A structure or union is to be called or returned by value."
- (let ((actual-type (ensure-parsed-base-type ctype)))
- (or (and (typep actual-type 'foreign-struct-type)
- (not (bare-struct-type-p actual-type)))
- #+cffi::no-long-long (typep actual-type 'emulated-llong-type))))
-
-(defun fn-call-by-value-p (argument-types return-type)
- "One or more structures in the arguments or return from the function are called by value."
- (or (some 'structure-by-value-p argument-types)
- (structure-by-value-p return-type)))
-
-(defvar *foreign-structures-by-value*
- (lambda (&rest args)
- (declare (ignore args))
- (restart-case
- (error "Unable to call structures by value without cffi-libffi loaded.")
- (load-cffi-libffi () :report "Load cffi-libffi."
- (asdf:operate 'asdf:load-op 'cffi-libffi))))
- "A function that produces a form suitable for calling structures by value.")
-
-(defun foreign-funcall-form (thing options args pointerp)
- (multiple-value-bind (types ctypes fargs rettype)
- (parse-args-and-types args)
- (let ((syms (make-gensym-list (length fargs)))
- (fsbvp (fn-call-by-value-p ctypes rettype)))
- (if fsbvp
- ;; Structures by value call through *foreign-structures-by-value*
- (funcall *foreign-structures-by-value*
- thing
- fargs
- syms
- types
- rettype
- ctypes
- pointerp)
- (translate-objects
- syms fargs types rettype
- `(,(if pointerp '%foreign-funcall-pointer '%foreign-funcall)
- ;; No structures by value, direct call
- ,thing
- (,@(mapcan #'list ctypes syms)
- ,(canonicalize-foreign-type rettype))
- ,@(parse-function-options options :pointer pointerp)))))))
-
-(defmacro foreign-funcall (name-and-options &rest args)
- "Wrapper around %FOREIGN-FUNCALL that translates its arguments."
- (let ((name (car (ensure-list name-and-options)))
- (options (cdr (ensure-list name-and-options))))
- (foreign-funcall-form name options args nil)))
-
-(defmacro foreign-funcall-pointer (pointer options &rest args)
- (foreign-funcall-form pointer options args t))
-
-(defun promote-varargs-type (builtin-type)
- "Default argument promotions."
- (case builtin-type
- (:float :double)
- ((:char :short) :int)
- ((:unsigned-char :unsigned-short) :unsigned-int)
- (t builtin-type)))
-
-;; If cffi-sys doesn't provide a %foreign-funcall-varargs macros we
-;; define one that use %foreign-funcall.
-(eval-when (:compile-toplevel :load-toplevel :execute)
- (unless (fboundp '%foreign-funcall-varargs)
- (defmacro %foreign-funcall-varargs (name fixed-args varargs
- &rest args &key convention library)
- (declare (ignore convention library))
- `(%foreign-funcall ,name ,(append fixed-args varargs) ,@args)))
- (unless (fboundp '%foreign-funcall-pointer-varargs)
- (defmacro %foreign-funcall-pointer-varargs (pointer fixed-args varargs
- &rest args &key convention)
- (declare (ignore convention))
- `(%foreign-funcall-pointer ,pointer ,(append fixed-args varargs) ,@args))))
-
-(defun foreign-funcall-varargs-form (thing options fixed-args varargs pointerp)
- (multiple-value-bind (fixed-types fixed-ctypes fixed-fargs)
- (parse-args-and-types fixed-args)
- (multiple-value-bind (varargs-types varargs-ctypes varargs-fargs rettype)
- (parse-args-and-types varargs)
- (let ((fixed-syms (make-gensym-list (length fixed-fargs)))
- (varargs-syms (make-gensym-list (length varargs-fargs))))
- (translate-objects
- (append fixed-syms varargs-syms)
- (append fixed-fargs varargs-fargs)
- (append fixed-types varargs-types)
- rettype
- `(,(if pointerp '%foreign-funcall-pointer-varargs '%foreign-funcall-varargs)
- ,thing
- ,(mapcan #'list fixed-ctypes fixed-syms)
- ,(append
- (mapcan #'list
- (mapcar #'promote-varargs-type varargs-ctypes)
- (loop for sym in varargs-syms
- and type in varargs-ctypes
- if (eq type :float)
- collect `(float ,sym 1.0d0)
- else collect sym))
- (list (canonicalize-foreign-type rettype)))
- ,@options))))))
-
-(defmacro foreign-funcall-varargs (name-and-options fixed-args
- &rest varargs)
- "Wrapper around %FOREIGN-FUNCALL that translates its arguments
-and does type promotion for the variadic arguments."
- (let ((name (car (ensure-list name-and-options)))
- (options (cdr (ensure-list name-and-options))))
- (foreign-funcall-varargs-form name options fixed-args varargs nil)))
-
-(defmacro foreign-funcall-pointer-varargs (pointer options fixed-args
- &rest varargs)
- "Wrapper around %FOREIGN-FUNCALL-POINTER that translates its
-arguments and does type promotion for the variadic arguments."
- (foreign-funcall-varargs-form pointer options fixed-args varargs t))
-
-;;;# Defining Foreign Functions
-;;;
-;;; The DEFCFUN macro provides a declarative interface for defining
-;;; Lisp functions that call foreign functions.
-
-;; If cffi-sys doesn't provide a defcfun-helper-forms,
-;; we define one that uses %foreign-funcall.
-(eval-when (:compile-toplevel :load-toplevel :execute)
- (unless (fboundp 'defcfun-helper-forms)
- (defun defcfun-helper-forms (name lisp-name rettype args types options)
- (declare (ignore lisp-name))
- (values
- '()
- `(%foreign-funcall ,name ,(append (mapcan #'list types args)
- (list rettype))
- ,@options)))))
-
-(defun %defcfun (lisp-name foreign-name return-type args options docstring)
- (let* ((arg-names (mapcar #'first args))
- (arg-types (mapcar #'second args))
- (syms (make-gensym-list (length args)))
- (call-by-value (fn-call-by-value-p arg-types return-type)))
- (multiple-value-bind (prelude caller)
- (if call-by-value
- (values nil nil)
- (defcfun-helper-forms
- foreign-name lisp-name (canonicalize-foreign-type return-type)
- syms (mapcar #'canonicalize-foreign-type arg-types) options))
- `(progn
- ,prelude
- (defun ,lisp-name ,arg-names
- ,@(ensure-list docstring)
- ,(if call-by-value
- `(foreign-funcall
- ,(cons foreign-name options)
- ,@(append (mapcan #'list arg-types arg-names)
- (list return-type)))
- (translate-objects
- syms arg-names arg-types return-type caller)))))))
-
-(defun %defcfun-varargs (lisp-name foreign-name return-type args options doc)
- (with-unique-names (varargs)
- (let ((arg-names (mapcar #'car args)))
- `(defmacro ,lisp-name (,@arg-names &rest ,varargs)
- ,@(ensure-list doc)
- `(foreign-funcall-varargs
- ,'(,foreign-name ,@options)
- ,,`(list ,@(loop for (name type) in args
- collect `',type collect name))
- ,@,varargs
- ,',return-type)))))
-
-(defgeneric translate-underscore-separated-name (name)
- (:method ((name string))
- (values (intern (canonicalize-symbol-name-case (substitute #\- #\_ name)))))
- (:method ((name symbol))
- (substitute #\_ #\- (string-downcase (symbol-name name)))))
-
-(defun collapse-prefix (l special-words)
- (unless (null l)
- (multiple-value-bind (newpre skip) (check-prefix l special-words)
- (cons newpre (collapse-prefix (nthcdr skip l) special-words)))))
-
-(defun check-prefix (l special-words)
- (let ((pl (loop for i from (1- (length l)) downto 0
- collect (apply #'concatenate 'simple-string (butlast l i)))))
- (loop for w in special-words
- for p = (position-if #'(lambda (s) (string= s w)) pl)
- when p do (return-from check-prefix (values (nth p pl) (1+ p))))
- (values (first l) 1)))
-
-(defgeneric translate-camelcase-name (name &key upper-initial-p special-words)
- (:method ((name string) &key upper-initial-p special-words)
- (declare (ignore upper-initial-p))
- (values (intern (reduce #'(lambda (s1 s2)
- (concatenate 'simple-string s1 "-" s2))
- (mapcar #'string-upcase
- (collapse-prefix
- (split-if #'(lambda (ch)
- (or (upper-case-p ch)
- (digit-char-p ch)))
- name)
- special-words))))))
- (:method ((name symbol) &key upper-initial-p special-words)
- (apply #'concatenate
- 'string
- (loop for str in (split-if #'(lambda (ch) (eq ch #\-))
- (string name)
- :elide)
- for first-word-p = t then nil
- for e = (member str special-words
- :test #'equal :key #'string-upcase)
- collect (cond
- ((and first-word-p (not upper-initial-p))
- (string-downcase str))
- (e (first e))
- (t (string-capitalize str)))))))
-
-(defgeneric translate-name-from-foreign (foreign-name package &optional varp)
- (:method (foreign-name package &optional varp)
- (declare (ignore package))
- (let ((sym (translate-underscore-separated-name foreign-name)))
- (if varp
- (values (intern (format nil "*~A*"
- (canonicalize-symbol-name-case
- (symbol-name sym)))))
- sym))))
-
-(defgeneric translate-name-to-foreign (lisp-name package &optional varp)
- (:method (lisp-name package &optional varp)
- (declare (ignore package))
- (let ((name (translate-underscore-separated-name lisp-name)))
- (if varp
- (string-trim '(#\*) name)
- name))))
-
-(defun lisp-name (spec varp)
- (check-type spec string)
- (translate-name-from-foreign spec *package* varp))
-
-(defun foreign-name (spec varp)
- (check-type spec (and symbol (not null)))
- (translate-name-to-foreign spec *package* varp))
-
-(defun foreign-options (opts varp)
- (if varp
- (funcall 'parse-defcvar-options opts)
- (parse-function-options opts)))
-
-(defun lisp-name-p (name)
- (and name (symbolp name) (not (keywordp name))))
-
-(defun %parse-name-and-options (spec varp)
- (cond
- ((stringp spec)
- (values (lisp-name spec varp) spec nil))
- ((symbolp spec)
- (assert (not (null spec)))
- (values spec (foreign-name spec varp) nil))
- ((and (consp spec) (stringp (first spec)))
- (destructuring-bind (foreign-name &rest options)
- spec
- (cond
- ((or (null options)
- (keywordp (first options)))
- (values (lisp-name foreign-name varp) foreign-name options))
- (t
- (assert (lisp-name-p (first options)))
- (values (first options) foreign-name (rest options))))))
- ((and (consp spec) (lisp-name-p (first spec)))
- (destructuring-bind (lisp-name &rest options)
- spec
- (cond
- ((or (null options)
- (keywordp (first options)))
- (values lisp-name (foreign-name spec varp) options))
- (t
- (assert (stringp (first options)))
- (values lisp-name (first options) (rest options))))))
- (t
- (error "Not a valid foreign function specifier: ~A" spec))))
-
-;;; DEFCFUN's first argument has can have the following syntax:
-;;;
-;;; 1. string
-;;; 2. symbol
-;;; 3. \( string [symbol] options* )
-;;; 4. \( symbol [string] options* )
-;;;
-;;; The string argument denotes the foreign function's name. The
-;;; symbol argument is used to name the Lisp function. If one isn't
-;;; present, its name is derived from the other. See the user
-;;; documentation for an explanation of the derivation rules.
-(defun parse-name-and-options (spec &optional varp)
- (multiple-value-bind (lisp-name foreign-name options)
- (%parse-name-and-options spec varp)
- (values lisp-name foreign-name (foreign-options options varp))))
-
-;;; If we find a &REST token at the end of ARGS, it means this is a
-;;; varargs foreign function therefore we define a lisp macro using
-;;; %DEFCFUN-VARARGS. Otherwise, a lisp function is defined with
-;;; %DEFCFUN.
-(defmacro defcfun (name-and-options return-type &body args)
- "Defines a Lisp function that calls a foreign function."
- (let ((docstring (when (stringp (car args)) (pop args))))
- (multiple-value-bind (lisp-name foreign-name options)
- (parse-name-and-options name-and-options)
- (if (eq (lastcar args) '&rest)
- (%defcfun-varargs lisp-name foreign-name return-type
- (butlast args) options docstring)
- (%defcfun lisp-name foreign-name return-type args options
- docstring)))))
-
-;;;# Defining Callbacks
-
-(defun inverse-translate-objects (args types declarations rettype call)
- `(let (,@(loop for arg in args and type in types
- collect (list arg (expand-from-foreign
- arg (parse-type type)))))
- ,@declarations
- ,(expand-to-foreign call (parse-type rettype))))
-
-(defun parse-defcallback-options (options)
- (destructuring-bind (&key (cconv :cdecl cconv-p)
- (calling-convention cconv calling-convention-p)
- (convention calling-convention))
- options
- (when cconv-p
- (warn-obsolete-argument :cconv :convention))
- (when calling-convention-p
- (warn-obsolete-argument :calling-convention :convention))
- (list :convention convention)))
-
-(defmacro defcallback (name-and-options return-type args &body body)
- (multiple-value-bind (body declarations)
- (parse-body body :documentation t)
- (let ((arg-names (mapcar #'car args))
- (arg-types (mapcar #'cadr args))
- (name (car (ensure-list name-and-options)))
- (options (cdr (ensure-list name-and-options))))
- `(progn
- (%defcallback ,name ,(canonicalize-foreign-type return-type)
- ,arg-names ,(mapcar #'canonicalize-foreign-type arg-types)
- ,(inverse-translate-objects
- arg-names arg-types declarations return-type
- `(block ,name ,@body))
- ,@(parse-defcallback-options options))
- ',name))))
-
-(declaim (inline get-callback))
-(defun get-callback (symbol)
- (%callback symbol))
-
-(defmacro callback (name)
- `(%callback ',name))
(DIR) diff --git a/3rdparties/software/cffi_0.20.0/src/libraries.lisp b/3rdparties/software/cffi_0.20.0/src/libraries.lisp
@@ -1,457 +0,0 @@
-;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
-;;;
-;;; libraries.lisp --- Finding and loading foreign libraries.
-;;;
-;;; Copyright (C) 2005-2006, James Bielman <jamesjb@jamesjb.com>
-;;; Copyright (C) 2006-2007, Luis Oliveira <loliveira@common-lisp.net>
-;;;
-;;; Permission is hereby granted, free of charge, to any person
-;;; obtaining a copy of this software and associated documentation
-;;; files (the "Software"), to deal in the Software without
-;;; restriction, including without limitation the rights to use, copy,
-;;; modify, merge, publish, distribute, sublicense, and/or sell copies
-;;; of the Software, and to permit persons to whom the Software is
-;;; furnished to do so, subject to the following conditions:
-;;;
-;;; The above copyright notice and this permission notice shall be
-;;; included in all copies or substantial portions of the Software.
-;;;
-;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
-;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
-;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
-;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
-;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
-;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
-;;; DEALINGS IN THE SOFTWARE.
-;;;
-
-(in-package #:cffi)
-
-;;;# Finding Foreign Libraries
-;;;
-;;; We offer two ways for the user of a CFFI library to define
-;;; his/her own library directories: *FOREIGN-LIBRARY-DIRECTORIES*
-;;; for regular libraries and *DARWIN-FRAMEWORK-DIRECTORIES* for
-;;; Darwin frameworks.
-;;;
-;;; These two special variables behave similarly to
-;;; ASDF:*CENTRAL-REGISTRY* as its arguments are evaluated before
-;;; being used. We used our MINI-EVAL instead of the full-blown EVAL
-;;; and the evaluated form should yield a single pathname or a list of
-;;; pathnames.
-;;;
-;;; Only after failing to find a library through the normal ways
-;;; (eg: on Linux LD_LIBRARY_PATH, /etc/ld.so.cache, /usr/lib/, /lib)
-;;; do we try to find the library ourselves.
-
-(defun explode-path-environment-variable (name)
- (mapcar #'uiop:ensure-directory-pathname
- (split-if (lambda (c) (eql #\: c))
- (uiop:getenv name)
- :elide)))
-
-(defun darwin-fallback-library-path ()
- (or (explode-path-environment-variable "DYLD_FALLBACK_LIBRARY_PATH")
- (list (merge-pathnames #p"lib/" (user-homedir-pathname))
- #p"/usr/local/lib/"
- #p"/usr/lib/")))
-
-(defvar *foreign-library-directories*
- (if (featurep :darwin)
- '((explode-path-environment-variable "LD_LIBRARY_PATH")
- (explode-path-environment-variable "DYLD_LIBRARY_PATH")
- (uiop:getcwd)
- (darwin-fallback-library-path))
- '())
- "List onto which user-defined library paths can be pushed.")
-
-(defun fallback-darwin-framework-directories ()
- (or (explode-path-environment-variable "DYLD_FALLBACK_FRAMEWORK_PATH")
- (list (uiop:getcwd)
- (merge-pathnames #p"Library/Frameworks/" (user-homedir-pathname))
- #p"/Library/Frameworks/"
- #p"/System/Library/Frameworks/")))
-
-(defvar *darwin-framework-directories*
- '((explode-path-environment-variable "DYLD_FRAMEWORK_PATH")
- (fallback-darwin-framework-directories))
- "List of directories where Frameworks are searched for.")
-
-(defun mini-eval (form)
- "Simple EVAL-like function to evaluate the elements of
-*FOREIGN-LIBRARY-DIRECTORIES* and *DARWIN-FRAMEWORK-DIRECTORIES*."
- (typecase form
- (cons (apply (car form) (mapcar #'mini-eval (cdr form))))
- (symbol (symbol-value form))
- (t form)))
-
-(defun parse-directories (list)
- (mappend (compose #'ensure-list #'mini-eval) list))
-
-(defun find-file (path directories)
- "Searches for PATH in a list of DIRECTORIES and returns the first it finds."
- (some (lambda (directory) (probe-file (merge-pathnames path directory)))
- directories))
-
-(defun find-darwin-framework (framework-name)
- "Searches for FRAMEWORK-NAME in *DARWIN-FRAMEWORK-DIRECTORIES*."
- (dolist (directory (parse-directories *darwin-framework-directories*))
- (let ((path (make-pathname
- :name framework-name
- :directory
- (append (pathname-directory directory)
- (list (format nil "~A.framework" framework-name))))))
- (when (probe-file path)
- (return-from find-darwin-framework path)))))
-
-;;;# Defining Foreign Libraries
-;;;
-;;; Foreign libraries can be defined using the
-;;; DEFINE-FOREIGN-LIBRARY macro. Example usage:
-;;;
-;;; (define-foreign-library opengl
-;;; (:darwin (:framework "OpenGL"))
-;;; (:unix (:or "libGL.so" "libGL.so.1"
-;;; #p"/myhome/mylibGL.so"))
-;;; (:windows "opengl32.dll")
-;;; ;; an hypothetical example of a particular platform
-;;; ((:and :some-system :some-cpu) "libGL-support.lib")
-;;; ;; if no other clauses apply, this one will and a type will be
-;;; ;; automagically appended to the name passed to :default
-;;; (t (:default "libGL")))
-;;;
-;;; This information is stored in the *FOREIGN-LIBRARIES* hashtable
-;;; and when the library is loaded through LOAD-FOREIGN-LIBRARY (or
-;;; USE-FOREIGN-LIBRARY) the first clause matched by FEATUREP is
-;;; processed.
-
-(defvar *foreign-libraries* (make-hash-table :test 'eq)
- "Hashtable of defined libraries.")
-
-(defclass foreign-library ()
- ((name :initform nil :initarg :name :accessor foreign-library-name)
- (type :initform :system :initarg :type)
- (spec :initarg :spec)
- (options :initform nil :initarg :options)
- (handle :initform nil :initarg :handle :accessor foreign-library-handle)
- (pathname :initform nil)))
-
-(defmethod print-object ((library foreign-library) stream)
- (with-slots (name pathname) library
- (print-unreadable-object (library stream :type t)
- (when name
- (format stream "~A" name))
- (when pathname
- (format stream " ~S" (file-namestring pathname))))))
-
-(define-condition foreign-library-undefined-error (error)
- ((name :initarg :name :reader fl-name))
- (:report (lambda (c s)
- (format s "Undefined foreign library: ~S"
- (fl-name c)))))
-
-(defun get-foreign-library (lib)
- "Look up a library by NAME, signalling an error if not found."
- (if (typep lib 'foreign-library)
- lib
- (or (gethash lib *foreign-libraries*)
- (error 'foreign-library-undefined-error :name lib))))
-
-(defun (setf get-foreign-library) (value name)
- (setf (gethash name *foreign-libraries*) value))
-
-(defun foreign-library-type (lib)
- (slot-value (get-foreign-library lib) 'type))
-
-(defun foreign-library-pathname (lib)
- (slot-value (get-foreign-library lib) 'pathname))
-
-(defun %foreign-library-spec (lib)
- (assoc-if (lambda (feature)
- (or (eq feature t)
- (featurep feature)))
- (slot-value lib 'spec)))
-
-(defun foreign-library-spec (lib)
- (second (%foreign-library-spec lib)))
-
-(defun foreign-library-options (lib)
- (append (cddr (%foreign-library-spec lib))
- (slot-value lib 'options)))
-
-(defun foreign-library-search-path (lib)
- (loop for (opt val) on (foreign-library-options lib) by #'cddr
- when (eql opt :search-path)
- append (ensure-list val) into search-path
- finally (return (mapcar #'pathname search-path))))
-
-(defun foreign-library-loaded-p (lib)
- (not (null (foreign-library-handle (get-foreign-library lib)))))
-
-(defun list-foreign-libraries (&key (loaded-only t) type)
- "Return a list of defined foreign libraries.
-If LOADED-ONLY is non-null only loaded libraries are returned.
-TYPE restricts the output to a specific library type: if NIL
-all libraries are returned."
- (let ((libs (hash-table-values *foreign-libraries*)))
- (remove-if (lambda (lib)
- (or (and type
- (not (eql type (foreign-library-type lib))))
- (and loaded-only
- (not (foreign-library-loaded-p lib)))))
- libs)))
-
-;; :CONVENTION, :CALLING-CONVENTION and :CCONV are coalesced,
-;; the former taking priority
-;; options with NULL values are removed
-(defun clean-spec-up (spec)
- (mapcar (lambda (x)
- (list* (first x) (second x)
- (let* ((opts (cddr x))
- (cconv (getf opts :cconv))
- (calling-convention (getf opts :calling-convention))
- (convention (getf opts :convention))
- (search-path (getf opts :search-path)))
- (remf opts :cconv) (remf opts :calling-convention)
- (when cconv
- (warn-obsolete-argument :cconv :convention))
- (when calling-convention
- (warn-obsolete-argument :calling-convention
- :convention))
- (setf (getf opts :convention)
- (or convention calling-convention cconv))
- (setf (getf opts :search-path)
- (mapcar #'pathname (ensure-list search-path)))
- (loop for (opt val) on opts by #'cddr
- when val append (list opt val) into new-opts
- finally (return new-opts)))))
- spec))
-
-(defmethod initialize-instance :after
- ((lib foreign-library) &key search-path
- (cconv :cdecl cconv-p)
- (calling-convention cconv calling-convention-p)
- (convention calling-convention))
- (with-slots (type options spec) lib
- (check-type type (member :system :test :grovel-wrapper))
- (setf spec (clean-spec-up spec))
- (let ((all-options
- (apply #'append options (mapcar #'cddr spec))))
- (assert (subsetp (loop for (key . nil) on all-options by #'cddr
- collect key)
- '(:convention :search-path)))
- (when cconv-p
- (warn-obsolete-argument :cconv :convention))
- (when calling-convention-p
- (warn-obsolete-argument :calling-convention :convention))
- (flet ((set-option (key value)
- (when value (setf (getf options key) value))))
- (set-option :convention convention)
- (set-option :search-path
- (mapcar #'pathname (ensure-list search-path)))))))
-
-(defun register-foreign-library (name spec &rest options)
- (let ((old-handle
- (when-let ((old-lib (gethash name *foreign-libraries*)))
- (foreign-library-handle old-lib))))
- (setf (get-foreign-library name)
- (apply #'make-instance 'foreign-library
- :name name
- :spec spec
- :handle old-handle
- options))
- name))
-
-(defmacro define-foreign-library (name-and-options &body pairs)
- "Defines a foreign library NAME that can be posteriorly used with
-the USE-FOREIGN-LIBRARY macro."
- (destructuring-bind (name . options)
- (ensure-list name-and-options)
- (check-type name symbol)
- `(register-foreign-library ',name ',pairs ,@options)))
-
-;;;# LOAD-FOREIGN-LIBRARY-ERROR condition
-;;;
-;;; The various helper functions that load foreign libraries can
-;;; signal this error when something goes wrong. We ignore the host's
-;;; error. We should probably reuse its error message.
-
-(define-condition load-foreign-library-error (simple-error)
- ())
-
-(defun read-new-value ()
- (format *query-io* "~&Enter a new value (unevaluated): ")
- (force-output *query-io*)
- (read *query-io*))
-
-(defun fl-error (control &rest arguments)
- (error 'load-foreign-library-error
- :format-control control
- :format-arguments arguments))
-
-;;;# Loading Foreign Libraries
-
-(defun load-darwin-framework (name framework-name)
- "Tries to find and load a darwin framework in one of the directories
-in *DARWIN-FRAMEWORK-DIRECTORIES*. If unable to find FRAMEWORK-NAME,
-it signals a LOAD-FOREIGN-LIBRARY-ERROR."
- (let ((framework (find-darwin-framework framework-name)))
- (if framework
- (load-foreign-library-path name (native-namestring framework))
- (fl-error "Unable to find framework ~A" framework-name))))
-
-(defun report-simple-error (name error)
- (fl-error "Unable to load foreign library (~A).~% ~A"
- name
- (format nil "~?" (simple-condition-format-control error)
- (simple-condition-format-arguments error))))
-
-;;; FIXME: haven't double checked whether all Lisps signal a
-;;; SIMPLE-ERROR on %load-foreign-library failure. In any case they
-;;; should be throwing a more specific error.
-(defun load-foreign-library-path (name path &optional search-path)
- "Tries to load PATH using %LOAD-FOREIGN-LIBRARY which should try and
-find it using the OS's usual methods. If that fails we try to find it
-ourselves."
- (handler-case
- (values (%load-foreign-library name path)
- (pathname path))
- (simple-error (error)
- (let ((dirs (parse-directories *foreign-library-directories*)))
- (if-let (file (find-file path (append search-path dirs)))
- (handler-case
- (values (%load-foreign-library name (native-namestring file))
- file)
- (simple-error (error)
- (report-simple-error name error)))
- (report-simple-error name error))))))
-
-(defun try-foreign-library-alternatives (name library-list &optional search-path)
- "Goes through a list of alternatives and only signals an error when
-none of alternatives were successfully loaded."
- (dolist (lib library-list)
- (multiple-value-bind (handle pathname)
- (ignore-errors (load-foreign-library-helper name lib search-path))
- (when handle
- (return-from try-foreign-library-alternatives
- (values handle pathname)))))
- ;; Perhaps we should show the error messages we got for each
- ;; alternative if we can figure out a nice way to do that.
- (fl-error "Unable to load any of the alternatives:~% ~S" library-list))
-
-(defparameter *cffi-feature-suffix-map*
- '((:windows . ".dll")
- (:darwin . ".dylib")
- (:unix . ".so")
- (t . ".so"))
- "Mapping of OS feature keywords to shared library suffixes.")
-
-(defun default-library-suffix ()
- "Return a string to use as default library suffix based on the
-operating system. This is used to implement the :DEFAULT option.
-This will need to be extended as we test on more OSes."
- (or (cdr (assoc-if #'featurep *cffi-feature-suffix-map*))
- (fl-error "Unable to determine the default library suffix on this OS.")))
-
-(defun load-foreign-library-helper (name thing &optional search-path)
- (etypecase thing
- ((or pathname string)
- (load-foreign-library-path name (filter-pathname thing) search-path))
- (cons
- (ecase (first thing)
- (:framework (load-darwin-framework name (second thing)))
- (:default
- (unless (stringp (second thing))
- (fl-error "Argument to :DEFAULT must be a string."))
- (let ((library-path
- (concatenate 'string
- (second thing)
- (default-library-suffix))))
- (load-foreign-library-path name library-path search-path)))
- (:or (try-foreign-library-alternatives name (rest thing) search-path))))))
-
-(defun %do-load-foreign-library (library search-path)
- (flet ((%do-load (lib name spec)
- (when (foreign-library-spec lib)
- (with-slots (handle pathname) lib
- (setf (values handle pathname)
- (load-foreign-library-helper
- name spec (foreign-library-search-path lib)))))
- lib))
- (etypecase library
- (symbol
- (let* ((lib (get-foreign-library library))
- (spec (foreign-library-spec lib)))
- (%do-load lib library spec)))
- ((or string list)
- (let* ((lib-name (gensym
- (format nil "~:@(~A~)-"
- (if (listp library)
- (first library)
- (file-namestring library)))))
- (lib (make-instance 'foreign-library
- :type :system
- :name lib-name
- :spec `((t ,library))
- :search-path search-path)))
- ;; first try to load the anonymous library
- ;; and register it only if that worked
- (%do-load lib lib-name library)
- (setf (get-foreign-library lib-name) lib))))))
-
-(defun filter-pathname (thing)
- (typecase thing
- (pathname (namestring thing))
- (t thing)))
-
-(defun load-foreign-library (library &key search-path)
- "Loads a foreign LIBRARY which can be a symbol denoting a library defined
-through DEFINE-FOREIGN-LIBRARY; a pathname or string in which case we try to
-load it directly first then search for it in *FOREIGN-LIBRARY-DIRECTORIES*;
-or finally list: either (:or lib1 lib2) or (:framework <framework-name>)."
- (let ((library (filter-pathname library)))
- (restart-case
- (progn
- ;; dlopen/dlclose does reference counting, but the CFFI-SYS
- ;; API has no infrastructure to track that. Therefore if we
- ;; want to avoid increasing the internal dlopen reference
- ;; counter, and thus thwarting dlclose, then we need to try
- ;; to call CLOSE-FOREIGN-LIBRARY and ignore any signaled
- ;; errors.
- (ignore-some-conditions (foreign-library-undefined-error)
- (close-foreign-library library))
- (%do-load-foreign-library library search-path))
- ;; Offer these restarts that will retry the call to
- ;; %LOAD-FOREIGN-LIBRARY.
- (retry ()
- :report "Try loading the foreign library again."
- (load-foreign-library library :search-path search-path))
- (use-value (new-library)
- :report "Use another library instead."
- :interactive read-new-value
- (load-foreign-library new-library :search-path search-path)))))
-
-(defmacro use-foreign-library (name)
- `(load-foreign-library ',name))
-
-;;;# Closing Foreign Libraries
-
-(defun close-foreign-library (library)
- "Closes a foreign library."
- (let* ((library (filter-pathname library))
- (lib (get-foreign-library library))
- (handle (foreign-library-handle lib)))
- (when handle
- (%close-foreign-library handle)
- (setf (foreign-library-handle lib) nil)
- t)))
-
-(defun reload-foreign-libraries (&key (test #'foreign-library-loaded-p))
- "(Re)load all currently loaded foreign libraries."
- (let ((libs (list-foreign-libraries)))
- (loop for l in libs
- for name = (foreign-library-name l)
- when (funcall test name)
- do (load-foreign-library name))
- libs))
(DIR) diff --git a/3rdparties/software/cffi_0.20.0/src/package.lisp b/3rdparties/software/cffi_0.20.0/src/package.lisp
@@ -1,181 +0,0 @@
-;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
-;;;
-;;; package.lisp --- Package definition for CFFI.
-;;;
-;;; Copyright (C) 2005-2006, James Bielman <jamesjb@jamesjb.com>
-;;;
-;;; Permission is hereby granted, free of charge, to any person
-;;; obtaining a copy of this software and associated documentation
-;;; files (the "Software"), to deal in the Software without
-;;; restriction, including without limitation the rights to use, copy,
-;;; modify, merge, publish, distribute, sublicense, and/or sell copies
-;;; of the Software, and to permit persons to whom the Software is
-;;; furnished to do so, subject to the following conditions:
-;;;
-;;; The above copyright notice and this permission notice shall be
-;;; included in all copies or substantial portions of the Software.
-;;;
-;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
-;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
-;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
-;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
-;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
-;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
-;;; DEALINGS IN THE SOFTWARE.
-;;;
-
-(in-package #:cl-user)
-
-(defpackage #:cffi
- (:use #:common-lisp #:cffi-sys #:babel-encodings)
- (:import-from #:alexandria
- #:compose
- #:ensure-list
- #:featurep
- #:format-symbol
- #:hash-table-values
- #:if-let
- #:ignore-some-conditions
- #:lastcar
- #:make-gensym-list
- #:make-keyword
- #:mappend
- #:once-only
- #:parse-body
- #:simple-style-warning
- #:symbolicate
- #:unwind-protect-case
- #:when-let
- #:with-unique-names)
- (:export
- ;; Types.
- #:foreign-pointer
-
- ;; FIXME: the following types are undocumented. They should
- ;; probably be replaced with a proper type introspection API
- ;; though.
- #:*built-in-foreign-types*
- #:*other-builtin-types*
- #:*built-in-integer-types*
- #:*built-in-float-types*
-
- ;; Primitive pointer operations.
- #:foreign-free
- #:foreign-alloc
- #:mem-aptr
- #:mem-aref
- #:mem-ref
- #:pointerp
- #:pointer-eq
- #:null-pointer
- #:null-pointer-p
- #:inc-pointer
- #:incf-pointer
- #:with-foreign-pointer
- #:make-pointer
- #:pointer-address
-
- ;; Shareable vectors.
- #:make-shareable-byte-vector
- #:with-pointer-to-vector-data
-
- ;; Foreign string operations.
- #:*default-foreign-encoding*
- #:foreign-string-alloc
- #:foreign-string-free
- #:foreign-string-to-lisp
- #:lisp-string-to-foreign
- #:with-foreign-string
- #:with-foreign-strings
- #:with-foreign-pointer-as-string
-
- ;; Foreign array operations.
- ;; TODO: document these
- #:foreign-array-alloc
- #:foreign-array-free
- #:foreign-array-to-lisp
- #:lisp-array-to-foreign
- #:with-foreign-array
- #:foreign-aref
-
- ;; Foreign function operations.
- #:defcfun
- #:foreign-funcall
- #:foreign-funcall-pointer
- #:foreign-funcall-varargs
- #:foreign-funcall-pointer-varargs
- #:translate-camelcase-name
- #:translate-name-from-foreign
- #:translate-name-to-foreign
- #:translate-underscore-separated-name
-
- ;; Foreign library operations.
- #:*foreign-library-directories*
- #:*darwin-framework-directories*
- #:foreign-library
- #:foreign-library-name
- #:foreign-library-pathname
- #:foreign-library-type
- #:foreign-library-loaded-p
- #:list-foreign-libraries
- #:define-foreign-library
- #:load-foreign-library
- #:load-foreign-library-error
- #:use-foreign-library
- #:close-foreign-library
- #:reload-foreign-libraries
-
- ;; Callbacks.
- #:callback
- #:get-callback
- #:defcallback
-
- ;; Foreign type operations.
- #:defcstruct
- #:defcunion
- #:defctype
- #:defcenum
- #:defbitfield
- #:define-foreign-type
- #:define-parse-method
- #:define-c-struct-wrapper
- #:foreign-enum-keyword
- #:foreign-enum-keyword-list
- #:foreign-enum-value
- #:foreign-bitfield-symbol-list
- #:foreign-bitfield-symbols
- #:foreign-bitfield-value
- #:foreign-slot-pointer
- #:foreign-slot-value
- #:foreign-slot-type
- #:foreign-slot-offset
- #:foreign-slot-count
- #:foreign-slot-names
- #:foreign-type-alignment
- #:foreign-type-size
- #:with-foreign-object
- #:with-foreign-objects
- #:with-foreign-slots
- #:convert-to-foreign
- #:convert-from-foreign
- #:convert-into-foreign-memory
- #:free-converted-object
- #:translation-forms-for-class
-
- ;; Extensible foreign type operations.
- #:define-translation-method ; FIXME: undocumented
- #:translate-to-foreign
- #:translate-from-foreign
- #:translate-into-foreign-memory
- #:free-translated-object
- #:expand-to-foreign-dyn
- #:expand-to-foreign
- #:expand-from-foreign
- #:expand-into-foreign-memory
-
- ;; Foreign globals.
- #:defcvar
- #:get-var-pointer
- #:foreign-symbol-pointer
- ))
(DIR) diff --git a/3rdparties/software/cffi_0.20.0/src/strings.lisp b/3rdparties/software/cffi_0.20.0/src/strings.lisp
@@ -1,305 +0,0 @@
-;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
-;;;
-;;; strings.lisp --- Operations on foreign strings.
-;;;
-;;; Copyright (C) 2005-2006, James Bielman <jamesjb@jamesjb.com>
-;;; Copyright (C) 2005-2007, Luis Oliveira <loliveira@common-lisp.net>
-;;;
-;;; Permission is hereby granted, free of charge, to any person
-;;; obtaining a copy of this software and associated documentation
-;;; files (the "Software"), to deal in the Software without
-;;; restriction, including without limitation the rights to use, copy,
-;;; modify, merge, publish, distribute, sublicense, and/or sell copies
-;;; of the Software, and to permit persons to whom the Software is
-;;; furnished to do so, subject to the following conditions:
-;;;
-;;; The above copyright notice and this permission notice shall be
-;;; included in all copies or substantial portions of the Software.
-;;;
-;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
-;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
-;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
-;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
-;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
-;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
-;;; DEALINGS IN THE SOFTWARE.
-;;;
-
-(in-package #:cffi)
-
-;;;# Foreign String Conversion
-;;;
-;;; Functions for converting NULL-terminated C-strings to Lisp strings
-;;; and vice versa. The string functions accept an ENCODING keyword
-;;; argument which is used to specify the encoding to use when
-;;; converting to/from foreign strings.
-
-(defvar *default-foreign-encoding* :utf-8
- "Default foreign encoding.")
-
-;;; TODO: refactor, sigh. Also, this should probably be a function.
-(defmacro bget (ptr off &optional (bytes 1) (endianness :ne))
- (let ((big-endian (member endianness
- '(:be #+big-endian :ne #+little-endian :re))))
- (once-only (ptr off)
- (ecase bytes
- (1 `(mem-ref ,ptr :uint8 ,off))
- (2 (if big-endian
- #+big-endian
- `(mem-ref ,ptr :uint16 ,off)
- #-big-endian
- `(dpb (mem-ref ,ptr :uint8 ,off) (byte 8 8)
- (mem-ref ,ptr :uint8 (1+ ,off)))
- #+little-endian
- `(mem-ref ,ptr :uint16 ,off)
- #-little-endian
- `(dpb (mem-ref ,ptr :uint8 (1+ ,off)) (byte 8 8)
- (mem-ref ,ptr :uint8 ,off))))
- (4 (if big-endian
- #+big-endian
- `(mem-ref ,ptr :uint32 ,off)
- #-big-endian
- `(dpb (mem-ref ,ptr :uint8 ,off) (byte 8 24)
- (dpb (mem-ref ,ptr :uint8 (1+ ,off)) (byte 8 16)
- (dpb (mem-ref ,ptr :uint8 (+ ,off 2)) (byte 8 8)
- (mem-ref ,ptr :uint8 (+ ,off 3)))))
- #+little-endian
- `(mem-ref ,ptr :uint32 ,off)
- #-little-endian
- `(dpb (mem-ref ,ptr :uint8 (+ ,off 3)) (byte 8 24)
- (dpb (mem-ref ,ptr :uint8 (+ ,off 2)) (byte 8 16)
- (dpb (mem-ref ,ptr :uint8 (1+ ,off)) (byte 8 8)
- (mem-ref ,ptr :uint8 ,off))))))))))
-
-(defmacro bset (val ptr off &optional (bytes 1) (endianness :ne))
- (let ((big-endian (member endianness
- '(:be #+big-endian :ne #+little-endian :re))))
- (ecase bytes
- (1 `(setf (mem-ref ,ptr :uint8 ,off) ,val))
- (2 (if big-endian
- #+big-endian
- `(setf (mem-ref ,ptr :uint16 ,off) ,val)
- #-big-endian
- `(setf (mem-ref ,ptr :uint8 (1+ ,off)) (ldb (byte 8 0) ,val)
- (mem-ref ,ptr :uint8 ,off) (ldb (byte 8 8) ,val))
- #+little-endian
- `(setf (mem-ref ,ptr :uint16 ,off) ,val)
- #-little-endian
- `(setf (mem-ref ,ptr :uint8 ,off) (ldb (byte 8 0) ,val)
- (mem-ref ,ptr :uint8 (1+ ,off)) (ldb (byte 8 8) ,val))))
- (4 (if big-endian
- #+big-endian
- `(setf (mem-ref ,ptr :uint32 ,off) ,val)
- #-big-endian
- `(setf (mem-ref ,ptr :uint8 (+ 3 ,off)) (ldb (byte 8 0) ,val)
- (mem-ref ,ptr :uint8 (+ 2 ,off)) (ldb (byte 8 8) ,val)
- (mem-ref ,ptr :uint8 (1+ ,off)) (ldb (byte 8 16) ,val)
- (mem-ref ,ptr :uint8 ,off) (ldb (byte 8 24) ,val))
- #+little-endian
- `(setf (mem-ref ,ptr :uint32 ,off) ,val)
- #-little-endian
- `(setf (mem-ref ,ptr :uint8 ,off) (ldb (byte 8 0) ,val)
- (mem-ref ,ptr :uint8 (1+ ,off)) (ldb (byte 8 8) ,val)
- (mem-ref ,ptr :uint8 (+ ,off 2)) (ldb (byte 8 16) ,val)
- (mem-ref ,ptr :uint8 (+ ,off 3)) (ldb (byte 8 24) ,val)))))))
-
-;;; TODO: tackle optimization notes.
-(defparameter *foreign-string-mappings*
- (instantiate-concrete-mappings
- ;; :optimize ((speed 3) (debug 0) (compilation-speed 0) (safety 0))
- :octet-seq-getter bget
- :octet-seq-setter bset
- :octet-seq-type foreign-pointer
- :code-point-seq-getter babel::string-get
- :code-point-seq-setter babel::string-set
- :code-point-seq-type babel:simple-unicode-string))
-
-(defun null-terminator-len (encoding)
- (length (enc-nul-encoding (get-character-encoding encoding))))
-
-(defun lisp-string-to-foreign (string buffer bufsize &key (start 0) end offset
- (encoding *default-foreign-encoding*))
- (check-type string string)
- (when offset
- (setq buffer (inc-pointer buffer offset)))
- (with-checked-simple-vector ((string (coerce string 'babel:unicode-string))
- (start start) (end end))
- (declare (type simple-string string))
- (let ((mapping (lookup-mapping *foreign-string-mappings* encoding))
- (nul-len (null-terminator-len encoding)))
- (assert (plusp bufsize))
- (multiple-value-bind (size end)
- (funcall (octet-counter mapping) string start end (- bufsize nul-len))
- (funcall (encoder mapping) string start end buffer 0)
- (dotimes (i nul-len)
- (setf (mem-ref buffer :char (+ size i)) 0))))
- buffer))
-
-;;; Expands into a loop that calculates the length of the foreign
-;;; string at PTR plus OFFSET, using ACCESSOR and looking for a null
-;;; terminator of LENGTH bytes.
-(defmacro %foreign-string-length (ptr offset type length)
- (once-only (ptr offset)
- `(do ((i 0 (+ i ,length)))
- ((zerop (mem-ref ,ptr ,type (+ ,offset i))) i)
- (declare (fixnum i)))))
-
-;;; Return the length in octets of the null terminated foreign string
-;;; at POINTER plus OFFSET octets, assumed to be encoded in ENCODING,
-;;; a CFFI encoding. This should be smart enough to look for 8-bit vs
-;;; 16-bit null terminators, as appropriate for the encoding.
-(defun foreign-string-length (pointer &key (encoding *default-foreign-encoding*)
- (offset 0))
- (ecase (null-terminator-len encoding)
- (1 (%foreign-string-length pointer offset :uint8 1))
- (2 (%foreign-string-length pointer offset :uint16 2))
- (4 (%foreign-string-length pointer offset :uint32 4))))
-
-(defun foreign-string-to-lisp (pointer &key (offset 0) count
- (max-chars (1- array-total-size-limit))
- (encoding *default-foreign-encoding*))
- "Copy at most COUNT bytes from POINTER plus OFFSET encoded in
-ENCODING into a Lisp string and return it. If POINTER is a null
-pointer, NIL is returned."
- (unless (null-pointer-p pointer)
- (let ((count (or count
- (foreign-string-length
- pointer :encoding encoding :offset offset)))
- (mapping (lookup-mapping *foreign-string-mappings* encoding)))
- (assert (plusp max-chars))
- (multiple-value-bind (size new-end)
- (funcall (code-point-counter mapping)
- pointer offset (+ offset count) max-chars)
- (let ((string (make-string size :element-type 'babel:unicode-char)))
- (funcall (decoder mapping) pointer offset new-end string 0)
- (values string (- new-end offset)))))))
-
-;;;# Using Foreign Strings
-
-(defun foreign-string-alloc (string &key (encoding *default-foreign-encoding*)
- (null-terminated-p t) (start 0) end)
- "Allocate a foreign string containing Lisp string STRING.
-The string must be freed with FOREIGN-STRING-FREE."
- (check-type string string)
- (with-checked-simple-vector ((string (coerce string 'babel:unicode-string))
- (start start) (end end))
- (declare (type simple-string string))
- (let* ((mapping (lookup-mapping *foreign-string-mappings* encoding))
- (count (funcall (octet-counter mapping) string start end 0))
- (nul-length (if null-terminated-p
- (null-terminator-len encoding)
- 0))
- (length (+ count nul-length))
- (ptr (foreign-alloc :char :count length)))
- (funcall (encoder mapping) string start end ptr 0)
- (dotimes (i nul-length)
- (setf (mem-ref ptr :char (+ count i)) 0))
- (values ptr length))))
-
-(defun foreign-string-free (ptr)
- "Free a foreign string allocated by FOREIGN-STRING-ALLOC."
- (foreign-free ptr))
-
-(defmacro with-foreign-string ((var-or-vars lisp-string &rest args) &body body)
- "VAR-OR-VARS is not evaluated and should be a list of the form
-\(VAR &OPTIONAL BYTE-SIZE-VAR) or just a VAR symbol. VAR is
-bound to a foreign string containing LISP-STRING in BODY. When
-BYTE-SIZE-VAR is specified then bind the C buffer size
-\(including the possible null terminator\(s)) to this variable."
- (destructuring-bind (var &optional size-var)
- (ensure-list var-or-vars)
- `(multiple-value-bind (,var ,@(when size-var (list size-var)))
- (foreign-string-alloc ,lisp-string ,@args)
- (unwind-protect
- (progn ,@body)
- (foreign-string-free ,var)))))
-
-(defmacro with-foreign-strings (bindings &body body)
- "See WITH-FOREIGN-STRING's documentation."
- (if bindings
- `(with-foreign-string ,(first bindings)
- (with-foreign-strings ,(rest bindings)
- ,@body))
- `(progn ,@body)))
-
-(defmacro with-foreign-pointer-as-string
- ((var-or-vars size &rest args) &body body)
- "VAR-OR-VARS is not evaluated and should be a list of the form
-\(VAR &OPTIONAL SIZE-VAR) or just a VAR symbol. VAR is bound to
-a foreign buffer of size SIZE within BODY. The return value is
-constructed by calling FOREIGN-STRING-TO-LISP on the foreign
-buffer along with ARGS." ; fix wording, sigh
- (destructuring-bind (var &optional size-var)
- (ensure-list var-or-vars)
- `(with-foreign-pointer (,var ,size ,size-var)
- (progn
- ,@body
- (values (foreign-string-to-lisp ,var ,@args))))))
-
-;;;# Automatic Conversion of Foreign Strings
-
-(define-foreign-type foreign-string-type ()
- (;; CFFI encoding of this string.
- (encoding :initform nil :initarg :encoding :reader encoding)
- ;; Should we free after translating from foreign?
- (free-from-foreign :initarg :free-from-foreign
- :reader fst-free-from-foreign-p
- :initform nil :type boolean)
- ;; Should we free after translating to foreign?
- (free-to-foreign :initarg :free-to-foreign
- :reader fst-free-to-foreign-p
- :initform t :type boolean))
- (:actual-type :pointer)
- (:simple-parser :string))
-
-;;; describe me
-(defun fst-encoding (type)
- (or (encoding type) *default-foreign-encoding*))
-
-;;; Display the encoding when printing a FOREIGN-STRING-TYPE instance.
-(defmethod print-object ((type foreign-string-type) stream)
- (print-unreadable-object (type stream :type t)
- (format stream "~S" (fst-encoding type))))
-
-(defmethod translate-to-foreign ((s string) (type foreign-string-type))
- (values (foreign-string-alloc s :encoding (fst-encoding type))
- (fst-free-to-foreign-p type)))
-
-(defmethod translate-to-foreign (obj (type foreign-string-type))
- (cond
- ((pointerp obj)
- (values obj nil))
- ;; FIXME: we used to support UB8 vectors but not anymore.
- ;; ((typep obj '(array (unsigned-byte 8)))
- ;; (values (foreign-string-alloc obj) t))
- (t (error "~A is not a Lisp string or pointer." obj))))
-
-(defmethod translate-from-foreign (ptr (type foreign-string-type))
- (unwind-protect
- (values (foreign-string-to-lisp ptr :encoding (fst-encoding type)))
- (when (fst-free-from-foreign-p type)
- (foreign-free ptr))))
-
-(defmethod free-translated-object (ptr (type foreign-string-type) free-p)
- (when free-p
- (foreign-string-free ptr)))
-
-(defmethod expand-to-foreign-dyn-indirect
- (value var body (type foreign-string-type))
- (alexandria:with-gensyms (str)
- (expand-to-foreign-dyn
- value
- str
- (list
- (expand-to-foreign-dyn-indirect str var body (parse-type :pointer)))
- type)))
-
-;;;# STRING+PTR
-
-(define-foreign-type foreign-string+ptr-type (foreign-string-type)
- ()
- (:simple-parser :string+ptr))
-
-(defmethod translate-from-foreign (value (type foreign-string+ptr-type))
- (list (call-next-method) value))
(DIR) diff --git a/3rdparties/software/cffi_0.20.0/src/structures.lisp b/3rdparties/software/cffi_0.20.0/src/structures.lisp
@@ -1,133 +0,0 @@
-;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
-;;;
-;;; structures.lisp --- Methods for translating foreign structures.
-;;;
-;;; Copyright (C) 2011, Liam M. Healy <lhealy@common-lisp.net>
-;;;
-;;; Permission is hereby granted, free of charge, to any person
-;;; obtaining a copy of this software and associated documentation
-;;; files (the "Software"), to deal in the Software without
-;;; restriction, including without limitation the rights to use, copy,
-;;; modify, merge, publish, distribute, sublicense, and/or sell copies
-;;; of the Software, and to permit persons to whom the Software is
-;;; furnished to do so, subject to the following conditions:
-;;;
-;;; The above copyright notice and this permission notice shall be
-;;; included in all copies or substantial portions of the Software.
-;;;
-;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
-;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
-;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
-;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
-;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
-;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
-;;; DEALINGS IN THE SOFTWARE.
-;;;
-
-(in-package #:cffi)
-
-;;; Definitions for conversion of foreign structures.
-
-(defmethod translate-into-foreign-memory ((object list)
- (type foreign-struct-type)
- p)
- (unless (bare-struct-type-p type)
- (loop for (name value) on object by #'cddr
- do (setf (foreign-slot-value p (unparse-type type) name)
- (let ((slot (gethash name (structure-slots type))))
- (convert-to-foreign value (slot-type slot)))))))
-
-(defmethod translate-to-foreign (value (type foreign-struct-type))
- (let ((ptr (foreign-alloc type)))
- (translate-into-foreign-memory value type ptr)
- ptr))
-
-(defmethod translate-from-foreign (p (type foreign-struct-type))
- ;; Iterate over slots, make plist
- (if (bare-struct-type-p type)
- p
- (let ((plist (list)))
- (loop for slot being the hash-value of (structure-slots type)
- for name = (slot-name slot)
- do (setf (getf plist name)
- (foreign-struct-slot-value p slot)))
- plist)))
-
-(defmethod free-translated-object (ptr (type foreign-struct-type) freep)
- (unless (bare-struct-type-p type)
- ;; Look for any pointer slots and free them first
- (loop for slot being the hash-value of (structure-slots type)
- when (and (listp (slot-type slot)) (eq (first (slot-type slot)) :pointer))
- do
- ;; Free if the pointer is to a specific type, not generic :pointer
- (free-translated-object
- (foreign-slot-value ptr type (slot-name slot))
- (rest (slot-type slot))
- freep))
- (foreign-free ptr)))
-
-(defmacro define-translation-method ((object type method) &body body)
- "Define a translation method for the foreign structure type; 'method is one of :into, :from, or :to, meaning relation to foreign memory. If :into, the variable 'pointer is the foreign pointer. Note: type must be defined and loaded before this macro is expanded, and just the bare name (without :struct) should be specified."
- (let ((tclass (class-name (class-of (cffi::parse-type `(:struct ,type))))))
- (when (eq tclass 'foreign-struct-type)
- (error "Won't replace existing translation method for foreign-struct-type"))
- `(defmethod
- ,(case method
- (:into 'translate-into-foreign-memory)
- (:from 'translate-from-foreign)
- (:to 'translate-to-foreign))
- ;; Arguments to the method
- (,object
- (type ,tclass)
- ,@(when (eq method :into) '(pointer))) ; is intentional variable capture a good idea?
- ;; The body
- (declare (ignorable type)) ; I can't think of a reason why you'd want to use this
- ,@body)))
-
-(defmacro translation-forms-for-class (class type-class)
- "Make forms for translation of foreign structures to and from a standard class. The class slots are assumed to have the same name as the foreign structure."
- ;; Possible improvement: optional argument to map structure slot names to/from class slot names.
- `(progn
- (defmethod translate-from-foreign (pointer (type ,type-class))
- ;; Make the instance from the plist
- (apply 'make-instance ',class (call-next-method)))
- (defmethod translate-into-foreign-memory ((object ,class) (type ,type-class) pointer)
- (call-next-method
- ;; Translate into a plist and call the general method
- (loop for slot being the hash-value of (structure-slots type)
- for name = (slot-name slot)
- append (list slot-name (slot-value object slot-name)))
- type
- pointer))))
-
-;;; For a class already defined and loaded, and a defcstruct already defined, use
-;;; (translation-forms-for-class class type-class)
-;;; to connnect the two. It would be nice to have a macro to do all three simultaneously.
-;;; (defmacro define-foreign-structure (class ))
-
-#|
-(defmacro define-structure-conversion
- (value-symbol type lisp-class slot-names to-form from-form &optional (struct-name type))
- "Define the functions necessary to convert to and from a foreign structure. The to-form sets each of the foreign slots in succession, assume the foreign object exists. The from-form creates the Lisp object, making it with the correct value by reference to foreign slots."
- `(flet ((map-slots (fn val)
- (maphash
- (lambda (name slot-struct)
- (funcall fn (foreign-slot-value val ',type name) (slot-type slot-struct)))
- (slots (follow-typedefs (parse-type ',type))))))
- ;; Convert this to a separate function so it doesn't have to be recomputed on the fly each time.
- (defmethod translate-to-foreign ((,value-symbol ,lisp-class) (type ,type))
- (let ((p (foreign-alloc ',struct-name)))
- ;;(map-slots #'translate-to-foreign ,value-symbol) ; recursive translation of slots
- (with-foreign-slots (,slot-names p ,struct-name)
- ,to-form)
- (values p t))) ; second value is passed to FREE-TRANSLATED-OBJECT
- (defmethod free-translated-object (,value-symbol (p ,type) freep)
- (when freep
- ;; Is this redundant?
- (map-slots #'free-translated-object value) ; recursively free slots
- (foreign-free ,value-symbol)))
- (defmethod translate-from-foreign (,value-symbol (type ,type))
- (with-foreign-slots (,slot-names ,value-symbol ,struct-name)
- ,from-form))))
-|#
(DIR) diff --git a/3rdparties/software/cffi_0.20.0/src/types.lisp b/3rdparties/software/cffi_0.20.0/src/types.lisp
@@ -1,1051 +0,0 @@
-;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
-;;;
-;;; types.lisp --- User-defined CFFI types.
-;;;
-;;; Copyright (C) 2005-2006, James Bielman <jamesjb@jamesjb.com>
-;;; Copyright (C) 2005-2007, Luis Oliveira <loliveira@common-lisp.net>
-;;;
-;;; Permission is hereby granted, free of charge, to any person
-;;; obtaining a copy of this software and associated documentation
-;;; files (the "Software"), to deal in the Software without
-;;; restriction, including without limitation the rights to use, copy,
-;;; modify, merge, publish, distribute, sublicense, and/or sell copies
-;;; of the Software, and to permit persons to whom the Software is
-;;; furnished to do so, subject to the following conditions:
-;;;
-;;; The above copyright notice and this permission notice shall be
-;;; included in all copies or substantial portions of the Software.
-;;;
-;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
-;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
-;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
-;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
-;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
-;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
-;;; DEALINGS IN THE SOFTWARE.
-;;;
-
-(in-package #:cffi)
-
-;;;# Built-In Types
-
-;; NOTE: In the C standard there's a "signed-char":
-;; https://stackoverflow.com/questions/436513/char-signed-char-char-unsigned-char
-;; and "char" may be either signed or unsigned, i.e. treating it as a small int
-;; is not wise. At the level of CFFI we can safely ignore this and assume that
-;; :char is mapped to "signed-char" by the CL implementation under us.
-(define-built-in-foreign-type :char)
-(define-built-in-foreign-type :unsigned-char)
-(define-built-in-foreign-type :short)
-(define-built-in-foreign-type :unsigned-short)
-(define-built-in-foreign-type :int)
-(define-built-in-foreign-type :unsigned-int)
-(define-built-in-foreign-type :long)
-(define-built-in-foreign-type :unsigned-long)
-(define-built-in-foreign-type :float)
-(define-built-in-foreign-type :double)
-(define-built-in-foreign-type :void)
-
-#-cffi-sys::no-long-long
-(progn
- (define-built-in-foreign-type :long-long)
- (define-built-in-foreign-type :unsigned-long-long))
-
-;;; Define emulated LONG-LONG types. Needs checking whether we're
-;;; using the right sizes on various platforms.
-;;;
-;;; A possibly better, certainly faster though more intrusive,
-;;; alternative is available here:
-;;; <http://article.gmane.org/gmane.lisp.cffi.devel/1091>
-#+cffi-sys::no-long-long
-(eval-when (:compile-toplevel :load-toplevel :execute)
- (defclass emulated-llong-type (foreign-type) ())
- (defmethod foreign-type-size ((tp emulated-llong-type)) 8)
- (defmethod foreign-type-alignment ((tp emulated-llong-type))
- ;; better than assuming that the alignment is 8
- (foreign-type-alignment :long))
- (defmethod aggregatep ((tp emulated-llong-type)) nil)
-
- (define-foreign-type emulated-llong (emulated-llong-type)
- ()
- (:simple-parser :long-long))
-
- (define-foreign-type emulated-ullong (emulated-llong-type)
- ()
- (:simple-parser :unsigned-long-long))
-
- (defmethod canonicalize ((tp emulated-llong)) :long-long)
- (defmethod unparse-type ((tp emulated-llong)) :long-long)
- (defmethod canonicalize ((tp emulated-ullong)) :unsigned-long-long)
- (defmethod unparse-type ((tp emulated-ullong)) :unsigned-long-long)
-
- (defun %emulated-mem-ref-64 (ptr type offset)
- (let ((value #+big-endian
- (+ (ash (mem-ref ptr :unsigned-long offset) 32)
- (mem-ref ptr :unsigned-long (+ offset 4)))
- #+little-endian
- (+ (mem-ref ptr :unsigned-long offset)
- (ash (mem-ref ptr :unsigned-long (+ offset 4)) 32))))
- (if (and (eq type :long-long) (logbitp 63 value))
- (lognot (logxor value #xFFFFFFFFFFFFFFFF))
- value)))
-
- (defun %emulated-mem-set-64 (value ptr type offset)
- (when (and (eq type :long-long) (minusp value))
- (setq value (lognot (logxor value #xFFFFFFFFFFFFFFFF))))
- (%mem-set (ldb (byte 32 0) value) ptr :unsigned-long
- #+big-endian (+ offset 4) #+little-endian offset)
- (%mem-set (ldb (byte 32 32) value) ptr :unsigned-long
- #+big-endian offset #+little-endian (+ offset 4))
- value))
-
-;;; When some lisp other than SCL supports :long-double we should
-;;; use #-cffi-sys::no-long-double here instead.
-#+(and scl long-float) (define-built-in-foreign-type :long-double)
-
-(defparameter *possible-float-types* '(:float :double :long-double))
-
-(defparameter *other-builtin-types* '(:pointer :void)
- "List of types other than integer or float built in to CFFI.")
-
-(defparameter *built-in-integer-types*
- (set-difference
- cffi:*built-in-foreign-types*
- (append *possible-float-types* *other-builtin-types*))
- "List of integer types supported by CFFI.")
-
-(defparameter *built-in-float-types*
- (set-difference
- cffi:*built-in-foreign-types*
- (append *built-in-integer-types* *other-builtin-types*))
- "List of real float types supported by CFFI.")
-
-;;;# Foreign Pointers
-
-(define-modify-macro incf-pointer (&optional (offset 1)) inc-pointer)
-
-(defun mem-ref (ptr type &optional (offset 0))
- "Return the value of TYPE at OFFSET bytes from PTR. If TYPE is aggregate,
-we don't return its 'value' but a pointer to it, which is PTR itself."
- (let* ((parsed-type (parse-type type))
- (ctype (canonicalize parsed-type)))
- #+cffi-sys::no-long-long
- (when (member ctype '(:long-long :unsigned-long-long))
- (return-from mem-ref
- (translate-from-foreign (%emulated-mem-ref-64 ptr ctype offset)
- parsed-type)))
- ;; normal branch
- (if (aggregatep parsed-type)
- (if (bare-struct-type-p parsed-type)
- (inc-pointer ptr offset)
- (translate-from-foreign (inc-pointer ptr offset) parsed-type))
- (translate-from-foreign (%mem-ref ptr ctype offset) parsed-type))))
-
-(define-compiler-macro mem-ref (&whole form ptr type &optional (offset 0))
- "Compiler macro to open-code MEM-REF when TYPE is constant."
- (if (constantp type)
- (let* ((parsed-type (parse-type (eval type)))
- (ctype (canonicalize parsed-type)))
- ;; Bail out when using emulated long long types.
- #+cffi-sys::no-long-long
- (when (member ctype '(:long-long :unsigned-long-long))
- (return-from mem-ref form))
- (if (aggregatep parsed-type)
- (if (bare-struct-type-p parsed-type)
- `(inc-pointer ,ptr ,offset)
- (expand-from-foreign `(inc-pointer ,ptr ,offset) parsed-type))
- (expand-from-foreign `(%mem-ref ,ptr ,ctype ,offset) parsed-type)))
- form))
-
-(defun mem-set (value ptr type &optional (offset 0))
- "Set the value of TYPE at OFFSET bytes from PTR to VALUE."
- (let* ((ptype (parse-type type))
- (ctype (canonicalize ptype)))
- #+cffi-sys::no-long-long
- (when (or (eq ctype :long-long) (eq ctype :unsigned-long-long))
- (return-from mem-set
- (%emulated-mem-set-64 (translate-to-foreign value ptype)
- ptr ctype offset)))
- (if (aggregatep ptype) ; XXX: backwards incompatible?
- (translate-into-foreign-memory value ptype (inc-pointer ptr offset))
- (%mem-set (translate-to-foreign value ptype) ptr ctype offset))))
-
-(define-setf-expander mem-ref (ptr type &optional (offset 0) &environment env)
- "SETF expander for MEM-REF that doesn't rebind TYPE.
-This is necessary for the compiler macro on MEM-SET to be able
-to open-code (SETF MEM-REF) forms."
- (multiple-value-bind (dummies vals newval setter getter)
- (get-setf-expansion ptr env)
- (declare (ignore setter newval))
- ;; if either TYPE or OFFSET are constant, we avoid rebinding them
- ;; so that the compiler macros on MEM-SET and %MEM-SET work.
- (with-unique-names (store type-tmp offset-tmp)
- (values
- (append (unless (constantp type) (list type-tmp))
- (unless (constantp offset) (list offset-tmp))
- dummies)
- (append (unless (constantp type) (list type))
- (unless (constantp offset) (list offset))
- vals)
- (list store)
- `(progn
- (mem-set ,store ,getter
- ,@(if (constantp type) (list type) (list type-tmp))
- ,@(if (constantp offset) (list offset) (list offset-tmp)))
- ,store)
- `(mem-ref ,getter
- ,@(if (constantp type) (list type) (list type-tmp))
- ,@(if (constantp offset) (list offset) (list offset-tmp)))))))
-
-(define-compiler-macro mem-set
- (&whole form value ptr type &optional (offset 0))
- "Compiler macro to open-code (SETF MEM-REF) when type is constant."
- (if (constantp type)
- (let* ((parsed-type (parse-type (eval type)))
- (ctype (canonicalize parsed-type)))
- ;; Bail out when using emulated long long types.
- #+cffi-sys::no-long-long
- (when (member ctype '(:long-long :unsigned-long-long))
- (return-from mem-set form))
- (if (aggregatep parsed-type)
- (expand-into-foreign-memory
- value parsed-type `(inc-pointer ,ptr ,offset))
- `(%mem-set ,(expand-to-foreign value parsed-type)
- ,ptr ,ctype ,offset)))
- form))
-
-;;;# Dereferencing Foreign Arrays
-
-;;; Maybe this should be named MEM-SVREF? [2007-02-28 LO]
-(defun mem-aref (ptr type &optional (index 0))
- "Like MEM-REF except for accessing 1d arrays."
- (mem-ref ptr type (* index (foreign-type-size type))))
-
-(define-compiler-macro mem-aref (&whole form ptr type &optional (index 0))
- "Compiler macro to open-code MEM-AREF when TYPE (and eventually INDEX)."
- (if (constantp type)
- (if (constantp index)
- `(mem-ref ,ptr ,type
- ,(* (eval index) (foreign-type-size (eval type))))
- `(mem-ref ,ptr ,type (* ,index ,(foreign-type-size (eval type)))))
- form))
-
-(define-setf-expander mem-aref (ptr type &optional (index 0) &environment env)
- "SETF expander for MEM-AREF."
- (multiple-value-bind (dummies vals newval setter getter)
- (get-setf-expansion ptr env)
- (declare (ignore setter newval))
- ;; we avoid rebinding type and index, if possible (and if type is not
- ;; constant, we don't bother about the index), so that the compiler macros
- ;; on MEM-SET or %MEM-SET can work.
- (with-unique-names (store type-tmp index-tmp)
- (values
- (append (unless (constantp type)
- (list type-tmp))
- (unless (and (constantp type) (constantp index))
- (list index-tmp))
- dummies)
- (append (unless (constantp type)
- (list type))
- (unless (and (constantp type) (constantp index))
- (list index))
- vals)
- (list store)
- ;; Here we'll try to calculate the offset from the type and index,
- ;; or if not possible at least get the type size early.
- `(progn
- ,(if (constantp type)
- (if (constantp index)
- `(mem-set ,store ,getter ,type
- ,(* (eval index) (foreign-type-size (eval type))))
- `(mem-set ,store ,getter ,type
- (* ,index-tmp ,(foreign-type-size (eval type)))))
- `(mem-set ,store ,getter ,type-tmp
- (* ,index-tmp (foreign-type-size ,type-tmp))))
- ,store)
- `(mem-aref ,getter
- ,@(if (constantp type)
- (list type)
- (list type-tmp))
- ,@(if (and (constantp type) (constantp index))
- (list index)
- (list index-tmp)))))))
-
-(defmethod translate-into-foreign-memory
- (value (type foreign-pointer-type) pointer)
- (setf (mem-aref pointer :pointer) value))
-
-(defmethod translate-into-foreign-memory
- (value (type foreign-built-in-type) pointer)
- (setf (mem-aref pointer (unparse-type type)) value))
-
-(defun mem-aptr (ptr type &optional (index 0))
- "The pointer to the element."
- (inc-pointer ptr (* index (foreign-type-size type))))
-
-(define-compiler-macro mem-aptr (&whole form ptr type &optional (index 0))
- "The pointer to the element."
- (cond ((not (constantp type))
- form)
- ((not (constantp index))
- `(inc-pointer ,ptr (* ,index ,(foreign-type-size (eval type)))))
- ((zerop (eval index))
- ptr)
- (t
- `(inc-pointer ,ptr ,(* (eval index)
- (foreign-type-size (eval type)))))))
-
-(define-foreign-type foreign-array-type ()
- ((dimensions :reader dimensions :initarg :dimensions)
- (element-type :reader element-type :initarg :element-type))
- (:actual-type :pointer))
-
-(defmethod aggregatep ((type foreign-array-type))
- t)
-
-(defmethod print-object ((type foreign-array-type) stream)
- "Print a FOREIGN-ARRAY-TYPE instance to STREAM unreadably."
- (print-unreadable-object (type stream :type t :identity nil)
- (format stream "~S ~S" (element-type type) (dimensions type))))
-
-(defun array-element-size (array-type)
- (foreign-type-size (element-type array-type)))
-
-(defmethod foreign-type-size ((type foreign-array-type))
- (* (array-element-size type) (reduce #'* (dimensions type))))
-
-(defmethod foreign-type-alignment ((type foreign-array-type))
- (foreign-type-alignment (element-type type)))
-
-(define-parse-method :array (element-type &rest dimensions)
- (assert (plusp (length dimensions)))
- (make-instance 'foreign-array-type
- :element-type element-type
- :dimensions dimensions))
-
-(defun indexes-to-row-major-index (dimensions &rest subscripts)
- (apply #'+ (maplist (lambda (x y)
- (* (car x) (apply #'* (cdr y))))
- subscripts
- dimensions)))
-
-(defun row-major-index-to-indexes (index dimensions)
- (loop with idx = index
- with rank = (length dimensions)
- with indexes = (make-list rank)
- for dim-index from (- rank 1) downto 0 do
- (setf (values idx (nth dim-index indexes))
- (floor idx (nth dim-index dimensions)))
- finally (return indexes)))
-
-(defun foreign-alloc (type &key (initial-element nil initial-element-p)
- (initial-contents nil initial-contents-p)
- (count 1 count-p) null-terminated-p)
- "Allocate enough memory to hold COUNT objects of type TYPE. If
-INITIAL-ELEMENT is supplied, each element of the newly allocated
-memory is initialized with its value. If INITIAL-CONTENTS is supplied,
-each of its elements will be used to initialize the contents of the
-newly allocated memory."
- (let (contents-length)
- ;; Some error checking, etc...
- (when (and null-terminated-p
- (not (eq (canonicalize-foreign-type type) :pointer)))
- (error "Cannot use :NULL-TERMINATED-P with non-pointer types."))
- (when (and initial-element-p initial-contents-p)
- (error "Cannot specify both :INITIAL-ELEMENT and :INITIAL-CONTENTS"))
- (when initial-contents-p
- (setq contents-length (length initial-contents))
- (if count-p
- (assert (>= count contents-length))
- (setq count contents-length)))
- ;; Everything looks good.
- (let ((ptr (%foreign-alloc (* (foreign-type-size type)
- (if null-terminated-p (1+ count) count)))))
- (when initial-element-p
- (dotimes (i count)
- (setf (mem-aref ptr type i) initial-element)))
- (when initial-contents-p
- (dotimes (i contents-length)
- (setf (mem-aref ptr type i) (elt initial-contents i))))
- (when null-terminated-p
- (setf (mem-aref ptr :pointer count) (null-pointer)))
- ptr)))
-
-;;; Simple compiler macro that kicks in when TYPE is constant and only
-;;; the COUNT argument is passed. (Note: hard-coding the type's size
-;;; into the fasl will likely break CLISP fasl cross-platform
-;;; compatibilty.)
-(define-compiler-macro foreign-alloc (&whole form type &rest args
- &key (count 1 count-p) &allow-other-keys)
- (if (or (and count-p (<= (length args) 2)) (null args))
- (cond
- ((and (constantp type) (constantp count))
- `(%foreign-alloc ,(* (eval count) (foreign-type-size (eval type)))))
- ((constantp type)
- `(%foreign-alloc (* ,count ,(foreign-type-size (eval type)))))
- (t form))
- form))
-
-(defun lisp-array-to-foreign (array pointer array-type)
- "Copy elements from a Lisp array to POINTER. ARRAY-TYPE must be a CFFI array
-type."
- (let* ((type (ensure-parsed-base-type array-type))
- (el-type (element-type type))
- (dimensions (dimensions type)))
- (loop with foreign-type-size = (array-element-size type)
- with size = (reduce #'* dimensions)
- for i from 0 below size
- for offset = (* i foreign-type-size)
- for element = (apply #'aref array
- (row-major-index-to-indexes i dimensions))
- do (setf (mem-ref pointer el-type offset) element))))
-
-(defun foreign-array-to-lisp (pointer array-type &rest make-array-args)
- "Copy elements from pointer into a Lisp array. ARRAY-TYPE must be a CFFI array
-type; the type of the resulting Lisp array can be defined in MAKE-ARRAY-ARGS
-that are then passed to MAKE-ARRAY. If POINTER is a null pointer, returns NIL."
- (unless (null-pointer-p pointer)
- (let* ((type (ensure-parsed-base-type array-type))
- (el-type (element-type type))
- (dimensions (dimensions type))
- (array (apply #'make-array dimensions make-array-args)))
- (loop with foreign-type-size = (array-element-size type)
- with size = (reduce #'* dimensions)
- for i from 0 below size
- for offset = (* i foreign-type-size)
- for element = (mem-ref pointer el-type offset)
- do (setf (apply #'aref array
- (row-major-index-to-indexes i dimensions))
- element))
- array)))
-
-(defun foreign-array-alloc (array array-type)
- "Allocate a foreign array containing the elements of lisp array.
-The foreign array must be freed with foreign-array-free."
- (check-type array array)
- (let* ((type (ensure-parsed-base-type array-type))
- (ptr (foreign-alloc (element-type type)
- :count (reduce #'* (dimensions type)))))
- (lisp-array-to-foreign array ptr array-type)
- ptr))
-
-(defun foreign-array-free (ptr)
- "Free a foreign array allocated by foreign-array-alloc."
- (foreign-free ptr))
-
-(defmacro with-foreign-array ((var lisp-array array-type) &body body)
- "Bind var to a foreign array containing lisp-array elements in body."
- (with-unique-names (type)
- `(let ((,type (ensure-parsed-base-type ,array-type)))
- (with-foreign-pointer (,var (* (reduce #'* (dimensions ,type))
- (array-element-size ,type)))
- (lisp-array-to-foreign ,lisp-array ,var ,array-type)
- ,@body))))
-
-(defun foreign-aref (ptr array-type &rest indexes)
- (let* ((type (ensure-parsed-base-type array-type))
- (offset (* (array-element-size type)
- (apply #'indexes-to-row-major-index
- (dimensions type) indexes))))
- (mem-ref ptr (element-type type) offset)))
-
-(defun (setf foreign-aref) (value ptr array-type &rest indexes)
- (let* ((type (ensure-parsed-base-type array-type))
- (offset (* (array-element-size type)
- (apply #'indexes-to-row-major-index
- (dimensions type) indexes))))
- (setf (mem-ref ptr (element-type type) offset) value)))
-
-;;; Automatic translations for the :ARRAY type. Notice that these
-;;; translators will also invoke the appropriate translators for for
-;;; each of the array's elements since that's the normal behaviour of
-;;; the FOREIGN-ARRAY-* operators, but there's a FIXME: **it doesn't
-;;; free them yet**
-
-;;; This used to be in a separate type but let's experiment with just
-;;; one type for a while. [2008-12-30 LO]
-
-;;; FIXME: those ugly invocations of UNPARSE-TYPE suggest that these
-;;; foreign array operators should take the type and dimention
-;;; arguments "unboxed". [2008-12-31 LO]
-
-(defmethod translate-to-foreign (array (type foreign-array-type))
- (foreign-array-alloc array (unparse-type type)))
-
-(defmethod translate-aggregate-to-foreign (ptr value (type foreign-array-type))
- (lisp-array-to-foreign value ptr (unparse-type type)))
-
-(defmethod translate-from-foreign (pointer (type foreign-array-type))
- (foreign-array-to-lisp pointer (unparse-type type)))
-
-(defmethod free-translated-object (pointer (type foreign-array-type) param)
- (declare (ignore param))
- (foreign-array-free pointer))
-
-;;;# Foreign Structures
-
-;;;## Foreign Structure Slots
-
-(defgeneric foreign-struct-slot-pointer (ptr slot)
- (:documentation
- "Get the address of SLOT relative to PTR."))
-
-(defgeneric foreign-struct-slot-pointer-form (ptr slot)
- (:documentation
- "Return a form to get the address of SLOT in PTR."))
-
-(defgeneric foreign-struct-slot-value (ptr slot)
- (:documentation
- "Return the value of SLOT in structure PTR."))
-
-(defgeneric (setf foreign-struct-slot-value) (value ptr slot)
- (:documentation
- "Set the value of a SLOT in structure PTR."))
-
-(defgeneric foreign-struct-slot-value-form (ptr slot)
- (:documentation
- "Return a form to get the value of SLOT in struct PTR."))
-
-(defgeneric foreign-struct-slot-set-form (value ptr slot)
- (:documentation
- "Return a form to set the value of SLOT in struct PTR."))
-
-(defclass foreign-struct-slot ()
- ((name :initarg :name :reader slot-name)
- (offset :initarg :offset :accessor slot-offset)
- ;; FIXME: the type should probably be parsed?
- (type :initarg :type :accessor slot-type))
- (:documentation "Base class for simple and aggregate slots."))
-
-(defmethod foreign-struct-slot-pointer (ptr (slot foreign-struct-slot))
- "Return the address of SLOT relative to PTR."
- (inc-pointer ptr (slot-offset slot)))
-
-(defmethod foreign-struct-slot-pointer-form (ptr (slot foreign-struct-slot))
- "Return a form to get the address of SLOT relative to PTR."
- (let ((offset (slot-offset slot)))
- (if (zerop offset)
- ptr
- `(inc-pointer ,ptr ,offset))))
-
-(defun foreign-slot-names (type)
- "Returns a list of TYPE's slot names in no particular order."
- (loop for value being the hash-values
- in (slots (ensure-parsed-base-type type))
- collect (slot-name value)))
-
-;;;### Simple Slots
-
-(defclass simple-struct-slot (foreign-struct-slot)
- ()
- (:documentation "Non-aggregate structure slots."))
-
-(defmethod foreign-struct-slot-value (ptr (slot simple-struct-slot))
- "Return the value of a simple SLOT from a struct at PTR."
- (mem-ref ptr (slot-type slot) (slot-offset slot)))
-
-(defmethod foreign-struct-slot-value-form (ptr (slot simple-struct-slot))
- "Return a form to get the value of a slot from PTR."
- `(mem-ref ,ptr ',(slot-type slot) ,(slot-offset slot)))
-
-(defmethod (setf foreign-struct-slot-value) (value ptr (slot simple-struct-slot))
- "Set the value of a simple SLOT to VALUE in PTR."
- (setf (mem-ref ptr (slot-type slot) (slot-offset slot)) value))
-
-(defmethod foreign-struct-slot-set-form (value ptr (slot simple-struct-slot))
- "Return a form to set the value of a simple structure slot."
- `(setf (mem-ref ,ptr ',(slot-type slot) ,(slot-offset slot)) ,value))
-
-;;;### Aggregate Slots
-
-(defclass aggregate-struct-slot (foreign-struct-slot)
- ((count :initarg :count :accessor slot-count))
- (:documentation "Aggregate structure slots."))
-
-;;; Since MEM-REF returns a pointer for struct types we are able to
-;;; chain together slot names when accessing slot values in nested
-;;; structures.
-(defmethod foreign-struct-slot-value (ptr (slot aggregate-struct-slot))
- "Return a pointer to SLOT relative to PTR."
- (convert-from-foreign (inc-pointer ptr (slot-offset slot))
- (slot-type slot)))
-
-(defmethod foreign-struct-slot-value-form (ptr (slot aggregate-struct-slot))
- "Return a form to get the value of SLOT relative to PTR."
- `(convert-from-foreign (inc-pointer ,ptr ,(slot-offset slot))
- ',(slot-type slot)))
-
-(defmethod translate-aggregate-to-foreign (ptr value (type foreign-struct-type))
- ;;; FIXME: use the block memory interface instead.
- (loop for i below (foreign-type-size type)
- do (%mem-set (%mem-ref value :char i) ptr :char i)))
-
-(defmethod (setf foreign-struct-slot-value)
- (value ptr (slot aggregate-struct-slot))
- "Set the value of an aggregate SLOT to VALUE in PTR."
- (translate-aggregate-to-foreign (inc-pointer ptr (slot-offset slot))
- value
- (parse-type (slot-type slot))))
-
-(defmethod foreign-struct-slot-set-form (value ptr (slot aggregate-struct-slot))
- "Return a form to get the value of an aggregate SLOT relative to PTR."
- `(translate-aggregate-to-foreign (inc-pointer ,ptr ,(slot-offset slot))
- ,value
- ,(parse-type (slot-type slot))))
-
-;;;## Defining Foreign Structures
-
-(defun make-struct-slot (name offset type count)
- "Make the appropriate type of structure slot."
- ;; If TYPE is an aggregate type or COUNT is >1, create an
- ;; AGGREGATE-STRUCT-SLOT, otherwise a SIMPLE-STRUCT-SLOT.
- (if (or (> count 1) (aggregatep (parse-type type)))
- (make-instance 'aggregate-struct-slot :offset offset :type type
- :name name :count count)
- (make-instance 'simple-struct-slot :offset offset :type type
- :name name)))
-
-(defun parse-deprecated-struct-type (name struct-or-union)
- (check-type struct-or-union (member :struct :union))
- (let* ((struct-type-name `(,struct-or-union ,name))
- (struct-type (parse-type struct-type-name)))
- (simple-style-warning
- "bare references to struct types are deprecated. ~
- Please use ~S or ~S instead."
- `(:pointer ,struct-type-name) struct-type-name)
- (make-instance (class-of struct-type)
- :alignment (alignment struct-type)
- :size (size struct-type)
- :slots (slots struct-type)
- :name (name struct-type)
- :bare t)))
-
-;;; Regarding structure alignment, the following ABIs were checked:
-;;; - System-V ABI: x86, x86-64, ppc, arm, mips and itanium. (more?)
-;;; - Mac OS X ABI Function Call Guide: ppc32, ppc64 and x86.
-;;;
-;;; Rules used here:
-;;;
-;;; 1. "An entire structure or union object is aligned on the same
-;;; boundary as its most strictly aligned member."
-;;;
-;;; 2. "Each member is assigned to the lowest available offset with
-;;; the appropriate alignment. This may require internal
-;;; padding, depending on the previous member."
-;;;
-;;; 3. "A structure's size is increased, if necessary, to make it a
-;;; multiple of the alignment. This may require tail padding,
-;;; depending on the last member."
-;;;
-;;; Special cases from darwin/ppc32's ABI:
-;;; http://developer.apple.com/documentation/DeveloperTools/Conceptual/LowLevelABI/index.html
-;;;
-;;; 4. "The embedding alignment of the first element in a data
-;;; structure is equal to the element's natural alignment."
-;;;
-;;; 5. "For subsequent elements that have a natural alignment
-;;; greater than 4 bytes, the embedding alignment is 4, unless
-;;; the element is a vector." (note: this applies for
-;;; structures too)
-
-;; FIXME: get a better name for this. --luis
-(defun get-alignment (type alignment-type firstp)
- "Return alignment for TYPE according to ALIGNMENT-TYPE."
- (declare (ignorable firstp))
- (ecase alignment-type
- (:normal #-(and darwin ppc)
- (foreign-type-alignment type)
- #+(and darwin ppc)
- (if firstp
- (foreign-type-alignment type)
- (min 4 (foreign-type-alignment type))))))
-
-(defun adjust-for-alignment (type offset alignment-type firstp)
- "Return OFFSET aligned properly for TYPE according to ALIGNMENT-TYPE."
- (let* ((align (get-alignment type alignment-type firstp))
- (rem (mod offset align)))
- (if (zerop rem)
- offset
- (+ offset (- align rem)))))
-
-(defmacro with-tentative-type-definition ((name value namespace) &body body)
- (once-only (name namespace)
- `(unwind-protect-case ()
- (progn
- (notice-foreign-type ,name ,value ,namespace)
- ,@body)
- (:abort (undefine-foreign-type ,name ,namespace)))))
-
-(defun notice-foreign-struct-definition (name options slots)
- "Parse and install a foreign structure definition."
- (destructuring-bind (&key size (class 'foreign-struct-type))
- options
- (let ((struct (make-instance class :name name))
- (current-offset 0)
- (max-align 1)
- (firstp t))
- (with-tentative-type-definition (name struct :struct)
- ;; determine offsets
- (dolist (slotdef slots)
- (destructuring-bind (slotname type &key (count 1) offset) slotdef
- (when (eq (canonicalize-foreign-type type) :void)
- (simple-foreign-type-error type :struct
- "In struct ~S: void type not allowed in field ~S"
- name slotdef))
- (setq current-offset
- (or offset
- (adjust-for-alignment type current-offset :normal firstp)))
- (let* ((slot (make-struct-slot slotname current-offset type count))
- (align (get-alignment (slot-type slot) :normal firstp)))
- (setf (gethash slotname (slots struct)) slot)
- (when (> align max-align)
- (setq max-align align)))
- (incf current-offset (* count (foreign-type-size type))))
- (setq firstp nil))
- ;; calculate padding and alignment
- (setf (alignment struct) max-align) ; See point 1 above.
- (let ((tail-padding (- max-align (rem current-offset max-align))))
- (unless (= tail-padding max-align) ; See point 3 above.
- (incf current-offset tail-padding)))
- (setf (size struct) (or size current-offset))))))
-
-(defun generate-struct-accessors (name conc-name slot-names)
- (loop with pointer-arg = (symbolicate '#:pointer-to- name)
- for slot in slot-names
- for accessor = (symbolicate conc-name slot)
- collect `(defun ,accessor (,pointer-arg)
- (foreign-slot-value ,pointer-arg '(:struct ,name) ',slot))
- collect `(defun (setf ,accessor) (value ,pointer-arg)
- (foreign-slot-set value ,pointer-arg '(:struct ,name) ',slot))))
-
-(define-parse-method :struct (name)
- (funcall (find-type-parser name :struct)))
-
-(defvar *defcstruct-hook* nil)
-
-(defmacro defcstruct (name-and-options &body fields)
- "Define the layout of a foreign structure."
- (discard-docstring fields)
- (destructuring-bind (name . options)
- (ensure-list name-and-options)
- (let ((conc-name (getf options :conc-name)))
- (remf options :conc-name)
- (unless (getf options :class) (setf (getf options :class) (symbolicate name '-tclass)))
- `(eval-when (:compile-toplevel :load-toplevel :execute)
- ;; m-f-s-t could do with this with mop:ensure-class.
- ,(when-let (class (getf options :class))
- `(defclass ,class (foreign-struct-type
- translatable-foreign-type)
- ()))
- (notice-foreign-struct-definition ',name ',options ',fields)
- ,@(when conc-name
- (generate-struct-accessors name conc-name
- (mapcar #'car fields)))
- ,@(when *defcstruct-hook*
- ;; If non-nil, *defcstruct-hook* should be a function
- ;; of the arguments that returns NIL or a list of
- ;; forms to include in the expansion.
- (apply *defcstruct-hook* name-and-options fields))
- (define-parse-method ,name ()
- (parse-deprecated-struct-type ',name :struct))
- '(:struct ,name)))))
-
-;;;## Accessing Foreign Structure Slots
-
-(defun get-slot-info (type slot-name)
- "Return the slot info for SLOT-NAME or raise an error."
- (let* ((struct (ensure-parsed-base-type type))
- (info (gethash slot-name (slots struct))))
- (unless info
- (simple-foreign-type-error type :struct
- "Undefined slot ~A in foreign type ~A."
- slot-name type))
- info))
-
-(defun foreign-slot-pointer (ptr type slot-name)
- "Return the address of SLOT-NAME in the structure at PTR."
- (foreign-struct-slot-pointer ptr (get-slot-info type slot-name)))
-
-(define-compiler-macro foreign-slot-pointer (&whole whole ptr type slot-name)
- (if (and (constantp type) (constantp slot-name))
- (foreign-struct-slot-pointer-form
- ptr (get-slot-info (eval type) (eval slot-name)))
- whole))
-
-(defun foreign-slot-type (type slot-name)
- "Return the type of SLOT in a struct TYPE."
- (slot-type (get-slot-info type slot-name)))
-
-(defun foreign-slot-offset (type slot-name)
- "Return the offset of SLOT in a struct TYPE."
- (slot-offset (get-slot-info type slot-name)))
-
-(defun foreign-slot-count (type slot-name)
- "Return the number of items in SLOT in a struct TYPE."
- (slot-count (get-slot-info type slot-name)))
-
-(defun foreign-slot-value (ptr type slot-name)
- "Return the value of SLOT-NAME in the foreign structure at PTR."
- (foreign-struct-slot-value ptr (get-slot-info type slot-name)))
-
-(define-compiler-macro foreign-slot-value (&whole form ptr type slot-name)
- "Optimizer for FOREIGN-SLOT-VALUE when TYPE is constant."
- (if (and (constantp type) (constantp slot-name))
- (foreign-struct-slot-value-form
- ptr (get-slot-info (eval type) (eval slot-name)))
- form))
-
-(define-setf-expander foreign-slot-value (ptr type slot-name &environment env)
- "SETF expander for FOREIGN-SLOT-VALUE."
- (multiple-value-bind (dummies vals newval setter getter)
- (get-setf-expansion ptr env)
- (declare (ignore setter newval))
- (if (and (constantp type) (constantp slot-name))
- ;; if TYPE and SLOT-NAME are constant we avoid rebinding them
- ;; so that the compiler macro on FOREIGN-SLOT-SET works.
- (with-unique-names (store)
- (values
- dummies
- vals
- (list store)
- `(progn
- (foreign-slot-set ,store ,getter ,type ,slot-name)
- ,store)
- `(foreign-slot-value ,getter ,type ,slot-name)))
- ;; if not...
- (with-unique-names (store slot-name-tmp type-tmp)
- (values
- (list* type-tmp slot-name-tmp dummies)
- (list* type slot-name vals)
- (list store)
- `(progn
- (foreign-slot-set ,store ,getter ,type-tmp ,slot-name-tmp)
- ,store)
- `(foreign-slot-value ,getter ,type-tmp ,slot-name-tmp))))))
-
-(defun foreign-slot-set (value ptr type slot-name)
- "Set the value of SLOT-NAME in a foreign structure."
- (setf (foreign-struct-slot-value ptr (get-slot-info type slot-name)) value))
-
-(define-compiler-macro foreign-slot-set
- (&whole form value ptr type slot-name)
- "Optimizer when TYPE and SLOT-NAME are constant."
- (if (and (constantp type) (constantp slot-name))
- (foreign-struct-slot-set-form
- value ptr (get-slot-info (eval type) (eval slot-name)))
- form))
-
-(defmacro with-foreign-slots ((vars ptr type) &body body)
- "Create local symbol macros for each var in VARS to reference
-foreign slots in PTR of TYPE. Similar to WITH-SLOTS.
-Each var can be of the form: slot-name - in which case slot-name will
-be bound to the value of the slot or: (:pointer slot-name) - in which
-case slot-name will be bound to the pointer to that slot."
- (let ((ptr-var (gensym "PTR")))
- `(let ((,ptr-var ,ptr))
- (symbol-macrolet
- ,(loop :for var :in vars
- :collect
- (if (listp var)
- (if (eq (first var) :pointer)
- `(,(second var) (foreign-slot-pointer
- ,ptr-var ',type ',(second var)))
- (error
- "Malformed slot specification ~a; must be:`name' or `(:pointer name)'"
- var))
- `(,var (foreign-slot-value ,ptr-var ',type ',var))))
- ,@body))))
-
-;;; We could add an option to define a struct instead of a class, in
-;;; the unlikely event someone needs something like that.
-(defmacro define-c-struct-wrapper (class-and-type supers &optional slots)
- "Define a new class with CLOS slots matching those of a foreign
-struct type. An INITIALIZE-INSTANCE method is defined which
-takes a :POINTER initarg that is used to store the slots of a
-foreign object. This pointer is only used for initialization and
-it is not retained.
-
-CLASS-AND-TYPE is either a list of the form (class-name
-struct-type) or a single symbol naming both. The class will
-inherit SUPERS. If a list of SLOTS is specified, only those
-slots will be defined and stored."
- (destructuring-bind (class-name &optional (struct-type (list :struct class-name)))
- (ensure-list class-and-type)
- (let ((slots (or slots (foreign-slot-names struct-type))))
- `(progn
- (defclass ,class-name ,supers
- ,(loop for slot in slots collect
- `(,slot :reader ,(format-symbol t "~A-~A" class-name slot))))
- ;; This could be done in a parent class by using
- ;; FOREIGN-SLOT-NAMES when instantiating but then the compiler
- ;; macros wouldn't kick in.
- (defmethod initialize-instance :after ((inst ,class-name) &key pointer)
- (with-foreign-slots (,slots pointer ,struct-type)
- ,@(loop for slot in slots collect
- `(setf (slot-value inst ',slot) ,slot))))
- ',class-name))))
-
-;;;# Foreign Unions
-;;;
-;;; A union is a subclass of FOREIGN-STRUCT-TYPE in which all slots
-;;; have an offset of zero.
-
-;;; See also the notes regarding ABI requirements in
-;;; NOTICE-FOREIGN-STRUCT-DEFINITION
-(defun notice-foreign-union-definition (name-and-options slots)
- "Parse and install a foreign union definition."
- (destructuring-bind (name &key size)
- (ensure-list name-and-options)
- (let ((union (make-instance 'foreign-union-type :name name))
- (max-size 0)
- (max-align 0))
- (with-tentative-type-definition (name union :union)
- (dolist (slotdef slots)
- (destructuring-bind (slotname type &key (count 1)) slotdef
- (when (eq (canonicalize-foreign-type type) :void)
- (simple-foreign-type-error name :struct
- "In union ~S: void type not allowed in field ~S"
- name slotdef))
- (let* ((slot (make-struct-slot slotname 0 type count))
- (size (* count (foreign-type-size type)))
- (align (foreign-type-alignment (slot-type slot))))
- (setf (gethash slotname (slots union)) slot)
- (when (> size max-size)
- (setf max-size size))
- (when (> align max-align)
- (setf max-align align)))))
- (setf (size union) (or size max-size))
- (setf (alignment union) max-align)))))
-
-(define-parse-method :union (name)
- (funcall (find-type-parser name :union)))
-
-(defmacro defcunion (name-and-options &body fields)
- "Define the layout of a foreign union."
- (discard-docstring fields)
- (destructuring-bind (name &key size)
- (ensure-list name-and-options)
- (declare (ignore size))
- `(eval-when (:compile-toplevel :load-toplevel :execute)
- (notice-foreign-union-definition ',name-and-options ',fields)
- (define-parse-method ,name ()
- (parse-deprecated-struct-type ',name :union))
- '(:union ,name))))
-
-;;;# Operations on Types
-
-(defmethod foreign-type-alignment (type)
- "Return the alignment in bytes of a foreign type."
- (foreign-type-alignment (parse-type type)))
-
-(defmacro with-foreign-object ((var type &optional (count 1)) &body body)
- "Bind VAR to a pointer to COUNT objects of TYPE during BODY.
-The buffer has dynamic extent and may be stack allocated."
- `(with-foreign-pointer
- (,var ,(if (constantp type)
- ;; with-foreign-pointer may benefit from constant folding:
- (if (constantp count)
- (* (eval count) (foreign-type-size (eval type)))
- `(* ,count ,(foreign-type-size (eval type))))
- `(* ,count (foreign-type-size ,type))))
- ,@body))
-
-(defmacro with-foreign-objects (bindings &body body)
- (if bindings
- `(with-foreign-object ,(car bindings)
- (with-foreign-objects ,(cdr bindings)
- ,@body))
- `(progn ,@body)))
-
-;;;## Anonymous Type Translators
-;;;
-;;; (:wrapper :to-c some-function :from-c another-function)
-;;;
-;;; TODO: We will need to add a FREE function to this as well I think.
-;;; --james
-
-(define-foreign-type foreign-type-wrapper ()
- ((to-c :initarg :to-c :reader wrapper-to-c)
- (from-c :initarg :from-c :reader wrapper-from-c))
- (:documentation "Wrapper type."))
-
-(define-parse-method :wrapper (base-type &key to-c from-c)
- (make-instance 'foreign-type-wrapper
- :actual-type (parse-type base-type)
- :to-c (or to-c 'identity)
- :from-c (or from-c 'identity)))
-
-(defmethod translate-to-foreign (value (type foreign-type-wrapper))
- (translate-to-foreign
- (funcall (slot-value type 'to-c) value) (actual-type type)))
-
-(defmethod translate-from-foreign (value (type foreign-type-wrapper))
- (funcall (slot-value type 'from-c)
- (translate-from-foreign value (actual-type type))))
-
-;;;# Other types
-
-;;; Boolean type. Maps to an :int by default. Only accepts integer types.
-(define-foreign-type foreign-boolean-type ()
- ())
-
-(define-parse-method :boolean (&optional (base-type :int))
- (make-instance
- 'foreign-boolean-type :actual-type
- (ecase (canonicalize-foreign-type base-type)
- ((:char :unsigned-char :int :unsigned-int :long :unsigned-long
- #-cffi-sys::no-long-long :long-long
- #-cffi-sys::no-long-long :unsigned-long-long) base-type))))
-
-(defmethod translate-to-foreign (value (type foreign-boolean-type))
- (if value 1 0))
-
-(defmethod translate-from-foreign (value (type foreign-boolean-type))
- (not (zerop value)))
-
-(defmethod expand-to-foreign (value (type foreign-boolean-type))
- "Optimization for the :boolean type."
- (if (constantp value)
- (if (eval value) 1 0)
- `(if ,value 1 0)))
-
-(defmethod expand-from-foreign (value (type foreign-boolean-type))
- "Optimization for the :boolean type."
- (if (constantp value) ; very unlikely, heh
- (not (zerop (eval value)))
- `(not (zerop ,value))))
-
-;;; Boolean type that represents C99 _Bool
-(defctype :bool (:boolean :char))
-
-;;;# Typedefs for built-in types.
-
-(defctype :uchar :unsigned-char)
-(defctype :ushort :unsigned-short)
-(defctype :uint :unsigned-int)
-(defctype :ulong :unsigned-long)
-(defctype :llong :long-long)
-(defctype :ullong :unsigned-long-long)
-
-;;; We try to define the :[u]int{8,16,32,64} types by looking at
-;;; the sizes of the built-in integer types and defining typedefs.
-(eval-when (:compile-toplevel :load-toplevel :execute)
- (macrolet
- ((match-types (sized-types mtypes)
- `(progn
- ,@(loop for (type . size-or-type) in sized-types
- for m = (car (member (if (keywordp size-or-type)
- (foreign-type-size size-or-type)
- size-or-type)
- mtypes :key #'foreign-type-size))
- when m collect `(defctype ,type ,m)))))
- ;; signed
- (match-types ((:int8 . 1) (:int16 . 2) (:int32 . 4) (:int64 . 8)
- (:intptr . :pointer))
- (:char :short :int :long :long-long))
- ;; unsigned
- (match-types ((:uint8 . 1) (:uint16 . 2) (:uint32 . 4) (:uint64 . 8)
- (:uintptr . :pointer))
- (:unsigned-char :unsigned-short :unsigned-int :unsigned-long
- :unsigned-long-long))))
(DIR) diff --git a/3rdparties/software/cffi_0.20.0/src/utils.lisp b/3rdparties/software/cffi_0.20.0/src/utils.lisp
@@ -1,84 +0,0 @@
-;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
-;;;
-;;; utils.lisp --- Various utilities.
-;;;
-;;; Copyright (C) 2005-2008, Luis Oliveira <loliveira(@)common-lisp.net>
-;;;
-;;; Permission is hereby granted, free of charge, to any person
-;;; obtaining a copy of this software and associated documentation
-;;; files (the "Software"), to deal in the Software without
-;;; restriction, including without limitation the rights to use, copy,
-;;; modify, merge, publish, distribute, sublicense, and/or sell copies
-;;; of the Software, and to permit persons to whom the Software is
-;;; furnished to do so, subject to the following conditions:
-;;;
-;;; The above copyright notice and this permission notice shall be
-;;; included in all copies or substantial portions of the Software.
-;;;
-;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
-;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
-;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
-;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
-;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
-;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
-;;; DEALINGS IN THE SOFTWARE.
-;;;
-
-(in-package #:cffi)
-
-(defmacro discard-docstring (body-var &optional force)
- "Discards the first element of the list in body-var if it's a
-string and the only element (or if FORCE is T)."
- `(when (and (stringp (car ,body-var)) (or ,force (cdr ,body-var)))
- (pop ,body-var)))
-
-(defun single-bit-p (integer)
- "Answer whether INTEGER, which must be an integer, is a single
-set twos-complement bit."
- (if (<= integer 0)
- nil ; infinite set bits for negatives
- (loop until (logbitp 0 integer)
- do (setf integer (ash integer -1))
- finally (return (zerop (ash integer -1))))))
-
-;;; This function is here because it needs to be defined early. It's
-;;; used by DEFINE-PARSE-METHOD and DEFCTYPE to warn users when
-;;; they're defining types whose names belongs to the KEYWORD or CL
-;;; packages. CFFI itself gets to use keywords without a warning.
-(defun warn-if-kw-or-belongs-to-cl (name)
- (let ((package (symbol-package name)))
- (when (and (not (eq *package* (find-package '#:cffi)))
- (member package '(#:common-lisp #:keyword)
- :key #'find-package))
- (warn "Defining a foreign type named ~S. This symbol belongs to the ~A ~
- package and that may interfere with other code using CFFI."
- name (package-name package)))))
-
-(define-condition obsolete-argument-warning (style-warning)
- ((old-arg :initarg :old-arg :reader old-arg)
- (new-arg :initarg :new-arg :reader new-arg))
- (:report (lambda (c s)
- (format s "Keyword ~S is obsolete, please use ~S"
- (old-arg c) (new-arg c)))))
-
-(defun warn-obsolete-argument (old-arg new-arg)
- (warn 'obsolete-argument-warning
- :old-arg old-arg :new-arg new-arg))
-
-(defun split-if (test seq &optional (dir :before))
- (remove-if #'(lambda (x) (equal x (subseq seq 0 0)))
- (loop for start fixnum = 0
- then (if (eq dir :before)
- stop
- (the fixnum (1+ (the fixnum stop))))
- while (< start (length seq))
- for stop = (position-if test seq
- :start (if (eq dir :elide)
- start
- (the fixnum (1+ start))))
- collect (subseq seq start
- (if (and stop (eq dir :after))
- (the fixnum (1+ (the fixnum stop)))
- stop))
- while stop)))
(DIR) diff --git a/3rdparties/software/cffi_0.20.0/tests/GNUmakefile b/3rdparties/software/cffi_0.20.0/tests/GNUmakefile
@@ -1,98 +0,0 @@
-# -*- Mode: Makefile; tab-width: 3; indent-tabs-mode: t -*-
-#
-# Makefile --- Make targets for various tasks.
-#
-# Copyright (C) 2005, James Bielman <jamesjb@jamesjb.com>
-#
-# Permission is hereby granted, free of charge, to any person
-# obtaining a copy of this software and associated documentation
-# files (the "Software"), to deal in the Software without
-# restriction, including without limitation the rights to use, copy,
-# modify, merge, publish, distribute, sublicense, and/or sell copies
-# of the Software, and to permit persons to whom the Software is
-# furnished to do so, subject to the following conditions:
-#
-# The above copyright notice and this permission notice shall be
-# included in all copies or substantial portions of the Software.
-#
-# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
-# EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
-# MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
-# NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
-# HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
-# WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-# OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
-# DEALINGS IN THE SOFTWARE.
-#
-
-OSTYPE = $(shell uname)
-ARCH = $(shell uname -m)
-
-CC := gcc
-CFLAGS := -Wall -std=c99 -pedantic
-SHLIB_CFLAGS := -shared
-SHLIB_EXT := .so
-
-ifneq ($(if $(filter Linux %BSD,$(OSTYPE)),OK), OK)
-ifeq ($(OSTYPE), Darwin)
-SHLIB_CFLAGS := -dynamiclib
-SHLIB_EXT := .dylib
-ifeq ($(shell sysctl -n hw.optional.x86_64), 1)
-ARCH := x86_64
-CFLAGS_64 := -m64
-endif
-else
-ifeq ($(OSTYPE), SunOS)
-CFLAGS := -m64 -fPIC -c -Wall -std=c99 -pedantic
-else
-# Let's assume this is win32
-SHLIB_EXT := .dll
-endif
-endif
-endif
-
-ifneq ($(ARCH), x86_64)
-CFLAGS += -lm
-endif
-
-ifeq ($(ARCH), x86_64)
-CFLAGS_64 += -fPIC
-endif
-
-# Are all G5s ppc970s?
-ifeq ($(ARCH), ppc970)
-CFLAGS_64 += -m64
-endif
-
-SHLIBS = libtest$(SHLIB_EXT) libtest2$(SHLIB_EXT) libfsbv$(SHLIB_EXT)
-
-ifeq ($(ARCH), x86_64)
-SHLIBS += libtest32$(SHLIB_EXT) libtest2_32$(SHLIB_EXT) libfsbv_32$(SHLIB_EXT)
-endif
-
-shlibs: $(SHLIBS)
-
-libtest$(SHLIB_EXT): libtest.c
- $(CC) -o $@ $(SHLIB_CFLAGS) $(CFLAGS) $(CFLAGS_64) $<
-
-libtest2$(SHLIB_EXT): libtest2.c
- $(CC) -o $@ $(SHLIB_CFLAGS) $(CFLAGS) $(CFLAGS_64) $<
-
-libfsbv$(SHLIB_EXT): libfsbv.c
- $(CC) -o $@ $(SHLIB_CFLAGS) $(CFLAGS) $(CFLAGS_64) $<
-
-ifeq ($(ARCH), x86_64)
-libtest32$(SHLIB_EXT): libtest.c
- -$(CC) -m32 -o $@ $(SHLIB_CFLAGS) $(CFLAGS) $<
-
-libtest2_32$(SHLIB_EXT): libtest2.c
- -$(CC) -m32 -o $@ $(SHLIB_CFLAGS) $(CFLAGS) $<
-
-libfsbv_32$(SHLIB_EXT): libfsbv.c
- -$(CC) -m32 -o $@ $(SHLIB_CFLAGS) $(CFLAGS) $<
-endif
-
-clean:
- rm -f *.so *.dylib *.dll *.bundle
-
-# vim: ft=make ts=3 noet
(DIR) diff --git a/3rdparties/software/cffi_0.20.0/tests/Makefile b/3rdparties/software/cffi_0.20.0/tests/Makefile
@@ -1,2 +0,0 @@
-shlibs clean:
- gmake $@
(DIR) diff --git a/3rdparties/software/cffi_0.20.0/tests/arrays.lisp b/3rdparties/software/cffi_0.20.0/tests/arrays.lisp
@@ -1,71 +0,0 @@
-;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
-;;;
-;;; arrays.lisp --- Tests for foreign arrays.
-;;;
-;;; Copyright (C) 2005-2006, James Bielman <jamesjb@jamesjb.com>
-;;; Copyright (C) 2005-2007, Luis Oliveira <loliveira@common-lisp.net>
-;;;
-;;; Permission is hereby granted, free of charge, to any person
-;;; obtaining a copy of this software and associated documentation
-;;; files (the "Software"), to deal in the Software without
-;;; restriction, including without limitation the rights to use, copy,
-;;; modify, merge, publish, distribute, sublicense, and/or sell copies
-;;; of the Software, and to permit persons to whom the Software is
-;;; furnished to do so, subject to the following conditions:
-;;;
-;;; The above copyright notice and this permission notice shall be
-;;; included in all copies or substantial portions of the Software.
-;;;
-;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
-;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
-;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
-;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
-;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
-;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
-;;; DEALINGS IN THE SOFTWARE.
-;;;
-
-;;;#Foreign Array Conversion Tests
-;;;
-
-(in-package #:cffi-tests)
-
-(deftest array.foreign-to-lisp.basic
- (with-foreign-array (ptr #(1 2 3 4 5) '(:array :int32 5))
- (foreign-array-to-lisp ptr '(:array :int32 5)))
- #(1 2 3 4 5))
-
-(deftest array.foreign-to-lisp.adjustable
- (with-foreign-array (ptr #(1 2 3 4 5) '(:array :int32 5))
- (let ((array (foreign-array-to-lisp ptr '(:array :int32 5)
- :adjustable t)))
- (adjustable-array-p array)))
- t)
-
-(deftest array.foreign-to-lisp.displaced
- (let ((array (make-array 10 :initial-contents '(1 2 3 4 5 6 7 8 9 0))))
- (with-foreign-array (ptr #(10 20 30 40 50) '(:array :int32 5))
- (let ((displaced (foreign-array-to-lisp ptr '(:array :int32 5)
- :displaced-to array
- :displaced-index-offset 5)))
- array)))
- #(1 2 3 4 5 10 20 30 40 50))
-
-;;; Implementation detail: 15.1.2.2 of the CL standard states that the only
-;;; truly portable array specializations are for bits (bit-vectors) and
-;;; characters (strings). Since char-codes are implementation-dependent, it
-;;; would be tricky to write a portable test for them without generating
-;;; characters at runtime. So, for a truly portable test, we are only left with
-;;; bits, which are luckily numeric, and equal to (UNSIGNED-BYTE 1).
-;;; This is why the below test is so terribly wasteful, spending a whole byte
-;;; for a single bit - CFFI has no capabilities for dealing with single bits,
-;;; and this test is only meant to check correctness of the :ELEMENT-TYPE
-;;; argument to MAKE-ARRAY. In actual use cases of specialized
-;;; FOREIGN-ARRAY-TO-LISP, capable implementations will be able to make
-;;; specialized arrays of types that are commonly optimized for and/or
-;;; representable in hardware, such as (UNSIGNED-BYTE 8) on x86 architectures.
-(deftest array.foreign-to-lisp.specialized
- (with-foreign-array (ptr #(1 0 1 0 1 1 1 0) '(:array :int8 8))
- (foreign-array-to-lisp ptr '(:array :int8 8) :element-type 'bit))
- #*10101110)
(DIR) diff --git a/3rdparties/software/cffi_0.20.0/tests/bindings.lisp b/3rdparties/software/cffi_0.20.0/tests/bindings.lisp
@@ -1,148 +0,0 @@
-;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
-;;;
-;;; libtest.lisp --- Setup CFFI bindings for libtest.
-;;;
-;;; Copyright (C) 2005-2007, Luis Oliveira <loliveira(@)common-lisp.net>
-;;;
-;;; Permission is hereby granted, free of charge, to any person
-;;; obtaining a copy of this software and associated documentation
-;;; files (the "Software"), to deal in the Software without
-;;; restriction, including without limitation the rights to use, copy,
-;;; modify, merge, publish, distribute, sublicense, and/or sell copies
-;;; of the Software, and to permit persons to whom the Software is
-;;; furnished to do so, subject to the following conditions:
-;;;
-;;; The above copyright notice and this permission notice shall be
-;;; included in all copies or substantial portions of the Software.
-;;;
-;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
-;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
-;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
-;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
-;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
-;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
-;;; DEALINGS IN THE SOFTWARE.
-;;;
-
-(in-package #:cffi-tests)
-
-(define-foreign-library (libtest :type :test)
- (:darwin (:or "libtest.dylib" "libtest32.dylib"))
- (:unix (:or "libtest.so" "libtest32.so"))
- (:windows "libtest.dll")
- (t (:default "libtest")))
-
-(define-foreign-library (libtest2 :type :test)
- (:darwin (:or "libtest2.dylib" "libtest2_32.dylib"))
- (:unix (:or "libtest2.so" "libtest2_32.so"))
- (t (:default "libtest2")))
-
-(define-foreign-library (libfsbv :type :test)
- (:darwin (:or "libfsbv.dylib" "libfsbv32.dylib"))
- (:unix (:or "libfsbv.so" "libfsbv_32.so"))
- (:windows "libfsbv.dll")
- (t (:default "libfsbv")))
-
-(define-foreign-library libc
- (:windows "msvcrt.dll"))
-
-(define-foreign-library libm
- #+(and lispworks darwin) ; not sure why the full path is necessary
- (:darwin "/usr/lib/libm.dylib")
- (t (:default "libm")))
-
-(defmacro deftest (name &rest body)
- (destructuring-bind (name &key expected-to-fail)
- (alexandria:ensure-list name)
- (let ((result `(rt:deftest ,name ,@body)))
- (when expected-to-fail
- (setf result `(progn
- (when ,expected-to-fail
- (pushnew ',name rt::*expected-failures*))
- ,result)))
- result)))
-
-(defun call-within-new-thread (fn &rest args)
- (let (result
- error
- (cv (bordeaux-threads:make-condition-variable))
- (lock (bordeaux-threads:make-lock)))
- (bordeaux-threads:with-lock-held (lock)
- (bordeaux-threads:make-thread
- (lambda ()
- (multiple-value-setq (result error)
- (ignore-errors (apply fn args)))
- (bordeaux-threads:with-lock-held (lock)
- (bordeaux-threads:condition-notify cv))))
- (bordeaux-threads:condition-wait cv lock)
- (values result error))))
-
-;;; As of OSX 10.6.6, loading CoreFoundation on something other than
-;;; the initial thread results in a crash.
-(deftest load-core-foundation
- (progn
- #+bordeaux-threads
- (call-within-new-thread 'load-foreign-library
- '(:framework "CoreFoundation"))
- t)
- t)
-
-;;; Return the directory containing the source when compiling or
-;;; loading this file. We don't use *LOAD-TRUENAME* because the fasl
-;;; file may be in a different directory than the source with certain
-;;; ASDF extensions loaded.
-(defun load-directory ()
- (let ((here #.(or *compile-file-truename* *load-truename*)))
- (make-pathname :name nil :type nil :version nil
- :defaults here)))
-
-(defun load-test-libraries ()
- (let ((*foreign-library-directories* (list (load-directory))))
- (load-foreign-library 'libtest)
- (load-foreign-library 'libtest2)
- (load-foreign-library 'libfsbv)
- (load-foreign-library 'libc)
- #+(or abcl lispworks) (load-foreign-library 'libm)))
-
-#-(:and :ecl (:not :dffi))
-(load-test-libraries)
-
-#+(:and :ecl (:not :dffi))
-(ffi:load-foreign-library
- #.(make-pathname :name "libtest" :type "so"
- :defaults (or *compile-file-truename* *load-truename*)))
-
-;;; check libtest version
-(defparameter *required-dll-version* "20120107")
-
-(defcvar "dll_version" :string)
-
-(unless (string= *dll-version* *required-dll-version*)
- (error "version check failed: expected ~s but libtest reports ~s"
- *required-dll-version*
- *dll-version*))
-
-;;; The maximum and minimum values for single and double precision C
-;;; floating point values, which may be quite different from the
-;;; corresponding Lisp versions.
-(defcvar "float_max" :float)
-(defcvar "float_min" :float)
-(defcvar "double_max" :double)
-(defcvar "double_min" :double)
-
-(defun run-cffi-tests (&key (compiled nil))
- (let ((regression-test::*compile-tests* compiled)
- (*package* (find-package '#:cffi-tests)))
- (format t "~&;;; running tests (~Acompiled)" (if compiled "" "un"))
- (do-tests)
- (set-difference (regression-test:pending-tests)
- regression-test::*expected-failures*)))
-
-(defun run-all-cffi-tests ()
- (append (run-cffi-tests :compiled nil)
- (run-cffi-tests :compiled t)))
-
-(defmacro expecting-error (&body body)
- `(handler-case (progn ,@body :no-error)
- (error () :error)))
(DIR) diff --git a/3rdparties/software/cffi_0.20.0/tests/callbacks.lisp b/3rdparties/software/cffi_0.20.0/tests/callbacks.lisp
@@ -1,526 +0,0 @@
-;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
-;;;
-;;; callbacks.lisp --- Tests on callbacks.
-;;;
-;;; Copyright (C) 2005-2006, Luis Oliveira <loliveira(@)common-lisp.net>
-;;;
-;;; Permission is hereby granted, free of charge, to any person
-;;; obtaining a copy of this software and associated documentation
-;;; files (the "Software"), to deal in the Software without
-;;; restriction, including without limitation the rights to use, copy,
-;;; modify, merge, publish, distribute, sublicense, and/or sell copies
-;;; of the Software, and to permit persons to whom the Software is
-;;; furnished to do so, subject to the following conditions:
-;;;
-;;; The above copyright notice and this permission notice shall be
-;;; included in all copies or substantial portions of the Software.
-;;;
-;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
-;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
-;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
-;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
-;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
-;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
-;;; DEALINGS IN THE SOFTWARE.
-;;;
-
-(in-package #:cffi-tests)
-
-(defcfun "expect_char_sum" :int (f :pointer))
-(defcfun "expect_unsigned_char_sum" :int (f :pointer))
-(defcfun "expect_short_sum" :int (f :pointer))
-(defcfun "expect_unsigned_short_sum" :int (f :pointer))
-(defcfun "expect_int_sum" :int (f :pointer))
-(defcfun "expect_unsigned_int_sum" :int (f :pointer))
-(defcfun "expect_long_sum" :int (f :pointer))
-(defcfun "expect_unsigned_long_sum" :int (f :pointer))
-(defcfun "expect_float_sum" :int (f :pointer))
-(defcfun "expect_double_sum" :int (f :pointer))
-(defcfun "expect_pointer_sum" :int (f :pointer))
-(defcfun "expect_strcat" :int (f :pointer))
-
-#-cffi-sys::no-long-long
-(progn
- (defcfun "expect_long_long_sum" :int (f :pointer))
- (defcfun "expect_unsigned_long_long_sum" :int (f :pointer)))
-
-#+(and scl long-float)
-(defcfun "expect_long_double_sum" :int (f :pointer))
-
-(defcallback sum-char :char ((a :char) (b :char))
- "Test if the named block is present and the docstring too."
- ;(format t "~%}}} a: ~A, b: ~A {{{~%" a b)
- (return-from sum-char (+ a b)))
-
-(defcallback sum-unsigned-char :unsigned-char
- ((a :unsigned-char) (b :unsigned-char))
- ;(format t "~%}}} a: ~A, b: ~A {{{~%" a b)
- (+ a b))
-
-(defcallback sum-short :short ((a :short) (b :short))
- ;(format t "~%}}} a: ~A, b: ~A {{{~%" a b)
- (+ a b))
-
-(defcallback sum-unsigned-short :unsigned-short
- ((a :unsigned-short) (b :unsigned-short))
- ;(format t "~%}}} a: ~A, b: ~A {{{~%" a b)
- (+ a b))
-
-(defcallback sum-int :int ((a :int) (b :int))
- (+ a b))
-
-(defcallback sum-unsigned-int :unsigned-int
- ((a :unsigned-int) (b :unsigned-int))
- (+ a b))
-
-(defcallback sum-long :long ((a :long) (b :long))
- (+ a b))
-
-(defcallback sum-unsigned-long :unsigned-long
- ((a :unsigned-long) (b :unsigned-long))
- (+ a b))
-
-#-cffi-sys::no-long-long
-(progn
- (defcallback sum-long-long :long-long
- ((a :long-long) (b :long-long))
- (+ a b))
-
- (defcallback sum-unsigned-long-long :unsigned-long-long
- ((a :unsigned-long-long) (b :unsigned-long-long))
- (+ a b)))
-
-(defcallback sum-float :float ((a :float) (b :float))
- ;(format t "~%}}} a: ~A, b: ~A {{{~%" a b)
- (+ a b))
-
-(defcallback sum-double :double ((a :double) (b :double))
- ;(format t "~%}}} a: ~A, b: ~A {{{~%" a b)
- (+ a b))
-
-#+(and scl long-float)
-(defcallback sum-long-double :long-double ((a :long-double) (b :long-double))
- ;(format t "~%}}} a: ~A, b: ~A {{{~%" a b)
- (+ a b))
-
-(defcallback sum-pointer :pointer ((ptr :pointer) (offset :int))
- (inc-pointer ptr offset))
-
-(defcallback lisp-strcat :string ((a :string) (b :string))
- (concatenate 'string a b))
-
-(deftest callbacks.char
- (expect-char-sum (get-callback 'sum-char))
- 1)
-
-(deftest callbacks.unsigned-char
- (expect-unsigned-char-sum (get-callback 'sum-unsigned-char))
- 1)
-
-(deftest callbacks.short
- (expect-short-sum (callback sum-short))
- 1)
-
-(deftest callbacks.unsigned-short
- (expect-unsigned-short-sum (callback sum-unsigned-short))
- 1)
-
-(deftest callbacks.int
- (expect-int-sum (callback sum-int))
- 1)
-
-(deftest callbacks.unsigned-int
- (expect-unsigned-int-sum (callback sum-unsigned-int))
- 1)
-
-(deftest callbacks.long
- (expect-long-sum (callback sum-long))
- 1)
-
-(deftest callbacks.unsigned-long
- (expect-unsigned-long-sum (callback sum-unsigned-long))
- 1)
-
-#-cffi-sys::no-long-long
-(progn
- (deftest (callbacks.long-long :expected-to-fail (alexandria:featurep :openmcl))
- (expect-long-long-sum (callback sum-long-long))
- 1)
-
- (deftest callbacks.unsigned-long-long
- (expect-unsigned-long-long-sum (callback sum-unsigned-long-long))
- 1))
-
-(deftest callbacks.float
- (expect-float-sum (callback sum-float))
- 1)
-
-(deftest callbacks.double
- (expect-double-sum (callback sum-double))
- 1)
-
-#+(and scl long-float)
-(deftest callbacks.long-double
- (expect-long-double-sum (callback sum-long-double))
- 1)
-
-(deftest callbacks.pointer
- (expect-pointer-sum (callback sum-pointer))
- 1)
-
-(deftest callbacks.string
- (expect-strcat (callback lisp-strcat))
- 1)
-
-#-cffi-sys::no-foreign-funcall
-(defcallback return-a-string-not-nil :string ()
- "abc")
-
-#-cffi-sys::no-foreign-funcall
-(deftest callbacks.string-not-docstring
- (foreign-funcall-pointer (callback return-a-string-not-nil) () :string)
- "abc")
-
-(defcallback check-for-nil :boolean ((pointer :pointer))
- (null pointer))
-
-#-cffi-sys::no-foreign-funcall
-(deftest callbacks.nil-for-null
- (foreign-funcall-pointer (callback check-for-nil) nil
- :pointer (null-pointer) :boolean)
- nil)
-
-;;; This one tests mem-aref too.
-(defcfun "qsort" :void
- (base :pointer)
- (nmemb :int)
- (size :int)
- (fun-compar :pointer))
-
-(defcallback < :int ((a :pointer) (b :pointer))
- (let ((x (mem-ref a :int))
- (y (mem-ref b :int)))
- (cond ((> x y) 1)
- ((< x y) -1)
- (t 0))))
-
-(deftest callbacks.qsort
- (with-foreign-object (array :int 10)
- ;; Initialize array.
- (loop for i from 0 and n in '(7 2 10 4 3 5 1 6 9 8)
- do (setf (mem-aref array :int i) n))
- ;; Sort it.
- (qsort array 10 (foreign-type-size :int) (callback <))
- ;; Return it as a list.
- (loop for i from 0 below 10
- collect (mem-aref array :int i)))
- (1 2 3 4 5 6 7 8 9 10))
-
-;;; void callback
-(defparameter *int* -1)
-
-(defcfun "pass_int_ref" :void (f :pointer))
-
-;;; CMUCL chokes on this one for some reason.
-#-(and darwin cmucl)
-(defcallback read-int-from-pointer :void ((a :pointer))
- (setq *int* (mem-ref a :int)))
-
-#+(and darwin cmucl)
-(pushnew 'callbacks.void rt::*expected-failures*)
-
-(deftest callbacks.void
- (progn
- (pass-int-ref (callback read-int-from-pointer))
- *int*)
- 1984)
-
-;;; test funcalling of a callback and also declarations inside
-;;; callbacks.
-
-#-cffi-sys::no-foreign-funcall
-(progn
- (defcallback sum-2 :int ((a :int) (b :int) (c :int))
- (declare (ignore c))
- (+ a b))
-
- (deftest callbacks.funcall.1
- (foreign-funcall-pointer (callback sum-2) () :int 2 :int 3 :int 1 :int)
- 5)
-
- (defctype foo-float :float)
-
- (defcallback sum-2f foo-float
- ((a foo-float) (b foo-float) (c foo-float) (d foo-float) (e foo-float))
- "This one ignores the middle 3 arguments."
- (declare (ignore b c))
- (declare (ignore d))
- (+ a e))
-
- (deftest callbacks.funcall.2
- (foreign-funcall-pointer (callback sum-2f) () foo-float 1.0 foo-float 2.0
- foo-float 3.0 foo-float 4.0 foo-float 5.0
- foo-float)
- 6.0))
-
-;;; (cb-test :no-long-long t)
-
-(defcfun "call_sum_127_no_ll" :long (cb :pointer))
-
-;;; CMUCL and CCL choke on this one.
-#-(or cmucl clozure
- #.(cl:if (cl:>= cl:lambda-parameters-limit 127) '(:or) '(:and)))
-(defcallback sum-127-no-ll :long
- ((a1 :unsigned-long) (a2 :pointer) (a3 :long) (a4 :double)
- (a5 :unsigned-long) (a6 :float) (a7 :float) (a8 :int) (a9 :unsigned-int)
- (a10 :double) (a11 :double) (a12 :double) (a13 :pointer)
- (a14 :unsigned-short) (a15 :unsigned-short) (a16 :pointer) (a17 :long)
- (a18 :long) (a19 :int) (a20 :short) (a21 :unsigned-short)
- (a22 :unsigned-short) (a23 :char) (a24 :long) (a25 :pointer) (a26 :pointer)
- (a27 :char) (a28 :unsigned-char) (a29 :unsigned-long) (a30 :short)
- (a31 :int) (a32 :int) (a33 :unsigned-char) (a34 :short) (a35 :long)
- (a36 :long) (a37 :pointer) (a38 :unsigned-short) (a39 :char) (a40 :double)
- (a41 :unsigned-short) (a42 :pointer) (a43 :short) (a44 :unsigned-long)
- (a45 :unsigned-short) (a46 :float) (a47 :unsigned-char) (a48 :short)
- (a49 :float) (a50 :short) (a51 :char) (a52 :unsigned-long)
- (a53 :unsigned-long) (a54 :char) (a55 :float) (a56 :long) (a57 :pointer)
- (a58 :short) (a59 :float) (a60 :unsigned-int) (a61 :float)
- (a62 :unsigned-int) (a63 :double) (a64 :unsigned-int) (a65 :unsigned-char)
- (a66 :int) (a67 :long) (a68 :char) (a69 :short) (a70 :double) (a71 :int)
- (a72 :pointer) (a73 :char) (a74 :unsigned-short) (a75 :pointer)
- (a76 :unsigned-short) (a77 :pointer) (a78 :unsigned-long) (a79 :double)
- (a80 :pointer) (a81 :long) (a82 :float) (a83 :unsigned-short)
- (a84 :unsigned-short) (a85 :pointer) (a86 :float) (a87 :int)
- (a88 :unsigned-int) (a89 :double) (a90 :float) (a91 :long) (a92 :pointer)
- (a93 :unsigned-short) (a94 :float) (a95 :unsigned-char) (a96 :unsigned-char)
- (a97 :float) (a98 :unsigned-int) (a99 :float) (a100 :unsigned-short)
- (a101 :double) (a102 :unsigned-short) (a103 :unsigned-long)
- (a104 :unsigned-int) (a105 :unsigned-long) (a106 :pointer)
- (a107 :unsigned-char) (a108 :char) (a109 :char) (a110 :unsigned-short)
- (a111 :unsigned-long) (a112 :float) (a113 :short) (a114 :pointer)
- (a115 :long) (a116 :unsigned-short) (a117 :short) (a118 :double)
- (a119 :short) (a120 :int) (a121 :char) (a122 :unsigned-long) (a123 :long)
- (a124 :int) (a125 :pointer) (a126 :double) (a127 :unsigned-char))
- (let ((args (list a1 (pointer-address a2) a3 (floor a4) a5 (floor a6)
- (floor a7) a8 a9 (floor a10) (floor a11) (floor a12)
- (pointer-address a13) a14 a15 (pointer-address a16) a17 a18
- a19 a20 a21 a22 a23 a24 (pointer-address a25)
- (pointer-address a26) a27 a28 a29 a30 a31 a32 a33 a34 a35
- a36 (pointer-address a37) a38 a39 (floor a40) a41
- (pointer-address a42) a43 a44 a45 (floor a46) a47 a48
- (floor a49) a50 a51 a52 a53 a54 (floor a55) a56
- (pointer-address a57) a58 (floor a59) a60 (floor a61) a62
- (floor a63) a64 a65 a66 a67 a68 a69 (floor a70) a71
- (pointer-address a72) a73 a74 (pointer-address a75) a76
- (pointer-address a77) a78 (floor a79) (pointer-address a80)
- a81 (floor a82) a83 a84 (pointer-address a85) (floor a86)
- a87 a88 (floor a89) (floor a90) a91 (pointer-address a92)
- a93 (floor a94) a95 a96 (floor a97) a98 (floor a99) a100
- (floor a101) a102 a103 a104 a105 (pointer-address a106) a107
- a108 a109 a110 a111 (floor a112) a113 (pointer-address a114)
- a115 a116 a117 (floor a118) a119 a120 a121 a122 a123 a124
- (pointer-address a125) (floor a126) a127)))
- #-(and)
- (loop for i from 1 and arg in args do
- (format t "a~A: ~A~%" i arg))
- (reduce #'+ args)))
-
-#+(or openmcl cmucl (and darwin (or allegro lispworks)))
-(push 'callbacks.bff.1 regression-test::*expected-failures*)
-
-#+#.(cl:if (cl:>= cl:lambda-parameters-limit 127) '(:and) '(:or))
-(deftest callbacks.bff.1
- (call-sum-127-no-ll (callback sum-127-no-ll))
- 2008547941)
-
-;;; (cb-test)
-
-#-(or cffi-sys::no-long-long
- #.(cl:if (cl:>= cl:lambda-parameters-limit 127) '(or) '(and)))
-(progn
- (defcfun "call_sum_127" :long-long (cb :pointer))
-
- ;;; CMUCL and CCL choke on this one.
- #-(or cmucl clozure)
- (defcallback sum-127 :long-long
- ((a1 :short) (a2 :char) (a3 :pointer) (a4 :float) (a5 :long) (a6 :double)
- (a7 :unsigned-long-long) (a8 :unsigned-short) (a9 :unsigned-char)
- (a10 :char) (a11 :char) (a12 :unsigned-short) (a13 :unsigned-long-long)
- (a14 :unsigned-short) (a15 :long-long) (a16 :unsigned-short)
- (a17 :unsigned-long-long) (a18 :unsigned-char) (a19 :unsigned-char)
- (a20 :unsigned-long-long) (a21 :long-long) (a22 :char) (a23 :float)
- (a24 :unsigned-int) (a25 :float) (a26 :float) (a27 :unsigned-int)
- (a28 :float) (a29 :char) (a30 :unsigned-char) (a31 :long) (a32 :long-long)
- (a33 :unsigned-char) (a34 :double) (a35 :long) (a36 :double)
- (a37 :unsigned-int) (a38 :unsigned-short) (a39 :long-long)
- (a40 :unsigned-int) (a41 :int) (a42 :unsigned-long-long) (a43 :long)
- (a44 :short) (a45 :unsigned-int) (a46 :unsigned-int)
- (a47 :unsigned-long-long) (a48 :unsigned-int) (a49 :long) (a50 :pointer)
- (a51 :unsigned-char) (a52 :char) (a53 :long-long) (a54 :unsigned-short)
- (a55 :unsigned-int) (a56 :float) (a57 :unsigned-char) (a58 :unsigned-long)
- (a59 :long-long) (a60 :float) (a61 :long) (a62 :float) (a63 :int)
- (a64 :float) (a65 :unsigned-short) (a66 :unsigned-long-long) (a67 :short)
- (a68 :unsigned-long) (a69 :long) (a70 :char) (a71 :unsigned-short)
- (a72 :long-long) (a73 :short) (a74 :double) (a75 :pointer)
- (a76 :unsigned-int) (a77 :char) (a78 :unsigned-int) (a79 :pointer)
- (a80 :pointer) (a81 :unsigned-char) (a82 :pointer) (a83 :unsigned-short)
- (a84 :unsigned-char) (a85 :long) (a86 :pointer) (a87 :char) (a88 :long)
- (a89 :unsigned-short) (a90 :unsigned-char) (a91 :double)
- (a92 :unsigned-long-long) (a93 :unsigned-short) (a94 :unsigned-short)
- (a95 :unsigned-int) (a96 :long) (a97 :char) (a98 :long) (a99 :char)
- (a100 :short) (a101 :unsigned-short) (a102 :unsigned-long)
- (a103 :unsigned-long) (a104 :short) (a105 :long-long) (a106 :long-long)
- (a107 :long-long) (a108 :double) (a109 :unsigned-short)
- (a110 :unsigned-char) (a111 :short) (a112 :unsigned-char) (a113 :long)
- (a114 :long-long) (a115 :unsigned-long-long) (a116 :unsigned-int)
- (a117 :unsigned-long) (a118 :unsigned-char) (a119 :long-long)
- (a120 :unsigned-char) (a121 :unsigned-long-long) (a122 :double)
- (a123 :unsigned-char) (a124 :long-long) (a125 :unsigned-char)
- (a126 :char) (a127 :long-long))
- (+ a1 a2 (pointer-address a3) (values (floor a4)) a5 (values (floor a6))
- a7 a8 a9 a10 a11 a12 a13 a14 a15 a16 a17 a18 a19 a20 a21 a22
- (values (floor a23)) a24 (values (floor a25)) (values (floor a26))
- a27 (values (floor a28)) a29 a30 a31 a32 a33 (values (floor a34))
- a35 (values (floor a36)) a37 a38 a39 a40 a41 a42 a43 a44 a45 a46 a47
- a48 a49 (pointer-address a50) a51 a52 a53 a54 a55 (values (floor a56))
- a57 a58 a59 (values (floor a60)) a61 (values (floor a62)) a63
- (values (floor a64)) a65 a66 a67 a68 a69 a70 a71 a72 a73
- (values (floor a74)) (pointer-address a75) a76 a77 a78
- (pointer-address a79) (pointer-address a80) a81 (pointer-address a82)
- a83 a84 a85 (pointer-address a86) a87 a88 a89 a90 (values (floor a91))
- a92 a93 a94 a95 a96 a97 a98 a99 a100 a101 a102 a103 a104 a105 a106 a107
- (values (floor a108)) a109 a110 a111 a112 a113 a114 a115 a116 a117 a118
- a119 a120 a121 (values (floor a122)) a123 a124 a125 a126 a127))
-
- #+(or openmcl cmucl)
- (push 'callbacks.bff.2 rt::*expected-failures*)
-
- (deftest callbacks.bff.2
- (call-sum-127 (callback sum-127))
- 8166570665645582011))
-
-;;; regression test: (callback non-existant-callback) should throw an error
-(deftest callbacks.non-existant
- (not (null (nth-value 1 (ignore-errors (callback doesnt-exist)))))
- t)
-
-;;; Handling many arguments of type double. Many lisps (used to) fail
-;;; this one on darwin/ppc. This test might be bogus due to floating
-;;; point arithmetic rounding errors.
-;;;
-;;; CMUCL chokes on this one.
-#-(and darwin cmucl)
-(defcallback double26 :double
- ((a1 :double) (a2 :double) (a3 :double) (a4 :double) (a5 :double)
- (a6 :double) (a7 :double) (a8 :double) (a9 :double) (a10 :double)
- (a11 :double) (a12 :double) (a13 :double) (a14 :double) (a15 :double)
- (a16 :double) (a17 :double) (a18 :double) (a19 :double) (a20 :double)
- (a21 :double) (a22 :double) (a23 :double) (a24 :double) (a25 :double)
- (a26 :double))
- (let ((args (list a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15
- a16 a17 a18 a19 a20 a21 a22 a23 a24 a25 a26)))
- #-(and)
- (loop for i from 1 and arg in args do
- (format t "a~A: ~A~%" i arg))
- (reduce #'+ args)))
-
-(defcfun "call_double26" :double (f :pointer))
-
-#+(and darwin (or allegro cmucl))
-(pushnew 'callbacks.double26 rt::*expected-failures*)
-
-(deftest callbacks.double26
- (call-double26 (callback double26))
- 81.64d0)
-
-#+(and darwin cmucl)
-(pushnew 'callbacks.double26.funcall rt::*expected-failures*)
-
-#-cffi-sys::no-foreign-funcall
-(deftest callbacks.double26.funcall
- (foreign-funcall-pointer
- (callback double26) () :double 3.14d0 :double 3.14d0
- :double 3.14d0 :double 3.14d0 :double 3.14d0 :double 3.14d0
- :double 3.14d0 :double 3.14d0 :double 3.14d0 :double 3.14d0
- :double 3.14d0 :double 3.14d0 :double 3.14d0 :double 3.14d0
- :double 3.14d0 :double 3.14d0 :double 3.14d0 :double 3.14d0
- :double 3.14d0 :double 3.14d0 :double 3.14d0 :double 3.14d0
- :double 3.14d0 :double 3.14d0 :double 3.14d0 :double 3.14d0
- :double)
- 81.64d0)
-
-;;; Same as above, for floats.
-#-(and darwin cmucl)
-(defcallback float26 :float
- ((a1 :float) (a2 :float) (a3 :float) (a4 :float) (a5 :float)
- (a6 :float) (a7 :float) (a8 :float) (a9 :float) (a10 :float)
- (a11 :float) (a12 :float) (a13 :float) (a14 :float) (a15 :float)
- (a16 :float) (a17 :float) (a18 :float) (a19 :float) (a20 :float)
- (a21 :float) (a22 :float) (a23 :float) (a24 :float) (a25 :float)
- (a26 :float))
- (let ((args (list a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15
- a16 a17 a18 a19 a20 a21 a22 a23 a24 a25 a26)))
- #-(and)
- (loop for i from 1 and arg in args do
- (format t "a~A: ~A~%" i arg))
- (reduce #'+ args)))
-
-(defcfun "call_float26" :float (f :pointer))
-
-#+(and darwin (or lispworks openmcl cmucl))
-(pushnew 'callbacks.float26 regression-test::*expected-failures*)
-
-(deftest callbacks.float26
- (call-float26 (callback float26))
- 130.0)
-
-#+(and darwin (or lispworks openmcl cmucl))
-(pushnew 'callbacks.float26.funcall regression-test::*expected-failures*)
-
-#-cffi-sys::no-foreign-funcall
-(deftest callbacks.float26.funcall
- (foreign-funcall-pointer
- (callback float26) () :float 5.0 :float 5.0
- :float 5.0 :float 5.0 :float 5.0 :float 5.0
- :float 5.0 :float 5.0 :float 5.0 :float 5.0
- :float 5.0 :float 5.0 :float 5.0 :float 5.0
- :float 5.0 :float 5.0 :float 5.0 :float 5.0
- :float 5.0 :float 5.0 :float 5.0 :float 5.0
- :float 5.0 :float 5.0 :float 5.0 :float 5.0
- :float)
- 130.0)
-
-;;; Defining a callback as a non-toplevel form. Not portable. Doesn't
-;;; work for CMUCL or Allegro.
-#-(and)
-(let ((n 42))
- (defcallback non-toplevel-cb :int ()
- n))
-
-#-(and)
-(deftest callbacks.non-toplevel
- (foreign-funcall (callback non-toplevel-cb) :int)
- 42)
-
-;;;# Stdcall
-
-#+(and x86 (not cffi-sys::no-stdcall))
-(progn
- (defcallback (stdcall-cb :convention :stdcall) :int
- ((a :int) (b :int) (c :int))
- (+ a b c))
-
- (defcfun "call_stdcall_fun" :int
- (f :pointer))
-
- (deftest callbacks.stdcall.1
- (call-stdcall-fun (callback stdcall-cb))
- 42))
-
-;;; RT: many of the %DEFCALLBACK implementations wouldn't handle
-;;; uninterned symbols.
-(deftest callbacks.uninterned
- (values (defcallback #1=#:foo :void ())
- (pointerp (callback #1#)))
- #1# t)
(DIR) diff --git a/3rdparties/software/cffi_0.20.0/tests/compile.bat b/3rdparties/software/cffi_0.20.0/tests/compile.bat
@@ -1,9 +0,0 @@
-rem
-rem script for compiling the test lib with the free MSVC++ toolkit.
-rem
-
-cl /LD /DWIN32=1 /Tc libtest.c
-del libtest.obj libtest.exp
-
-cl /LD /DWIN32=1 /Tc libtest2.c
-del libtest2.obj libtest2.exp
(DIR) diff --git a/3rdparties/software/cffi_0.20.0/tests/defcfun.lisp b/3rdparties/software/cffi_0.20.0/tests/defcfun.lisp
@@ -1,536 +0,0 @@
-;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
-;;;
-;;; defcfun.lisp --- Tests function definition and calling.
-;;;
-;;; Copyright (C) 2005-2007, Luis Oliveira <loliveira@common-lisp.net>
-;;;
-;;; Permission is hereby granted, free of charge, to any person
-;;; obtaining a copy of this software and associated documentation
-;;; files (the "Software"), to deal in the Software without
-;;; restriction, including without limitation the rights to use, copy,
-;;; modify, merge, publish, distribute, sublicense, and/or sell copies
-;;; of the Software, and to permit persons to whom the Software is
-;;; furnished to do so, subject to the following conditions:
-;;;
-;;; The above copyright notice and this permission notice shall be
-;;; included in all copies or substantial portions of the Software.
-;;;
-;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
-;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
-;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
-;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
-;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
-;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
-;;; DEALINGS IN THE SOFTWARE.
-;;;
-
-(in-package #:cffi-tests)
-
-(deftest defcfun.parse-name-and-options.1
- (multiple-value-bind (lisp-name foreign-name)
- (let ((*package* (find-package '#:cffi-tests)))
- (cffi::parse-name-and-options "foo_bar"))
- (list lisp-name foreign-name))
- (foo-bar "foo_bar"))
-
-(deftest defcfun.parse-name-and-options.2
- (multiple-value-bind (lisp-name foreign-name)
- (let ((*package* (find-package '#:cffi-tests)))
- (cffi::parse-name-and-options "foo_bar" t))
- (list lisp-name foreign-name))
- (*foo-bar* "foo_bar"))
-
-(deftest defcfun.parse-name-and-options.3
- (multiple-value-bind (lisp-name foreign-name)
- (cffi::parse-name-and-options 'foo-bar)
- (list lisp-name foreign-name))
- (foo-bar "foo_bar"))
-
-(deftest defcfun.parse-name-and-options.4
- (multiple-value-bind (lisp-name foreign-name)
- (cffi::parse-name-and-options '*foo-bar* t)
- (list lisp-name foreign-name))
- (*foo-bar* "foo_bar"))
-
-(deftest defcfun.parse-name-and-options.5
- (multiple-value-bind (lisp-name foreign-name)
- (cffi::parse-name-and-options '("foo_bar" foo-baz))
- (list lisp-name foreign-name))
- (foo-baz "foo_bar"))
-
-(deftest defcfun.parse-name-and-options.6
- (multiple-value-bind (lisp-name foreign-name)
- (cffi::parse-name-and-options '("foo_bar" *foo-baz*) t)
- (list lisp-name foreign-name))
- (*foo-baz* "foo_bar"))
-
-(deftest defcfun.parse-name-and-options.7
- (multiple-value-bind (lisp-name foreign-name)
- (cffi::parse-name-and-options '(foo-baz "foo_bar"))
- (list lisp-name foreign-name))
- (foo-baz "foo_bar"))
-
-(deftest defcfun.parse-name-and-options.8
- (multiple-value-bind (lisp-name foreign-name)
- (cffi::parse-name-and-options '(*foo-baz* "foo_bar") t)
- (list lisp-name foreign-name))
- (*foo-baz* "foo_bar"))
-
-;;;# Name translation
-
-(deftest translate-underscore-separated-name.to-symbol
- (let ((*package* (find-package '#:cffi-tests)))
- (translate-underscore-separated-name "some_name_with_underscores"))
- some-name-with-underscores)
-
-(deftest translate-underscore-separated-name.to-string
- (translate-underscore-separated-name 'some-name-with-underscores)
- "some_name_with_underscores")
-
-(deftest translate-camelcase-name.to-symbol
- (let ((*package* (find-package '#:cffi-tests)))
- (translate-camelcase-name "someXmlFunction"))
- some-xml-function)
-
-(deftest translate-camelcase-name.to-string
- (translate-camelcase-name 'some-xml-function)
- "someXmlFunction")
-
-(deftest translate-camelcase-name.to-string-upper
- (translate-camelcase-name 'some-xml-function :upper-initial-p t)
- "SomeXmlFunction")
-
-(deftest translate-camelcase-name.to-symbol-special
- (let ((*package* (find-package '#:cffi-tests)))
- (translate-camelcase-name "someXMLFunction" :special-words '("XML")))
- some-xml-function)
-
-(deftest translate-camelcase-name.to-string-special
- (translate-camelcase-name 'some-xml-function :special-words '("XML"))
- "someXMLFunction")
-
-(deftest translate-name-from-foreign.function
- (let ((*package* (find-package '#:cffi-tests)))
- (translate-name-from-foreign "some_xml_name" *package*))
- some-xml-name)
-
-(deftest translate-name-from-foreign.var
- (let ((*package* (find-package '#:cffi-tests)))
- (translate-name-from-foreign "some_xml_name" *package* t))
- *some-xml-name*)
-
-(deftest translate-name-to-foreign.function
- (translate-name-to-foreign 'some-xml-name *package*)
- "some_xml_name")
-
-(deftest translate-name-to-foreign.var
- (translate-name-to-foreign '*some-xml-name* *package* t)
- "some_xml_name")
-
-;;;# Calling with built-in c types
-;;;
-;;; Tests calling standard C library functions both passing
-;;; and returning each built-in type. (adapted from funcall.lisp)
-
-(defcfun "toupper" :char
- "toupper docstring"
- (char :char))
-
-(deftest defcfun.char
- (toupper (char-code #\a))
- #.(char-code #\A))
-
-(deftest defcfun.docstring
- (documentation 'toupper 'function)
- "toupper docstring")
-
-
-(defcfun ("abs" c-abs) :int
- (n :int))
-
-(deftest defcfun.int
- (c-abs -100)
- 100)
-
-
-(defcfun "labs" :long
- (n :long))
-
-(deftest defcfun.long
- (labs -131072)
- 131072)
-
-
-#-cffi-features:no-long-long
-(progn
- (defcfun "my_llabs" :long-long
- (n :long-long))
-
- (deftest defcfun.long-long
- (my-llabs -9223372036854775807)
- 9223372036854775807)
-
- (defcfun "ullong" :unsigned-long-long
- (n :unsigned-long-long))
-
- #+allegro ; lp#914500
- (pushnew 'defcfun.unsigned-long-long rt::*expected-failures*)
-
- (deftest defcfun.unsigned-long-long
- (let ((ullong-max (1- (expt 2 (* 8 (foreign-type-size :unsigned-long-long))))))
- (eql ullong-max (ullong ullong-max)))
- t))
-
-
-(defcfun "my_sqrtf" :float
- (n :float))
-
-(deftest defcfun.float
- (my-sqrtf 16.0)
- 4.0)
-
-
-(defcfun ("sqrt" c-sqrt) :double
- (n :double))
-
-(deftest defcfun.double
- (c-sqrt 36.0d0)
- 6.0d0)
-
-
-#+(and scl long-float)
-(defcfun ("sqrtl" c-sqrtl) :long-double
- (n :long-double))
-
-#+(and scl long-float)
-(deftest defcfun.long-double
- (c-sqrtl 36.0l0)
- 6.0l0)
-
-
-(defcfun "strlen" :int
- (n :string))
-
-(deftest defcfun.string.1
- (strlen "Hello")
- 5)
-
-
-(defcfun "strcpy" (:pointer :char)
- (dest (:pointer :char))
- (src :string))
-
-(defcfun "strcat" (:pointer :char)
- (dest (:pointer :char))
- (src :string))
-
-(deftest defcfun.string.2
- (with-foreign-pointer-as-string (s 100)
- (setf (mem-ref s :char) 0)
- (strcpy s "Hello")
- (strcat s ", world!"))
- "Hello, world!")
-
-(defcfun "strerror" :string
- (n :int))
-
-(deftest defcfun.string.3
- (typep (strerror 1) 'string)
- t)
-
-
-;;; Regression test. Allegro would warn on direct calls to
-;;; functions with no arguments.
-;;;
-;;; Also, let's check if void functions will return NIL.
-;;;
-;;; Check if a docstring without arguments doesn't cause problems.
-
-(defcfun "noargs" :int
- "docstring")
-
-(deftest defcfun.noargs
- (noargs)
- 42)
-
-(defcfun "noop" :void)
-
-#+(or allegro openmcl ecl) (pushnew 'defcfun.noop rt::*expected-failures*)
-
-(deftest defcfun.noop
- (noop)
- #|no values|#)
-
-;;;# Calling varargs functions
-
-(defcfun "sum_double_arbitrary" :double (n :int) &rest)
-
-(deftest defcfun.varargs.nostdlib
- (sum-double-arbitrary
- 26
- :double 3.14d0 :double 3.14d0 :double 3.14d0 :double 3.14d0
- :double 3.14d0 :double 3.14d0 :double 3.14d0 :double 3.14d0
- :double 3.14d0 :double 3.14d0 :double 3.14d0 :double 3.14d0
- :double 3.14d0 :double 3.14d0 :double 3.14d0 :double 3.14d0
- :double 3.14d0 :double 3.14d0 :double 3.14d0 :double 3.14d0
- :double 3.14d0 :double 3.14d0 :double 3.14d0 :double 3.14d0
- :double 3.14d0 :double 3.14d0)
- 81.64d0)
-
-(defcfun "sprintf" :int
- "sprintf docstring"
- (str (:pointer :char))
- (control :string)
- &rest)
-
-;;; CLISP and ABCL discard macro docstrings.
-#+(or clisp abcl)
-(pushnew 'defcfun.varargs.docstrings rt::*expected-failures*)
-
-(deftest defcfun.varargs.docstrings
- (documentation 'sprintf 'function)
- "sprintf docstring")
-
-(deftest defcfun.varargs.char
- (with-foreign-pointer-as-string (s 100)
- (sprintf s "%c" :char 65))
- "A")
-
-(deftest defcfun.varargs.short
- (with-foreign-pointer-as-string (s 100)
- (sprintf s "%d" :short 42))
- "42")
-
-(deftest defcfun.varargs.int
- (with-foreign-pointer-as-string (s 100)
- (sprintf s "%d" :int 1000))
- "1000")
-
-(deftest defcfun.varargs.long
- (with-foreign-pointer-as-string (s 100)
- (sprintf s "%ld" :long 131072))
- "131072")
-
-(deftest defcfun.varargs.float
- (with-foreign-pointer-as-string (s 100)
- (sprintf s "%.2f" :float (float pi)))
- "3.14")
-
-(deftest defcfun.varargs.double
- (with-foreign-pointer-as-string (s 100)
- (sprintf s "%.2f" :double (float pi 1.0d0)))
- "3.14")
-
-#+(and scl long-float)
-(deftest defcfun.varargs.long-double
- (with-foreign-pointer-as-string (s 100)
- (setf (mem-ref s :char) 0)
- (sprintf s "%.2Lf" :long-double pi))
- "3.14")
-
-(deftest defcfun.varargs.string
- (with-foreign-pointer-as-string (s 100)
- (sprintf s "%s, %s!" :string "Hello" :string "world"))
- "Hello, world!")
-
-;;; (let ((rettype (find-type :long))
-;;; (arg-types (n-random-types-no-ll 127)))
-;;; (c-function rettype arg-types)
-;;; (gen-function-test rettype arg-types))
-
-#+(and (not ecl)
- #.(cl:if (cl:>= cl:lambda-parameters-limit 127) '(:and) '(:or)))
-(progn
- (defcfun "sum_127_no_ll" :long
- (a1 :long) (a2 :unsigned-long) (a3 :short) (a4 :unsigned-short) (a5 :float)
- (a6 :double) (a7 :unsigned-long) (a8 :float) (a9 :unsigned-char)
- (a10 :unsigned-short) (a11 :short) (a12 :unsigned-long) (a13 :double)
- (a14 :long) (a15 :unsigned-int) (a16 :pointer) (a17 :unsigned-int)
- (a18 :unsigned-short) (a19 :long) (a20 :float) (a21 :pointer) (a22 :float)
- (a23 :int) (a24 :int) (a25 :unsigned-short) (a26 :long) (a27 :long)
- (a28 :double) (a29 :unsigned-char) (a30 :unsigned-int) (a31 :unsigned-int)
- (a32 :int) (a33 :unsigned-short) (a34 :unsigned-int) (a35 :pointer)
- (a36 :double) (a37 :double) (a38 :long) (a39 :short) (a40 :unsigned-short)
- (a41 :long) (a42 :char) (a43 :long) (a44 :unsigned-short) (a45 :pointer)
- (a46 :int) (a47 :unsigned-int) (a48 :double) (a49 :unsigned-char)
- (a50 :unsigned-char) (a51 :float) (a52 :int) (a53 :unsigned-short)
- (a54 :double) (a55 :short) (a56 :unsigned-char) (a57 :unsigned-long)
- (a58 :float) (a59 :float) (a60 :float) (a61 :pointer) (a62 :pointer)
- (a63 :unsigned-int) (a64 :unsigned-long) (a65 :char) (a66 :short)
- (a67 :unsigned-short) (a68 :unsigned-long) (a69 :pointer) (a70 :float)
- (a71 :double) (a72 :long) (a73 :unsigned-long) (a74 :short)
- (a75 :unsigned-int) (a76 :unsigned-short) (a77 :int) (a78 :unsigned-short)
- (a79 :char) (a80 :double) (a81 :short) (a82 :unsigned-char) (a83 :float)
- (a84 :char) (a85 :int) (a86 :double) (a87 :unsigned-char) (a88 :int)
- (a89 :unsigned-long) (a90 :double) (a91 :short) (a92 :short)
- (a93 :unsigned-int) (a94 :unsigned-char) (a95 :float) (a96 :long)
- (a97 :float) (a98 :long) (a99 :long) (a100 :int) (a101 :int)
- (a102 :unsigned-int) (a103 :char) (a104 :char) (a105 :unsigned-short)
- (a106 :unsigned-int) (a107 :unsigned-short) (a108 :unsigned-short)
- (a109 :int) (a110 :long) (a111 :char) (a112 :double) (a113 :unsigned-int)
- (a114 :char) (a115 :short) (a116 :unsigned-long) (a117 :unsigned-int)
- (a118 :short) (a119 :unsigned-char) (a120 :float) (a121 :pointer)
- (a122 :double) (a123 :int) (a124 :long) (a125 :char) (a126 :unsigned-short)
- (a127 :float))
-
- (deftest defcfun.bff.1
- (sum-127-no-ll
- 1442906394 520035521 -4715 50335 -13557.0 -30892.0d0 24061483 -23737.0
- 22 2348 4986 104895680 8073.0d0 -571698147 102484400
- (make-pointer 507907275) 12733353 7824 -1275845284 13602.0
- (make-pointer 286958390) -8042.0 -773681663 -1289932452 31199 -154985357
- -170994216 16845.0d0 177 218969221 2794350893 6068863 26327 127699339
- (make-pointer 184352771) 18512.0d0 -12345.0d0 -179853040 -19981 37268
- -792845398 116 -1084653028 50494 (make-pointer 2105239646) -1710519651
- 1557813312 2839.0d0 90 180 30580.0 -532698978 8623 9537.0d0 -10882 54
- 184357206 14929.0 -8190.0 -25615.0 (make-pointer 235310526)
- (make-pointer 220476977) 7476055 1576685 -117 -11781 31479 23282640
- (make-pointer 8627281) -17834.0 10391.0d0 -1904504370 114393659 -17062
- 637873619 16078 -891210259 8107 0 760.0d0 -21268 104 14133.0 10
- 588598141 310.0d0 20 1351785456 16159552 -10121.0d0 -25866 24821
- 68232851 60 -24132.0 -1660411658 13387.0 -786516668 -499825680
- -1128144619 111849719 2746091587 -2 95 14488 326328135 64781 18204
- 150716680 -703859275 103 16809.0d0 852235610 -43 21088 242356110
- 324325428 -22380 23 24814.0 (make-pointer 40362014) -14322.0d0
- -1864262539 523684371 -21 49995 -29175.0)
- 796447501))
-
-;;; (let ((rettype (find-type :long-long))
-;;; (arg-types (n-random-types 127)))
-;;; (c-function rettype arg-types)
-;;; (gen-function-test rettype arg-types))
-
-#-(or ecl cffi-sys::no-long-long
- #.(cl:if (cl:>= cl:lambda-parameters-limit 127) '(:or) '(:and)))
-(progn
- (defcfun "sum_127" :long-long
- (a1 :pointer) (a2 :pointer) (a3 :float) (a4 :unsigned-long) (a5 :pointer)
- (a6 :long-long) (a7 :double) (a8 :double) (a9 :unsigned-short) (a10 :int)
- (a11 :long-long) (a12 :long) (a13 :short) (a14 :unsigned-int) (a15 :long)
- (a16 :unsigned-char) (a17 :int) (a18 :double) (a19 :short) (a20 :short)
- (a21 :long-long) (a22 :unsigned-int) (a23 :unsigned-short) (a24 :short)
- (a25 :pointer) (a26 :short) (a27 :unsigned-short) (a28 :unsigned-short)
- (a29 :int) (a30 :long-long) (a31 :pointer) (a32 :int) (a33 :unsigned-long)
- (a34 :unsigned-long) (a35 :pointer) (a36 :unsigned-long-long) (a37 :float)
- (a38 :int) (a39 :short) (a40 :pointer) (a41 :unsigned-long-long)
- (a42 :long-long) (a43 :unsigned-long) (a44 :unsigned-long)
- (a45 :unsigned-long-long) (a46 :unsigned-long) (a47 :char) (a48 :double)
- (a49 :long) (a50 :unsigned-int) (a51 :int) (a52 :short) (a53 :pointer)
- (a54 :long) (a55 :unsigned-long-long) (a56 :int) (a57 :unsigned-short)
- (a58 :unsigned-long-long) (a59 :float) (a60 :pointer) (a61 :float)
- (a62 :unsigned-short) (a63 :unsigned-long) (a64 :float) (a65 :unsigned-int)
- (a66 :unsigned-long-long) (a67 :pointer) (a68 :double)
- (a69 :unsigned-long-long) (a70 :double) (a71 :double) (a72 :long-long)
- (a73 :pointer) (a74 :unsigned-short) (a75 :long) (a76 :pointer) (a77 :short)
- (a78 :double) (a79 :long) (a80 :unsigned-char) (a81 :pointer)
- (a82 :unsigned-char) (a83 :long) (a84 :double) (a85 :pointer) (a86 :int)
- (a87 :double) (a88 :unsigned-char) (a89 :double) (a90 :short) (a91 :long)
- (a92 :int) (a93 :long) (a94 :double) (a95 :unsigned-short)
- (a96 :unsigned-int) (a97 :int) (a98 :char) (a99 :long-long) (a100 :double)
- (a101 :float) (a102 :unsigned-long) (a103 :short) (a104 :pointer)
- (a105 :float) (a106 :long-long) (a107 :int) (a108 :long-long)
- (a109 :long-long) (a110 :double) (a111 :unsigned-long-long) (a112 :double)
- (a113 :unsigned-long) (a114 :char) (a115 :char) (a116 :unsigned-long)
- (a117 :short) (a118 :unsigned-char) (a119 :unsigned-char) (a120 :int)
- (a121 :int) (a122 :float) (a123 :unsigned-char) (a124 :unsigned-char)
- (a125 :double) (a126 :unsigned-long-long) (a127 :char))
-
- #+(and sbcl x86) (push 'defcfun.bff.2 rtest::*expected-failures*)
-
- (deftest defcfun.bff.2
- (sum-127
- (make-pointer 2746181372) (make-pointer 177623060) -32334.0 3158055028
- (make-pointer 242315091) 4288001754991016425 -21047.0d0 287.0d0 18722
- 243379286 -8677366518541007140 581399424 -13872 4240394881 1353358999
- 226 969197676 -26207.0d0 6484 11150 1241680089902988480 106068320 61865
- 2253 (make-pointer 866809333) -31613 35616 11715 1393601698
- 8940888681199591845 (make-pointer 1524606024) 805638893 3315410736
- 3432596795 (make-pointer 1490355706) 696175657106383698 -25438.0
- 1294381547 26724 (make-pointer 3196569545) 2506913373410783697
- -4405955718732597856 4075932032 3224670123 2183829215657835866
- 1318320964 -22 -3786.0d0 -2017024146 1579225515 -626617701 -1456
- (make-pointer 3561444187) 395687791 1968033632506257320 -1847773261
- 48853 142937735275669133 -17974.0 (make-pointer 2791749948) -14140.0
- 2707 3691328585 3306.0 1132012981 303633191773289330
- (make-pointer 981183954) 9114.0d0 8664374572369470 -19013.0d0
- -10288.0d0 -3679345119891954339 (make-pointer 3538786709) 23761
- -154264605 (make-pointer 2694396308) 7023 997.0d0 1009561368 241
- (make-pointer 2612292671) 48 1431872408 -32675.0d0
- (make-pointer 1587599336) 958916472 -9857.0d0 111 -14370.0d0 -7308
- -967514912 488790941 2146978095 -24111.0d0 13711 86681861 717987770
- 111 1013402998690933877 17234.0d0 -8772.0 3959216275 -8711
- (make-pointer 3142780851) 9480.0 -3820453146461186120 1616574376
- -3336232268263990050 -1906114671562979758 -27925.0d0 9695970875869913114
- 27033.0d0 1096518219 -12 104 3392025403 -27911 60 89 509297051
- -533066551 29158.0 110 54 -9802.0d0 593950442165910888 -79)
- 7758614658402721936))
-
-;;; regression test: defining an undefined foreign function should only
-;;; throw some sort of warning, not signal an error.
-
-#+(or cmucl (and sbcl (or (not linkage-table) win32)))
-(pushnew 'defcfun.undefined rt::*expected-failures*)
-
-(deftest defcfun.undefined
- (progn
- (eval '(defcfun ("undefined_foreign_function" undefined-foreign-function) :void))
- (compile 'undefined-foreign-function)
- t)
- t)
-
-;;; Test whether all doubles are passed correctly. On some platforms, eg.
-;;; darwin/ppc, some are passed on registers others on the stack.
-(defcfun "sum_double26" :double
- (a1 :double) (a2 :double) (a3 :double) (a4 :double) (a5 :double)
- (a6 :double) (a7 :double) (a8 :double) (a9 :double) (a10 :double)
- (a11 :double) (a12 :double) (a13 :double) (a14 :double) (a15 :double)
- (a16 :double) (a17 :double) (a18 :double) (a19 :double) (a20 :double)
- (a21 :double) (a22 :double) (a23 :double) (a24 :double) (a25 :double)
- (a26 :double))
-
-(deftest defcfun.double26
- (sum-double26 3.14d0 3.14d0 3.14d0 3.14d0 3.14d0 3.14d0 3.14d0
- 3.14d0 3.14d0 3.14d0 3.14d0 3.14d0 3.14d0 3.14d0
- 3.14d0 3.14d0 3.14d0 3.14d0 3.14d0 3.14d0 3.14d0
- 3.14d0 3.14d0 3.14d0 3.14d0 3.14d0)
- 81.64d0)
-
-;;; Same as above for floats.
-(defcfun "sum_float26" :float
- (a1 :float) (a2 :float) (a3 :float) (a4 :float) (a5 :float)
- (a6 :float) (a7 :float) (a8 :float) (a9 :float) (a10 :float)
- (a11 :float) (a12 :float) (a13 :float) (a14 :float) (a15 :float)
- (a16 :float) (a17 :float) (a18 :float) (a19 :float) (a20 :float)
- (a21 :float) (a22 :float) (a23 :float) (a24 :float) (a25 :float)
- (a26 :float))
-
-(deftest defcfun.float26
- (sum-float26 5.0 5.0 5.0 5.0 5.0 5.0 5.0 5.0 5.0 5.0 5.0 5.0 5.0
- 5.0 5.0 5.0 5.0 5.0 5.0 5.0 5.0 5.0 5.0 5.0 5.0 5.0)
- 130.0)
-
-;;;# Namespaces
-
-#-cffi-sys::flat-namespace
-(progn
- (defcfun ("ns_function" ns-fun1 :library libtest) :boolean)
- (defcfun ("ns_function" ns-fun2 :library libtest2) :boolean)
-
- (deftest defcfun.namespace.1
- (values (ns-fun1) (ns-fun2))
- t nil))
-
-;;;# stdcall
-
-#+(and x86 windows (not cffi-sys::no-stdcall))
-(progn
- (defcfun ("stdcall_fun@12" stdcall-fun :convention :stdcall) :int
- (a :int)
- (b :int)
- (c :int))
-
- (deftest defcfun.stdcall.1
- (loop repeat 100 do (stdcall-fun 1 2 3)
- finally (return (stdcall-fun 1 2 3)))
- 6))
(DIR) diff --git a/3rdparties/software/cffi_0.20.0/tests/enum.lisp b/3rdparties/software/cffi_0.20.0/tests/enum.lisp
@@ -1,231 +0,0 @@
-;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
-;;;
-;;; enum.lisp --- Tests on C enums.
-;;;
-;;; Copyright (C) 2005-2006, Luis Oliveira <loliveira(@)common-lisp.net>
-;;;
-;;; Permission is hereby granted, free of charge, to any person
-;;; obtaining a copy of this software and associated documentation
-;;; files (the "Software"), to deal in the Software without
-;;; restriction, including without limitation the rights to use, copy,
-;;; modify, merge, publish, distribute, sublicense, and/or sell copies
-;;; of the Software, and to permit persons to whom the Software is
-;;; furnished to do so, subject to the following conditions:
-;;;
-;;; The above copyright notice and this permission notice shall be
-;;; included in all copies or substantial portions of the Software.
-;;;
-;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
-;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
-;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
-;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
-;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
-;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
-;;; DEALINGS IN THE SOFTWARE.
-;;;
-
-(in-package #:cffi-tests)
-
-(defctype numeros-base-type :int)
-
-(defcenum (numeros numeros-base-type)
- (:one 1)
- :two
- :three
- :four
- (:forty-one 41)
- :forty-two)
-
-(defcfun "check_enums" :int
- (%one numeros)
- (%two numeros)
- (%three numeros)
- (%four numeros)
- (%forty-one numeros)
- (%forty-two numeros))
-
-(deftest enum.1
- (check-enums :one :two :three 4 :forty-one :forty-two)
- 1)
-
-(defcenum another-boolean :false :true)
-(defcfun "return_enum" another-boolean (x :uint))
-
-(deftest enum.2
- (and (eq :false (return-enum 0))
- (eq :true (return-enum 1)))
- t)
-
-(defctype yet-another-boolean another-boolean)
-(defcfun ("return_enum" return-enum2) yet-another-boolean
- (x yet-another-boolean))
-
-(deftest enum.3
- (and (eq :false (return-enum2 :false))
- (eq :true (return-enum2 :true)))
- t)
-
-(defctype numeros-typedef numeros)
-
-(deftest enum.typedef.1
- (eq (foreign-enum-keyword 'numeros-typedef 1)
- (foreign-enum-keyword 'numeros 1))
- t)
-
-(deftest enum.typedef.2
- (eql (foreign-enum-value 'numeros-typedef :four)
- (foreign-enum-value 'numeros :four))
- t)
-
-(defcenum enum-size.int
- (:one 1)
- (enum-size-int #.(1- (expt 2 (1- (* (foreign-type-size :unsigned-int) 8)))))
- (enum-size-negative-int #.(- (1- (expt 2 (1- (* (foreign-type-size :unsigned-int) 8))))))
- (:two 2))
-
-(defcenum enum-size.uint
- (:one 1)
- (enum-size-uint #.(1- (expt 2 (* (foreign-type-size :unsigned-int) 8))))
- (:two 2))
-
-(deftest enum.size
- (mapcar (alexandria:compose 'cffi::unparse-type
- 'cffi::actual-type
- 'cffi::parse-type)
- (list 'enum-size.int
- 'enum-size.uint))
- ;; The C standard only has weak constraints on the size of integer types, so
- ;; we cannot really test more than one type in a platform independent way due
- ;; to the possible overlaps.
- (:int
- :unsigned-int))
-
-(deftest enum.size.members
- (mapcar (alexandria:conjoin 'boundp 'constantp)
- '(enum-size-int enum-size-negative-int enum-size-uint))
- (t t t))
-
-(deftest enum.size.error-when-too-large
- (expecting-error
- (eval '(defcenum enum-size-too-large
- (:too-long #.(expt 2 129)))))
- :error)
-
-;; There are some projects that use non-integer base type. It's not in
-;; adherence with the C standard, but we also don't lose much by
-;; allowing it.
-(defcenum (enum.double :double)
- (:one 1)
- (:two 2d0)
- (:three 3.42)
- :four)
-
-(deftest enum.double
- (values-list
- (mapcar (alexandria:curry 'foreign-enum-value 'enum.double)
- '(:one :two :three :four)))
- 1
- 2.0d0
- 3.42
- 4.42)
-
-;;;# Bitfield tests
-
-;;; Regression test: defbitfield was misbehaving when the first value
-;;; was provided.
-(deftest bitfield.1
- (eval '(defbitfield (bf1 :long)
- (:foo 0)))
- bf1)
-
-(defbitfield bf2
- one
- two
- four
- eight
- sixteen
- (bf2.outlier 42)
- thirty-two
- sixty-four)
-
-(deftest bitfield.2
- (mapcar (lambda (symbol)
- (foreign-bitfield-value 'bf2 (list symbol)))
- '(one two four eight sixteen thirty-two sixty-four))
- (1 2 4 8 16 32 64))
-
-(deftest bitfield.2.outlier
- (mapcar (lambda (symbol)
- (foreign-bitfield-value 'bf2 (list symbol)))
- '(one two four eight sixteen thirty-two sixty-four))
- (1 2 4 8 16 32 64))
-
-(defbitfield (bf3 :int)
- (three 3)
- one
- (seven 7)
- two
- (eight 8)
- sixteen)
-
-;;; Non-single-bit numbers must not influence the progression of
-;;; implicit values. Single bits larger than any before *must*
-;;; influence said progression.
-(deftest bitfield.3
- (mapcar (lambda (symbol)
- (foreign-bitfield-value 'bf3 (list symbol)))
- '(one two sixteen))
- (1 2 16))
-
-(defbitfield bf4
- ;; zero will be a simple enum member because it's not a valid mask
- (zero 0)
- one
- two
- four
- (three 3)
- (sixteen 16))
-
-;;; Yet another edge case with the 0...
-(deftest bitfield.4
- ;; These should macroexpand to the literals in Slime
- ;; due to the compiler macros. Same below.
- (values (foreign-bitfield-value 'bf4 ())
- (foreign-bitfield-value 'bf4 'one)
- (foreign-bitfield-value 'bf4 '(one two))
- (foreign-bitfield-value 'bf4 '(three)) ; or should it signal an error?
- (foreign-bitfield-value 'bf4 '(sixteen)))
- 0
- 1
- 3
- 3
- 16)
-
-(deftest bitfield.4b
- (values (foreign-bitfield-symbols 'bf4 0)
- (foreign-bitfield-symbols 'bf4 1)
- (foreign-bitfield-symbols 'bf4 3)
- (foreign-bitfield-symbols 'bf4 8)
- (foreign-bitfield-symbols 'bf4 16))
- nil
- (one)
- (one two)
- nil
- (sixteen))
-
-(deftest bitfield.translators
- (with-foreign-object (bf 'bf4 2)
- (setf (mem-aref bf 'bf4 0) 1)
- (setf (mem-aref bf 'bf4 1) 3)
- (values (mem-aref bf 'bf4 0)
- (mem-aref bf 'bf4 1)))
- (one)
- (one two))
-
-#+nil
-(deftest bitfield.base-type-error
- (expecting-error
- (eval '(defbitfield (bf1 :float)
- (:foo 0))))
- :error)
(DIR) diff --git a/3rdparties/software/cffi_0.20.0/tests/foreign-globals.lisp b/3rdparties/software/cffi_0.20.0/tests/foreign-globals.lisp
@@ -1,309 +0,0 @@
-;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
-;;;
-;;; foreign-globals.lisp --- Tests on foreign globals.
-;;;
-;;; Copyright (C) 2005-2007, Luis Oliveira <loliveira(@)common-lisp.net>
-;;;
-;;; Permission is hereby granted, free of charge, to any person
-;;; obtaining a copy of this software and associated documentation
-;;; files (the "Software"), to deal in the Software without
-;;; restriction, including without limitation the rights to use, copy,
-;;; modify, merge, publish, distribute, sublicense, and/or sell copies
-;;; of the Software, and to permit persons to whom the Software is
-;;; furnished to do so, subject to the following conditions:
-;;;
-;;; The above copyright notice and this permission notice shall be
-;;; included in all copies or substantial portions of the Software.
-;;;
-;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
-;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
-;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
-;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
-;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
-;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
-;;; DEALINGS IN THE SOFTWARE.
-;;;
-
-(in-package #:cffi-tests)
-
-(defcvar ("var_char" *char-var*) :char)
-(defcvar "var_unsigned_char" :unsigned-char)
-(defcvar "var_short" :short)
-(defcvar "var_unsigned_short" :unsigned-short)
-(defcvar "var_int" :int)
-(defcvar "var_unsigned_int" :unsigned-int)
-(defcvar "var_long" :long)
-(defcvar "var_unsigned_long" :unsigned-long)
-(defcvar "var_float" :float)
-(defcvar "var_double" :double)
-(defcvar "var_pointer" :pointer)
-(defcvar "var_string" :string)
-(defcvar "var_long_long" :long-long)
-(defcvar "var_unsigned_long_long" :unsigned-long-long)
-
-;;; The expected failures marked below result from this odd behaviour:
-;;;
-;;; (foreign-symbol-pointer "var_char") => NIL
-;;;
-;;; (foreign-symbol-pointer "var_char" :library 'libtest)
-;;; => #<Pointer to type :VOID = #xF7F50740>
-;;;
-;;; Why is this happening? --luis
-#+lispworks
-(mapc (lambda (x) (pushnew x rtest::*expected-failures*))
- '(foreign-globals.ref.char foreign-globals.get-var-pointer.1
- foreign-globals.get-var-pointer.2 foreign-globals.symbol-name
- foreign-globals.read-only.1 ))
-
-(deftest foreign-globals.ref.char
- *char-var*
- -127)
-
-(deftest foreign-globals.ref.unsigned-char
- *var-unsigned-char*
- 255)
-
-(deftest foreign-globals.ref.short
- *var-short*
- -32767)
-
-(deftest foreign-globals.ref.unsigned-short
- *var-unsigned-short*
- 65535)
-
-(deftest foreign-globals.ref.int
- *var-int*
- -32767)
-
-(deftest foreign-globals.ref.unsigned-int
- *var-unsigned-int*
- 65535)
-
-(deftest foreign-globals.ref.long
- *var-long*
- -2147483647)
-
-(deftest foreign-globals.ref.unsigned-long
- *var-unsigned-long*
- 4294967295)
-
-(deftest foreign-globals.ref.float
- *var-float*
- 42.0)
-
-(deftest foreign-globals.ref.double
- *var-double*
- 42.0d0)
-
-(deftest foreign-globals.ref.pointer
- (null-pointer-p *var-pointer*)
- t)
-
-(deftest foreign-globals.ref.string
- *var-string*
- "Hello, foreign world!")
-
-#+openmcl (push 'foreign-globals.set.long-long rt::*expected-failures*)
-
-(deftest foreign-globals.ref.long-long
- *var-long-long*
- -9223372036854775807)
-
-(deftest foreign-globals.ref.unsigned-long-long
- *var-unsigned-long-long*
- 18446744073709551615)
-
-;; The *.set.* tests restore the old values so that the *.ref.*
-;; don't fail when re-run.
-(defmacro with-old-value-restored ((place) &body body)
- (let ((old (gensym)))
- `(let ((,old ,place))
- (prog1
- (progn ,@body)
- (setq ,place ,old)))))
-
-(deftest foreign-globals.set.int
- (with-old-value-restored (*var-int*)
- (setq *var-int* 42)
- *var-int*)
- 42)
-
-(deftest foreign-globals.set.string
- (with-old-value-restored (*var-string*)
- (setq *var-string* "Ehxosxangxo")
- (prog1
- *var-string*
- ;; free the string we just allocated
- (foreign-free (mem-ref (get-var-pointer '*var-string*) :pointer))))
- "Ehxosxangxo")
-
-(deftest foreign-globals.set.long-long
- (with-old-value-restored (*var-long-long*)
- (setq *var-long-long* -9223000000000005808)
- *var-long-long*)
- -9223000000000005808)
-
-(deftest foreign-globals.get-var-pointer.1
- (pointerp (get-var-pointer '*char-var*))
- t)
-
-(deftest foreign-globals.get-var-pointer.2
- (mem-ref (get-var-pointer '*char-var*) :char)
- -127)
-
-;;; Symbol case.
-
-(defcvar "UPPERCASEINT1" :int)
-(defcvar "UPPER_CASE_INT1" :int)
-(defcvar "MiXeDCaSeInT1" :int)
-(defcvar "MiXeD_CaSe_InT1" :int)
-
-(deftest foreign-globals.ref.uppercaseint1
- *uppercaseint1*
- 12345)
-
-(deftest foreign-globals.ref.upper-case-int1
- *upper-case-int1*
- 23456)
-
-(deftest foreign-globals.ref.mixedcaseint1
- *mixedcaseint1*
- 34567)
-
-(deftest foreign-globals.ref.mixed-case-int1
- *mixed-case-int1*
- 45678)
-
-(when (string= (symbol-name 'nil) "NIL")
- (let ((*readtable* (copy-readtable)))
- (setf (readtable-case *readtable*) :invert)
- (eval (read-from-string "(defcvar \"UPPERCASEINT2\" :int)"))
- (eval (read-from-string "(defcvar \"UPPER_CASE_INT2\" :int)"))
- (eval (read-from-string "(defcvar \"MiXeDCaSeInT2\" :int)"))
- (eval (read-from-string "(defcvar \"MiXeD_CaSe_InT2\" :int)"))
- (setf (readtable-case *readtable*) :preserve)
- (eval (read-from-string "(DEFCVAR \"UPPERCASEINT3\" :INT)"))
- (eval (read-from-string "(DEFCVAR \"UPPER_CASE_INT3\" :INT)"))
- (eval (read-from-string "(DEFCVAR \"MiXeDCaSeInT3\" :INT)"))
- (eval (read-from-string "(DEFCVAR \"MiXeD_CaSe_InT3\" :INT)"))))
-
-
-;;; EVAL gets rid of SBCL's unreachable code warnings.
-(when (string= (symbol-name (eval nil)) "nil")
- (let ((*readtable* (copy-readtable)))
- (setf (readtable-case *readtable*) :invert)
- (eval (read-from-string "(DEFCVAR \"UPPERCASEINT2\" :INT)"))
- (eval (read-from-string "(DEFCVAR \"UPPER_CASE_INT2\" :INT)"))
- (eval (read-from-string "(DEFCVAR \"MiXeDCaSeInT2\" :INT)"))
- (eval (read-from-string "(DEFCVAR \"MiXeD_CaSe_InT2\" :INT)"))
- (setf (readtable-case *readtable*) :downcase)
- (eval (read-from-string "(defcvar \"UPPERCASEINT3\" :int)"))
- (eval (read-from-string "(defcvar \"UPPER_CASE_INT3\" :int)"))
- (eval (read-from-string "(defcvar \"MiXeDCaSeInT3\" :int)"))
- (eval (read-from-string "(defcvar \"MiXeD_CaSe_InT3\" :int)"))))
-
-(deftest foreign-globals.ref.uppercaseint2
- *uppercaseint2*
- 12345)
-
-(deftest foreign-globals.ref.upper-case-int2
- *upper-case-int2*
- 23456)
-
-(deftest foreign-globals.ref.mixedcaseint2
- *mixedcaseint2*
- 34567)
-
-(deftest foreign-globals.ref.mixed-case-int2
- *mixed-case-int2*
- 45678)
-
-(deftest foreign-globals.ref.uppercaseint3
- *uppercaseint3*
- 12345)
-
-(deftest foreign-globals.ref.upper-case-int3
- *upper-case-int3*
- 23456)
-
-(deftest foreign-globals.ref.mixedcaseint3
- *mixedcaseint3*
- 34567)
-
-(deftest foreign-globals.ref.mixed-case-int3
- *mixed-case-int3*
- 45678)
-
-;;; regression test:
-;;; gracefully accept symbols in defcvar
-
-(defcvar *var-char* :char)
-(defcvar var-char :char)
-
-(deftest foreign-globals.symbol-name
- (values *var-char* var-char)
- -127 -127)
-
-;;;# Namespace
-
-#-cffi-sys::flat-namespace
-(progn
- (deftest foreign-globals.namespace.1
- (values
- (mem-ref (foreign-symbol-pointer "var_char" :library 'libtest) :char)
- (foreign-symbol-pointer "var_char" :library 'libtest2))
- -127 nil)
-
- (deftest foreign-globals.namespace.2
- (values
- (mem-ref (foreign-symbol-pointer "ns_var" :library 'libtest) :boolean)
- (mem-ref (foreign-symbol-pointer "ns_var" :library 'libtest2) :boolean))
- t nil)
-
- ;; For its "default" module, Lispworks seems to cache lookups from
- ;; the newest module tried. If a lookup happens to have failed
- ;; subsequent lookups will fail even the symbol exists in other
- ;; modules. So this test fails.
- #+lispworks
- (pushnew 'foreign-globals.namespace.3 regression-test::*expected-failures*)
-
- (deftest foreign-globals.namespace.3
- (values
- (foreign-symbol-pointer "var_char" :library 'libtest2)
- (mem-ref (foreign-symbol-pointer "var_char") :char))
- nil -127)
-
- (defcvar ("ns_var" *ns-var1* :library libtest) :boolean)
- (defcvar ("ns_var" *ns-var2* :library libtest2) :boolean)
-
- (deftest foreign-globals.namespace.4
- (values *ns-var1* *ns-var2*)
- t nil))
-
-;;;# Read-only
-
-(defcvar ("var_char" *var-char-ro* :read-only t) :char
- "docstring")
-
-(deftest foreign-globals.read-only.1
- (values *var-char-ro*
- (ignore-errors (setf *var-char-ro* 12)))
- -127 nil)
-
-(deftest defcvar.docstring
- (documentation '*var-char-ro* 'variable)
- "docstring")
-
-;;;# Other tests
-
-;;; RT: FOREIGN-SYMBOL-POINTER shouldn't signal an error when passed
-;;; an undefined variable.
-(deftest foreign-globals.undefined.1
- (foreign-symbol-pointer "surely-undefined?")
- nil)
-
-(deftest foreign-globals.error.1
- (handler-case (foreign-symbol-pointer 'not-a-string)
- (type-error () t))
- t)
(DIR) diff --git a/3rdparties/software/cffi_0.20.0/tests/fsbv.lisp b/3rdparties/software/cffi_0.20.0/tests/fsbv.lisp
@@ -1,199 +0,0 @@
-;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
-;;;
-;;; fsbv.lisp --- Tests of foreign structure by value calls.
-;;;
-;;; Copyright (C) 2011, Liam M. Healy
-;;;
-;;; Permission is hereby granted, free of charge, to any person
-;;; obtaining a copy of this software and associated documentation
-;;; files (the "Software"), to deal in the Software without
-;;; restriction, including without limitation the rights to use, copy,
-;;; modify, merge, publish, distribute, sublicense, and/or sell copies
-;;; of the Software, and to permit persons to whom the Software is
-;;; furnished to do so, subject to the following conditions:
-;;;
-;;; The above copyright notice and this permission notice shall be
-;;; included in all copies or substantial portions of the Software.
-;;;
-;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
-;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
-;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
-;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
-;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
-;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
-;;; DEALINGS IN THE SOFTWARE.
-;;;
-
-(in-package #:cffi-tests)
-
-;; Requires struct.lisp
-
-(defcfun "sumpair" :int
- (p (:struct struct-pair)))
-
-(defcfun "makepair" (:struct struct-pair)
- (condition :bool))
-
-(defcfun "doublepair" (:struct struct-pair)
- (p (:struct struct-pair)))
-
-(defcfun "prodsumpair" :double
- (p (:struct struct-pair+double)))
-
-(defcfun "doublepairdouble" (:struct struct-pair+double)
- (p (:struct struct-pair+double)))
-
-;;; Call struct by value
-(deftest fsbv.1
- (sumpair '(1 . 2))
- 3)
-
-;;; See lp#1528719
-(deftest (fsbv.wfo :expected-to-fail t)
- (with-foreign-object (arg '(:struct struct-pair))
- (convert-into-foreign-memory '(40 . 2) '(:struct struct-pair) arg)
- (sumpair arg))
- 42)
-
-;;; Call and return struct by value
-(deftest fsbv.2
- (doublepair '(1 . 2))
- (2 . 4))
-
-;;; return struct by value
-(deftest (fsbv.makepair.1 :expected-to-fail t)
- (makepair nil)
- (-127 . 43))
-
-(deftest (fsbv.makepair.2 :expected-to-fail t)
- (makepair t)
- (-127 . 42))
-
-;;; Call recursive structure by value
-(deftest fsbv.3
- (prodsumpair '(pr (a 4 b 5) dbl 2.5d0))
- 22.5d0)
-
-;;; Call and return recursive structure by value
-(deftest fsbv.4
- (let ((ans (doublepairdouble '(pr (a 4 b 5) dbl 2.5d0))))
- (values (getf (getf ans 'pr) 'a)
- (getf (getf ans 'pr) 'b)
- (getf ans 'dbl)))
- 8
- 10
- 5.0d0)
-
-(defcstruct (struct-with-array :size 6)
- (s1 (:array :char 6)))
-
-(defcfun "zork" :void
- (p (:struct struct-with-array)))
-
-;;; Typedef fsbv test
-
-(defcfun ("sumpair" sumpair2) :int
- (p struct-pair-typedef1))
-
-(deftest fsbv.5
- (sumpair2 '(1 . 2))
- 3)
-
-(defcfun "returnpairpointer" (:pointer (:struct struct-pair))
- (ignored (:struct struct-pair)))
-
-(deftest fsbv.return-a-pointer
- (let ((ptr (returnpairpointer '(1 . 2))))
- (+ (foreign-slot-value ptr '(:struct struct-pair) 'a)
- (foreign-slot-value ptr '(:struct struct-pair) 'b)))
- 42)
-
-;;; Test ulonglong on no-long-long implementations.
-
-(defcfun "ullsum" :unsigned-long-long
- (a :unsigned-long-long) (b :unsigned-long-long))
-
-(deftest fsbv.6
- (ullsum #x10DEADBEEF #x2300000000)
- #x33DEADBEEF)
-
-;;; Combine structures by value with a string argument
-(defcfun "stringlenpair" (:struct struct-pair)
- (s :string)
- (p (:struct struct-pair)))
-
-(deftest fsbv.7
- (stringlenpair "abc" '(1 . 2))
- (3 . 6))
-
-;;; Combine structures by value with an enum argument
-(defcfun "enumpair" (:int)
- (e numeros)
- (p (:struct struct-pair)))
-
-(deftest fsbv.8
- (enumpair :two '(1 . 2))
- 5)
-
-;;; returning struct with bitfield member (bug #1474631)
-(defbitfield (struct-bitfield :unsigned-int)
- (:a 1)
- (:b 2))
-
-(defcstruct bitfield-struct
- (b struct-bitfield))
-
-(defcfun "structbitfield" (:struct bitfield-struct)
- (x :unsigned-int))
-
-(defctype struct-bitfield-typedef struct-bitfield)
-
-(defcstruct bitfield-struct.2
- (b struct-bitfield-typedef))
-
-(defcfun ("structbitfield" structbitfield.2) (:struct bitfield-struct.2)
- (x :unsigned-int))
-
-;; these would get stuck in an infinite loop previously
-(deftest fsbv.struct-bitfield.0
- (structbitfield 0)
- (b nil))
-
-(deftest fsbv.struct-bitfield.1
- (structbitfield 1)
- (b (:a)))
-
-(deftest fsbv.struct-bitfield.2
- (structbitfield 2)
- (b (:b)))
-
-(deftest fsbv.struct-bitfield.3
- (structbitfield.2 2)
- (b (:b)))
-
-;;; Test for a discrepancy between normal and fsbv return values
-(cffi:define-foreign-type int-return-code (cffi::foreign-type-alias)
- ()
- (:default-initargs :actual-type (cffi::parse-type :int))
- (:simple-parser int-return-code))
-
-(defmethod cffi:expand-from-foreign (value (type int-return-code))
- ;; NOTE: strictly speaking it should be
- ;; (cffi:convert-from-foreign ,value :int), but it's irrelevant in this case
- `(let ((return-code ,value))
- (check-type return-code integer)
- return-code))
-
-(defcfun (noargs-with-typedef "noargs") int-return-code)
-
-(deftest fsbv.noargs-with-typedef ; for reference, not an FSBV call
- (noargs-with-typedef)
- 42)
-
-(defcfun (sumpair-with-typedef "sumpair") int-return-code
- (p (:struct struct-pair)))
-
-(deftest (fsbv.return-value-typedef)
- (sumpair-with-typedef '(40 . 2))
- 42)
(DIR) diff --git a/3rdparties/software/cffi_0.20.0/tests/funcall.lisp b/3rdparties/software/cffi_0.20.0/tests/funcall.lisp
@@ -1,245 +0,0 @@
-;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
-;;;
-;;; funcall.lisp --- Tests function calling.
-;;;
-;;; Copyright (C) 2005-2006, James Bielman <jamesjb@jamesjb.com>
-;;; Copyright (C) 2005-2007, Luis Oliveira <loliveira@common-lisp.net>
-;;;
-;;; Permission is hereby granted, free of charge, to any person
-;;; obtaining a copy of this software and associated documentation
-;;; files (the "Software"), to deal in the Software without
-;;; restriction, including without limitation the rights to use, copy,
-;;; modify, merge, publish, distribute, sublicense, and/or sell copies
-;;; of the Software, and to permit persons to whom the Software is
-;;; furnished to do so, subject to the following conditions:
-;;;
-;;; The above copyright notice and this permission notice shall be
-;;; included in all copies or substantial portions of the Software.
-;;;
-;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
-;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
-;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
-;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
-;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
-;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
-;;; DEALINGS IN THE SOFTWARE.
-;;;
-
-(in-package #:cffi-tests)
-
-;;;# Calling with Built-In C Types
-;;;
-;;; Tests calling standard C library functions both passing and
-;;; returning each built-in type.
-
-;;; Don't run these tests if the implementation does not support
-;;; foreign-funcall.
-#-cffi-sys::no-foreign-funcall
-(progn
-
-(deftest funcall.char
- (foreign-funcall "toupper" :char (char-code #\a) :char)
- #.(char-code #\A))
-
-(deftest funcall.int.1
- (foreign-funcall "abs" :int -100 :int)
- 100)
-
-(defun funcall-abs (n)
- (foreign-funcall "abs" :int n :int))
-
-;;; regression test: lispworks's %foreign-funcall based on creating
-;;; and caching foreign-funcallables at macro-expansion time.
-(deftest funcall.int.2
- (funcall-abs -42)
- 42)
-
-(deftest funcall.long
- (foreign-funcall "labs" :long -131072 :long)
- 131072)
-
-#-cffi-sys::no-long-long
-(deftest funcall.long-long
- (foreign-funcall "my_llabs" :long-long -9223372036854775807 :long-long)
- 9223372036854775807)
-
-#-cffi-sys::no-long-long
-(deftest funcall.unsigned-long-long
- (let ((ullong-max (1- (expt 2 (* 8 (foreign-type-size :unsigned-long-long))))))
- (eql ullong-max
- (foreign-funcall "ullong" :unsigned-long-long ullong-max
- :unsigned-long-long)))
- t)
-
-(deftest funcall.float
- (foreign-funcall "my_sqrtf" :float 16.0 :float)
- 4.0)
-
-(deftest funcall.double
- (foreign-funcall "sqrt" :double 36.0d0 :double)
- 6.0d0)
-
-#+(and scl long-float)
-(deftest funcall.long-double
- (foreign-funcall "sqrtl" :long-double 36.0l0 :long-double)
- 6.0l0)
-
-(deftest funcall.string.1
- (foreign-funcall "strlen" :string "Hello" :int)
- 5)
-
-(deftest funcall.string.2
- (with-foreign-pointer-as-string (s 100)
- (setf (mem-ref s :char) 0)
- (foreign-funcall "strcpy" :pointer s :string "Hello" :pointer)
- (foreign-funcall "strcat" :pointer s :string ", world!" :pointer))
- "Hello, world!")
-
-(deftest funcall.string.3
- (with-foreign-pointer (ptr 100)
- (lisp-string-to-foreign "Hello, " ptr 8)
- (foreign-funcall "strcat" :pointer ptr :string "world!" :string))
- "Hello, world!")
-
-;;;# Calling Varargs Functions
-
-(deftest funcall.varargs.nostdlib
- (foreign-funcall-varargs
- "sum_double_arbitrary" (:int 26)
- :double 3.14d0 :double 3.14d0 :double 3.14d0 :double 3.14d0
- :double 3.14d0 :double 3.14d0 :double 3.14d0 :double 3.14d0
- :double 3.14d0 :double 3.14d0 :double 3.14d0 :double 3.14d0
- :double 3.14d0 :double 3.14d0 :double 3.14d0 :double 3.14d0
- :double 3.14d0 :double 3.14d0 :double 3.14d0 :double 3.14d0
- :double 3.14d0 :double 3.14d0 :double 3.14d0 :double 3.14d0
- :double 3.14d0 :double 3.14d0
- :double)
- 81.64d0)
-
-;; The CHAR argument must be passed as :INT because chars are promoted
-;; to ints when passed as variable arguments.
-(deftest funcall.varargs.char
- (with-foreign-pointer-as-string (s 100)
- (setf (mem-ref s :char) 0)
- (foreign-funcall-varargs
- "sprintf" (:pointer s :string "%c") :int 65 :int))
- "A")
-
-(deftest funcall.varargs.int
- (with-foreign-pointer-as-string (s 100)
- (setf (mem-ref s :char) 0)
- (foreign-funcall-varargs
- "sprintf" (:pointer s :string "%d") :int 1000 :int))
- "1000")
-
-(deftest funcall.varargs.long
- (with-foreign-pointer-as-string (s 100)
- (setf (mem-ref s :char) 0)
- (foreign-funcall-varargs
- "sprintf" (:pointer s :string "%ld")
- :long 131072 :int))
- "131072")
-
-;;; There is no FUNCALL.VARARGS.FLOAT as floats are promoted to double
-;;; when passed as variable arguments. Currently this fails in SBCL
-;;; and CMU CL on Darwin/ppc.
-(deftest funcall.varargs.double
- (with-foreign-pointer-as-string (s 100)
- (setf (mem-ref s :char) 0)
- (foreign-funcall-varargs
- "sprintf" (:pointer s :string "%.2f") :double (coerce pi 'double-float) :int))
- "3.14")
-
-#+(and scl long-float)
-(deftest funcall.varargs.long-double
- (with-foreign-pointer-as-string (s 100)
- (setf (mem-ref s :char) 0)
- (foreign-funcall-varargs
- "sprintf" :pointer s :string "%.2Lf" :long-double pi :int))
- "3.14")
-
-(deftest funcall.varargs.string
- (with-foreign-pointer-as-string (s 100)
- (setf (mem-ref s :char) 0)
- (foreign-funcall-varargs
- "sprintf" (:pointer s :string "%s, %s!") :string "Hello" :string "world" :int))
- "Hello, world!")
-
-;;; See DEFCFUN.DOUBLE26.
-(deftest funcall.double26
- (foreign-funcall "sum_double26"
- :double 3.14d0 :double 3.14d0 :double 3.14d0
- :double 3.14d0 :double 3.14d0 :double 3.14d0
- :double 3.14d0 :double 3.14d0 :double 3.14d0
- :double 3.14d0 :double 3.14d0 :double 3.14d0
- :double 3.14d0 :double 3.14d0 :double 3.14d0
- :double 3.14d0 :double 3.14d0 :double 3.14d0
- :double 3.14d0 :double 3.14d0 :double 3.14d0
- :double 3.14d0 :double 3.14d0 :double 3.14d0
- :double 3.14d0 :double 3.14d0 :double)
- 81.64d0)
-
-;;; See DEFCFUN.FLOAT26.
-(deftest funcall.float26
- (foreign-funcall "sum_float26"
- :float 5.0 :float 5.0 :float 5.0 :float 5.0 :float 5.0
- :float 5.0 :float 5.0 :float 5.0 :float 5.0 :float 5.0
- :float 5.0 :float 5.0 :float 5.0 :float 5.0 :float 5.0
- :float 5.0 :float 5.0 :float 5.0 :float 5.0 :float 5.0
- :float 5.0 :float 5.0 :float 5.0 :float 5.0 :float 5.0
- :float 5.0 :float)
- 130.0)
-
-;;; Funcalling a pointer.
-(deftest funcall.f-s-p.1
- (foreign-funcall-pointer (foreign-symbol-pointer "abs") nil :int -42 :int)
- 42)
-
-;;;# Namespaces
-
-#-cffi-sys::flat-namespace
-(deftest funcall.namespace.1
- (values (foreign-funcall ("ns_function" :library libtest) :boolean)
- (foreign-funcall ("ns_function" :library libtest2) :boolean))
- t nil)
-
-;;;# stdcall
-
-#+(and x86 windows (not cffi-sys::no-stdcall))
-(deftest funcall.stdcall.1
- (flet ((fun ()
- (foreign-funcall ("stdcall_fun@12" :convention :stdcall)
- :int 1 :int 2 :int 3 :int)))
- (loop repeat 100 do (fun)
- finally (return (fun))))
- 6)
-
-;;; RT: NIL arguments are skipped
-
-(defvar *nil-skipped*)
-
-(define-foreign-type check-nil-skip-type ()
- ()
- (:actual-type :pointer)
- (:simple-parser check-nil-skip-type))
-
-(defmethod expand-to-foreign (val (type check-nil-skip-type))
- (declare (ignore val))
- (setf *nil-skipped* nil)
- (null-pointer))
-
-(deftest funcall.nil-skip
- (let ((*nil-skipped* t))
- (compile nil '(lambda ()
- (foreign-funcall "abs" check-nil-skip-type nil)))
- *nil-skipped*)
- nil)
-
-;;; RT: CLISP returns NIL instead of a null-pointer
-
-(deftest funcall.pointer-not-nil
- (not (null (foreign-funcall "strchr" :string "" :int 1 :pointer)))
- t)
-
-) ;; #-cffi-sys::no-foreign-funcall
(DIR) diff --git a/3rdparties/software/cffi_0.20.0/tests/grovel.lisp b/3rdparties/software/cffi_0.20.0/tests/grovel.lisp
@@ -1,96 +0,0 @@
-;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
-;;;
-;;; grovel.lisp --- CFFI-Grovel tests.
-;;;
-;;; Copyright (C) 2014, Luis Oliveira <loliveira@common-lisp.net>
-;;;
-;;; Permission is hereby granted, free of charge, to any person
-;;; obtaining a copy of this software and associated documentation
-;;; files (the "Software"), to deal in the Software without
-;;; restriction, including without limitation the rights to use, copy,
-;;; modify, merge, publish, distribute, sublicense, and/or sell copies
-;;; of the Software, and to permit persons to whom the Software is
-;;; furnished to do so, subject to the following conditions:
-;;;
-;;; The above copyright notice and this permission notice shall be
-;;; included in all copies or substantial portions of the Software.
-;;;
-;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
-;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
-;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
-;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
-;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
-;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
-;;; DEALINGS IN THE SOFTWARE.
-;;;
-
-(in-package #:cffi-tests)
-
-(deftest %invoke
- (cffi-grovel::invoke "echo" "test")
- nil nil 0)
-
-(defun grovel-forms (forms &key (quiet t))
- (uiop:with-temporary-file (:stream grovel-stream :pathname grovel-file)
- (with-standard-io-syntax
- (with-open-stream (*standard-output* grovel-stream)
- (let ((*package* (find-package :keyword)))
- (mapc #'write forms))))
- (let ((lisp-file (let ((*debug-io* (if quiet (make-broadcast-stream) *debug-io*)))
- (cffi-grovel:process-grovel-file grovel-file))))
- (unwind-protect
- (load lisp-file)
- (uiop:delete-file-if-exists lisp-file)))))
-
-(defun bug-1395242-helper (enum-type base-type constant-name)
- (check-type enum-type (member constantenum cenum))
- (check-type base-type string)
- (check-type constant-name string)
- (let ((enum-name (intern (symbol-name (gensym))))
- (base-type-name (intern (symbol-name (gensym)))))
- (grovel-forms `((ctype ,base-type-name ,base-type)
- (,enum-type (,enum-name :base-type ,base-type-name)
- ((:value ,constant-name)))))
- (cffi:foreign-enum-value enum-name :value)))
-
-(deftest bug-1395242
- (labels
- ((process-expression (expression)
- (loop for enum-type in '(constantenum cenum)
- always (destructuring-bind (base-type &rest evaluations) expression
- (loop for (name expected-value) in evaluations
- for actual-value = (bug-1395242-helper enum-type base-type name)
- always (or (= expected-value actual-value)
- (progn
- (format *error-output*
- "Test failed for case: ~A, ~A, ~A (expected ~A, actual ~A)~%"
- enum-type base-type name expected-value actual-value)
- nil)))))))
- (every #'process-expression
- '(("uint8_t" ("UINT8_MAX" 255) ("INT8_MAX" 127) ("INT8_MIN" 128))
- ("int8_t" ("INT8_MIN" -128) ("INT8_MAX" 127) ("UINT8_MAX" -1))
- ("uint16_t" ("UINT16_MAX" 65535) ("INT8_MIN" 65408))
- ("int16_t" ("INT16_MIN" -32768) ("INT16_MAX" 32767) ("UINT16_MAX" -1))
- ("uint32_t" ("UINT32_MAX" 4294967295) ("INT8_MIN" 4294967168))
- ("int32_t" ("INT32_MIN" -2147483648) ("INT32_MAX" 2147483647)))))
- t)
-
-(defvar *grovelled-features*)
-
-(deftest grovel-feature
- (let ((*grovelled-features* nil))
- (grovel-forms `((in-package :cffi-tests)
- (include "limits.h")
- (feature grovel-test-feature "CHAR_BIT")
- (feature :char-bit "CHAR_BIT"
- :feature-list *grovelled-features*)
- (feature :inexistent-grovel-feature
- "INEXISTENT_CFFI_GROVEL_FEATURE"
- :feature-list *grovelled-features*)))
- (unwind-protect
- (values (and (member 'grovel-test-feature *features*) t)
- (and (member :char-bit *grovelled-features*) t)
- (member :inexistent-grovel-feature *grovelled-features*))
- (alexandria:removef *features* 'grovel-test-feature)))
- t t nil)
(DIR) diff --git a/3rdparties/software/cffi_0.20.0/tests/libfsbv.c b/3rdparties/software/cffi_0.20.0/tests/libfsbv.c
@@ -1,179 +0,0 @@
-/* -*- Mode: C; tab-width: 4; indent-tabs-mode: nil -*-
- *
- * libfsbv.c --- auxiliary C lib for testing foreign structure by value calls
- *
- * Copyright (C) 2011, 2015 Liam M. Healy
- *
- * Permission is hereby granted, free of charge, to any person
- * obtaining a copy of this software and associated documentation
- * files (the "Software"), to deal in the Software without
- * restriction, including without limitation the rights to use, copy,
- * modify, merge, publish, distribute, sublicense, and/or sell copies
- * of the Software, and to permit persons to whom the Software is
- * furnished to do so, subject to the following conditions:
- *
- * The above copyright notice and this permission notice shall be
- * included in all copies or substantial portions of the Software.
- *
- * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
- * EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
- * MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
- * NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
- * HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
- * WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
- * OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
- * DEALINGS IN THE SOFTWARE.
- */
-
-#ifdef WIN32
-#define DLLEXPORT __declspec(dllexport)
-#else
-#define DLLEXPORT
-#endif
-
-#include <stdio.h>
-#include <limits.h>
-#include <string.h>
-#include <stdlib.h>
-#include <stdbool.h>
-#include <math.h>
-#include <float.h>
-
-/* MSVC doesn't have stdint.h and uses a different syntax for stdcall */
-#ifndef _MSC_VER
-#include <stdint.h>
-#endif
-
-#ifdef WIN32
-#ifdef _MSC_VER
-#define STDCALL __stdcall
-#else
-#define STDCALL __attribute__((stdcall))
-#endif
-#else
-#define STDCALL
-#endif
-
-struct struct_pair {
- int a;
- int b;
-};
-
-struct struct_pair_double {
- struct struct_pair pr;
- double dbl;
-};
-
-typedef enum {
- ONE = 1,
- TWO,
- THREE,
- FOUR,
- FORTY_ONE = 41,
- FORTY_TWO
-} numeros;
-
-int sumpair (struct struct_pair sp);
-int enumpair (numeros mynum, struct struct_pair sp);
-struct struct_pair doublepair (struct struct_pair dp);
-double prodsumpair (struct struct_pair_double spd);
-struct struct_pair_double doublepairdouble (struct struct_pair_double pd);
-
-DLLEXPORT
-int sumpair (struct struct_pair sp)
-{
- return sp.a + sp.b;
-}
-
-DLLEXPORT
-int enumpair (numeros mynum, struct struct_pair sp)
-{
- if ( mynum == ONE )
- {
- return sp.a + sp.b;
- }
- else if ( mynum == TWO )
- {
- return sp.a + 2*sp.b;
- }
- else if ( mynum == THREE )
- {
- return 2*sp.a + sp.b;
- }
- else if ( mynum == FOUR )
- {
- return 2*sp.a + 2*sp.b;
- }
- else
- {
- return 41*sp.a + 42*sp.b;
- }
-}
-
-DLLEXPORT
-struct struct_pair makepair (bool cond)
-{
- struct struct_pair ret;
- ret.a = -127;
- ret.b = cond ? 42 : 43;
- return ret;
-}
-
-const struct struct_pair static_pair = { 40, 2};
-
-DLLEXPORT
-struct struct_pair * returnpairpointer (struct struct_pair ignored)
-{
- return &static_pair;
-}
-
-DLLEXPORT
-struct struct_pair doublepair (struct struct_pair dp)
-{
- struct struct_pair ret;
- ret.a = 2*dp.a;
- ret.b = 2*dp.b;
- return ret;
-}
-
-DLLEXPORT
-double prodsumpair (struct struct_pair_double pd)
-{
- return pd.dbl * sumpair(pd.pr);
-}
-
-DLLEXPORT
-struct struct_pair_double doublepairdouble (struct struct_pair_double pd)
-{
- struct struct_pair_double ret;
- ret.pr = doublepair(pd.pr);
- ret.dbl = 2*pd.dbl;
- return ret;
-}
-
-DLLEXPORT
-unsigned long long ullsum (unsigned long long a, unsigned long long b)
-{
- return a + b;
-}
-
-DLLEXPORT
-struct struct_pair stringlenpair (char *string, struct struct_pair dp)
-{
- struct struct_pair ret;
- int len = strlen(string);
- ret.a = len*dp.a;
- ret.b = len*dp.b;
- return ret;
-}
-
-struct bitfield_struct {
- unsigned int b;
-};
-
-DLLEXPORT
-struct bitfield_struct structbitfield (unsigned int x) {
- struct bitfield_struct ret;
- ret.b = x;
- return ret;
-}
(DIR) diff --git a/3rdparties/software/cffi_0.20.0/tests/libtest.c b/3rdparties/software/cffi_0.20.0/tests/libtest.c
@@ -1,985 +0,0 @@
-/* -*- Mode: C; tab-width: 4; indent-tabs-mode: nil -*-
- *
- * libtest.c --- auxiliary C lib for testing purposes
- *
- * Copyright (C) 2005-2007, Luis Oliveira <loliveira(@)common-lisp.net>
- *
- * Permission is hereby granted, free of charge, to any person
- * obtaining a copy of this software and associated documentation
- * files (the "Software"), to deal in the Software without
- * restriction, including without limitation the rights to use, copy,
- * modify, merge, publish, distribute, sublicense, and/or sell copies
- * of the Software, and to permit persons to whom the Software is
- * furnished to do so, subject to the following conditions:
- *
- * The above copyright notice and this permission notice shall be
- * included in all copies or substantial portions of the Software.
- *
- * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
- * EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
- * MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
- * NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
- * HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
- * WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
- * OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
- * DEALINGS IN THE SOFTWARE.
- */
-
-#ifdef WIN32
-#define DLLEXPORT __declspec(dllexport)
-#else
-#define DLLEXPORT
-#endif
-
-#include <stdio.h>
-#include <limits.h>
-#include <string.h>
-#include <stdlib.h>
-#include <math.h>
-#include <float.h>
-#include <stdbool.h>
-#include <stdarg.h>
-
-/* MSVC doesn't have stdint.h and uses a different syntax for stdcall */
-#ifndef _MSC_VER
-#include <stdint.h>
-#endif
-
-#ifdef WIN32
-#ifdef _MSC_VER
-#define STDCALL __stdcall
-#else
-#define STDCALL __attribute__((stdcall))
-#endif
-#else
-#define STDCALL
-#endif
-
-/*
- * Some functions that aren't available on WIN32
- */
-
-DLLEXPORT
-float my_sqrtf(float n)
-{
- return (float) sqrt((double) n);
-}
-
-DLLEXPORT
-char *my_strdup(const char *str)
-{
- char *p = malloc(strlen(str) + 1);
- strcpy(p, str);
- return p;
-}
-
-DLLEXPORT
-void my_strfree(char *str)
-{
- free(str);
-}
-
-DLLEXPORT
-long long my_llabs(long long n)
-{
- return n < 0 ? -n : n;
-}
-
-
-DLLEXPORT
-unsigned long long ullong(unsigned long long n)
-{
- return n == ULLONG_MAX ? n : 42;
-}
-
-/*
- * Foreign Globals
- *
- * (var_int is used in MISC-TYPES.EXPAND.3 as well)
- */
-
-DLLEXPORT char * dll_version = "20120107";
-
-/* TODO: look into signed char vs. unsigned char issue */
-DLLEXPORT char var_char = -127;
-DLLEXPORT unsigned char var_unsigned_char = 255;
-DLLEXPORT short var_short = -32767;
-DLLEXPORT unsigned short var_unsigned_short = 65535;
-DLLEXPORT int var_int = -32767;
-DLLEXPORT unsigned int var_unsigned_int = 65535;
-DLLEXPORT long var_long = -2147483647L;
-DLLEXPORT unsigned long var_unsigned_long = 4294967295UL;
-DLLEXPORT float var_float = 42.0f;
-DLLEXPORT double var_double = 42.0;
-DLLEXPORT void * var_pointer = NULL;
-DLLEXPORT char * var_string = "Hello, foreign world!";
-
-DLLEXPORT long long var_long_long = -9223372036854775807LL;
-DLLEXPORT unsigned long long var_unsigned_long_long = 18446744073709551615ULL;
-
-DLLEXPORT float float_max = FLT_MAX;
-DLLEXPORT float float_min = FLT_MIN;
-DLLEXPORT double double_max = DBL_MAX;
-DLLEXPORT double double_min = DBL_MIN;
-
-/*
- * Callbacks
- */
-
-DLLEXPORT
-int expect_char_sum(char (*f)(char, char))
-{
- return f('a', 3) == 'd';
-}
-
-DLLEXPORT
-int expect_unsigned_char_sum(unsigned char (*f)(unsigned char, unsigned char))
-{
- return f(UCHAR_MAX-1, 1) == UCHAR_MAX;
-}
-
-DLLEXPORT
-int expect_short_sum(short (*f)(short a, short b))
-{
- return f(SHRT_MIN+1, -1) == SHRT_MIN;
-}
-
-DLLEXPORT
-int expect_unsigned_short_sum(unsigned short (*f)(unsigned short,
- unsigned short))
-{
- return f(USHRT_MAX-1, 1) == USHRT_MAX;
-}
-
-/* used in MISC-TYPES.EXPAND.4 as well */
-DLLEXPORT
-int expect_int_sum(int (*f)(int, int))
-{
- return f(INT_MIN+1, -1) == INT_MIN;
-}
-
-DLLEXPORT
-int expect_unsigned_int_sum(unsigned int (*f)(unsigned int, unsigned int))
-{
- return f(UINT_MAX-1, 1) == UINT_MAX;
-}
-
-DLLEXPORT
-int expect_long_sum(long (*f)(long, long))
-{
- return f(LONG_MIN+1, -1) == LONG_MIN;
-}
-
-DLLEXPORT
-int expect_unsigned_long_sum(unsigned long (*f)(unsigned long, unsigned long))
-{
- return f(ULONG_MAX-1, 1) == ULONG_MAX;
-}
-
-DLLEXPORT
-int expect_long_long_sum(long long (*f)(long long, long long))
-{
- return f(LLONG_MIN+1, -1) == LLONG_MIN;
-}
-
-DLLEXPORT
-int expect_unsigned_long_long_sum (unsigned long long
- (*f)(unsigned long long, unsigned long long))
-{
- return f(ULLONG_MAX-1, 1) == ULLONG_MAX;
-}
-
-DLLEXPORT
-int expect_float_sum(float (*f)(float, float))
-{
- /*printf("\n>>> FLOAT: %f <<<\n", f(20.0f, 22.0f));*/
- return f(20.0f, 22.0f) == 42.0f;
-}
-
-DLLEXPORT
-int expect_double_sum(double (*f)(double, double))
-{
- /*printf("\n>>> DOUBLE: %f<<<\n", f(-20.0, -22.0));*/
- return f(-20.0, -22.0) == -42.0;
-}
-
-DLLEXPORT
-int expect_long_double_sum(long double (*f)(long double, long double))
-{
- /*printf("\n>>> DOUBLE: %f<<<\n", f(-20.0, -22.0));*/
- return f(-20.0, -22.0) == -42.0;
-}
-
-DLLEXPORT
-int expect_pointer_sum(void* (*f)(void*, int))
-{
- return f(NULL, 0xDEAD) == (void *) 0xDEAD;
-}
-
-DLLEXPORT
-int expect_strcat(char* (*f)(char*, char*))
-{
- char *ret = f("Hello, ", "C world!");
- int res = strcmp(ret, "Hello, C world!") == 0;
- /* commented out as a quick fix on platforms that don't
- foreign allocate in C malloc space. */
- /*free(ret);*/ /* is this allowed? */
- return res;
-}
-
-DLLEXPORT
-void pass_int_ref(void (*f)(int*))
-{
- int x = 1984;
- f(&x);
-}
-
-/*
- * Enums
- */
-
-typedef enum {
- ONE = 1,
- TWO,
- THREE,
- FOUR,
- FORTY_ONE = 41,
- FORTY_TWO
-} numeros;
-
-DLLEXPORT
-int check_enums(numeros one, numeros two, numeros three, numeros four,
- numeros forty_one, numeros forty_two)
-{
- if (one == ONE && two == TWO && three == THREE && four == FOUR &&
- forty_one == FORTY_ONE && forty_two == FORTY_TWO)
- return 1;
-
- return 0;
-}
-
-typedef enum { FALSE, TRUE } another_boolean;
-
-DLLEXPORT
-another_boolean return_enum(int x)
-{
- if (x == 0)
- return FALSE;
- else
- return TRUE;
-}
-
-/*
- * Booleans
- */
-
-DLLEXPORT
-int equalequal(int a, unsigned int b)
-{
- return ((unsigned int) a) == b;
-}
-
-DLLEXPORT
-char bool_and(unsigned char a, char b)
-{
- return a && b;
-}
-
-DLLEXPORT
-unsigned long bool_xor(long a, unsigned long b)
-{
- return (a && !b) || (!a && b);
-}
-
-DLLEXPORT
-unsigned sizeof_bool(void)
-{
- return (unsigned) sizeof(_Bool);
-}
-
-DLLEXPORT
-unsigned bool_to_unsigned(_Bool b)
-{
- return (unsigned) b;
-}
-
-DLLEXPORT
-_Bool unsigned_to_bool(unsigned u)
-{
- return (_Bool) u;
-}
-
-/*
- * Test struct alignment issues. These comments assume the x86 gABI.
- * Hopefully these tests will spot alignment issues in others archs
- * too.
- */
-
-/*
- * STRUCT.ALIGNMENT.1
- */
-
-struct s_ch {
- char a_char;
-};
-
-/* This struct's size should be 2 bytes */
-struct s_s_ch {
- char another_char;
- struct s_ch a_s_ch;
-};
-
-DLLEXPORT
-struct s_s_ch the_s_s_ch = { 2, { 1 } };
-
-/*
- * STRUCT.ALIGNMENT.2
- */
-
-/* This one should be alignment should be the same as short's alignment. */
-struct s_short {
- char a_char;
- char another_char;
- short a_short;
-};
-
-struct s_s_short {
- char yet_another_char;
- struct s_short a_s_short; /* so this should be 2-byte aligned */
-}; /* size: 6 bytes */
-
-DLLEXPORT
-struct s_s_short the_s_s_short = { 4, { 1, 2, 3 } };
-
-/*
- * STRUCT.ALIGNMENT.3
- */
-
-/* This test will, among other things, check for the existence tail padding. */
-
-struct s_double {
- char a_char; /* 1 byte */
- /* padding: 3 bytes */
- double a_double; /* 8 bytes */
- char another_char; /* 1 byte */
- /* padding: 3 bytes */
-}; /* total size: 16 bytes */
-
-struct s_s_double {
- char yet_another_char; /* 1 byte */
- /* 3 bytes padding */
- struct s_double a_s_double; /* 16 bytes */
- short a_short; /* 2 byte */
- /* 2 bytes padding */
-}; /* total size: 24 bytes */
-
-DLLEXPORT
-struct s_s_double the_s_s_double = { 4, { 1, 2.0, 3 }, 5 };
-
-/*
- * STRUCT.ALIGNMENT.4
- */
-struct s_s_s_double {
- short another_short; /* 2 bytes */
- /* 2 bytes padding */
- struct s_s_double a_s_s_double; /* 24 bytes */
- char last_char; /* 1 byte */
- /* 3 bytes padding */
-}; /* total size: 32 */
-
-DLLEXPORT
-struct s_s_s_double the_s_s_s_double = { 6, { 4, { 1, 2.0, 3 }, 5 }, 7 };
-
-/*
- * STRUCT.ALIGNMENT.5
- */
-
-/* MacOSX ABI says: "The embedding alignment of the first element in a data
- structure is equal to the element's natural alignment." and "For subsequent
- elements that have a natural alignment greater than 4 bytes, the embedding
- alignment is 4, unless the element is a vector." */
-
-/* note: these rules will apply to the structure itself. So, unless it is
- the first element of another structure, its alignment will be 4. */
-
-/* the following offsets and sizes are specific to darwin/ppc32 */
-
-struct s_double2 {
- double a_double; /* 8 bytes (alignment 8) */
- short a_short; /* 2 bytes */
- /* 6 bytes padding */
-}; /* total size: 16 */
-
-struct s_s_double2 {
- char a_char; /* 1 byte */
- /* 3 bytes padding */
- struct s_double2 a_s_double2; /* 16 bytes, alignment 4 */
- short another_short; /* 2 bytes */
- /* 2 bytes padding */
-}; /* total size: 24 bytes */
- /* alignment: 4 */
-
-DLLEXPORT
-struct s_s_double2 the_s_s_double2 = { 3, { 1.0, 2 }, 4 };
-
-/*
- * STRUCT.ALIGNMENT.6
- */
-
-/* Same as STRUCT.ALIGNMENT.5 but with long long. */
-
-struct s_long_long {
- long long a_long_long; /* 8 bytes (alignment 8) */
- short a_short; /* 2 bytes */
- /* 6 bytes padding */
-}; /* total size: 16 */
-
-struct s_s_long_long {
- char a_char; /* 1 byte */
- /* 3 bytes padding */
- struct s_long_long a_s_long_long; /* 16 bytes, alignment 4 */
- short a_short; /* 2 bytes */
- /* 2 bytes padding */
-}; /* total size: 24 bytes */
- /* alignment: 4 */
-
-DLLEXPORT
-struct s_s_long_long the_s_s_long_long = { 3, { 1, 2 }, 4 };
-
-/*
- * STRUCT.ALIGNMENT.7
- */
-
-/* Another test for Darwin's PPC32 ABI. */
-
-struct s_s_double3 {
- struct s_double2 a_s_double2; /* 16 bytes, alignment 8*/
- short another_short; /* 2 bytes */
- /* 6 bytes padding */
-}; /* total size: 24 */
-
-struct s_s_s_double3 {
- struct s_s_double3 a_s_s_double3; /* 24 bytes */
- char a_char; /* 1 byte */
- /* 7 bytes padding */
-}; /* total size: 32 */
-
-DLLEXPORT
-struct s_s_s_double3 the_s_s_s_double3 = { { { 1.0, 2 }, 3 }, 4 };
-
-/*
- * STRUCT.ALIGNMENT.8
- */
-
-/* Same as STRUCT.ALIGNMENT.[56] but with unsigned long long. */
-
-struct s_unsigned_long_long {
- unsigned long long an_unsigned_long_long; /* 8 bytes (alignment 8) */
- short a_short; /* 2 bytes */
- /* 6 bytes padding */
-}; /* total size: 16 */
-
-struct s_s_unsigned_long_long {
- char a_char; /* 1 byte */
- /* 3 bytes padding */
- struct s_unsigned_long_long a_s_unsigned_long_long; /* 16 bytes, align 4 */
- short a_short; /* 2 bytes */
- /* 2 bytes padding */
-}; /* total size: 24 bytes */
- /* alignment: 4 */
-
-DLLEXPORT
-struct s_s_unsigned_long_long the_s_s_unsigned_long_long = { 3, { 1, 2 }, 4 };
-
-/* STRUCT.ALIGNMENT.x */
-
-/* commented this test out because this is not standard C
- and MSVC++ (or some versions of it at least) won't compile it. */
-
-/*
-struct empty_struct {};
-
-struct with_empty_struct {
- struct empty_struct foo;
- int an_int;
-};
-
-DLLEXPORT
-struct with_empty_struct the_with_empty_struct = { {}, 42 };
-*/
-
-/*
- * STRUCT-VALUES.*
- */
-
-struct pair { int a, b; };
-
-DLLEXPORT
-int pair_sum(struct pair p)
-{
- return p.a + p.b;
-}
-
-DLLEXPORT
-int pair_pointer_sum(struct pair *p)
-{
- return p->a + p->b;
-}
-
-DLLEXPORT
-struct pair make_pair(int a, int b)
-{
- return (struct pair) { a, b };
-}
-
-DLLEXPORT
-struct pair *alloc_pair(int a, int b)
-{
- struct pair *p = malloc(sizeof(struct pair));
- p->a = a;
- p->b = b;
- return p;
-}
-
-struct pair_plus_one {
- struct pair p;
- int c;
-};
-
-DLLEXPORT
-int pair_plus_one_sum(struct pair_plus_one p)
-{
- return p.p.a + p.p.b + p.c;
-}
-
-DLLEXPORT
-int pair_plus_one_pointer_sum(struct pair_plus_one *p)
-{
- return p->p.a + p->p.b + p->c;
-}
-
-DLLEXPORT
-struct pair_plus_one make_pair_plus_one(int a, int b, int c)
-{
- return (struct pair_plus_one) { { a, b }, c };
-}
-
-DLLEXPORT
-struct pair_plus_one *alloc_pair_plus_one(int a, int b, int c)
-{
- struct pair_plus_one *p = malloc(sizeof(struct pair_plus_one));
- p->p.a = a;
- p->p.b = b;
- p->c = c;
- return p;
-}
-
-/*
- * DEFCFUN.NOARGS and DEFCFUN.NOOP
- */
-
-DLLEXPORT
-int noargs()
-{
- return 42;
-}
-
-DLLEXPORT
-void noop()
-{
- return;
-}
-
-/*
- * DEFCFUN.BFF.1
- *
- * (let ((rettype (find-type :long))
- * (arg-types (n-random-types-no-ll 127)))
- * (c-function rettype arg-types)
- * (gen-function-test rettype arg-types))
- */
-
-DLLEXPORT long sum_127_no_ll
- (long a1, unsigned long a2, short a3, unsigned short a4, float a5,
- double a6, unsigned long a7, float a8, unsigned char a9, unsigned
- short a10, short a11, unsigned long a12, double a13, long a14,
- unsigned int a15, void* a16, unsigned int a17, unsigned short a18,
- long a19, float a20, void* a21, float a22, int a23, int a24, unsigned
- short a25, long a26, long a27, double a28, unsigned char a29, unsigned
- int a30, unsigned int a31, int a32, unsigned short a33, unsigned int
- a34, void* a35, double a36, double a37, long a38, short a39, unsigned
- short a40, long a41, char a42, long a43, unsigned short a44, void*
- a45, int a46, unsigned int a47, double a48, unsigned char a49,
- unsigned char a50, float a51, int a52, unsigned short a53, double a54,
- short a55, unsigned char a56, unsigned long a57, float a58, float a59,
- float a60, void* a61, void* a62, unsigned int a63, unsigned long a64,
- char a65, short a66, unsigned short a67, unsigned long a68, void* a69,
- float a70, double a71, long a72, unsigned long a73, short a74,
- unsigned int a75, unsigned short a76, int a77, unsigned short a78,
- char a79, double a80, short a81, unsigned char a82, float a83, char
- a84, int a85, double a86, unsigned char a87, int a88, unsigned long
- a89, double a90, short a91, short a92, unsigned int a93, unsigned char
- a94, float a95, long a96, float a97, long a98, long a99, int a100, int
- a101, unsigned int a102, char a103, char a104, unsigned short a105,
- unsigned int a106, unsigned short a107, unsigned short a108, int a109,
- long a110, char a111, double a112, unsigned int a113, char a114, short
- a115, unsigned long a116, unsigned int a117, short a118, unsigned char
- a119, float a120, void* a121, double a122, int a123, long a124, char
- a125, unsigned short a126, float a127)
-{
- return (long) a1 + a2 + a3 + a4 + ((long) a5) + ((long) a6) + a7 +
- ((long) a8) + a9 + a10 + a11 + a12 + ((long) a13) + a14 + a15 +
- ((intptr_t) a16) + a17 + a18 + a19 + ((long) a20) +
- ((intptr_t) a21) + ((long) a22) + a23 + a24 + a25 + a26 + a27 +
- ((long) a28) + a29 + a30 + a31 + a32 + a33 + a34 + ((intptr_t) a35) +
- ((long) a36) + ((long) a37) + a38 + a39 + a40 + a41 + a42 + a43 + a44 +
- ((intptr_t) a45) + a46 + a47 + ((long) a48) + a49 + a50 +
- ((long) a51) + a52 + a53 + ((long) a54) + a55 + a56 + a57 + ((long) a58) +
- ((long) a59) + ((long) a60) + ((intptr_t) a61) +
- ((intptr_t) a62) + a63 + a64 + a65 + a66 + a67 + a68 +
- ((intptr_t) a69) + ((long) a70) + ((long) a71) + a72 + a73 + a74 +
- a75 + a76 + a77 + a78 + a79 + ((long) a80) + a81 + a82 + ((long) a83) +
- a84 + a85 + ((long) a86) + a87 + a88 + a89 + ((long) a90) + a91 + a92 +
- a93 + a94 + ((long) a95) + a96 + ((long) a97) + a98 + a99 + a100 + a101 +
- a102 + a103 + a104 + a105 + a106 + a107 + a108 + a109 + a110 + a111 +
- ((long) a112) + a113 + a114 + a115 + a116 + a117 + a118 + a119 +
- ((long) a120) + ((intptr_t) a121) + ((long) a122) + a123 + a124 +
- a125 + a126 + ((long) a127);
-}
-
-/*
- * DEFCFUN.BFF.2
- *
- * (let ((rettype (find-type :long-long))
- * (arg-types (n-random-types 127)))
- * (c-function rettype arg-types)
- * (gen-function-test rettype arg-types))
- */
-
-DLLEXPORT long long sum_127
- (void* a1, void* a2, float a3, unsigned long a4, void* a5, long long
- a6, double a7, double a8, unsigned short a9, int a10, long long a11,
- long a12, short a13, unsigned int a14, long a15, unsigned char a16,
- int a17, double a18, short a19, short a20, long long a21, unsigned
- int a22, unsigned short a23, short a24, void* a25, short a26,
- unsigned short a27, unsigned short a28, int a29, long long a30,
- void* a31, int a32, unsigned long a33, unsigned long a34, void* a35,
- unsigned long long a36, float a37, int a38, short a39, void* a40,
- unsigned long long a41, long long a42, unsigned long a43, unsigned
- long a44, unsigned long long a45, unsigned long a46, char a47,
- double a48, long a49, unsigned int a50, int a51, short a52, void*
- a53, long a54, unsigned long long a55, int a56, unsigned short a57,
- unsigned long long a58, float a59, void* a60, float a61, unsigned
- short a62, unsigned long a63, float a64, unsigned int a65, unsigned
- long long a66, void* a67, double a68, unsigned long long a69, double
- a70, double a71, long long a72, void* a73, unsigned short a74, long
- a75, void* a76, short a77, double a78, long a79, unsigned char a80,
- void* a81, unsigned char a82, long a83, double a84, void* a85, int
- a86, double a87, unsigned char a88, double a89, short a90, long a91,
- int a92, long a93, double a94, unsigned short a95, unsigned int a96,
- int a97, char a98, long long a99, double a100, float a101, unsigned
- long a102, short a103, void* a104, float a105, long long a106, int
- a107, long long a108, long long a109, double a110, unsigned long
- long a111, double a112, unsigned long a113, char a114, char a115,
- unsigned long a116, short a117, unsigned char a118, unsigned char
- a119, int a120, int a121, float a122, unsigned char a123, unsigned
- char a124, double a125, unsigned long long a126, char a127)
-{
- return (long long) ((intptr_t) a1) + ((intptr_t) a2) + ((long) a3) +
- a4 + ((intptr_t) a5) + a6 + ((long) a7) + ((long) a8) + a9 + a10 +
- a11 + a12 + a13 + a14 + a15 + a16 + a17 + ((long) a18) + a19 + a20 +
- a21 + a22 + a23 + a24 + ((intptr_t) a25) + a26 + a27 + a28 + a29 +
- a30 + ((intptr_t) a31) + a32 + a33 + a34 + ((intptr_t) a35) +
- a36 + ((long) a37) + a38 + a39 + ((intptr_t) a40) + a41 + a42 + a43 +
- a44 + a45 + a46 + a47 + ((long) a48) + a49 + a50 + a51 + a52 +
- ((intptr_t) a53) + a54 + a55 + a56 + a57 + a58 + ((long) a59) +
- ((intptr_t) a60) + ((long) a61) + a62 + a63 + ((long) a64) + a65 + a66
- + ((intptr_t) a67) + ((long) a68) + a69 + ((long) a70) + ((long) a71) +
- a72 + ((intptr_t) a73) + a74 + a75 + ((intptr_t) a76) + a77 +
- ((long) a78) + a79 + a80 + ((intptr_t) a81) + a82 + a83 + ((long) a84)
- + ((intptr_t) a85) + a86 + ((long) a87) + a88 + ((long) a89) + a90 +
- a91 + a92 + a93 + ((long) a94) + a95 + a96 + a97 + a98 + a99 +
- ((long) a100) + ((long) a101) + a102 + a103 + ((intptr_t) a104) +
- ((long) a105) + a106 + a107 + a108 + a109 + ((long) a110) + a111 +
- ((long) a112) + a113 + a114 + a115 + a116 + a117 + a118 + a119 + a120 +
- a121 + ((long) a122) + a123 + a124 + ((long) a125) + a126 + a127;
-}
-
-/*
- * CALLBACKS.BFF.1 (cb-test :no-long-long t)
- */
-
-DLLEXPORT long call_sum_127_no_ll
- (long (*func)
- (unsigned long, void*, long, double, unsigned long, float, float,
- int, unsigned int, double, double, double, void*, unsigned short,
- unsigned short, void*, long, long, int, short, unsigned short,
- unsigned short, char, long, void*, void*, char, unsigned char,
- unsigned long, short, int, int, unsigned char, short, long, long,
- void*, unsigned short, char, double, unsigned short, void*, short,
- unsigned long, unsigned short, float, unsigned char, short, float,
- short, char, unsigned long, unsigned long, char, float, long, void*,
- short, float, unsigned int, float, unsigned int, double, unsigned int,
- unsigned char, int, long, char, short, double, int, void*, char,
- unsigned short, void*, unsigned short, void*, unsigned long, double,
- void*, long, float, unsigned short, unsigned short, void*, float, int,
- unsigned int, double, float, long, void*, unsigned short, float,
- unsigned char, unsigned char, float, unsigned int, float, unsigned
- short, double, unsigned short, unsigned long, unsigned int, unsigned
- long, void*, unsigned char, char, char, unsigned short, unsigned long,
- float, short, void*, long, unsigned short, short, double, short, int,
- char, unsigned long, long, int, void*, double, unsigned char))
-{
- return
- func(948223085, (void *) 803308438, -465723152, 20385,
- 219679466, -10035, 13915, -1193455756, 1265303699, 27935, -18478,
- -10508, (void *) 215389089, 55561, 55472, (void *) 146070433,
- -1040819989, -17851453, -1622662247, -19473, 20837, 30216, 79,
- 986800400, (void *) 390281604, (void *) 1178532858, 19, 117,
- 78337699, -5718, -991300738, 872160910, 184, 926, -1487245383,
- 1633973783, (void *) 33738609, 53985, -116, 31645, 27196, (void *)
- 145569903, -6960, 17252220, 47404, -10491, 88, -30438, -21212,
- -1982, -16, 1175270, 7949380, -121, 8559, -432968526, (void *)
- 293455312, 11894, -8394, 142421516, -25758, 3422998, 4004,
- 15758212, 198, -1071899743, -1284904617, -11, -17219, -30039,
- 311589092, (void *) 541468577, 123, 63517, (void *) 1252504506,
- 39368, (void *) 10057868, 134781408, -7143, (void *) 72825877,
- -1190798667, -30862, 63757, 14965, (void *) 802391252, 22008,
- -517289619, 806091099, 1125, 451, -498145176, (void *) 55960931,
- 15379, 4629, 184, 254, 22532, 465856451, -1669, 49416, -16546,
- 2983, 4337541, 65292495, 39253529, (void *) 669025, 211, 85, -19,
- 24298, 65358, 16776, -29957, (void *) 124311, -163231228, 2610,
- -7806, 26434, -21913, -753615541, 120, 358697932, -1198889034,
- -2131350926, (void *) 3749492036, -13413, 17);
-}
-
-/*
- * CALLBACKS.BFF.2 (cb-test)
- */
-
-DLLEXPORT long long call_sum_127
- (long long (*func)
- (short, char, void*, float, long, double, unsigned long long,
- unsigned short, unsigned char, char, char, unsigned short, unsigned
- long long, unsigned short, long long, unsigned short, unsigned long
- long, unsigned char, unsigned char, unsigned long long, long long,
- char, float, unsigned int, float, float, unsigned int, float, char,
- unsigned char, long, long long, unsigned char, double, long,
- double, unsigned int, unsigned short, long long, unsigned int, int,
- unsigned long long, long, short, unsigned int, unsigned int,
- unsigned long long, unsigned int, long, void*, unsigned char, char,
- long long, unsigned short, unsigned int, float, unsigned char,
- unsigned long, long long, float, long, float, int, float, unsigned
- short, unsigned long long, short, unsigned long, long, char,
- unsigned short, long long, short, double, void*, unsigned int,
- char, unsigned int, void*, void*, unsigned char, void*, unsigned
- short, unsigned char, long, void*, char, long, unsigned short,
- unsigned char, double, unsigned long long, unsigned short, unsigned
- short, unsigned int, long, char, long, char, short, unsigned short,
- unsigned long, unsigned long, short, long long, long long, long
- long, double, unsigned short, unsigned char, short, unsigned char,
- long, long long, unsigned long long, unsigned int, unsigned long,
- unsigned char, long long, unsigned char, unsigned long long,
- double, unsigned char, long long, unsigned char, char, long long))
-{
- return
- func(-8573, 14, (void *) 832601021, -32334, -1532040888,
- -18478, 2793023182591311826, 2740, 230, 103, 97, 13121,
- 5112369026351511084, 7763, -8134147951003417418, 34348,
- 5776613699556468853, 19, 122, 1431603726926527625,
- 439503521880490337, -112, -21557, 1578969190, -22008, -4953,
- 2127745975, -7262, -6, 180, 226352974, -3928775366167459219, 134,
- -17730, -1175042526, 23868, 3494181009, 57364,
- 3134876875147518682, 104531655, -1286882727, 803577887579693487,
- 1349268803, 24912, 3313099419, 3907347884, 1738833249233805034,
- 2794230885, 1008818752, (void *) 1820044575, 189, 61,
- -931654560961745071, 57531, 3096859985, 10405, 220, 3631311224,
- -8531370353478907668, 31258, 678896693, -32150, -1869057813,
- -19877, 62841, 4161660185772906873, -23869, 4016251006, 610353435,
- 105, 47315, -1051054492535331660, 6846, -15163, (void *)
- 736672359, 2123928476, -122, 3859258652, (void *) 3923394833,
- (void *) 1265031970, 161, (void *) 1993867800, 55056, 122,
- 1562112760, (void *) 866615125, -79, -1261399547, 31737, 254,
- -31279, 5462649659172897980, 5202, 7644, 174224940, -337854382,
- -45, -583502442, -37, -13266, 24520, 2198606699, 2890453969,
- -8282, -2295716637858246075, -1905178488651598878,
- -6384652209316714643, 14841, 35443, 132, 15524, 187, 2138878229,
- -5153032566879951000, 9056545530140684207, 4124632010, 276167701,
- 56, -2307310370663738730, 66, 9113015627153789746, -9618, 167,
- 755753399701306200, 119, -28, -990561962725435433);
-}
-
-/*
- * CALLBACKS.DOUBLE26
- */
-
-DLLEXPORT double call_double26
- (double (*f)(double, double, double, double, double, double, double, double,
- double, double, double, double, double, double, double, double,
- double, double, double, double, double, double, double, double,
- double, double))
-{
- return f(3.14, 3.14, 3.14, 3.14, 3.14, 3.14, 3.14, 3.14, 3.14, 3.14, 3.14,
- 3.14, 3.14, 3.14, 3.14, 3.14, 3.14, 3.14, 3.14, 3.14, 3.14, 3.14,
- 3.14, 3.14, 3.14, 3.14);
-}
-
-/*
- * DEFCFUN.DOUBLE26 and FUNCALL.DOUBLE26
- */
-
-DLLEXPORT
-double sum_double26(double a1, double a2, double a3, double a4, double a5,
- double a6, double a7, double a8, double a9, double a10,
- double a11, double a12, double a13, double a14, double a15,
- double a16, double a17, double a18, double a19, double a20,
- double a21, double a22, double a23, double a24, double a25,
- double a26)
-{
- return a1 + a2 + a3 + a4 + a5 + a6 + a7 + a8 + a9 + a10 + a11 + a12 + a13 +
- a14 + a15 + a16 + a17 + a18 + a19 + a20 + a21 + a22 + a23 + a24 + a25 +
- a26;
-}
-
-/*
- * DEFCFUN.VARARGS.NOSTDLIB and FUNCALL.VARARGS.NOSTDLIB
- */
-DLLEXPORT
-double sum_double_arbitrary(int n, ...)
-{
- va_list ap;
- double sum = 0;
- va_start(ap, n);
- for(int j=0; j<n; j++)
- sum += va_arg(ap, double);
- va_end(ap);
- return sum;
-}
-
-/*
- * CALLBACKS.FLOAT26
- */
-
-DLLEXPORT float call_float26
- (float (*f)(float, float, float, float, float, float, float, float,
- float, float, float, float, float, float, float, float,
- float, float, float, float, float, float, float, float,
- float, float))
-{
- return f(5.0, 5.0, 5.0, 5.0, 5.0, 5.0, 5.0, 5.0, 5.0, 5.0, 5.0,
- 5.0, 5.0, 5.0, 5.0, 5.0, 5.0, 5.0, 5.0, 5.0, 5.0, 5.0,
- 5.0, 5.0, 5.0, 5.0);
-}
-
-/*
- * DEFCFUN.FLOAT26 and FUNCALL.FLOAT26
- */
-
-DLLEXPORT
-float sum_float26(float a1, float a2, float a3, float a4, float a5,
- float a6, float a7, float a8, float a9, float a10,
- float a11, float a12, float a13, float a14, float a15,
- float a16, float a17, float a18, float a19, float a20,
- float a21, float a22, float a23, float a24, float a25,
- float a26)
-{
- return a1 + a2 + a3 + a4 + a5 + a6 + a7 + a8 + a9 + a10 + a11 + a12 + a13 +
- a14 + a15 + a16 + a17 + a18 + a19 + a20 + a21 + a22 + a23 + a24 + a25 +
- a26;
-}
-
-/*
- * Symbol case.
- */
-
-DLLEXPORT int UPPERCASEINT1 = 12345;
-DLLEXPORT int UPPER_CASE_INT1 = 23456;
-DLLEXPORT int MiXeDCaSeInT1 = 34567;
-DLLEXPORT int MiXeD_CaSe_InT1 = 45678;
-
-DLLEXPORT int UPPERCASEINT2 = 12345;
-DLLEXPORT int UPPER_CASE_INT2 = 23456;
-DLLEXPORT int MiXeDCaSeInT2 = 34567;
-DLLEXPORT int MiXeD_CaSe_InT2 = 45678;
-
-DLLEXPORT int UPPERCASEINT3 = 12345;
-DLLEXPORT int UPPER_CASE_INT3 = 23456;
-DLLEXPORT int MiXeDCaSeInT3 = 34567;
-DLLEXPORT int MiXeD_CaSe_InT3 = 45678;
-
-/*
- * FOREIGN-SYMBOL-POINTER.1
- */
-
-DLLEXPORT int compare_against_abs(intptr_t p)
-{
- return p == (intptr_t) abs;
-}
-
-/*
- * FOREIGN-SYMBOL-POINTER.2
- */
-
-DLLEXPORT void xpto_fun() {}
-
-DLLEXPORT
-int compare_against_xpto_fun(intptr_t p)
-{
- return p == (intptr_t) xpto_fun;
-}
-
-/*
- * [DEFCFUN|FUNCALL].NAMESPACE.1
- */
-
-DLLEXPORT
-int ns_function()
-{
- return 1;
-}
-
-/*
- * FOREIGN-GLOBALS.NAMESPACE.*
- */
-
-DLLEXPORT int ns_var = 1;
-
-/*
- * DEFCFUN.STDCALL.1
- */
-
-DLLEXPORT
-int STDCALL stdcall_fun(int a, int b, int c)
-{
- return a + b + c;
-}
-
-/*
- * CALLBACKS.STDCALL.1
- */
-
-DLLEXPORT
-int call_stdcall_fun(int (STDCALL *f)(int, int, int))
-{
- int a = 42;
- f(1, 2, 3);
- return a;
-}
-
-/* Unlike the one above, this commented test below actually
- * works. But, alas, it doesn't compile with -std=c99. */
-
-/*
-DLLEXPORT
-int call_stdcall_fun(int __attribute__((stdcall)) (*f)(int, int, int))
-{
- asm("pushl $42");
- register int ebx asm("%ebx");
- f(1, 2, 3);
- asm("popl %ebx");
- return ebx;
-}
-*/
-
-/* vim: ts=4 et
-*/
(DIR) diff --git a/3rdparties/software/cffi_0.20.0/tests/libtest2.c b/3rdparties/software/cffi_0.20.0/tests/libtest2.c
@@ -1,50 +0,0 @@
-/* -*- Mode: C; tab-width: 4; indent-tabs-mode: nil -*-
- *
- * libtest2.c --- auxiliary C lib for testing purposes
- *
- * Copyright (C) 2007, Luis Oliveira <loliveira(@)common-lisp.net>
- *
- * Permission is hereby granted, free of charge, to any person
- * obtaining a copy of this software and associated documentation
- * files (the "Software"), to deal in the Software without
- * restriction, including without limitation the rights to use, copy,
- * modify, merge, publish, distribute, sublicense, and/or sell copies
- * of the Software, and to permit persons to whom the Software is
- * furnished to do so, subject to the following conditions:
- *
- * The above copyright notice and this permission notice shall be
- * included in all copies or substantial portions of the Software.
- *
- * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
- * EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
- * MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
- * NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
- * HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
- * WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
- * OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
- * DEALINGS IN THE SOFTWARE.
- */
-
-#ifdef WIN32
-#define DLLEXPORT __declspec(dllexport)
-#else
-#define DLLEXPORT
-#endif
-
-/*
- * [DEFCFUN|FOREIGN].NAMESPACE.1
- */
-
-DLLEXPORT int ns_function()
-{
- return 0;
-}
-
-/*
- * FOREIGN-GLOBALS.NAMESPACE.*
- */
-
-DLLEXPORT int ns_var = 0;
-
-/* vim: ts=4 et
-*/
(DIR) diff --git a/3rdparties/software/cffi_0.20.0/tests/memory.lisp b/3rdparties/software/cffi_0.20.0/tests/memory.lisp
@@ -1,657 +0,0 @@
-;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
-;;;
-;;; memory.lisp --- Tests for memory referencing.
-;;;
-;;; Copyright (C) 2005-2006, James Bielman <jamesjb@jamesjb.com>
-;;;
-;;; Permission is hereby granted, free of charge, to any person
-;;; obtaining a copy of this software and associated documentation
-;;; files (the "Software"), to deal in the Software without
-;;; restriction, including without limitation the rights to use, copy,
-;;; modify, merge, publish, distribute, sublicense, and/or sell copies
-;;; of the Software, and to permit persons to whom the Software is
-;;; furnished to do so, subject to the following conditions:
-;;;
-;;; The above copyright notice and this permission notice shall be
-;;; included in all copies or substantial portions of the Software.
-;;;
-;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
-;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
-;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
-;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
-;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
-;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
-;;; DEALINGS IN THE SOFTWARE.
-;;;
-
-(in-package #:cffi-tests)
-
-(deftest deref.char
- (with-foreign-object (p :char)
- (setf (mem-ref p :char) -127)
- (mem-ref p :char))
- -127)
-
-(deftest deref.unsigned-char
- (with-foreign-object (p :unsigned-char)
- (setf (mem-ref p :unsigned-char) 255)
- (mem-ref p :unsigned-char))
- 255)
-
-(deftest deref.short
- (with-foreign-object (p :short)
- (setf (mem-ref p :short) -32767)
- (mem-ref p :short))
- -32767)
-
-(deftest deref.unsigned-short
- (with-foreign-object (p :unsigned-short)
- (setf (mem-ref p :unsigned-short) 65535)
- (mem-ref p :unsigned-short))
- 65535)
-
-(deftest deref.int
- (with-foreign-object (p :int)
- (setf (mem-ref p :int) -131072)
- (mem-ref p :int))
- -131072)
-
-(deftest deref.unsigned-int
- (with-foreign-object (p :unsigned-int)
- (setf (mem-ref p :unsigned-int) 262144)
- (mem-ref p :unsigned-int))
- 262144)
-
-(deftest deref.long
- (with-foreign-object (p :long)
- (setf (mem-ref p :long) -536870911)
- (mem-ref p :long))
- -536870911)
-
-(deftest deref.unsigned-long
- (with-foreign-object (p :unsigned-long)
- (setf (mem-ref p :unsigned-long) 536870912)
- (mem-ref p :unsigned-long))
- 536870912)
-
-#+(and darwin openmcl)
-(pushnew 'deref.long-long rt::*expected-failures*)
-
-(deftest deref.long-long
- (with-foreign-object (p :long-long)
- (setf (mem-ref p :long-long) -9223372036854775807)
- (mem-ref p :long-long))
- -9223372036854775807)
-
-(deftest deref.unsigned-long-long
- (with-foreign-object (p :unsigned-long-long)
- (setf (mem-ref p :unsigned-long-long) 18446744073709551615)
- (mem-ref p :unsigned-long-long))
- 18446744073709551615)
-
-(deftest deref.float.1
- (with-foreign-object (p :float)
- (setf (mem-ref p :float) 0.0)
- (mem-ref p :float))
- 0.0)
-
-(deftest deref.float.2
- (with-foreign-object (p :float)
- (setf (mem-ref p :float) *float-max*)
- (mem-ref p :float))
- #.*float-max*)
-
-(deftest deref.float.3
- (with-foreign-object (p :float)
- (setf (mem-ref p :float) *float-min*)
- (mem-ref p :float))
- #.*float-min*)
-
-(deftest deref.double.1
- (with-foreign-object (p :double)
- (setf (mem-ref p :double) 0.0d0)
- (mem-ref p :double))
- 0.0d0)
-
-(deftest deref.double.2
- (with-foreign-object (p :double)
- (setf (mem-ref p :double) *double-max*)
- (mem-ref p :double))
- #.*double-max*)
-
-(deftest deref.double.3
- (with-foreign-object (p :double)
- (setf (mem-ref p :double) *double-min*)
- (mem-ref p :double))
- #.*double-min*)
-
-;;; TODO: use something like *DOUBLE-MIN/MAX* above once we actually
-;;; have an available lisp that supports long double.
-;#-cffi-sys::no-long-float
-#+(and scl long-double)
-(progn
- (deftest deref.long-double.1
- (with-foreign-object (p :long-double)
- (setf (mem-ref p :long-double) 0.0l0)
- (mem-ref p :long-double))
- 0.0l0)
-
- (deftest deref.long-double.2
- (with-foreign-object (p :long-double)
- (setf (mem-ref p :long-double) most-positive-long-float)
- (mem-ref p :long-double))
- #.most-positive-long-float)
-
- (deftest deref.long-double.3
- (with-foreign-object (p :long-double)
- (setf (mem-ref p :long-double) least-positive-long-float)
- (mem-ref p :long-double))
- #.least-positive-long-float))
-
-;;; make sure the lisp doesn't convert NULL to NIL
-(deftest deref.pointer.null
- (with-foreign-object (p :pointer)
- (setf (mem-ref p :pointer) (null-pointer))
- (null-pointer-p (mem-ref p :pointer)))
- t)
-
-;;; regression test. lisp-string-to-foreign should handle empty strings
-(deftest lisp-string-to-foreign.empty
- (with-foreign-pointer (str 2)
- (setf (mem-ref str :unsigned-char) 42)
- (lisp-string-to-foreign "" str 1)
- (mem-ref str :unsigned-char))
- 0)
-
-;;; regression test. with-foreign-pointer shouldn't evaluate
-;;; the size argument twice.
-(deftest with-foreign-pointer.evalx2
- (let ((count 0))
- (with-foreign-pointer (x (incf count) size-var)
- (values count size-var)))
- 1 1)
-
-(defconstant +two+ 2)
-
-;;; regression test. cffi-allegro's with-foreign-pointer wasn't
-;;; handling constants properly.
-(deftest with-foreign-pointer.constant-size
- (with-foreign-pointer (p +two+ size)
- size)
- 2)
-
-(deftest mem-ref.left-to-right
- (let ((i 0))
- (with-foreign-object (p :char 3)
- (setf (mem-ref p :char 0) 66 (mem-ref p :char 1) 92)
- (setf (mem-ref p :char (incf i)) (incf i))
- (values (mem-ref p :char 0) (mem-ref p :char 1) i)))
- 66 2 2)
-
-;;; This needs to be in a real function for at least Allegro CL or the
-;;; compiler macro on %MEM-REF is not expanded and the test doesn't
-;;; actually test anything!
-(defun %mem-ref-left-to-right ()
- (let ((result nil))
- (with-foreign-object (p :char)
- (%mem-set 42 p :char)
- (%mem-ref (progn (push 1 result) p) :char (progn (push 2 result) 0))
- (nreverse result))))
-
-;;; Test left-to-right evaluation of the arguments to %MEM-REF when
-;;; optimized by the compiler macro.
-(deftest %mem-ref.left-to-right
- (%mem-ref-left-to-right)
- (1 2))
-
-;;; This needs to be in a top-level function for at least Allegro CL
-;;; or the compiler macro on %MEM-SET is not expanded and the test
-;;; doesn't actually test anything!
-(defun %mem-set-left-to-right ()
- (let ((result nil))
- (with-foreign-object (p :char)
- (%mem-set (progn (push 1 result) 0)
- (progn (push 2 result) p)
- :char
- (progn (push 3 result) 0))
- (nreverse result))))
-
-;;; Test left-to-right evaluation of the arguments to %MEM-SET when
-;;; optimized by the compiler macro.
-(deftest %mem-set.left-to-right
- (%mem-set-left-to-right)
- (1 2 3))
-
-;; regression test. mem-aref's setf expansion evaluated its type argument twice.
-(deftest mem-aref.eval-type-x2
- (let ((count 0))
- (with-foreign-pointer (p 1)
- (setf (mem-aref p (progn (incf count) :char) 0) 127))
- count)
- 1)
-
-(deftest mem-aref.left-to-right
- (let ((count -1))
- (with-foreign-pointer (p 2)
- (values
- (setf (mem-aref p (progn (incf count) :char) (incf count)) (incf count))
- (setq count -1)
- (mem-aref (progn (incf count) p) :char (incf count))
- count)))
- 2 -1 2 1)
-
-;; regression tests. nested mem-ref's and mem-aref's had bogus getters
-(deftest mem-ref.nested
- (with-foreign-object (p :pointer)
- (with-foreign-object (i :int)
- (setf (mem-ref p :pointer) i)
- (setf (mem-ref i :int) 42)
- (setf (mem-ref (mem-ref p :pointer) :int) 1984)
- (mem-ref i :int)))
- 1984)
-
-(deftest mem-aref.nested
- (with-foreign-object (p :pointer)
- (with-foreign-object (i :int 2)
- (setf (mem-aref p :pointer 0) i)
- (setf (mem-aref i :int 1) 42)
- (setf (mem-aref (mem-ref p :pointer 0) :int 1) 1984)
- (mem-aref i :int 1)))
- 1984)
-
-(cffi:defcstruct mem-aref.bare-struct
- (a :uint8))
-
-;;; regression test: although mem-aref was dealing with bare struct
-;;; types as though they were pointers, it wasn't calculating the
-;;; proper offsets. The offsets for bare structs types should be
-;;; calculated as aggregate types.
-(deftest mem-aref.bare-struct
- (with-foreign-object (a 'mem-aref.bare-struct 2)
- (eql (- (pointer-address (cffi:mem-aref a 'mem-aref.bare-struct 1))
- (pointer-address (cffi:mem-aref a 'mem-aref.bare-struct 0)))
- (foreign-type-size '(:struct mem-aref.bare-struct))))
- t)
-
-;;; regression tests. dereferencing an aggregate type. dereferencing a
-;;; struct should return a pointer to the struct itself, not return the
-;;; first 4 bytes (or whatever the size of :pointer is) as a pointer.
-;;;
-;;; This important for accessing an array of structs, which is
-;;; what the deref.array-of-aggregates test does.
-(defcstruct some-struct (x :int))
-
-(deftest deref.aggregate
- (with-foreign-object (s 'some-struct)
- (pointer-eq s (mem-ref s 'some-struct)))
- t)
-
-(deftest deref.array-of-aggregates
- (with-foreign-object (arr 'some-struct 3)
- (loop for i below 3
- do (setf (foreign-slot-value (mem-aref arr 'some-struct i)
- 'some-struct 'x)
- 112))
- (loop for i below 3
- collect (foreign-slot-value (mem-aref arr 'some-struct i)
- 'some-struct 'x)))
- (112 112 112))
-
-;;; pointer operations
-(deftest pointer.1
- (pointer-address (make-pointer 42))
- 42)
-
-;;; I suppose this test is not very good. --luis
-(deftest pointer.2
- (pointer-address (null-pointer))
- 0)
-
-(deftest pointer.null
- (nth-value 0 (ignore-errors (null-pointer-p nil)))
- nil)
-
-(deftest foreign-pointer-type.nil
- (typep nil 'foreign-pointer)
- nil)
-
-;;; Ensure that a pointer to the highest possible address can be
-;;; created using MAKE-POINTER. Regression test for CLISP/X86-64.
-(deftest make-pointer.high
- (let* ((pointer-length (foreign-type-size :pointer))
- (high-address (1- (expt 2 (* pointer-length 8))))
- (pointer (make-pointer high-address)))
- (- high-address (pointer-address pointer)))
- 0)
-
-;;; Ensure that incrementing a pointer by zero bytes returns an
-;;; equivalent pointer.
-(deftest inc-pointer.zero
- (with-foreign-object (x :int)
- (pointer-eq x (inc-pointer x 0)))
- t)
-
-;;; Test the INITIAL-ELEMENT keyword argument to FOREIGN-ALLOC.
-(deftest foreign-alloc.1
- (let ((ptr (foreign-alloc :int :initial-element 42)))
- (unwind-protect
- (mem-ref ptr :int)
- (foreign-free ptr)))
- 42)
-
-;;; Test the INITIAL-ELEMENT and COUNT arguments to FOREIGN-ALLOC.
-(deftest foreign-alloc.2
- (let ((ptr (foreign-alloc :int :count 4 :initial-element 100)))
- (unwind-protect
- (loop for i from 0 below 4
- collect (mem-aref ptr :int i))
- (foreign-free ptr)))
- (100 100 100 100))
-
-;;; Test the INITIAL-CONTENTS and COUNT arguments to FOREIGN-ALLOC,
-;;; passing a list of initial values.
-(deftest foreign-alloc.3
- (let ((ptr (foreign-alloc :int :count 4 :initial-contents '(4 3 2 1))))
- (unwind-protect
- (loop for i from 0 below 4
- collect (mem-aref ptr :int i))
- (foreign-free ptr)))
- (4 3 2 1))
-
-;;; Test INITIAL-CONTENTS and COUNT with FOREIGN-ALLOC passing a
-;;; vector of initial values.
-(deftest foreign-alloc.4
- (let ((ptr (foreign-alloc :int :count 4 :initial-contents #(10 20 30 40))))
- (unwind-protect
- (loop for i from 0 below 4
- collect (mem-aref ptr :int i))
- (foreign-free ptr)))
- (10 20 30 40))
-
-;;; Ensure calling FOREIGN-ALLOC with both INITIAL-ELEMENT and
-;;; INITIAL-CONTENTS signals an error.
-(deftest foreign-alloc.5
- (values
- (ignore-errors
- (let ((ptr (foreign-alloc :int :initial-element 1
- :initial-contents '(1))))
- (foreign-free ptr))
- t))
- nil)
-
-;;; Regression test: FOREIGN-ALLOC shouldn't actually perform translation
-;;; on initial-element/initial-contents since MEM-AREF will do that already.
-(define-foreign-type not-an-int ()
- ()
- (:actual-type :int)
- (:simple-parser not-an-int))
-
-(defmethod translate-to-foreign (value (type not-an-int))
- (assert (not (integerp value)))
- 0)
-
-(deftest foreign-alloc.6
- (let ((ptr (foreign-alloc 'not-an-int :initial-element 'foooo)))
- (foreign-free ptr)
- t)
- t)
-
-;;; Ensure calling FOREIGN-ALLOC with NULL-TERMINATED-P and a non-pointer
-;;; type signals an error.
-(deftest foreign-alloc.7
- (values
- (ignore-errors
- (let ((ptr (foreign-alloc :int :null-terminated-p t)))
- (foreign-free ptr))
- t))
- nil)
-
-;;; The opposite of the above test.
-(defctype pointer-alias :pointer)
-
-(deftest foreign-alloc.8
- (progn
- (foreign-free (foreign-alloc 'pointer-alias :count 0 :null-terminated-p t))
- t)
- t)
-
-;;; Ensure calling FOREIGN-ALLOC with NULL-TERMINATED-P actually places
-;;; a null pointer at the end. Not a very reliable test apparently.
-(deftest foreign-alloc.9
- (let ((ptr (foreign-alloc :pointer :count 0 :null-terminated-p t)))
- (unwind-protect
- (null-pointer-p (mem-ref ptr :pointer))
- (foreign-free ptr)))
- t)
-
-;;; RT: FOREIGN-ALLOC with :COUNT 0 on CLISP signalled an error.
-(deftest foreign-alloc.10
- (null (foreign-free (foreign-alloc :char :count 0)))
- t)
-
-;;; Tests for mem-ref with a non-constant type. This is a way to test
-;;; the functional interface (without compiler macros).
-
-(deftest deref.nonconst.char
- (let ((type :char))
- (with-foreign-object (p type)
- (setf (mem-ref p type) -127)
- (mem-ref p type)))
- -127)
-
-(deftest deref.nonconst.unsigned-char
- (let ((type :unsigned-char))
- (with-foreign-object (p type)
- (setf (mem-ref p type) 255)
- (mem-ref p type)))
- 255)
-
-(deftest deref.nonconst.short
- (let ((type :short))
- (with-foreign-object (p type)
- (setf (mem-ref p type) -32767)
- (mem-ref p type)))
- -32767)
-
-(deftest deref.nonconst.unsigned-short
- (let ((type :unsigned-short))
- (with-foreign-object (p type)
- (setf (mem-ref p type) 65535)
- (mem-ref p type)))
- 65535)
-
-(deftest deref.nonconst.int
- (let ((type :int))
- (with-foreign-object (p type)
- (setf (mem-ref p type) -131072)
- (mem-ref p type)))
- -131072)
-
-(deftest deref.nonconst.unsigned-int
- (let ((type :unsigned-int))
- (with-foreign-object (p type)
- (setf (mem-ref p type) 262144)
- (mem-ref p type)))
- 262144)
-
-(deftest deref.nonconst.long
- (let ((type :long))
- (with-foreign-object (p type)
- (setf (mem-ref p type) -536870911)
- (mem-ref p type)))
- -536870911)
-
-(deftest deref.nonconst.unsigned-long
- (let ((type :unsigned-long))
- (with-foreign-object (p type)
- (setf (mem-ref p type) 536870912)
- (mem-ref p type)))
- 536870912)
-
-#+(and darwin openmcl)
-(pushnew 'deref.nonconst.long-long rt::*expected-failures*)
-
-(deftest deref.nonconst.long-long
- (let ((type :long-long))
- (with-foreign-object (p type)
- (setf (mem-ref p type) -9223372036854775807)
- (mem-ref p type)))
- -9223372036854775807)
-
-(deftest deref.nonconst.unsigned-long-long
- (let ((type :unsigned-long-long))
- (with-foreign-object (p type)
- (setf (mem-ref p type) 18446744073709551615)
- (mem-ref p type)))
- 18446744073709551615)
-
-(deftest deref.nonconst.float.1
- (let ((type :float))
- (with-foreign-object (p type)
- (setf (mem-ref p type) 0.0)
- (mem-ref p type)))
- 0.0)
-
-(deftest deref.nonconst.float.2
- (let ((type :float))
- (with-foreign-object (p type)
- (setf (mem-ref p type) *float-max*)
- (mem-ref p type)))
- #.*float-max*)
-
-(deftest deref.nonconst.float.3
- (let ((type :float))
- (with-foreign-object (p type)
- (setf (mem-ref p type) *float-min*)
- (mem-ref p type)))
- #.*float-min*)
-
-(deftest deref.nonconst.double.1
- (let ((type :double))
- (with-foreign-object (p type)
- (setf (mem-ref p type) 0.0d0)
- (mem-ref p type)))
- 0.0d0)
-
-(deftest deref.nonconst.double.2
- (let ((type :double))
- (with-foreign-object (p type)
- (setf (mem-ref p type) *double-max*)
- (mem-ref p type)))
- #.*double-max*)
-
-(deftest deref.nonconst.double.3
- (let ((type :double))
- (with-foreign-object (p type)
- (setf (mem-ref p type) *double-min*)
- (mem-ref p type)))
- #.*double-min*)
-
-;;; regression tests: lispworks's %mem-ref and %mem-set compiler
-;;; macros were misbehaving.
-
-(defun mem-ref-rt-1 ()
- (with-foreign-object (a :int 2)
- (setf (mem-aref a :int 0) 123
- (mem-aref a :int 1) 456)
- (values (mem-aref a :int 0) (mem-aref a :int 1))))
-
-(deftest mem-ref.rt.1
- (mem-ref-rt-1)
- 123 456)
-
-(defun mem-ref-rt-2 ()
- (with-foreign-object (a :double 2)
- (setf (mem-aref a :double 0) 123.0d0
- (mem-aref a :double 1) 456.0d0)
- (values (mem-aref a :double 0) (mem-aref a :double 1))))
-
-(deftest mem-ref.rt.2
- (mem-ref-rt-2)
- 123.0d0 456.0d0)
-
-(deftest incf-pointer.1
- (let ((ptr (null-pointer)))
- (incf-pointer ptr)
- (pointer-address ptr))
- 1)
-
-(deftest incf-pointer.2
- (let ((ptr (null-pointer)))
- (incf-pointer ptr 42)
- (pointer-address ptr))
- 42)
-
-(deftest pointerp.1
- (values
- (pointerp (null-pointer))
- (null-pointer-p (null-pointer))
- (typep (null-pointer) 'foreign-pointer))
- t t t)
-
-(deftest pointerp.2
- (let ((p (make-pointer #xFEFF)))
- (values
- (pointerp p)
- (typep p 'foreign-pointer)))
- t t)
-
-(deftest pointerp.3
- (pointerp 'not-a-pointer)
- nil)
-
-(deftest pointerp.4
- (pointerp 42)
- nil)
-
-(deftest pointerp.5
- (pointerp 0)
- nil)
-
-(deftest pointerp.6
- (pointerp nil)
- nil)
-
-(deftest mem-ref.setf.1
- (with-foreign-object (p :char)
- (setf (mem-ref p :char) 42))
- 42)
-
-(define-foreign-type int+1 ()
- ()
- (:actual-type :int)
- (:simple-parser int+1))
-
-(defmethod translate-to-foreign (value (type int+1))
- (1+ value))
-
-(defmethod translate-from-foreign (value (type int+1))
- (1+ value))
-
-(deftest mem-ref.setf.2
- (with-foreign-object (p 'int+1)
- (values (setf (mem-ref p 'int+1) 42)
- (mem-ref p 'int+1)))
- 42 ; should this be 43?
- 44)
-
-(deftest pointer-eq.non-pointers.1
- (expecting-error (pointer-eq 1 2))
- :error)
-
-(deftest pointer-eq.non-pointers.2
- (expecting-error (pointer-eq 'a 'b))
- :error)
-
-(deftest null-pointer-p.non-pointer.1
- (expecting-error (null-pointer-p 'not-a-pointer))
- :error)
-
-(deftest null-pointer-p.non-pointer.2
- (expecting-error (null-pointer-p 0))
- :error)
-
-(deftest null-pointer-p.non-pointer.3
- (expecting-error (null-pointer-p nil))
- :error)
(DIR) diff --git a/3rdparties/software/cffi_0.20.0/tests/misc-types.lisp b/3rdparties/software/cffi_0.20.0/tests/misc-types.lisp
@@ -1,296 +0,0 @@
-;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
-;;;
-;;; misc-types.lisp --- Various tests on the type system.
-;;;
-;;; Copyright (C) 2005-2006, Luis Oliveira <loliveira(@)common-lisp.net>
-;;;
-;;; Permission is hereby granted, free of charge, to any person
-;;; obtaining a copy of this software and associated documentation
-;;; files (the "Software"), to deal in the Software without
-;;; restriction, including without limitation the rights to use, copy,
-;;; modify, merge, publish, distribute, sublicense, and/or sell copies
-;;; of the Software, and to permit persons to whom the Software is
-;;; furnished to do so, subject to the following conditions:
-;;;
-;;; The above copyright notice and this permission notice shall be
-;;; included in all copies or substantial portions of the Software.
-;;;
-;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
-;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
-;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
-;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
-;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
-;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
-;;; DEALINGS IN THE SOFTWARE.
-;;;
-
-(in-package #:cffi-tests)
-
-(defcfun ("my_strdup" strdup) :string+ptr (str :string))
-
-(defcfun ("my_strfree" strfree) :void (str :pointer))
-
-(deftest misc-types.string+ptr
- (destructuring-bind (string pointer)
- (strdup "foo")
- (strfree pointer)
- string)
- "foo")
-
-#-(and)
-(deftest misc-types.string+ptr.ub8
- (destructuring-bind (string pointer)
- (strdup (make-array 3 :element-type '(unsigned-byte 8)
- :initial-contents (map 'list #'char-code "foo")))
- (strfree pointer)
- string)
- "foo")
-
-#-(and)
-(deftest misc-types.string.ub8.1
- (let ((array (make-array 7 :element-type '(unsigned-byte 8)
- :initial-contents '(84 117 114 97 110 103 97))))
- (with-foreign-string (foreign-string array)
- (foreign-string-to-lisp foreign-string)))
- "Turanga")
-
-#-(and)
-(deftest misc-types.string.ub8.2
- (let ((str (foreign-string-alloc
- (make-array 7 :element-type '(unsigned-byte 8)
- :initial-contents '(84 117 114 97 110 103 97)))))
- (prog1 (foreign-string-to-lisp str)
- (foreign-string-free str)))
- "Turanga")
-
-(defcfun "equalequal" :boolean
- (a (:boolean :int))
- (b (:boolean :unsigned-int)))
-
-(defcfun "bool_and" (:boolean :char)
- (a (:boolean :unsigned-char))
- (b (:boolean :char)))
-
-(defcfun "bool_xor" (:boolean :unsigned-long)
- (a (:boolean :long))
- (b (:boolean :unsigned-long)))
-
-(deftest misc-types.boolean.1
- (list (equalequal nil nil)
- (equalequal t t)
- (equalequal t 23)
- (bool-and 'a 'b)
- (bool-and "foo" nil)
- (bool-xor t nil)
- (bool-xor nil nil))
- (t t t t nil t nil))
-
-(defcfun "sizeof_bool" :unsigned-int)
-
-(deftest misc-types.sizeof.bool
- (eql (sizeof-bool) (foreign-type-size :bool))
- t)
-
-(defcfun "bool_to_unsigned" :unsigned-int
- (b :bool))
-
-(defcfun "unsigned_to_bool" :bool
- (u :unsigned-int))
-
-(deftest misc-types.bool.convert-to-foreign.mem
- (loop for v in '(nil t)
- collect
- (with-foreign-object (b :bool)
- (setf (mem-ref b :bool) v)
- (mem-ref b #.(cffi::canonicalize-foreign-type :bool))))
- (0 1))
-
-(deftest misc-types.bool.convert-to-foreign.call
- (mapcar #'bool-to-unsigned '(nil t))
- (0 1))
-
-(deftest misc-types.bool.convert-from-foreign.mem
- (loop for v in '(0 1 42)
- collect
- (with-foreign-object (b :bool)
- (setf (mem-ref b #.(cffi::canonicalize-foreign-type :bool)) v)
- (mem-ref b :bool)))
- (nil t t))
-
-(deftest misc-types.bool.convert-from-foreign.call
- (mapcar #'unsigned-to-bool '(0 1 42))
- (nil t t))
-
-;;; Regression test: boolean type only worked with canonicalized
-;;; built-in integer types. Should work for any type that canonicalizes
-;;; to a built-in integer type.
-(defctype int-for-bool :int)
-(defcfun ("equalequal" equalequal2) :boolean
- (a (:boolean int-for-bool))
- (b (:boolean :uint)))
-
-(deftest misc-types.boolean.2
- (equalequal2 nil t)
- nil)
-
-(defctype my-string :string+ptr)
-
-(defun funkify (str)
- (concatenate 'string "MORE " (string-upcase str)))
-
-(defun 3rd-person (value)
- (list (concatenate 'string "Strdup says: " (first value))
- (second value)))
-
-;; (defctype funky-string
-;; (:wrapper my-string
-;; :to-c #'funkify
-;; :from-c (lambda (value)
-;; (list
-;; (concatenate 'string "Strdup says: "
-;; (first value))
-;; (second value))))
-;; "A useful type.")
-
-(defctype funky-string (:wrapper my-string :to-c funkify :from-c 3rd-person))
-
-(defcfun ("my_strdup" funky-strdup) funky-string
- (str funky-string))
-
-(deftest misc-types.wrapper
- (destructuring-bind (string ptr)
- (funky-strdup "code")
- (strfree ptr)
- string)
- "Strdup says: MORE CODE")
-
-(deftest misc-types.sized-ints
- (mapcar #'foreign-type-size
- '(:int8 :uint8 :int16 :uint16 :int32 :uint32 :int64 :uint64))
- (1 1 2 2 4 4 8 8))
-
-(define-foreign-type error-error ()
- ()
- (:actual-type :int)
- (:simple-parser error-error))
-
-(defmethod translate-to-foreign (value (type error-error))
- (declare (ignore value))
- (error "translate-to-foreign invoked."))
-
-(defmethod translate-from-foreign (value (type error-error))
- (declare (ignore value))
- (error "translate-from-foreign invoked."))
-
-(eval-when (:load-toplevel :compile-toplevel :execute)
- (defmethod expand-to-foreign (value (type error-error))
- value)
-
- (defmethod expand-from-foreign (value (type error-error))
- value))
-
-(defcfun ("abs" expand-abs) error-error
- (n error-error))
-
-(defcvar ("var_int" *expand-var-int*) error-error)
-
-(defcfun ("expect_int_sum" expand-expect-int-sum) :boolean
- (cb :pointer))
-
-(defcallback expand-int-sum error-error ((x error-error) (y error-error))
- (+ x y))
-
-;;; Ensure that macroexpansion-time translators are called where this
-;;; is guaranteed (defcfun, defcvar, foreign-funcall and defcallback)
-(deftest misc-types.expand.1
- (expand-abs -1)
- 1)
-
-#-cffi-sys::no-foreign-funcall
-(deftest misc-types.expand.2
- (foreign-funcall "abs" error-error -1 error-error)
- 1)
-
-(deftest misc-types.expand.3
- (let ((old (mem-ref (get-var-pointer '*expand-var-int*) :int)))
- (unwind-protect
- (progn
- (setf *expand-var-int* 42)
- *expand-var-int*)
- (setf (mem-ref (get-var-pointer '*expand-var-int*) :int) old)))
- 42)
-
-(deftest misc-types.expand.4
- (expand-expect-int-sum (callback expand-int-sum))
- t)
-
-(define-foreign-type translate-tracker ()
- ()
- (:actual-type :int)
- (:simple-parser translate-tracker))
-
-(declaim (special .fto-called.))
-
-(defmethod free-translated-object (value (type translate-tracker) param)
- (declare (ignore value param))
- (setf .fto-called. t))
-
-(define-foreign-type expand-tracker ()
- ()
- (:actual-type :int)
- (:simple-parser expand-tracker))
-
-(defmethod free-translated-object (value (type expand-tracker) param)
- (declare (ignore value param))
- (setf .fto-called. t))
-
-(eval-when (:compile-toplevel :load-toplevel :execute)
- (defmethod expand-to-foreign (value (type expand-tracker))
- (declare (ignore value))
- (call-next-method)))
-
-(defcfun ("abs" ttracker-abs) :int
- (n translate-tracker))
-
-(defcfun ("abs" etracker-abs) :int
- (n expand-tracker))
-
-;; free-translated-object must be called when there is no etf
-(deftest misc-types.expand.5
- (let ((.fto-called. nil))
- (ttracker-abs -1)
- .fto-called.)
- t)
-
-;; free-translated-object must be called when there is an etf, but
-;; they answer *runtime-translator-form*
-(deftest misc-types.expand.6
- (let ((.fto-called. nil))
- (etracker-abs -1)
- .fto-called.)
- t)
-
-(define-foreign-type misc-type.expand.7 ()
- ()
- (:actual-type :int)
- (:simple-parser misc-type.expand.7))
-
-(defmethod translate-to-foreign (value (type misc-type.expand.7))
- (values value 'second-value))
-
-;; Auxiliary function to test CONVERT-TO-FOREIGN's compiler macro.
-(defun misc-type.expand.7-aux ()
- (convert-to-foreign "foo" 'misc-type.expand.7))
-
-;; Checking that expand-to-foreign doesn't ignore the second value of
-;; translate-to-foreign.
-(deftest misc-type.expand.7
- (misc-type.expand.7-aux)
- "foo" second-value)
-
-;; Like MISC-TYPE.EXPAND.7 but doesn't depend on compiler macros
-;; kicking in.
-(deftest misc-type.expand.8
- (eval (expand-to-foreign "foo" (cffi::parse-type 'misc-type.expand.7)))
- "foo" second-value)
(DIR) diff --git a/3rdparties/software/cffi_0.20.0/tests/misc.lisp b/3rdparties/software/cffi_0.20.0/tests/misc.lisp
@@ -1,132 +0,0 @@
-;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
-;;;
-;;; misc.lisp --- Miscellaneous tests.
-;;;
-;;; Copyright (C) 2006, Luis Oliveira <loliveira@common-lisp.net>
-;;;
-;;; Permission is hereby granted, free of charge, to any person
-;;; obtaining a copy of this software and associated documentation
-;;; files (the "Software"), to deal in the Software without
-;;; restriction, including without limitation the rights to use, copy,
-;;; modify, merge, publish, distribute, sublicense, and/or sell copies
-;;; of the Software, and to permit persons to whom the Software is
-;;; furnished to do so, subject to the following conditions:
-;;;
-;;; The above copyright notice and this permission notice shall be
-;;; included in all copies or substantial portions of the Software.
-;;;
-;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
-;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
-;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
-;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
-;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
-;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
-;;; DEALINGS IN THE SOFTWARE.
-;;;
-
-(in-package #:cffi-tests)
-
-;;;# foreign-symbol-pointer tests
-
-;;; This might be useful for some libraries that compare function
-;;; pointers. http://thread.gmane.org/gmane.lisp.cffi.devel/694
-(defcfun "compare_against_abs" :boolean (p :pointer))
-
-(deftest foreign-symbol-pointer.1
- (compare-against-abs (foreign-symbol-pointer "abs"))
- t)
-
-(defcfun "compare_against_xpto_fun" :boolean (p :pointer))
-
-(deftest foreign-symbol-pointer.2
- (compare-against-xpto-fun (foreign-symbol-pointer "xpto_fun"))
- t)
-
-;;;# Library tests
-;;;
-;;; Need to figure out a way to test this. CLISP, for instance, will
-;;; automatically reopen the foreign-library when we call a foreign
-;;; function so we can't test CLOSE-FOREIGN-LIBRARY this way.
-;;;
-;;; IIRC, GCC has some extensions to have code run when a library is
-;;; loaded and stuff like that. That could work.
-
-#||
-#-(and ecl (not dffi))
-(deftest library.close.2
- (unwind-protect
- (progn
- (close-foreign-library 'libtest)
- (ignore-errors (my-sqrtf 16.0)))
- (load-test-libraries))
- nil)
-
-#-(or (and ecl (not dffi))
- cffi-sys::flat-namespace
- cffi-sys::no-foreign-funcall)
-(deftest library.close.2
- (unwind-protect
- (values
- (foreign-funcall ("ns_function" :library libtest) :boolean)
- (close-foreign-library 'libtest)
- (foreign-funcall "ns_function" :boolean)
- (close-foreign-library 'libtest2)
- (close-foreign-library 'libtest2)
- (ignore-errors (foreign-funcall "ns_function" :boolean)))
- (load-test-libraries))
- t t nil t nil nil)
-||#
-
-(deftest library.error.1
- (handler-case (load-foreign-library "libdoesnotexistimsure")
- (load-foreign-library-error () 'error))
- error)
-
-(define-foreign-library pseudo-library
- (t pseudo-library-spec))
-
-;;; RT: T clause was being handled as :T by FEATUREP.
-;;;
-;;; We might want to export (and clean up) the API used in this test
-;;; when the need arises.
-(deftest library.t-clause
- (eq (cffi::foreign-library-spec
- (cffi::get-foreign-library 'pseudo-library))
- 'pseudo-library-spec)
- t)
-
-(define-foreign-library library-with-pathname
- (t #p"libdoesnotexistimsure"))
-
-;;; RT: we were mishandling pathnames within libraries. (lp#1720626)
-(deftest library.error.2
- (handler-case (load-foreign-library 'library-with-pathname)
- (load-foreign-library-error () 'error))
- error)
-
-(deftest library.error.3
- (handler-case (load-foreign-library #p"libdoesnotexistimsure")
- (load-foreign-library-error () 'error))
- error)
-
-;;;# Shareable Byte Vector Tests
-
-#+ecl
-(mapc (lambda (x) (pushnew x rt::*expected-failures*))
- '(shareable-vector.1 shareable-vector.2))
-
-(deftest shareable-vector.1
- (let ((vector (cffi-sys::make-shareable-byte-vector 5)))
- (cffi::with-pointer-to-vector-data (pointer vector)
- (strcpy pointer "xpto"))
- vector)
- #(120 112 116 111 0))
-
-(deftest shareable-vector.2
- (block nil
- (let ((vector (cffi-sys::make-shareable-byte-vector 5)))
- (cffi::with-pointer-to-vector-data (pointer vector)
- (strcpy pointer "xpto")
- (return vector))))
- #(120 112 116 111 0))
(DIR) diff --git a/3rdparties/software/cffi_0.20.0/tests/package.lisp b/3rdparties/software/cffi_0.20.0/tests/package.lisp
@@ -1,33 +0,0 @@
-;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
-;;;
-;;; package.lisp --- CFFI-TESTS package definition.
-;;;
-;;; Copyright (C) 2005-2006, James Bielman <jamesjb@jamesjb.com>
-;;;
-;;; Permission is hereby granted, free of charge, to any person
-;;; obtaining a copy of this software and associated documentation
-;;; files (the "Software"), to deal in the Software without
-;;; restriction, including without limitation the rights to use, copy,
-;;; modify, merge, publish, distribute, sublicense, and/or sell copies
-;;; of the Software, and to permit persons to whom the Software is
-;;; furnished to do so, subject to the following conditions:
-;;;
-;;; The above copyright notice and this permission notice shall be
-;;; included in all copies or substantial portions of the Software.
-;;;
-;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
-;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
-;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
-;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
-;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
-;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
-;;; DEALINGS IN THE SOFTWARE.
-;;;
-
-(in-package #:cl-user)
-
-(defpackage #:cffi-tests
- (:use #:cl #:cffi #:cffi-sys #:regression-test)
- (:export #:do-tests #:run-cffi-tests #:run-all-cffi-tests)
- (:shadow #:deftest))
(DIR) diff --git a/3rdparties/software/cffi_0.20.0/tests/random-tester.lisp b/3rdparties/software/cffi_0.20.0/tests/random-tester.lisp
@@ -1,246 +0,0 @@
-;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
-;;;
-;;; random-tester.lisp --- Random test generator.
-;;;
-;;; Copyright (C) 2006, Luis Oliveira <loliveira(@)common-lisp.net>
-;;;
-;;; Permission is hereby granted, free of charge, to any person
-;;; obtaining a copy of this software and associated documentation
-;;; files (the "Software"), to deal in the Software without
-;;; restriction, including without limitation the rights to use, copy,
-;;; modify, merge, publish, distribute, sublicense, and/or sell copies
-;;; of the Software, and to permit persons to whom the Software is
-;;; furnished to do so, subject to the following conditions:
-;;;
-;;; The above copyright notice and this permission notice shall be
-;;; included in all copies or substantial portions of the Software.
-;;;
-;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
-;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
-;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
-;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
-;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
-;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
-;;; DEALINGS IN THE SOFTWARE.
-;;;
-
-;;; This code was used to generate the C and Lisp source code for
-;;; the CALLBACKS.BFF.[12] and DEFCFUN.BFF.[12] tests.
-;;;
-;;; The original idea was to test all combinations of argument types
-;;; but obviously as soon as you do the maths that it's not quite
-;;; feasable for more that 4 or 5 arguments.
-;;;
-;;; TODO: actually run random tests, ie compile/load/run the tests
-;;; this code can generate.
-
-(defpackage #:cffi-random-tester
- (:use #:cl #:cffi #:alexandria #:regression-test))
-(in-package #:cffi-random-tester)
-
-(defstruct (c-type (:conc-name type-))
- keyword
- name
- abbrev
- min
- max)
-
-(defparameter +types+
- (mapcar (lambda (type)
- (let ((keyword (first type))
- (name (second type)))
- (multiple-value-bind (min max)
- ;; assume we can represent an integer in the range
- ;; [-2^16 2^16-1] in a float/double without causing
- ;; rounding errors (probably a lame assumption)
- (let ((type-size (if (or (eq keyword :float)
- (eq keyword :double))
- 16
- (* 8 (foreign-type-size keyword)))))
- (if (or (eql (char name 0) #\u) (eq keyword :pointer))
- (values 0 (1- (expt 2 type-size)))
- (values (- (expt 2 (1- type-size)))
- (1- (expt 2 (1- type-size))))))
- (make-c-type :keyword keyword :name name :abbrev (third type)
- :min min :max max))))
- '((:char "char" "c")
- (:unsigned-char "unsigned char" "uc")
- (:short "short" "s")
- (:unsigned-short "unsigned short" "us")
- (:int "int" "i")
- (:unsigned-int "unsigned int" "ui")
- (:long "long" "l")
- (:unsigned-long "unsigned long" "ul")
- (:float "float" "f")
- (:double "double" "d")
- (:pointer "void*" "p")
- (:long-long "long long" "ll")
- (:unsigned-long-long "unsigned long long" "ull"))))
-
-(defun find-type (keyword)
- (find keyword +types+ :key #'type-keyword))
-
-(defun n-random-types (n)
- (loop repeat n collect (nth (random (length +types+)) +types+)))
-
-;;; same as above, without the long long types
-(defun n-random-types-no-ll (n)
- (loop repeat n collect (nth (random (- (length +types+) 2)) +types+)))
-
-(defun random-range (x y)
- (+ x (random (+ (- y x) 2))))
-
-(defun random-sum (rettype arg-types)
- "Returns a list of integers that fit in the respective types in the
-ARG-TYPES list and whose sum fits in RETTYPE."
- (loop with sum = 0
- for type in arg-types
- for x = (random-range (max (- (type-min rettype) sum) (type-min type))
- (min (- (type-max rettype) sum) (type-max type)))
- do (incf sum x)
- collect x))
-
-(defun combinations (n items)
- (let ((combs '()))
- (labels ((rec (n accum)
- (if (= n 0)
- (push accum combs)
- (loop for item in items
- do (rec (1- n) (cons item accum))))))
- (rec n '())
- combs)))
-
-(defun function-name (rettype arg-types)
- (format nil "sum_~A_~{_~A~}"
- (type-abbrev rettype)
- (mapcar #'type-abbrev arg-types)))
-
-(defun c-function (rettype arg-types)
- (let ((args (loop for type in arg-types and i from 1
- collect (list (type-name type) (format nil "a~A" i)))))
- (format t "DLLEXPORT ~A ~A(~{~{~A ~A~}~^, ~})~%~
- { return ~A(~A) ~{~A~^ + ~}~A; }"
- (type-name rettype) (function-name rettype arg-types) args
- (if (eq (type-keyword rettype) :pointer)
- "(void *)((unsigned int)("
- "")
- (type-name rettype)
- (loop for arg-pair in args collect
- (format nil "~A~A~A"
- (cond ((string= (first arg-pair) "void*")
- "(unsigned int) ")
- ((or (string= (first arg-pair) "double")
- (string= (first arg-pair) "float"))
- "((int) ")
- (t ""))
- (second arg-pair)
- (if (member (first arg-pair)
- '("void*" "double" "float")
- :test #'string=)
- ")"
- "")))
- (if (eq (type-keyword rettype) :pointer) "))" ""))))
-
-(defun c-callback (rettype arg-types args)
- (format t "DLLEXPORT ~A call_~A(~A (*func)(~{~A~^, ~}~^))~%~
- { return func(~{~A~^, ~}); }"
- (type-name rettype) (function-name rettype arg-types)
- (type-name rettype) (mapcar #'type-name arg-types)
- (loop for type in arg-types and value in args collect
- (format nil "~A~A"
- (if (eq (type-keyword type) :pointer)
- "(void *) "
- "")
- value))))
-
-;;; (output-c-code #p"generated.c" 3 5)
-(defun output-c-code (file min max)
- (with-open-file (stream file :direction :output :if-exists :error)
- (let ((*standard-output* stream))
- (format t "/* automatically generated functions and callbacks */~%~%")
- (loop for n from min upto max do
- (format t "/* ~A args */" (1- n))
- (loop for comb in (combinations n +types+) do
- (terpri) (c-function (car comb) (cdr comb))
- (terpri) (c-callback (car comb) (cdr comb)))))))
-
-(defmacro with-conversion (type form)
- (case type
- (:double `(float ,form 1.0d0))
- (:float `(float ,form))
- (:pointer `(make-pointer ,form))
- (t form)))
-
-(defun integer-conversion (type form)
- (case type
- ((:double :float) `(values (floor ,form)))
- (:pointer `(pointer-address ,form))
- (t form)))
-
-(defun gen-arg-values (rettype arg-types)
- (let ((numbers (random-sum rettype arg-types)))
- (values
- (reduce #'+ numbers)
- (loop for type in arg-types and n in numbers
- collect (case (type-keyword type)
- (:double (float n 1.0d0))
- (:float (float n))
- (:pointer `(make-pointer ,n))
- (t n))))))
-
-(defun gen-function-test (rettype arg-types)
- (let* ((fun-name (function-name rettype arg-types))
- (fun-sym (cffi::lisp-function-name fun-name)))
- (multiple-value-bind (sum value-forms)
- (gen-arg-values rettype arg-types)
- `(progn
- (defcfun (,fun-name ,fun-sym) ,(type-keyword rettype)
- ,@(loop for type in arg-types and i from 1 collect
- (list (symbolicate '#:a (format nil "~A" i))
- (type-keyword type))))
- (deftest ,(symbolicate '#:defcfun. fun-sym)
- ,(integer-conversion (type-keyword rettype)
- `(,fun-sym ,@value-forms))
- ,sum)))))
-
-(defun gen-callback-test (rettype arg-types sum)
- (let* ((fname (function-name rettype arg-types))
- (cb-sym (cffi::lisp-function-name fname))
- (fun-name (concatenate 'string "call_" fname))
- (fun-sym (cffi::lisp-function-name fun-name))
- (arg-names (loop for i from 1 upto (length arg-types) collect
- (symbolicate '#:a (format nil "~A" i)))))
- `(progn
- (defcfun (,fun-name ,fun-sym) ,(type-keyword rettype) (cb :pointer))
- (defcallback ,cb-sym ,(type-keyword rettype)
- ,(loop for type in arg-types and name in arg-names
- collect (list name (type-keyword type)))
- ,(integer-conversion
- (type-keyword rettype)
- `(+ ,@(mapcar (lambda (tp n)
- (integer-conversion (type-keyword tp) n))
- arg-types arg-names))))
- (deftest ,(symbolicate '#:callbacks. cb-sym)
- ,(integer-conversion (type-keyword rettype)
- `(,fun-sym (callback ,cb-sym)))
- ,sum))))
-
-(defun cb-test (&key no-long-long)
- (let* ((rettype (find-type (if no-long-long :long :long-long)))
- (arg-types (if no-long-long
- (n-random-types-no-ll 127)
- (n-random-types 127)))
- (args (random-sum rettype arg-types))
- (sum (reduce #'+ args)))
- (c-callback rettype arg-types args)
- (gen-callback-test rettype arg-types sum)))
-
-;; (defmacro define-function-and-callback-tests (min max)
-;; `(progn
-;; ,@(loop for n from min upto max appending
-;; (loop for comb in (combinations n +types+)
-;; collect (gen-function-test (car comb) (cdr comb))
-;; collect (gen-callback-test (car comb) (cdr comb))))))
-
-;; (define-function-and-callback-tests 3 5)
(DIR) diff --git a/3rdparties/software/cffi_0.20.0/tests/run-tests.lisp b/3rdparties/software/cffi_0.20.0/tests/run-tests.lisp
@@ -1,44 +0,0 @@
-;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
-;;;
-;;; run-tests.lisp --- Simple script to run the unit tests.
-;;;
-;;; Copyright (C) 2005-2006, James Bielman <jamesjb@jamesjb.com>
-;;;
-;;; Permission is hereby granted, free of charge, to any person
-;;; obtaining a copy of this software and associated documentation
-;;; files (the "Software"), to deal in the Software without
-;;; restriction, including without limitation the rights to use, copy,
-;;; modify, merge, publish, distribute, sublicense, and/or sell copies
-;;; of the Software, and to permit persons to whom the Software is
-;;; furnished to do so, subject to the following conditions:
-;;;
-;;; The above copyright notice and this permission notice shall be
-;;; included in all copies or substantial portions of the Software.
-;;;
-;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
-;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
-;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
-;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
-;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
-;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
-;;; DEALINGS IN THE SOFTWARE.
-;;;
-
-(in-package #:cl-user)
-
-(setf *load-verbose* nil *compile-verbose* nil *compile-print* nil)
-#+cmucl (setf ext:*gc-verbose* nil)
-
-(require "asdf")
-
-(format t "~&;;; -------- Running tests in ~A --------~%"
- (uiop:implementation-identifier))
-
-(asdf:load-system "cffi-tests" :verbose nil)
-(asdf:test-system "cffi-tests")
-
-(terpri)
-(force-output)
-
-(uiop:quit)
(DIR) diff --git a/3rdparties/software/cffi_0.20.0/tests/strings.lisp b/3rdparties/software/cffi_0.20.0/tests/strings.lisp
@@ -1,150 +0,0 @@
-;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
-;;;
-;;; strings.lisp --- Tests for foreign string conversion.
-;;;
-;;; Copyright (C) 2005, James Bielman <jamesjb@jamesjb.com>
-;;; Copyright (C) 2007, Luis Oliveira <loliveira@common-lisp.net>
-;;;
-;;; Permission is hereby granted, free of charge, to any person
-;;; obtaining a copy of this software and associated documentation
-;;; files (the "Software"), to deal in the Software without
-;;; restriction, including without limitation the rights to use, copy,
-;;; modify, merge, publish, distribute, sublicense, and/or sell copies
-;;; of the Software, and to permit persons to whom the Software is
-;;; furnished to do so, subject to the following conditions:
-;;;
-;;; The above copyright notice and this permission notice shall be
-;;; included in all copies or substantial portions of the Software.
-;;;
-;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
-;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
-;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
-;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
-;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
-;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
-;;; DEALINGS IN THE SOFTWARE.
-;;;
-
-(in-package #:cffi-tests)
-
-;;;# Foreign String Conversion Tests
-;;;
-;;; With the implementation of encoding support, there are a lot of
-;;; things that can go wrong with foreign string conversions. This is
-;;; a start at defining tests for strings and encoding conversion, but
-;;; there needs to be a lot more.
-
-(babel:enable-sharp-backslash-syntax)
-
-;;; *ASCII-TEST-STRING* contains the characters in the ASCII character
-;;; set that we will convert to a foreign string and check against
-;;; *ASCII-TEST-BYTES*. We don't bother with control characters.
-;;;
-;;; FIXME: It would probably be good to move these tables into files
-;;; in "tests/", especially if we ever want to get fancier and have
-;;; tests for more encodings.
-(eval-when (:compile-toplevel :load-toplevel :execute)
- (defparameter *ascii-test-string*
- (concatenate 'string " !\"#$%&'()*+,-./0123456789:;"
- "<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]"
- "^_`abcdefghijklmnopqrstuvwxyz{|}~")))
-
-;;; *ASCII-TEST-BYTES* contains the expected ASCII encoded values
-;;; for each character in *ASCII-TEST-STRING*.
-(eval-when (:compile-toplevel :load-toplevel :execute)
- (defparameter *ascii-test-bytes*
- (let ((vector (make-array 95 :element-type '(unsigned-byte 8))))
- (loop for i from 0
- for code from 32 below 127
- do (setf (aref vector i) code)
- finally (return vector)))))
-
-;;; Test basic consistency converting a string to and from Lisp using
-;;; the default encoding.
-(deftest string.conversion.basic
- (with-foreign-string (s *ascii-test-string*)
- (foreign-string-to-lisp s))
- #.*ascii-test-string* 95)
-
-(deftest string.conversion.basic.2
- (with-foreign-string ((ptr size) "123" :null-terminated-p nil)
- (values (foreign-string-to-lisp ptr :count 3) size))
- "123" 3)
-
-;;; Ensure that conversion of *ASCII-TEST-STRING* to a foreign buffer
-;;; and back preserves ASCII encoding.
-(deftest string.encoding.ascii
- (with-foreign-string (s *ascii-test-string* :encoding :ascii)
- (let ((vector (make-array 95 :element-type '(unsigned-byte 8))))
- (loop for i from 0 below (length vector)
- do (setf (aref vector i) (mem-ref s :unsigned-char i)))
- vector))
- #.*ascii-test-bytes*)
-
-;;; FIXME: bogus test. We need support for BOM or UTF-16{BE,LE}.
-(pushnew 'string.encoding.utf-16.basic rtest::*expected-failures*)
-
-;;; Test UTF-16 conversion of a string back and forth. Tests proper
-;;; null terminator handling for wide character strings and ensures no
-;;; byte order marks are added. (Why no BOM? --luis)
-;;;
-;;; FIXME: an identical test using :UTF-16 wouldn't work because on
-;;; little-endian architectures, :UTF-16 defaults to little-endian
-;;; when writing and big-endian on reading because the BOM is
-;;; suppressed.
-#-babel::8-bit-chars
-(progn
- (deftest string.encoding.utf-16le.basic
- (with-foreign-string (s *ascii-test-string* :encoding :utf-16le)
- (foreign-string-to-lisp s :encoding :utf-16le))
- #.*ascii-test-string* 190)
-
- (deftest string.encoding.utf-16be.basic
- (with-foreign-string (s *ascii-test-string* :encoding :utf-16be)
- (foreign-string-to-lisp s :encoding :utf-16be))
- #.*ascii-test-string* 190))
-
-;;; Ensure that writing a long string into a short buffer does not
-;;; attempt to write beyond the edge of the buffer, and that the
-;;; resulting string is still null terminated.
-(deftest string.short-write.1
- (with-foreign-pointer (buf 6)
- (setf (mem-ref buf :unsigned-char 5) 70)
- (lisp-string-to-foreign "ABCDE" buf 5 :encoding :ascii)
- (values (mem-ref buf :unsigned-char 4)
- (mem-ref buf :unsigned-char 5)))
- 0 70)
-
-#-babel::8-bit-chars
-(deftest string.encoding.utf-8.basic
- (with-foreign-pointer (buf 7 size)
- (let ((string (concatenate 'babel:unicode-string
- '(#\u03bb #\u00e3 #\u03bb))))
- (lisp-string-to-foreign string buf size :encoding :utf-8)
- (loop for i from 0 below size
- collect (mem-ref buf :unsigned-char i))))
- (206 187 195 163 206 187 0))
-
-(defparameter *basic-latin-alphabet* "abcdefghijklmnopqrstuvwxyz")
-
-(deftest string.encodings.all.basic
- (let (failed)
- ;;; FIXME: UTF-{32,16} and friends fail due to lack of BOM. See
- ;;; STRING.ENCODING.UTF-16.BASIC for more details.
- (dolist (encoding (remove-if (lambda (x)
- (member x '(:utf-32 :utf-16 :ucs-2)))
- (babel:list-character-encodings)))
- ;; (format t "Testing ~S~%" encoding)
- (with-foreign-string (ptr *basic-latin-alphabet* :encoding encoding)
- (let ((string (foreign-string-to-lisp ptr :encoding encoding)))
- ;; (format t " got ~S~%" string)
- (unless (string= *basic-latin-alphabet* string)
- (push encoding failed)))))
- failed)
- nil)
-
-;;; rt: make sure *default-foreign-enconding* binds to a keyword
-(deftest string.encodings.default
- (keywordp *default-foreign-encoding*)
- t)
(DIR) diff --git a/3rdparties/software/cffi_0.20.0/tests/struct.lisp b/3rdparties/software/cffi_0.20.0/tests/struct.lisp
@@ -1,705 +0,0 @@
-;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
-;;;
-;;; struct.lisp --- Foreign structure type tests.
-;;;
-;;; Copyright (C) 2005-2006, James Bielman <jamesjb@jamesjb.com>
-;;; Copyright (C) 2005-2011, Luis Oliveira <loliveira@common-lisp.net>
-;;;
-;;; Permission is hereby granted, free of charge, to any person
-;;; obtaining a copy of this software and associated documentation
-;;; files (the "Software"), to deal in the Software without
-;;; restriction, including without limitation the rights to use, copy,
-;;; modify, merge, publish, distribute, sublicense, and/or sell copies
-;;; of the Software, and to permit persons to whom the Software is
-;;; furnished to do so, subject to the following conditions:
-;;;
-;;; The above copyright notice and this permission notice shall be
-;;; included in all copies or substantial portions of the Software.
-;;;
-;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
-;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
-;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
-;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
-;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
-;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
-;;; DEALINGS IN THE SOFTWARE.
-;;;
-
-(in-package #:cffi-tests)
-
-(defcstruct timeval
- (tv-secs :long)
- (tv-usecs :long))
-
-(defparameter *timeval-size* (* 2 (max (foreign-type-size :long)
- (foreign-type-alignment :long))))
-
-;;;# Basic Structure Tests
-
-(deftest struct.1
- (- (foreign-type-size 'timeval) *timeval-size*)
- 0)
-
-(deftest struct.2
- (with-foreign-object (tv 'timeval)
- (setf (foreign-slot-value tv 'timeval 'tv-secs) 0)
- (setf (foreign-slot-value tv 'timeval 'tv-usecs) 1)
- (values (foreign-slot-value tv 'timeval 'tv-secs)
- (foreign-slot-value tv 'timeval 'tv-usecs)))
- 0 1)
-
-(deftest struct.3
- (with-foreign-object (tv 'timeval)
- (with-foreign-slots ((tv-secs tv-usecs) tv timeval)
- (setf tv-secs 100 tv-usecs 200)
- (values tv-secs tv-usecs)))
- 100 200)
-
-;; regression test: accessing a struct through a typedef
-
-(defctype xpto (:struct timeval))
-
-(deftest struct.4
- (with-foreign-object (tv 'xpto)
- (setf (foreign-slot-value tv 'xpto 'tv-usecs) 1)
- (values (foreign-slot-value tv 'xpto 'tv-usecs)
- (foreign-slot-value tv 'timeval 'tv-usecs)))
- 1 1)
-
-(deftest struct.names
- (sort (foreign-slot-names 'xpto) #'<
- :key (lambda (x) (foreign-slot-offset 'xpto x)))
- (tv-secs tv-usecs))
-
-;; regression test: compiler macro not quoting the type in the
-;; resulting mem-ref form. The compiler macro on foreign-slot-value
-;; is not guaranteed to be expanded though.
-
-(defctype my-int :int)
-(defcstruct s5 (a my-int))
-
-(deftest struct.5
- (with-foreign-object (s 's5)
- (setf (foreign-slot-value s 's5 'a) 42)
- (foreign-slot-value s 's5 'a))
- 42)
-
-;;;# Structs with type translators
-
-(defcstruct struct-string
- (s :string))
-
-(deftest struct.string.1
- (with-foreign-object (ptr 'struct-string)
- (with-foreign-slots ((s) ptr struct-string)
- (setf s "So long and thanks for all the fish!")
- s))
- "So long and thanks for all the fish!")
-
-(deftest struct.string.2
- (with-foreign-object (ptr 'struct-string)
- (setf (foreign-slot-value ptr 'struct-string 's) "Cha")
- (foreign-slot-value ptr 'struct-string 's))
- "Cha")
-
-;;;# Structure Alignment Tests
-;;;
-;;; See libtest.c and types.lisp for some comments about alignments.
-
-(defcstruct s-ch
- (a-char :char))
-
-(defctype s-ch (:struct s-ch))
-
-(defcstruct s-s-ch
- (another-char :char)
- (a-s-ch s-ch))
-
-(defctype s-s-ch (:struct s-s-ch))
-
-(defcvar "the_s_s_ch" s-s-ch)
-
-(deftest struct.alignment.1
- (list 'a-char (foreign-slot-value
- (foreign-slot-pointer *the-s-s-ch* 's-s-ch 'a-s-ch)
- 's-ch 'a-char)
- 'another-char (foreign-slot-value *the-s-s-ch* 's-s-ch 'another-char))
- (a-char 1 another-char 2))
-
-
-(defcstruct s-short
- (a-char :char)
- (another-char :char)
- (a-short :short))
-
-(defctype s-short (:struct s-short))
-
-(defcstruct s-s-short
- (yet-another-char :char)
- (a-s-short s-short))
-
-(defctype s-s-short (:struct s-s-short))
-
-(defcvar "the_s_s_short" s-s-short)
-
-(deftest struct.alignment.2
- (with-foreign-slots ((yet-another-char a-s-short) *the-s-s-short* s-s-short)
- (with-foreign-slots ((a-char another-char a-short) a-s-short s-short)
- (list 'a-char a-char
- 'another-char another-char
- 'a-short a-short
- 'yet-another-char yet-another-char)))
- (a-char 1 another-char 2 a-short 3 yet-another-char 4))
-
-
-(defcstruct s-double
- (a-char :char)
- (a-double :double)
- (another-char :char))
-
-(defctype s-double (:struct s-double))
-
-(defcstruct s-s-double
- (yet-another-char :char)
- (a-s-double s-double)
- (a-short :short))
-
-(defctype s-s-double (:struct s-s-double))
-
-(defcvar "the_s_s_double" s-s-double)
-
-(deftest struct.alignment.3
- (with-foreign-slots
- ((yet-another-char a-s-double a-short) *the-s-s-double* s-s-double)
- (with-foreign-slots ((a-char a-double another-char) a-s-double s-double)
- (list 'a-char a-char
- 'a-double a-double
- 'another-char another-char
- 'yet-another-char yet-another-char
- 'a-short a-short)))
- (a-char 1 a-double 2.0d0 another-char 3 yet-another-char 4 a-short 5))
-
-
-(defcstruct s-s-s-double
- (another-short :short)
- (a-s-s-double s-s-double)
- (last-char :char))
-
-(defctype s-s-s-double (:struct s-s-s-double))
-
-(defcvar "the_s_s_s_double" s-s-s-double)
-
-(deftest struct.alignment.4
- (with-foreign-slots
- ((another-short a-s-s-double last-char) *the-s-s-s-double* s-s-s-double)
- (with-foreign-slots
- ((yet-another-char a-s-double a-short) a-s-s-double s-s-double)
- (with-foreign-slots ((a-char a-double another-char) a-s-double s-double)
- (list 'a-char a-char
- 'a-double a-double
- 'another-char another-char
- 'yet-another-char yet-another-char
- 'a-short a-short
- 'another-short another-short
- 'last-char last-char))))
- (a-char 1 a-double 2.0d0 another-char 3 yet-another-char 4 a-short 5
- another-short 6 last-char 7))
-
-
-(defcstruct s-double2
- (a-double :double)
- (a-short :short))
-
-(defctype s-double2 (:struct s-double2))
-
-(defcstruct s-s-double2
- (a-char :char)
- (a-s-double2 s-double2)
- (another-short :short))
-
-(defctype s-s-double2 (:struct s-s-double2))
-
-(defcvar "the_s_s_double2" s-s-double2)
-
-(deftest struct.alignment.5
- (with-foreign-slots
- ((a-char a-s-double2 another-short) *the-s-s-double2* s-s-double2)
- (with-foreign-slots ((a-double a-short) a-s-double2 s-double2)
- (list 'a-double a-double
- 'a-short a-short
- 'a-char a-char
- 'another-short another-short)))
- (a-double 1.0d0 a-short 2 a-char 3 another-short 4))
-
-(defcstruct s-long-long
- (a-long-long :long-long)
- (a-short :short))
-
-(defctype s-long-long (:struct s-long-long))
-
-(defcstruct s-s-long-long
- (a-char :char)
- (a-s-long-long s-long-long)
- (another-short :short))
-
-(defctype s-s-long-long (:struct s-s-long-long))
-
-(defcvar "the_s_s_long_long" s-s-long-long)
-
-(deftest struct.alignment.6
- (with-foreign-slots
- ((a-char a-s-long-long another-short) *the-s-s-long-long* s-s-long-long)
- (with-foreign-slots ((a-long-long a-short) a-s-long-long s-long-long)
- (list 'a-long-long a-long-long
- 'a-short a-short
- 'a-char a-char
- 'another-short another-short)))
- (a-long-long 1 a-short 2 a-char 3 another-short 4))
-
-(defcstruct s-s-double3
- (a-s-double2 s-double2)
- (another-short :short))
-
-(defctype s-s-double3 (:struct s-s-double3))
-
-(defcstruct s-s-s-double3
- (a-s-s-double3 s-s-double3)
- (a-char :char))
-
-(defctype s-s-s-double3 (:struct s-s-s-double3))
-
-(defcvar "the_s_s_s_double3" s-s-s-double3)
-
-(deftest struct.alignment.7
- (with-foreign-slots ((a-s-s-double3 a-char) *the-s-s-s-double3* s-s-s-double3)
- (with-foreign-slots ((a-s-double2 another-short) a-s-s-double3 s-s-double3)
- (with-foreign-slots ((a-double a-short) a-s-double2 s-double2)
- (list 'a-double a-double
- 'a-short a-short
- 'another-short another-short
- 'a-char a-char))))
- (a-double 1.0d0 a-short 2 another-short 3 a-char 4))
-
-
-(defcstruct empty-struct)
-
-(defctype empty-struct (:struct empty-struct))
-
-(defcstruct with-empty-struct
- (foo empty-struct)
- (an-int :int))
-
-;; commented out this test because an empty struct is not valid/standard C
-;; left the struct declarations anyway because they should be handled
-;; gracefuly anyway.
-
-; (defcvar "the_with_empty_struct" with-empty-struct)
-;
-; (deftest struct.alignment.5
-; (with-foreign-slots ((foo an-int) *the-with-empty-struct* with-empty-struct)
-; an-int)
-; 42)
-
-
-;; regression test, setf-ing nested foreign-slot-value forms
-;; the setf expander used to return a bogus getter
-
-(defcstruct s1
- (an-int :int))
-
-(defctype s1 (:struct s1))
-
-(defcstruct s2
- (an-s1 s1))
-
-(defctype s2 (:struct s2))
-
-(deftest struct.nested-setf
- (with-foreign-object (an-s2 's2)
- (setf (foreign-slot-value (foreign-slot-value an-s2 's2 'an-s1)
- 's1 'an-int)
- 1984)
- (foreign-slot-value (foreign-slot-value an-s2 's2 'an-s1)
- 's1 'an-int))
- 1984)
-
-;; regression test, some Lisps were returning 4 instead of 8 for
-;; (foreign-type-alignment :unsigned-long-long) on darwin/ppc32
-
-(defcstruct s-unsigned-long-long
- (an-unsigned-long-long :unsigned-long-long)
- (a-short :short))
-
-(defctype s-unsigned-long-long (:struct s-unsigned-long-long))
-
-(defcstruct s-s-unsigned-long-long
- (a-char :char)
- (a-s-unsigned-long-long s-unsigned-long-long)
- (another-short :short))
-
-(defctype s-s-unsigned-long-long (:struct s-s-unsigned-long-long))
-
-(defcvar "the_s_s_unsigned_long_long" s-s-unsigned-long-long)
-
-(deftest struct.alignment.8
- (with-foreign-slots
- ((a-char a-s-unsigned-long-long another-short)
- *the-s-s-unsigned-long-long* s-s-unsigned-long-long)
- (with-foreign-slots ((an-unsigned-long-long a-short)
- a-s-unsigned-long-long s-unsigned-long-long)
- (list 'an-unsigned-long-long an-unsigned-long-long
- 'a-short a-short
- 'a-char a-char
- 'another-short another-short)))
- (an-unsigned-long-long 1 a-short 2 a-char 3 another-short 4))
-
-;;;# C Struct Wrappers
-
-(define-c-struct-wrapper timeval ())
-
-(define-c-struct-wrapper (timeval2 (:struct timeval)) ()
- (tv-secs))
-
-(defmacro with-example-timeval (var &body body)
- `(with-foreign-object (,var 'timeval)
- (with-foreign-slots ((tv-secs tv-usecs) ,var timeval)
- (setf tv-secs 42 tv-usecs 1984)
- ,@body)))
-
-(deftest struct-wrapper.1
- (with-example-timeval ptr
- (let ((obj (make-instance 'timeval :pointer ptr)))
- (values (timeval-tv-secs obj)
- (timeval-tv-usecs obj))))
- 42 1984)
-
-(deftest struct-wrapper.2
- (with-example-timeval ptr
- (let ((obj (make-instance 'timeval2 :pointer ptr)))
- (timeval2-tv-secs obj)))
- 42)
-
-;;;# Structures as Values
-
-(defcstruct (struct-pair :class pair)
- (a :int)
- (b :int))
-
-(defctype struct-pair-typedef1 (:struct struct-pair))
-(defctype struct-pair-typedef2 (:pointer (:struct struct-pair)))
-
-(deftest struct.unparse.1
- (mapcar (alexandria:compose #'cffi::unparse-type #'cffi::parse-type)
- '(struct-pair
- (:struct struct-pair)
- struct-pair-typedef1
- struct-pair-typedef2))
- (struct-pair
- (:struct struct-pair)
- struct-pair-typedef1
- struct-pair-typedef2))
-
-(deftest struct.canonicalize.1
- (mapcar #'cffi::canonicalize-foreign-type
- '(struct-pair
- (:struct struct-pair)
- struct-pair-typedef1
- struct-pair-typedef2))
- (:pointer
- (:struct struct-pair)
- (:struct struct-pair)
- :pointer))
-
-(deftest struct.canonicalize.2
- (mapcar #'cffi::canonicalize-foreign-type
- '(struct-pair
- (:struct struct-pair)
- struct-pair-typedef1
- struct-pair-typedef2))
- (:pointer
- (:struct struct-pair)
- (:struct struct-pair)
- :pointer))
-
-(defmethod translate-from-foreign (pointer (type pair))
- (with-foreign-slots ((a b) pointer (:struct struct-pair))
- (cons a b)))
-
-(defmethod translate-into-foreign-memory (object (type pair) pointer)
- (with-foreign-slots ((a b) pointer (:struct struct-pair))
- (setf a (car object)
- b (cdr object))))
-
-(defmethod translate-to-foreign (object (type pair))
- (let ((p (foreign-alloc '(:struct struct-pair))))
- (translate-into-foreign-memory object type p)
- (values p t)))
-
-(defmethod free-translated-object (pointer (type pair) freep)
- (when freep
- (foreign-free pointer)))
-
-(deftest struct-values.translation.1
- (multiple-value-bind (p freep)
- (convert-to-foreign '(1 . 2) 'struct-pair)
- (assert freep)
- (unwind-protect
- (convert-from-foreign p 'struct-pair)
- (free-converted-object p 'struct-pair freep)))
- (1 . 2))
-
-(defcfun "pair_pointer_sum" :int
- (p (:pointer (:struct struct-pair))))
-
-#+#:pointer-translation-not-yet-implemented
-(deftest struct-values.translation.2
- (pair-pointer-sum '(1 . 2))
- 3)
-
-;;; should the return type be something along the lines of
-;;; (:pointer (:struct pair) :free t)?
-;;; LMH: error on ":free t" option?
-(defcfun "alloc_pair" (:pointer (:struct struct-pair))
- (a :int)
- (b :int))
-
-;; bogus: doesn't free() pointer.
-#+#:pointer-translation-not-yet-implemented
-(deftest struct-values.translation.3
- (alloc-pair 1 2)
- (1 . 2))
-
-(deftest struct-values.translation.mem-ref.1
- (with-foreign-object (p '(:struct struct-pair))
- (setf (mem-ref p '(:struct struct-pair)) '(1 . 2))
- (with-foreign-slots ((a b) p (:struct struct-pair))
- (values (mem-ref p '(:struct struct-pair))
- a
- b)))
- (1 . 2)
- 1
- 2)
-
-(deftest struct-values.translation.mem-aref.1
- (with-foreign-object (p '(:struct struct-pair) 2)
- (setf (mem-aref p '(:struct struct-pair) 0) '(1 . 2)
- (mem-aref p '(:struct struct-pair) 1) '(3 . 4))
- (values (mem-aref p '(:struct struct-pair) 0)
- (mem-aref p '(:struct struct-pair) 1)))
- (1 . 2)
- (3 . 4))
-
-(defcstruct (struct-pair-default-translate :class pair-default)
- (a :int)
- (b :int))
-
-(deftest struct-values-default.translation.mem-ref.1
- (with-foreign-object (p '(:struct struct-pair-default-translate))
- (setf (mem-ref p '(:struct struct-pair-default-translate)) '(a 1 b 2))
- (with-foreign-slots ((a b) p (:struct struct-pair-default-translate))
- (let ((plist (mem-ref p '(:struct struct-pair-default-translate))))
- (values (getf plist 'a)
- (getf plist 'b)
- a
- b))))
- 1
- 2
- 1
- 2)
-
-(defcstruct (struct-pair+double :class pair+double)
- (pr (:struct struct-pair-default-translate))
- (dbl :double))
-
-(deftest struct-values-default.translation.mem-ref.2
- (with-foreign-object (p '(:struct struct-pair+double))
- (setf (mem-ref p '(:struct struct-pair+double)) '(pr (a 4 b 5) dbl 2.5d0))
- (with-foreign-slots ((pr dbl) p (:struct struct-pair+double))
- (let ((plist (mem-ref p '(:struct struct-pair+double))))
- (values (getf (getf plist 'pr) 'a)
- (getf (getf plist 'pr) 'b)
- (getf plist 'dbl)))))
- 4
- 5
- 2.5d0)
-
-(defcstruct (struct-pair+1 :class pair+1)
- (p (:pointer (:struct struct-pair)))
- (c :int))
-
-(defctype struct-pair+1 (:struct struct-pair+1))
-
-(defmethod translate-from-foreign (pointer (type pair+1))
- (with-foreign-slots ((p c) pointer struct-pair+1)
- (cons p c)))
-
-(defmethod translate-into-foreign-memory (object (type pair+1) pointer)
- (with-foreign-slots ((c) pointer struct-pair+1)
- (convert-into-foreign-memory (car object)
- 'struct-pair
- (foreign-slot-pointer pointer
- 'struct-pair+1
- 'p))
- (setf c (cdr object))))
-
-(defmethod translate-to-foreign (object (type pair+1))
- (let ((p (foreign-alloc 'struct-pair+1)))
- (translate-into-foreign-memory object type p)
- (values p t)))
-
-(defmethod free-translated-object (pointer (type pair+1) freep)
- (when freep
- (foreign-free pointer)))
-
-#+#:pointer-translation-not-yet-implemented
-(deftest struct-values.translation.ppo.1
- (multiple-value-bind (p freep)
- (convert-to-foreign '((1 . 2) . 3) 'struct-pair+1)
- (assert freep)
- (unwind-protect
- (convert-from-foreign p 'struct-pair+1)
- (free-converted-object p 'struct-pair+1 freep)))
- ((1 . 2) . 3))
-
-#+#:unimplemented
-(defcfun "pair_plus_one_sum" :int
- (p (:struct pair+1)))
-
-(defcfun "pair_plus_one_pointer_sum" :int
- (p (:pointer (:struct struct-pair+1))))
-
-#+#:pointer-translation-not-yet-implemented
-(deftest struct-values.translation.ppo.2
- (pair-plus-one-pointer-sum '((1 . 2) . 3))
- 6)
-
-#+#:unimplemented
-(defcfun "make_pair_plus_one" (:struct pair+1)
- (a :int)
- (b :int)
- (c :int))
-
-(defcfun "alloc_pair_plus_one" struct-pair+1
- (a :int)
- (b :int)
- (c :int))
-
-;; bogus: doesn't free() pointer.
-#+#:pointer-translation-not-yet-implemented
-(deftest struct-values.translation.ppo.3
- (alloc-pair-plus-one 1 2 3)
- ((1 . 2) . 3))
-
-#+#:unimplemented
-(defcfun "pair_sum" :int
- (p (:struct pair)))
-
-#+#:unimplemented
-(defcfun "make_pair" (:struct pair)
- (a :int)
- (b :int))
-
-#|| ; TODO: load cffi-libffi for these tests to work.
-(deftest struct-values.fn.1
- (with-foreign-object (p '(:struct pair))
- (with-foreign-slots ((a b) p (:struct pair))
- (setf a -1 b 2)
- (pair-sum p)))
- 1)
-
-(deftest struct-values.fn.2
- (pair-sum '(3 . 5))
- 8)
-
-(deftest struct-values.fn.3
- (with-foreign-object (p '(:struct pair))
- (make-pair 7 11 :result-pointer p)
- (with-foreign-slots ((a b) p (:struct pair))
- (cons a b)))
- (7 . 11))
-
-(deftest struct-values.fn.4
- (make-pair 13 17)
- (13 . 17))
-||#
-
-(defcstruct single-byte-struct
- (a :uint8))
-
-(deftest bare-struct-types.1
- (eql (foreign-type-size 'single-byte-struct)
- (foreign-type-size '(:struct single-byte-struct)))
- t)
-
-(defctype single-byte-struct-alias (:struct single-byte-struct))
-
-(deftest bare-struct-types.2
- (eql (foreign-type-size 'single-byte-struct-alias)
- (foreign-type-size '(:struct single-byte-struct)))
- t)
-
-;;; Old-style access to inner structure fields.
-
-(defcstruct inner-struct (x :int))
-(defcstruct old-style-outer (inner inner-struct))
-(defcstruct new-style-outer (inner (:struct inner-struct)))
-
-(deftest old-style-struct-access
- (with-foreign-object (s '(:struct old-style-outer))
- (let ((inner-ptr (foreign-slot-pointer s 'old-style-outer 'inner)))
- (setf (foreign-slot-value inner-ptr 'inner-struct 'x) 42))
- (assert (pointerp (foreign-slot-value s 'old-style-outer 'inner)))
- (foreign-slot-value (foreign-slot-value s 'old-style-outer 'inner)
- 'inner-struct 'x))
- 42)
-
-(deftest new-style-struct-access
- (with-foreign-object (s '(:struct new-style-outer))
- (let ((inner-ptr (foreign-slot-pointer s 'new-style-outer 'inner)))
- (setf (foreign-slot-value inner-ptr 'inner-struct 'x) 42))
- (foreign-slot-value s 'new-style-outer 'inner))
- (x 42))
-
-;;; regression test: setting the value of aggregate slots.
-
-(defcstruct aggregate-struct
- (x :int)
- (pair (:struct struct-pair))
- (y :int))
-
-(deftest set-aggregate-struct-slot
- (with-foreign-objects ((pair-struct '(:struct struct-pair))
- (aggregate-struct '(:struct aggregate-struct)))
- (with-foreign-slots ((a b) pair-struct (:struct struct-pair))
- (setf a 1 b 2)
- (with-foreign-slots ((x pair y) aggregate-struct (:struct aggregate-struct))
- (setf x 42 y 42)
- (setf pair pair-struct)
- (values x pair y))))
- 42
- (1 . 2)
- 42)
-
-;; TODO this needs to go through compile-file to exhibit the error
-;; ("don't know how to dump #<CFFI::AGGREGATE-STRUCT-SLOT>"), but
-;; there's no support for that, so let's leave it at toplevel here.
-(defcstruct (aggregate-struct.acc :conc-name acc-)
- (x :int)
- (pair (:struct struct-pair))
- (y :int))
-
-(deftest set-aggregate-struct-slot.acc
- (with-foreign-objects ((pair-struct '(:struct struct-pair))
- (aggregate-struct '(:struct aggregate-struct)))
- (with-foreign-slots ((a b) pair-struct (:struct struct-pair))
- (setf a 1 b 2)
- (setf (acc-x aggregate-struct) 42)
- (setf (acc-y aggregate-struct) 42)
- (setf (acc-pair aggregate-struct) pair-struct)
- (values (acc-x aggregate-struct)
- (acc-pair aggregate-struct)
- (acc-y aggregate-struct))))
- 42
- (1 . 2)
- 42)
(DIR) diff --git a/3rdparties/software/cffi_0.20.0/tests/test-asdf.lisp b/3rdparties/software/cffi_0.20.0/tests/test-asdf.lisp
@@ -1,42 +0,0 @@
-;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
-;;;
-;;; asdf.lisp --- CFFI-Grovel asdf support tests.
-;;;
-;;; Copyright (C) 2015, Luis Oliveira <loliveira@common-lisp.net>
-;;;
-;;; Permission is hereby granted, free of charge, to any person
-;;; obtaining a copy of this software and associated documentation
-;;; files (the "Software"), to deal in the Software without
-;;; restriction, including without limitation the rights to use, copy,
-;;; modify, merge, publish, distribute, sublicense, and/or sell copies
-;;; of the Software, and to permit persons to whom the Software is
-;;; furnished to do so, subject to the following conditions:
-;;;
-;;; The above copyright notice and this permission notice shall be
-;;; included in all copies or substantial portions of the Software.
-;;;
-;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
-;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
-;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
-;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
-;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
-;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
-;;; DEALINGS IN THE SOFTWARE.
-;;;
-
-(in-package #:cffi-tests)
-
-#.(when (cffi-toolchain::static-ops-enabled-p)
- '(deftest test-static-program
- (progn
- (asdf:operate :static-program-op :cffi-tests/example)
- (let ((program (asdf:output-file :static-program-op :cffi-tests/example)))
- (uiop:run-program `(,(native-namestring program) "1" "2 3") :output :lines)))
- ("Arguments: 1 \"2 3\"" "hello, world!") nil 0))
-
-(deftest test-asdf-load
- (progn
- (asdf:load-system :cffi-tests/example)
- (uiop:symbol-call :cffi-example :check-groveller))
- nil)
(DIR) diff --git a/3rdparties/software/cffi_0.20.0/tests/test-static-link.sh b/3rdparties/software/cffi_0.20.0/tests/test-static-link.sh
@@ -1,9 +0,0 @@
-#!/bin/sh -eux
-
-for l in sbcl ; do # mkcl ecl clisp sbcl
- EX="$(cl-launch -l $l -sp cffi-toolchain -ip "(output-file :static-program-op :cffi-tests/example)")"
- rm -f $EX ; :
- cl-launch -l $l -sp cffi-toolchain -i "(operate :static-program-op :cffi-tests/example)"
- [ -f $EX ]
- [ "$($EX)" = "hello, world!" ]
-done
(DIR) diff --git a/3rdparties/software/cffi_0.20.0/tests/union.lisp b/3rdparties/software/cffi_0.20.0/tests/union.lisp
@@ -1,52 +0,0 @@
-;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
-;;;
-;;; union.lisp --- Tests on C unions.
-;;;
-;;; Copyright (C) 2005-2006, James Bielman <jamesjb@jamesjb.com>
-;;;
-;;; Permission is hereby granted, free of charge, to any person
-;;; obtaining a copy of this software and associated documentation
-;;; files (the "Software"), to deal in the Software without
-;;; restriction, including without limitation the rights to use, copy,
-;;; modify, merge, publish, distribute, sublicense, and/or sell copies
-;;; of the Software, and to permit persons to whom the Software is
-;;; furnished to do so, subject to the following conditions:
-;;;
-;;; The above copyright notice and this permission notice shall be
-;;; included in all copies or substantial portions of the Software.
-;;;
-;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
-;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
-;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
-;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
-;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
-;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
-;;; DEALINGS IN THE SOFTWARE.
-;;;
-
-(in-package #:cffi-tests)
-
-(defcunion uint32-bytes
- (int-value :unsigned-int)
- (bytes :unsigned-char :count 4))
-
-(defctype uint32-bytes (:union uint32-bytes))
-
-(defun int-to-bytes (n)
- "Convert N to a list of bytes using a union."
- (with-foreign-object (obj 'uint32-bytes)
- (setf (foreign-slot-value obj 'uint32-bytes 'int-value) n)
- (loop for i from 0 below 4
- collect (mem-aref
- (foreign-slot-value obj 'uint32-bytes 'bytes)
- :unsigned-char i))))
-
-(deftest union.1
- (let ((bytes (int-to-bytes #x12345678)))
- (cond ((equal bytes '(#x12 #x34 #x56 #x78))
- t)
- ((equal bytes '(#x78 #x56 #x34 #x12))
- t)
- (t bytes)))
- t)
(DIR) diff --git a/3rdparties/software/cffi_0.20.0/toolchain/bundle.lisp b/3rdparties/software/cffi_0.20.0/toolchain/bundle.lisp
@@ -1,565 +0,0 @@
-;;;; -------------------------------------------------------------------------
-;;;; ASDF-Bundle
-
-(uiop/package:define-package :asdf/bundle
- (:recycle :asdf/bundle :asdf)
- (:use :uiop/common-lisp :uiop :asdf/upgrade
- :asdf/component :asdf/system :asdf/find-system :asdf/find-component :asdf/operation
- :asdf/action :asdf/lisp-action :asdf/plan :asdf/operate :asdf/defsystem)
- (:export
- #:bundle-op #:bundle-type #:program-system
- #:bundle-system #:bundle-pathname-type #:direct-dependency-files
- #:monolithic-op #:monolithic-bundle-op #:operation-monolithic-p
- #:basic-compile-bundle-op #:prepare-bundle-op
- #:compile-bundle-op #:load-bundle-op #:monolithic-compile-bundle-op #:monolithic-load-bundle-op
- #:lib-op #:monolithic-lib-op
- #:dll-op #:monolithic-dll-op
- #:deliver-asd-op #:monolithic-deliver-asd-op
- #:program-op #:image-op #:compiled-file #:precompiled-system #:prebuilt-system
- #:user-system-p #:user-system #:trivial-system-p
- #:prologue-code #:epilogue-code #:static-library))
-(in-package :asdf/bundle)
-
-(with-upgradability ()
- (defclass bundle-op (basic-compile-op)
- ;; NB: use of instance-allocated slots for operations is DEPRECATED
- ;; and only supported in a temporary fashion for backward compatibility.
- ;; Supported replacement: Define slots on program-system instead.
- ((bundle-type :initform :no-output-file :reader bundle-type :allocation :class))
- (:documentation "base class for operations that bundle outputs from multiple components"))
-
- (defclass monolithic-op (operation) ()
- (:documentation "A MONOLITHIC operation operates on a system *and all of its
-dependencies*. So, for example, a monolithic concatenate operation will
-concatenate together a system's components and all of its dependencies, but a
-simple concatenate operation will concatenate only the components of the system
-itself."))
-
- (defclass monolithic-bundle-op (bundle-op monolithic-op)
- ;; Old style way of specifying prologue and epilogue on ECL: in the monolithic operation.
- ;; DEPRECATED. Supported replacement: Define slots on program-system instead.
- ((prologue-code :initform nil :accessor prologue-code)
- (epilogue-code :initform nil :accessor epilogue-code))
- (:documentation "operations that are both monolithic-op and bundle-op"))
-
- (defclass program-system (system)
- ;; New style (ASDF3.1) way of specifying prologue and epilogue on ECL: in the system
- ((prologue-code :initform nil :initarg :prologue-code :reader prologue-code)
- (epilogue-code :initform nil :initarg :epilogue-code :reader epilogue-code)
- (no-uiop :initform nil :initarg :no-uiop :reader no-uiop)
- (prefix-lisp-object-files :initarg :prefix-lisp-object-files
- :initform nil :accessor prefix-lisp-object-files)
- (postfix-lisp-object-files :initarg :postfix-lisp-object-files
- :initform nil :accessor postfix-lisp-object-files)
- (extra-object-files :initarg :extra-object-files
- :initform nil :accessor extra-object-files)
- (extra-build-args :initarg :extra-build-args
- :initform nil :accessor extra-build-args)))
-
- (defmethod prologue-code ((x system)) nil)
- (defmethod epilogue-code ((x system)) nil)
- (defmethod no-uiop ((x system)) nil)
- (defmethod prefix-lisp-object-files ((x system)) nil)
- (defmethod postfix-lisp-object-files ((x system)) nil)
- (defmethod extra-object-files ((x system)) nil)
- (defmethod extra-build-args ((x system)) nil)
-
- (defclass link-op (bundle-op) ()
- (:documentation "Abstract operation for linking files together"))
-
- (defclass gather-operation (bundle-op)
- ((gather-operation :initform nil :allocation :class :reader gather-operation)
- (gather-type :initform :no-output-file :allocation :class :reader gather-type))
- (:documentation "Abstract operation for gathering many input files from a system"))
-
- (defun operation-monolithic-p (op)
- (typep op 'monolithic-op))
-
- ;; Dependencies of a gather-op are the actions of the dependent operation
- ;; for all the (sorted) required components for loading the system.
- ;; Monolithic operations typically use lib-op as the dependent operation,
- ;; and all system-level dependencies as required components.
- ;; Non-monolithic operations typically use compile-op as the dependent operation,
- ;; and all transitive sub-components as required components (excluding other systems).
- (defmethod component-depends-on ((o gather-operation) (s system))
- (let* ((mono (operation-monolithic-p o))
- (go (make-operation (or (gather-operation o) 'compile-op)))
- (bundle-p (typep go 'bundle-op))
- ;; In a non-mono operation, don't recurse to other systems.
- ;; In a mono operation gathering bundles, don't recurse inside systems.
- (component-type (if mono (if bundle-p 'system t) '(not system)))
- ;; In the end, only keep system bundles or non-system bundles, depending.
- (keep-component (if bundle-p 'system '(not system)))
- (deps
- ;; Required-components only looks at the dependencies of an action, excluding the action
- ;; itself, so it may be safely used by an action recursing on its dependencies (which
- ;; may or may not be an overdesigned API, since in practice we never use it that way).
- ;; Therefore, if we use :goal-operation 'load-op :keep-operation 'load-op, which looks
- ;; cleaner, we will miss the load-op on the requested system itself, which doesn't
- ;; matter for a regular system, but matters, a lot, for a package-inferred-system.
- ;; Using load-op as the goal operation and basic-compile-op as the keep-operation works
- ;; for our needs of gathering all the files we want to include in a bundle.
- ;; Note that we use basic-compile-op rather than compile-op so it will still work on
- ;; systems when *load-system-operation* is load-bundle-op.
- (required-components
- s :other-systems mono :component-type component-type :keep-component keep-component
- :goal-operation 'load-op :keep-operation 'basic-compile-op)))
- `((,go ,@deps) ,@(call-next-method))))
-
- ;; Create a single fasl for the entire library
- (defclass basic-compile-bundle-op (bundle-op)
- ((gather-type :initform #-(or clasp ecl mkcl) :fasl #+(or clasp ecl mkcl) :object
- :allocation :class)
- (bundle-type :initform :fasl :allocation :class))
- (:documentation "Base class for compiling into a bundle"))
-
- ;; Analog to prepare-op, for load-bundle-op and compile-bundle-op
- (defclass prepare-bundle-op (sideway-operation)
- ((sideway-operation
- :initform #+(or clasp ecl mkcl) 'load-bundle-op #-(or clasp ecl mkcl) 'load-op
- :allocation :class))
- (:documentation "Operation class for loading the bundles of a system's dependencies"))
-
- (defclass lib-op (link-op gather-operation non-propagating-operation)
- ((gather-type :initform :object :allocation :class)
- (bundle-type :initform :lib :allocation :class))
- (:documentation "Compile the system and produce a linkable static library (.a/.lib)
-for all the linkable object files associated with the system. Compare with DLL-OP.
-
-On most implementations, these object files only include extensions to the runtime
-written in C or another language with a compiler producing linkable object files.
-On CLASP, ECL, MKCL, these object files _also_ include the contents of Lisp files
-themselves. In any case, this operation will produce what you need to further build
-a static runtime for your system, or a dynamic library to load in an existing runtime."))
-
- ;; What works: on ECL, CLASP(?), MKCL, we link the many .o files from the system into the .so;
- ;; on other implementations, we combine (usually concatenate) the .fasl files into one.
- (defclass compile-bundle-op (basic-compile-bundle-op selfward-operation gather-operation
- #+(or clasp ecl mkcl) link-op)
- ((selfward-operation :initform '(prepare-bundle-op) :allocation :class))
- (:documentation "This operator is an alternative to COMPILE-OP. Build a system
-and all of its dependencies, but build only a single (\"monolithic\") FASL, instead
-of one per source file, which may be more resource efficient. That monolithic
-FASL should be loaded with LOAD-BUNDLE-OP, rather than LOAD-OP."))
-
- (defclass load-bundle-op (basic-load-op selfward-operation)
- ((selfward-operation :initform '(prepare-bundle-op compile-bundle-op) :allocation :class))
- (:documentation "This operator is an alternative to LOAD-OP. Build a system
-and all of its dependencies, using COMPILE-BUNDLE-OP. The difference with
-respect to LOAD-OP is that it builds only a single FASL, which may be
-faster and more resource efficient."))
-
- ;; NB: since the monolithic-op's can't be sideway-operation's,
- ;; if we wanted lib-op, dll-op, deliver-asd-op to be sideway-operation's,
- ;; we'd have to have the monolithic-op not inherit from the main op,
- ;; but instead inherit from a basic-FOO-op as with basic-compile-bundle-op above.
-
- (defclass dll-op (link-op gather-operation non-propagating-operation)
- ((gather-type :initform :object :allocation :class)
- (bundle-type :initform :dll :allocation :class))
- (:documentation "Compile the system and produce a dynamic loadable library (.so/.dll)
-for all the linkable object files associated with the system. Compare with LIB-OP."))
-
- (defclass deliver-asd-op (basic-compile-op selfward-operation)
- ((selfward-operation
- ;; TODO: implement link-op on all implementations, and make that
- ;; '(compile-bundle-op lib-op #-(or clasp ecl mkcl) dll-op)
- :initform '(compile-bundle-op #+(or clasp ecl mkcl) lib-op)
- :allocation :class))
- (:documentation "produce an asd file for delivering the system as a single fasl"))
-
-
- (defclass monolithic-deliver-asd-op (deliver-asd-op monolithic-bundle-op)
- ((selfward-operation
- ;; TODO: implement link-op on all implementations, and make that
- ;; '(monolithic-compile-bundle-op monolithic-lib-op #-(or clasp ecl mkcl) monolithic-dll-op)
- :initform '(monolithic-compile-bundle-op #+(or clasp ecl mkcl) monolithic-lib-op)
- :allocation :class))
- (:documentation "produce fasl and asd files for combined system and dependencies."))
-
- (defclass monolithic-compile-bundle-op
- (basic-compile-bundle-op monolithic-bundle-op
- #+(or clasp ecl mkcl) link-op gather-operation non-propagating-operation)
- ()
- (:documentation "Create a single fasl for the system and its dependencies."))
-
- (defclass monolithic-load-bundle-op (load-bundle-op monolithic-bundle-op)
- ((selfward-operation :initform 'monolithic-compile-bundle-op :allocation :class))
- (:documentation "Load a single fasl for the system and its dependencies."))
-
- (defclass monolithic-lib-op (lib-op monolithic-bundle-op non-propagating-operation)
- ((gather-type :initform :object :allocation :class))
- (:documentation "Compile the system and produce a linkable static library (.a/.lib)
-for all the linkable object files associated with the system or its dependencies. See LIB-OP."))
-
- (defclass monolithic-dll-op (dll-op monolithic-bundle-op non-propagating-operation)
- ((gather-type :initform :object :allocation :class))
- (:documentation "Compile the system and produce a dynamic loadable library (.so/.dll)
-for all the linkable object files associated with the system or its dependencies. See LIB-OP"))
-
- (defclass image-op (monolithic-bundle-op selfward-operation
- #+(or clasp ecl mkcl) link-op #+(or clasp ecl mkcl) gather-operation)
- ((bundle-type :initform :image :allocation :class)
- (gather-operation :initform 'lib-op :allocation :class)
- #+(or clasp ecl mkcl) (gather-type :initform :static-library :allocation :class)
- (selfward-operation :initform '(#-(or clasp ecl mkcl) load-op) :allocation :class))
- (:documentation "create an image file from the system and its dependencies"))
-
- (defclass program-op (image-op)
- ((bundle-type :initform :program :allocation :class))
- (:documentation "create an executable file from the system and its dependencies"))
-
- ;; From the ASDF-internal bundle-type identifier, get a filesystem-usable pathname type.
- (defun bundle-pathname-type (bundle-type)
- (etypecase bundle-type
- ((or null string) ;; pass through nil or string literal
- bundle-type)
- ((eql :no-output-file) ;; marker for a bundle-type that has NO output file
- (error "No output file, therefore no pathname type"))
- ((eql :fasl) ;; the type of a fasl
- #-(or clasp ecl mkcl) (compile-file-type) ; on image-based platforms, used as input and output
- #+(or clasp ecl mkcl) "fasb") ; on C-linking platforms, only used as output for system bundles
- ((member :image)
- #+allegro "dxl"
- #+(and clisp os-windows) "exe"
- #-(or allegro (and clisp os-windows)) "image")
- ;; NB: on CLASP and ECL these implementations, we better agree with
- ;; (compile-file-type :type bundle-type))
- ((eql :object) ;; the type of a linkable object file
- (os-cond ((os-unix-p) "o")
- ((os-windows-p) (if (featurep '(:or :mingw32 :mingw64)) "o" "obj"))))
- ((member :lib :static-library) ;; the type of a linkable library
- (os-cond ((os-unix-p) "a")
- ((os-windows-p) (if (featurep '(:or :mingw32 :mingw64)) "a" "lib"))))
- ((member :dll :shared-library) ;; the type of a shared library
- (os-cond ((os-macosx-p) "dylib") ((os-unix-p) "so") ((os-windows-p) "dll")))
- ((eql :program) ;; the type of an executable program
- (os-cond ((os-unix-p) nil) ((os-windows-p) "exe")))))
-
- ;; Compute the output-files for a given bundle action
- (defun bundle-output-files (o c)
- (let ((bundle-type (bundle-type o)))
- (unless (or (eq bundle-type :no-output-file) ;; NIL already means something regarding type.
- (and (null (input-files o c)) (not (member bundle-type '(:image :program)))))
- (let ((name (or (component-build-pathname c)
- (let ((suffix
- (unless (typep o 'program-op)
- ;; "." is no good separator for Logical Pathnames, so we use "--"
- (if (operation-monolithic-p o)
- "--all-systems"
- ;; These use a different type .fasb or .a instead of .fasl
- #-(or clasp ecl mkcl) "--system"))))
- (format nil "~A~@[~A~]" (component-name c) suffix))))
- (type (bundle-pathname-type bundle-type)))
- (values (list (subpathname (component-pathname c) name :type type))
- (eq (class-of o) (coerce-class (component-build-operation c)
- :package :asdf/interface
- :super 'operation
- :error nil)))))))
-
- (defmethod output-files ((o bundle-op) (c system))
- (bundle-output-files o c))
-
- #-(or clasp ecl mkcl)
- (progn
- (defmethod perform ((o image-op) (c system))
- (dump-image (output-file o c) :executable (typep o 'program-op)))
- (defmethod perform :before ((o program-op) (c system))
- (setf *image-entry-point* (ensure-function (component-entry-point c)))))
-
- (defclass compiled-file (file-component)
- ((type :initform #-(or clasp ecl mkcl) (compile-file-type) #+(or clasp ecl mkcl) "fasb"))
- (:documentation "Class for a file that is already compiled,
-e.g. as part of the implementation, of an outer build system that calls into ASDF,
-or of opaque libraries shipped along the source code."))
-
- (defclass precompiled-system (system)
- ((build-pathname :initarg :fasl))
- (:documentation "Class For a system that is delivered as a precompiled fasl"))
-
- (defclass prebuilt-system (system)
- ((build-pathname :initarg :static-library :initarg :lib
- :accessor prebuilt-system-static-library))
- (:documentation "Class for a system delivered with a linkable static library (.a/.lib)")))
-
-
-;;;
-;;; BUNDLE-OP
-;;;
-;;; This operation takes all components from one or more systems and
-;;; creates a single output file, which may be
-;;; a FASL, a statically linked library, a shared library, etc.
-;;; The different targets are defined by specialization.
-;;;
-(when-upgrading (:version "3.2.0")
- ;; Cancel any previously defined method
- (defmethod initialize-instance :after ((instance bundle-op) &rest initargs &key &allow-other-keys)
- (declare (ignore initargs))))
-
-(with-upgradability ()
- (defgeneric trivial-system-p (component))
-
- (defun user-system-p (s)
- (and (typep s 'system)
- (not (builtin-system-p s))
- (not (trivial-system-p s)))))
-
-(eval-when (#-lispworks :compile-toplevel :load-toplevel :execute)
- (deftype user-system () '(and system (satisfies user-system-p))))
-
-;;;
-;;; First we handle monolithic bundles.
-;;; These are standalone systems which contain everything,
-;;; including other ASDF systems required by the current one.
-;;; A PROGRAM is always monolithic.
-;;;
-;;; MONOLITHIC SHARED LIBRARIES, PROGRAMS, FASL
-;;;
-(with-upgradability ()
- (defun direct-dependency-files (o c &key (test 'identity) (key 'output-files) &allow-other-keys)
- ;; This function selects output files from direct dependencies;
- ;; your component-depends-on method must gather the correct dependencies in the correct order.
- (while-collecting (collect)
- (map-direct-dependencies
- t o c #'(lambda (sub-o sub-c)
- (loop :for f :in (funcall key sub-o sub-c)
- :when (funcall test f) :do (collect f))))))
-
- (defun pathname-type-equal-function (type)
- #'(lambda (p) (equalp (pathname-type p) type)))
-
- (defmethod input-files ((o gather-operation) (c system))
- (unless (eq (bundle-type o) :no-output-file)
- (direct-dependency-files
- o c :key 'output-files
- :test (pathname-type-equal-function (bundle-pathname-type (gather-type o))))))
-
- ;; Find the operation that produces a given bundle-type
- (defun select-bundle-operation (type &optional monolithic)
- (ecase type
- ((:dll :shared-library)
- (if monolithic 'monolithic-dll-op 'dll-op))
- ((:lib :static-library)
- (if monolithic 'monolithic-lib-op 'lib-op))
- ((:fasl)
- (if monolithic 'monolithic-compile-bundle-op 'compile-bundle-op))
- ((:image)
- 'image-op)
- ((:program)
- 'program-op))))
-
-;;;
-;;; LOAD-BUNDLE-OP
-;;;
-;;; This is like ASDF's LOAD-OP, but using bundle fasl files.
-;;;
-(with-upgradability ()
- (defmethod component-depends-on ((o load-bundle-op) (c system))
- `((,o ,@(component-sideway-dependencies c))
- (,(if (user-system-p c) 'compile-bundle-op 'load-op) ,c)
- ,@(call-next-method)))
-
- (defmethod input-files ((o load-bundle-op) (c system))
- (when (user-system-p c)
- (output-files (find-operation o 'compile-bundle-op) c)))
-
- (defmethod perform ((o load-bundle-op) (c system))
- (when (input-files o c)
- (perform-lisp-load-fasl o c)))
-
- (defmethod mark-operation-done :after ((o load-bundle-op) (c system))
- (mark-operation-done (find-operation o 'load-op) c)))
-
-;;;
-;;; PRECOMPILED FILES
-;;;
-;;; This component can be used to distribute ASDF systems in precompiled form.
-;;; Only useful when the dependencies have also been precompiled.
-;;;
-(with-upgradability ()
- (defmethod trivial-system-p ((s system))
- (every #'(lambda (c) (typep c 'compiled-file)) (component-children s)))
-
- (defmethod input-files ((o operation) (c compiled-file))
- (list (component-pathname c)))
- (defmethod perform ((o load-op) (c compiled-file))
- (perform-lisp-load-fasl o c))
- (defmethod perform ((o load-source-op) (c compiled-file))
- (perform (find-operation o 'load-op) c))
- (defmethod perform ((o operation) (c compiled-file))
- nil))
-
-;;;
-;;; Pre-built systems
-;;;
-(with-upgradability ()
- (defmethod trivial-system-p ((s prebuilt-system))
- t)
-
- (defmethod perform ((o link-op) (c prebuilt-system))
- nil)
-
- (defmethod perform ((o basic-compile-bundle-op) (c prebuilt-system))
- nil)
-
- (defmethod perform ((o lib-op) (c prebuilt-system))
- nil)
-
- (defmethod perform ((o dll-op) (c prebuilt-system))
- nil)
-
- (defmethod component-depends-on ((o gather-operation) (c prebuilt-system))
- nil)
-
- (defmethod output-files ((o lib-op) (c prebuilt-system))
- (values (list (prebuilt-system-static-library c)) t)))
-
-
-;;;
-;;; PREBUILT SYSTEM CREATOR
-;;;
-(with-upgradability ()
- (defmethod output-files ((o deliver-asd-op) (s system))
- (list (make-pathname :name (component-name s) :type "asd"
- :defaults (component-pathname s))))
-
- (defmethod perform ((o deliver-asd-op) (s system))
- (let* ((inputs (input-files o s))
- (fasl (first inputs))
- (library (second inputs))
- (asd (first (output-files o s)))
- (name (if (and fasl asd) (pathname-name asd) (return-from perform)))
- (version (component-version s))
- (dependencies
- (if (operation-monolithic-p o)
- ;; We want only dependencies, and we use basic-load-op rather than load-op so that
- ;; this will keep working on systems when *load-system-operation* is load-bundle-op
- (remove-if-not 'builtin-system-p
- (required-components s :component-type 'system
- :keep-operation 'basic-load-op))
- (while-collecting (x) ;; resolve the sideway-dependencies of s
- (map-direct-dependencies
- t 'load-op s
- #'(lambda (o c)
- (when (and (typep o 'load-op) (typep c 'system))
- (x c)))))))
- (depends-on (mapcar 'coerce-name dependencies)))
- (when (pathname-equal asd (system-source-file s))
- (cerror "overwrite the asd file"
- "~/asdf-action:format-action/ is going to overwrite the system definition file ~S ~
-which is probably not what you want; you probably need to tweak your output translations."
- (cons o s) asd))
- (with-open-file (s asd :direction :output :if-exists :supersede
- :if-does-not-exist :create)
- (format s ";;; Prebuilt~:[~; monolithic~] ASDF definition for system ~A~%"
- (operation-monolithic-p o) name)
- (format s ";;; Built for ~A ~A on a ~A/~A ~A~%"
- (lisp-implementation-type)
- (lisp-implementation-version)
- (software-type)
- (machine-type)
- (software-version))
- (let ((*package* (find-package :asdf-user)))
- (pprint `(defsystem ,name
- :class prebuilt-system
- :version ,version
- :depends-on ,depends-on
- :components ((:compiled-file ,(pathname-name fasl)))
- ,@(when library `(:lib ,(file-namestring library))))
- s)
- (terpri s)))))
-
- #-(or clasp ecl mkcl)
- (defmethod perform ((o basic-compile-bundle-op) (c system))
- (let* ((input-files (input-files o c))
- (fasl-files (remove (compile-file-type) input-files :key #'pathname-type :test-not #'equalp))
- (non-fasl-files (remove (compile-file-type) input-files :key #'pathname-type :test #'equalp))
- (output-files (output-files o c))
- (output-file (first output-files)))
- (assert (eq (not input-files) (not output-files)))
- (when input-files
- (when non-fasl-files
- (error "On ~A, asdf/bundle can only bundle FASL files, but these were also produced: ~S"
- (implementation-type) non-fasl-files))
- (when (or (prologue-code c) (epilogue-code c))
- (error "prologue-code and epilogue-code are not supported on ~A"
- (implementation-type)))
- (with-staging-pathname (output-file)
- (combine-fasls fasl-files output-file)))))
-
- (defmethod input-files ((o load-op) (s precompiled-system))
- (bundle-output-files (find-operation o 'compile-bundle-op) s))
-
- (defmethod perform ((o load-op) (s precompiled-system))
- (perform-lisp-load-fasl o s))
-
- (defmethod component-depends-on ((o load-bundle-op) (s precompiled-system))
- #+xcl (declare (ignorable o))
- `((load-op ,s) ,@(call-next-method))))
-
-#| ;; Example use:
-(asdf:defsystem :precompiled-asdf-utils :class asdf::precompiled-system :fasl (asdf:apply-output-translations (asdf:system-relative-pathname :asdf-utils "asdf-utils.system.fasl")))
-(asdf:load-system :precompiled-asdf-utils)
-|#
-
-#+(or clasp ecl mkcl)
-(with-upgradability ()
-
- #+ecl ;; doesn't work on clasp or mkcl (yet?).
- (unless (use-ecl-byte-compiler-p)
- (setf *load-system-operation* 'load-bundle-op))
-
- (defun system-module-pathname (module)
- (let ((name (coerce-name module)))
- (some
- 'file-exists-p
- (list
- #+clasp (compile-file-pathname (make-pathname :name name :defaults "sys:") :output-type :object)
- #+ecl (compile-file-pathname (make-pathname :name name :defaults "sys:") :type :lib)
- #+ecl (compile-file-pathname (make-pathname :name name :defaults "sys:") :type :object)
- #+mkcl (make-pathname :name name :type (bundle-pathname-type :lib) :defaults #p"sys:")
- #+mkcl (make-pathname :name name :type (bundle-pathname-type :lib) :defaults #p"sys:contrib;")))))
-
- (defun make-prebuilt-system (name &optional (pathname (system-module-pathname name)))
- "Creates a prebuilt-system if PATHNAME isn't NIL."
- (when pathname
- (make-instance 'prebuilt-system
- :name (coerce-name name)
- :static-library (resolve-symlinks* pathname))))
-
- (defmethod component-depends-on :around ((o image-op) (c system))
- (destructuring-bind ((lib-op . deps)) (call-next-method)
- (labels ((has-it-p (x) (find x deps :test 'equal :key 'coerce-name))
- (ensure-linkable-system (x)
- (unless (has-it-p x)
- (or (if-let (s (find-system x))
- (and (system-source-directory x)
- (list s)))
- (if-let (p (system-module-pathname x))
- (list (make-prebuilt-system x p)))))))
- `((,lib-op
- ,@(unless (no-uiop c)
- (append (ensure-linkable-system "cmp")
- (or (ensure-linkable-system "uiop")
- (ensure-linkable-system "asdf"))))
- ,@deps)))))
-
- (defmethod perform ((o link-op) (c system))
- (let* ((object-files (input-files o c))
- (output (output-files o c))
- (bundle (first output))
- (programp (typep o 'program-op))
- (kind (bundle-type o)))
- (when output
- (apply 'create-image
- bundle (append
- (when programp (prefix-lisp-object-files c))
- object-files
- (when programp (postfix-lisp-object-files c)))
- :kind kind
- :prologue-code (when programp (prologue-code c))
- :epilogue-code (when programp (epilogue-code c))
- :build-args (when programp (extra-build-args c))
- :extra-object-files (when programp (extra-object-files c))
- :no-uiop (no-uiop c)
- (when programp `(:entry-point ,(component-entry-point c))))))))
(DIR) diff --git a/3rdparties/software/cffi_0.20.0/toolchain/c-toolchain.lisp b/3rdparties/software/cffi_0.20.0/toolchain/c-toolchain.lisp
@@ -1,392 +0,0 @@
-;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
-;;;
-;;; c-toolchain.lisp --- Generic support compiling and linking C code.
-;;;
-;;; Copyright (C) 2005-2006, Dan Knap <dankna@accela.net>
-;;; Copyright (C) 2005-2006, Emily Backes <lucca@accela.net>
-;;; Copyright (C) 2007, Stelian Ionescu <sionescu@cddr.org>
-;;; Copyright (C) 2007, Luis Oliveira <loliveira@common-lisp.net>
-;;;
-;;; Permission is hereby granted, free of charge, to any person
-;;; obtaining a copy of this software and associated documentation
-;;; files (the "Software"), to deal in the Software without
-;;; restriction, including without limitation the rights to use, copy,
-;;; modify, merge, publish, distribute, sublicense, and/or sell copies
-;;; of the Software, and to permit persons to whom the Software is
-;;; furnished to do so, subject to the following conditions:
-;;;
-;;; The above copyright notice and this permission notice shall be
-;;; included in all copies or substantial portions of the Software.
-;;;
-;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
-;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
-;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
-;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
-;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
-;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
-;;; DEALINGS IN THE SOFTWARE.
-;;;
-
-(in-package #:cffi-toolchain)
-
-;;; Utils
-
-(defun parse-command-flags (flags)
- (let ((separators '(#\Space #\Tab #\Newline #\Return)))
- (remove-if 'emptyp (split-string flags :separator separators))))
-
-(defun parse-command-flags-list (strings)
- (loop for flags in strings append (parse-command-flags flags)))
-
-(defun program-argument (x)
- (etypecase x
- (string x)
- (pathname (native-namestring x))))
-
-(defun invoke (command &rest args)
- (when (pathnamep command)
- (setf command (native-namestring command))
- #+os-unix
- (unless (absolute-pathname-p command)
- (setf command (strcat "./" command))))
- (let ((cmd (cons command (mapcar 'program-argument args))))
- (safe-format! *debug-io* "; ~A~%" (escape-command cmd))
- (run-program cmd :output :interactive :error-output :interactive)))
-
-
-;;; C support
-
-(defparameter *cc* nil "C compiler")
-(defparameter *cc-flags* nil "flags for the C compiler")
-(defparameter *ld* nil "object linker") ;; NB: can actually be the same as *cc*
-(defparameter *ld-exe-flags* nil "flags for linking executables via *ld*")
-(defparameter *ld-dll-flags* nil "flags for linking shared library via *ld*")
-(defparameter *linkkit-start* nil "flags for the implementation linkkit, start")
-(defparameter *linkkit-end* nil "flags for the implementation linkkit, end")
-
-(defun link-all-library (lib)
- ;; Flags to provide to cc to link a whole library into an executable
- (when lib
- (if (featurep :darwin) ;; actually, LLVM ld vs GNU ld
- `("-Wl,-force_load" ,lib)
- `("-Wl,--whole-archive" ,lib "-Wl,--no-whole-archive"))))
-
-(defun normalize-flags (directory flags)
- (loop for val in (parse-command-flags flags) collect
- (cond
- ((find (first-char val) "-+/") val)
- ((probe-file* (subpathname directory val)))
- (t val))))
-
-(defun implementation-file (file &optional type)
- (subpathname (lisp-implementation-directory) file
- :type (bundle-pathname-type type)))
-
-;; TODO: on CCL, extract data from
-;; (pathname (strcat "ccl:lisp-kernel/" (ccl::kernel-build-directory) "/Makefile")) ?
-
-#+clisp
-(progn
- (defparameter *clisp-toolchain-parameters*
- '(("CC" *cc*)
- ("CFLAGS" *cc-flags* t)
- ("CLFLAGS" *cc-exe-flags* t)
- ("LIBS" *linkkit-start* t)
- ("X_LIBS" *linkkit-end* t)))
- (defun clisp-toolchain-parameters (&optional linkset)
- (nest
- (let* ((linkset (ensure-pathname
- (or linkset "base")
- :defaults (lisp-implementation-directory)
- :ensure-absolute t
- :ensure-directory t
- :want-existing t))
- (makevars (subpathname linkset "makevars"))))
- (with-input-file (params makevars :if-does-not-exist nil))
- (when params)
- (loop for l = (read-line params nil nil) while l
- finally (appendf *linkkit-start* (normalize-flags linkset "modules.o")) do)
- (if-let (p (position #\= l)))
- (let ((var (subseq l 0 p))
- ;; strip the start and end quote characters
- (val (subseq l (+ p 2) (- (length l) 1)))))
- (if-let (param (cdr (assoc var *clisp-toolchain-parameters* :test 'equal))))
- (destructuring-bind (sym &optional normalizep) param
- (setf (symbol-value sym)
- (if normalizep (normalize-flags linkset val) val))))
- (setf *ld* *cc*
- *ld-exe-flags* `(,@*cc-flags* #-darwin "-Wl,--export-dynamic")
- *ld-dll-flags* (list* #+darwin "-dynamiclib" ;; -bundle ?
- #-darwin "-shared"
- *cc-flags*))))
-
-;; TODO: for CMUCL, see whatever uses its linker.sh,
-;; and teach it to accept additional objects / libraries
-;; as it links a runtime plus a core into an executable
-
-#+ecl
-(defun ecl-toolchain-parameters ()
- (setf *cc* c:*cc*
- *cc-flags* `(,@(parse-command-flags c::*cc-flags*)
- ,@(parse-command-flags c:*user-cc-flags*))
- ;; For the below, we just use c::build-FOO
- *ld* *cc*
- *ld-exe-flags* *cc-flags*
- *ld-dll-flags* *cc-flags*
- *linkkit-start* nil
- *linkkit-end* nil))
-
-#+mkcl
-(defun mkcl-toolchain-parameters ()
- (setf *cc* compiler::*cc*
- *cc-flags* (parse-command-flags compiler::*cc-flags*)
- ;; For the below, we just use compiler::build-FOO
- *ld* *cc*
- *ld-exe-flags* *cc-flags*
- *ld-dll-flags* *cc-flags*
- *linkkit-start* nil
- *linkkit-end* nil))
-
-#+sbcl
-(progn
- (defparameter *sbcl-toolchain-parameters*
- '(("CC" *cc*)
- ("CFLAGS" *cc-flags* t)
- ("LINKFLAGS" *ld-exe-flags* t)
- ("USE_LIBSBCL" *linkkit-start* t)
- ("LIBS" *linkkit-end* t)))
- (defun sbcl-toolchain-parameters ()
- (nest
- (let* ((sbcl-home (lisp-implementation-directory))
- (sbcl.mk (subpathname sbcl-home "sbcl.mk"))))
- (with-input-file (params sbcl.mk :if-does-not-exist nil))
- (when params)
- (loop for l = (read-line params nil nil) while l
- finally (appendf *linkkit-end* '("-lm")) do)
- (if-let (p (position #\= l)))
- (let ((var (subseq l 0 p))
- (val (subseq l (1+ p)))))
- (if-let (param (cdr (assoc var *sbcl-toolchain-parameters* :test 'equal))))
- (destructuring-bind (sym &optional normalizep) param
- (setf (symbol-value sym)
- (if normalizep (normalize-flags sbcl-home val) val))))
- (unless (featurep :sb-linkable-runtime)
- (setf *linkkit-start* nil *linkkit-end* nil))
- (setf *ld* *cc* ;; !
- *ld-dll-flags* (list* #+darwin "-dynamiclib" #-darwin "-shared"
- *cc-flags*))))
-
-;;; Taken from sb-grovel
-(defun split-cflags (string)
- (remove-if (lambda (flag)
- (zerop (length flag)))
- (loop
- for start = 0 then (if end (1+ end) nil)
- for end = (and start (position #\Space string :start start))
- while start
- collect (subseq string start end))))
-
-(defun default-toolchain-parameters ()
- ;; The values below are legacy guesses from previous versions of CFFI.
- ;; It would be nice to clean them up, remove unneeded guesses,
- ;; annotate every guess with some comment explaining the context.
- ;; TODO: have proper implementation-provided linkkit parameters
- ;; for all implementations as above, and delete the below altogether.
- (let ((arch-flags
- ;; Former *cpu-word-size-flags*
- #+arm '("-marm")
- #+arm64 '()
- #-(or arm arm64)
- (ecase (cffi:foreign-type-size :pointer)
- (4 '("-m32"))
- (8 '("-m64")))))
- (setf *cc*
- (or (getenvp "CC")
- #+(or cygwin (not windows)) "cc"
- "gcc")
- *cc-flags*
- (append
- arch-flags
- ;; For MacPorts
- #+darwin (list "-I" "/opt/local/include/")
- ;; ECL internal flags
- #+ecl (parse-command-flags c::*cc-flags*)
- ;; FreeBSD non-base header files
- #+freebsd (list "-I" "/usr/local/include/")
- (split-cflags (getenv "CFLAGS")))
- *ld* *cc*
- *ld-exe-flags* `(,@arch-flags #-darwin "-Wl,--export-dynamic")
- *ld-dll-flags* (list* #+darwin "-dynamiclib" ;; -bundle ?
- #-darwin "-shared"
- *cc-flags*)
- *linkkit-start* nil
- *linkkit-end* nil)))
-
-(defun ensure-toolchain-parameters ()
- #+clisp (unless *cc* (clisp-toolchain-parameters))
- #+ecl (unless *cc* (ecl-toolchain-parameters))
- #+mkcl (unless *cc* (mkcl-toolchain-parameters))
- #+sbcl (unless *cc* (sbcl-toolchain-parameters))
- (unless *cc* (default-toolchain-parameters)))
-
-;; Actually initialize toolchain parameters
-(ignore-errors (ensure-toolchain-parameters))
-
-
-(defun call-with-temporary-output (output-file fun)
- (let ((output-file (ensure-pathname output-file :want-file t :ensure-absolute t :truenamize t)))
- (with-temporary-file
- (:pathname tmp :direction :output
- :prefix (strcat (native-namestring (pathname-directory-pathname output-file))
- (pathname-name output-file) "-tmp")
- :suffix ""
- :type (pathname-type output-file))
- (funcall fun tmp)
- (rename-file-overwriting-target tmp output-file))))
-
-(defmacro with-temporary-output ((output-file-var &optional (output-file-val output-file-var))
- &body body)
- "Create an output file atomically, by executing the BODY while OUTPUT-FILE-VAR
-is bound to a temporary file name, then atomically renaming that temporary file to OUTPUT-FILE-VAL."
- `(call-with-temporary-output ,output-file-val (lambda (,output-file-var) ,@body)))
-
-(defun invoke-builder (builder output-file &rest args)
- "Invoke the C Compiler with given OUTPUT-FILE and arguments ARGS"
- (with-temporary-output (output-file)
- (apply 'invoke `(,@builder ,output-file ,@args))))
-
-(defun cc-compile (output-file inputs)
- (apply 'invoke-builder (list *cc* "-o") output-file
- "-c" (append *cc-flags* #-windows '("-fPIC") inputs)))
-
-(defun link-executable (output-file inputs)
- (apply 'invoke-builder (list *ld* "-o") output-file
- (append *ld-exe-flags* inputs)))
-
-(defun link-lisp-executable (output-file inputs)
- #+ecl
- (let ((c::*ld-flags*
- (format nil "-Wl,--export-dynamic ~@[ ~A~]"
- c::*ld-flags*)))
- (c::build-program output-file :lisp-files inputs))
- #+mkcl (compiler::build-program
- output-file :lisp-object-files (mapcar 'program-argument inputs)
- :on-missing-lisp-object-initializer nil)
- #+(and sbcl (not sb-linkable-runtime)) (error "Your SBCL doesn't support :SB-LINKABLE-RUNTIME")
- #-(or ecl mkcl)
- (link-executable output-file `(,@*linkkit-start* ,@inputs ,@*linkkit-end*)))
-
-(defun link-static-library (output-file inputs)
- #+ecl (c::build-static-library output-file :lisp-files inputs)
- #+mkcl (compiler::build-static-library
- output-file :lisp-object-files (mapcar 'program-argument inputs)
- :on-missing-lisp-object-initializer nil)
- #-(or ecl mkcl)
- (with-temporary-output (output-file)
- (delete-file-if-exists output-file)
- #+(or bsd linux windows)
- (apply 'invoke
- `(;; TODO: make it portable to BSD.
- ;; ar D is also on FreeBSD, but not on OpenBSD or Darwin, dunno about NetBSD;
- ;; ar T seems to only be on Linux (means something different on Darwin). Sigh.
- ;; A MRI script might be more portable... not, only supported by GNU binutils.
- ;; I couldn't get libtool to work, and it's not ubiquitous anyway.
- ;; ,@`("libtool" "--mode=link" ,*cc* ,@*cc-flags* "-static" "-o" ,output-file)
- ;; "Solution": never link .a's into further .a's, only link .o's into .a's,
- ;; which implied changes that are now the case in ASDF 3.2.0.
- #+bsd ,@`("ar" "rcs" ,output-file) ;; NB: includes darwin
- #+linux ,@`("ar" "rcsDT" ,output-file)
- #+windows ,@`("lib" "-nologo" ,(strcat "-out:" (native-namestring output-file)))
- ,@inputs))
- #-(or bsd linux windows)
- (error "Not implemented on your system")))
-
-(defun link-shared-library (output-file inputs)
- ;; remove the library so we won't possibly be overwriting
- ;; the code of any existing process
- (delete-file-if-exists output-file)
- #+ecl (c::build-shared-library output-file :lisp-files inputs)
- #+mkcl (compiler::build-shared-library
- output-file :lisp-object-files (mapcar 'program-argument inputs)
- :on-missing-lisp-object-initializer nil)
- #-(or ecl mkcl)
- ;; Don't use a temporary file, because linking is sensitive to the output file name :-/ (or put it in a temporary directory?)
- (apply 'invoke *ld* "-o" output-file
- (append *ld-dll-flags* inputs)))
-
-
-;;; Computing file names
-
-(defun make-c-file-name (output-defaults &optional suffix)
- (make-pathname :type "c"
- :name (strcat (pathname-name output-defaults) suffix)
- :defaults output-defaults))
-
-(defun make-o-file-name (output-defaults &optional suffix)
- (make-pathname :type (bundle-pathname-type :object)
- :name (format nil "~A~@[~A~]" (pathname-name output-defaults) suffix)
- :defaults output-defaults))
-
-(defun make-so-file-name (defaults)
- (make-pathname :type (bundle-pathname-type :shared-library)
- :defaults defaults))
-
-(defun make-exe-file-name (defaults)
- (make-pathname :type (bundle-pathname-type :program)
- :defaults defaults))
-
-
-;;; Implement link-op on image-based platforms.
-#-(or clasp ecl mkcl)
-(defmethod perform ((o link-op) (c system))
- (let* ((inputs (input-files o c))
- (output (first (output-files o c)))
- (kind (bundle-type o)))
- (when output ;; some operations skip any output when there is no input
- (ecase kind
- (:program (link-executable output inputs))
- ((:lib :static-library) (link-static-library output inputs))
- ((:dll :shared-library) (link-shared-library output inputs))))))
-
-(defclass c-file (source-file)
- ((cflags :initarg :cflags :initform :default)
- (type :initform "c")))
-
-(defmethod output-files ((o compile-op) (c c-file))
- (let* ((i (first (input-files o c)))
- (base (format nil "~(~{~a~^__~}~)"
- (mapcar (lambda (x) (substitute-if #\_ (complement #'alphanumericp) x))
- (component-find-path c))))
- (path (make-pathname :defaults i :name base)))
- (list (make-o-file-name path)
- (make-so-file-name path))))
-
-(defmethod perform ((o compile-op) (c c-file))
- (let ((i (first (input-files o c))))
- (destructuring-bind (.o .so) (output-files o c)
- (cc-compile .o (list i))
- (link-shared-library .so (list .o)))))
-
-(defmethod perform ((o load-op) (c c-file))
- (let ((o (second (input-files o c))))
- (cffi:load-foreign-library (file-namestring o) :search-path (list (pathname-directory-pathname o)))))
-
-(setf (find-class 'asdf::c-file) (find-class 'c-file))
-
-(defclass o-file (source-file)
- ((cflags :initarg :cflags :initform :default)
- (type :initform (bundle-pathname-type :object)))
- (:documentation "class for pre-compile object components"))
-
-(defmethod output-files ((op compile-op) (c o-file))
- (let* ((o (first (input-files op c)))
- (so (apply-output-translations (make-so-file-name o))))
- (values (list o so) t)))
-
-(defmethod perform ((o load-op) (c o-file))
- (let ((so (second (input-files o c))))
- (cffi:load-foreign-library (file-namestring so) :search-path (list (pathname-directory-pathname so)))))
-
-(setf (find-class 'asdf::o-file) (find-class 'o-file))
-
(DIR) diff --git a/3rdparties/software/cffi_0.20.0/toolchain/package.lisp b/3rdparties/software/cffi_0.20.0/toolchain/package.lisp
@@ -1,46 +0,0 @@
-;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
-;;;
-;;; package.lisp --- Toolchain DEFPACKAGE.
-;;;
-;;; Permission is hereby granted, free of charge, to any person
-;;; obtaining a copy of this software and associated documentation
-;;; files (the "Software"), to deal in the Software without
-;;; restriction, including without limitation the rights to use, copy,
-;;; modify, merge, publish, distribute, sublicense, and/or sell copies
-;;; of the Software, and to permit persons to whom the Software is
-;;; furnished to do so, subject to the following conditions:
-;;;
-;;; The above copyright notice and this permission notice shall be
-;;; included in all copies or substantial portions of the Software.
-;;;
-;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
-;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
-;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
-;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
-;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
-;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
-;;; DEALINGS IN THE SOFTWARE.
-;;;
-
-(uiop:define-package #:cffi-toolchain
- (:mix #:asdf #:uiop #:common-lisp)
- (:import-from #:asdf/bundle
- #:link-op #:bundle-pathname-type #:bundle-type
- #:gather-operation #:gather-type)
- (:export
- ;; Variables
- #:*cc* #:*cc-flags*
- #:*ld* #:*ld-exe-flags* #:*ld-dll-flags*
- #:*linkkit-start* #:*linkkit-end*
- ;; Functions from c-toolchain
- #:make-c-file-name #:make-o-file-name
- #:make-so-file-name #:make-exe-file-name
- #:parse-command-flags #:parse-command-flags-list
- #:invoke #:invoke-build #:cc-compile
- #:link-static-library #:link-shared-library
- #:link-executable #:link-lisp-executable
- ;; ASDF classes
- #:c-file #:o-file
- #:static-runtime-op #:static-image-op #:static-program-op
- ))
(DIR) diff --git a/3rdparties/software/cffi_0.20.0/toolchain/static-link.lisp b/3rdparties/software/cffi_0.20.0/toolchain/static-link.lisp
@@ -1,95 +0,0 @@
-;; FIXME: arrange packages so that this can be moved in ASDF some time later?
-
-(in-package #:cffi-toolchain)
-
-(defun static-ops-enabled-p ()
- (ensure-toolchain-parameters)
- (and (or *linkkit-start* *linkkit-end*) t))
-
-(defclass static-runtime-op (monolithic-bundle-op link-op selfward-operation) ()
- (:documentation "Create a Lisp runtime linkable library for the system and its dependencies."))
-(defmethod bundle-type ((o static-runtime-op)) :program)
-(defmethod selfward-operation ((o static-runtime-op)) 'monolithic-lib-op)
-
-(defmethod output-files ((o static-runtime-op) (s system))
- #-(or ecl mkcl)
- (list (subpathname (component-pathname s)
- (strcat (coerce-name s) "-runtime")
- :type (bundle-pathname-type :program))))
-
-(defmethod perform ((o static-runtime-op) (s system))
- (link-lisp-executable
- (output-file o s)
- (link-all-library (first (input-files o s)))))
-
-(defclass static-image-op (image-op) ()
- (:documentation "Create a statically linked standalone image for the system."))
-#-(or ecl mkcl) (defmethod selfward-operation ((o static-image-op)) '(load-op static-runtime-op))
-#+(or ecl mkcl) (defmethod gather-operation ((o static-image-op)) 'compile-op)
-#+(or ecl mkcl) (defmethod gather-operation ((o static-image-op)) :object)
-
-(defclass static-program-op (program-op static-image-op) ()
- (:documentation "Create a statically linked standalone executable for the system."))
-
-;; Problem? Its output may conflict with the program-op output :-/
-
-#-(or ecl mkcl)
-(defmethod perform ((o static-image-op) (s system))
- #-(or clisp sbcl) (error "Not implemented yet")
- #+(or clisp sbcl)
- (let* ((name (coerce-name s))
- (runtime (output-file 'static-runtime-op s))
- (image
- #+clisp (implementation-file "base/lispinit.mem")
- #+sbcl (subpathname (lisp-implementation-directory) "sbcl.core"))
- (output (output-file o s))
- (child-op (if (typep o 'program-op) 'program-op 'image-op)))
- (with-temporary-output (tmp output)
- (apply 'invoke runtime
- #+clisp "-M" #+sbcl "--core" image
- `(#+clisp ,@'("--silent" "-ansi" "-norc" "-x")
- #+sbcl ,@'("--noinform" "--non-interactive" "--no-sysinit" "--no-userinit" "--eval")
- ,(with-safe-io-syntax (:package :asdf)
- (let ((*print-pretty* nil)
- (*print-case* :downcase))
- (format
- ;; This clever staging allows to put things in a single form,
- ;; as required for CLISP not to print output for the first form,
- ;; yet allow subsequent forms to rely on packages defined by former forms.
- nil "'(~@{#.~S~^ ~})"
- '(require "asdf")
- '(in-package :asdf)
- `(progn
- (setf asdf:*central-registry* ',asdf:*central-registry*)
- (initialize-source-registry ',asdf::*source-registry-parameter*)
- (initialize-output-translations ',asdf::*output-translations-parameter*)
- (upgrade-asdf)
- ,@(if-let (ql-home
- (symbol-value (find-symbol* '*quicklisp-home* 'ql-setup nil)))
- `((load ,(subpathname ql-home "setup.lisp"))))
- (load-system "cffi-grovel")
- ;; We force the (final step of the) operation to take place
- (defmethod operation-done-p
- ((operation ,child-op) (system (eql (find-system ,name))))
- nil)
- ;; Some implementations (notably SBCL) die as part of dumping an image,
- ;; so redirect output-files to desired destination, for this processs might
- ;; never otherwise get a chance to move the file to destination.
- (defmethod output-files
- ((operation ,child-op) (system (eql (find-system ,name))))
- (values (list ,tmp) t))
- (operate ',child-op ,name)
- (quit))))))))))
-
-#+(or ecl mkcl)
-(defmethod perform ((o static-image-op) (s system))
- (let (#+ecl
- (c::*ld-flags*
- (format nil "-Wl,--export-dynamic ~@[ ~A~]"
- c::*ld-flags*)))
- (call-next-method)))
-
-;; Allow for :static-FOO-op in ASDF definitions.
-(setf (find-class 'asdf::static-runtime-op) (find-class 'static-runtime-op)
- (find-class 'asdf::static-image-op) (find-class 'static-image-op)
- (find-class 'asdf::static-program-op) (find-class 'static-program-op))
(DIR) diff --git a/3rdparties/software/cffi_0.20.0/uffi-compat/uffi-compat.lisp b/3rdparties/software/cffi_0.20.0/uffi-compat/uffi-compat.lisp
@@ -1,664 +0,0 @@
-;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
-;;;
-;;; uffi-compat.lisp --- UFFI compatibility layer for CFFI.
-;;;
-;;; Copyright (C) 2005-2006, James Bielman <jamesjb@jamesjb.com>
-;;; Copyright (C) 2005-2007, Luis Oliveira <loliveira@common-lisp.net>
-;;;
-;;; Permission is hereby granted, free of charge, to any person
-;;; obtaining a copy of this software and associated documentation
-;;; files (the "Software"), to deal in the Software without
-;;; restriction, including without limitation the rights to use, copy,
-;;; modify, merge, publish, distribute, sublicense, and/or sell copies
-;;; of the Software, and to permit persons to whom the Software is
-;;; furnished to do so, subject to the following conditions:
-;;;
-;;; The above copyright notice and this permission notice shall be
-;;; included in all copies or substantial portions of the Software.
-;;;
-;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
-;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
-;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
-;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
-;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
-;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
-;;; DEALINGS IN THE SOFTWARE.
-;;;
-
-;;; Code borrowed from UFFI is Copyright (c) Kevin M. Rosenberg.
-
-(defpackage #:cffi-uffi-compat
- (:nicknames #:uffi) ;; is this a good idea?
- (:use #:cl)
- (:export
-
- ;; immediate types
- #:def-constant
- #:def-foreign-type
- #:def-type
- #:null-char-p
-
- ;; aggregate types
- #:def-enum
- #:def-struct
- #:get-slot-value
- #:get-slot-pointer
- #:def-array-pointer
- #:deref-array
- #:def-union
-
- ;; objects
- #:allocate-foreign-object
- #:free-foreign-object
- #:with-foreign-object
- #:with-foreign-objects
- #:size-of-foreign-type
- #:pointer-address
- #:deref-pointer
- #:ensure-char-character
- #:ensure-char-integer
- #:ensure-char-storable
- #:null-pointer-p
- #:make-null-pointer
- #:make-pointer
- #:+null-cstring-pointer+
- #:char-array-to-pointer
- #:with-cast-pointer
- #:def-foreign-var
- #:convert-from-foreign-usb8
- #:def-pointer-var
-
- ;; string functions
- #:convert-from-cstring
- #:convert-to-cstring
- #:free-cstring
- #:with-cstring
- #:with-cstrings
- #:convert-from-foreign-string
- #:convert-to-foreign-string
- #:allocate-foreign-string
- #:with-foreign-string
- #:with-foreign-strings
- #:foreign-string-length ; not implemented
- #:string-to-octets
- #:octets-to-string
- #:foreign-encoded-octet-count
-
- ;; function call
- #:def-function
-
- ;; libraries
- #:find-foreign-library
- #:load-foreign-library
- #:default-foreign-library-type
- #:foreign-library-types
-
- ;; os
- #:getenv
- #:run-shell-command
- ))
-
-(in-package #:cffi-uffi-compat)
-
-#+clisp
-(eval-when (:compile-toplevel :load-toplevel :execute)
- (when (equal (machine-type) "POWER MACINTOSH")
- (pushnew :ppc *features*)))
-
-(defun convert-uffi-type (uffi-type)
- "Convert a UFFI primitive type to a CFFI type."
- ;; Many CFFI types are the same as UFFI. This list handles the
- ;; exceptions only.
- (case uffi-type
- (:cstring :pointer)
- (:pointer-void :pointer)
- (:pointer-self :pointer)
- ;; Although UFFI's documentation claims dereferencing :CHAR and
- ;; :UNSIGNED-CHAR returns characters, it actually returns
- ;; integers.
- (:char :char)
- (:unsigned-char :unsigned-char)
- (:byte :char)
- (:unsigned-byte :unsigned-char)
- (t
- (if (listp uffi-type)
- (case (car uffi-type)
- ;; this is imho gross but it is what uffi does
- (quote (convert-uffi-type (second uffi-type)))
- (* :pointer)
- (:array `(uffi-array ,(convert-uffi-type (second uffi-type))
- ,(third uffi-type)))
- (:union (second uffi-type))
- (:struct (convert-uffi-type (second uffi-type)))
- (:struct-pointer :pointer))
- uffi-type))))
-
-(cffi:define-foreign-type uffi-array-type ()
- ;; ELEMENT-TYPE should be /unparsed/, suitable for passing to mem-aref.
- ((element-type :initform (error "An element-type is required.")
- :accessor element-type :initarg :element-type)
- (nelems :initform (error "nelems is required.")
- :accessor nelems :initarg :nelems))
- (:actual-type :pointer)
- (:documentation "UFFI's :array type."))
-
-(cffi:define-parse-method uffi-array (element-type count)
- (make-instance 'uffi-array-type :element-type element-type
- :nelems (or count 1)))
-
-(defmethod cffi:foreign-type-size ((type uffi-array-type))
- (* (cffi:foreign-type-size (element-type type)) (nelems type)))
-
-(defmethod cffi::aggregatep ((type uffi-array-type))
- t)
-
-;; UFFI's :(unsigned-)char
-#+#:ignore
-(cffi:define-foreign-type uffi-char ()
- ())
-
-#+#:ignore
-(cffi:define-parse-method uffi-char (base-type)
- (make-instance 'uffi-char :actual-type base-type))
-
-#+#:ignore
-(defmethod cffi:translate-to-foreign ((value character) (type uffi-char))
- (char-code value))
-
-#+#:ignore
-(defmethod cffi:translate-from-foreign (obj (type uffi-char))
- (code-char obj))
-
-(defmacro def-type (name type)
- "Define a Common Lisp type NAME for UFFI type TYPE."
- (declare (ignore type))
- `(deftype ,name () t))
-
-(defmacro def-foreign-type (name type)
- "Define a new foreign type."
- `(cffi:defctype ,name ,(convert-uffi-type type)))
-
-(defmacro def-constant (name value &key export)
- "Define a constant and conditionally export it."
- `(eval-when (:compile-toplevel :load-toplevel :execute)
- (defconstant ,name ,value)
- ,@(when export `((export ',name)))
- ',name))
-
-(defmacro null-char-p (val)
- "Return true if character is null."
- `(zerop (char-code ,val)))
-
-(defmacro def-enum (enum-name args &key (separator-string "#"))
- "Creates a constants for a C type enum list, symbols are
-created in the created in the current package. The symbol is the
-concatenation of the enum-name name, separator-string, and
-field-name"
- (let ((counter 0)
- (cmds nil)
- (constants nil))
- (declare (fixnum counter))
- (dolist (arg args)
- (let ((name (if (listp arg) (car arg) arg))
- (value (if (listp arg)
- (prog1
- (setq counter (cadr arg))
- (incf counter))
- (prog1
- counter
- (incf counter)))))
- (setq name (intern (concatenate 'string
- (symbol-name enum-name)
- separator-string
- (symbol-name name))))
- (push `(def-constant ,name ,value) constants)))
- (setf cmds (append '(progn) `((cffi:defctype ,enum-name :int))
- (nreverse constants)))
- cmds))
-
-(defmacro def-struct (name &body fields)
- "Define a C structure."
- `(cffi:defcstruct ,name
- ,@(loop for (name uffi-type) in fields
- for cffi-type = (convert-uffi-type uffi-type)
- collect (list name cffi-type))))
-
-;; TODO: figure out why the compiler macro is kicking in before
-;; the setf expander.
-(defun %foreign-slot-value (obj type field)
- (cffi:foreign-slot-value obj `(:struct ,type) field))
-
-(defun (setf %foreign-slot-value) (value obj type field)
- (setf (cffi:foreign-slot-value obj `(:struct ,type) field) value))
-
-(defmacro get-slot-value (obj type field)
- "Access a slot value from a structure."
- `(%foreign-slot-value ,obj ,type ,field))
-
-;; UFFI uses a different function when accessing a slot whose
-;; type is a pointer. We don't need that in CFFI so we use
-;; foreign-slot-value too.
-(defmacro get-slot-pointer (obj type field)
- "Access a pointer slot value from a structure."
- `(cffi:foreign-slot-value ,obj ,type ,field))
-
-(defmacro def-array-pointer (name type)
- "Define a foreign array type."
- `(cffi:defctype ,name (uffi-array ,(convert-uffi-type type) 1)))
-
-(defmacro deref-array (array type position)
- "Dereference an array."
- `(cffi:mem-aref ,array
- ,(if (constantp type)
- `',(element-type (cffi::parse-type
- (convert-uffi-type (eval type))))
- `(element-type (cffi::parse-type
- (convert-uffi-type ,type))))
- ,position))
-
-;; UFFI's documentation on DEF-UNION is a bit scarce, I'm not sure
-;; if DEFCUNION and DEF-UNION are strictly compatible.
-(defmacro def-union (name &body fields)
- "Define a foreign union type."
- `(cffi:defcunion ,name
- ,@(loop for (name uffi-type) in fields
- for cffi-type = (convert-uffi-type uffi-type)
- collect (list name cffi-type))))
-
-(defmacro allocate-foreign-object (type &optional (size 1))
- "Allocate one or more instance of a foreign type."
- `(cffi:foreign-alloc ,(if (constantp type)
- `',(convert-uffi-type (eval type))
- `(convert-uffi-type ,type))
- :count ,size))
-
-(defmacro free-foreign-object (ptr)
- "Free a foreign object allocated by ALLOCATE-FOREIGN-OBJECT."
- `(cffi:foreign-free ,ptr))
-
-(defmacro with-foreign-object ((var type) &body body)
- "Wrap the allocation of a foreign object around BODY."
- `(cffi:with-foreign-object (,var (convert-uffi-type ,type))
- ,@body))
-
-;; Taken from UFFI's src/objects.lisp
-(defmacro with-foreign-objects (bindings &rest body)
- (if bindings
- `(with-foreign-object ,(car bindings)
- (with-foreign-objects ,(cdr bindings)
- ,@body))
- `(progn ,@body)))
-
-(defmacro size-of-foreign-type (type)
- "Return the size in bytes of a foreign type."
- `(cffi:foreign-type-size (convert-uffi-type ,type)))
-
-(defmacro pointer-address (ptr)
- "Return the address of a pointer."
- `(cffi:pointer-address ,ptr))
-
-(defmacro deref-pointer (ptr type)
- "Dereference a pointer."
- `(cffi:mem-ref ,ptr (convert-uffi-type ,type)))
-
-(defsetf deref-pointer (ptr type) (value)
- `(setf (cffi:mem-ref ,ptr (convert-uffi-type ,type)) ,value))
-
-(defmacro ensure-char-character (obj &environment env)
- "Convert OBJ to a character if it is an integer."
- (if (constantp obj env)
- (if (characterp obj) obj (code-char obj))
- (let ((obj-var (gensym)))
- `(let ((,obj-var ,obj))
- (if (characterp ,obj-var)
- ,obj-var
- (code-char ,obj-var))))))
-
-(defmacro ensure-char-integer (obj &environment env)
- "Convert OBJ to an integer if it is a character."
- (if (constantp obj env)
- (let ((the-obj (eval obj)))
- (if (characterp the-obj) (char-code the-obj) the-obj))
- (let ((obj-var (gensym)))
- `(let ((,obj-var ,obj))
- (if (characterp ,obj-var)
- (char-code ,obj-var)
- ,obj-var)))))
-
-(defmacro ensure-char-storable (obj)
- "Ensure OBJ is storable as a character."
- `(ensure-char-integer ,obj))
-
-(defmacro make-null-pointer (type)
- "Create a NULL pointer."
- (declare (ignore type))
- `(cffi:null-pointer))
-
-(defmacro make-pointer (address type)
- "Create a pointer to ADDRESS."
- (declare (ignore type))
- `(cffi:make-pointer ,address))
-
-(defmacro null-pointer-p (ptr)
- "Return true if PTR is a null pointer."
- `(cffi:null-pointer-p ,ptr))
-
-(defparameter +null-cstring-pointer+ (cffi:null-pointer)
- "A constant NULL string pointer.")
-
-(defmacro char-array-to-pointer (obj)
- obj)
-
-(defmacro with-cast-pointer ((var ptr type) &body body)
- "Cast a pointer, does nothing in CFFI."
- (declare (ignore type))
- `(let ((,var ,ptr))
- ,@body))
-
-(defmacro def-foreign-var (name type module)
- "Define a symbol macro to access a foreign variable."
- (declare (ignore module))
- (flet ((lisp-name (name)
- (intern (cffi-sys:canonicalize-symbol-name-case
- (substitute #\- #\_ name)))))
- `(cffi:defcvar ,(if (listp name)
- name
- (list name (lisp-name name)))
- ,(convert-uffi-type type))))
-
-(defmacro def-pointer-var (name value &optional doc)
- #-openmcl `(defvar ,name ,value ,@(if doc (list doc)))
- #+openmcl `(ccl::defloadvar ,name ,value ,doc))
-
-(defmacro convert-from-cstring (s)
- "Convert a cstring to a Lisp string."
- (let ((ret (gensym)))
- `(let ((,ret (cffi:foreign-string-to-lisp ,s)))
- (if (equal ,ret "")
- nil
- ,ret))))
-
-(defmacro convert-to-cstring (obj)
- "Convert a Lisp string to a cstring."
- (let ((str (gensym)))
- `(let ((,str ,obj))
- (if (null ,str)
- (cffi:null-pointer)
- (cffi:foreign-string-alloc ,str)))))
-
-(defmacro free-cstring (ptr)
- "Free a cstring."
- `(cffi:foreign-string-free ,ptr))
-
-(defmacro with-cstring ((foreign-string lisp-string) &body body)
- "Binds a newly creating string."
- (let ((str (gensym)) (body-proc (gensym)))
- `(flet ((,body-proc (,foreign-string) ,@body))
- (let ((,str ,lisp-string))
- (if (null ,str)
- (,body-proc (cffi:null-pointer))
- (cffi:with-foreign-string (,foreign-string ,str)
- (,body-proc ,foreign-string)))))))
-
-;; Taken from UFFI's src/strings.lisp
-(defmacro with-cstrings (bindings &rest body)
- (if bindings
- `(with-cstring ,(car bindings)
- (with-cstrings ,(cdr bindings)
- ,@body))
- `(progn ,@body)))
-
-(defmacro def-function (name args &key module (returning :void))
- "Define a foreign function."
- (declare (ignore module))
- `(cffi:defcfun ,name ,(convert-uffi-type returning)
- ,@(loop for (name type) in args
- collect `(,name ,(convert-uffi-type type)))))
-
-;;; Taken from UFFI's src/libraries.lisp
-
-(defvar *loaded-libraries* nil
- "List of foreign libraries loaded. Used to prevent reloading a library")
-
-(defun default-foreign-library-type ()
- "Returns string naming default library type for platform"
- #+(or win32 cygwin mswindows) "dll"
- #+(or macos macosx darwin ccl-5.0) "dylib"
- #-(or win32 cygwin mswindows macos macosx darwin ccl-5.0) "so")
-
-(defun foreign-library-types ()
- "Returns list of string naming possible library types for platform,
-sorted by preference"
- #+(or win32 cygwin mswindows) '("dll" "lib" "so")
- #+(or macos macosx darwin ccl-5.0) '("dylib" "bundle")
- #-(or win32 cygwin mswindows macos macosx darwin ccl-5.0) '("so" "a" "o"))
-
-(defun find-foreign-library (names directories &key types drive-letters)
- "Looks for a foreign library. directories can be a single
-string or a list of strings of candidate directories. Use default
-library type if type is not specified."
- (unless types
- (setq types (foreign-library-types)))
- (unless (listp types)
- (setq types (list types)))
- (unless (listp names)
- (setq names (list names)))
- (unless (listp directories)
- (setq directories (list directories)))
- #+(or win32 mswindows)
- (unless (listp drive-letters)
- (setq drive-letters (list drive-letters)))
- #-(or win32 mswindows)
- (setq drive-letters '(nil))
- (dolist (drive-letter drive-letters)
- (dolist (name names)
- (dolist (dir directories)
- (dolist (type types)
- (let ((path (make-pathname
- #+lispworks :host
- #+lispworks (when drive-letter drive-letter)
- #-lispworks :device
- #-lispworks (when drive-letter drive-letter)
- :name name
- :type type
- :directory
- (etypecase dir
- (pathname
- (pathname-directory dir))
- (list
- dir)
- (string
- (pathname-directory
- (parse-namestring dir)))))))
- (when (probe-file path)
- (return-from find-foreign-library path)))))))
- nil)
-
-(defun convert-supporting-libraries-to-string (libs)
- (let (lib-load-list)
- (dolist (lib libs)
- (push (format nil "-l~A" lib) lib-load-list))
- (nreverse lib-load-list)))
-
-(defun load-foreign-library (filename &key module supporting-libraries
- force-load)
- #+(or allegro mcl sbcl clisp) (declare (ignore module supporting-libraries))
- #+(or cmucl scl sbcl) (declare (ignore module))
-
- (when (and filename (or (null (pathname-directory filename))
- (probe-file filename)))
- (if (pathnamep filename) ;; ensure filename is a string to check if
- (setq filename (namestring filename))) ; already loaded
-
- (if (and (not force-load)
- (find filename *loaded-libraries* :test #'string-equal))
- t ;; return T, but don't reload library
- (progn
- ;; FIXME: Hmm, what are these two for?
- #+cmucl
- (let ((type (pathname-type (parse-namestring filename))))
- (if (string-equal type "so")
- (sys::load-object-file filename)
- (alien:load-foreign filename
- :libraries
- (convert-supporting-libraries-to-string
- supporting-libraries))))
- #+scl
- (let ((type (pathname-type (parse-namestring filename))))
- (if (string-equal type "so")
- (sys::load-dynamic-object filename)
- (alien:load-foreign filename
- :libraries
- (convert-supporting-libraries-to-string
- supporting-libraries))))
-
- #-(or cmucl scl)
- (cffi:load-foreign-library filename)
- (push filename *loaded-libraries*)
- t))))
-
-;; Taken from UFFI's src/os.lisp
-(defun getenv (var)
- "Return the value of the environment variable."
- #+allegro (sys::getenv (string var))
- #+clisp (sys::getenv (string var))
- #+(or cmucl scl) (cdr (assoc (string var) ext:*environment-list* :test #'equalp
- :key #'string))
- #+(or ecl gcl) (si:getenv (string var))
- #+lispworks (lw:environment-variable (string var))
- #+lucid (lcl:environment-variable (string var))
- #+(or mcl ccl) (ccl::getenv var)
- #+sbcl (sb-ext:posix-getenv var)
- #-(or allegro clisp cmucl ecl scl gcl lispworks lucid mcl ccl sbcl)
- (error 'not-implemented :proc (list 'getenv var)))
-
-;; Taken from UFFI's src/os.lisp
-;; modified from function ASDF -- Copyright Dan Barlow and Contributors
-(defun run-shell-command (control-string &rest args)
- "Interpolate ARGS into CONTROL-STRING as if by FORMAT, and
-synchronously execute the result using a Bourne-compatible shell, with
-output to *trace-output*. Returns the shell's exit code."
- (let ((command (apply #'format nil control-string args))
- (output *trace-output*))
- #+sbcl
- (sb-impl::process-exit-code
- (sb-ext:run-program
- "/bin/sh"
- (list "-c" command)
- :input nil :output output))
-
- #+(or cmucl scl)
- (ext:process-exit-code
- (ext:run-program
- "/bin/sh"
- (list "-c" command)
- :input nil :output output))
-
- #+allegro
- (excl:run-shell-command command :input nil :output output)
-
- #+lispworks
- (system:call-system-showing-output
- command
- :shell-type "/bin/sh"
- :output-stream output)
-
- #+clisp ;XXX not exactly *trace-output*, I know
- (ext:run-shell-command command :output :terminal :wait t)
-
- #+openmcl
- (nth-value 1
- (ccl:external-process-status
- (ccl:run-program "/bin/sh" (list "-c" command)
- :input nil :output output
- :wait t)))
-
- #+ecl
- (nth-value 1
- (ext:run-program
- "/bin/sh" (list "-c" command)
- :input nil :output output :error nil :wait t))
-
- #-(or openmcl ecl clisp lispworks allegro scl cmucl sbcl)
- (error "RUN-SHELL-PROGRAM not implemented for this Lisp")
- ))
-
-;;; Some undocumented UFFI operators...
-
-(defmacro convert-from-foreign-string
- (obj &key length (locale :default)
- (encoding 'cffi:*default-foreign-encoding*)
- (null-terminated-p t))
- ;; in effect, (eq NULL-TERMINATED-P (null LENGTH)). Hopefully,
- ;; that's compatible with the intended semantics, which are
- ;; undocumented. If that's not the case, we can implement
- ;; NULL-TERMINATED-P in CFFI:FOREIGN-STRING-TO-LISP.
- (declare (ignore locale null-terminated-p))
- (let ((ret (gensym)))
- `(let ((,ret (cffi:foreign-string-to-lisp ,obj
- :count ,length
- :encoding ,encoding)))
- (if (equal ,ret "")
- nil
- ,ret))))
-
-;; What's the difference between this and convert-to-cstring?
-(defmacro convert-to-foreign-string
- (obj &optional (encoding 'cffi:*default-foreign-encoding*))
- (let ((str (gensym)))
- `(let ((,str ,obj))
- (if (null ,str)
- (cffi:null-pointer)
- (cffi:foreign-string-alloc ,str :encoding ,encoding)))))
-
-(defmacro allocate-foreign-string (size &key unsigned)
- (declare (ignore unsigned))
- `(cffi:foreign-alloc :char :count ,size))
-
-;; Ditto.
-(defmacro with-foreign-string ((foreign-string lisp-string) &body body)
- (let ((str (gensym)))
- `(let ((,str ,lisp-string))
- (if (null ,str)
- (let ((,foreign-string (cffi:null-pointer)))
- ,@body)
- (cffi:with-foreign-string (,foreign-string ,str)
- ,@body)))))
-
-(defmacro with-foreign-strings (bindings &body body)
- `(with-foreign-string ,(car bindings)
- ,@(if (cdr bindings)
- `((with-foreign-strings ,(cdr bindings) ,@body))
- body)))
-
-;; This function returns a form? Where is this used in user-code?
-(defun foreign-string-length (foreign-string)
- (declare (ignore foreign-string))
- (error "FOREIGN-STRING-LENGTH not implemented."))
-
-;; This should be optimized.
-(defun convert-from-foreign-usb8 (s len)
- (let ((a (make-array len :element-type '(unsigned-byte 8))))
- (dotimes (i len a)
- (setf (aref a i) (cffi:mem-ref s :unsigned-char i)))))
-
-;;;; String Encodings
-
-(defmacro string-to-octets (str &key encoding null-terminate)
- `(babel:concatenate-strings-to-octets
- (or ,encoding cffi:*default-foreign-encoding*)
- ,str
- (if ,null-terminate
- #.(string #\Nul)
- "")))
-
-(defmacro octets-to-string (octets &key encoding)
- `(babel:octets-to-string ,octets
- :encoding (or ,encoding
- cffi:*default-foreign-encoding*)))
-
-(defun foreign-encoded-octet-count (str &key encoding)
- (babel:string-size-in-octets str
- :encoding (or encoding
- cffi:*default-foreign-encoding*)))
(DIR) diff --git a/3rdparties/software/cffi_0.20.0/uffi-compat/uffi.asd b/3rdparties/software/cffi_0.20.0/uffi-compat/uffi.asd
@@ -1,3 +0,0 @@
-;;;; uffi.asd -*- Mode: Lisp -*-
-
-(defsystem uffi :depends-on (cffi-uffi-compat))
(DIR) diff --git a/3rdparties/software/cl+ssl-20190202-git/.gitignore b/3rdparties/software/cl+ssl-20190202-git/.gitignore
@@ -1,3 +0,0 @@
-*~
-\#*
-.#*
-\ No newline at end of file
(DIR) diff --git a/3rdparties/software/cl+ssl-20190202-git/.travis.yml b/3rdparties/software/cl+ssl-20190202-git/.travis.yml
@@ -1,50 +0,0 @@
-language: common-lisp
-sudo: false # lets try new infrastructure
-
-env:
- global:
- - PATH=~/.roswell/bin:$PATH
- - ROSWELL_BRANCH=release
- - ROSWELL_INSTALL_DIR=$HOME/.roswell
- - COVERAGE_EXCLUDE=test
- matrix:
- - LISP=sbcl-bin COVERALLS=true
- - LISP=ccl-bin
-# CLISP is disabled because it can't load bordeaux-treads which require ASDF >= 3.1
-# Example log: https://travis-ci.org/cl-plus-ssl/cl-plus-ssl/jobs/181539210
-# (As a workaround we could try to download ASDF 3 ourselves)
-# - LISP=clisp
- - LISP=ecl
- - LISP=abcl
-# CMUCL fails to load libssl on TravisCI, despite OpenSSL 1.0.1f is installed,
-# example log: https://travis-ci.org/cl-plus-ssl/cl-plus-ssl/jobs/479189027
-# - LISP=cmu-bin
-# Allegro is also failing to load libssl
-# https://travis-ci.org/cl-plus-ssl/cl-plus-ssl/jobs/479194225
-# - LISP=allegro
-
-install:
- - curl -L https://raw.githubusercontent.com/snmsts/roswell/$ROSWELL_BRANCH/scripts/install-for-ci.sh | sh
-
-# cache:
-# directories:
-# - $HOME/.roswell
-# - $HOME/.config/common-lisp
-
-script:
- - "ros -e '(progn
- (format t \"(lisp-implementation-type): ~A~%\" (lisp-implementation-type))
- (format t \"(lisp-implementation-version): ~A~%\" (lisp-implementation-version))
- (format t \"*features*: ~A~%\" *features*)
- (format t \"(asdf:asdf-version): ~A~%\" (asdf:asdf-version)))'
- -e '(ql:quickload :cl+ssl.test)'
- -e '(let ((results
- #+ sbcl
- (coveralls:with-coveralls (:exclude \"test\")
- (5am:run :cl+ssl))
- #- sbcl
- (5am:run :cl+ssl)
- ))
- (5am:explain! results)
- (unless (5am:results-status results)
- (uiop:quit 1)))'"
(DIR) diff --git a/3rdparties/software/cl+ssl-20190202-git/LICENSE b/3rdparties/software/cl+ssl-20190202-git/LICENSE
@@ -1,31 +0,0 @@
-Copyright (C) 2001, 2003 Eric Marsden
-Copyright (C) ???? Jochen Schmidt
-Copyright (C) 2005 David Lichteblau
-Copyright (C) 2007 Pixel // pinterface
-
-* License first changed by Eric Marsden, Jochen Schmidt, and David Lichteblau
- from plain LGPL to Lisp-LGPL in December 2005.
-
-* License then changed by Eric Marsden, Jochen Schmidt, and David Lichteblau
- from Lisp-LGPL to MIT-style in January 2007.
-
-
- Permission is hereby granted, free of charge, to any person
- obtaining a copy of this software and associated documentation files
- (the "Software"), to deal in the Software without restriction,
- including without limitation the rights to use, copy, modify, merge,
- publish, distribute, sublicense, and/or sell copies of the Software,
- and to permit persons to whom the Software is furnished to do so,
- subject to the following conditions:
-
- The above copyright notice and this permission notice shall be
- included in all copies or substantial portions of the Software.
-
- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
- EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
- NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS
- BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN
- ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
- CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
- SOFTWARE.
(DIR) diff --git a/3rdparties/software/cl+ssl-20190202-git/Makefile b/3rdparties/software/cl+ssl-20190202-git/Makefile
@@ -1,3 +0,0 @@
-.PHONY: clean
-clean:
- rm -f *.fasl *.x86f *.fas *.ufsl *.lib *.pfsl
(DIR) diff --git a/3rdparties/software/cl+ssl-20190202-git/README.md b/3rdparties/software/cl+ssl-20190202-git/README.md
@@ -1,4 +0,0 @@
-[](https://travis-ci.org/cl-plus-ssl/cl-plus-ssl)
-
-Homepage: http://common-lisp.net/project/cl-plus-ssl/
-
(DIR) diff --git a/3rdparties/software/cl+ssl-20190202-git/build.xcvb b/3rdparties/software/cl+ssl-20190202-git/build.xcvb
@@ -1,26 +0,0 @@
-;;; -*- mode: lisp -*-
-;;;
-;;; Copyright (C) 2001, 2003 Eric Marsden
-;;; Copyright (C) 2005 David Lichteblau
-;;; Copyright (C) 2007 Pixel // pinterface
-;;; "the conditions and ENSURE-SSL-FUNCALL are by Jochen Schmidt."
-;;;
-;;; See LICENSE for details.
-
-
-#+xcvb
-(module
- (:fullname "cl+ssl"
- :depends-on ("src/package"
- "src/reload"
- "src/conditions"
- "src/ffi"
- "src/ffi-buffer-all"
- (:cond ((:featurep :clisp) "src/ffi-buffer-clisp")
- ((:featurep (:not :clisp)) "src/ffi-buffer"))
- "src/streams"
- "src/bio"
- "src/random"
- "src/context")
- :build-depends-on ("flexi-streams" "trivial-gray-streams" "cffi")
- :supersedes-asdf ("cl+ssl")))
(DIR) diff --git a/3rdparties/software/cl+ssl-20190202-git/cl+ssl.asd b/3rdparties/software/cl+ssl-20190202-git/cl+ssl.asd
@@ -1,48 +0,0 @@
-;;; -*- mode: lisp -*-
-;;;
-;;; Copyright (C) 2001, 2003 Eric Marsden
-;;; Copyright (C) 2005 David Lichteblau
-;;; Copyright (C) 2007 Pixel // pinterface
-;;; "the conditions and ENSURE-SSL-FUNCALL are by Jochen Schmidt."
-;;;
-;;; See LICENSE for details.
-
-(defpackage :cl+ssl-system
- (:use :cl :asdf))
-
-(in-package :cl+ssl-system)
-
-(defsystem :cl+ssl
- :description "Common Lisp interface to OpenSSL."
- :license "MIT"
- :author "Eric Marsden, Jochen Schmidt, David Lichteblau"
- :depends-on (:cffi :trivial-gray-streams :flexi-streams #+sbcl :sb-posix
- :bordeaux-threads :trivial-garbage :uiop
- :alexandria :trivial-features)
- :serial t
- :components ((:module "src"
- :serial t
- :components
- ((:file "package")
- (:file "reload")
- (:file "conditions")
- (:file "ffi")
- (:file "x509")
- (:file "ffi-buffer-all")
- #-clisp (:file "ffi-buffer")
- #+clisp (:file "ffi-buffer-clisp")
- (:file "streams")
- (:file "bio")
- (:file "random")
- (:file "context")
- (:file "verify-hostname")))))
-
-(defsystem :openssl-1.1.0
- :description "FFI bindings to API introduced in OpenSSL 1.1.0"
- :license "MIT"
- :author "Anton Vodonosov"
- :depends-on (:cffi)
- :serial t
- :components ((:module "src"
- :serial t
- :components ((:file "ffi-1.1.0")))))
(DIR) diff --git a/3rdparties/software/cl+ssl-20190202-git/cl+ssl.test.asd b/3rdparties/software/cl+ssl-20190202-git/cl+ssl.test.asd
@@ -1,31 +0,0 @@
-;;; -*- mode: lisp -*-
-;;;
-;;; Copyright (C) 2015 Ilya Khaprov <ilya.khaprov@publitechs.com>
-;;;
-;;; See LICENSE for details.
-
-(defpackage :cl+ssl.test-system
- (:use :cl :asdf))
-
-(in-package :cl+ssl.test-system)
-
-(asdf:defsystem :cl+ssl.test
- :version "0.1"
- :description "CL+SSL test suite"
- :maintainer "Ilya Khaprov <ilya.khaprov@publitechs.com>"
- :author "Ilya Khaprov <ilya.khaprov@publitechs.com>"
- :licence "MIT"
- :depends-on (:fiveam
- (:feature (:or :sbcl :ccl) :cl-coveralls)
- :cl+ssl
- :openssl-1.1.0 ;; for now the dependency is only included to test how the system is loaded
- :usocket)
- :serial t
- :components ((:module "test"
- :serial t
- :components
- ((:file "package")
- (:file "dummy")
- (:file "sni")
- (:file "verify-hostname")
- (:file "badssl-com")))))
(DIR) diff --git a/3rdparties/software/cl+ssl-20190202-git/example.lisp b/3rdparties/software/cl+ssl-20190202-git/example.lisp
@@ -1,110 +0,0 @@
-;;; Copyright (C) 2001, 2003 Eric Marsden
-;;; Copyright (C) 2005 David Lichteblau
-;;; "the conditions and ENSURE-SSL-FUNCALL are by Jochen Schmidt."
-;;;
-;;; See LICENSE for details.
-
-#|
-(load "example.lisp")
-(ssl-test::test-https-client "www.google.com")
-(ssl-test::test-https-server)
-|#
-
-(defpackage :ssl-test
- (:use :cl))
-(in-package :ssl-test)
-
-(eval-when (:compile-toplevel :load-toplevel :execute)
- (asdf:operate 'asdf:load-op :trivial-sockets))
-
-(defun read-line-crlf (stream &optional eof-error-p)
- (let ((s (make-string-output-stream)))
- (loop
- for empty = t then nil
- for c = (read-char stream eof-error-p nil)
- while (and c (not (eql c #\return)))
- do
- (unless (eql c #\newline)
- (write-char c s))
- finally
- (return
- (if empty nil (get-output-stream-string s))))))
-
-(defun test-nntps-client (&optional (host "snews.gmane.org") (port 563))
- (let* ((fd (trivial-sockets:open-stream host port
- :element-type '(unsigned-byte 8)))
- (nntps (cl+ssl:make-ssl-client-stream fd :external-format '(:iso-8859-1 :eol-style :lf))))
- (format t "NNTPS> ~A~%" (read-line-crlf nntps))
- (write-line "HELP" nntps)
- (force-output nntps)
- (loop :for line = (read-line-crlf nntps nil)
- :until (string-equal "." line)
- :do (format t "NNTPS> ~A~%" line))))
-
-
-;; open an HTTPS connection to a secure web server and make a
-;; HEAD request
-(defun test-https-client (host &optional (port 443))
- (let* ((deadline (+ (get-internal-real-time)
- (* 3 internal-time-units-per-second)))
- (socket (ccl:make-socket :address-family :internet
- :connect :active
- :type :stream
- :remote-host host
- :remote-port port
-;; :local-host (resolve-hostname local-host)
-;; :local-port local-port
- :deadline deadline))
- (https
- (progn
- (cl+ssl:make-ssl-client-stream
- socket
- :unwrap-stream-p t
- :external-format '(:iso-8859-1 :eol-style :lf)))))
- (unwind-protect
- (progn
- (format https "GET / HTTP/1.0~%Host: ~a~%~%" host)
- (force-output https)
- (loop :for line = (read-line-crlf https nil)
- :while line :do
- (format t "HTTPS> ~a~%" line)))
- (close https))))
-
-;; start a simple HTTPS server. See the mod_ssl documentation at
-;; <URL:http://www.modssl.org/> for information on generating the
-;; server certificate and key
-;;
-;; You can stress-test the server with
-;;
-;; siege -c 10 -u https://host:8080/foobar
-;;
-(defun test-https-server
- (&key (port 8080)
- (cert "/home/david/newcert.pem")
- (key "/home/david/newkey.pem"))
- (format t "~&SSL server listening on port ~d~%" port)
- (trivial-sockets:with-server (server (:port port))
- (loop
- (let* ((socket (trivial-sockets:accept-connection
- server
- :element-type '(unsigned-byte 8)))
- (client (cl+ssl:make-ssl-server-stream
- socket
- :external-format '(:iso-8859-1 :eol-style :lf)
- :certificate cert
- :key key)))
- (unwind-protect
- (progn
- (loop :for line = (read-line-crlf client nil)
- :while (> (length line) 1) :do
- (format t "HTTPS> ~a~%" line))
- (format client "HTTP/1.0 200 OK~%")
- (format client "Server: SSL-CMUCL/1.1~%")
- (format client "Content-Type: text/plain~%")
- (terpri client)
- (format client "G'day at ~A!~%"
- (multiple-value-list (get-decoded-time)))
- (format client "CL+SSL running in ~A ~A~%"
- (lisp-implementation-type)
- (lisp-implementation-version)))
- (close client))))))
(DIR) diff --git a/3rdparties/software/cl+ssl-20190202-git/index.css b/3rdparties/software/cl+ssl-20190202-git/index.css
@@ -1,72 +0,0 @@
-div.sidebar {
- float: right;
- background-color: #eeeeee;
- border: 2pt solid black;
- margin: 0em 2pt 1em 2em;
- min-width: 15%;
- padding: 0pt 5pt 5pt 5pt;
-}
-
-div.sidebar ul {
- padding: 0pt 0pt 0pt 1em;
- margin: 0 0 1em;
-}
-
-body {
- color: #000000;
- background-color: #ffffff;
- margin-right: 0pt;
- margin-bottom: 10%;
- padding-left: 30px;
-}
-
-h1,h2 {
- margin-left: -30px;
-}
-
-h3 {
- margin-top: 2em;
- margin-left: -20px;
-}
-
-th {
- background-color: darkred;
- color: white;
- text-align: left;
-}
-
-pre {
- background-color: #eeeeee;
- border: solid 1px #d0d0d0;
- padding: 1em;
- margin-right: 10%;
-}
-
-.def {
- background-color: #eeeeee;
- width: 90%;
- font-weight: bold;
- border: solid 1px #d0d0d0;
- padding: 3px;
-}
-
-.nomargin {
- margin-bottom: 0;
- margin-top: 0;
-}
-
-.working {
- background-color: #60c060;
-}
-
-.broken {
- background-color: #ff6060;
-}
-
-.incomplete {
- background-color: #ffff60;
-}
-
-.unknown {
- background-color: #cccccc;
-}
(DIR) diff --git a/3rdparties/software/cl+ssl-20190202-git/index.html b/3rdparties/software/cl+ssl-20190202-git/index.html
@@ -1,464 +0,0 @@
-<?xml version="1.0" encoding="iso-8859-1"?>
-<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
-<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en">
- <head>
- <title>CL+SSL</title>
- <link rel="stylesheet" type="text/css" href="index.css"/>
- </head>
- <body>
- <h1>CL+SSL</h1>
-
- <p>
- A Common Lisp interface to OpenSSL.
- </p>
-
- <h3>About</h3>
-
- <p>
- This library is a fork
- of <a href="http://www.cliki.net/SSL-CMUCL">SSL-CMUCL</a>. The
- original SSL-CMUCL source code was written by Eric Marsden and
- includes contributions by Jochen Schmidt. Development into CL+SSL
- was done by David Lichteblau. License: MIT-style.
- </p>
-
- <p>
- Distinguishing features: CL+SSL is portable code based on CFFI and
- gray streams. It defines its own libssl BIO method, so that SSL
- I/O can be written over portable Lisp streams instead of bypassing
- the streams and sending data over Unix file descriptors directly.
- (But the traditional approach is still used if possible.)
- </p>
-
- <h3>Download</h3>
- <p>
- The library is available via <a href="http://www.quicklisp.org/">Quicklisp</a>.
- </p>
-
- <p>
- The Git repository: <a href="https://github.com/cl-plus-ssl/cl-plus-ssl">https://github.com/cl-plus-ssl/cl-plus-ssl</a>.
- </p>
- <p>
- Send bug reports to <a
- href="mailto:cl-plus-ssl-devel@common-lisp.net">cl-plus-ssl-devel@common-lisp.net</a>
- (<a
- href="http://common-lisp.net/cgi-bin/mailman/listinfo/cl-plus-ssl-devel">list
- information</a>).
- </p>
-
- <p>
- <i>Note</i> that you need the <tt>libssl-dev</tt> package on Debian to
- load this package without manual configuration.
- </p>
-
- <p>
- OpenSSL binaries for Windows may be found at
- <a href="http://www.slproweb.com/products/Win32OpenSSL.html">http://www.slproweb.com/products/Win32OpenSSL.html</a>
- (slproweb.com is a 3rd party; if you have questions about the OpenSSL installer they provide,
- please ask in the mailing list specified on the linked page).
- </p>
-
-
-<!--
- <p>
- Comparison chart:
- </p>
- <table border="1" cellpadding="2" cellspacing="0">
- <thead>
- <tr>
- <th></th>
- <th><b>FFI</b></th>
- <th><b>Streams</b></th>
- <th><b>Lisp-BIO</b></th>
- </tr>
- </thead>
- <tr>
- <td>CL+SSL</td>
- <td>CFFI</td>
- <td>gray<sup>1</sup>, buffering output</td>
- <td>yes</td>
- </tr>
- <tr>
- <td>CL-SSL</td>
- <td>UFFI</td>
- <td>gray, buffering I/O [<em>part of ACL-COMPAT</em>]</td>
- <td>no</td>
- </tr>
- <tr>
- <td>SSL-CMUCL</td>
- <td>CMUCL/ALIEN</td>
- <td>CMUCL, non-buffering</td>
- <td>no</td>
- </tr>
- </table>
- <p>
- <sup>1</sup> Character I/O and external formats in CL+SSL
- are provided
- using <a href="http://weitz.de/flexi-streams/">flexi-streams</a>.
- </p>
--->
-
- <h3>API</h3>
- <p>
- <div class="def">Function CL+SSL:ENSURE-INITIALIZED (&key (method 'ssl-v23-method) (rand-seed nil))</div>
- In most cases you <strong>do not</strong> need to call this function, because it is called
- automatically. The only reason to call it explicitly is to supply the <tt>rand-seed</tt> parameter.
- In this case do it before calling any other functions.
- </p>
- <p>
- Keyword arguments:
- </p>
- <p>
- <tt>method</tt>. Just leave its default value.
- </p>
- <p>
- <tt>rand-seed</tt> is an octet sequence to initialize OpenSSL random number generator.
- On many platforms, including Linux and Windows, it may be leaved NIL (default),
- because OpenSSL initializes the random number generator from OS specific service. But for
- example on Solaris it may be necessary to supply this value. The minimum length required
- by OpenSSL is 128 bits. See here <a href="http://www.openssl.org/support/faq.html#USER1">
- http://www.openssl.org/support/faq.html#USER1</a> for the details.
- </p>
- <p>
- Hint: do not use Common Lisp RANDOM function to generate the <tt>rand-seed</tt>, because the function
- usually returns predictable values.
- </p>
- <p>
- <pre class="def" style="font-family:normal;">Function CL+SSL:MAKE-CONTEXT (&key (method (ssl-v23-method))
- (disabled-protocols)
- (options (list +SSL-OP-ALL+))
- (session-cache-mode +ssl-sess-cache-server+)
- (verify-location :default)
- (verify-depth 100)
- (verify-mode +ssl-verify-peer+)
- (verify-callback nil verify-callback-supplied-p)
- (cipher-list +default-cipher-list+)
- (pem-password-callback 'pem-password-callback))</pre>
- </p>
- <p>
- Creates a new SSL_CTX using <a href="https://www.openssl.org/docs/manmaster/ssl/SSL_CTX_new.html"><tt>SSL_CTX_new</tt></a>
- and initializes it according to the specified parameters.
- After you're done using the context, don't forget to free it using <tt>ssl-ctx-free</tt>.
- </p>
- <p>
- Exceptions:
- </p>
- <p>
- <tt>ssl-error-initialize</tt>. When underlying SSL_CTX_new fails.
- </p>
- <p>
- Keyword arguments:
- </p>
- <p>
- <tt>method</tt>. Specifies which supported SSL/TLS to use. Defaults to ssl-v23-method
- </p>
- <p>
- <tt>disabled-protocols</tt>. List of +SSL-OP-NO-* constants. Denotes disabled SSL/TLS versions.
- When <tt>method</tt> not specified defaults to (list +SSL-OP-NO-SSLv2+ +SSL-OP-NO-SSLv3+)
- </p>
- <p>
- <tt>options</tt>. SSL context options list. Defaults to (list +SSL-OP-ALL+)
- </p>
- <p>
- <tt>session-cache-mode</tt>. Enable/Disable session caching. Defaults to +SSL-SESS-CACHE-SERVER+
- </p>
- <p>
- <tt>verify-location</tt>. Location(s) to load CA from.
- Possible values
- <br>
- <ul>
- <li><tt>:default</tt> OpenSSL default directory and file will be loaded</li>
- <li><tt>:default-file</tt> OpenSSL default file will be loaded</li>
- <li><tt>:default-dir</tt> OpenSSL default directory will be loaded</li>
- <li><tt>STRING</tt> Directory or file path to be loaded</li>
- <li><tt>PATHNAME</tt> Directory or file path to be loaded</li>
- <li><tt>(LIST (or STRING PATHNAME))</tt> List of directories or files to be loaded</li>
- </ul>
- </p>
- <p>
- <tt>verify-depth</tt>. Sets the maximum depth for the certificate chain verification that shall be allowed for context.
- Defaults to 100.
- </p>
- <p>
- <tt>verify-mode</tt>. Sets the verification flags for context to be mode. Available flags
- <ul>
- <li>+SSL-VERIFY-NONE+</li>
- <li>+SSL-VERIFY-PEER+</li>
- <li>+SSL-VERIFY-FAIL-IF-NO-PEER-CERT+</li>
- <li>+SSL-VERIFY-CLIENT-ONCE+</li>
- </ul>
- Defaults to +VERIFY-PEER+
- </p>
- <p>
- <tt>verify-callback</tt>. The verify-callback is used to control the behaviour when the +SSL-VERIFY-PEER+ flag is set.
- <br/>
- Please note: this must be CFFI callback i.e. defined as <tt>(defcallback <name> :int ((ok :int) (ctx :pointer)) .. )</tt>.
- <br/>
- Defaults to <tt>verify-peer-callback</tt> which converts chain errors to <tt>ssl-error-verify</tt>.
- </p>
- <p>
- <tt>cipher-list</tt>. Sets the list of available ciphers for context.
- Possible values described <a href="https://www.openssl.org/docs/manmaster/apps/ciphers.html">here</a>.
- <br/>
- Default is expected to change overtime to provide highest security level. Do not rely on its exact value.
- </p>
- <p>
- <tt>pem-password-callback</tt>. Sets the default password callback called when loading/storing a PEM certificate with encryption.
- <br/>
- Please note: this must be CFFI callback i.e. defined as <tt>(cffi:defcallback <name> :int
- ((buf :pointer) (size :int) (rwflag :int) (unused :pointer)) .. )</tt>.
- <br/>
- Defaults to <tt>pem-password-callback</tt> which simply uses password provided by <tt>with-pem-password</tt>.
- </p>
- <p>
- <div class="def">Function CL+SSL:SSL-CTX-FREE (context)</div>
- Plain FFI binding for <a href="https://www.openssl.org/docs/manmaster/ssl/SSL_CTX_free.html">SSL_CTX_free<a>.
- </p>
- <p>
- <div class="def">Macro CL+SSL:WITH-GLOBAL-CONTEXT ((context &key :auto-free-p) &body body)</div>
- Executes <tt>body</tt> with <tt>*ssl-global-context*</tt> bound to <tt>context</tt>.
- <br/>
- If <tt>auto-free-p</tt> is true the context is freed using <tt>ssl-ctx-free</tt> before exit.
- </p>
- <p>
- <div class="def">Function CL+SSL:MAKE-SSL-CLIENT-STREAM (fd-or-stream &key external-format certificate key password close-callback (unwrap-stream-p t) hostname)<br/><br/>
- Function CL+SSL:MAKE-SSL-SERVER-STREAM (fd-or-stream &key external-format certificate key password close-callback (unwrap-stream-p t))</div>
- Return an SSL stream for the client (server)
- socket <tt>fd-or-stream</tt>. All reads and writes to this
- stream will be pushed through the OpenSSL library.
- </p>
- <p>
- Keyword arguments:
- </p>
- <p>
- If <tt>fd-or-stream</tt> is a lisp stream, the SSL stream will
- close it automatically. File descriptors are not closed
- automatically. However, if <tt>close-callback</tt> is non-nil, it
- will be called with zero arguments when the SSL stream is closed.
- </p>
- <p>
- If <tt>unwrap-stream-p</tt> is true (the default), a stream for a
- file descriptor will be replaced by that file descriptor
- automatically. This is similar to passing the result
- of <tt>stream-fd</tt> as an argument, except that a deadline
- associated with the stream object will be taken into account, and
- that the stream will be closed automatically. As with file
- descriptor arguments, no I/O will actually be done on the stream
- object.
- </p>
- <p>
- <tt>certificate</tt> is the path to a file containing the PEM-encoded
- certificate.
- </p>
- <p>
- <tt>key</tt> is the path to the PEM-encoded key, which may be associated
- with the passphrase <tt>password</tt>.
- </p>
- <p>
- If <tt>external-format</tt> is <tt>nil</tt> (the default), a plain
- <tt>(unsigned-byte 8)</tt> SSL stream is returned. With a
- non-null <tt>external-format</tt>, a flexi-stream capable of
- character I/O will be returned instead, with the specified value
- as its initial external format.
- </p>
- <p>
- <tt>verify</tt> can be specified either as NIL if no check should be performed,
- <tt>:optional</tt> to verify the server's certificate if it presented one or
- <tt>:required</tt> to verify the server's certificate
- and fail if an invalid or no certificate was presented.
- Defaults to <tt>*make-ssl-client-stream-verify-default*</tt>
- which is initialized to <tt>:required</tt>
- </p>
- <p>
- <tt>hostname</tt> if specified, will be sent by client during TLS negotiation,
- according to the Server Name Indication (SNI) extension to the TLS.
- When server handles several domain names, this extension enables the server
- to choose certificate for right domain. Also the <tt>hostname></tt> is used for
- hostname verification if verification is enabled by <tt>verify</tt>.
- </p>
- <p>
- <div class="def">Variable *make-ssl-client-stream-verify-default* :required</div>
- Helps to mitigate the change in default behaviour of
- <tt>make-ssl-client-stream</tt> - previously it worked as if <tt>:verify nil</tt>
- but then <tt>:verify :required</tt> became the default on non-Windows platforms.
- Change this variable if you want the previous behaviour.
- </p>
- <p>
- <div class="def">Function CL+SSL:USE-CERTIFICATE-CHAIN-FILE (certificate-chain-file)</div>
- Loads a PEM encoded certificate chain file <tt>certificate-chain-file</tt>
- and adds the chain to global context. The certificates must be sorted
- starting with the subject's certificate (actual client or server certificate),
- followed by intermediate CA certificates if applicable, and ending at
- the highest level (root) CA.
- </p>
- <p>
- Note: the RELOAD function clears the global
- context and in particular the loaded certificate chain.
- </p>
- <p>
- <div class="def">Function CL+SSL:RELOAD ()</div>
- Reload <tt>libssl</tt>. Call this function after restarting a Lisp
- core with CL+SSL dumped into it on Lisp implementations that do
- not reload shared libraries automatically.
- </p>
- <p>
- <div class="def"><a name="libs-already-loaded">
- *FEATURES* flag :CL+SSL-FOREIGN-LIBS-ALREADY-LOADED
- </a></div>
- Allows user to load libssl (and libeay32 on Windows) himself
- thus choosing the foreigh library(-ies) path and version to load.
-
- <p>If specified, neither loading of the cl+ssl ASDF system
- nor (cl+ssl:reload) try to load the foreign libraries,
- assuming user has loaded them already.</p>
-
- <pre>
- (cffi:load-foreign-library "libssl.so.1.0.0")
-
- (let ((*features* (cons :cl+ssl-foreign-libs-already-loaded
- *features*)))
-
- (ql:quickload :a-system-which-depends-on-cl+ssl)
-
- ;; or just load cl+ssl
- (ql:quickload :cl+ssl))
- </pre>
-
- </p>
- <p>
- <div class="def">Function CL+SSL:STREAM-FD (stream)</div>
- Return <tt>stream</tt>'s file descriptor as an integer, if known.
- Otherwise return <tt>stream</tt> itself. The result of this
- function can be passed to <tt>make-ssl-client-stream</tt>
- and <tt>make-ssl-server-stream</tt>.
- </p>
- <p>
- <div class="def">Function CL+SSL:RANDOM-BYTES (count)</div>
- Generates <tt>count</tt> cryptographically strong pseudo-random bytes. Returns
- the bytes as a <tt>simple-array</tt> with <tt>element-type '(unsigned-byte 8)</tt>.
- Signals an <tt>error</tt> in case of problems, for example when the OpenSSL
- random number generator has not been seeded with enough randomness to ensure
- an unpredictable byte sequence.
- </p>
-
- <h3>Portability</h3>
- <p>
- CL+SSL requires CFFI with callback support.
- </p>
- <p>
- CL Test Grid results: <a href="https://common-lisp.net/project/cl-test-grid/library/cl+ssl.html">https://common-lisp.net/project/cl-test-grid/library/cl+ssl.html</a>
- </p>
- <h3>TODO</h3>
- <ul>
- <li>session caching</li>
- <li>The FFI code for all platforms except clisp needs to be
- rewritten. (update 2017-07-05: does it? why?)</li>
- </ul>
- <h3>News</h3>
- <p>
- 2017-07-03
- </p>
- <ul>
- <li>
- Hostname verification added, thanks to Ilya Khaprov.
- Default mode for <tt>make-ssl-client-stream</tt> is to verify the connection.
- New keywrd argument <tt>verify</tt> is added to <tt>make-ssl-client-stream</tt> with the same possible values as Drakma uses for http request verification.
- </li>
- </ul>
- <p>
- 201?-??-??
- </p>
- <ul>
- <li>
- See <a href="https://github.com/cl-plus-ssl/cl-plus-ssl/commits/master">commits</a>.
- </li>
- </ul>
- <p>
- 2011-05-22
- </p>
- <ul>
- <li>
- Added new public function RANDOM-BYTES.
- </li>
- </ul>
- <p>
- 2011-05-22
- </p>
- <ul>
- <li>
- The source code repository is moved to Git.
- </li>
- </ul>
- <p>
- 2011-03-25
- </p>
- <ul>
- <li>
- OpenSSL libraries names for OpenBSD, thanks to Thomas de Grivel.
- </li>
- </ul>
- <p>
- 2010-05-26
- </p>
- <ul>
- <li>
- Fixed two bugs in LISTEN, thanks to Ron Garret.
- </li>
- </ul>
- <p>
- 2009-09-17
- </p>
- <ul>
- <li>
- libssl loading on FreeBSD 7.2 fixed, thanks to Stian Sletner.
- </li>
- </ul>
- <p>
- 2008-xx-yy
- </p>
- <ul>
- <li>
- Support for I/O deadlines (Clozure CL and SBCL).
- </li>
- <li>
- Support for encrypted keys, thanks to Vsevolod Dyomkin.
- </li>
- <li>
- Chained certificates support, thanks to Juhani Rnkimies.
- </li>
- <li>
- More secure initialization of OpenSSL random number generator.
- </li>
- <li>
- Minor CLISP-specific fixes.
- </li>
- </ul>
- <p>
- 2007-xx-yy
- </p>
- <ul>
- <li>
- Fixed windows support, thanks to Matthew Kennedy and Anton Vodonosov.
- </li>
- </ul>
- <p>
- 2007-07-07
- </p>
- <ul>
- <li>
- Improved CLISP support, thanks
- to <a
- href="http://web.kepibu.org/code/lisp/cl+ssl/">Pixel
- // pinterface</a>, as well as client certificate support.
- </li>
- <li>
- Re-introduced support for direct access to file descriptors as
- an optimization. New function <tt>stream-fd</tt>. New keyword
- argument <tt>close-callback</tt>.
- </li>
- </ul>
- <p>
- 2007-01-16: CL+SSL is now available under an MIT-style license.
- </p>
- </body>
-</html>
(DIR) diff --git a/3rdparties/software/cl+ssl-20190202-git/src/bio.lisp b/3rdparties/software/cl+ssl-20190202-git/src/bio.lisp
@@ -1,140 +0,0 @@
-;;;; -*- Mode: LISP; Syntax: COMMON-LISP; indent-tabs-mode: nil; coding: utf-8; show-trailing-whitespace: t -*-
-;;;
-;;; Copyright (C) 2005 David Lichteblau
-;;;
-;;; See LICENSE for details.
-
-#+xcvb (module (:depends-on ("package")))
-
-(in-package cl+ssl)
-
-(defconstant +bio-type-socket+ (logior 5 #x0400 #x0100))
-(defconstant +BIO_FLAGS_READ+ 1)
-(defconstant +BIO_FLAGS_WRITE+ 2)
-(defconstant +BIO_FLAGS_SHOULD_RETRY+ 8)
-(defconstant +BIO_CTRL_FLUSH+ 11)
-
-(cffi:defcstruct bio-method
- (type :int)
- (name :pointer)
- (bwrite :pointer)
- (bread :pointer)
- (bputs :pointer)
- (bgets :pointer)
- (ctrl :pointer)
- (create :pointer)
- (destroy :pointer)
- (callback-ctrl :pointer))
-
-(cffi:defcstruct bio
- (method :pointer)
- (callback :pointer)
- (cb-arg :pointer)
- (init :int)
- (shutdown :int)
- (flags :int)
- (retry-reason :int)
- (num :int)
- (ptr :pointer)
- (next-bio :pointer)
- (prev-bio :pointer)
- (references :int)
- (num-read :unsigned-long)
- (num-write :unsigned-long)
- (crypto-ex-data-stack :pointer)
- (crypto-ex-data-dummy :int))
-
-(defun make-bio-lisp-method ()
- (let ((m (cffi:foreign-alloc '(:struct bio-method))))
- (setf (cffi:foreign-slot-value m '(:struct bio-method) 'type)
- ;; fixme: this is wrong, but presumably still better than some
- ;; random value here.
- +bio-type-socket+)
- (macrolet ((slot (name)
- `(cffi:foreign-slot-value m '(:struct bio-method) ,name)))
- (setf (slot 'name) (cffi:foreign-string-alloc "lisp"))
- (setf (slot 'bwrite) (cffi:callback lisp-write))
- (setf (slot 'bread) (cffi:callback lisp-read))
- (setf (slot 'bputs) (cffi:callback lisp-puts))
- (setf (slot 'bgets) (cffi:null-pointer))
- (setf (slot 'ctrl) (cffi:callback lisp-ctrl))
- (setf (slot 'create) (cffi:callback lisp-create))
- (setf (slot 'destroy) (cffi:callback lisp-destroy))
- (setf (slot 'callback-ctrl) (cffi:null-pointer)))
- m))
-
-(defun bio-new-lisp ()
- (bio-new *bio-lisp-method*))
-
-
-;;; "cargo cult"
-
-(cffi:defcallback lisp-write :int ((bio :pointer) (buf :pointer) (n :int))
- bio
- (dotimes (i n)
- (write-byte (cffi:mem-ref buf :unsigned-char i) *socket*))
- (finish-output *socket*)
- n)
-
-(defun clear-retry-flags (bio)
- (setf (cffi:foreign-slot-value bio '(:struct bio) 'flags)
- (logandc2 (cffi:foreign-slot-value bio '(:struct bio) 'flags)
- (logior +BIO_FLAGS_READ+
- +BIO_FLAGS_WRITE+
- +BIO_FLAGS_SHOULD_RETRY+))))
-
-(defun set-retry-read (bio)
- (setf (cffi:foreign-slot-value bio '(:struct bio) 'flags)
- (logior (cffi:foreign-slot-value bio '(:struct bio) 'flags)
- +BIO_FLAGS_READ+
- +BIO_FLAGS_SHOULD_RETRY+)))
-
-(cffi:defcallback lisp-read :int ((bio :pointer) (buf :pointer) (n :int))
- bio buf n
- (let ((i 0))
- (handler-case
- (unless (or (cffi:null-pointer-p buf) (null n))
- (clear-retry-flags bio)
- (when (or *blockp* (listen *socket*))
- (setf (cffi:mem-ref buf :unsigned-char i) (read-byte *socket*))
- (incf i))
- (loop
- while (and (< i n)
- (or (null *partial-read-p*) (listen *socket*)))
- do
- (setf (cffi:mem-ref buf :unsigned-char i) (read-byte *socket*))
- (incf i))
- #+(or)
- (when (zerop i) (set-retry-read bio)))
- (end-of-file ()))
- i))
-
-(cffi:defcallback lisp-puts :int ((bio :pointer) (buf :string))
- bio buf
- (error "lisp-puts not implemented"))
-
-(cffi:defcallback lisp-ctrl :int
- ((bio :pointer) (cmd :int) (larg :long) (parg :pointer))
- bio larg parg
- (cond
- ((eql cmd +BIO_CTRL_FLUSH+) 1)
- (t
- ;; (warn "lisp-ctrl(~A,~A,~A)" cmd larg parg)
- 0)))
-
-(cffi:defcallback lisp-create :int ((bio :pointer))
- (setf (cffi:foreign-slot-value bio '(:struct bio) 'init) 1)
- (setf (cffi:foreign-slot-value bio '(:struct bio) 'num) 0)
- (setf (cffi:foreign-slot-value bio '(:struct bio) 'ptr) (cffi:null-pointer))
- (setf (cffi:foreign-slot-value bio '(:struct bio) 'flags) 0)
- 1)
-
-(cffi:defcallback lisp-destroy :int ((bio :pointer))
- (cond
- ((cffi:null-pointer-p bio) 0)
- (t
- (setf (cffi:foreign-slot-value bio '(:struct bio) 'init) 0)
- (setf (cffi:foreign-slot-value bio '(:struct bio) 'flags) 0)
- 1)))
-
-(setf *bio-lisp-method* nil) ;force reinit if anything changed here
(DIR) diff --git a/3rdparties/software/cl+ssl-20190202-git/src/conditions.lisp b/3rdparties/software/cl+ssl-20190202-git/src/conditions.lisp
@@ -1,321 +0,0 @@
-;;;; -*- Mode: LISP; Syntax: COMMON-LISP; indent-tabs-mode: nil; coding: utf-8; show-trailing-whitespace: t -*-
-;;;
-;;; Copyright (C) 2001, 2003 Eric Marsden
-;;; Copyright (C) 2005 David Lichteblau
-;;; "the conditions and ENSURE-SSL-FUNCALL are by Jochen Schmidt."
-;;;
-;;; See LICENSE for details.
-
-#+xcvb (module (:depends-on ("package")))
-
-(in-package :cl+ssl)
-
-(eval-when (:compile-toplevel :load-toplevel :execute)
- (defconstant +ssl-error-none+ 0)
- (defconstant +ssl-error-ssl+ 1)
- (defconstant +ssl-error-want-read+ 2)
- (defconstant +ssl-error-want-write+ 3)
- (defconstant +ssl-error-want-x509-lookup+ 4)
- (defconstant +ssl-error-syscall+ 5)
- (defconstant +ssl-error-zero-return+ 6)
- (defconstant +ssl-error-want-connect+ 7))
-
-
-;;; Condition hierarchy
-;;;
-
-(defun read-ssl-error-queue ()
- (loop
- :for error-code = (err-get-error)
- :until (zerop error-code)
- :collect error-code))
-
-(defun format-ssl-error-queue (stream-designator queue-designator)
- "STREAM-DESIGNATOR is the same as CL:FORMAT accepts: T, NIL, or a stream.
-QUEUE-DESIGNATOR is either a list of error codes (as returned
-by READ-SSL-ERROR-QUEUE) or an SSL-ERROR condition."
- (flet ((body (stream)
- (let ((queue (etypecase queue-designator
- (ssl-error (ssl-error-queue queue-designator))
- (list queue-designator))))
- (format stream "SSL error queue")
- (if queue
- (progn
- (format stream ":~%")
- (loop
- :for error-code :in queue
- :do (format stream "~a~%" (err-error-string error-code (cffi:null-pointer)))))
- (format stream " is empty.")))))
- (case stream-designator
- ((t) (body *standard-output*))
- ((nil) (let ((s (make-string-output-stream :element-type 'character)))
- (unwind-protect
- (body s)
- (close s))
- (get-output-stream-string s)))
- (otherwise (body stream-designator)))))
-
-(define-condition cl+ssl-error (error)
- ())
-
-(define-condition ssl-error (cl+ssl-error)
- (
- ;; Stores list of error codes
- ;; (as returned by the READ-SSL-ERROR-QUEUE function)
- (queue :initform nil :initarg :queue :reader ssl-error-queue)))
-
-(define-condition ssl-error/handle (ssl-error)
- ((ret :initarg :ret
- :reader ssl-error-ret)
- (handle :initarg :handle
- :reader ssl-error-handle))
- (:report (lambda (condition stream)
- (format stream "Unspecified error ~A on handle ~A~%"
- (ssl-error-ret condition)
- (ssl-error-handle condition))
- (format-ssl-error-queue stream condition))))
-
-(define-condition ssl-error-initialize (ssl-error)
- ((reason :initarg :reason
- :reader ssl-error-reason))
- (:report (lambda (condition stream)
- (format stream "SSL initialization error: ~A~%"
- (ssl-error-reason condition))
- (format-ssl-error-queue stream condition))))
-
-
-(define-condition ssl-error-want-something (ssl-error/handle)
- ())
-
-;;;SSL_ERROR_NONE
-(define-condition ssl-error-none (ssl-error/handle)
- ()
- (:documentation
- "The TLS/SSL I/O operation completed. This result code is returned if and
- only if ret > 0.")
- (:report (lambda (condition stream)
- (format stream "The TLS/SSL operation on handle ~A completed (return code: ~A).~%"
- (ssl-error-handle condition)
- (ssl-error-ret condition))
- (format-ssl-error-queue stream condition))))
-
-;; SSL_ERROR_ZERO_RETURN
-(define-condition ssl-error-zero-return (ssl-error/handle)
- ()
- (:documentation
- "The TLS/SSL connection has been closed. If the protocol version is SSL 3.0
- or TLS 1.0, this result code is returned only if a closure alert has
- occurred in the protocol, i.e. if the connection has been closed cleanly.
- Note that in this case SSL_ERROR_ZERO_RETURN
- does not necessarily indicate that the underlying transport has been
- closed.")
- (:report (lambda (condition stream)
- (format stream "The TLS/SSL connection on handle ~A has been closed (return code: ~A).~%"
- (ssl-error-handle condition)
- (ssl-error-ret condition))
- (format-ssl-error-queue stream condition))))
-
-;; SSL_ERROR_WANT_READ
-(define-condition ssl-error-want-read (ssl-error-want-something)
- ()
- (:documentation
- "The operation did not complete; the same TLS/SSL I/O function should be
- called again later. If, by then, the underlying BIO has data available for
- reading (if the result code is SSL_ERROR_WANT_READ) or allows writing data
- (SSL_ERROR_WANT_WRITE), then some TLS/SSL protocol progress will take place,
- i.e. at least part of an TLS/SSL record will be read or written. Note that
- the retry may again lead to a SSL_ERROR_WANT_READ or SSL_ERROR_WANT_WRITE
- condition. There is no fixed upper limit for the number of iterations that
- may be necessary until progress becomes visible at application protocol
- level.")
- (:report (lambda (condition stream)
- (format stream "The TLS/SSL operation on handle ~A did not complete: It wants a READ (return code: ~A).~%"
- (ssl-error-handle condition)
- (ssl-error-ret condition))
- (format-ssl-error-queue stream condition))))
-
-;; SSL_ERROR_WANT_WRITE
-(define-condition ssl-error-want-write (ssl-error-want-something)
- ()
- (:documentation
- "The operation did not complete; the same TLS/SSL I/O function should be
- called again later. If, by then, the underlying BIO has data available for
- reading (if the result code is SSL_ERROR_WANT_READ) or allows writing data
- (SSL_ERROR_WANT_WRITE), then some TLS/SSL protocol progress will take place,
- i.e. at least part of an TLS/SSL record will be read or written. Note that
- the retry may again lead to a SSL_ERROR_WANT_READ or SSL_ERROR_WANT_WRITE
- condition. There is no fixed upper limit for the number of iterations that
- may be necessary until progress becomes visible at application protocol
- level.")
- (:report (lambda (condition stream)
- (format stream "The TLS/SSL operation on handle ~A did not complete: It wants a WRITE (return code: ~A).~%"
- (ssl-error-handle condition)
- (ssl-error-ret condition))
- (format-ssl-error-queue stream condition))))
-
-;; SSL_ERROR_WANT_CONNECT
-(define-condition ssl-error-want-connect (ssl-error-want-something)
- ()
- (:documentation
- "The operation did not complete; the same TLS/SSL I/O function should be
- called again later. The underlying BIO was not connected yet to the peer
- and the call would block in connect()/accept(). The SSL
- function should be called again when the connection is established. These
- messages can only appear with a BIO_s_connect() or
- BIO_s_accept() BIO, respectively. In order to find out, when
- the connection has been successfully established, on many platforms
- select() or poll() for writing on the socket file
- descriptor can be used.")
- (:report (lambda (condition stream)
- (format stream "The TLS/SSL operation on handle ~A did not complete: It wants a connect first (return code: ~A).~%"
- (ssl-error-handle condition)
- (ssl-error-ret condition))
- (format-ssl-error-queue stream condition))))
-
-;; SSL_ERROR_WANT_X509_LOOKUP
-(define-condition ssl-error-want-x509-lookup (ssl-error-want-something)
- ()
- (:documentation
- "The operation did not complete because an application callback set by
- SSL_CTX_set_client_cert_cb() has asked to be called again. The
- TLS/SSL I/O function should be called again later. Details depend on the
- application.")
- (:report (lambda (condition stream)
- (format stream "The TLS/SSL operation on handle ~A did not complete: An application callback wants to be called again (return code: ~A).~%"
- (ssl-error-handle condition)
- (ssl-error-ret condition))
- (format-ssl-error-queue stream condition))))
-
-;; SSL_ERROR_SYSCALL
-(define-condition ssl-error-syscall (ssl-error/handle)
- ((syscall :initarg :syscall))
- (:documentation
- "Some I/O error occurred. The OpenSSL error queue may contain more
- information on the error. If the error queue is empty (i.e. ERR_get_error() returns 0),
- ret can be used to find out more about the error: If ret == 0, an EOF was observed that
- violates the protocol. If ret == -1, the underlying BIO reported an I/O error (for socket
- I/O on Unix systems, consult errno for details).")
- (:report (lambda (condition stream)
- (if (zerop (length (ssl-error-queue condition)))
- (case (ssl-error-ret condition)
- (0 (format stream "An I/O error occurred: An unexpected EOF was observed on handle ~A (return code: ~A).~%"
- (ssl-error-handle condition)
- (ssl-error-ret condition)))
- (-1 (format stream "An I/O error occurred in the underlying BIO (return code: ~A).~%"
- (ssl-error-ret condition)))
- (otherwise (format stream "An I/O error occurred: undocumented reason (return code: ~A).~%"
- (ssl-error-ret condition))))
- (format stream "An UNKNOWN I/O error occurred in the underlying BIO (return code: ~A).~%"
- (ssl-error-ret condition)))
- (format-ssl-error-queue stream condition))))
-
-;; SSL_ERROR_SSL
-(define-condition ssl-error-ssl (ssl-error/handle)
- ()
- (:documentation
- "A failure in the SSL library occurred, usually a protocol error. The
- OpenSSL error queue contains more information on the error.")
- (:report (lambda (condition stream)
- (format stream
- "A failure in the SSL library occurred on handle ~A (return code: ~A).~%"
- (ssl-error-handle condition)
- (ssl-error-ret condition))
- (format-ssl-error-queue stream condition))))
-
-(defun ssl-signal-error (handle syscall error-code original-error)
- (let ((queue (read-ssl-error-queue)))
- (if (and (eql error-code #.+ssl-error-syscall+)
- (not (zerop original-error)))
- (error 'ssl-error-syscall
- :handle handle
- :ret error-code
- :queue queue
- :syscall syscall)
- (error (case error-code
- (#.+ssl-error-none+ 'ssl-error-none)
- (#.+ssl-error-ssl+ 'ssl-error-ssl)
- (#.+ssl-error-want-read+ 'ssl-error-want-read)
- (#.+ssl-error-want-write+ 'ssl-error-want-write)
- (#.+ssl-error-want-x509-lookup+ 'ssl-error-want-x509-lookup)
- (#.+ssl-error-zero-return+ 'ssl-error-zero-return)
- (#.+ssl-error-want-connect+ 'ssl-error-want-connect)
- (#.+ssl-error-syscall+ 'ssl-error-zero-return) ; this is intentional here. we got an EOF from the syscall (ret is 0)
- (t 'ssl-error/handle))
- :handle handle
- :ret error-code
- :queue queue))))
-
-(defparameter *ssl-verify-error-alist*
- '((0 :X509_V_OK)
- (2 :X509_V_ERR_UNABLE_TO_GET_ISSUER_CERT)
- (3 :X509_V_ERR_UNABLE_TO_GET_CRL)
- (4 :X509_V_ERR_UNABLE_TO_DECRYPT_CERT_SIGNATURE)
- (5 :X509_V_ERR_UNABLE_TO_DECRYPT_CRL_SIGNATURE)
- (6 :X509_V_ERR_UNABLE_TO_DECODE_ISSUER_PUBLIC_KEY)
- (7 :X509_V_ERR_CERT_SIGNATURE_FAILURE)
- (8 :X509_V_ERR_CRL_SIGNATURE_FAILURE)
- (9 :X509_V_ERR_CERT_NOT_YET_VALID)
- (10 :X509_V_ERR_CERT_HAS_EXPIRED)
- (11 :X509_V_ERR_CRL_NOT_YET_VALID)
- (12 :X509_V_ERR_CRL_HAS_EXPIRED)
- (13 :X509_V_ERR_ERROR_IN_CERT_NOT_BEFORE_FIELD)
- (14 :X509_V_ERR_ERROR_IN_CERT_NOT_AFTER_FIELD)
- (15 :X509_V_ERR_ERROR_IN_CRL_LAST_UPDATE_FIELD)
- (16 :X509_V_ERR_ERROR_IN_CRL_NEXT_UPDATE_FIELD)
- (17 :X509_V_ERR_OUT_OF_MEM)
- (18 :X509_V_ERR_DEPTH_ZERO_SELF_SIGNED_CERT)
- (19 :X509_V_ERR_SELF_SIGNED_CERT_IN_CHAIN)
- (20 :X509_V_ERR_UNABLE_TO_GET_ISSUER_CERT_LOCALLY)
- (21 :X509_V_ERR_UNABLE_TO_VERIFY_LEAF_SIGNATURE)
- (22 :X509_V_ERR_CERT_CHAIN_TOO_LONG)
- (23 :X509_V_ERR_CERT_REVOKED)
- (24 :X509_V_ERR_INVALID_CA)
- (25 :X509_V_ERR_PATH_LENGTH_EXCEEDED)
- (26 :X509_V_ERR_INVALID_PURPOSE)
- (27 :X509_V_ERR_CERT_UNTRUSTED)
- (28 :X509_V_ERR_CERT_REJECTED)
- (29 :X509_V_ERR_SUBJECT_ISSUER_MISMATCH)
- (30 :X509_V_ERR_AKID_SKID_MISMATCH)
- (31 :X509_V_ERR_AKID_ISSUER_SERIAL_MISMATCH)
- (32 :X509_V_ERR_KEYUSAGE_NO_CERTSIGN)
- (50 :X509_V_ERR_APPLICATION_VERIFICATION)))
-
-(defun ssl-verify-error-keyword (code)
- (cadr (assoc code *ssl-verify-error-alist*)))
-
-(defun ssl-verify-error-code (keyword)
- (caar (member keyword *ssl-verify-error-alist* :key #'cadr)))
-
-(define-condition ssl-error-verify (ssl-error)
- ((stream :initarg :stream
- :reader ssl-error-stream
- :documentation "The SSL stream whose peer certificate didn't verify.")
- (error-code :initarg :error-code
- :reader ssl-error-code
- :documentation "The peer certificate verification error code."))
- (:report (lambda (condition stream)
- (let ((code (ssl-error-code condition)))
- (format stream "SSL verify error: ~d~@[ ~a~]"
- code (ssl-verify-error-keyword code)))))
- (:documentation "This condition is signalled on SSL connection when a peer certificate doesn't verify."))
-
-(define-condition ssl-error-call (cl+ssl::ssl-error)
- ((message :initarg :message))
- (:documentation
- "A failure in the SSL library occurred..")
- (:report (lambda (condition stream)
- (format stream "A failure in OpenSSL library occurred~@[: ~A~].~%" (slot-value condition 'message)) (cl+ssl::format-ssl-error-queue stream (cl+ssl::ssl-error-queue condition)))))
-
-(define-condition asn1-error (cl+ssl-error)
- ()
- (:documentation "Asn1 syntax error"))
-
-(define-condition invalid-asn1-string (cl+ssl-error)
- ((type :initarg :type :initform nil))
- (:documentation "ASN.1 string parsing/validation error")
- (:report (lambda (condition stream)
- (format stream "ASN.1 syntax error: invalid asn1 string (expected type ~a)" (slot-value condition 'type))))) ;; TODO: when moved to grovel use enum symbol here
-
-(define-condition server-certificate-missing (cl+ssl-error simple-error)
- ()
- (:documentation "SSL server didn't present a certificate"))
(DIR) diff --git a/3rdparties/software/cl+ssl-20190202-git/src/context.lisp b/3rdparties/software/cl+ssl-20190202-git/src/context.lisp
@@ -1,127 +0,0 @@
-;;;; -*- Mode: LISP; Syntax: COMMON-LISP; indent-tabs-mode: nil; coding: utf-8; show-trailing-whitespace: t -*-
-
-(in-package :cl+ssl)
-
-(define-condition verify-location-not-found-error (ssl-error)
- ((location :initarg :location))
- (:documentation "Unable to find verify locations")
- (:report (lambda (condition stream)
- (format stream "Unable to find verify location. Path: ~A" (slot-value condition 'location)))))
-
-(defun validate-verify-location (location)
- (handler-case
- (cond
- ((uiop:file-exists-p location)
- (values location t))
- ((uiop:directory-exists-p location)
- (values location nil))
- (t
- (error 'verify-location-not-found-error :location location)))))
-
-(defun add-verify-locations (ctx locations)
- (dolist (location locations)
- (multiple-value-bind (location isfile)
- (validate-verify-location location)
- (cffi:with-foreign-strings ((location-ptr location))
- (unless (= 1 (cl+ssl::ssl-ctx-load-verify-locations
- ctx
- (if isfile location-ptr (cffi:null-pointer))
- (if isfile (cffi:null-pointer) location-ptr)))
- (error 'ssl-error :queue (read-ssl-error-queue) :message (format nil "Unable to load verify location ~A" location)))))))
-
-(defun ssl-ctx-set-verify-location (ctx location)
- (cond
- ((eq :default location)
- (unless (= 1 (ssl-ctx-set-default-verify-paths ctx))
- (error 'ssl-error-call :queue (read-ssl-error-queue) :message (format nil "Unable to load default verify paths"))))
- ;; TODO: design how to load ffi-1.1.0.lisp when and only when corresponding OpenSSL version is available
- ;; ((eq :default-file location)
- ;; (unless (= 1 (openssl-1.1.0:ssl-ctx-set-default-verify-file ctx))
- ;; (error 'ssl-error-call :queue (read-ssl-error-queue) :message (format nil "Unable to load default verify file"))))
- ;; ((eq :default-dir location)
- ;; (unless (= 1 (openssl-1.1.0:ssl-ctx-set-default-verify-dir ctx))
- ;; (error 'ssl-error-call :queue (read-ssl-error-queue) :message (format nil "Unable to load default verify dir"))))
- ((stringp location)
- (add-verify-locations ctx (list location)))
- ((pathnamep location)
- (add-verify-locations ctx (list location)))
- ((and location (listp location))
- (add-verify-locations ctx location))
- ;; silently allow NIL as location
- (location
- (error "Invalid location ~a" location))))
-
-(alexandria:define-constant +default-cipher-list+
- (format nil
- "ECDHE-RSA-AES256-GCM-SHA384:~
- ECDHE-RSA-AES256-SHA384:~
- ECDHE-RSA-AES256-SHA:~
- ECDHE-RSA-AES128-GCM-SHA256:~
- ECDHE-RSA-AES128-SHA256:~
- ECDHE-RSA-AES128-SHA:~
- ECDHE-RSA-RC4-SHA:~
- DHE-RSA-AES256-GCM-SHA384:~
- DHE-RSA-AES256-SHA256:~
- DHE-RSA-AES256-SHA:~
- DHE-RSA-AES128-GCM-SHA256:~
- DHE-RSA-AES128-SHA256:~
- DHE-RSA-AES128-SHA:~
- AES256-GCM-SHA384:~
- AES256-SHA256:~
- AES256-SHA:~
- AES128-GCM-SHA256:~
- AES128-SHA256:~
- AES128-SHA") :test 'equal)
-
-(cffi:defcallback verify-peer-callback :int ((ok :int) (ctx :pointer))
- (let ((error-code (x509-store-ctx-get-error ctx)))
- (unless (= error-code 0)
- (error 'ssl-error-verify :error-code error-code))
- ok))
-
-(defun make-context (&key (method nil method-supplied-p)
- (disabled-protocols)
- (options (list +SSL-OP-ALL+))
- (session-cache-mode +ssl-sess-cache-server+)
- (verify-location :default)
- (verify-depth 100)
- (verify-mode +ssl-verify-peer+)
- (verify-callback nil verify-callback-supplied-p)
- (cipher-list +default-cipher-list+)
- (pem-password-callback 'pem-password-callback))
- (ensure-initialized)
- (let ((ctx (ssl-ctx-new (if method-supplied-p
- method
- (progn
- (unless disabled-protocols
- (setf disabled-protocols
- (list +SSL-OP-NO-SSLv2+ +SSL-OP-NO-SSLv3+)))
- (ssl-v23-method))))))
- (when (cffi:null-pointer-p ctx)
- (error 'ssl-error-initialize :reason "Can't create new SSL CTX" :queue (read-ssl-error-queue)))
- (handler-bind ((error (lambda (_)
- (declare (ignore _))
- (ssl-ctx-free ctx))))
- (ssl-ctx-set-options ctx (apply #'logior (append disabled-protocols options)))
- (ssl-ctx-set-session-cache-mode ctx session-cache-mode)
- (ssl-ctx-set-verify-location ctx verify-location)
- (ssl-ctx-set-verify-depth ctx verify-depth)
- (ssl-ctx-set-verify ctx verify-mode (if verify-callback
- (cffi:get-callback verify-callback)
- (if verify-callback-supplied-p
- (cffi:null-pointer)
- (if (= verify-mode +ssl-verify-peer+)
- (cffi:callback verify-peer-callback)
- (cffi:null-pointer)))))
- (ssl-ctx-set-cipher-list ctx cipher-list)
- (ssl-ctx-set-default-passwd-cb ctx (cffi:get-callback pem-password-callback))
- ctx)))
-
-(defun call-with-global-context (context auto-free-p body-fn)
- (let* ((*ssl-global-context* context))
- (unwind-protect (funcall body-fn)
- (when auto-free-p
- (ssl-ctx-free context)))))
-
-(defmacro with-global-context ((context &key auto-free-p) &body body)
- `(call-with-global-context ,context ,auto-free-p (lambda () ,@body)))
(DIR) diff --git a/3rdparties/software/cl+ssl-20190202-git/src/ffi-1.1.0.lisp b/3rdparties/software/cl+ssl-20190202-git/src/ffi-1.1.0.lisp
@@ -1,22 +0,0 @@
-;;;; -*- Mode: LISP; Syntax: COMMON-LISP; indent-tabs-mode: nil; coding: utf-8; show-trailing-whitespace: t -*-
-
-(defpackage :openssl-1.1.0
- (:nicknames :ossl-1.1.0 :ossl110)
- (:use :common-lisp)
- (:export #:ssl-ctx-set-default-verify-dir
- #:ssl-ctx-set-default-verify-file))
-
-(in-package :openssl-1.1.0)
-
-;; TODO: factor out define-ssl-function into a common dependency from ffi.lisp
-;; and use it here. Or just move these functions to ffi.lisp if enough time passes
-;; and OpenSSL 1.1 or later is available universally.
-
-(cffi:defcfun ("SSL_CTX_set_default_verify_dir" ssl-ctx-set-default-verify-dir)
- :int
- (ctx :pointer))
-
-(cffi:defcfun ("SSL_CTX_set_default_verify_file" ssl-ctx-set-default-verify-file)
- :int
- (ctx :pointer))
-
(DIR) diff --git a/3rdparties/software/cl+ssl-20190202-git/src/ffi-buffer-all.lisp b/3rdparties/software/cl+ssl-20190202-git/src/ffi-buffer-all.lisp
@@ -1,16 +0,0 @@
-;;;; -*- Mode: LISP; Syntax: COMMON-LISP; indent-tabs-mode: nil; coding: utf-8; show-trailing-whitespace: t -*-
-
-#+xcvb (module (:depends-on ("package")))
-
-(in-package :cl+ssl)
-
-(defconstant +initial-buffer-size+ 2048)
-
-(declaim
- (inline
- make-buffer
- buffer-length
- buffer-elt
- set-buffer-elt
- s/b-replace
- b/s-replace))
(DIR) diff --git a/3rdparties/software/cl+ssl-20190202-git/src/ffi-buffer-clisp.lisp b/3rdparties/software/cl+ssl-20190202-git/src/ffi-buffer-clisp.lisp
@@ -1,53 +0,0 @@
-;;;; -*- Mode: LISP; Syntax: COMMON-LISP; indent-tabs-mode: nil; coding: utf-8; show-trailing-whitespace: t -*-
-
-#+xcvb (module (:depends-on ("package" "reload" "conditions" "ffi" "ffi-buffer-all")))
-
-(in-package :cl+ssl)
-
-(defun make-buffer (size)
- (cffi-sys:%foreign-alloc size))
-
-(defun buffer-length (buf)
- (declare (ignore buf))
- +initial-buffer-size+)
-
-(defun buffer-elt (buf index)
- (ffi:memory-as buf 'ffi:uint8 index))
-(defun set-buffer-elt (buf index val)
- (setf (ffi:memory-as buf 'ffi:uint8 index) val))
-(defsetf buffer-elt set-buffer-elt)
-
-(declaim
- (inline calc-buf-end))
-
-;; to calculate non NIL value of the buffer end index
-(defun calc-buf-end (buf-start seq seq-start seq-end)
- (+ buf-start
- (- (or seq-end (length seq))
- seq-start)))
-
-(defun s/b-replace (seq buf &key (start1 0) end1 (start2 0) end2)
- (when (null end2)
- (setf end2 (calc-buf-end start2 seq start1 end1)))
- (replace
- seq
- (ffi:memory-as buf (ffi:parse-c-type `(ffi:c-array ffi:uint8 ,(- end2 start2))) start2)
- :start1 start1
- :end1 end1))
-
-(defun as-vector (seq)
- (if (typep seq 'vector)
- seq
- (make-array (length seq) :initial-contents seq :element-type '(unsigned-byte 8))))
-
-(defun b/s-replace (buf seq &key (start1 0) end1 (start2 0) end2)
- (when (null end1)
- (setf end1 (calc-buf-end start1 seq start2 end2)))
- (setf
- (ffi:memory-as buf (ffi:parse-c-type `(ffi:c-array ffi:uint8 ,(- end1 start1))) start1)
- (as-vector (subseq seq start2 end2)))
- seq)
-
-(defmacro with-pointer-to-vector-data ((ptr buf) &body body)
- `(let ((,ptr ,buf))
- ,@body))
(DIR) diff --git a/3rdparties/software/cl+ssl-20190202-git/src/ffi-buffer.lisp b/3rdparties/software/cl+ssl-20190202-git/src/ffi-buffer.lisp
@@ -1,26 +0,0 @@
-;;;; -*- Mode: LISP; Syntax: COMMON-LISP; indent-tabs-mode: nil; coding: utf-8; show-trailing-whitespace: t -*-
-
-#+xcvb (module (:depends-on ("package")))
-
-(in-package :cl+ssl)
-
-(defun make-buffer (size)
- (cffi-sys::make-shareable-byte-vector size))
-
-(defun buffer-length (buf)
- (length buf))
-
-(defun buffer-elt (buf index)
- (elt buf index))
-(defun set-buffer-elt (buf index val)
- (setf (elt buf index) val))
-(defsetf buffer-elt set-buffer-elt)
-
-(defun s/b-replace (seq buf &key (start1 0) end1 (start2 0) end2)
- (replace seq buf :start1 start1 :end1 end1 :start2 start2 :end2 end2))
-(defun b/s-replace (buf seq &key (start1 0) end1 (start2 0) end2)
- (replace buf seq :start1 start1 :end1 end1 :start2 start2 :end2 end2))
-
-(defmacro with-pointer-to-vector-data ((ptr buf) &body body)
- `(cffi-sys::with-pointer-to-vector-data (,ptr ,buf)
- ,@body))
(DIR) diff --git a/3rdparties/software/cl+ssl-20190202-git/src/ffi.lisp b/3rdparties/software/cl+ssl-20190202-git/src/ffi.lisp
@@ -1,825 +0,0 @@
-;;;; -*- Mode: LISP; Syntax: COMMON-LISP; indent-tabs-mode: nil; coding: utf-8; show-trailing-whitespace: t -*-
-;;;
-;;; Copyright (C) 2001, 2003 Eric Marsden
-;;; Copyright (C) 2005 David Lichteblau
-;;; "the conditions and ENSURE-SSL-FUNCALL are by Jochen Schmidt."
-;;;
-;;; See LICENSE for details.
-
-#+xcvb (module (:depends-on ("package" "conditions")))
-
-(eval-when (:compile-toplevel)
- (declaim
- (optimize (speed 3) (space 1) (safety 1) (debug 0) (compilation-speed 0))))
-
-(in-package :cl+ssl)
-
-;;; Code for checking that we got the correct foreign symbols right.
-;;; Implemented only for LispWorks for now.
-(defvar *cl+ssl-ssl-foreign-function-names* nil)
-(defvar *cl+ssl-crypto-foreign-function-names* nil)
-#+lispworks
-(defun check-cl+ssl-symbols ()
- (dolist (ssl-symbol *cl+ssl-ssl-foreign-function-names*)
- (when (fli:null-pointer-p (fli:make-pointer :symbol-name ssl-symbol :module 'libssl :errorp nil))
- (format *error-output* "Symbol ~s undefined~%" ssl-symbol)))
- (dolist (crypto-symbol *cl+ssl-crypto-foreign-function-names*)
- (when (fli:null-pointer-p (fli:make-pointer :symbol-name crypto-symbol :module 'libcrypto :errorp nil))
- (format *error-output* "Symbol ~s undefined~%" crypto-symbol))))
-
-(defmacro define-ssl-function (name-and-options &body body)
- `(progn
- (pushnew ,(car name-and-options) *cl+ssl-ssl-foreign-function-names* :test 'equal) ; debugging
- (cffi:defcfun ,(append name-and-options '(:library libssl)) ,@body)))
-
-(defmacro define-crypto-function (name-and-options &body body)
- `(progn
- (pushnew ,(car name-and-options) *cl+ssl-crypto-foreign-function-names* :test 'equal) ; debugging
- (cffi:defcfun ,(append name-and-options #+(and lispworks darwin) '(:library libcrypto)) ,@body)))
-
-
-;;; Global state
-;;;
-(defvar *ssl-global-context* nil)
-(defvar *ssl-global-method* nil)
-(defvar *bio-lisp-method* nil)
-
-(defparameter *blockp* t)
-(defparameter *partial-read-p* nil)
-
-(defun ssl-initialized-p ()
- (and *ssl-global-context* *ssl-global-method*))
-
-
-;;; Constants
-;;;
-(defconstant +ssl-filetype-pem+ 1)
-(defconstant +ssl-filetype-asn1+ 2)
-(defconstant +ssl-filetype-default+ 3)
-
-(defconstant +SSL-CTRL-OPTIONS+ 32)
-(defconstant +SSL_CTRL_SET_SESS_CACHE_MODE+ 44)
-(defconstant +SSL_CTRL_MODE+ 33)
-
-(defconstant +SSL_MODE_ACCEPT_MOVING_WRITE_BUFFER+ 2)
-
-(defconstant +RSA_F4+ #x10001)
-
-(defconstant +SSL-SESS-CACHE-OFF+ #x0000
- "No session caching for client or server takes place.")
-(defconstant +SSL-SESS-CACHE-CLIENT+ #x0001
- "Client sessions are added to the session cache.
-As there is no reliable way for the OpenSSL library to know whether a session should be reused
-or which session to choose (due to the abstract BIO layer the SSL engine does not have details
-about the connection), the application must select the session to be reused by using the
-SSL-SET-SESSION function. This option is not activated by default.")
-(defconstant +SSL-SESS-CACHE-SERVER+ #x0002
- "Server sessions are added to the session cache.
-When a client proposes a session to be reused, the server looks for the corresponding session
-in (first) the internal session cache (unless +SSL-SESS-CACHE-NO-INTERNAL-LOOKUP+ is set), then
-(second) in the external cache if available. If the session is found, the server will try to
-reuse the session. This is the default.")
-(defconstant +SSL-SESS-CACHE-BOTH+ (logior +SSL-SESS-CACHE-CLIENT+ +SSL-SESS-CACHE-SERVER+)
- "Enable both +SSL-SESS-CACHE-CLIENT+ and +SSL-SESS-CACHE-SERVER+ at the same time.")
-(defconstant +SSL-SESS-CACHE-NO-AUTO-CLEAR+ #x0080
- "Normally the session cache is checked for expired sessions every 255 connections using the
-SSL-CTX-FLUSH-SESSIONS function. Since this may lead to a delay which cannot be controlled,
-the automatic flushing may be disabled and SSL-CTX-FLUSH-SESSIONS can be called explicitly
-by the application.")
-(defconstant +SSL-SESS-CACHE-NO-INTERNAL-LOOKUP+ #x0100
- "By setting this flag, session-resume operations in an SSL/TLS server will not automatically
-look up sessions in the internal cache, even if sessions are automatically stored there.
-If external session caching callbacks are in use, this flag guarantees that all lookups are
-directed to the external cache. As automatic lookup only applies for SSL/TLS servers, the flag
-has no effect on clients.")
-(defconstant +SSL-SESS-CACHE-NO-INTERNAL-STORE+ #x0200
- "Depending on the presence of +SSL-SESS-CACHE-CLIENT+ and/or +SSL-SESS-CACHE-SERVER+, sessions
-negotiated in an SSL/TLS handshake may be cached for possible reuse. Normally a new session is
-added to the internal cache as well as any external session caching (callback) that is configured
-for the SSL-CTX. This flag will prevent sessions being stored in the internal cache (though the
-application can add them manually using SSL-CTX-ADD-SESSION). Note: in any SSL/TLS servers where
-external caching is configured, any successful session lookups in the external cache (ie. for
-session-resume requests) would normally be copied into the local cache before processing continues
-- this flag prevents these additions to the internal cache as well.")
-(defconstant +SSL-SESS-CACHE-NO-INTERNAL+ (logior +SSL-SESS-CACHE-NO-INTERNAL-LOOKUP+ +SSL-SESS-CACHE-NO-INTERNAL-STORE+)
- "Enable both +SSL-SESS-CACHE-NO-INTERNAL-LOOKUP+ and +SSL-SESS-CACHE-NO-INTERNAL-STORE+ at the same time.")
-
-(defconstant +SSL-VERIFY-NONE+ #x00)
-(defconstant +SSL-VERIFY-PEER+ #x01)
-(defconstant +SSL-VERIFY-FAIL-IF-NO-PEER-CERT+ #x02)
-(defconstant +SSL-VERIFY-CLIENT-ONCE+ #x04)
-
-(defconstant +SSL-OP-ALL+ #x80000BFF)
-
-(defconstant +SSL-OP-NO-SSLv2+ #x01000000)
-(defconstant +SSL-OP-NO-SSLv3+ #x02000000)
-(defconstant +SSL-OP-NO-TLSv1+ #x04000000)
-(defconstant +SSL-OP-NO-TLSv1-2+ #x08000000)
-(defconstant +SSL-OP-NO-TLSv1-1+ #x10000000)
-
-(defvar *tmp-rsa-key-512* nil)
-(defvar *tmp-rsa-key-1024* nil)
-(defvar *tmp-rsa-key-2048* nil)
-
-;;; Misc
-;;;
-(defmacro while (cond &body body)
- `(do () ((not ,cond)) ,@body))
-
-
-;;; Function definitions
-;;;
-
-(cffi:defcfun (#-windows "close" #+windows "closesocket" close-socket)
- :int
- (socket :int))
-
-(declaim (inline ssl-write ssl-read ssl-connect ssl-accept))
-
-(cffi:defctype ssl-method :pointer)
-(cffi:defctype ssl-ctx :pointer)
-(cffi:defctype ssl-pointer :pointer)
-
-(define-ssl-function ("SSL_get_version" ssl-get-version)
- :string
- (ssl ssl-pointer))
-(define-ssl-function ("SSL_load_error_strings" ssl-load-error-strings)
- :void)
-(define-ssl-function ("SSL_library_init" ssl-library-init)
- :int)
-;;
-;; We don't refer SSLv2_client_method as the default
-;; builds of OpenSSL do not have it, due to insecurity
-;; of the SSL v2 protocol (see https://www.openssl.org/docs/ssl/SSL_CTX_new.html
-;; and https://github.com/cl-plus-ssl/cl-plus-ssl/issues/6)
-;;
-;; (define-ssl-function ("SSLv2_client_method" ssl-v2-client-method)
-;; ssl-method)
-(define-ssl-function ("SSLv23_client_method" ssl-v23-client-method)
- ssl-method)
-(define-ssl-function ("SSLv23_server_method" ssl-v23-server-method)
- ssl-method)
-(define-ssl-function ("SSLv23_method" ssl-v23-method)
- ssl-method)
-(define-ssl-function ("SSLv3_client_method" ssl-v3-client-method)
- ssl-method)
-(define-ssl-function ("SSLv3_server_method" ssl-v3-server-method)
- ssl-method)
-(define-ssl-function ("SSLv3_method" ssl-v3-method)
- ssl-method)
-(define-ssl-function ("TLSv1_client_method" ssl-TLSv1-client-method)
- ssl-method)
-(define-ssl-function ("TLSv1_server_method" ssl-TLSv1-server-method)
- ssl-method)
-(define-ssl-function ("TLSv1_method" ssl-TLSv1-method)
- ssl-method)
-(define-ssl-function ("TLSv1_1_client_method" ssl-TLSv1-1-client-method)
- ssl-method)
-(define-ssl-function ("TLSv1_1_server_method" ssl-TLSv1-1-server-method)
- ssl-method)
-(define-ssl-function ("TLSv1_1_method" ssl-TLSv1-1-method)
- ssl-method)
-(define-ssl-function ("TLSv1_2_client_method" ssl-TLSv1-2-client-method)
- ssl-method)
-(define-ssl-function ("TLSv1_2_server_method" ssl-TLSv1-2-server-method)
- ssl-method)
-(define-ssl-function ("TLSv1_2_method" ssl-TLSv1-2-method)
- ssl-method)
-
-(define-ssl-function ("SSL_CTX_new" ssl-ctx-new)
- ssl-ctx
- (method ssl-method))
-(define-ssl-function ("SSL_new" ssl-new)
- ssl-pointer
- (ctx ssl-ctx))
-(define-ssl-function ("SSL_get_fd" ssl-get-fd)
- :int
- (ssl ssl-pointer))
-(define-ssl-function ("SSL_set_fd" ssl-set-fd)
- :int
- (ssl ssl-pointer)
- (fd :int))
-(define-ssl-function ("SSL_set_bio" ssl-set-bio)
- :void
- (ssl ssl-pointer)
- (rbio :pointer)
- (wbio :pointer))
-(define-ssl-function ("SSL_get_error" ssl-get-error)
- :int
- (ssl ssl-pointer)
- (ret :int))
-(define-ssl-function ("SSL_set_connect_state" ssl-set-connect-state)
- :void
- (ssl ssl-pointer))
-(define-ssl-function ("SSL_set_accept_state" ssl-set-accept-state)
- :void
- (ssl ssl-pointer))
-(define-ssl-function ("SSL_connect" ssl-connect)
- :int
- (ssl ssl-pointer))
-(define-ssl-function ("SSL_accept" ssl-accept)
- :int
- (ssl ssl-pointer))
-(define-ssl-function ("SSL_write" ssl-write)
- :int
- (ssl ssl-pointer)
- (buf :pointer)
- (num :int))
-(define-ssl-function ("SSL_read" ssl-read)
- :int
- (ssl ssl-pointer)
- (buf :pointer)
- (num :int))
-(define-ssl-function ("SSL_shutdown" ssl-shutdown)
- :void
- (ssl ssl-pointer))
-(define-ssl-function ("SSL_free" ssl-free)
- :void
- (ssl ssl-pointer))
-(define-ssl-function ("SSL_CTX_free" ssl-ctx-free)
- :void
- (ctx ssl-ctx))
-(define-crypto-function ("BIO_ctrl" bio-set-fd)
- :long
- (bio :pointer)
- (cmd :int)
- (larg :long)
- (parg :pointer))
-(define-crypto-function ("BIO_new_socket" bio-new-socket)
- :pointer
- (fd :int)
- (close-flag :int))
-(define-crypto-function ("BIO_new" bio-new)
- :pointer
- (method :pointer))
-
-(define-crypto-function ("ERR_get_error" err-get-error)
- :unsigned-long)
-(define-crypto-function ("ERR_error_string" err-error-string)
- :string
- (e :unsigned-long)
- (buf :pointer))
-
-(define-ssl-function ("SSL_set_cipher_list" ssl-set-cipher-list)
- :int
- (ssl ssl-pointer)
- (str :string))
-(define-ssl-function ("SSL_use_RSAPrivateKey_file" ssl-use-rsa-privatekey-file)
- :int
- (ssl ssl-pointer)
- (str :string)
- ;; either +ssl-filetype-pem+ or +ssl-filetype-asn1+
- (type :int))
-(define-ssl-function
- ("SSL_CTX_use_RSAPrivateKey_file" ssl-ctx-use-rsa-privatekey-file)
- :int
- (ctx ssl-ctx)
- (type :int))
-(define-ssl-function ("SSL_use_certificate_file" ssl-use-certificate-file)
- :int
- (ssl ssl-pointer)
- (str :string)
- (type :int))
-#+new-openssl
-(define-ssl-function ("SSL_CTX_set_options" ssl-ctx-set-options)
- :long
- (ctx :pointer)
- (options :long))
-#-new-openssl
-(defun ssl-ctx-set-options (ctx options)
- (ssl-ctx-ctrl ctx +SSL-CTRL-OPTIONS+ options (cffi:null-pointer)))
-(define-ssl-function ("SSL_CTX_set_cipher_list" ssl-ctx-set-cipher-list%)
- :int
- (ctx :pointer)
- (ciphers :pointer))
-(defun ssl-ctx-set-cipher-list (ctx ciphers)
- (cffi:with-foreign-string (ciphers* ciphers)
- (when (= 0 (ssl-ctx-set-cipher-list% ctx ciphers*))
- (error 'ssl-error-initialize :reason "Can't set SSL cipher list" :queue (read-ssl-error-queue)))))
-(define-ssl-function ("SSL_CTX_use_certificate_chain_file" ssl-ctx-use-certificate-chain-file)
- :int
- (ctx ssl-ctx)
- (str :string))
-(define-ssl-function ("SSL_CTX_load_verify_locations" ssl-ctx-load-verify-locations)
- :int
- (ctx ssl-ctx)
- (CAfile :string)
- (CApath :string))
-(define-ssl-function ("SSL_CTX_set_client_CA_list" ssl-ctx-set-client-ca-list)
- :void
- (ctx ssl-ctx)
- (list ssl-pointer))
-(define-ssl-function ("SSL_load_client_CA_file" ssl-load-client-ca-file)
- ssl-pointer
- (file :string))
-
-(define-ssl-function ("SSL_CTX_ctrl" ssl-ctx-ctrl)
- :long
- (ctx ssl-ctx)
- (cmd :int)
- ;; Despite declared as long in the original OpenSSL headers,
- ;; passing to larg for example 2181041151 which is the result of
- ;; (logior cl+ssl::+SSL-OP-ALL+
- ;; cl+ssl::+SSL-OP-NO-SSLv2+
- ;; cl+ssl::+SSL-OP-NO-SSLv3+)
- ;; causes CFFI on 32 bit platforms to signal an error
- ;; "The value 2181041151 is not of the expected type (SIGNED-BYTE 32)"
- ;; The problem is that 2181041151 requires 32 bits by itself and
- ;; there is no place left for the sign bit.
- ;; In C the compiler silently coerces unsigned to signed,
- ;; but CFFI raises this error.
- ;; Therefore we use :UNSIGNED-LONG for LARG.
- (larg :unsigned-long)
- (parg :pointer))
-
-(define-ssl-function ("SSL_ctrl" ssl-ctrl)
- :long
- (ssl :pointer)
- (cmd :int)
- (larg :long)
- (parg :pointer))
-
-(define-ssl-function ("SSL_CTX_set_default_passwd_cb" ssl-ctx-set-default-passwd-cb)
- :void
- (ctx ssl-ctx)
- (pem_passwd_cb :pointer))
-
-(define-crypto-function ("CRYPTO_num_locks" crypto-num-locks) :int)
-(define-crypto-function ("CRYPTO_set_locking_callback" crypto-set-locking-callback)
- :void
- (fun :pointer))
-(define-crypto-function ("CRYPTO_set_id_callback" crypto-set-id-callback)
- :void
- (fun :pointer))
-
-(define-crypto-function ("RAND_seed" rand-seed)
- :void
- (buf :pointer)
- (num :int))
-(define-crypto-function ("RAND_bytes" rand-bytes)
- :int
- (buf :pointer)
- (num :int))
-
-(define-ssl-function ("SSL_CTX_set_verify_depth" ssl-ctx-set-verify-depth)
- :void
- (ctx :pointer)
- (depth :int))
-
-(define-ssl-function ("SSL_CTX_set_verify" ssl-ctx-set-verify)
- :void
- (ctx :pointer)
- (mode :int)
- (verify-callback :pointer))
-
-(define-ssl-function ("SSL_get_verify_result" ssl-get-verify-result)
- :long
- (ssl ssl-pointer))
-
-(define-ssl-function ("SSL_get_peer_certificate" ssl-get-peer-certificate)
- :pointer
- (ssl ssl-pointer))
-
-;;; X509 & ASN1
-(define-crypto-function ("X509_free" x509-free)
- :void
- (x509 :pointer))
-
-(define-crypto-function ("X509_NAME_oneline" x509-name-oneline)
- :pointer
- (x509-name :pointer)
- (buf :pointer)
- (size :int))
-
-(define-crypto-function ("X509_NAME_get_index_by_NID" x509-name-get-index-by-nid)
- :int
- (name :pointer)
- (nid :int)
- (lastpos :int))
-
-(define-crypto-function ("X509_NAME_get_entry" x509-name-get-entry)
- :pointer
- (name :pointer)
- (log :int))
-
-(define-crypto-function ("X509_NAME_ENTRY_get_data" x509-name-entry-get-data)
- :pointer
- (name-entry :pointer))
-
-(define-crypto-function ("X509_get_issuer_name" x509-get-issuer-name)
- :pointer ; *X509_NAME
- (x509 :pointer))
-
-(define-crypto-function ("X509_get_subject_name" x509-get-subject-name)
- :pointer ; *X509_NAME
- (x509 :pointer))
-
-(define-crypto-function ("X509_get_ext_d2i" x509-get-ext-d2i)
- :pointer
- (cert :pointer)
- (nid :int)
- (crit :pointer)
- (idx :pointer))
-
-(define-crypto-function ("X509_STORE_CTX_get_error" x509-store-ctx-get-error)
- :int
- (ctx :pointer))
-
-(define-crypto-function ("d2i_X509" d2i-x509)
- :pointer
- (*px :pointer)
- (in :pointer)
- (len :int))
-
-;; GENERAL-NAME types
-(defconstant +GEN-OTHERNAME+ 0)
-(defconstant +GEN-EMAIL+ 1)
-(defconstant +GEN-DNS+ 2)
-(defconstant +GEN-X400+ 3)
-(defconstant +GEN-DIRNAME+ 4)
-(defconstant +GEN-EDIPARTY+ 5)
-(defconstant +GEN-URI+ 6)
-(defconstant +GEN-IPADD+ 7)
-(defconstant +GEN-RID+ 8)
-
-(defconstant +V-ASN1-OCTET-STRING+ 4)
-(defconstant +V-ASN1-UTF8STRING+ 12)
-(defconstant +V-ASN1-PRINTABLESTRING+ 19)
-(defconstant +V-ASN1-TELETEXSTRING+ 20)
-(defconstant +V-ASN1-IASTRING+ 22)
-(defconstant +V-ASN1-UNIVERSALSTRING+ 28)
-(defconstant +V-ASN1-BMPSTRING+ 30)
-
-
-(defconstant +NID-subject-alt-name+ 85)
-(defconstant +NID-commonName+ 13)
-
-(cffi:defcstruct general-name
- (type :int)
- (data :pointer))
-
-(define-crypto-function ("sk_value" sk-value)
- :pointer
- (stack :pointer)
- (index :int))
-
-(define-crypto-function ("sk_num" sk-num)
- :int
- (stack :pointer))
-
-(declaim (ftype (function (cffi:foreign-pointer fixnum) cffi:foreign-pointer) sk-general-name-value))
-(defun sk-general-name-value (names index)
- (sk-value names index))
-
-(declaim (ftype (function (cffi:foreign-pointer) fixnum) sk-general-name-num))
-(defun sk-general-name-num (names)
- (sk-num names))
-
-(define-crypto-function ("GENERAL_NAMES_free" general-names-free)
- :void
- (general-names :pointer))
-
-(define-crypto-function ("ASN1_STRING_data" asn1-string-data)
- :pointer
- (asn1-string :pointer))
-
-(define-crypto-function ("ASN1_STRING_length" asn1-string-length)
- :int
- (asn1-string :pointer))
-
-(define-crypto-function ("ASN1_STRING_type" asn1-string-type)
- :int
- (asn1-string :pointer))
-
-(cffi:defcstruct asn1_string_st
- (length :int)
- (type :int)
- (data :pointer)
- (flags :long))
-
-;; X509 & ASN1 - end
-
-(define-ssl-function ("SSL_CTX_set_default_verify_paths" ssl-ctx-set-default-verify-paths)
- :int
- (ctx :pointer))
-
-(define-crypto-function ("RSA_generate_key" rsa-generate-key)
- :pointer
- (num :int)
- (e :unsigned-long)
- (callback :pointer)
- (opt :pointer))
-
-(define-crypto-function ("RSA_free" rsa-free)
- :void
- (rsa :pointer))
-
-(define-ssl-function ("SSL_CTX_set_tmp_rsa_callback" ssl-ctx-set-tmp-rsa-callback)
- :pointer
- (ctx :pointer)
- (callback :pointer))
-
-(cffi:defcallback tmp-rsa-callback :pointer ((ssl :pointer) (export-p :int) (key-length :int))
- (declare (ignore ssl export-p))
- (flet ((rsa-key (length)
- (rsa-generate-key length
- +RSA_F4+
- (cffi:null-pointer)
- (cffi:null-pointer))))
- (cond ((= key-length 512)
- (unless *tmp-rsa-key-512*
- (setf *tmp-rsa-key-512* (rsa-key key-length)))
- *tmp-rsa-key-512*)
- ((= key-length 1024)
- (unless *tmp-rsa-key-1024*
- (setf *tmp-rsa-key-1024* (rsa-key key-length)))
- *tmp-rsa-key-1024*)
- (t
- (unless *tmp-rsa-key-2048*
- (setf *tmp-rsa-key-2048* (rsa-key key-length)))
- *tmp-rsa-key-2048*))))
-
-;;; Funcall wrapper
-;;;
-(defvar *socket*)
-
-(declaim (inline ensure-ssl-funcall))
-(defun ensure-ssl-funcall (stream handle func &rest args)
- (loop
- (let ((nbytes
- (let ((*socket* (ssl-stream-socket stream))) ;for Lisp-BIO callbacks
- (apply func args))))
- (when (plusp nbytes)
- (return nbytes))
- (let ((error (ssl-get-error handle nbytes)))
- (case error
- (#.+ssl-error-want-read+
- (input-wait stream
- (ssl-get-fd handle)
- (ssl-stream-deadline stream)))
- (#.+ssl-error-want-write+
- (output-wait stream
- (ssl-get-fd handle)
- (ssl-stream-deadline stream)))
- (t
- (ssl-signal-error handle func error nbytes)))))))
-
-(declaim (inline nonblocking-ssl-funcall))
-(defun nonblocking-ssl-funcall (stream handle func &rest args)
- (loop
- (let ((nbytes
- (let ((*socket* (ssl-stream-socket stream))) ;for Lisp-BIO callbacks
- (apply func args))))
- (when (plusp nbytes)
- (return nbytes))
- (let ((error (ssl-get-error handle nbytes)))
- (case error
- ((#.+ssl-error-want-read+ #.+ssl-error-want-write+)
- (return nbytes))
- (t
- (ssl-signal-error handle func error nbytes)))))))
-
-
-;;; Waiting for output to be possible
-
-#+clozure-common-lisp
-(defun milliseconds-until-deadline (deadline stream)
- (let* ((now (get-internal-real-time)))
- (if (> now deadline)
- (error 'ccl::communication-deadline-expired :stream stream)
- (values
- (round (- deadline now) (/ internal-time-units-per-second 1000))))))
-
-#+clozure-common-lisp
-(defun output-wait (stream fd deadline)
- (unless deadline
- (setf deadline (stream-deadline (ssl-stream-socket stream))))
- (let* ((timeout
- (if deadline
- (milliseconds-until-deadline deadline stream)
- nil)))
- (multiple-value-bind (win timedout error)
- (ccl::process-output-wait fd timeout)
- (unless win
- (if timedout
- (error 'ccl::communication-deadline-expired :stream stream)
- (ccl::stream-io-error stream (- error) "write"))))))
-
-#+sbcl
-(defun output-wait (stream fd deadline)
- (declare (ignore stream))
- (let ((timeout
- ;; *deadline* is handled by wait-until-fd-usable automatically,
- ;; but we need to turn a user-specified deadline into a timeout
- (when deadline
- (/ (- deadline (get-internal-real-time))
- internal-time-units-per-second))))
- (sb-sys:wait-until-fd-usable fd :output timeout)))
-
-#-(or clozure-common-lisp sbcl)
-(defun output-wait (stream fd deadline)
- (declare (ignore stream fd deadline))
- ;; This situation means that the lisp set our fd to non-blocking mode,
- ;; and streams.lisp didn't know how to undo that.
- (warn "non-blocking stream encountered unexpectedly"))
-
-
-;;; Waiting for input to be possible
-
-#+clozure-common-lisp
-(defun input-wait (stream fd deadline)
- (unless deadline
- (setf deadline (stream-deadline (ssl-stream-socket stream))))
- (let* ((timeout
- (if deadline
- (milliseconds-until-deadline deadline stream)
- nil)))
- (multiple-value-bind (win timedout error)
- (ccl::process-input-wait fd timeout)
- (unless win
- (if timedout
- (error 'ccl::communication-deadline-expired :stream stream)
- (ccl::stream-io-error stream (- error) "read"))))))
-
-#+sbcl
-(defun input-wait (stream fd deadline)
- (declare (ignore stream))
- (let ((timeout
- ;; *deadline* is handled by wait-until-fd-usable automatically,
- ;; but we need to turn a user-specified deadline into a timeout
- (when deadline
- (/ (- deadline (get-internal-real-time))
- internal-time-units-per-second))))
- (sb-sys:wait-until-fd-usable fd :input timeout)))
-
-#-(or clozure-common-lisp sbcl)
-(defun input-wait (stream fd deadline)
- (declare (ignore stream fd deadline))
- ;; This situation means that the lisp set our fd to non-blocking mode,
- ;; and streams.lisp didn't know how to undo that.
- (warn "non-blocking stream encountered unexpectedly"))
-
-
-;;; Encrypted PEM files support
-;;;
-
-;; based on http://www.openssl.org/docs/ssl/SSL_CTX_set_default_passwd_cb.html
-
-(defvar *pem-password* ""
- "The callback registered with SSL_CTX_set_default_passwd_cb
-will use this value.")
-
-;; The callback itself
-(cffi:defcallback pem-password-callback :int
- ((buf :pointer) (size :int) (rwflag :int) (unused :pointer))
- (declare (ignore rwflag unused))
- (let* ((password-str (coerce *pem-password* 'base-string))
- (tmp (cffi:foreign-string-alloc password-str)))
- (cffi:foreign-funcall "strncpy"
- :pointer buf
- :pointer tmp
- :int size)
- (cffi:foreign-string-free tmp)
- (setf (cffi:mem-ref buf :char (1- size)) 0)
- (cffi:foreign-funcall "strlen" :pointer buf :int)))
-
-;; The macro to be used by other code to provide password
-;; when loading PEM file.
-(defmacro with-pem-password ((password) &body body)
- `(let ((*pem-password* (or ,password "")))
- ,@body))
-
-
-;;; Initialization
-;;;
-
-(defun init-prng (seed-byte-sequence)
- (let* ((length (length seed-byte-sequence))
- (buf (cffi-sys::make-shareable-byte-vector length)))
- (dotimes (i length)
- (setf (elt buf i) (elt seed-byte-sequence i)))
- (cffi-sys::with-pointer-to-vector-data (ptr buf)
- (rand-seed ptr length))))
-
-(defun ssl-ctx-set-session-cache-mode (ctx mode)
- (ssl-ctx-ctrl ctx +SSL_CTRL_SET_SESS_CACHE_MODE+ mode (cffi:null-pointer)))
-
-(defun SSL-set-tlsext-host-name (ctx hostname)
- (ssl-ctrl ctx 55 #|SSL_CTRL_SET_TLSEXT_HOSTNAME|# 0 #|TLSEXT_NAMETYPE_host_name|# hostname))
-
-(defvar *locks*)
-(defconstant +CRYPTO-LOCK+ 1)
-(defconstant +CRYPTO-UNLOCK+ 2)
-(defconstant +CRYPTO-READ+ 4)
-(defconstant +CRYPTO-WRITE+ 8)
-
-;; zzz as of early 2011, bxthreads is totally broken on SBCL wrt. explicit
-;; locking of recursive locks. with-recursive-lock works, but acquire/release
-;; don't. Hence we use non-recursize locks here (but can use a recursive
-;; lock for the global lock).
-
-(cffi:defcallback locking-callback :void
- ((mode :int)
- (n :int)
- (file :pointer) ;; could be (file :string), but we don't use FILE, so avoid the conversion
- (line :int))
- (declare (ignore file line))
- ;; (assert (logtest mode (logior +CRYPTO-READ+ +CRYPTO-WRITE+)))
- (let ((lock (elt *locks* n)))
- (cond
- ((logtest mode +CRYPTO-LOCK+)
- (bt:acquire-lock lock))
- ((logtest mode +CRYPTO-UNLOCK+)
- (bt:release-lock lock))
- (t
- (error "fell through")))))
-
-(defvar *threads* (trivial-garbage:make-weak-hash-table :weakness :key))
-(defvar *thread-counter* 0)
-
-(defparameter *global-lock*
- (bordeaux-threads:make-recursive-lock "SSL initialization"))
-
-;; zzz BUG: On a 32-bit system and under non-trivial load, this counter
-;; is likely to wrap in less than a year.
-(cffi:defcallback threadid-callback :unsigned-long ()
- (bordeaux-threads:with-recursive-lock-held (*global-lock*)
- (let ((self (bt:current-thread)))
- (or (gethash self *threads*)
- (setf (gethash self *threads*)
- (incf *thread-counter*))))))
-
-(defvar *ssl-check-verify-p* :unspecified
- "DEPRECATED.
-Use the (MAKE-SSL-CLIENT-STREAM .. :VERIFY ?) to enable/disable verification.
-MAKE-CONTEXT also allows to enab/disable verification.")
-
-(defun initialize (&key (method 'ssl-v23-method) rand-seed)
- (setf *locks* (loop
- repeat (crypto-num-locks)
- collect (bt:make-lock)))
- (crypto-set-locking-callback (cffi:callback locking-callback))
- (crypto-set-id-callback (cffi:callback threadid-callback))
- (setf *bio-lisp-method* (make-bio-lisp-method))
- (ssl-load-error-strings)
- (ssl-library-init)
- (when rand-seed
- (init-prng rand-seed))
- (setf *ssl-check-verify-p* :unspecified)
- (setf *ssl-global-method* (funcall method))
- (setf *ssl-global-context* (ssl-ctx-new *ssl-global-method*))
- (unless (eql 1 (ssl-ctx-set-default-verify-paths *ssl-global-context*))
- (error "ssl-ctx-set-default-verify-paths failed."))
- (ssl-ctx-set-session-cache-mode *ssl-global-context* 3)
- (ssl-ctx-set-default-passwd-cb *ssl-global-context*
- (cffi:callback pem-password-callback))
- (ssl-ctx-set-tmp-rsa-callback *ssl-global-context*
- (cffi:callback tmp-rsa-callback)))
-
-(defun ensure-initialized (&key (method 'ssl-v23-method) (rand-seed nil))
- "In most cases you do *not* need to call this function, because it
-is called automatically by all other functions. The only reason to
-call it explicitly is to supply the RAND-SEED parameter. In this case
-do it before calling any other functions.
-
-Just leave the default value for the METHOD parameter.
-
-RAND-SEED is an octet sequence to initialize OpenSSL random number generator.
-On many platforms, including Linux and Windows, it may be leaved NIL (default),
-because OpenSSL initializes the random number generator from OS specific service.
-But for example on Solaris it may be necessary to supply this value.
-The minimum length required by OpenSSL is 128 bits.
-See ttp://www.openssl.org/support/faq.html#USER1 for details.
-
-Hint: do not use Common Lisp RANDOM function to generate the RAND-SEED,
-because the function usually returns predictable values."
- #+lispworks
- (check-cl+ssl-symbols)
- (bordeaux-threads:with-recursive-lock-held (*global-lock*)
- (unless (ssl-initialized-p)
- (initialize :method method :rand-seed rand-seed))
- (unless *bio-lisp-method*
- (setf *bio-lisp-method* (make-bio-lisp-method)))))
-
-(defun use-certificate-chain-file (certificate-chain-file)
- "Loads a PEM encoded certificate chain file CERTIFICATE-CHAIN-FILE
-and adds the chain to global context. The certificates must be sorted
-starting with the subject's certificate (actual client or server certificate),
-followed by intermediate CA certificates if applicable, and ending at
-the highest level (root) CA. Note: the RELOAD function clears the global
-context and in particular the loaded certificate chain."
- (ensure-initialized)
- (ssl-ctx-use-certificate-chain-file *ssl-global-context* certificate-chain-file))
-
-(defun reload ()
- (if *ssl-global-context*
- (ssl-ctx-free *ssl-global-context*))
- (unless (member :cl+ssl-foreign-libs-already-loaded
- *features*)
- (cffi:use-foreign-library libcrypto)
- (cffi:load-foreign-library 'libssl)
- (cffi:load-foreign-library 'libeay32))
- (setf *ssl-global-context* nil)
- (setf *ssl-global-method* nil)
- (setf *tmp-rsa-key-512* nil)
- (setf *tmp-rsa-key-1024* nil))
(DIR) diff --git a/3rdparties/software/cl+ssl-20190202-git/src/package.lisp b/3rdparties/software/cl+ssl-20190202-git/src/package.lisp
@@ -1,66 +0,0 @@
-;;;; -*- Mode: LISP; Syntax: COMMON-LISP; indent-tabs-mode: nil; coding: utf-8; show-trailing-whitespace: t -*-
-;;;
-;;; Copyright (C) 2001, 2003 Eric Marsden
-;;; Copyright (C) 2005 David Lichteblau
-;;; "the conditions and ENSURE-SSL-FUNCALL are by Jochen Schmidt."
-;;;
-;;; See LICENSE for details.
-
-#+xcvb (module (:depends-on ((:when (:featurep :sbcl) (:require :sb-posix)))))
-
-(in-package :cl-user)
-
-(defpackage :cl+ssl
- (:use :common-lisp :trivial-gray-streams)
- (:export #:*default-cipher-list*
- #:ensure-initialized
- #:reload
- #:stream-fd
- #:make-ssl-client-stream
- #:*make-ssl-client-stream-verify-default*
- #:make-ssl-server-stream
- #:use-certificate-chain-file
- #:random-bytes
- ;; DEPRECATED.
- ;; Use the (MAKE-SSL-CLIENT-STREAM .. :VERIFY ?) to enable/disable verification.
- ;; MAKE-CONTEXT also allows to enab/disable verification.
- #:ssl-check-verify-p
- #:ssl-load-global-verify-locations
- #:ssl-set-global-default-verify-paths
- #:ssl-error-verify
- #:ssl-error-stream
- #:ssl-error-code
- #:ssl-error-initialize
- #:ssl-ctx-free
-
- #:with-pem-password
-
- #:+ssl-verify-none+
- #:+ssl-verify-peer+
- #:+ssl-verify-fail-if-no-peer-cert+
- #:+ssl-verify-client-once+
-
- #:+ssl-op-no-sslv2+
- #:+ssl-op-no-sslv3+
- #:+ssl-op-no-tlsv1+
- #:+ssl-op-no-tlsv1-1+
- #:+ssl-op-no-tlsv1-2+
-
- #:+ssl-sess-cache-off+
- #:+ssl-sess-cache-client+
- #:+ssl-sess-cache-server+
- #:+ssl-sess-cache-both+
- #:+ssl-sess-cache-no-auto-clear+
- #:+ssl-sess-cache-no-internal-lookup+
- #:+ssl-sess-cache-no-internal-store+
- #:+ssl-sess-cache-no-internal+
-
- #:make-context
- #:with-global-context
-
- ;; x509 stuff
- #:decode-certificate-from-file
- #:decode-certificate
-
- ;; hostname-verification
- #:verify-hostname))
(DIR) diff --git a/3rdparties/software/cl+ssl-20190202-git/src/random.lisp b/3rdparties/software/cl+ssl-20190202-git/src/random.lisp
@@ -1,33 +0,0 @@
-;;;; -*- Mode: LISP; Syntax: COMMON-LISP; indent-tabs-mode: nil; coding: utf-8; show-trailing-whitespace: t -*-
-
-#+xcvb
-(module
- (:depends-on ("package" "conditions" "ffi"
- (:cond ((:featurep :clisp) "ffi-buffer-clisp")
- (t "ffi-buffer"))
- "ffi-buffer-all")))
-
-(in-package :cl+ssl)
-
-(defun random-bytes (count)
- "Generates COUNT cryptographically strong pseudo-random bytes. Returns
-the bytes as a SIMPLE-ARRAY with ELEMENT-TYPE '(UNSIGNED-BYTE 8). Signals
-an ERROR in case of problems, for example when the OpenSSL random number
-generator has not been seeded with enough randomness to ensure an
-unpredictable byte sequence."
- (let* ((result (make-array count :element-type '(unsigned-byte 8)))
- (buf (make-buffer count))
- (ret (with-pointer-to-vector-data (ptr buf)
- (rand-bytes ptr count))))
- (when (/= 1 ret)
- (error "RANDOM-BYTES failed: error reported by the OpenSSL RAND_bytes function. ~A."
- (format-ssl-error-queue nil (read-ssl-error-queue))))
- (s/b-replace result buf)))
-
-;; TODO: Should we define random-specific constants and condition classes for
-;; RAND_F_RAND_GET_RAND_METHOD, RAND_F_SSLEAY_RAND_BYTES, RAND_R_PRNG_NOT_SEEDED
-;; (defined in the rand.h file of the OpenSSl sources)?
-;; Where to place these constants/condtitions, here or in the conditions.lisp?
-;; On the other hand, those constants are just numbers defined for C,
-;; for now we jsut report human readable strings, without possibility
-;; to distinguish these error causes programmatically.
(DIR) diff --git a/3rdparties/software/cl+ssl-20190202-git/src/reload.lisp b/3rdparties/software/cl+ssl-20190202-git/src/reload.lisp
@@ -1,77 +0,0 @@
-;;;; -*- Mode: LISP; Syntax: COMMON-LISP; indent-tabs-mode: nil; coding: utf-8; show-trailing-whitespace: t -*-
-;;;
-;;; Copyright (C) 2001, 2003 Eric Marsden
-;;; Copyright (C) 2005 David Lichteblau
-;;; "the conditions and ENSURE-SSL-FUNCALL are by Jochen Schmidt."
-;;;
-;;; See LICENSE for details.
-
-;;; We do this in an extra file so that it happens
-;;; - after the asd file has been loaded, so that users can
-;;; customize *libssl-pathname* between loading the asd and LOAD-OPing
-;;; the actual sources
-;;; - before ssl.lisp is loaded, which needs the library at compilation
-;;; time on some implemenations
-;;; - but not every time ffi.lisp is re-loaded as would happen if we
-;;; put this directly into ffi.lisp
-
-#+xcvb (module (:depends-on ("package")))
-
-(in-package :cl+ssl)
-
-(cffi:define-foreign-library libcrypto
- (:openbsd "libcrypto.so")
- (:darwin (:or "/opt/local/lib/libcrypto.dylib" ;; MacPorts
- "/sw/lib/libcrypto.dylib" ;; Fink
- "/usr/local/opt/openssl/lib/libcrypto.dylib" ;; Homebrew
- "/usr/local/lib/libcrypto.dylib" ;; personalized install
- "libcrypto.dylib" ;; default system libcrypto, which may have insufficient crypto
- "/usr/lib/libcrypto.dylib")))
-
-(cffi:define-foreign-library libssl
- (:windows (:or "libssl32.dll" "ssleay32.dll"))
- ;; The default OS-X libssl seems have had insufficient crypto algos
- ;; (missing TLSv1_[1,2]_XXX methods,
- ;; see https://github.com/cl-plus-ssl/cl-plus-ssl/issues/56)
- ;; so first try to load possible custom installations of libssl
- (:darwin (:or "/opt/local/lib/libssl.dylib" ;; MacPorts
- "/sw/lib/libssl.dylib" ;; Fink
- "/usr/local/opt/openssl/lib/libssl.dylib" ;; Homebrew
- "/usr/local/lib/libssl.dylib" ;; personalized install
- "libssl.dylib" ;; default system libssl, which may have insufficient crypto
- "/usr/lib/libssl.dylib"))
- (:solaris (:or "/lib/64/libssl.so"
- "libssl.so.0.9.8" "libssl.so" "libssl.so.4"))
- ;; Unlike some other systems, OpenBSD linker,
- ;; when passed library name without versions at the end,
- ;; will locate the library with highest macro.minor version,
- ;; so we can just use just "libssl.so".
- ;; More info at https://github.com/cl-plus-ssl/cl-plus-ssl/pull/2.
- (:openbsd "libssl.so")
- ((and :unix (not :cygwin)) (:or "libssl.so.1.0.2m"
- "libssl.so.1.0.2k"
- "libssl.so.1.0.2"
- "libssl.so.1.0.1l"
- "libssl.so.1.0.1j"
- "libssl.so.1.0.1f"
- "libssl.so.1.0.1e"
- "libssl.so.1.0.1"
- "libssl.so.1.0.0q"
- "libssl.so.1.0.0"
- "libssl.so.0.9.8ze"
- "libssl.so.0.9.8"
- "libssl.so.10"
- "libssl.so.4"
- "libssl.so"))
- (:cygwin "cygssl-1.0.0.dll")
- (t (:default "libssl3")))
-
-(cffi:define-foreign-library libeay32
- (:windows "libeay32.dll"))
-
-
-(unless (member :cl+ssl-foreign-libs-already-loaded
- *features*)
- (cffi:use-foreign-library libcrypto)
- (cffi:use-foreign-library libssl)
- (cffi:use-foreign-library libeay32))
(DIR) diff --git a/3rdparties/software/cl+ssl-20190202-git/src/streams.lisp b/3rdparties/software/cl+ssl-20190202-git/src/streams.lisp
@@ -1,480 +0,0 @@
-;;;; -*- Mode: LISP; Syntax: COMMON-LISP; indent-tabs-mode: nil; coding: utf-8; show-trailing-whitespace: t -*-
-;;;
-;;; Copyright (C) 2001, 2003 Eric Marsden
-;;; Copyright (C) 2005 David Lichteblau
-;;; Copyright (C) 2007 Pixel // pinterface
-;;; "the conditions and ENSURE-SSL-FUNCALL are by Jochen Schmidt."
-;;;
-;;; See LICENSE for details.
-
-#+xcvb
-(module
- (:depends-on ("package" "conditions" "ffi"
- (:cond ((:featurep :clisp) "ffi-buffer-clisp")
- (t "ffi-buffer"))
- "ffi-buffer-all")))
-
-(eval-when (:compile-toplevel)
- (declaim
- (optimize (speed 3) (space 1) (safety 1) (debug 0) (compilation-speed 0))))
-
-(in-package :cl+ssl)
-
-;; Default Cipher List
-(defvar *default-cipher-list* "ALL")
-
-(defclass ssl-stream
- (trivial-gray-stream-mixin
- fundamental-binary-input-stream
- fundamental-binary-output-stream)
- ((ssl-stream-socket
- :initarg :socket
- :accessor ssl-stream-socket)
- (close-callback
- :initarg :close-callback
- :accessor ssl-close-callback)
- (handle
- :initform nil
- :accessor ssl-stream-handle)
- (deadline
- :initform nil
- :initarg :deadline
- :accessor ssl-stream-deadline)
- (output-buffer
- :initform (make-buffer +initial-buffer-size+)
- :accessor ssl-stream-output-buffer)
- (output-pointer
- :initform 0
- :accessor ssl-stream-output-pointer)
- (input-buffer
- :initform (make-buffer +initial-buffer-size+)
- :accessor ssl-stream-input-buffer)
- (peeked-byte
- :initform nil
- :accessor ssl-stream-peeked-byte)))
-
-(defmethod print-object ((object ssl-stream) stream)
- (print-unreadable-object (object stream :type t)
- (format stream "for ~A" (ssl-stream-socket object))))
-
-(defclass ssl-server-stream (ssl-stream)
- ((certificate
- :initarg :certificate
- :accessor ssl-stream-certificate)
- (key
- :initarg :key
- :accessor ssl-stream-key)))
-
-(defmethod stream-element-type ((stream ssl-stream))
- '(unsigned-byte 8))
-
-(defmethod close ((stream ssl-stream) &key abort)
- (cond
- ((ssl-stream-handle stream)
- (unless abort
- (force-output stream))
- (ssl-free (ssl-stream-handle stream))
- (setf (ssl-stream-handle stream) nil)
- (when (streamp (ssl-stream-socket stream))
- (close (ssl-stream-socket stream)))
- (when (ssl-close-callback stream)
- (funcall (ssl-close-callback stream)))
- t)
- (t
- nil)))
-
-(defmethod open-stream-p ((stream ssl-stream))
- (and (ssl-stream-handle stream) t))
-
-(defmethod stream-listen ((stream ssl-stream))
- (or (ssl-stream-peeked-byte stream)
- (setf (ssl-stream-peeked-byte stream)
- (let* ((buf (ssl-stream-input-buffer stream))
- (handle (ssl-stream-handle stream))
- (*blockp* nil) ;; for the Lisp-BIO
- (n (with-pointer-to-vector-data (ptr buf)
- (nonblocking-ssl-funcall
- stream handle #'ssl-read handle ptr 1))))
- (and (> n 0) (buffer-elt buf 0))))))
-
-(defmethod stream-read-byte ((stream ssl-stream))
- (or (prog1
- (ssl-stream-peeked-byte stream)
- (setf (ssl-stream-peeked-byte stream) nil))
- (handler-case
- (let ((buf (ssl-stream-input-buffer stream))
- (handle (ssl-stream-handle stream)))
- (with-pointer-to-vector-data (ptr buf)
- (ensure-ssl-funcall
- stream handle #'ssl-read handle ptr 1))
- (buffer-elt buf 0))
- (ssl-error-zero-return () ;SSL_read returns 0 on end-of-file
- :eof))))
-
-(defmethod stream-read-sequence ((stream ssl-stream) seq start end &key)
- (when (and (< start end) (ssl-stream-peeked-byte stream))
- (setf (elt seq start) (ssl-stream-peeked-byte stream))
- (setf (ssl-stream-peeked-byte stream) nil)
- (incf start))
- (let ((buf (ssl-stream-input-buffer stream))
- (handle (ssl-stream-handle stream)))
- (loop
- for length = (min (- end start) (buffer-length buf))
- while (plusp length)
- do
- (handler-case
- (let ((read-bytes
- (with-pointer-to-vector-data (ptr buf)
- (ensure-ssl-funcall
- stream handle #'ssl-read handle ptr length))))
- (s/b-replace seq buf :start1 start :end1 (+ start read-bytes))
- (incf start read-bytes))
- (ssl-error-zero-return () ;SSL_read returns 0 on end-of-file
- (return))))
- ;; fixme: kein out-of-file wenn (zerop start)?
- start))
-
-(defmethod stream-write-byte ((stream ssl-stream) b)
- (let ((buf (ssl-stream-output-buffer stream)))
- (when (eql (buffer-length buf) (ssl-stream-output-pointer stream))
- (force-output stream))
- (setf (buffer-elt buf (ssl-stream-output-pointer stream)) b)
- (incf (ssl-stream-output-pointer stream)))
- b)
-
-(defmethod stream-write-sequence ((stream ssl-stream) seq start end &key)
- (let ((buf (ssl-stream-output-buffer stream)))
- (when (> (+ (- end start) (ssl-stream-output-pointer stream)) (buffer-length buf))
- ;; not enough space left? flush buffer.
- (force-output stream)
- ;; still doesn't fit?
- (while (> (- end start) (buffer-length buf))
- (b/s-replace buf seq :start2 start)
- (incf start (buffer-length buf))
- (setf (ssl-stream-output-pointer stream) (buffer-length buf))
- (force-output stream)))
- (b/s-replace buf seq
- :start1 (ssl-stream-output-pointer stream)
- :start2 start
- :end2 end)
- (incf (ssl-stream-output-pointer stream) (- end start)))
- seq)
-
-(defmethod stream-finish-output ((stream ssl-stream))
- (stream-force-output stream))
-
-(defmethod stream-force-output ((stream ssl-stream))
- (let ((buf (ssl-stream-output-buffer stream))
- (fill-ptr (ssl-stream-output-pointer stream))
- (handle (ssl-stream-handle stream)))
- (when (plusp fill-ptr)
- (unless handle
- (error "output operation on closed SSL stream"))
- (with-pointer-to-vector-data (ptr buf)
- (ensure-ssl-funcall stream handle #'ssl-write handle ptr fill-ptr))
- (setf (ssl-stream-output-pointer stream) 0))))
-
-#+(and clozure-common-lisp (not windows))
-(defun install-nonblock-flag (fd)
- (ccl::fd-set-flags fd (logior (ccl::fd-get-flags fd)
- #.(read-from-string "#$O_NONBLOCK"))))
- ;; read-from-string is necessary because
- ;; CLISP and perhaps other Lisps are confused
- ;; by #$, signaling"undefined dispatch character $",
- ;; even though the defun in conditionalized by
- ;; #+clozure-common-lisp
-
-#+(and sbcl (not win32))
-(defun install-nonblock-flag (fd)
- (sb-posix:fcntl fd
- sb-posix::f-setfl
- (logior (sb-posix:fcntl fd sb-posix::f-getfl)
- sb-posix::o-nonblock)))
-
-#-(or (and clozure-common-lisp (not windows)) sbcl)
-(defun install-nonblock-flag (fd)
- (declare (ignore fd)))
-
-#+(and sbcl win32)
-(defun install-nonblock-flag (fd)
- (when (boundp 'sockint::fionbio)
- (sockint::ioctl fd sockint::fionbio 1)))
-
-;;; interface functions
-;;;
-
-(defun install-handle-and-bio (stream handle socket unwrap-stream-p)
- (setf (ssl-stream-handle stream) handle)
- (when unwrap-stream-p
- (let ((fd (stream-fd socket)))
- (when fd
- (setf socket fd))))
- (etypecase socket
- (integer
- (install-nonblock-flag socket)
- (ssl-set-fd handle socket))
- (stream
- (ssl-set-bio handle (bio-new-lisp) (bio-new-lisp))))
-
- ;; The below call setting +SSL_MODE_ACCEPT_MOVING_WRITE_BUFFER+ mode
- ;; existed since commit 5bd5225.
- ;; It is implemented wrong - ssl-ctx-ctrl expects
- ;; a context as the first parameter, not handle.
- ;; It was lucky to not crush on Linux and Windows,
- ;; untill crash was detedcted on OpenBSD + LibreSSL.
- ;; See https://github.com/cl-plus-ssl/cl-plus-ssl/pull/42.
- ;; We keep this code commented but not removed because
- ;; we don't know what David Lichteblau meant when
- ;; added this - maybe he has some idea?
- ;; (Although modifying global context is a bad
- ;; thing to do for install-handle-and-bio function,
- ;; also we don't see a need for movable buffer -
- ;; we don't repeat calls to ssl functions with
- ;; moved buffer).
- ;;
- ;; (ssl-ctx-ctrl handle
- ;; +SSL_CTRL_MODE+
- ;; +SSL_MODE_ACCEPT_MOVING_WRITE_BUFFER+
- ;; (cffi:null-pointer))
-
- socket)
-
-(defun install-key-and-cert (handle key certificate)
- (when key
- (unless (eql 1 (ssl-use-rsa-privatekey-file handle
- key
- +ssl-filetype-pem+))
- (error 'ssl-error-initialize :reason (format nil "Can't load RSA private key file ~A" key))))
- (when certificate
- (unless (eql 1 (ssl-use-certificate-file handle
- certificate
- +ssl-filetype-pem+))
- (error 'ssl-error-initialize
- :reason (format nil "Can't load certificate ~A" certificate)))))
-
-(defun x509-certificate-names (x509-certificate)
- (unless (cffi:null-pointer-p x509-certificate)
- (cffi:with-foreign-pointer (buf 1024)
- (let ((issuer-name (x509-get-issuer-name x509-certificate))
- (subject-name (x509-get-subject-name x509-certificate)))
- (values
- (unless (cffi:null-pointer-p issuer-name)
- (x509-name-oneline issuer-name buf 1024)
- (cffi:foreign-string-to-lisp buf))
- (unless (cffi:null-pointer-p subject-name)
- (x509-name-oneline subject-name buf 1024)
- (cffi:foreign-string-to-lisp buf)))))))
-
-(defmethod ssl-stream-handle ((stream flexi-streams:flexi-stream))
- (ssl-stream-handle (flexi-streams:flexi-stream-stream stream)))
-
-(defun ssl-stream-x509-certificate (ssl-stream)
- (ssl-get-peer-certificate (ssl-stream-handle ssl-stream)))
-
-(defun ssl-load-global-verify-locations (&rest pathnames)
- "PATHNAMES is a list of pathnames to PEM files containing server and CA certificates.
-Install these certificates to use for verifying on all SSL connections.
-After RELOAD, you need to call this again."
- (ensure-initialized)
- (dolist (path pathnames)
- (let ((namestring (namestring (truename path))))
- (cffi:with-foreign-strings ((cafile namestring))
- (unless (eql 1 (ssl-ctx-load-verify-locations
- *ssl-global-context*
- cafile
- (cffi:null-pointer)))
- (error "ssl-ctx-load-verify-locations failed."))))))
-
-(defun ssl-set-global-default-verify-paths ()
- "Load the system default verification certificates.
-After RELOAD, you need to call this again."
- (ensure-initialized)
- (unless (eql 1 (ssl-ctx-set-default-verify-paths *ssl-global-context*))
- (error "ssl-ctx-set-default-verify-paths failed.")))
-
-(defun ssl-check-verify-p ()
- "DEPRECATED. Use the (MAKE-SSL-CLIENT-STREAM .. :VERIFY ?) to enable/disable verification.
-MAKE-CONTEXT also allows to enab/disable verification.
-
-Return true if SSL connections will error if the certificate doesn't verify."
- (and *ssl-check-verify-p* (not (eq *ssl-check-verify-p* :unspecified))))
-
-(defun (setf ssl-check-verify-p) (check-verify-p)
- "DEPRECATED. Use the (MAKE-SSL-CLIENT-STREAM .. :VERIFY ?) to enable/disable verification.
-MAKE-CONTEXT also allows to enab/disable verification.
-
-If CHECK-VERIFY-P is true, signal connection errors if the server certificate doesn't verify."
- (setf *ssl-check-verify-p* (not (null check-verify-p))))
-
-(defun ssl-verify-init (&key
- (verify-depth nil)
- (verify-locations nil))
-"DEPRECATED.
-Use the (MAKE-SSL-CLIENT-STREAM .. :VERIFY ?) to enable/disable verification.
-Use (MAKE-CONTEXT ... :VERIFY-LOCATION ? :VERIFY-DEPTH ?) to control the verification depth and locations.
-MAKE-CONTEXT also allows to enab/disable verification."
- (check-type verify-depth (or null integer))
- (ensure-initialized)
- (when verify-depth
- (ssl-ctx-set-verify-depth *ssl-global-context* verify-depth))
- (when verify-locations
- (apply #'ssl-load-global-verify-locations verify-locations)
- ;; This makes (setf (ssl-check-verify) nil) persistent
- (unless (null *ssl-check-verify-p*)
- (setf (ssl-check-verify-p) t))
- t))
-
-(defun maybe-verify-client-stream (ssl-stream verify-mode hostname)
- ;; VERIFY-MODE is one of NIL, :OPTIONAL, :REQUIRED
- ;; HOSTNAME is either NIL or a string.
- (when verify-mode
- (let* ((handle (ssl-stream-handle ssl-stream))
- (srv-cert (ssl-get-peer-certificate handle)))
- (unwind-protect
- (progn
- (when (and (eq :required verify-mode)
- (cffi:null-pointer-p srv-cert))
- (error 'server-certificate-missing
- :format-control "The server didn't present a certificate."))
- (let ((err (ssl-get-verify-result handle)))
- (unless (eql err 0)
- (error 'ssl-error-verify :stream ssl-stream :error-code err)))
- (when (and hostname
- (not (cffi:null-pointer-p srv-cert))
- ;; Beware of the unusual protocol of verify-hostname:
- ;; it returns the verification result as true / false,
- ;; but also signals error for many verification failures.
- ;; TODO: refactor verify-hostname to simplify this protocol.
- (not (verify-hostname srv-cert hostname)))
- (error 'ssl-unable-to-match-host-name :hostname hostname))))
- (unless (cffi:null-pointer-p srv-cert)
- (x509-free srv-cert)))))
-
-(defun handle-external-format (stream ef)
- (if ef
- (flexi-streams:make-flexi-stream stream :external-format ef)
- stream))
-
-(defmacro with-new-ssl ((var) &body body)
- (alexandria:with-gensyms (ssl)
- `(let* ((,ssl (ssl-new *ssl-global-context*))
- (,var ,ssl))
- (when (cffi:null-pointer-p ,ssl)
- (error 'ssl-error-call :message "Unable to create SSL structure" :queue (read-ssl-error-queue)))
- (handler-bind ((error (lambda (_)
- (declare (ignore _))
- (ssl-free ,ssl))))
- ,@body))))
-
-(defvar *make-ssl-client-stream-verify-default*
- (if (member :windows *features*) ; by trivial-features
- ;; On Windows we can't yet initizlise context with
- ;; trusted certifying authorities from system configuration.
- ;; ssl-ctx-set-default-verify-paths only helps
- ;; on Unix-like platforms.
- ;; See https://github.com/cl-plus-ssl/cl-plus-ssl/issues/54.
- nil
- :required)
- "Helps to mitigate the change in default behaviour of
-MAKE-SSL-CLIENT-STREAM - previously it worked as if :VERIFY NIL
-but then :VERIFY :REQUIRED became the default on non-Windows platforms.
-Change this variable if you want the previous behaviour.")
-
-;; fixme: free the context when errors happen in this function
-(defun make-ssl-client-stream
- (socket &key certificate key password (method 'ssl-v23-method) external-format
- close-callback (unwrap-stream-p t)
- (cipher-list *default-cipher-list*)
- (verify (if (ssl-check-verify-p)
- :optional
- *make-ssl-client-stream-verify-default*))
- hostname)
- "Returns an SSL stream for the client socket descriptor SOCKET.
-CERTIFICATE is the path to a file containing the PEM-encoded certificate for
- your client. KEY is the path to the PEM-encoded key for the client, which
-may be associated with the passphrase PASSWORD.
-
-VERIFY can be specified either as NIL if no check should be performed,
-:OPTIONAL to verify the server's certificate if it presented one or
-:REQUIRED to verify the server's certificate and fail if an invalid
-or no certificate was presented.
-
-HOSTNAME if specified, will be sent by client during TLS negotiation,
-according to the Server Name Indication (SNI) extension to the TLS.
-When server handles several domain names, this extension enables the server
-to choose certificate for right domain. Also the HOSTNAME is used for
-hostname verification if verification is enabled by VERIFY."
- (ensure-initialized :method method)
- (let ((stream (make-instance 'ssl-stream
- :socket socket
- :close-callback close-callback)))
- (with-new-ssl (handle)
- (if hostname
- (cffi:with-foreign-string (chostname hostname)
- (ssl-set-tlsext-host-name handle chostname)))
- (setf socket (install-handle-and-bio stream handle socket unwrap-stream-p))
- (ssl-set-connect-state handle)
- (when (zerop (ssl-set-cipher-list handle cipher-list))
- (error 'ssl-error-initialize :reason "Can't set SSL cipher list"))
- (with-pem-password (password)
- (install-key-and-cert handle key certificate))
- (ensure-ssl-funcall stream handle #'ssl-connect handle)
- (maybe-verify-client-stream stream verify hostname)
- (handle-external-format stream external-format))))
-
-;; fixme: free the context when errors happen in this function
-(defun make-ssl-server-stream
- (socket &key certificate key password (method 'ssl-v23-method) external-format
- close-callback (unwrap-stream-p t)
- (cipher-list *default-cipher-list*))
- "Returns an SSL stream for the server socket descriptor SOCKET.
-CERTIFICATE is the path to a file containing the PEM-encoded certificate for
- your server. KEY is the path to the PEM-encoded key for the server, which
-may be associated with the passphrase PASSWORD."
- (ensure-initialized :method method)
- (let ((stream (make-instance 'ssl-server-stream
- :socket socket
- :close-callback close-callback
- :certificate certificate
- :key key)))
- (with-new-ssl (handle)
- (setf socket (install-handle-and-bio stream handle socket unwrap-stream-p))
- (ssl-set-accept-state handle)
- (when (zerop (ssl-set-cipher-list handle cipher-list))
- (error 'ssl-error-initialize :reason "Can't set SSL cipher list"))
- (with-pem-password (password)
- (install-key-and-cert handle key certificate))
- (ensure-ssl-funcall stream handle #'ssl-accept handle)
- (handle-external-format stream external-format))))
-
-#+openmcl
-(defmethod stream-deadline ((stream ccl::basic-stream))
- (ccl::ioblock-deadline (ccl::stream-ioblock stream t)))
-#+openmcl
-(defmethod stream-deadline ((stream t))
- nil)
-
-
-(defgeneric stream-fd (stream))
-(defmethod stream-fd (stream) stream)
-
-#+sbcl
-(defmethod stream-fd ((stream sb-sys:fd-stream))
- (sb-sys:fd-stream-fd stream))
-
-#+cmu
-(defmethod stream-fd ((stream system:fd-stream))
- (system:fd-stream-fd stream))
-
-#+openmcl
-(defmethod stream-fd ((stream ccl::basic-stream))
- (ccl::ioblock-device (ccl::stream-ioblock stream t)))
-
-#+clisp
-(defmethod stream-fd ((stream stream))
- ;; sockets appear to be direct instances of STREAM
- (ext:stream-handles stream))
-
-#+ecl
-(defmethod stream-fd ((stream two-way-stream))
- (si:file-stream-fd (two-way-stream-input-stream stream)))
(DIR) diff --git a/3rdparties/software/cl+ssl-20190202-git/src/verify-hostname.lisp b/3rdparties/software/cl+ssl-20190202-git/src/verify-hostname.lisp
@@ -1,109 +0,0 @@
-;;;; -*- Mode: LISP; Syntax: COMMON-LISP; indent-tabs-mode: nil; coding: utf-8; show-trailing-whitespace: t -*-
-
-(in-package :cl+ssl)
-
-(define-condition hostname-verification-error (error)
- ())
-
-(define-condition unable-to-match-altnames (hostname-verification-error)
- ())
-
-(define-condition unable-to-decode-common-name (hostname-verification-error)
- ())
-
-(define-condition unable-to-match-common-name (hostname-verification-error)
- ())
-
-(defun case-insensitive-match (name hostname)
- (string-equal name hostname))
-
-(defun remove-trailing-dot (string)
- (string-right-trim '(#\.) string))
-
-(defun check-wildcard-in-leftmost-label (identifier wildcard-pos)
- (alexandria:when-let ((dot-pos (position #\. identifier)))
- (> dot-pos wildcard-pos)))
-
-(defun check-single-wildcard (identifier wildcard-pos)
- (not (find #\* identifier :start (1+ wildcard-pos))))
-
-(defun check-two-labels-after-wildcard (after-wildcard)
- ;;at least two dots(in fact labels since we remove trailing dot first) after wildcard
- (alexandria:when-let ((first-dot-aw-pos (position #\. after-wildcard)))
- (and (find #\. after-wildcard :start (1+ first-dot-aw-pos))
- first-dot-aw-pos)))
-
-(defun validate-and-parse-wildcard-identifier (identifier hostname)
- (alexandria:when-let ((wildcard-pos (position #\* identifier)))
- (when (and (>= (length hostname) (length identifier)) ;; wildcard should constiute at least one character
- (check-wildcard-in-leftmost-label identifier wildcard-pos)
- (check-single-wildcard identifier wildcard-pos))
- (let ((after-wildcard (subseq identifier (1+ wildcard-pos)))
- (before-wildcard (subseq identifier 0 wildcard-pos)))
- (alexandria:when-let ((first-dot-aw-pos (check-two-labels-after-wildcard after-wildcard)))
- (if (and (= 0 (length before-wildcard)) ;; nothing before wildcard
- (= wildcard-pos first-dot-aw-pos)) ;; i.e. dot follows *
- (values t before-wildcard after-wildcard t)
- (values t before-wildcard after-wildcard nil)))))))
-
-(defun wildcard-not-in-a-label (before-wildcard after-wildcard)
- (let ((after-w-dot-pos (position #\. after-wildcard)))
- (and
- (not (search "xn--" before-wildcard))
- (not (search "xn--" (subseq after-wildcard 0 after-w-dot-pos))))))
-
-(defun try-match-wildcard (before-wildcard after-wildcard single-char-wildcard pattern)
- ;; Compare AfterW part with end of pattern with length (length AfterW)
- ;; was Wildcard the only character in left-most label in identifier
- ;; doesn't matter since parts after Wildcard should match unconditionally.
- ;; However if Wildcard was the only character in left-most label we can't match this *.example.com and bar.foo.example.com
- ;; if i'm correct if it wasn't the only character
- ;; we can match like this: *o.example.com = bar.foo.example.com
- ;; but this is prohibited anyway thanks to check-vildcard-in-leftmost-label
- (if single-char-wildcard
- (let ((pattern-except-left-most-label
- (alexandria:if-let ((first-hostname-dot-post (position #\. pattern)))
- (subseq pattern first-hostname-dot-post)
- pattern)))
- (case-insensitive-match after-wildcard pattern-except-left-most-label))
- (when (wildcard-not-in-a-label before-wildcard after-wildcard)
- ;; baz*.example.net and *baz.example.net and b*z.example.net would
- ;; be taken to match baz1.example.net and foobaz.example.net and
- ;; buzz.example.net, respectively
- (and
- (case-insensitive-match before-wildcard (subseq pattern 0 (length before-wildcard)))
- (case-insensitive-match after-wildcard (subseq pattern
- (- (length pattern)
- (length after-wildcard))))))))
-
-(defun maybe-try-match-wildcard (name hostname)
- (multiple-value-bind (valid before-wildcard after-wildcard single-char-wildcard)
- (validate-and-parse-wildcard-identifier name hostname)
- (when valid
- (try-match-wildcard before-wildcard after-wildcard single-char-wildcard hostname))))
-
-(defun try-match-hostname (name hostname)
- (let ((name (remove-trailing-dot name))
- (hostname (remove-trailing-dot hostname)))
- (or (case-insensitive-match name hostname)
- (maybe-try-match-wildcard name hostname))))
-
-(defun try-match-hostnames (names hostname)
- (loop for name in names
- when (try-match-hostname name hostname) do
- (return t)))
-
-(defun maybe-check-subject-cn (dns-names cert hostname)
- (when dns-names
- (error 'unable-to-match-altnames))
- ;; TODO: we are matching only first CN
- (alexandria:if-let ((cn (first (certificate-subject-common-names cert))))
- (progn
- (or (try-match-hostname cn hostname)
- (error 'unable-to-match-common-name)))
- (error 'unable-to-decode-common-name)))
-
-(defun verify-hostname (cert hostname)
- (let* ((dns-names (certificate-dns-alt-names cert)))
- (or (try-match-hostnames dns-names hostname)
- (maybe-check-subject-cn dns-names cert hostname))))
(DIR) diff --git a/3rdparties/software/cl+ssl-20190202-git/src/x509.lisp b/3rdparties/software/cl+ssl-20190202-git/src/x509.lisp
@@ -1,224 +0,0 @@
-;;;; -*- Mode: LISP; Syntax: COMMON-LISP; indent-tabs-mode: nil; coding: utf-8; show-trailing-whitespace: t -*-
-
-(in-package :cl+ssl)
-
-#|
-ASN1 string validation references:
- - https://github.com/digitalbazaar/forge/blob/909e312878838f46ba6d70e90264650b05eb8bde/js/asn1.js
- - http://www.obj-sys.com/asn1tutorial/node128.html
- - https://github.com/deadtrickster/ssl_verify_hostname.erl/blob/master/src/ssl_verify_hostname.erl
- - https://golang.org/src/encoding/asn1/asn1.go?m=text
-|#
-(defgeneric decode-asn1-string (asn1-string type))
-
-(defun copy-bytes-to-lisp-vector (src-ptr vector count)
- (declare (type (simple-array (unsigned-byte 8)) vector)
- (type fixnum count)
- (optimize (safety 0) (debug 0) (speed 3)))
- (dotimes (i count vector)
- (setf (aref vector i) (cffi:mem-aref src-ptr :unsigned-char i))))
-
-(defun asn1-string-bytes-vector (asn1-string)
- (let* ((data (asn1-string-data asn1-string))
- (length (asn1-string-length asn1-string))
- (vector (cffi:make-shareable-byte-vector length)))
- (copy-bytes-to-lisp-vector data vector length)
- vector))
-
-(defun asn1-iastring-char-p (byte)
- (declare (type (unsigned-byte 8) byte)
- (optimize (speed 3)
- (debug 0)
- (safety 0)))
- (< byte #x80))
-
-(defun asn1-iastring-p (bytes)
- (declare (type (simple-array (unsigned-byte 8)) bytes)
- (optimize (speed 3)
- (debug 0)
- (safety 0)))
- (every #'asn1-iastring-char-p bytes))
-
-(defmethod decode-asn1-string (asn1-string (type (eql +v-asn1-iastring+)))
- (let ((bytes (asn1-string-bytes-vector asn1-string)))
- (if (asn1-iastring-p bytes)
- (flex:octets-to-string bytes :external-format :ascii)
- (error 'invalid-asn1-string :type '+v-asn1-iastring+))))
-
-(defun asn1-printable-char-p (byte)
- (declare (type (unsigned-byte 8) byte)
- (optimize (speed 3)
- (debug 0)
- (safety 0)))
- (cond
- ;; a-z
- ((and (>= byte #.(char-code #\a))
- (<= byte #.(char-code #\z)))
- t)
- ;; '-/
- ((and (>= byte #.(char-code #\'))
- (<= byte #.(char-code #\/)))
- t)
- ;; 0-9
- ((and (>= byte #.(char-code #\0))
- (<= byte #.(char-code #\9)))
- t)
- ;; A-Z
- ((and (>= byte #.(char-code #\A))
- (<= byte #.(char-code #\Z)))
- t)
- ;; other
- ((= byte #.(char-code #\ )) t)
- ((= byte #.(char-code #\:)) t)
- ((= byte #.(char-code #\=)) t)
- ((= byte #.(char-code #\?)) t)))
-
-(defun asn1-printable-string-p (bytes)
- (declare (type (simple-array (unsigned-byte 8)) bytes)
- (optimize (speed 3)
- (debug 0)
- (safety 0)))
- (every #'asn1-printable-char-p bytes))
-
-(defmethod decode-asn1-string (asn1-string (type (eql +v-asn1-printablestring+)))
- (let* ((bytes (asn1-string-bytes-vector asn1-string)))
- (if (asn1-printable-string-p bytes)
- (flex:octets-to-string bytes :external-format :ascii)
- (error 'invalid-asn1-string :type '+v-asn1-printablestring+))))
-
-(defmethod decode-asn1-string (asn1-string (type (eql +v-asn1-utf8string+)))
- (let* ((data (asn1-string-data asn1-string))
- (length (asn1-string-length asn1-string)))
- (cffi:foreign-string-to-lisp data :count length :encoding :utf-8)))
-
-(defmethod decode-asn1-string (asn1-string (type (eql +v-asn1-universalstring+)))
- (if (= 0 (mod (asn1-string-length asn1-string) 4))
- ;; cffi sometimes fails here on sbcl? idk why (maybe threading?)
- ;; fail: Illegal :UTF-32 character starting at position 48...
- ;; when (length bytes) is 48...
- ;; so I'm passing :count explicitly
- (or (ignore-errors (cffi:foreign-string-to-lisp (asn1-string-data asn1-string) :count (asn1-string-length asn1-string) :encoding :utf-32))
- (error 'invalid-asn1-string :type '+v-asn1-universalstring+))
- (error 'invalid-asn1-string :type '+v-asn1-universalstring+)))
-
-(defun asn1-teletex-char-p (byte)
- (declare (type (unsigned-byte 8) byte)
- (optimize (speed 3)
- (debug 0)
- (safety 0)))
- (and (>= byte #x20)
- (< byte #x80)))
-
-(defun asn1-teletex-string-p (bytes)
- (declare (type (simple-array (unsigned-byte 8)) bytes)
- (optimize (speed 3)
- (debug 0)
- (safety 0)))
- (every #'asn1-teletex-char-p bytes))
-
-(defmethod decode-asn1-string (asn1-string (type (eql +v-asn1-teletexstring+)))
- (let ((bytes (asn1-string-bytes-vector asn1-string)))
- (if (asn1-teletex-string-p bytes)
- (flex:octets-to-string bytes :external-format :ascii)
- (error 'invalid-asn1-string :type '+v-asn1-teletexstring+))))
-
-(defmethod decode-asn1-string (asn1-string (type (eql +v-asn1-bmpstring+)))
- (if (= 0 (mod (asn1-string-length asn1-string) 2))
- (or (ignore-errors (cffi:foreign-string-to-lisp (asn1-string-data asn1-string) :count (asn1-string-length asn1-string) :encoding :utf-16/be))
- (error 'invalid-asn1-string :type '+v-asn1-bmpstring+))
- (error 'invalid-asn1-string :type '+v-asn1-bmpstring+)))
-
-;; TODO: respect asn1-string type
-(defun try-get-asn1-string-data (asn1-string allowed-types)
- (let ((type (asn1-string-type asn1-string)))
- (assert (member (asn1-string-type asn1-string) allowed-types) nil "Invalid asn1 string type")
- (decode-asn1-string asn1-string type)))
-
-(defun slurp-stream (stream)
- (let ((seq (make-array (file-length stream) :element-type '(unsigned-byte 8))))
- (read-sequence seq stream)
- seq))
-
-(defmethod decode-certificate ((format (eql :der)) bytes)
- (cffi:with-pointer-to-vector-data (buf* bytes)
- (cffi:with-foreign-object (buf** :pointer)
- (setf (cffi:mem-ref buf** :pointer) buf*)
- (let ((cert (d2i-x509 (cffi:null-pointer) buf** (length bytes))))
- (when (cffi:null-pointer-p cert)
- (error 'ssl-error-call :message "d2i-X509 failed" :queue (read-ssl-error-queue)))
- cert))))
-
-(defun cert-format-from-path (path)
- ;; or match "pem" type too and raise unknown format error?
- (if (equal "der" (pathname-type path))
- :der
- :pem))
-
-(defun decode-certificate-from-file (path &key format)
- (let ((bytes (with-open-file (stream path :element-type '(unsigned-byte 8))
- (slurp-stream stream)))
- (format (or format (cert-format-from-path path))))
- (decode-certificate format bytes)))
-
-(defun certificate-alt-names (cert)
- #|
- * The return value is the decoded extension or NULL on
- * error. The actual error can have several different causes,
- * the value of *crit reflects the cause:
- * >= 0, extension found but not decoded (reflects critical value).
- * -1 extension not found.
- * -2 extension occurs more than once.
- |#
- (cffi:with-foreign-object (crit* :int)
- (let ((result (x509-get-ext-d2i cert +NID-subject-alt-name+ crit* (cffi:null-pointer))))
- (if (cffi:null-pointer-p result)
- (let ((crit (cffi:mem-ref crit* :int)))
- (cond
- ((>= crit 0)
- (error "X509_get_ext_d2i: subject-alt-name extension decoding error"))
- ((= crit -1) ;; extension not found, return NULL
- result)
- ((= crit -2)
- (error "X509_get_ext_d2i: subject-alt-name extension occurs more than once"))))
- result))))
-
-(defun certificate-dns-alt-names (cert)
- (let ((altnames (certificate-alt-names cert)))
- (unless (cffi:null-pointer-p altnames)
- (unwind-protect
- (flet ((alt-name-to-string (alt-name)
- (cffi:with-foreign-slots ((type data) alt-name (:struct general-name))
- (when (= type +GEN-DNS+)
- (alexandria:if-let ((string (try-get-asn1-string-data data '(#.+v-asn1-iastring+))))
- string
- (error "Malformed certificate: possibly NULL in dns-alt-name"))))))
- (let ((altnames-count (sk-general-name-num altnames)))
- (loop for i from 0 below altnames-count
- as alt-name = (sk-general-name-value altnames i)
- collect (alt-name-to-string alt-name))))
- (general-names-free altnames)))))
-
-(defun certificate-subject-common-names (cert)
- (let ((i -1)
- (subject-name (x509-get-subject-name cert)))
- (when (cffi:null-pointer-p subject-name)
- (error "X509_get_subject_name returned NULL"))
- (flet ((extract-cn ()
- (setf i (x509-name-get-index-by-nid subject-name +NID-commonName+ i))
- (when (>= i 0)
- (let* ((entry (x509-name-get-entry subject-name i)))
- (when (cffi:null-pointer-p entry)
- (error "X509_NAME_get_entry returned NULL"))
- (let ((entry-data (x509-name-entry-get-data entry)))
- (when (cffi:null-pointer-p entry-data)
- (error "X509_NAME_ENTRY_get_data returned NULL"))
- (try-get-asn1-string-data entry-data '(#.+v-asn1-utf8string+
- #.+v-asn1-bmpstring+
- #.+v-asn1-printablestring+
- #.+v-asn1-universalstring+
- #.+v-asn1-teletexstring+)))))))
- (loop
- as cn = (extract-cn)
- if cn collect cn
- if (not cn) do
- (loop-finish)))))
(DIR) diff --git a/3rdparties/software/cl+ssl-20190202-git/ssl-verify-test.lisp b/3rdparties/software/cl+ssl-20190202-git/ssl-verify-test.lisp
@@ -1,166 +0,0 @@
-;;; Copyright (C) 2011 David Lichteblau
-;;;
-;;; See LICENSE for details.
-
-#+xcvb (module (:depends-on ("package")))
-
-(in-package :cl+ssl)
-
-;; from cl+ssl/example.lisp
-(defun read-line-crlf-2 (stream &optional eof-error-p)
- (let ((s (make-string-output-stream)))
- (loop
- for empty = t then nil
- for c = (read-char stream eof-error-p nil)
- while (and c (not (eql c #\return)))
- do
- (unless (eql c #\newline)
- (write-char c s))
- finally
- (return
- (if empty nil (get-output-stream-string s))))))
-
-(defun write-ssl-certificate-names (ssl-stream &optional (output-stream t))
- (let* ((ssl (ssl-stream-handle ssl-stream))
- (cert (ssl-get-peer-certificate ssl)))
- (unless (cffi:null-pointer-p cert)
- (unwind-protect
- (multiple-value-bind (issuer subject)
- (x509-certificate-names cert)
- (format output-stream
- " issuer: ~a~% subject: ~a~%" issuer subject))
- (x509-free cert)))))
-
-;; from cl+ssl/example.lisp
-(defun test-https-client-2 (host &key (port 443) show-text-p)
- (let* ((deadline (+ (get-internal-real-time)
- (* 3 internal-time-units-per-second)))
- (socket (ccl:make-socket :address-family :internet
- :connect :active
- :type :stream
- :remote-host host
- :remote-port port
-;; :local-host (resolve-hostname local-host)
-;; :local-port local-port
- :deadline deadline))
- https)
- (unwind-protect
- (handler-bind
- ((ssl-error-verify
- (lambda (c)
- (write-ssl-certificate-names (ssl-error-stream c)))))
- (setf https
- (cl+ssl:make-ssl-client-stream
- socket
- :unwrap-stream-p t
- :external-format '(:iso-8859-1 :eol-style :lf)))
- (write-ssl-certificate-names https)
- (format https "GET / HTTP/1.0~%Host: ~a~%~%" host)
- (force-output https)
- (loop :for line = (read-line-crlf-2 https nil)
- for cnt from 0
- :while line :do
- (when show-text-p
- (format t "HTTPS> ~a~%" line))
- finally (return cnt)))
- (if https
- (close https)
- (close socket)))))
-
-(defparameter *rayservers-ca-certificate-pem-file*
- "rayservers-ca-certificate.pem")
-
-(defparameter *rayservers-ca-certificate-path*
- (merge-pathnames *rayservers-ca-certificate-pem-file*
- (asdf:system-source-directory :cl+ssl)))
-
-(defparameter *rayservers-ca-certificate-pem*
- "-----BEGIN CERTIFICATE-----
-MIIElTCCA32gAwIBAgIJALoXNnj+yvJCMA0GCSqGSIb3DQEBBQUAMIGNMQswCQYD
-VQQGEwJQQTELMAkGA1UECBMCTkExFDASBgNVBAcTC1BhbmFtYSBDaXR5MRgwFgYD
-VQQKEw9SYXlzZXJ2ZXJzIEdtYkgxGjAYBgNVBAMTEWNhLnJheXNlcnZlcnMuY29t
-MSUwIwYJKoZIhvcNAQkBFhZzdXBwb3J0QHJheXNlcnZlcnMuY29tMB4XDTA5MTAx
-OTE3MzgyMFoXDTE5MTAxNzE3MzgyMFowgY0xCzAJBgNVBAYTAlBBMQswCQYDVQQI
-EwJOQTEUMBIGA1UEBxMLUGFuYW1hIENpdHkxGDAWBgNVBAoTD1JheXNlcnZlcnMg
-R21iSDEaMBgGA1UEAxMRY2EucmF5c2VydmVycy5jb20xJTAjBgkqhkiG9w0BCQEW
-FnN1cHBvcnRAcmF5c2VydmVycy5jb20wggEiMA0GCSqGSIb3DQEBAQUAA4IBDwAw
-ggEKAoIBAQC9rNsCCM+TNp6xDk2yxhXQOStmPTd0txFyduNAj02/nLZV4eq0ZS5n
-xXBE6l3MYIMBMV3BgKiy7LsdiRJeZ5HdsV/HRZzXCQI+k4acBjlRC1ZdWMNsIR+H
-QUVx2y0wgp+QpcMrgBQZdPI7PobnXCZ6+Fmc50kM7xbIsoWZUzQDpRtUymgOhnnT
-4TSb1/XufFHHhDMReRA7s3Co911hzcnZJqL9gFWULlB/RI2ZeVbkp0K4lUXyMZ/R
-fnOtCdAA+TkQcpzoyBETV9p5MO8KBOPBskvyGYqVcIZNuxwfC2uoKx0s5b6eMRKR
-54B4mB/hIi7i0uGjzuAZdt5iDXQHYaM3AgMBAAGjgfUwgfIwHQYDVR0OBBYEFOyu
-Fp80LSc1gwnq5rghs/P8bMgrMIHCBgNVHSMEgbowgbeAFOyuFp80LSc1gwnq5rgh
-s/P8bMgroYGTpIGQMIGNMQswCQYDVQQGEwJQQTELMAkGA1UECBMCTkExFDASBgNV
-BAcTC1BhbmFtYSBDaXR5MRgwFgYDVQQKEw9SYXlzZXJ2ZXJzIEdtYkgxGjAYBgNV
-BAMTEWNhLnJheXNlcnZlcnMuY29tMSUwIwYJKoZIhvcNAQkBFhZzdXBwb3J0QHJh
-eXNlcnZlcnMuY29tggkAuhc2eP7K8kIwDAYDVR0TBAUwAwEB/zANBgkqhkiG9w0B
-AQUFAAOCAQEAqScS+A2Hajjb+jTKQ19LVPzTpRYo1Jz0SPtzGO91n0efYeRJD5hV
-tU+57zGSlUDszARvB+sxzLdJTItK+wEpDM8pLtwUT/VPrRKOoOUBkKBshcTD4HmI
-k8uJlNed0QQLP41hFjr+mYd7WM+N5LtFMQAUBMUN6dzEqQIx69EnIoVp0KB8kDwW
-/QK5ogKY0g8DmRTFiV036bHQH93kLzyV6FNAldO8vBDqcTeru/uU2Kcn6a8YOfO1
-T6MVYory7prWbBaGPKsGw0VgrV9OGbxhbw9EOEYSOgdejvbi9VhgMvEpDYFN7Hnq
-0wiHJq5jKECf3bwRe9uVzVMrIeCap/r2uA==
------END CERTIFICATE-----")
-
-(defun write-rayservers-certificate-pem ()
- (with-open-file (s *rayservers-ca-certificate-path*
- :direction :output
- :if-exists :supersede
- :if-does-not-exist :create)
- (write-string *rayservers-ca-certificate-pem* s)
- *rayservers-ca-certificate-path*))
-
-(defun install-rayservers-ca-certificate ()
- (let ((path (write-rayservers-certificate-pem)))
- (ssl-load-global-verify-locations path)))
-
-(defun test-loom-client (&optional show-text-p)
- (test-https-client-2 "secure.loom.cc" :show-text-p show-text-p))
-
-(defun test-yahoo-client (&optional show-text-p)
- (test-https-client-2 "yahoo.com" :show-text-p show-text-p))
-
-(defmacro expecting-no-errors (&body body)
- `(handler-case
- (progn ,@body)
- (error (c)
- (error "Got an unexpected error: ~a" c))))
-
-(defmacro expecting-error ((type) &body body)
- `(let ((got-error-p nil))
- (handler-case
- (progn ,@body)
- (error (c)
- (unless (typep c ',type)
- (error "Got an unexpected error type: ~a" c))
- (setf got-error-p t)))
- (unless got-error-p
- (error "Did not get expected error."))))
-
-(defun test-verify (&optional quietly)
- (let ((*standard-output*
- ;; test-https-client-2 prints the certificate names
- (if quietly (make-broadcast-stream) *standard-output*)))
- (expecting-no-errors
- (reload)
- (test-loom-client)
- (test-yahoo-client)
- (setf (ssl-check-verify-p) t))
- ;; The Mac appears to have no way to get rid of the default CA certificates
- ;; #+darwin-host is only true in Clozure Common Lisp running on a Mac,
- ;; So this test will fail in SBCL on a Mac
- #-darwin-host
- (expecting-error (ssl-error-verify)
- (test-yahoo-client))
- #+darwin-host
- (expecting-no-errors
- (test-yahoo-client))
- (expecting-error (ssl-error-verify)
- (test-loom-client))
- (expecting-no-errors
- (install-rayservers-ca-certificate)
- (test-loom-client))
- (expecting-no-errors
- (ssl-set-global-default-verify-paths)
- (test-yahoo-client))))
(DIR) diff --git a/3rdparties/software/cl+ssl-20190202-git/test.lisp b/3rdparties/software/cl+ssl-20190202-git/test.lisp
@@ -1,409 +0,0 @@
-;;; Copyright (C) 2008 David Lichteblau
-;;; See LICENSE for details.
-
-#|
-(load "test.lisp")
-|#
-
-(defpackage :ssl-test
- (:use :cl))
-(in-package :ssl-test)
-
-(defvar *port* 8080)
-(defvar *cert* "/home/david/newcert.pem")
-(defvar *key* "/home/david/newkey.pem")
-
-(eval-when (:compile-toplevel :load-toplevel :execute)
- (asdf:operate 'asdf:load-op :trivial-sockets)
- (asdf:operate 'asdf:load-op :bordeaux-threads))
-
-(defparameter *tests* '())
-
-(defvar *sockets* '())
-(defvar *sockets-lock* (bordeaux-threads:make-lock))
-
-(defun record-socket (socket)
- (unless (integerp socket)
- (bordeaux-threads:with-lock-held (*sockets-lock*)
- (push socket *sockets*)))
- socket)
-
-(defun close-socket (socket &key abort)
- (if (streamp socket)
- (close socket :abort abort)
- (trivial-sockets:close-server socket)))
-
-(defun check-sockets ()
- (let ((failures nil))
- (bordeaux-threads:with-lock-held (*sockets-lock*)
- (dolist (socket *sockets*)
- (when (close-socket socket :abort t)
- (push socket failures)))
- (setf *sockets* nil))
- #-sbcl ;fixme
- (when failures
- (error "failed to close sockets properly:~{ ~A~%~}" failures))))
-
-(defmacro deftest (name &body body)
- `(progn
- (defun ,name ()
- (format t "~%----- ~A ----------------------------~%" ',name)
- (handler-case
- (progn
- ,@body
- (check-sockets)
- (format t "===== [OK] ~A ====================~%" ',name)
- t)
- (error (c)
- (when (typep c 'trivial-sockets:socket-error)
- (setf c (trivial-sockets:socket-nested-error c)))
- (format t "~%===== [FAIL] ~A: ~A~%" ',name c)
- (handler-case
- (check-sockets)
- (error (c)
- (format t "muffling follow-up error ~A~%" c)))
- nil)))
- (push ',name *tests*)))
-
-(defun run-all-tests ()
- (unless (probe-file *cert*) (error "~A not found" *cert*))
- (unless (probe-file *key*) (error "~A not found" *key*))
- (let ((n 0)
- (nok 0))
- (dolist (test (reverse *tests*))
- (when (funcall test)
- (incf nok))
- (incf n))
- (format t "~&passed ~D/~D tests~%" nok n)))
-
-(define-condition quit (condition)
- ())
-
-(defparameter *please-quit* t)
-
-(defun make-test-thread (name init main &rest args)
- "Start a thread named NAME, wait until it has funcalled INIT with ARGS
- as arguments, then continue while the thread concurrently funcalls MAIN
- with INIT's return values as arguments."
- (let ((cv (bordeaux-threads:make-condition-variable))
- (lock (bordeaux-threads:make-lock name))
- ;; redirect io manually, because swan's global redirection isn't as
- ;; global as one might hope
- (out *terminal-io*)
- (init-ok nil))
- (bordeaux-threads:with-lock-held (lock)
- (setf *please-quit* nil)
- (prog1
- (bordeaux-threads:make-thread
- (lambda ()
- (flet ((notify ()
- (bordeaux-threads:with-lock-held (lock)
- (bordeaux-threads:condition-notify cv))))
- (let ((*terminal-io* out)
- (*standard-output* out)
- (*trace-output* out)
- (*error-output* out))
- (handler-case
- (let ((values (multiple-value-list (apply init args))))
- (setf init-ok t)
- (notify)
- (apply main values))
- (quit ()
- (notify)
- t)
- (error (c)
- (when (typep c 'trivial-sockets:socket-error)
- (setf c (trivial-sockets:socket-nested-error c)))
- (format t "aborting test thread ~A: ~A" name c)
- (notify)
- nil)))))
- :name name)
- (bordeaux-threads:condition-wait cv lock)
- (unless init-ok
- (error "failed to start background thread"))))))
-
-(defmacro with-thread ((name init main &rest args) &body body)
- `(invoke-with-thread (lambda () ,@body)
- ,name
- ,init
- ,main
- ,@args))
-
-(defun invoke-with-thread (body name init main &rest args)
- (let ((thread (apply #'make-test-thread name init main args)))
- (unwind-protect
- (funcall body)
- (setf *please-quit* t)
- (loop
- for delay = 0.0001 then (* delay 2)
- while (and (< delay 0.5) (bordeaux-threads:thread-alive-p thread))
- do
- (sleep delay))
- (when (bordeaux-threads:thread-alive-p thread)
- (format t "~&thread doesn't want to quit, killing it~%")
- (force-output)
- (bordeaux-threads:interrupt-thread thread (lambda () (error 'quit)))
- (loop
- for delay = 0.0001 then (* delay 2)
- while (bordeaux-threads:thread-alive-p thread)
- do
- (sleep delay))))))
-
-(defun init-server (&key (unwrap-stream-p t))
- (format t "~&SSL server listening on port ~d~%" *port*)
- (values (record-socket (trivial-sockets:open-server :port *port*))
- unwrap-stream-p))
-
-(defun test-server (listening-socket unwrap-stream-p)
- (format t "~&SSL server accepting...~%")
- (unwind-protect
- (let* ((socket (record-socket
- (trivial-sockets:accept-connection
- listening-socket
- :element-type '(unsigned-byte 8))))
- (callback nil))
- (when (eq unwrap-stream-p :caller)
- (setf callback (let ((s socket)) (lambda () (close-socket s))))
- (setf socket (cl+ssl:stream-fd socket))
- (setf unwrap-stream-p nil))
- (let ((client (record-socket
- (cl+ssl:make-ssl-server-stream
- socket
- :unwrap-stream-p unwrap-stream-p
- :close-callback callback
- :external-format :iso-8859-1
- :certificate *cert*
- :key *key*))))
- (unwind-protect
- (loop
- for line = (prog2
- (when *please-quit* (return))
- (read-line client nil)
- (when *please-quit* (return)))
- while line
- do
- (cond
- ((equal line "freeze")
- (format t "~&Freezing on client request~%")
- (loop
- (sleep 1)
- (when *please-quit* (return))))
- (t
- (format t "~&Responding to query ~A...~%" line)
- (format client "(echo ~A)~%" line)
- (force-output client))))
- (close-socket client))))
- (close-socket listening-socket)))
-
-(defun init-client (&key (unwrap-stream-p t))
- (let ((socket (record-socket
- (trivial-sockets:open-stream
- "127.0.0.1"
- *port*
- :element-type '(unsigned-byte 8))))
- (callback nil))
- (when (eq unwrap-stream-p :caller)
- (setf callback (let ((s socket)) (lambda () (close-socket s))))
- (setf socket (cl+ssl:stream-fd socket))
- (setf unwrap-stream-p nil))
- (cl+ssl:make-ssl-client-stream
- socket
- :unwrap-stream-p unwrap-stream-p
- :close-callback callback
- :external-format :iso-8859-1)))
-
-;; CCL requires specifying the
-;; deadline at the socket cration (
-;; in constrast to SBCL which has
-;; the WITH-TIMEOUT macro).
-;;
-;; Therefore a separate INIT-CLIENT
-;; function is needed for CCL when
-;; we need read/write deadlines on
-;; the SSL client stream.
-#+clozure-common-lisp
-(defun ccl-init-client-with-deadline (&key (unwrap-stream-p t)
- seconds)
- (let* ((deadline
- (+ (get-internal-real-time)
- (* seconds internal-time-units-per-second)))
- (low
- (record-socket
- (ccl:make-socket
- :address-family :internet
- :connect :active
- :type :stream
- :remote-host "127.0.0.1"
- :remote-port *port*
- :deadline deadline))))
- (cl+ssl:make-ssl-client-stream
- low
- :unwrap-stream-p unwrap-stream-p
- :external-format :iso-8859-1)))
-
-;;; Simple echo-server test. Write a line and check that the result
-;;; watches, three times in a row.
-(deftest echo
- (with-thread ("simple server" #'init-server #'test-server)
- (with-open-stream (socket (init-client))
- (write-line "test" socket)
- (force-output socket)
- (assert (equal (read-line socket) "(echo test)"))
- (write-line "test2" socket)
- (force-output socket)
- (assert (equal (read-line socket) "(echo test2)"))
- (write-line "test3" socket)
- (force-output socket)
- (assert (equal (read-line socket) "(echo test3)")))))
-
-;;; Run tests with different BIO setup strategies:
-;;; - :UNWRAP-STREAMS T
-;;; In this case, CL+SSL will convert the socket to a file descriptor.
-;;; - :UNWRAP-STREAMS :CLIENT
-;;; Convert the socket to a file descriptor manually, and give that
-;;; to CL+SSL.
-;;; - :UNWRAP-STREAMS NIL
-;;; Let CL+SSL write to the stream directly, using the Lisp BIO.
-(macrolet ((deftests (name (var &rest values) &body body)
- `(progn
- ,@(loop
- for value in values
- collect
- `(deftest ,(intern (format nil "~A-~A" name value))
- (let ((,var ',value))
- ,@body))))))
-
- (deftests unwrap-strategy (usp nil t :caller)
- (with-thread ("echo server for strategy test"
- (lambda () (init-server :unwrap-stream-p usp))
- #'test-server)
- (with-open-stream (socket (init-client :unwrap-stream-p usp))
- (write-line "test" socket)
- (force-output socket)
- (assert (equal (read-line socket) "(echo test)")))))
-
- #+clozure-common-lisp
- (deftests read-deadline (usp nil t :caller)
- (with-thread ("echo server for deadline test"
- (lambda () (init-server :unwrap-stream-p usp))
- #'test-server)
- (with-open-stream
- (socket
- (ccl-init-client-with-deadline
- :unwrap-stream-p usp
- :seconds 3))
- (write-line "test" socket)
- (force-output socket)
- (assert (equal (read-line socket) "(echo test)"))
- (handler-case
- (progn
- (read-char socket)
- (error "unexpected data"))
- (ccl::communication-deadline-expired ())))))
-
- #+sbcl
- (deftests read-deadline (usp nil t :caller)
- (with-thread ("echo server for deadline test"
- (lambda () (init-server :unwrap-stream-p usp))
- #'test-server)
- (sb-sys:with-deadline (:seconds 3)
- (with-open-stream (socket (init-client :unwrap-stream-p usp))
- (write-line "test" socket)
- (force-output socket)
- (assert (equal (read-line socket) "(echo test)"))
- (handler-case
- (progn
- (read-char socket)
- (error "unexpected data"))
- (sb-sys:deadline-timeout ()))))))
-
- #+clozure-common-lisp
- (deftests write-deadline (usp nil t)
- (with-thread ("echo server for deadline test"
- (lambda () (init-server :unwrap-stream-p usp))
- #'test-server)
- (with-open-stream
- (socket
- (ccl-init-client-with-deadline
- :unwrap-stream-p usp
- :seconds 3))
- (unwind-protect
- (progn
- (write-line "test" socket)
- (force-output socket)
- (assert (equal (read-line socket) "(echo test)"))
- (write-line "freeze" socket)
- (force-output socket)
- (let ((n 0))
- (handler-case
- (loop
- (write-line "deadbeef" socket)
- (incf n))
- (ccl::communication-deadline-expired ()))
- ;; should have written a couple of lines before the deadline:
- (assert (> n 100))))
- (handler-case
- (close-socket socket :abort t)
- (ccl::communication-deadline-expired ()))))))
-
- #+sbcl
- (deftests write-deadline (usp nil t)
- (with-thread ("echo server for deadline test"
- (lambda () (init-server :unwrap-stream-p usp))
- #'test-server)
- (with-open-stream (socket (init-client :unwrap-stream-p usp))
- (unwind-protect
- (sb-sys:with-deadline (:seconds 3)
- (write-line "test" socket)
- (force-output socket)
- (assert (equal (read-line socket) "(echo test)"))
- (write-line "freeze" socket)
- (force-output socket)
- (let ((n 0))
- (handler-case
- (loop
- (write-line "deadbeef" socket)
- (incf n))
- (sb-sys:deadline-timeout ()))
- ;; should have written a couple of lines before the deadline:
- (assert (> n 100))))
- (handler-case
- (close-socket socket :abort t)
- (sb-sys:deadline-timeout ()))))))
-
- #+clozure-common-lisp
- (deftests read-char-no-hang/test (usp nil t :caller)
- (with-thread ("echo server for read-char-no-hang test"
- (lambda () (init-server :unwrap-stream-p usp))
- #'test-server)
- (with-open-stream
- (socket (ccl-init-client-with-deadline
- :unwrap-stream-p usp
- :seconds 3))
- (write-line "test" socket)
- (force-output socket)
- (assert (equal (read-line socket) "(echo test)"))
- (handler-case
- (when (read-char-no-hang socket)
- (error "unexpected data"))
- (ccl::communication-deadline-expired ()
- (error "read-char-no-hang hangs"))))))
-
- #+sbcl
- (deftests read-char-no-hang/test (usp nil t :caller)
- (with-thread ("echo server for read-char-no-hang test"
- (lambda () (init-server :unwrap-stream-p usp))
- #'test-server)
- (sb-sys:with-deadline (:seconds 3)
- (with-open-stream (socket (init-client :unwrap-stream-p usp))
- (write-line "test" socket)
- (force-output socket)
- (assert (equal (read-line socket) "(echo test)"))
- (handler-case
- (when (read-char-no-hang socket)
- (error "unexpected data"))
- (sb-sys:deadline-timeout ()
- (error "read-char-no-hang hangs"))))))))
-
-#+(or)
-(run-all-tests)
(DIR) diff --git a/3rdparties/software/cl+ssl-20190202-git/test/badssl-com.lisp b/3rdparties/software/cl+ssl-20190202-git/test/badssl-com.lisp
@@ -1,46 +0,0 @@
-;;;; -*- Mode: LISP; Syntax: COMMON-LISP; indent-tabs-mode: nil; coding: utf-8; show-trailing-whitespace: t -*-
-
-(in-package :cl+ssl.test)
-
-(def-suite :cl+ssl.badssl-com :in :cl+ssl
- :description "Tests using badssl.com")
-
-(in-suite :cl+ssl.badssl-com)
-
-
-(defun test-connect (host &key (verify :required))
- (usocket:with-client-socket (socket stream host 443
- :element-type '(unsigned-byte 8))
- (cl+ssl:make-ssl-client-stream stream
- :hostname host
- :verify verify)))
-
-(test wrong.host
- (signals error
- (test-connect "wrong.host.badssl.com"))
- (signals error
- (test-connect "wrong.host.badssl.com" :verify :optional))
- (finishes
- (test-connect "wrong.host.badssl.com" :verify nil)))
-
-(test expired
- (signals error
- (test-connect "expired.badssl.com"))
- (signals error
- (test-connect "expired.badssl.com" :verify :optional))
- (finishes
- (test-connect "expired.badssl.com" :verify nil)))
-
-(test self-signed
- (signals error
- (test-connect "self-signed.badssl.com")))
-
-(test untrusted-root
- (signals error
- (test-connect "untrusted-root.badssl.com")))
-
-(test null
- (signals error
- (test-connect "null.badssl.com"))
- (finishes
- (test-connect "null.badssl.com" :verify :optional)))
(DIR) diff --git a/3rdparties/software/cl+ssl-20190202-git/test/certs/google.der b/3rdparties/software/cl+ssl-20190202-git/test/certs/google.der
Binary files differ.
(DIR) diff --git a/3rdparties/software/cl+ssl-20190202-git/test/certs/google_bmp.der b/3rdparties/software/cl+ssl-20190202-git/test/certs/google_bmp.der
Binary files differ.
(DIR) diff --git a/3rdparties/software/cl+ssl-20190202-git/test/certs/google_nodns.der b/3rdparties/software/cl+ssl-20190202-git/test/certs/google_nodns.der
Binary files differ.
(DIR) diff --git a/3rdparties/software/cl+ssl-20190202-git/test/certs/google_printable!.der b/3rdparties/software/cl+ssl-20190202-git/test/certs/google_printable!.der
Binary files differ.
(DIR) diff --git a/3rdparties/software/cl+ssl-20190202-git/test/certs/google_printable.der b/3rdparties/software/cl+ssl-20190202-git/test/certs/google_printable.der
Binary files differ.
(DIR) diff --git a/3rdparties/software/cl+ssl-20190202-git/test/certs/google_teletex.der b/3rdparties/software/cl+ssl-20190202-git/test/certs/google_teletex.der
Binary files differ.
(DIR) diff --git a/3rdparties/software/cl+ssl-20190202-git/test/certs/google_universal.der b/3rdparties/software/cl+ssl-20190202-git/test/certs/google_universal.der
Binary files differ.
(DIR) diff --git a/3rdparties/software/cl+ssl-20190202-git/test/certs/google_wildcard.der b/3rdparties/software/cl+ssl-20190202-git/test/certs/google_wildcard.der
Binary files differ.
(DIR) diff --git a/3rdparties/software/cl+ssl-20190202-git/test/dummy.lisp b/3rdparties/software/cl+ssl-20190202-git/test/dummy.lisp
@@ -1,11 +0,0 @@
-;;;; -*- Mode: LISP; Syntax: COMMON-LISP; indent-tabs-mode: nil; coding: utf-8; show-trailing-whitespace: t -*-
-
-(in-package :cl+ssl.test)
-
-(in-suite :cl+ssl)
-
-(test (sanity-check.1 :compile-at :definition-time)
- (is-true t "SANITY CHECK: T isn't T"))
-
-(test (sanity-check.2 :compile-at :definition-time)
- (is-false nil "SANITY CHECK: NIL isn't NIL"))
(DIR) diff --git a/3rdparties/software/cl+ssl-20190202-git/test/package.lisp b/3rdparties/software/cl+ssl-20190202-git/test/package.lisp
@@ -1,12 +0,0 @@
-;;;; -*- Mode: LISP; Syntax: COMMON-LISP; indent-tabs-mode: nil; coding: utf-8; show-trailing-whitespace: t -*-
-
-(in-package :cl-user)
-
-(defpackage :cl+ssl.test
- (:use :cl
- :5am))
-
-(in-package :cl+ssl.test)
-
-(def-suite :cl+ssl
- :description "Main test suite for CL+SSL")
(DIR) diff --git a/3rdparties/software/cl+ssl-20190202-git/test/run-on-many-lisps-and-openssls/openssl-releases/build-all.sh b/3rdparties/software/cl+ssl-20190202-git/test/run-on-many-lisps-and-openssls/openssl-releases/build-all.sh
@@ -1,18 +0,0 @@
-#!/bin/bash
-
-curdir="`dirname $0`"
-mkdir "${curdir}/bin"
-cd bin
-bindirabs=`pwd -P` # absolute path to bindir
-cd ..
-
-for srcdir in openssl-0.9.8zh openssl-1.0.0s openssl-1.0.2q openssl-1.1.0j openssl-1.1.1a
-do
- cd $srcdir
- make clean
- ./config shared --prefix="${bindirabs}/${srcdir}" --openssldir="${bindirabs}/${srcdir}"
- make && make install
- cd ..
-done
-
-
(DIR) diff --git a/3rdparties/software/cl+ssl-20190202-git/test/run-on-many-lisps-and-openssls/openssl-releases/fetch-all.sh b/3rdparties/software/cl+ssl-20190202-git/test/run-on-many-lisps-and-openssls/openssl-releases/fetch-all.sh
@@ -1,13 +0,0 @@
-#!/bin/sh
-cd "`dirname $0`"
-
-wget https://www.openssl.org/source/openssl-1.0.2q.tar.gz
-tar -xzf openssl-1.0.2q.tar.gz
-wget https://www.openssl.org/source/openssl-1.1.0j.tar.gz
-tar -xzf openssl-1.1.0j.tar.gz
-wget https://www.openssl.org/source/openssl-1.1.1a.tar.gz
-tar -xzf openssl-1.1.1a.tar.gz
-wget https://www.openssl.org/source/old/1.0.0/openssl-1.0.0s.tar.gz
-tar -xzf openssl-1.0.0s.tar.gz
-wget https://www.openssl.org/source/old/0.9.x/openssl-0.9.8zh.tar.gz
-tar -xzf openssl-0.9.8zh.tar.gz
(DIR) diff --git a/3rdparties/software/cl+ssl-20190202-git/test/run-on-many-lisps-and-openssls/run-home.lisp b/3rdparties/software/cl+ssl-20190202-git/test/run-on-many-lisps-and-openssls/run-home.lisp
@@ -1,44 +0,0 @@
-(defparameter *this-dir*
- (if *load-truename*
- (make-pathname :name nil :type nil :defaults *load-truename*)
- ;; for slime:
- #P"/home/anton/prj/cl+ssl/cl-plus-ssl/test/run-on-many-lisps-and-openssls/"))
-
-(load (merge-pathnames "run-on-many-lisps-and-openssls.lisp" *this-dir*))
-
-
-(defparameter *abcl-1.3.1* (make-instance 'lisp-exe:abcl
- :java-exe-path "java"
- :abcl-jar-path "/home/anton/unpacked/abcl-bin-1.3.1/abcl.jar"))
-(defparameter *ccl-1.11-x86-64* (make-instance 'lisp-exe:ccl
- :exe-path "/home/anton/unpacked/ccl-1.11/lx86cl64"))
-(defparameter *sbcl-1.4.13* (make-instance 'lisp-exe:sbcl
- :exe-path "/home/anton/unpacked/sbcl-1.4.13-x86-64-linux/run-sbcl.sh"))
-
-
-;; (run-on-many-lisps-and-openssls:clean-fasls (merge-pathnames "workdir/" *this-dir*))
-
-(let ((*print-pretty* t))
- (format t "~S~%"
- (time
- (run-on-many-lisps-and-openssls:run
- :test-run-description '(:lib-world "quicklisp 2019-01-07 + cl+ssl.head"
- :contact-email "avodonosov@yandex.ru")
- :test-run-dir (merge-pathnames "workdir/" *this-dir*)
- :quicklisp-dir (merge-pathnames "quicklisp/" (user-homedir-pathname))
- ;; :cl+ssl-location (uiop:pathname-parent-directory-pathname
- ;; (uiop:pathname-parent-directory-pathname *this-dir*))
- :cl+ssl-location nil ;; to use the cl+ssl version from quicklisp
- :lisps (list *ccl-1.11-x86-64*
- *sbcl-1.4.13*
- *abcl-1.3.1*
- )
- :openssl-releases '("openssl-0.9.8zh"
- ; "openssl-1.0.0s"
- ; "openssl-1.0.2q"
- ; "openssl-1.1.0j"
- ; "openssl-1.1.1a"
- )
- :openssl-releases-dir (merge-pathnames "openssl-releases/bin/"
- *this-dir*)))))
-
(DIR) diff --git a/3rdparties/software/cl+ssl-20190202-git/test/run-on-many-lisps-and-openssls/run-home.sh b/3rdparties/software/cl+ssl-20190202-git/test/run-on-many-lisps-and-openssls/run-home.sh
@@ -1,3 +0,0 @@
-#!/bin/sh
-cd "`dirname $0`"
-~/unpacked/ccl-1.11/lx86cl64 --heap-reserve 200M --load run-home.lisp --eval "(quit)"
(DIR) diff --git a/3rdparties/software/cl+ssl-20190202-git/test/run-on-many-lisps-and-openssls/run-on-many-lisps-and-openssls.lisp b/3rdparties/software/cl+ssl-20190202-git/test/run-on-many-lisps-and-openssls/run-on-many-lisps-and-openssls.lisp
@@ -1,89 +0,0 @@
-(ql:quickload :test-grid-agent)
-(ql:quickload :test-grid-utils)
-(ql:quickload :cl-fad)
-(ql:quickload :alexandria)
-(ql:quickload :log4cl)
-
-(defpackage #:run-on-many-lisps-and-openssls
- (:use :common-lisp)
- (:export #:run
- #:clean-fasls))
-
-(in-package :run-on-many-lisps-and-openssls)
-
-(defun fasl-root (test-run-dir)
- (merge-pathnames "fasl/" test-run-dir))
-
-(defun sanitize-as-path (str)
- ;; Substitute dots by hypens if our main process is CCL, it
- ;; prepends the > symbol before dots;
- ;; for example: 1.1.0.36.mswinmt.1201-284e340 => 1>.1>.0>.36>.mswinmt.1201-284e340
- ;; When we pass such a pathname to other lisps, they can't handle it.
- (substitute #\- #\. str))
-
-(defun log-name (lisp openssl-release)
- (sanitize-as-path
- (string-downcase (concatenate 'string
- (tg-agent::implementation-identifier lisp)
- "-"
- openssl-release))))
-
-(defun fasl-dir (test-run-dir lisp)
- (merge-pathnames
- (format nil
- "~(~A~)/"
- (sanitize-as-path (tg-agent::implementation-identifier lisp)))
- (fasl-root test-run-dir)))
-
-(defun so-path (openssl-releases-dir openssl-release so-name)
- (merge-pathnames (format nil "~A/lib/~A" openssl-release so-name)
- openssl-releases-dir))
-
-(defun run (&key test-run-description
- test-run-dir
- quicklisp-dir
- lisps
- openssl-releases
- openssl-releases-dir
- cl+ssl-location)
- ;; (unless cl+ssl-location
- ;; (error "cl+ssl-location parameter is not specified and *load-truename* was not available at the load time."))
-
- (ensure-directories-exist test-run-dir)
-
- (let ((lisp-exe:*temp-dir* test-run-dir))
- (flet ((run-lib-test (lisp openssl-release)
- (tg-agent::proc-run-libtest
- lisp
- :cl+ssl
- (cons :lisp (cons (tg-agent::implementation-identifier lisp)
- test-run-description))
- (merge-pathnames (log-name lisp openssl-release) test-run-dir)
- quicklisp-dir
- (fasl-dir test-run-dir lisp)
- :eval-before-test `(progn
- (set (read-from-string "asdf:*central-registry*")
- (cons ,cl+ssl-location
- (symbol-value (read-from-string "asdf:*central-registry*"))))
- ,(when cl+ssl-location
- `(cl-user::fncall "add-asdf-output-translation"
- ,cl+ssl-location
- ,(merge-pathnames "cl+ssl/" (fasl-dir test-run-dir lisp))))
- (cl-user::fncall "ql:quickload" :cffi)
- (cl-user::fncall "cffi:load-foreign-library"
- ,(so-path openssl-releases-dir openssl-release "libcrypto.so"))
- (cl-user::fncall "cffi:load-foreign-library"
- ,(so-path openssl-releases-dir openssl-release "libssl.so"))
- (pushnew :cl+ssl-foreign-libs-already-loaded *features*)))))
- (tg-utils::write-to-file
- (alexandria:map-product (lambda (lisp openssl-release)
- (list (tg-agent::implementation-identifier lisp)
- openssl-release
- (getf (run-lib-test lisp openssl-release)
- :status)))
- lisps
- openssl-releases)
- (merge-pathnames "resutls.lisp" test-run-dir)))))
-
-(defun clean-fasls (test-run-dir)
- (cl-fad:delete-directory-and-files (fasl-root test-run-dir)))
(DIR) diff --git a/3rdparties/software/cl+ssl-20190202-git/test/run-on-many-lisps-and-openssls/run-on-server.lisp b/3rdparties/software/cl+ssl-20190202-git/test/run-on-many-lisps-and-openssls/run-on-server.lisp
@@ -1,100 +0,0 @@
-(defparameter *this-dir*
- (if *load-truename*
- (make-pathname :name nil :type nil :defaults *load-truename*)
- ;; for slime:
- #P"/home/testgrid/cl+ssl/cl-plus-ssl/test/run-on-many-lisps-and-openssls/"))
-
-(pushnew "/home/testgrid/cl-test-grid/" asdf:*central-registry* :test #'equal)
-
-(load (merge-pathnames "run-on-many-lisps-and-openssls.lisp" *this-dir*))
-
-
-(defparameter *abcl-1.5.0*
- (make-instance 'lisp-exe:abcl
- :java-exe-path "java"
- :abcl-jar-path "/home/testgrid/lisps/abcl-bin-1.5.0/abcl.jar"))
-
-(defparameter *acl-10.0*
- (make-instance 'lisp-exe:acl
- :exe-path "/home/testgrid/lisps/acl100/alisp"))
-
-(defparameter *acl-10.0m*
- (make-instance 'lisp-exe:acl
- :exe-path "/home/testgrid/lisps/acl100/mlisp"))
-
-(defparameter *acl-10.0-smp*
- (make-instance 'lisp-exe:acl
- :exe-path "/home/testgrid/lisps/acl100-smp/alisp"))
-
-(defparameter *acl-10.0m-smp*
- (make-instance 'lisp-exe:acl
- :exe-path "/home/testgrid/lisps/acl100-smp/mlisp"))
-
-(defparameter *ccl-1.11.5*
- (make-instance 'lisp-exe:ccl
- :exe-path "/home/testgrid/lisps/ccl-1.11.5/lx86cl"))
-
-(defparameter *sbcl-1.3.21*
- (make-instance 'lisp-exe:sbcl
- :exe-path "/home/testgrid/lisps/sbcl-bin-1.3.21/run.sh"))
-
-(defparameter *cmucl-2016-12*
- (make-instance 'lisp-exe:cmucl
- :exe-path "/home/testgrid/lisps/cmucl-2016-12/bin/lisp"))
-
-(defparameter *cmucl-2016-12*
- (make-instance 'lisp-exe:cmucl
- :exe-path "/home/testgrid/lisps/cmucl-2016-12/bin/lisp"))
-
-(defparameter *cmucl-21d*
- (make-instance 'lisp-exe:cmucl
- :exe-path "/home/testgrid/lisps/cmucl-21d/bin/lisp"))
-
-(defparameter *ecl-16.1.2-bytecode*
- (make-instance 'lisp-exe:ecl
- :exe-path "/home/testgrid/lisps/ecl-bin-16.1.2/bin/ecl"
- :compiler :bytecode))
-
-(defparameter *ecl-16.1.2-lisp-to-c*
- (make-instance 'lisp-exe:ecl
- :exe-path "/home/testgrid/lisps/ecl-bin-16.1.2/bin/ecl"
- :compiler :lisp-to-c))
-
-(defparameter *clisp*
- (make-instance 'lisp-exe:clisp :exe-path "/usr/bin/clisp"))
-
-(run-on-many-lisps-and-openssls:clean-fasls (merge-pathnames "workdir/" *this-dir*))
-
-(let ((*print-pretty* t))
- (format t "~%~S~%"
- (time
- (run-on-many-lisps-and-openssls:run
- :test-run-description '(:lib-world "quicklisp 2019-01-07 + cl+ssl.head"
- :contact-email "avodonosov@yandex.ru")
- :test-run-dir (merge-pathnames "workdir/" *this-dir*)
- :quicklisp-dir (merge-pathnames "quicklisp/" (user-homedir-pathname))
- ;; if we want the cl+ssl from the parent folder
- :cl+ssl-location (uiop:pathname-parent-directory-pathname
- (uiop:pathname-parent-directory-pathname *this-dir*))
- ;; if we want the cl+ssl version from quicklisp
- ;:cl+ssl-location nil
-
- :lisps (list *sbcl-1.3.21*
- *ccl-1.11.5*
- *abcl-1.5.0*
- *acl-10.0* *acl-10.0m* *acl-10.0-smp* *acl-10.0m-smp*
- *clisp*
- *ecl-16.1.2-bytecode*
- *ecl-16.1.2-lisp-to-c*
- *cmucl-21d*
- )
-
- :openssl-releases '("openssl-0.9.8zh"
- "openssl-1.0.0s"
- "openssl-1.0.2q"
- "openssl-1.1.0j"
- "openssl-1.1.1a"
- )
- :openssl-releases-dir (merge-pathnames "openssl-releases/bin/"
- *this-dir*)))))
-
(DIR) diff --git a/3rdparties/software/cl+ssl-20190202-git/test/run-on-many-lisps-and-openssls/run-on-server.sh b/3rdparties/software/cl+ssl-20190202-git/test/run-on-many-lisps-and-openssls/run-on-server.sh
@@ -1,3 +0,0 @@
-#!/bin/sh
-cd "`dirname $0`"
-~/lisps/ccl-1.11/lx86cl --heap-reserve 200M --load run-on-server.lisp --eval "(quit)"
(DIR) diff --git a/3rdparties/software/cl+ssl-20190202-git/test/sni.lisp b/3rdparties/software/cl+ssl-20190202-git/test/sni.lisp
@@ -1,42 +0,0 @@
-;;;; -*- Mode: LISP; Syntax: COMMON-LISP; indent-tabs-mode: nil; coding: utf-8; show-trailing-whitespace: t -*-
-
-(in-package :cl+ssl.test)
-
-(def-suite :cl+ssl.sni :in :cl+ssl
- :description "Server Name Indications tests")
-
-(in-suite :cl+ssl.sni)
-
-(defun make-request-to-sni-test-server (sni-enabled)
- (usocket:with-client-socket (socket stream "sni.velox.ch" 443
- :element-type '(unsigned-byte 8))
- (let* ((ssl-stream (cl+ssl:make-ssl-client-stream stream
- :hostname (if sni-enabled "sni.velox.ch")))
- (char-stream (flexi-streams:make-flexi-stream ssl-stream
- :external-format '(:utf-8 :eol-style :crlf)))
- (reply-buf (make-string 1000)))
- (unwind-protect
- (progn
- (format char-stream "GET / HTTP/1.1~%")
- (format char-stream "Host: sni.velox.ch~%~%")
- (finish-output char-stream)
- (read-sequence reply-buf char-stream)
- reply-buf)
- (close ssl-stream)))))
-
-(defun sni-test-request-succeeded-p (response)
- (search "Great!" response))
-
-(defun sni-test-request-failed-p (response)
- (search "Unfortunately" response))
-
-;; Disable the SNI tests because sni.velox.ch was shut down and we
-;; haven't found a replacement.
-;;
-;; (test (sni.disabled :compile-at :definition-time)
-;; (is-true (sni-test-request-failed-p (make-request-to-sni-test-server nil))
-;; "Request to SNI test server should've failed because SNI was disabled"))
-;;
-;; (test (sni.enabled :compile-at :definition-time)
-;; (is-true (sni-test-request-succeeded-p (make-request-to-sni-test-server t))
-;; "Request to SNI test server should've succeseeded because SNI was enabled"))
(DIR) diff --git a/3rdparties/software/cl+ssl-20190202-git/test/verify-hostname.lisp b/3rdparties/software/cl+ssl-20190202-git/test/verify-hostname.lisp
@@ -1,89 +0,0 @@
-;;;; -*- Mode: LISP; Syntax: COMMON-LISP; indent-tabs-mode: nil; coding: utf-8; show-trailing-whitespace: t -*-
-
-(in-package :cl+ssl.test)
-
-(def-suite :cl+ssl.verify-hostname :in :cl+ssl
- :description "Hostname verification tests")
-
-(in-suite :cl+ssl.verify-hostname)
-
-(test veriy-hostname-success
- ;; presented identifier, reference identifier, validation and parsing result
- (let ((tests '(("www.example.com" "WWW.eXamPle.CoM" (nil)) ;; case insensitive match
- ("www.example.com." "www.example.com" (nil)) ;; ignore trailing dots (prevenet *.com. matches)
- ("www.example.com" "www.example.com." (nil))
- ("*.example.com" "www.example.com" (t "" ".example.com" t))
- ("b*z.example.com" "buzz.example.com" (t "b" "z.example.com" nil))
- ("*baz.example.com" "foobaz.example.com" (t "" "baz.example.com" nil))
- ("baz*.example.com" "baz1.example.com" (t "baz" ".example.com" nil)))))
- (loop for (i r v) in tests do
- (is (equalp (multiple-value-list (cl+ssl::validate-and-parse-wildcard-identifier i r)) v))
- (is (cl+ssl::try-match-hostname i r)))))
-
-(test verify-hostname-fail
- (let ((tests '(("*.com" "eXamPle.CoM")
- (".com." "example.com.")
- ("*.www.example.com" "www.example.com.")
- ("foo.*.example.com" "foo.bar.example.com.")
- ("xn--*.example.com" "xn-foobar.example.com")
- ("*fooxn--bar.example.com" "bazfooxn--bar.example.com")
- ("*.akamaized.net" "tv.eurosport.com")
- ("a*c.example.com" "abcd.example.com")
- ("*baz.example.com" "foobuzz.example.com"))))
- (loop for (i r) in tests do
- (is-false (cl+ssl::try-match-hostname i r)))))
-
-(defun full-cert-path (name)
- (merge-pathnames (concatenate 'string
- "test/certs/"
- name)
- (asdf:component-pathname (asdf:find-system :cl+ssl.test))))
-
-(defun load-cert(name)
- (let ((full-path (full-cert-path name)))
- (unless (probe-file full-path)
- (error "Unable to find certificate ~a~%Full path: ~a" name full-path))
- (cl+ssl:decode-certificate-from-file full-path)))
-
-(defmacro with-cert ((name var) &body body)
- `(let* ((,var (load-cert ,name)))
- (when (cffi:null-pointer-p ,var)
- (error "Unable to load certificate: ~a" ,name))
- (unwind-protect
- (progn ,@body)
- (cl+ssl::x509-free ,var))))
-
-(test verify-google-cert
- (with-cert ("google.der" cert)
- (is-true (cl+ssl:verify-hostname cert
- "qwe.fr.doubleclick.net"))))
-
-(test verify-google-cert-dns-wildcard
- (with-cert ("google_wildcard.der" cert)
- (is-true (cl+ssl:verify-hostname cert
- "www.google.co.uk"))))
-
-(test verify-google-cert-without-dns
- (with-cert ("google_nodns.der" cert)
- (is-true (cl+ssl:verify-hostname cert
- "www.google.co.uk"))))
-
-(test verify-google-cert-printable-string
- (with-cert ("google_printable.der" cert)
- (is-true (cl+ssl:verify-hostname cert
- "www.google.co.uk"))))
-
-(test verify-google-cert-teletex-string
- (with-cert ("google_teletex.der" cert)
- (is-true (cl+ssl:verify-hostname cert
- "www.google.co.uk"))))
-
-(test verify-google-cert-bmp-string
- (with-cert ("google_bmp.der" cert)
- (is-true (cl+ssl:verify-hostname cert
- "google.co.uk"))))
-
-(test verify-google-cert-universal-string
- (with-cert ("google_universal.der" cert)
- (is-true (cl+ssl:verify-hostname cert
- "google.co.uk"))))
(DIR) diff --git a/3rdparties/software/cl+ssl-20190202-git/todo.txt b/3rdparties/software/cl+ssl-20190202-git/todo.txt
@@ -1,31 +0,0 @@
-- Fix the CCL crash.
-- Separate project page and a Git repo for trivial-gray-streams.
-- Remove the ENSURE-INITIALIZED function from the public API.
- It was only intoroduced to provide users access to the RAND-SEEND
- which we decided to pass as a parameter to the ENSURE-INITIALIZED.
- We did this because solaris users complained, as Solaris doesn't
- have /dev/random, /dev/urnandom files which OpenSSL uses to initialize
- it's random number generator. But now we know that on Solaris people can
- use EGD: The Entropy Gathering Daemon: http://egd.sourceforge.net/,
- and OpenSSL uses it if it's running on a systems without /dev/random.
- Therefore we should get rid of the ENSURE-INITIALIZED and just
- put an excerpt from the OpenSSL docs about what software should
- be installed on the systems without /dev/random.
-- The stream-fd function is confusing when it's called with ssl-stream as
- a parameter; a developer might think this function allows to retrieve a
- socket file descriptor from an ssl-strem, but this function is implemented
- only for "native" socket streams provided by the Lisp implementation.
- Makes sense to implement it for ssl-stream too.
-- The ssl-error-syscall condition uses (err-get-error) in it's :report
- function. This is not correct; (err-get-error) should be queried
- when the error occurs. The result might be stored in a slot of
- the ssl-error-syscall and printed by the :report function.
-- Fix LispBIO.
-- Extract the low-level SSL code into a separate library that supports
- both OpenSSL and GnuTLS (maybe into two thin FFI libraries).
-- Implement SSL in IOLib adding an API system that only defines stubs that
- signal an error, and adding implementation systems using the before
- mentioned thin FFI wrapper libraries. IOLib doesn't support windows,
- therefore with this plan we will either need to drop Windows support
- (at tleast for the IOLib based asynch subset of features), or
- implement Windows support in IOLib.
(DIR) diff --git a/3rdparties/software/flexi-streams-20190107-git/CHANGELOG b/3rdparties/software/flexi-streams-20190107-git/CHANGELOG
@@ -1,297 +0,0 @@
-Version 1.0.18
-2018-12-12
-peek-byte for in-memory streams (Christopher Eames)
-
-Version 1.0.17
-2018-06-05
-Fixes to octets-to-string.
-
-Version 1.0.16
-2016-12-19
-Remove (safety 0). (Stas Boukarev)
-Don't assume simple vectors in output-stream-sequence-length. (Stas Boukarev)
-Produce an error when loaded on implementations without unicode. (Stas Boukarev)
-
-Version 1.0.15
-2015-07-01
-Support strings as external-format name specifiers (LispAlien)
-
-Version 1.0.14
-2014-11-28
-update support information (Hans Huebner)
-
-Version 1.0.13
-2014-05-18
-fix version number (Hans Huebner)
-
-Version 1.0.12
-2013-12-30
-Update :description
-
-Version 1.0.11
-2013-12-30
-Don't reset column to NIL on internal write operations (Anton Vodonosov)
-
-Version 1.0.10
-2013-12-09
-Fix file-position errors (markv)
-
-Version 1.0.9
-2013-11-21
-Dummy release without any functional changes
-
-Version 1.0.8
-Make write-sequence call transform-octet (Jason Miller)
-Fix for CMUCL (Raymond Toy, Xu Jingtao)
-
-Version 1.0.7
-2008-08-26
-Don't read a second time if the first READ-SEQUENCE already reached EOF (Drakma bug report by Stas Boukarev)
-
-Version 1.0.6
-2008-08-25
-Don't use a reserve if we can't rewind the stream (Drakma bug report by Stas Boukarev)
-
-Version 1.0.5
-2008-08-01
-Export RUN-ALL-TESTS instead of RUN-TESTS (caught by Nick Allen)
-
-Version 1.0.4
-2008-07-25
-Cosmetic surgery on test suite
-
-Version 1.0.3
-2008-05-30
-Better checks for invalid UTF-8 data
-New restart ACCEPT-OVERLONG-SEQUENCE
-More tests
-Unused variable in CHECK-END
-
-Version 1.0.2
-2008-05-26
-Removed unnecessary test
-
-Version 1.0.1
-2008-05-26
-Removed two faulty declarations
-
-Version 1.0.0
-2008-05-26
-More redesign for the sake of performance
-More checks for invalid data
-More tests
-Exported functions for length computation
-
-Version 0.15.3
-2008-05-23
-Avoid CHANGE-CLASS on LispWorks if possible
-
-Version 0.15.2
-2008-05-22
-Remove debugging remnants (d'ooh!)
-
-Version 0.15.1
-2008-05-21
-Direct access to underlying stream in case of binary sequence operations
-More tests
-
-Version 0.15.0
-2008-05-21
-Complete redesign, various additions, bugfixes, performance improvements (with the help of Hans Hbner)
-
-Version 0.14.0
-2007-12-30
-Some fixes for LispWorks (when the underlying stream is a character stream)
-Optimized methods for UNREAD-CHAR% in case of 8-bit encodings
-More tests
-
-Version 0.13.1
-2007-10-11
-Small fix for AllegroCL's "modern" mode
-
-Version 0.13.0
-2007-09-13
-Better optimizations for STREAM-WRITE-SEQUENCE (thanks to Anton Vodonosov)
-Bugfix for STREAM-WRITE-BYTE
-
-Version 0.12.0
-2007-09-07
-Added "bound" for flexi input streams
-
-Version 0.11.2
-2007-04-06
-Fixed bug in STREAM-WRITE-STRING implementation (reported by quasi)
-
-Version 0.11.1
-2007-03-22
-More ugliness for a bit of output performance in special cases
-
-Version 0.11.0
-2007-03-09
-Re-factoring of how encoding errors are handled (patch by Anton Vodonosov)
-
-Version 0.10.3
-2007-02-19
-Fixed bug in UTF-16 output (patch by Stelian Ionescu)
-Fixed *SUBSTITUTION-CHAR* example in docs
-
-Version 0.10.2
-2007-01-12
-Another fix - sigh...
-
-Version 0.10.1
-2007-01-11
-Fixed the last change (thanks to Red Daly)
-
-Version 0.10.0
-2007-01-10
-Added transformers to in-memory streams (thanks to Chris Dean)
-Documentation fixes
-
-Version 0.9.1
-2006-12-27
-More performance improvements (thanks to Robert J. Macomber for SBCL hints)
-
-Version 0.9.0
-2006-12-27
-Complete re-factoring to improve performance and reduce consing (at least for LispWorks)
-Added some tests
-Added *PROVIDE-USE-VALUE-RESTART*
-Added FLEXI-STREAM-POSITION-SPEC-ERROR condition
-
-Version 0.8.0
-2006-11-14
-Added USE-VALUE restart for STREAM-READ-CHAR (thanks to Anton Vodonosov)
-Added *SUBSTITUTION-CHAR*
-
-Version 0.7.2
-2006-11-06
-Removed unnecessary CHECK-EOF-NO-HANG also for in-memory streams (see 0.5.8)
-
-Version 0.7.1
-2006-10-31
-Argh, missed the most important part...
-
-Version 0.7.0
-2006-10-31
-Added KOI8-R (thanks to Igor Plekhov)
-
-Version 0.6.6
-2006-10-06
-Made sure not to apply Gray stream generic function to underlying stream
-
-Version 0.6.5
-2006-10-06
-Optimized STREAM-WRITE-SEQUENCE and STREAM-READ-SEQUENCE for arrays of octets
-
-Version 0.6.4
-2006-10-05
-Made READ-BYTE/WRITE-BYTE the default behaviour, i.e. we only use the sequence functions for LW if necessary
-
-Version 0.6.3
-2006-10-02
-Fixed problems with CMUCL Gray streams implementation (reported by Ivan Toshkov)
-
-Version 0.6.2
-2006-09-23
-Added method for MAKE-LOAD-FORM which is needed for OpenMCL (reported by Robert Synnott, see Drakma mailing list)
-
-Version 0.6.1
-2006-09-15
-Switched FILE-POSITION implementation to TRIVIAL-GRAY-STREAMS (thanks to David Lichteblau)
-
-Version 0.6.0
-2006-09-13
-Implemented file positions for LispWorks
-
-Version 0.5.10
-2006-09-04
-Flexi streams can have binary element types now
-
-Version 0.5.9
-2006-09-01
-Added string functions
-
-Version 0.5.8
-2006-09-01
-CHECK-EOF-NO-HANG is not necessary
-Updated LW links in documentation
-Changed package handling in system definition (thanks to Christophe Rhodes)
-
-Version 0.5.7
-2006-06-29
-Removed incompatibility with AllegroCL, see mailing list archive for details
-
-Version 0.5.6
-2006-06-13
-Fixed Emacs mode lines (reported by Robert Goldman)
-
-Version 0.5.5
-2006-05-24
-Some small fixes for LW
-
-Version 0.5.4
-2006-05-18
-Workaround for CMUCL (thanks to Satyaki Das)
-
-Version 0.5.3
-2006-03-06
-Fixed more typos in stream.lisp
-Added missing exports in packages.lisp
-
-Version 0.5.2
-2006-01-26
-Fixed typos in stream.lisp (thanks to James Bielman)
-
-Version 0.5.1
-2005-12-14
-Some bugfixes in output.lisp (thanks to Jan Idzikowski)
-
-Version 0.5.0
-2005-12-11
-Added in-memory streams
-Exported types
-Added specific conditions
-
-Version 0.4.1
-2005-12-05
-Updated docs
-
-Version 0.4.0
-2005-12-05
-Added US-ASCII encoding
-Added *USE-REPLACEMENT-CHAR*
-
-Version 0.3.0
-2005-11-26
-Added UNREAD-BYTE and PEEK-BYTE
-
-Version 0.2.4
-2005-11-26
-WIN32:CODE-PAGE only for LispWorks
-
-Version 0.2.3
-2005-11-26
-Added STREAM-TERPRI to appease AllegroCL
-Fixed typo in docs
-
-Version 0.2.2
-2005-11-26
-Patch to make class precendence list work in AllegroCL (David Lichteblau)
-
-Version 0.2.1
-2005-11-25
-Adapted to new TRIVIAL-GRAY-STREAMS API (David Lichteblau)
-More changes for portability, specifically for SBCL (David Lichteblau)
-
-Version 0.2.0
-2005-11-25
-Portable version thanks to TRIVIAL-GRAY-STREAMS (David Lichteblau)
-
-Version 0.1.1
-2005-11-25
-Documentation enhancements
-
-Version 0.1.0
-2005-11-25
-Initial public release
(DIR) diff --git a/3rdparties/software/flexi-streams-20190107-git/README.md b/3rdparties/software/flexi-streams-20190107-git/README.md
@@ -1,12 +0,0 @@
----------------------------------------------------------
-FLEXI-STREAMS - Flexible bivalent streams for Common Lisp
----------------------------------------------------------
-
-FLEXI-STREAMS implements "virtual" bivalent streams that can be
-layered atop real binary or bivalent streams and that can be used to
-read and write character data in various single- or multi-octet
-encodings which can be changed on the fly. It also supplies in-memory
-binary streams which are similar to string streams.
-
-Complete documentation for CL-INTERPOL can be found in the `docs`
-directory or at the [project documentation site](https://edicl.github.io/flexi-streams/).
-\ No newline at end of file
(DIR) diff --git a/3rdparties/software/flexi-streams-20190107-git/ascii.lisp b/3rdparties/software/flexi-streams-20190107-git/ascii.lisp
@@ -1,36 +0,0 @@
-;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: FLEXI-STREAMS; Base: 10 -*-
-;;; $Header: /usr/local/cvsrep/flexi-streams/ascii.lisp,v 1.9 2008/05/18 21:32:15 edi Exp $
-
-;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved.
-
-;;; Redistribution and use in source and binary forms, with or without
-;;; modification, are permitted provided that the following conditions
-;;; are met:
-
-;;; * Redistributions of source code must retain the above copyright
-;;; notice, this list of conditions and the following disclaimer.
-
-;;; * Redistributions in binary form must reproduce the above
-;;; copyright notice, this list of conditions and the following
-;;; disclaimer in the documentation and/or other materials
-;;; provided with the distribution.
-
-;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED
-;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
-;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
-;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
-;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
-;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
-;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
-;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
-;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
-;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
-;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-
-(in-package :flexi-streams)
-
-(defconstant +ascii-table+
- ;; currently not used, but we leave it in here just in case...
- (make-decoding-table '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533))
- "An array enumerating the character codes for the US-ASCII
-encoding.")
(DIR) diff --git a/3rdparties/software/flexi-streams-20190107-git/code-pages.lisp b/3rdparties/software/flexi-streams-20190107-git/code-pages.lisp
@@ -1,62 +0,0 @@
-;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: FLEXI-STREAMS; Base: 10 -*-
-;;; $Header: /usr/local/cvsrep/flexi-streams/code-pages.lisp,v 1.7 2008/05/18 21:32:15 edi Exp $
-
-;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved.
-
-;;; Redistribution and use in source and binary forms, with or without
-;;; modification, are permitted provided that the following conditions
-;;; are met:
-
-;;; * Redistributions of source code must retain the above copyright
-;;; notice, this list of conditions and the following disclaimer.
-
-;;; * Redistributions in binary form must reproduce the above
-;;; copyright notice, this list of conditions and the following
-;;; disclaimer in the documentation and/or other materials
-;;; provided with the distribution.
-
-;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED
-;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
-;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
-;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
-;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
-;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
-;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
-;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
-;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
-;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
-;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-
-(in-package :flexi-streams)
-
-;;; the following code was auto-generated with LWW
-
-(defconstant +code-page-tables+
- `((437 . ,(make-decoding-table '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 199 252 233 226 228 224 229 231 234 235 232 239 238 236 196 197 201 230 198 244 246 242 251 249 255 214 220 162 163 165 8359 402 225 237 243 250 241 209 170 186 191 8976 172 189 188 161 171 187 9617 9618 9619 9474 9508 9569 9570 9558 9557 9571 9553 9559 9565 9564 9563 9488 9492 9524 9516 9500 9472 9532 9566 9567 9562 9556 9577 9574 9568 9552 9580 9575 9576 9572 9573 9561 9560 9554 9555 9579 9578 9496 9484 9608 9604 9612 9616 9600 945 223 915 960 931 963 181 964 934 920 937 948 8734 966 949 8745 8801 177 8805 8804 8992 8993 247 8776 176 8729 183 8730 8319 178 9632 160)))
- (720 . ,(make-decoding-table '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 233 226 132 224 134 231 234 235 232 239 238 141 142 143 144 1617 1618 244 164 1600 251 249 1569 1570 1571 1572 163 1573 1574 1575 1576 1577 1578 1579 1580 1581 1582 1583 1584 1585 1586 1587 1588 1589 171 187 9617 9618 9619 9474 9508 9569 9570 9558 9557 9571 9553 9559 9565 9564 9563 9488 9492 9524 9516 9500 9472 9532 9566 9567 9562 9556 9577 9574 9568 9552 9580 9575 9576 9572 9573 9561 9560 9554 9555 9579 9578 9496 9484 9608 9604 9612 9616 9600 1590 1591 1592 1593 1594 1601 181 1602 1603 1604 1605 1606 1607 1608 1609 1610 8801 1611 1612 1613 1614 1615 1616 8776 176 8729 183 8730 8319 178 9632 160)))
- (737 . ,(make-decoding-table '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 913 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 931 932 933 934 935 936 937 945 946 947 948 949 950 951 952 953 954 955 956 957 958 959 960 961 963 962 964 965 966 967 968 9617 9618 9619 9474 9508 9569 9570 9558 9557 9571 9553 9559 9565 9564 9563 9488 9492 9524 9516 9500 9472 9532 9566 9567 9562 9556 9577 9574 9568 9552 9580 9575 9576 9572 9573 9561 9560 9554 9555 9579 9578 9496 9484 9608 9604 9612 9616 9600 969 940 941 942 970 943 972 973 971 974 902 904 905 906 908 910 911 177 8805 8804 938 939 247 8776 176 8729 183 8730 8319 178 9632 160)))
- (775 . ,(make-decoding-table '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 262 252 233 257 228 291 229 263 322 275 342 343 299 377 196 197 201 230 198 333 246 290 162 346 347 214 220 248 163 216 215 164 256 298 243 379 380 378 8221 166 169 174 172 189 188 321 171 187 9617 9618 9619 9474 9508 260 268 280 278 9571 9553 9559 9565 302 352 9488 9492 9524 9516 9500 9472 9532 370 362 9562 9556 9577 9574 9568 9552 9580 381 261 269 281 279 303 353 371 363 382 9496 9484 9608 9604 9612 9616 9600 211 223 332 323 245 213 181 324 310 311 315 316 326 274 325 8217 173 177 8220 190 182 167 247 8222 176 8729 183 185 179 178 9632 160)))
- (850 . ,(make-decoding-table '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 199 252 233 226 228 224 229 231 234 235 232 239 238 236 196 197 201 230 198 244 246 242 251 249 255 214 220 248 163 216 215 402 225 237 243 250 241 209 170 186 191 174 172 189 188 161 171 187 9617 9618 9619 9474 9508 193 194 192 169 9571 9553 9559 9565 162 165 9488 9492 9524 9516 9500 9472 9532 227 195 9562 9556 9577 9574 9568 9552 9580 164 240 208 202 203 200 305 205 206 207 9496 9484 9608 9604 166 204 9600 211 223 212 210 245 213 181 254 222 218 219 217 253 221 175 180 173 177 8215 190 182 167 247 184 176 168 183 185 179 178 9632 160)))
- (852 . ,(make-decoding-table '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 199 252 233 226 228 367 263 231 322 235 336 337 238 377 196 262 201 313 314 244 246 317 318 346 347 214 220 356 357 321 215 269 225 237 243 250 260 261 381 382 280 281 172 378 268 351 171 187 9617 9618 9619 9474 9508 193 194 282 350 9571 9553 9559 9565 379 380 9488 9492 9524 9516 9500 9472 9532 258 259 9562 9556 9577 9574 9568 9552 9580 164 273 272 270 203 271 327 205 206 283 9496 9484 9608 9604 354 366 9600 211 223 212 323 324 328 352 353 340 218 341 368 253 221 355 180 173 733 731 711 728 167 247 184 176 168 729 369 344 345 9632 160)))
- (855 . ,(make-decoding-table '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 1106 1026 1107 1027 1105 1025 1108 1028 1109 1029 1110 1030 1111 1031 1112 1032 1113 1033 1114 1034 1115 1035 1116 1036 1118 1038 1119 1039 1102 1070 1098 1066 1072 1040 1073 1041 1094 1062 1076 1044 1077 1045 1092 1060 1075 1043 171 187 9617 9618 9619 9474 9508 1093 1061 1080 1048 9571 9553 9559 9565 1081 1049 9488 9492 9524 9516 9500 9472 9532 1082 1050 9562 9556 9577 9574 9568 9552 9580 164 1083 1051 1084 1052 1085 1053 1086 1054 1087 9496 9484 9608 9604 1055 1103 9600 1071 1088 1056 1089 1057 1090 1058 1091 1059 1078 1046 1074 1042 1100 1068 8470 173 1099 1067 1079 1047 1096 1064 1101 1069 1097 1065 1095 1063 167 9632 160)))
- (857 . ,(make-decoding-table '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 199 252 233 226 228 224 229 231 234 235 232 239 238 305 196 197 201 230 198 244 246 242 251 249 304 214 220 248 163 216 350 351 225 237 243 250 241 209 286 287 191 174 172 189 188 161 171 187 9617 9618 9619 9474 9508 193 194 192 169 9571 9553 9559 9565 162 165 9488 9492 9524 9516 9500 9472 9532 227 195 9562 9556 9577 9574 9568 9552 9580 164 186 170 202 203 200 65533 205 206 207 9496 9484 9608 9604 166 204 9600 211 223 212 210 245 213 181 65533 215 218 219 217 236 255 175 180 173 177 65533 190 182 167 247 184 176 168 183 185 179 178 9632 160)))
- (860 . ,(make-decoding-table '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 199 252 233 226 227 224 193 231 234 202 232 205 212 236 195 194 201 192 200 244 245 242 218 249 204 213 220 162 163 217 8359 211 225 237 243 250 241 209 170 186 191 210 172 189 188 161 171 187 9617 9618 9619 9474 9508 9569 9570 9558 9557 9571 9553 9559 9565 9564 9563 9488 9492 9524 9516 9500 9472 9532 9566 9567 9562 9556 9577 9574 9568 9552 9580 9575 9576 9572 9573 9561 9560 9554 9555 9579 9578 9496 9484 9608 9604 9612 9616 9600 945 223 915 960 931 963 181 964 934 920 937 948 8734 966 949 8745 8801 177 8805 8804 8992 8993 247 8776 176 8729 183 8730 8319 178 9632 160)))
- (861 . ,(make-decoding-table '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 199 252 233 226 228 224 229 231 234 235 232 208 240 222 196 197 201 230 198 244 246 254 251 221 253 214 220 248 163 216 8359 402 225 237 243 250 193 205 211 218 191 8976 172 189 188 161 171 187 9617 9618 9619 9474 9508 9569 9570 9558 9557 9571 9553 9559 9565 9564 9563 9488 9492 9524 9516 9500 9472 9532 9566 9567 9562 9556 9577 9574 9568 9552 9580 9575 9576 9572 9573 9561 9560 9554 9555 9579 9578 9496 9484 9608 9604 9612 9616 9600 945 223 915 960 931 963 181 964 934 920 937 948 8734 966 949 8745 8801 177 8805 8804 8992 8993 247 8776 176 8729 183 8730 8319 178 9632 160)))
- (862 . ,(make-decoding-table '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 1488 1489 1490 1491 1492 1493 1494 1495 1496 1497 1498 1499 1500 1501 1502 1503 1504 1505 1506 1507 1508 1509 1510 1511 1512 1513 1514 162 163 165 8359 402 225 237 243 250 241 209 170 186 191 8976 172 189 188 161 171 187 9617 9618 9619 9474 9508 9569 9570 9558 9557 9571 9553 9559 9565 9564 9563 9488 9492 9524 9516 9500 9472 9532 9566 9567 9562 9556 9577 9574 9568 9552 9580 9575 9576 9572 9573 9561 9560 9554 9555 9579 9578 9496 9484 9608 9604 9612 9616 9600 945 223 915 960 931 963 181 964 934 920 937 948 8734 966 949 8745 8801 177 8805 8804 8992 8993 247 8776 176 8729 183 8730 8319 178 9632 160)))
- (863 . ,(make-decoding-table '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 199 252 233 226 194 224 182 231 234 235 232 239 238 8215 192 167 201 200 202 244 203 207 251 249 164 212 220 162 163 217 219 402 166 180 243 250 168 184 179 175 206 8976 172 189 188 190 171 187 9617 9618 9619 9474 9508 9569 9570 9558 9557 9571 9553 9559 9565 9564 9563 9488 9492 9524 9516 9500 9472 9532 9566 9567 9562 9556 9577 9574 9568 9552 9580 9575 9576 9572 9573 9561 9560 9554 9555 9579 9578 9496 9484 9608 9604 9612 9616 9600 945 223 915 960 931 963 181 964 934 920 937 948 8734 966 949 8745 8801 177 8805 8804 8992 8993 247 8776 176 8729 183 8730 8319 178 9632 160)))
- (864 . ,(make-decoding-table '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 176 183 8729 8730 9618 9472 9474 9532 9508 9516 9500 9524 9488 9484 9492 9496 946 8734 966 177 189 188 8776 171 187 65271 65272 155 156 65275 65276 159 160 173 65154 163 164 65156 65533 65533 65166 65167 65173 65177 1548 65181 65185 65189 1632 1633 1634 1635 1636 1637 1638 1639 1640 1641 65233 1563 65201 65205 65209 1567 162 65152 65153 65155 65157 65226 65163 65165 65169 65171 65175 65179 65183 65187 65191 65193 65195 65197 65199 65203 65207 65211 65215 65217 65221 65227 65231 166 172 247 215 65225 1600 65235 65239 65243 65247 65251 65255 65259 65261 65263 65267 65213 65228 65230 65229 65249 65149 1617 65253 65257 65260 65264 65266 65232 65237 65269 65270 65245 65241 65265 9632 65533)))
- (865 . ,(make-decoding-table '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 199 252 233 226 228 224 229 231 234 235 232 239 238 236 196 197 201 230 198 244 246 242 251 249 255 214 220 248 163 216 8359 402 225 237 243 250 241 209 170 186 191 8976 172 189 188 161 171 164 9617 9618 9619 9474 9508 9569 9570 9558 9557 9571 9553 9559 9565 9564 9563 9488 9492 9524 9516 9500 9472 9532 9566 9567 9562 9556 9577 9574 9568 9552 9580 9575 9576 9572 9573 9561 9560 9554 9555 9579 9578 9496 9484 9608 9604 9612 9616 9600 945 223 915 960 931 963 181 964 934 920 937 948 8734 966 949 8745 8801 177 8805 8804 8992 8993 247 8776 176 8729 183 8730 8319 178 9632 160)))
- (866 . ,(make-decoding-table '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079 1080 1081 1082 1083 1084 1085 1086 1087 9617 9618 9619 9474 9508 9569 9570 9558 9557 9571 9553 9559 9565 9564 9563 9488 9492 9524 9516 9500 9472 9532 9566 9567 9562 9556 9577 9574 9568 9552 9580 9575 9576 9572 9573 9561 9560 9554 9555 9579 9578 9496 9484 9608 9604 9612 9616 9600 1088 1089 1090 1091 1092 1093 1094 1095 1096 1097 1098 1099 1100 1101 1102 1103 1025 1105 1028 1108 1031 1111 1038 1118 176 8729 183 8730 8470 164 9632 160)))
- (869 . ,(make-decoding-table '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 902 135 183 172 166 8216 8217 904 8213 905 906 938 908 147 148 910 939 169 911 178 179 940 163 941 942 943 970 912 972 973 913 914 915 916 917 918 919 189 920 921 171 187 9617 9618 9619 9474 9508 922 923 924 925 9571 9553 9559 9565 926 927 9488 9492 9524 9516 9500 9472 9532 928 929 9562 9556 9577 9574 9568 9552 9580 931 932 933 934 935 936 937 945 946 947 9496 9484 9608 9604 948 949 9600 950 951 952 953 954 955 956 957 958 959 960 961 963 962 964 900 173 177 965 966 967 167 968 901 176 168 969 971 944 974 9632 160)))
- (1250 . ,(make-decoding-table '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 8364 129 8218 131 8222 8230 8224 8225 136 8240 352 8249 346 356 381 377 144 8216 8217 8220 8221 8226 8211 8212 152 8482 353 8250 347 357 382 378 160 711 728 321 164 260 166 167 168 169 350 171 172 173 174 379 176 177 731 322 180 181 182 183 184 261 351 187 317 733 318 380 340 193 194 258 196 313 262 199 268 201 280 203 282 205 206 270 272 323 327 211 212 336 214 215 344 366 218 368 220 221 354 223 341 225 226 259 228 314 263 231 269 233 281 235 283 237 238 271 273 324 328 243 244 337 246 247 345 367 250 369 252 253 355 729)))
- (1251 . ,(make-decoding-table '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 1026 1027 8218 1107 8222 8230 8224 8225 8364 8240 1033 8249 1034 1036 1035 1039 1106 8216 8217 8220 8221 8226 8211 8212 152 8482 1113 8250 1114 1116 1115 1119 160 1038 1118 1032 164 1168 166 167 1025 169 1028 171 172 173 174 1031 176 177 1030 1110 1169 181 182 183 1105 8470 1108 187 1112 1029 1109 1111 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079 1080 1081 1082 1083 1084 1085 1086 1087 1088 1089 1090 1091 1092 1093 1094 1095 1096 1097 1098 1099 1100 1101 1102 1103)))
- (1252 . ,(make-decoding-table '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 8364 129 8218 402 8222 8230 8224 8225 710 8240 352 8249 338 141 381 143 144 8216 8217 8220 8221 8226 8211 8212 732 8482 353 8250 339 157 382 376 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255)))
- (1253 . ,(make-decoding-table '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 8364 129 8218 402 8222 8230 8224 8225 136 8240 138 8249 140 141 142 143 144 8216 8217 8220 8221 8226 8211 8212 152 8482 154 8250 156 157 158 159 160 901 902 163 164 165 166 167 168 169 65533 171 172 173 174 8213 176 177 178 179 900 181 182 183 904 905 906 187 908 189 910 911 912 913 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 65533 931 932 933 934 935 936 937 938 939 940 941 942 943 944 945 946 947 948 949 950 951 952 953 954 955 956 957 958 959 960 961 962 963 964 965 966 967 968 969 970 971 972 973 974 65533)))
- (1254 . ,(make-decoding-table '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 8364 129 8218 402 8222 8230 8224 8225 710 8240 352 8249 338 141 142 143 144 8216 8217 8220 8221 8226 8211 8212 732 8482 353 8250 339 157 158 376 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 286 209 210 211 212 213 214 215 216 217 218 219 220 304 350 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 287 241 242 243 244 245 246 247 248 249 250 251 252 305 351 255)))
- (1255 . ,(make-decoding-table '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 8364 129 8218 402 8222 8230 8224 8225 710 8240 138 8249 140 141 142 143 144 8216 8217 8220 8221 8226 8211 8212 732 8482 154 8250 156 157 158 159 160 161 162 163 8362 165 166 167 168 169 215 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 247 187 188 189 190 191 1456 1457 1458 1459 1460 1461 1462 1463 1464 1465 1466 1467 1468 1469 1470 1471 1472 1473 1474 1475 1520 1521 1522 1523 1524 65533 65533 65533 65533 65533 65533 65533 1488 1489 1490 1491 1492 1493 1494 1495 1496 1497 1498 1499 1500 1501 1502 1503 1504 1505 1506 1507 1508 1509 1510 1511 1512 1513 1514 65533 65533 8206 8207 65533)))
- (1256 . ,(make-decoding-table '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 8364 1662 8218 402 8222 8230 8224 8225 710 8240 1657 8249 338 1670 1688 1672 1711 8216 8217 8220 8221 8226 8211 8212 1705 8482 1681 8250 339 8204 8205 1722 160 1548 162 163 164 165 166 167 168 169 1726 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 1563 187 188 189 190 1567 1729 1569 1570 1571 1572 1573 1574 1575 1576 1577 1578 1579 1580 1581 1582 1583 1584 1585 1586 1587 1588 1589 1590 215 1591 1592 1593 1594 1600 1601 1602 1603 224 1604 226 1605 1606 1607 1608 231 232 233 234 235 1609 1610 238 239 1611 1612 1613 1614 244 1615 1616 247 1617 249 1618 251 252 8206 8207 1746)))
- (1257 . ,(make-decoding-table '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 8364 129 8218 131 8222 8230 8224 8225 136 8240 138 8249 140 168 711 184 144 8216 8217 8220 8221 8226 8211 8212 152 8482 154 8250 156 175 731 159 160 65533 162 163 164 65533 166 167 216 169 342 171 172 173 174 198 176 177 178 179 180 181 182 183 248 185 343 187 188 189 190 230 260 302 256 262 196 197 280 274 268 201 377 278 290 310 298 315 352 323 325 211 332 213 214 215 370 321 346 362 220 379 381 223 261 303 257 263 228 229 281 275 269 233 378 279 291 311 299 316 353 324 326 243 333 245 246 247 371 322 347 363 252 380 382 729)))
- (1258 . ,(make-decoding-table '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 8364 129 8218 402 8222 8230 8224 8225 710 8240 138 8249 338 141 142 143 144 8216 8217 8220 8221 8226 8211 8212 732 8482 154 8250 339 157 158 376 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 258 196 197 198 199 200 201 202 203 768 205 206 207 272 209 777 211 212 416 214 215 216 217 218 219 220 431 771 223 224 225 226 259 228 229 230 231 232 233 234 235 769 237 238 239 273 241 803 243 244 417 246 247 248 249 250 251 252 432 8363 255))))
- "A list of 8-bit Windows code pages where each element is a
-cons with the car being the ID of the code page and the cdr being
-a vector enumerating the corresponding character codes.")
(DIR) diff --git a/3rdparties/software/flexi-streams-20190107-git/conditions.lisp b/3rdparties/software/flexi-streams-20190107-git/conditions.lisp
@@ -1,108 +0,0 @@
-;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: FLEXI-STREAMS; Base: 10 -*-
-;;; $Header: /usr/local/cvsrep/flexi-streams/conditions.lisp,v 1.9 2008/05/25 22:23:58 edi Exp $
-
-;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved.
-
-;;; Redistribution and use in source and binary forms, with or without
-;;; modification, are permitted provided that the following conditions
-;;; are met:
-
-;;; * Redistributions of source code must retain the above copyright
-;;; notice, this list of conditions and the following disclaimer.
-
-;;; * Redistributions in binary form must reproduce the above
-;;; copyright notice, this list of conditions and the following
-;;; disclaimer in the documentation and/or other materials
-;;; provided with the distribution.
-
-;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED
-;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
-;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
-;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
-;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
-;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
-;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
-;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
-;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
-;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
-;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-
-(in-package :flexi-streams)
-
-(define-condition flexi-stream-error (stream-error)
- ()
- (:documentation "Superclass for all errors related to flexi
-streams."))
-
-(define-condition flexi-stream-simple-error (flexi-stream-error simple-condition)
- ()
- (:documentation "Like FLEXI-STREAM-ERROR but with formatting
-capabilities."))
-
-(define-condition flexi-stream-element-type-error (flexi-stream-error)
- ((element-type :initarg :element-type
- :reader flexi-stream-element-type-error-element-type))
- (:report (lambda (condition stream)
- (format stream "Element type ~S not allowed."
- (flexi-stream-element-type-error-element-type condition))))
- (:documentation "Errors of this type are signalled if the flexi
-stream has a wrong element type."))
-
-(define-condition flexi-stream-out-of-sync-error (flexi-stream-error)
- ()
- (:report (lambda (condition stream)
- (declare (ignore condition))
- (format stream "Stream out of sync from previous
-lookahead, couldn't rewind.")))
- (:documentation "This can happen if you're trying to write to an IO
-stream which had prior to that `looked ahead' while reading and now
-can't `rewind' to the octet where you /should/ be."))
-
-(define-condition in-memory-stream-error (stream-error)
- ()
- (:documentation "Superclass for all errors related to
-IN-MEMORY streams."))
-
-(define-condition in-memory-stream-simple-error (in-memory-stream-error simple-condition)
- ()
- (:documentation "Like IN-MEMORY-STREAM-ERROR but with formatting
-capabilities."))
-
-(define-condition in-memory-stream-closed-error (in-memory-stream-error)
- ()
- (:report (lambda (condition stream)
- (format stream "~S is closed."
- (stream-error-stream condition))))
- (:documentation "An error that is signalled when someone is trying
-to read from or write to a closed IN-MEMORY stream."))
-
-(define-condition in-memory-stream-position-spec-error (in-memory-stream-simple-error)
- ((position-spec :initarg :position-spec
- :reader in-memory-stream-position-spec-error-position-spec))
- (:documentation "Errors of this type are signalled if an erroneous
-position spec is used in conjunction with FILE-POSITION."))
-
-(define-condition external-format-condition (simple-condition)
- ((external-format :initarg :external-format
- :initform nil
- :reader external-format-condition-external-format))
- (:documentation "Superclass for all conditions related to external
-formats."))
-
-(define-condition external-format-error (external-format-condition error)
- ()
- (:documentation "Superclass for all errors related to external
-formats."))
-
-(define-condition external-format-encoding-error (external-format-error)
- ()
- (:documentation "Errors of this type are signalled if there is an
-encoding problem."))
-
-(defun signal-encoding-error (external-format format-control &rest format-args)
- "Convenience function similar to ERROR to signal conditions of type
-EXTERNAL-FORMAT-ENCODING-ERROR."
- (error 'external-format-encoding-error
- :format-control format-control
- :format-arguments format-args
- :external-format external-format))
(DIR) diff --git a/3rdparties/software/flexi-streams-20190107-git/decode.lisp b/3rdparties/software/flexi-streams-20190107-git/decode.lisp
@@ -1,468 +0,0 @@
-;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: FLEXI-STREAMS; Base: 10 -*-
-;;; $Header: /usr/local/cvsrep/flexi-streams/decode.lisp,v 1.35 2008/08/26 10:59:22 edi Exp $
-
-;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved.
-
-;;; Redistribution and use in source and binary forms, with or without
-;;; modification, are permitted provided that the following conditions
-;;; are met:
-
-;;; * Redistributions of source code must retain the above copyright
-;;; notice, this list of conditions and the following disclaimer.
-
-;;; * Redistributions in binary form must reproduce the above
-;;; copyright notice, this list of conditions and the following
-;;; disclaimer in the documentation and/or other materials
-;;; provided with the distribution.
-
-;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED
-;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
-;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
-;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
-;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
-;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
-;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
-;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
-;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
-;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
-;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-
-(in-package :flexi-streams)
-
-(defun recover-from-encoding-error (external-format format-control &rest format-args)
- "Helper function used by OCTETS-TO-CHAR-CODE below to deal with
-encoding errors. Checks if *SUBSTITUTION-CHAR* is not NIL and returns
-its character code in this case. Otherwise signals an
-EXTERNAL-FORMAT-ENCODING-ERROR as determined by the arguments to this
-function and provides a corresponding USE-VALUE restart."
- (when *substitution-char*
- (return-from recover-from-encoding-error (char-code *substitution-char*)))
- (restart-case
- (apply #'signal-encoding-error external-format format-control format-args)
- (use-value (char)
- :report "Specify a character to be used instead."
- :interactive (lambda ()
- (loop
- (format *query-io* "Type a character: ")
- (let ((line (read-line *query-io*)))
- (when (= 1 (length line))
- (return (list (char line 0)))))))
- (char-code char))))
-
-(defgeneric octets-to-char-code (format reader)
- (declare #.*standard-optimize-settings*)
- (:documentation "Converts a sequence of octets to a character code
-\(which is returned, or NIL in case of EOF) using the external format
-FORMAT. The sequence is obtained by calling the function \(which must
-be a functional object) READER with no arguments which should return
-one octet per call. In the case of EOF, READER should return NIL.
-
-The special variable *CURRENT-UNREADER* must be bound correctly
-whenever this function is called."))
-
-(defgeneric octets-to-string* (format sequence start end)
- (declare #.*standard-optimize-settings*)
- (:documentation "A generic function which dispatches on the external
-format and does the real work for OCTETS-TO-STRING."))
-
-(defmethod octets-to-string* :around (format (list list) start end)
- (declare #.*standard-optimize-settings*)
- (octets-to-string* format (coerce list 'vector) start end))
-
-(defmacro define-sequence-readers ((format-class) &body body)
- "Non-hygienic utility macro which defines methods for READ-SEQUENCE*
-and OCTETS-TO-STRING* for the class FORMAT-CLASS. BODY is described
-in the docstring of DEFINE-CHAR-ENCODERS but can additionally contain
-a form \(UNGET <form>) which has to be replaced by the correct code to
-`unread' the octets for the character designated by <form>."
- (let* ((body `((block char-decoder
- (locally
- (declare #.*fixnum-optimize-settings*)
- ,@body)))))
- `(progn
- (defmethod read-sequence* ((format ,format-class) flexi-input-stream sequence start end)
- (with-accessors ((position flexi-stream-position)
- (bound flexi-stream-bound)
- (octet-stack flexi-stream-octet-stack)
- (last-octet flexi-stream-last-octet)
- (last-char-code flexi-stream-last-char-code)
- (stream flexi-stream-stream))
- flexi-input-stream
- (let* (buffer
- (buffer-pos 0)
- (buffer-end 0)
- (index start)
- donep
- ;; whether we will later be able to rewind the stream if
- ;; needed (to get rid of unused octets in the buffer)
- (can-rewind-p (maybe-rewind stream 0))
- (factor (encoding-factor format))
- (integer-factor (floor factor))
- ;; it's an interesting question whether it makes sense
- ;; performance-wise to make RESERVE significantly bigger
- ;; (and thus put potentially a lot more octets into
- ;; OCTET-STACK), especially for UTF-8
- (reserve (cond ((or (not (floatp factor))
- (not can-rewind-p)) 0)
- (t (ceiling (* (- factor integer-factor) (- end start)))))))
- (declare (fixnum buffer-pos buffer-end index integer-factor reserve)
- (boolean can-rewind-p))
- (flet ((compute-fill-amount ()
- "Computes the amount of octets we can savely read into
-the buffer without violating the stream's bound \(if there is one) and
-without potentially reading much more than we need \(unless we can
-rewind afterwards)."
- (let ((minimum (min (the fixnum (+ (the fixnum (* integer-factor
- (the fixnum (- end index))))
- reserve))
- +buffer-size+)))
- (cond (bound (min minimum (- bound position)))
- (t minimum))))
- (fill-buffer (end)
- "Tries to fill the buffer from BUFFER-POS to END and
-returns NIL if the buffer doesn't contain any new data."
- (when donep
- (return-from fill-buffer nil))
- ;; put data from octet stack into buffer if there is any
- (loop
- (when (>= buffer-pos end)
- (return))
- (let ((next-octet (pop octet-stack)))
- (cond (next-octet
- (setf (aref (the (array octet *) buffer) buffer-pos) (the octet next-octet))
- (incf buffer-pos))
- (t (return)))))
- (setq buffer-end (read-sequence buffer stream
- :start buffer-pos
- :end end))
- ;; we reached EOF, so we remember this
- (when (< buffer-end end)
- (setq donep t))
- ;; BUFFER-POS is only greater than zero if the buffer
- ;; already contains unread data from the octet stack
- ;; (see below), so we test for ZEROP here and do /not/
- ;; compare with BUFFER-POS
- (unless (zerop buffer-end)
- (incf position buffer-end))))
- (let ((minimum (compute-fill-amount)))
- (declare (fixnum minimum))
- (setq buffer (make-octet-buffer minimum))
- ;; fill buffer for the first time or return immediately if
- ;; we don't succeed
- (unless (fill-buffer minimum)
- (return-from read-sequence* start)))
- (setq buffer-pos 0)
- (macrolet ((iterate (set-place)
- "A very unhygienic macro to implement the
-actual iteration through the sequence including housekeeping for the
-flexi stream. SET-PLACE is the place \(using the index INDEX) used to
-access the sequence."
- `(flet ((leave ()
- "This is the function used to
-abort the LOOP iteration below."
- (when (> index start)
- (setq last-octet nil
- last-char-code ,(sublis '((index . (1- index))) set-place)))
- (return-from read-sequence* index)))
- (loop
- (when (>= index end)
- ;; check if there are octets in the
- ;; buffer we didn't use - see
- ;; COMPUTE-FILL-AMOUNT above
- (let ((rest (- buffer-end buffer-pos)))
- (when (plusp rest)
- (or (and can-rewind-p
- (maybe-rewind stream rest))
- (loop
- (when (>= buffer-pos buffer-end)
- (return))
- (decf buffer-end)
- (push (aref (the (array octet *) buffer) buffer-end)
- octet-stack)))))
- (leave))
- (let ((next-char-code
- (progn (symbol-macrolet
- ((octet-getter
- ;; this is the code to retrieve the next octet (or
- ;; NIL) and to fill the buffer if needed
- (block next-octet
- (when (>= buffer-pos buffer-end)
- (setq buffer-pos 0)
- (unless (fill-buffer (compute-fill-amount))
- (return-from next-octet)))
- (prog1
- (aref (the (array octet *) buffer) buffer-pos)
- (incf buffer-pos)))))
- (macrolet ((unget (form)
- `(unread-char% ,form flexi-input-stream)))
- ,',@body)))))
- (unless next-char-code
- (leave))
- (setf ,set-place (code-char next-char-code))
- (incf index))))))
- (etypecase sequence
- (string (iterate (char sequence index)))
- (array (iterate (aref sequence index)))
- (list (iterate (nth index sequence)))))))))
- (defmethod octets-to-string* ((format ,format-class) sequence start end)
- (declare #.*standard-optimize-settings*)
- (declare (fixnum start end))
- (let* ((i start)
- (string-length (compute-number-of-chars format sequence start end))
- (string (make-array string-length :element-type 'char*)))
- (declare (fixnum i string-length))
- (loop for j of-type fixnum from 0 below string-length
- do (setf (schar string j)
- (code-char (macrolet ((unget (form)
- `(decf i (character-length format ,form))))
- (symbol-macrolet ((octet-getter (and (< i end)
- (prog1
- (the octet (aref sequence i))
- (incf i)))))
- ,@body))))
- finally (return string)))))))
-
-(defmacro define-char-decoders ((lf-format-class cr-format-class crlf-format-class) &body body)
- "Non-hygienic utility macro which defines several decoding-related
-methods for the classes LF-FORMAT-CLASS, CR-FORMAT-CLASS, and
-CRLF-FORMAT-CLASS where it is assumed that CR-FORMAT-CLASS is the same
-encoding as LF-FORMAT-CLASS but with CR instead of LF line endings and
-similar for CRLF-FORMAT-CLASS, i.e. LF-FORMAT-CLASS is the base class.
-BODY is a code template for the code to read octets and return one
-character code. BODY must contain a symbol OCTET-GETTER representing
-the form which is used to obtain the next octet."
- (let* ((body (with-unique-names (char-code)
- `((let ((,char-code (progn ,@body)))
- (when (and ,char-code
- (or (<= #xd8 (logand* #x00ff (ash* ,char-code -8)) #xdf)
- (> ,char-code #x10ffff)))
- (recover-from-encoding-error format "Illegal code point ~A \(#x~:*~X)." ,char-code))
- ,char-code)))))
- `(progn
- (defmethod octets-to-char-code ((format ,lf-format-class) reader)
- (declare #.*fixnum-optimize-settings*)
- (declare (function reader))
- (symbol-macrolet ((octet-getter (funcall reader)))
- ,@(sublis '((char-decoder . octets-to-char-code))
- body)))
- (define-sequence-readers (,lf-format-class) ,@body)
- (define-sequence-readers (,cr-format-class)
- ,(with-unique-names (char-code)
- `(let ((,char-code (progn ,@body)))
- (case ,char-code
- (#.+cr+ #.(char-code #\Newline))
- (otherwise ,char-code)))))
- (define-sequence-readers (,crlf-format-class)
- ,(with-unique-names (char-code next-char-code get-char-code)
- `(flet ((,get-char-code () ,@body))
- (let ((,char-code (,get-char-code)))
- (case ,char-code
- (#.+cr+
- (let ((,next-char-code (,get-char-code)))
- (case ,next-char-code
- (#.+lf+ #.(char-code #\Newline))
- ;; we saw a CR but no LF afterwards, but then the data
- ;; ended, so we just return #\Return
- ((nil) +cr+)
- ;; if the character we peeked at wasn't a
- ;; linefeed character we unread its constituents
- (otherwise (unget (code-char ,next-char-code))
- ,char-code))))
- (otherwise ,char-code)))))))))
-
-(define-char-decoders (flexi-latin-1-format flexi-cr-latin-1-format flexi-crlf-latin-1-format)
- octet-getter)
-
-(define-char-decoders (flexi-ascii-format flexi-cr-ascii-format flexi-crlf-ascii-format)
- (when-let (octet octet-getter)
- (if (> (the octet octet) 127)
- (recover-from-encoding-error format
- "No character which corresponds to octet #x~X." octet)
- octet)))
-
-(define-char-decoders (flexi-8-bit-format flexi-cr-8-bit-format flexi-crlf-8-bit-format)
- (with-accessors ((decoding-table external-format-decoding-table))
- format
- (when-let (octet octet-getter)
- (let ((char-code (aref (the (simple-array char-code-integer *) decoding-table)
- (the octet octet))))
- (if (or (null char-code)
- (= (the char-code-integer char-code) 65533))
- (recover-from-encoding-error format
- "No character which corresponds to octet #x~X." octet)
- char-code)))))
-
-(define-char-decoders (flexi-utf-8-format flexi-cr-utf-8-format flexi-crlf-utf-8-format)
- (let (first-octet-seen)
- (declare (boolean first-octet-seen))
- (macrolet ((read-next-byte ()
- '(prog1
- (or octet-getter
- (cond (first-octet-seen
- (return-from char-decoder
- (recover-from-encoding-error format
- "End of data while in UTF-8 sequence.")))
- (t (return-from char-decoder nil))))
- (setq first-octet-seen t))))
- (flet ((recover-from-overlong-sequence (value)
- (restart-case
- (recover-from-encoding-error format "`Overlong' UTF-8 sequence for code point #x~X."
- value)
- (accept-overlong-sequence ()
- :report "Accept the code point and continue."
- value))))
- (let ((octet (read-next-byte)))
- (declare (type octet octet))
- (block utf-8-sequence
- (multiple-value-bind (start count)
- (cond ((not (logbitp 7 octet))
- ;; avoid the overlong checks below
- (return-from utf-8-sequence octet))
- ((= #b11000000 (logand* octet #b11100000))
- (values (logand* octet #b00011111) 1))
- ((= #b11100000 (logand* octet #b11110000))
- (values (logand* octet #b00001111) 2))
- ((= #b11110000 (logand* octet #b11111000))
- (values (logand* octet #b00000111) 3))
- (t (return-from char-decoder
- (recover-from-encoding-error format
- "Unexpected value #x~X at start of UTF-8 sequence."
- octet))))
- (declare (fixnum count))
- (loop for result of-type code-point
- = start then (+ (ash* result 6)
- (logand* octet #b111111))
- repeat count
- for octet of-type octet = (read-next-byte)
- unless (= #b10000000 (logand* octet #b11000000))
- do (return-from char-decoder
- (recover-from-encoding-error format
- "Unexpected value #x~X in UTF-8 sequence." octet))
- finally (return (cond ((< result (ecase count
- (1 #x00080)
- (2 #x00800)
- (3 #x10000)))
- (recover-from-overlong-sequence result))
- (t result)))))))))))
-
-(define-char-decoders (flexi-utf-16-le-format flexi-cr-utf-16-le-format flexi-crlf-utf-16-le-format)
- (let (first-octet-seen)
- (declare (boolean first-octet-seen))
- (macrolet ((read-next-byte ()
- '(prog1
- (or octet-getter
- (cond (first-octet-seen
- (return-from char-decoder
- (recover-from-encoding-error format
- "End of data while in UTF-16 sequence.")))
- (t (return-from char-decoder nil))))
- (setq first-octet-seen t))))
- (flet ((read-next-word ()
- (+ (the octet (read-next-byte))
- (ash* (the octet (read-next-byte)) 8))))
- (declare (inline read-next-word))
- (let ((word (read-next-word)))
- (declare (type (unsigned-byte 16) word))
- (cond ((<= #xd800 word #xdfff)
- (let ((next-word (read-next-word)))
- (declare (type (unsigned-byte 16) next-word))
- (unless (<= #xdc00 next-word #xdfff)
- (return-from char-decoder
- (recover-from-encoding-error format
- "Unexpected UTF-16 word #x~X following #x~X."
- next-word word)))
- (+ (ash* (logand* #b1111111111 word) 10)
- (logand* #b1111111111 next-word)
- #x10000)))
- (t word)))))))
-
-(define-char-decoders (flexi-utf-16-be-format flexi-cr-utf-16-be-format flexi-crlf-utf-16-be-format)
- (let (first-octet-seen)
- (declare (boolean first-octet-seen))
- (macrolet ((read-next-byte ()
- '(prog1
- (or octet-getter
- (cond (first-octet-seen
- (return-from char-decoder
- (recover-from-encoding-error format
- "End of data while in UTF-16 sequence.")))
- (t (return-from char-decoder nil))))
- (setq first-octet-seen t))))
- (flet ((read-next-word ()
- (+ (ash* (the octet (read-next-byte)) 8)
- (the octet (read-next-byte)))))
- (declare (inline read-next-word))
- (let ((word (read-next-word)))
- (declare (type (unsigned-byte 16) word))
- (cond ((<= #xd800 word #xdfff)
- (let ((next-word (read-next-word)))
- (declare (type (unsigned-byte 16) next-word))
- (unless (<= #xdc00 next-word #xdfff)
- (return-from char-decoder
- (recover-from-encoding-error format
- "Unexpected UTF-16 word #x~X following #x~X."
- next-word word)))
- (+ (ash* (logand* #b1111111111 word) 10)
- (logand* #b1111111111 next-word)
- #x10000)))
- (t word)))))))
-
-(define-char-decoders (flexi-utf-32-le-format flexi-cr-utf-32-le-format flexi-crlf-utf-32-le-format)
- (let (first-octet-seen)
- (declare (boolean first-octet-seen))
- (macrolet ((read-next-byte ()
- '(prog1
- (or octet-getter
- (cond (first-octet-seen
- (return-from char-decoder
- (recover-from-encoding-error format
- "End of data while in UTF-32 sequence.")))
- (t (return-from char-decoder nil))))
- (setq first-octet-seen t))))
- (loop for count of-type fixnum from 0 to 24 by 8
- for octet of-type octet = (read-next-byte)
- sum (ash* octet count)))))
-
-(define-char-decoders (flexi-utf-32-be-format flexi-cr-utf-32-be-format flexi-crlf-utf-32-be-format)
- (let (first-octet-seen)
- (declare (boolean first-octet-seen))
- (macrolet ((read-next-byte ()
- '(prog1
- (or octet-getter
- (cond (first-octet-seen
- (return-from char-decoder
- (recover-from-encoding-error format
- "End of data while in UTF-32 sequence.")))
- (t (return-from char-decoder nil))))
- (setq first-octet-seen t))))
- (loop for count of-type fixnum from 24 downto 0 by 8
- for octet of-type octet = (read-next-byte)
- sum (ash* octet count)))))
-
-(defmethod octets-to-char-code ((format flexi-cr-mixin) reader)
- (declare #.*fixnum-optimize-settings*)
- (declare (ignore reader))
- (let ((char-code (call-next-method)))
- (case char-code
- (#.+cr+ #.(char-code #\Newline))
- (otherwise char-code))))
-
-(defmethod octets-to-char-code ((format flexi-crlf-mixin) reader)
- (declare #.*fixnum-optimize-settings*)
- (declare (function *current-unreader*))
- (declare (ignore reader))
- (let ((char-code (call-next-method)))
- (case char-code
- (#.+cr+
- (let ((next-char-code (call-next-method)))
- (case next-char-code
- (#.+lf+ #.(char-code #\Newline))
- ;; we saw a CR but no LF afterwards, but then the data
- ;; ended, so we just return #\Return
- ((nil) +cr+)
- ;; if the character we peeked at wasn't a
- ;; linefeed character we unread its constituents
- (otherwise (funcall *current-unreader* (code-char next-char-code))
- char-code))))
- (otherwise char-code))))
-
(DIR) diff --git a/3rdparties/software/flexi-streams-20190107-git/docs/foo.txt b/3rdparties/software/flexi-streams-20190107-git/docs/foo.txt
Binary files differ.
(DIR) diff --git a/3rdparties/software/flexi-streams-20190107-git/docs/index.html b/3rdparties/software/flexi-streams-20190107-git/docs/index.html
@@ -1,1119 +0,0 @@
-<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">
-<html>
-
-<head>
- <meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1">
- <title>FLEXI-STREAMS - Flexible bivalent streams for Common Lisp</title>
- <style type="text/css">
- pre { padding:5px; background-color:#e0e0e0 }
- h3, h4 { text-decoration: underline; }
- a { text-decoration: none; padding: 1px 2px 1px 2px; }
- a:visited { text-decoration: none; padding: 1px 2px 1px 2px; }
- a:hover { text-decoration: none; padding: 1px 1px 1px 1px; border: 1px solid #000000; }
- a:focus { text-decoration: none; padding: 1px 2px 1px 2px; border: none; }
- a.none { text-decoration: none; padding: 0; }
- a.none:visited { text-decoration: none; padding: 0; }
- a.none:hover { text-decoration: none; border: none; padding: 0; }
- a.none:focus { text-decoration: none; border: none; padding: 0; }
- a.noborder { text-decoration: none; padding: 0; }
- a.noborder:visited { text-decoration: none; padding: 0; }
- a.noborder:hover { text-decoration: none; border: none; padding: 0; }
- a.noborder:focus { text-decoration: none; border: none; padding: 0; }
- </style>
-</head>
-
-<body bgcolor=white>
-
-<h2>FLEXI-STREAMS - Flexible bivalent streams for Common Lisp</h2>
-
-<blockquote>
-<br> <br><h3><a name=abstract class=none>Abstract</a></h3>
-
-FLEXI-STREAMS implements "virtual" bivalent streams that can be
-layered atop real binary or bivalent streams and that can be used to
-read and write character data in various single- or multi-octet
-encodings which can be changed on the fly. It also supplies
-<em>in-memory</em> binary streams which are similar to string streams.
-<p>
-The library needs a Common Lisp implementation that
-supports <a
-href="http://www.nhplace.com/kent/CL/Issues/stream-definition-by-user.html"><em>Gray
-streams</em></a> and relies on David
-Lichteblau's <a
-href="http://www.cliki.net/trivial-gray-streams">trivial-gray-streams</a>
-to offer portability between different Lisps.
-<p>
-The code comes with
-a <a
-href="http://www.opensource.org/licenses/bsd-license.php">BSD-style
-license</a> so you can basically do with it whatever you want.
-
-<p>
-<font color=red>Download shortcut:</font> <a
-href="https://github.com/edicl/flexi-streams/releases/latest">https://github.com/edicl/flexi-streams/releases/latest</a>
-</blockquote>
-
-<br> <br><h3><a class=none name="contents">Contents</a></h3>
-<ol>
- <li><a href="#example">Example usage</a>
- <li><a href="#install">Download and installation</a>
- <li><a href="#support">Support</a>
- <li><a href="#dictionary">The FLEXI-STREAMS dictionary</a>
- <ol>
- <li><a href="#external-formats">External formats</a>
- <ol>
- <li><a href="#make-external-format"><code>make-external-format</code></a>
- <li><a href="#external-format-name"><code>external-format-name</code></a>
- <li><a href="#external-format-eol-style"><code>external-format-eol-style</code></a>
- <li><a href="#external-format-little-endian"><code>external-format-little-endian</code></a>
- <li><a href="#external-format-id"><code>external-format-id</code></a>
- <li><a href="#external-format-equal"><code>external-format-equal</code></a>
- <li><a href="#*default-eol-style*"><code>*default-eol-style*</code></a>
- <li><a href="#*default-little-endian*"><code>*default-little-endian*</code></a>
- <li><a href="#external-format-condition"><code>external-format-condition</code></a>
- <li><a href="#external-format-condition-external-format"><code>external-format-condition-external-format</code></a>
- <li><a href="#external-format-error"><code>external-format-error</code></a>
- <li><a href="#external-format-encoding-error"><code>external-format-encoding-error</code></a>
- <li><a href="#*substitution-char*"><code>*substitution-char*</code></a>
- <li><a href="#accept-overlong-sequence"><code>accept-overlong-sequence</code></a>
- </ol>
- <li><a href="#flexi-streams">Flexi streams</a>
- <ol>
- <li><a href="#flexi-stream"><code>flexi-stream</code></a>
- <li><a href="#flexi-input-stream"><code>flexi-input-stream</code></a>
- <li><a href="#flexi-output-stream"><code>flexi-output-stream</code></a>
- <li><a href="#flexi-io-stream"><code>flexi-io-stream</code></a>
- <li><a href="#make-flexi-stream"><code>make-flexi-stream</code></a>
- <li><a href="#flexi-stream-external-format"><code>flexi-stream-external-format</code></a>
- <li><a href="#flexi-stream-element-type"><code>flexi-stream-element-type</code></a>
- <li><a href="#flexi-stream-column"><code>flexi-stream-column</code></a>
- <li><a href="#flexi-stream-position"><code>flexi-stream-position</code></a>
- <li><a href="#flexi-stream-bound"><code>flexi-stream-bound</code></a>
- <li><a href="#flexi-stream-stream"><code>flexi-stream-stream</code></a>
- <li><a href="#unread-byte"><code>unread-byte</code></a>
- <li><a href="#peek-byte"><code>peek-byte</code></a>
- <li><a href="#octet"><code>octet</code></a>
- <li><a href="#flexi-stream-error"><code>flexi-stream-error</code></a>
- <li><a href="#flexi-stream-out-of-sync-error"><code>flexi-stream-out-of-sync-error</code></a>
- <li><a href="#flexi-stream-element-type-error"><code>flexi-stream-element-type-error</code></a>
- <li><a href="#flexi-stream-element-type-error-element-type"><code>flexi-stream-element-type-error-element-type</code></a>
- </ol>
- <li><a href="#in-memory">In-memory streams</a>
- <ol>
- <li><a href="#in-memory-stream"><code>in-memory-stream</code></a>
- <li><a href="#in-memory-input-stream"><code>in-memory-input-stream</code></a>
- <li><a href="#in-memory-output-stream"><code>in-memory-output-stream</code></a>
- <li><a href="#list-stream"><code>list-stream</code></a>
- <li><a href="#vector-stream"><code>vector-stream</code></a>
- <li><a href="#make-in-memory-input-stream"><code>make-in-memory-input-stream</code></a>
- <li><a href="#make-in-memory-output-stream"><code>make-in-memory-output-stream</code></a>
- <li><a href="#get-output-stream-sequence"><code>get-output-stream-sequence</code></a>
- <li><a href="#output-stream-sequence-length"><code>output-stream-sequence-length</code></a>
- <li><a href="#with-input-from-sequence"><code>with-input-from-sequence</code></a>
- <li><a href="#with-output-to-sequence"><code>with-output-to-sequence</code></a>
- <li><a href="#in-memory-stream-error"><code>in-memory-stream-error</code></a>
- <li><a href="#in-memory-stream-closed-error"><code>in-memory-stream-closed-error</code></a>
- <li><a href="#in-memory-stream-position-spec-error"><code>in-memory-stream-position-spec-error</code></a>
- <li><a href="#in-memory-stream-position-spec-error-position-spec"><code>in-memory-stream-position-spec-error-position-spec</code></a>
- </ol>
- <li><a href="#strings">Strings</a>
- <ol>
- <li><a href="#string-to-octets"><code>string-to-octets</code></a>
- <li><a href="#octets-to-string"><code>octets-to-string</code></a>
- <li><a href="#octet-length"><code>octet-length</code></a>
- <li><a href="#char-length"><code>char-length</code></a>
- </ol>
- </ol>
- <li><a href="#position">File positions</a>
- <li><a href="#ack">Acknowledgements</a>
-</ol>
-
-<br> <br><h3><a name="example" class=none>Example usage</a></h3>
-
-The examples were created with <a href="http://www.lispworks.com/">LispWorks</a> 4.4.6 pro on Windows. The following two functions create <a href="foo.txt">the same file</a>:
-
-<pre>
-(defun foo (pathspec)
- "With standard LispWorks streams."
- (with-open-file (out pathspec
- :direction :output
- :if-exists :supersede
- :external-format '(:utf-8 :eol-style :crlf))
- (write-line "ÄÖÜ1" out))
- (with-open-file (out pathspec
- :direction :output
- :if-exists :append
- :external-format '(:latin-1 :eol-style :lf))
- (write-line "ÄÖÜ2" out))
- (with-open-file (out pathspec
- :direction :output
- :if-exists :append
- :element-type 'octet)
- (write-byte #xeb out)
- (write-sequence #(#xa3 #xa4 #xa5) out))
- (with-open-file (out pathspec
- :direction :output
- :if-exists :append
- :external-format '(:unicode :little-endian nil :eol-style :crlf))
- (write-line "ÄÖÜ3" out)))
-
-(defun bar (pathspec)
- "With a <a href="#flexi-streams" class=noborder>flexi stream</a>."
- (with-open-file (out pathspec
- :direction :output
- :if-exists :supersede
- :external-format '(:latin-1 :eol-style :lf))
- (setq out (<a href="#make-flexi-stream" class=noborder>make-flexi-stream</a> out <a href="#external-formats" class=noborder>:external-format</a> :utf-8))
- (write-line "ÄÖÜ1" out)
- (setf (<a href="#flexi-stream-external-format" class=noborder>flexi-stream-external-format</a> out) '(:latin-1 :eol-style :lf))
- (write-line "ÄÖÜ2" out)
- (write-byte #xeb out)
- (write-sequence #(#xa3 #xa4 #xa5) out)
- (setf (flexi-stream-external-format out) :ucs-2be)
- (write-line "ÄÖÜ3" out)))
-</pre>
-
-<p>
-And applying this function
-<pre>
-(defun baz (pathspec)
- (let (result)
- (with-open-file (in pathspec :element-type '<a href="#octet" class=noborder>octet</a>)
- (setq in (<a href="#make-flexi-stream" class=noborder>make-flexi-stream</a> in <a href="#external-formats" class=noborder>:external-format</a> :utf-8))
- (push (read-line in) result)
- (push (read-byte in) result)
- (setf (<a href="#flexi-stream-external-format" class=noborder>flexi-stream-external-format</a> in) '(:latin-1 :eol-style :lf))
- (push (read-line in) result)
- (setf (flexi-stream-external-format in) :greek)
- (push (read-char in) result)
- (setf (flexi-stream-external-format in) :latin0)
- (let ((string (make-string 3 :element-type 'character)))
- (read-sequence string in)
- (push string result))
- (let ((octets (make-array 2 :element-type 'octet)))
- (read-sequence octets in)
- (push octets result))
- (setf (flexi-stream-external-format in) :ucs-2be)
- (push (read-line in) result))
- (nreverse result)))
-</pre>
-to the file created above will yield the list
-<pre>
-("ÄÖÜ1" 196 "ÖÜ2" #\λ "£€¥" #(0 196) "ÖÜ3")
-</pre>
-
-<p>
-For more examples see the source code
-of
-<a href="http://mr-co.de/projects/cl-rfc2047/">CL-RFC2047</a>,
-<a
-href="http://weitz.de/drakma/">Drakma</a>, <a
-href="http://weitz.de/chunga/">Chunga</a>,
-or <a href="http://weitz.de/cl-wbxml/">CL-WBXML</a>.
-
-<br> <br><h3><a name="install" class=none>Download and installation</a></h3>
-
-Before you try to install FLEXI-STREAMS, first check that in your Lisp
-each <a
-href="http://www.lispworks.com/documentation/HyperSpec/Body/13_.htm">character</a>'s
-<a
-href="http://www.lispworks.com/documentation/HyperSpec/Body/26_glo_c.htm#character_code">character
-code</a> is equal to
-its <a
-href="http://en.wikipedia.org/wiki/Unicode">Unicode</a> <a
-href="http://unicode.org/glossary/">code point</a> and
-that <code>(CHAR-CODE #\Newline)</code>
-and <code>(CHAR-CODE #\Linefeed)</code> have the same
-value (10). (This is the case for all relevant CL
-implementations which were in use when this library was written. It
-is <em>not</em> mandated by the ANSI standard, though.)
-<p>
-FLEXI-STREAMS together with this documentation can be downloaded from <a
-href="https://github.com/edicl/flexi-streams/releases/latest">https://github.com/edicl/flexi-streams/releases/latest</a>.
-<p>
-Before you install FLEXI-STREAMS you first need to
-install the <a
-href="http://www.cliki.net/trivial-gray-streams">trivial-gray-streams</a> library
-unless you already have it.
-<p>
-FLEXI-STREAMS comes with a system definition for <a
-href="http://www.cliki.net/asdf">ASDF</a> so you can install the library with
-<pre>
-(asdf:oos 'asdf:load-op :flexi-streams)
-</pre>
-if you've unpacked it in a place where ASDF can find it. Installation
-via <a href="http://www.cliki.net/asdf-install">asdf-install</a>
-should also be possible, and there's a port
-to <a href="http://www.cliki.net/Gentoo">Gentoo Lisp</a> thanks to
-Matthew Kennedy.
-<p>
-You can run a test suite which tests <em>some</em> (but
-not <em>all</em>) aspects of the library with
-<pre>
-(asdf:oos 'asdf:test-op :flexi-streams)
-</pre>
-This might take a while...
-<p>
-The current development version of FLEXI-STREAMS can be found
-at <a href="http://bknr.net/trac/browser/trunk/thirdparty">http://bknr.net/trac/browser/trunk/thirdparty</a>.
-This is the one to send <a href="#mail">patches</a> against. Use at
-your own risk.
-<p>
-Luís Oliveira maintains a <a href="http://darcs.net/">darcs</a>
-repository of FLEXI-STREAMS
-at <a href="http://common-lisp.net/%7Eloliveira/ediware/">http://common-lisp.net/~loliveira/ediware/</a>.
-<p>
-A <a href="http://www.selenic.com/mercurial/wiki/">Mercurial</a>
-repository of older versions is available
-at <a
-href="http://arcanes.fr.eu.org/~pierre/2007/02/weitz/">http://arcanes.fr.eu.org/~pierre/2007/02/weitz/</a>
-thanks to Pierre Thierry.
-
-<br> <br><h3><a name="support" class=none>Support</a></h3>
-
-The development version of flexi-streams can be
-found <a href="https://github.com/edicl/flexi-streams" target="_new">on
-github</a>. Please use the github issue tracking system to submit bug
-reports. Patches are welcome, please
-use <a href="https://github.com/edicl/flexi-streams/pulls">GitHub pull
-requests</a>. If you want to make a change,
-please <a href="http://weitz.de/patches.html" target="_new">read this
-first</a>.
-
-<br> <br><h3><a class=none name="dictionary">The FLEXI-STREAMS dictionary</a></h3>
-
-<h4><a name="external-formats" class=none>External formats</a></h4>
-
-<code>EXTERNAL-FORMAT</code> objects are used to denote the external
-formats of <a href="#flexi-streams">flexi streams</a>. These objects are created using
-the <a
-href="#make-external-format"><code>MAKE-EXTERNAL-FORMAT</code></a>
-function, and there are <a href="#external-format-name">various
-readers</a> to query their attributes. Once such an object is
-created it can't be changed.
-<p>
-An external format consists of a basic encoding
-(like <a
-href="http://en.wikipedia.org/wiki/Iso-8859-1">ISO 8859-1</a>
-or <a href="http://en.wikipedia.org/wiki/UTF-8">UTF-8</a>), a
-definition how line endings are denoted - by a carriage return
-character (ASCII 13), by a line feed character (ASCII 10),
-or by both of these characters in a row -, and optionally (for
-encodings that use units larger than 8 bits) information
-about the <a href="http://en.wikipedia.org/wiki/Endian">endianess</a>
-of the encoding.
-<p>
-The following encodings are currently supported by FLEXI-STREAMS:
-<ul>
-<li><a href="http://en.wikipedia.org/wiki/UTF-8">UTF-8</a> (denoted by the keyword <code>:UTF-8</code>),
-<li><a href="http://en.wikipedia.org/wiki/UTF-16">UTF-16</a> (denoted by the keyword <code>:UTF-16</code>),
-<li><a href="http://en.wikipedia.org/wiki/UTF-32">UTF-32</a> (denoted by the keyword <code>:UTF-32</code>),
-<li>all <a href="http://czyborra.com/charsets/iso8859.html">ISO 8859</a> character sets (denoted by keywords like <code>:ISO-8859-15</code>),
-<li><a href="http://en.wikipedia.org/wiki/KOI8-R">KOI8-R</a> (denoted by the keyword <code>:KOI8-R</code>),
-<li>a couple
-of <a href="http://czyborra.com/charsets/codepages.html">Windows code
-pages</a> (denoted by the keyword <code>:CODE-PAGE</code> and an
-obligatory <code>:ID</code> argument), and
-<li><a href="http://en.wikipedia.org/wiki/ASCII">US-ASCII</a>.
-</ul>
-<p>
-A couple of alternative names are allowed that are listed below:
-<p>
-<table border=1>
-<tr><td><code>:UTF-8</code></td><td><code>:UTF8</code></td></tr>
-<tr><td rowspan=4 valign=top><code>:UTF-16</code></td><td><code>:UTF16</code></td></tr>
-<tr><td><code>:UCS-2</code></td></tr>
-<tr><td><code>:UCS2</code></td></tr>
-<tr><td><code>:UNICODE</code></td></tr>
-<tr><td rowspan=3 valign=top><code>:UTF-32</code></td><td><code>:UTF32</code></td></tr>
-<tr><td><code>:UCS-4</code></td></tr>
-<tr><td><code>:UCS4</code></td></tr>
-<tr><td rowspan=2 valign=top><code>:ISO-8859-1</code></td><td><code>:LATIN-1</code></td></tr>
-<tr><td><code>:LATIN1</code></td></tr>
-<tr><td rowspan=2 valign=top><code>:ISO-8859-2</code></td><td><code>:LATIN-2</code></td></tr>
-<tr><td><code>:LATIN2</code></td></tr>
-<tr><td rowspan=2 valign=top><code>:ISO-8859-3</code></td><td><code>:LATIN-3</code></td></tr>
-<tr><td><code>:LATIN3</code></td></tr>
-<tr><td rowspan=2 valign=top><code>:ISO-8859-4</code></td><td><code>:LATIN-4</code></td></tr>
-<tr><td><code>:LATIN4</code></td></tr>
-<tr><td><code>:ISO-8859-5</code></td><td><code>:CYRILLIC</code></td></tr>
-<tr><td><code>:ISO-8859-6</code></td><td><code>:ARABIC</code></td></tr>
-<tr><td><code>:ISO-8859-7</code></td><td><code>:GREEK</code></td></tr>
-<tr><td><code>:ISO-8859-8</code></td><td><code>:HEBREW</code></td></tr>
-<tr><td rowspan=2 valign=top><code>:ISO-8859-9</code></td><td><code>:LATIN-5</code></td></tr>
-<tr><td><code>:LATIN5</code></td></tr>
-<tr><td rowspan=2 valign=top><code>:ISO-8859-10</code></td><td><code>:LATIN-6</code></td></tr>
-<tr><td><code>:LATIN6</code></td></tr>
-<tr><td><code>:ISO-8859-11</code></td><td><code>:THAI</code></td></tr>
-<tr><td rowspan=2 valign=top><code>:ISO-8859-13</code></td><td><code>:LATIN-7</code></td></tr>
-<tr><td><code>:LATIN7</code></td></tr>
-<tr><td rowspan=2 valign=top><code>:ISO-8859-14</code></td><td><code>:LATIN-8</code></td></tr>
-<tr><td><code>:LATIN8</code></td></tr>
-<tr><td rowspan=4 valign=top><code>:ISO-8859-15</code></td><td><code>:LATIN-9</code></td></tr>
-<tr><td><code>:LATIN9</code></td></tr>
-<tr><td><code>:LATIN-0</code></td></tr>
-<tr><td><code>:LATIN0</code></td></tr>
-<tr><td rowspan=2 valign=top><code>:ISO-8859-16</code></td><td><code>:LATIN-10</code></td></tr>
-<tr><td><code>:LATIN10</code></td></tr>
-<tr><td rowspan=2 valign=top><code>:CODE-PAGE</code></td><td><code>:CODEPAGE</code></td></tr>
-<tr><td><code>WIN32:CODE-PAGE<br>(only on <a href="http://www.lispworks.com/products/lww.html">LWW</a>)</code></td></tr>
-<tr><td><code>:KOI8-R</code></td><td><code>:KOI8R</code></td></tr>
-<tr><td><code>:US-ASCII</code></td><td><code>:ASCII</code></td></tr>
-</table>
-<p>
-(Note that we treat UCS-2 exactly like UTF-16 although there
-are <a href="http://en.wikipedia.org/wiki/UTF-16">subtle
-differences</a>. Also note that even though we support encodings like
-UTF-32 some Lisps only supports characters contained within
-the <a
-href="http://en.wikipedia.org/wiki/Basic_Multilingual_Plane">Basic
-Multilingual Plane</a> (like LispWorks) or even less (like CMUCL), so
-if other characters are read from a
-<a href="#flexi-streams">flexi
-stream</a>, <a
-href="http://www.lispworks.com/documentation/HyperSpec/Body/f_rd_cha.htm"><code>READ-CHAR</code></a>
-will try to be helpful and return the corresponding Unicode code point -
-an integer - instead. This might lead to an error if you're using
-functions
-like <a
-href="http://www.lispworks.com/documentation/HyperSpec/Body/f_rd_lin.htm"><code>READ-LINE</code></a>, though.)
-
-<p>
-Whenever a FLEXI-STREAMS function accepts an external format as one of
-its arguments, you can provide either an <code>EXTERNAL-FORMAT</code>
-object or a shortcut which can be a list or a symbol. The list
-shortcuts have a syntax similar
-to <a
-href="http://www.lispworks.com/documentation/lw50/LWUG/html/lwuser-360.htm">the
-one used by LispWorks</a> - the cars are the names of and encoding
-and the cdrs of these lists correspond to the keyword arguments
-to <a
-href="#make-external-format"><code>MAKE-EXTERNAL-FORMAT</code></a>, so
-for example
-<pre>(:latin-1 :eol-style :crlf)</pre>
-is equivalent to
-<pre>(<a class=noborder href="#make-external-format">make-external-format</a> :latin-1 :eol-style :crlf)</pre> The
-symbol shortcuts are equivalent to
-calling <a
-href="#make-external-format"><code>MAKE-EXTERNAL-FORMAT</code></a>
-without keyword arguments, i.e.
-<pre>:thai</pre>
-behaves like
-<pre>(<a class=noborder href="#make-external-format">make-external-format</a> :thai)</pre>
-Finally, the following expansions are
-available:
-<p>
-<table border=1>
-<tr><td><code>:UCS-2LE</code></td><td><code>(:UCS-2 :LITTLE-ENDIAN T)</code></td></tr>
-<tr><td><code>:UCS-2BE</code></td><td><code>(:UCS-2 :LITTLE-ENDIAN NIL)</code></td></tr>
-<tr><td><code>:UCS-4LE</code></td><td><code>(:UCS-4 :LITTLE-ENDIAN T)</code></td></tr>
-<tr><td><code>:UCS-4BE</code></td><td><code>(:UCS-4 :LITTLE-ENDIAN NIL)</code></td></tr>
-<tr><td><code>:UTF-16LE</code></td><td><code>(:UTF-16 :LITTLE-ENDIAN T)</code></td></tr>
-<tr><td><code>:UTF-16BE</code></td><td><code>(:UTF-16 :LITTLE-ENDIAN NIL)</code></td></tr>
-<tr><td><code>:UTF-32LE</code></td><td><code>(:UTF-32 :LITTLE-ENDIAN T)</code></td></tr>
-<tr><td><code>:UTF-32BE</code></td><td><code>(:UTF-32 :LITTLE-ENDIAN NIL)</code></td></tr>
-<tr><td><code>:IBM437</code></td><td><code>(:CODE-PAGE :ID 437)</code></td></tr>
-<tr><td><code>:IBM850</code></td><td><code>(:CODE-PAGE :ID 850)</code></td></tr>
-<tr><td><code>:IBM852</code></td><td><code>(:CODE-PAGE :ID 852)</code></td></tr>
-<tr><td><code>:IBM855</code></td><td><code>(:CODE-PAGE :ID 855)</code></td></tr>
-<tr><td><code>:IBM857</code></td><td><code>(:CODE-PAGE :ID 857)</code></td></tr>
-<tr><td><code>:IBM860</code></td><td><code>(:CODE-PAGE :ID 860)</code></td></tr>
-<tr><td><code>:IBM861</code></td><td><code>(:CODE-PAGE :ID 861)</code></td></tr>
-<tr><td><code>:IBM862</code></td><td><code>(:CODE-PAGE :ID 862)</code></td></tr>
-<tr><td><code>:IBM863</code></td><td><code>(:CODE-PAGE :ID 863)</code></td></tr>
-<tr><td><code>:IBM864</code></td><td><code>(:CODE-PAGE :ID 864)</code></td></tr>
-<tr><td><code>:IBM865</code></td><td><code>(:CODE-PAGE :ID 865)</code></td></tr>
-<tr><td><code>:IBM866</code></td><td><code>(:CODE-PAGE :ID 866)</code></td></tr>
-<tr><td><code>:IBM869</code></td><td><code>(:CODE-PAGE :ID 869)</code></td></tr>
-<tr><td><code>:WINDOWS-1250</code></td><td><code>(:CODE-PAGE :ID 1250)</code></td></tr>
-<tr><td><code>:WINDOWS-1251</code></td><td><code>(:CODE-PAGE :ID 1251)</code></td></tr>
-<tr><td><code>:WINDOWS-1252</code></td><td><code>(:CODE-PAGE :ID 1252)</code></td></tr>
-<tr><td><code>:WINDOWS-1253</code></td><td><code>(:CODE-PAGE :ID 1253)</code></td></tr>
-<tr><td><code>:WINDOWS-1254</code></td><td><code>(:CODE-PAGE :ID 1254)</code></td></tr>
-<tr><td><code>:WINDOWS-1255</code></td><td><code>(:CODE-PAGE :ID 1255)</code></td></tr>
-<tr><td><code>:WINDOWS-1256</code></td><td><code>(:CODE-PAGE :ID 1256)</code></td></tr>
-<tr><td><code>:WINDOWS-1257</code></td><td><code>(:CODE-PAGE :ID 1257)</code></td></tr>
-<tr><td><code>:WINDOWS-1258</code></td><td><code>(:CODE-PAGE :ID 1258)</code></td></tr>
-</table>
-<p>
-Note that if you provide a shortcut, it
-will be converted to an <code>EXTERNAL-FORMAT</code> object first.
-So, if you're concerned about efficiency, create these objects once and
-re-use them.
-
-<p><br>[Function]
-<br><a class=none name="make-external-format"><b>make-external-format</b> <i>name <tt>&key</tt> eol-style little-endian id</i> => <i>external-format</i></a>
-
-<blockquote><br> Creates and returns
-an <a href="#external-formats"><code>EXTERNAL-FORMAT</code>
-object</a>. <code><i>name</i></code> is a
-symbol, <code><i>eol-style</i></code> is one of the
-keywords <code>:CR</code>, <code>:LF</code>, or <code>:CRLF</code>,
-and <code><i>little-endian</i></code> is
-a <a
-href="http://www.lispworks.com/documentation/HyperSpec/Body/26_glo_g.htm#generalized_boolean">generalized
-boolean</a>. The default value for <code><i>eol-style</i></code> is the value of <a href="#*default-eol-style*"><code>*DEFAULT-EOL-STYLE*</code></a> except for Windows code pages where it is <code>:CRLF</code>. The default value
-for <code><i>little-endian</i></code> is the value of <a href="#*default-little-endian*"><code>*DEFAULT-LITTLE-ENDIAN*</code></a> - this value is ignored unless <code><i>name</i></code> denotes one of UTF-16 or UTF-32.
-<code><i>id</i></code> must be an integer denoting a Windows code page
-known by FLEXI-STREAMS if <code><i>name</i></code>
-is <code>:CODE-PAGE</code> or <code>WIN32:CODE-PAGE</code>, otherwise
-the value is ignored. See <a href="#external-formats">the section
-about external formats</a> for more info.
-<p>
-Examples (run on Windows):
-
-<pre>
-CL-USER 1 > (make-external-format :latin-1)
-#<FLEXI-STREAMS::EXTERNAL-FORMAT (:ISO-8859-1 :EOL-STYLE :CRLF) 2067DA84>
-
-CL-USER 2 > (make-external-format :latin-1 :eol-style :lf)
-#<FLEXI-STREAMS::EXTERNAL-FORMAT (:ISO-8859-1 :EOL-STYLE :LF) 2068B4D4>
-
-CL-USER 3 > (make-external-format :ibm437)
-#<FLEXI-STREAMS::EXTERNAL-FORMAT (:CODE-PAGE :ID 437 :EOL-STYLE :CRLF) 2069B33C>
-
-CL-USER 4 > (make-external-format :ucs-2)
-#<FLEXI-STREAMS::EXTERNAL-FORMAT (:UTF-16 :EOL-STYLE :CRLF :LITTLE-ENDIAN T) 206B4F4C>
-
-CL-USER 5 > (make-external-format :ucs-2be)
-#<FLEXI-STREAMS::EXTERNAL-FORMAT (:UTF-16 :EOL-STYLE :CRLF :LITTLE-ENDIAN NIL) 2067DBE4>
-
-CL-USER 6 > (make-external-format :ucs-2be :eol-style :cr)
-#<FLEXI-STREAMS::EXTERNAL-FORMAT (:UTF-16 :EOL-STYLE :CR :LITTLE-ENDIAN NIL) 206B54AC>
-</pre>
-</blockquote>
-
-<p><br>[Readers]
-<br><a class=none name="external-format-name"><b>external-format-name</b> <i>external-format</i> => <i>name</i></a>
-<br><a class=none name="external-format-eol-style"><b>external-format-eol-style</b> <i>external-format</i> => <i>eol-style</i></a>
-<br><a class=none name="external-format-little-endian"><b>external-format-little-endian</b> <i>external-format</i> => <i>little-endian</i></a>
-<br><a class=none name="external-format-id"><b>external-format-id</b> <i>external-format</i> => <i>id</i></a>
-
-<blockquote><br>
-These methods can be used to query an <a href="#external-formats"><code>EXTERNAL-FORMAT</code> object</a> for its attributes.
-</blockquote>
-
-<p><br>[Functions]
-<br><a class=none name="external-format-equal"><b>external-format-equal</b> <i>external-format-1 external-format-2</i> => <i>generalized-boolean</i></a>
-
-<blockquote><br>
-Checks whether the two <a href="#external-formats">external formats</a> <code><i>external-format-1</i></code> and <code><i>external-format-2</i></code> are equivalent with respect to their effects on <a href="#flexi-streams">flexi streams</a>.
-<p>
-Examples (run on Windows):
-
-<pre>
-CL-USER 1 > (<a href="#make-external-format" class=noborder>make-external-format</a> :ucs-4le)
-#<FLEXI-STREAMS::EXTERNAL-FORMAT (:UTF-32 :EOL-STYLE :CRLF :LITTLE-ENDIAN T) 2067FB74>
-
-CL-USER 2 > (external-format-equal <a href="http://www.lispworks.com/documentation/HyperSpec/Body/v__stst_.htm" class=noborder>*</a> (make-external-format :utf32 :little-endian t))
-T
-
-CL-USER 3 > (make-external-format :code-page :id 437)
-#<FLEXI-STREAMS::EXTERNAL-FORMAT (:CODE-PAGE :ID 437 :EOL-STYLE :CRLF) 2069428C>
-
-CL-USER 4 > (external-format-equal * (make-external-format :ibm437))
-T
-</pre>
-
-</blockquote>
-
-<p><br>[Special variable]
-<br><a class=none name="*default-eol-style*"><b>*default-eol-style*</b></a>
-
-<blockquote><br>
-The default value for the <code><i>eol-style</i></code> keyword argument of <a href="#make-external-format"><code>MAKE-EXTERNAL-FORMAT</code></a>. Its initial value is <code>:CRLF</code> on Windows and <code>:LF</code> on other operating systems.
-</blockquote>
-
-<p><br>[Special variable]
-<br><a class=none name="*default-little-endian*"><b>*default-little-endian*</b></a>
-
-<blockquote><br>
-The default value for the <code><i>little-endian</i></code> keyword argument of <a href="#make-external-format"><code>MAKE-EXTERNAL-FORMAT</code></a>. Its initial value corresponds to the endianess of the platform FLEXI-STREAMS is used on as revealed by the <code>:LITTLE-ENDIAN</code> <a href="http://www.lispworks.com/documentation/HyperSpec/Body/24_ab.htm">feature</a>.
-</blockquote>
-
-<p><br>[Condition]
-<br><a class=none name="external-format-condition"><b>external-format-condition</b></a>
-
-<blockquote><br>
-All conditions related to <a href="#external-formats">external formats</a> are of this type.
-There's a slot for the external format which can be accessed with <a href="#external-format-condition-external-format"><code>EXTERNAL-FORMAT-CONDITION-EXTERNAL-FORMAT</code></a>.
-</blockquote>
-
-<p><br>[Reader]
-<br><a class=none name="external-format-condition-external-format"><b>external-format-condition-external-format</b> <i>condition</i> => <i>external-format</i></a>
-
-<blockquote><br> If <code><i>condition</i></code> is of
-type <a href="#external-format-condition"><code>EXTERNAL-FORMAT-CONDITION</code></a>,
-this function will return the associated external format. Note that
-there are situation which happen during the creation of external
-formats where this method returns <code>NIL</code>.
-</blockquote>
-
-<p><br>[Condition]
-<br><a class=none name="external-format-error"><b>external-format-error</b></a>
-
-<blockquote><br>
-All errors related to <a href="#external-formats">external formats</a> are of this type.
-This is a subtype of <a href="#external-format-condition"><code>EXTERNAL-FORMAT-CONDITION</code></a>.
-</blockquote>
-
-<p><br>[Condition]
-<br><a class=none name="external-format-encoding-error"><b>external-format-encoding-error</b></a>
-
-<blockquote><br>
-All errors related to encoding problems with <a href="#external-formats">external formats</a> are of this type. (This includes situation where an end of file is encountered in the middle of a multi-octet character.) When this condition is signalled during reading, <a href="http://www.lispworks.com/documentation/HyperSpec/Body/r_use_va.htm"><code>USE-VALUE</code>
-restart</a> is provided. See also <a href="#*substitution-char*"><code>*SUBSTITUTION-CHAR*</code></a> and the example for it. <a href="#external-format-encoding-error"><code>EXTERNAL-FORMAT-ENCODING-ERROR</code></a> is a subtype of <a href="#external-format-error"><code>EXTERNAL-FORMAT-ERROR</code></a>.
-</blockquote>
-
-<p><br>[Special variable]
-<br><a class=none name="*substitution-char*"><b>*substitution-char*</b></a>
-
-<blockquote><br>
-If this value is not NIL, it should be a character which is used
-(as if by a <a href="http://www.lispworks.com/documentation/HyperSpec/Body/r_use_va.htm"><code>USE-VALUE</code> restart</a>) whenever during reading an error of
-type <a href="#external-format-encoding-error"><code>EXTERNAL-FORMAT-ENCODING-ERROR</code></a> would have been signalled otherwise.
-
-<pre>
-CL-USER 1 > (defun foo ()
- <font color=orange>;; not a valid UTF-8 sequence</font>
- (<a href="#with-input-from-sequence" class=noborder>with-input-from-sequence</a> (in '(#xe4 #xf6 #xfc))
- (setq in (<a href="#make-flexi-stream" class=noborder>make-flexi-stream</a> in :external-format :utf8))
- (read-line in)))
-FOO
-
-CL-USER 2 > (foo)
-
-Error: Unexpected value #xF6 in UTF-8 sequence.
- 1 (continue) Specify a character to be used instead.
- 2 (abort) Return to level 0.
- 3 Return to top loop level 0.
-
-Type :b for backtrace, :c <option number> to proceed, or :? for other options
-
-CL-USER 3 : 1 > :c
-Type a character: x
-
-Error: End of file while in UTF-8 sequence.
- 1 (continue) Specify a character to be used instead.
- 2 (abort) Return to level 0.
- 3 Return to top loop level 0.
-
-Type :b for backtrace, :c <option number> to proceed, or :? for other options
-
-CL-USER 4 : 1 > :c
-Type a character: y
-"xy"
-T
-
-CL-USER 5 > (<a href="http://www.lispworks.com/documentation/HyperSpec/Body/m_handle.htm" class=noborder>handler-bind</a> ((<a href="#external-format-encoding-error" class=noborder>external-format-encoding-error</a> (lambda (condition)
- (<a href="http://www.lispworks.com/documentation/HyperSpec/Body/r_use_va.htm" class=noborder>use-value</a> #\-))))
- (foo))
-"--"
-T
-
-CL-USER 6 > (let ((<a href="#*SUBSTITUTION-CHAR*" class=noborder>*substitution-char*</a> #\?))
- (foo))
-"??"
-T
-</pre>
-</blockquote>
-
-<p><br>[Restart]
-<br><a class=none name="accept-overlong-sequence"><b>accept-overlong-sequence</b></a>
-
-<blockquote><br> This is
-a <a href="http://www.lispworks.com/documentation/HyperSpec/Body/09_adb.htm">restart</a>
-which is established whenever a UTF-8 "overlong" sequence is
-encountered. If
-you <a href="http://www.lispworks.com/documentation/HyperSpec/Body/f_invo_1.htm">invoke</a>
-this restart, the corresponding code point will be accepted although
-it was encoded in an illegal way.
-</blockquote>
-
-<h4><a name="flexi-streams" class=none>Flexi streams</a></h4>
-
-<em>Flexi streams</em> are the core of the FLEXI-STREAMS library. You
-create them using the
-function <a
-href="#make-flexi-stream"><code>MAKE-FLEXI-STREAM</code></a> which
-takes an open binary stream (called the <em>underlying</em> stream) as its only required argument.
-A <em>binary</em> stream in this context means that if it's an <a href="http://www.lispworks.com/documentation/HyperSpec/Body/26_glo_i.htm#input">input
-stream</a>, you can read from it with
-<a href="http://www.lispworks.com/documentation/HyperSpec/Body/f_rd_by.htm"><code>READ-BYTE</code></a>
-(or, as a workaround for LispWorks, you can at least apply
-<a
-href="http://www.lispworks.com/documentation/HyperSpec/Body/f_rd_seq.htm"><code>READ-SEQUENCE</code></a>
-to it where the sequence is an array of element
-type <a href="#octet"><code>OCTET</code></a>), and similarly for
-<a
-href="http://www.lispworks.com/documentation/HyperSpec/Body/f_wr_by.htm#write-byte"><code>WRITE-BYTE</code></a>
-(<a
-href="http://www.lispworks.com/documentation/HyperSpec/Body/f_wr_seq.htm"><code>WRITE-SEQUENCE</code></a>
-for LispWorks)
-and <a
-href="http://www.lispworks.com/documentation/HyperSpec/Body/26_glo_o.htm#output">output
-streams</a>. (Note that this specifically holds
-for <a
-href="http://www.lispworks.com/documentation/lw50/LWRM/html/lwref-91.htm"><em>bivalent</em>
-streams</a> like socket streams.)
-<p>
-A flexi stream behaves like an ordinary Lisp stream. It is an input
-stream if the underlying binary stream is an input stream, and it is
-an output stream when the underlying binary stream is an output
-stream. You can write characters as well
-as <a href="#octet">octets</a> to an output flexi stream and similarly
-you can read characters and octets from an input flexi stream.
-<p>
-A flexi stream always has an <a href="#external-formats">external
-format</a> associated with it which is deployed whenever you read
-characters from the stream or write characters to it. You
-can <a href="#flexi-stream-external-format">change</a> the external
-format while you use the stream.
-<p>
-Once you're using a flexi stream you should <em>not</em> read from or
-write to the underlying stream directly anymore.
-<p>
-If
-you <a
-href="http://www.lispworks.com/documentation/HyperSpec/Body/f_close.htm">close</a>
-a flexi stream, the underlying stream will also be closed. However, it
-also suffices to close the underlying stream directly should you not
-want to use the flexi stream anymore. So, the following usage
-(where <code>IN</code> is implicitly closed at the end) is OK:
-<pre>
-(with-open-file (in "/foo/bar/baz.txt")
- (let ((flexi (<a href="#make-flexi-stream" class=noborder>make-flexi-stream</a> in <a href="#external-formats" class=noborder>:external-format</a> :hebrew)))
- (read-line flexi)))
-</pre>
-<p>
-Output flexi streams will try to keep track of
-the <a
-href="http://www.lispworks.com/documentation/lw50/LWRM/html/lwref-591.htm">column</a>
-they're in but you can also <a href="#flexi-stream-column">set</a> the
-column directly. This value will be incremented by one for each
-character written to the stream and it will be set to <code>0</code>
-if you send a <code>#\Newline</code> character. The column will be
-set to <code>NIL</code> if an <a href="#octet"><code>OCTET</code></a>
-is sent to the stream. Once the column is <code>NIL</code> it'll stay
-like that unless it is explicitly set to another value.
-<p>
-Input flexi streams keep track of
-their <a href="#flexi-stream-position">position</a> within the stream.
-This value is incremented by one for
-each <a href="#octet"><code>OCTET</code></a> read from the stream, and
-it is incremented by the number of octets actually read for each
-character read from the stream. So, if the encoding is UTF-8, reading
-the character <code>#\ä</code> (a-umlaut) will advance the position by two.
-If the encoding is UTF-32 and the end-of-line style
-is <code>:CRLF</code>, reading a <code>#\Newline</code> will advance
-the position by eight.
-<p>
-You can also set the <a href="#flexi-stream-bound">bound</a> of an
-input flexi stream. Initially it is <code>NIL</code>, but when it's
-an integer and the
-stream's <a href="#flexi-stream-position">position</a> has gone beyond
-this bound, the stream will behave as if no more input is available.
-<p>
-Caveat: You can
-only <a
-href="http://www.lispworks.com/documentation/HyperSpec/Body/f_unrd_c.htm">unread</a>
-a character from a flexi stream if you haven't changed the external format after you read it.
-<p>
-Caveat: The <em>underlying</em> stream should either be a <a href="http://www.lispworks.com/documentation/HyperSpec/Body/26_glo_b.htm#binary">binary stream</a> (i.e. have an element type that is a subtype of integer) or it should explicitly use an <a href="http://www.lispworks.com/documentation/lw50/LWUG/html/lwuser-360.htm">external format</a> with <code>:LF</code> as its end-of-line style. Otherwise it might perform unwanted conversion of line endings on its own. (LispWorks <a href="http://article.gmane.org/gmane.lisp.lispworks.general/4859">does this</a> even if you write binary data to the stream using <a href="http://www.lispworks.com/documentation/HyperSpec/Body/f_wr_seq.htm"><code>WRITE-SEQUENCE</code></a>.)
-
-<p><br>[Standard class]
-<br><a class=none name="flexi-stream"><b>flexi-stream</b></a>
-
-<blockquote><br>
-Every <a href="#flexi-streams"><em>flexi stream</em></a> returned by <a href="#make-flexi-stream"><code>MAKE-FLEXI-STREAM</code></a> is of this type which is a subtype of <a href="http://www.lispworks.com/documentation/HyperSpec/Body/t_stream.htm"><code>STREAM</code></a>.
-</blockquote>
-
-<p><br>[Standard class]
-<br><a class=none name="flexi-input-stream"><b>flexi-input-stream</b></a>
-
-<blockquote><br>
-A <a href="#flexi-streams"><em>flexi stream</em></a> is of this type if its underlying stream is an <a href="http://www.lispworks.com/documentation/HyperSpec/Body/f_in_stm.htm">input stream</a>. This is a subtype of <a href="#flexi-stream"><code>FLEXI-STREAM</code></a>.
-</blockquote>
-
-<p><br>[Standard class]
-<br><a class=none name="flexi-output-stream"><b>flexi-output-stream</b></a>
-
-<blockquote><br>
-A <a href="#flexi-streams"><em>flexi stream</em></a> is of this type if its underlying stream is an <a href="http://www.lispworks.com/documentation/HyperSpec/Body/f_in_stm.htm">output stream</a>. This is a subtype of <a href="#flexi-stream"><code>FLEXI-STREAM</code></a>.
-</blockquote>
-
-<p><br>[Standard class]
-<br><a class=none name="flexi-io-stream"><b>flexi-io-stream</b></a>
-
-<blockquote><br>
-A <a href="#flexi-streams"><em>flexi stream</em></a> is of this type if it is both a <a href="#flexi-input-stream"><code>FLEXI-INPUT-STREAM</code></a> as well as a <a href="#flexi-output-stream"><code>FLEXI-OUTPUT-STREAM</code></a>.
-</blockquote>
-
-<p><br>[Function]
-<br><a class=none name="make-flexi-stream"><b>make-flexi-stream</b> <i>stream <tt>&key</tt> external-format element-type column position bound</i> => <i>flexi-stream</i></a>
-
-<blockquote><br>
-Creates and returns a <a href="#flexi-streams"><em>flexi stream</em></a>, i.e. an object of type <a href="#flexi-stream"><code>FLEXI-STREAM</code></a>. <code><i>stream</i></code> is the underlying Lisp stream. <code><i>external-format</i></code> is the initial <a href="#external-formats">external format</a> to be used by the stream, the default is the value of evaluating <code>(<a href="#make-external-format">MAKE-EXTERNAL-FORMAT</a> :LATIN1)</code>. <code><i>element-type</i></code> is the initial <a href="http://www.lispworks.com/documentation/HyperSpec/Body/f_stm_el.htm">element type</a> of the flexi stream the default of which is <a href="http://www.lispworks.com/documentation/lw50/LWRM/html/lwref-346.htm"><code>LW:SIMPLE-CHAR</code></a> for LispWorks and <a href="http://www.lispworks.com/documentation/HyperSpec/Body/t_ch.htm"><code>CHARACTER</code></a> otherwise. <code><i>column</i></code> is the initial column of the stream and should only be provided for output streams, the default is <code>0</code>. <code><i>position</i></code> is the initial octet position of the stream and must only be provided for input streams, the default is <code>0</code>. <code><i>bound</i></code> should be <code>NIL</code> (the default) or an integer and must only be provided for input streams. If the octet position of the stream has gone beyond this bound, the stream will behave as if no more input is available. See <a href="#flexi-streams">the section about flexi streams</a> for more information.
-</blockquote>
-
-<p><br>[Accessors]
-<br><a class=none name="flexi-stream-external-format"><b>flexi-stream-external-format</b> <i>flexi-stream</i> => <i>external-format</i></a>
-<br><tt>(setf (</tt><b>flexi-stream-external-format</b> <i>flexi-stream</i>) <i>external-format</i><tt>)</tt>
-<br><a class=none name="flexi-stream-element-type"><b>flexi-stream-element-type</b> <i>flexi-stream</i> => <i>element-type</i></a>
-<br><tt>(setf (</tt><b>flexi-stream-element-type</b> <i>flexi-stream</i>) <i>element-type</i><tt>)</tt>
-<br><a class=none name="flexi-stream-column"><b>flexi-stream-column</b> <i>flexi-output-stream</i> => <i>column</i></a>
-<br><tt>(setf (</tt><b>flexi-stream-column</b> <i>flexi-output-stream</i>) <i>column</i><tt>)</tt>
-<br><a class=none name="flexi-stream-position"><b>flexi-stream-position</b> <i>flexi-input-stream</i> => <i>position</i></a>
-<br><tt>(setf (</tt><b>flexi-stream-position</b> <i>flexi-input-stream</i>) <i>position</i><tt>)</tt>
-<br><a class=none name="flexi-stream-bound"><b>flexi-stream-bound</b> <i>flexi-input-stream</i> => <i>bound</i></a>
-<br><tt>(setf (</tt><b>flexi-stream-bound</b> <i>flexi-input-stream</i>) <i>bound</i><tt>)</tt>
-
-<blockquote><br>
-These methods can be used to get and set the corresponding attributes of a <a href="#flexi-streams">flexi stream</a>.
-<p>
-<a href="#flexi-stream-external-format"><code>(SETF
-FLEXI-STREAM-EXTERNAL-FORMAT)</code></a> accepts keyword symbols
-(<a href="#external-formats">names of external formats</a>), lists
-(which should be valid lists of parameters
-to <a
-href="#make-external-format"><code>MAKE-EXTERNAL-FORMAT</code></a>), or <code>EXTERNAL-FORMAT</code> objects:
-<pre>
-CL-USER 1 > (setf (flexi-stream-external-format *my-stream*) :ucs-4le)
-#<FLEXI-STREAMS::EXTERNAL-FORMAT (:UTF-32 :EOL-STYLE :CRLF :LITTLE-ENDIAN T) 206920DC>
-
-CL-USER 2 > (setf (flexi-stream-external-format *my-stream*) '(:ucs-2be :eol-style :br))
-#<FLEXI-STREAMS::EXTERNAL-FORMAT (:UTF-16 :EOL-STYLE :BR :LITTLE-ENDIAN NIL) 20696934>
-
-CL-USER 3 > (setf (flexi-stream-external-format *my-stream*) (make-external-format :ibm437))
-#<FLEXI-STREAMS::EXTERNAL-FORMAT (:CODE-PAGE :ID 437 :EOL-STYLE :CRLF) 2068716C>
-</pre>
-</blockquote>
-
-<p><br>[Reader]
-<br><a class=none name="flexi-stream-stream"><b>flexi-stream-stream</b> <i>flexi-stream</i> => <i>stream</i></a>
-
-<blockquote><br>
-This method returns the underlying stream of a <a href="#flexi-streams">flexi stream</a>.
-</blockquote>
-
-<p><br>[Generic function]
-<br><a class=none name="unread-byte"><b>unread-byte</b> <i>byte stream</i> => <i>nil</i></a>
-
-<blockquote><br>
-Similar to <a href="http://www.lispworks.com/documentation/HyperSpec/Body/f_unrd_c.htm"><code>UNREAD-CHAR</code></a> in that it "unreads" the last <a href="#octet">octet</a> from
-<code><i>stream</i></code> which must be a <a href="#flexi-streams">flexi stream</a>. Note that you can only call <code>UNREAD-BYTE</code> after a corresponding
-<a href="http://www.lispworks.com/documentation/HyperSpec/Body/f_rd_by.htm"><code>READ-BYTE</code></a>, <em>not</em> after <a href="http://www.lispworks.com/documentation/HyperSpec/Body/f_rd_cha.htm"><code>READ-CHAR</code></a>.
-</blockquote>
-
-<p><br>[Generic function]
-<br><a class=none name="peek-byte"><b>peek-byte</b> <i>stream <tt>&optional</tt> peek-type eof-error-p eof-value</i> => <i>byte</i></a>
-
-<blockquote><br>
-<code>PEEK-BYTE</code> is like <a href="http://www.lispworks.com/documentation/HyperSpec/Body/f_peek_c.htm"><code>PEEK-CHAR</code></a>, i.e. it returns an <a href="#octet">octet</a> from <code><i>stream</i></code> (which must be a <a href="#flexi-streams">flexi stream</a>)
-without actually removing it. If <code><i>peek-type</i></code> is <code>NIL</code>, the next octet is
-returned, if <code><i>peek-type</i></code> is <code>T</code>, the next octet which is not <code>0</code> is
-returned, if <code><i>peek-type</i></code> is an octet, the next octet which equals
-<code><i>peek-type</i></code> is returned. <code><i>eof-error-p</i></code> and <code><i>eof-value</i></code> are interpreted as usual.
-<p>
-Note that the parameters aren't in the same order as with <a href="http://www.lispworks.com/documentation/HyperSpec/Body/f_peek_c.htm"><code>PEEK-CHAR</code></a> because it doesn't make much sense to make <code><i>stream</i></code> an optional argument.
-</blockquote>
-
-<p><br>[Type]
-<br><a class=none name="octet"><b>octet</b></a>
-
-<blockquote><br>
-Just a shortcut for <code>(UNSIGNED-BYTE 8)</code>.
-</blockquote>
-
-<p><br>[Condition]
-<br><a class=none name="flexi-stream-error"><b>flexi-stream-error</b></a>
-
-<blockquote><br>
-All errors related to <a href="#flexi-streams">flexi streams</a> are of this type. This is a subtype of <a href="http://www.lispworks.com/documentation/HyperSpec/Body/e_stm_er.htm"><code>STREAM-ERROR</code></a>.
-</blockquote>
-
-<p><br>[Condition]
-<br><a class=none name="flexi-stream-out-of-sync-error"><b>flexi-stream-out-of-sync-error</b></a>
-
-<blockquote><br> This can happen if you're trying to write to
-an <a href="#flexi-io-stream">IO stream</a> which had prior to that
-"looked ahead" while reading and now can't "rewind" to the octet where
-you <em>should</em> be.
-</blockquote>
-
-<p><br>[Condition]
-<br><a class=none name="flexi-stream-element-type-error"><b>flexi-stream-element-type-error</b></a>
-
-<blockquote><br>
-All errors related to problems with the element type of <a href="#flexi-streams">flexi streams</a> are of this type. This is a subtype of <a href="#flexi-stream-error"><code>FLEXI-STREAM-ERROR</code></a> and has an additional slot for the element type which can be accessed with <a href="#flexi-stream-element-type-error-element-type"><code>FLEXI-STREAM-ELEMENT-TYPE-ERROR-ELEMENT-TYPE</code></a>.
-</blockquote>
-
-<p><br>[Reader]
-<br><a class=none name="flexi-stream-element-type-error-element-type"><b>flexi-stream-element-type-error-element-type</b> <i>condition</i> => <i>element-type</i></a>
-
-<blockquote><br>
-If <code><i>condition</i></code> is of type <a href="#flexi-stream-element-type-error"><code>FLEXI-STREAM-ELEMENT-TYPE-ERROR</code></a>, this function will return the offending element type.
-</blockquote>
-
-<h4><a name="in-memory" class=none>In-memory streams</a></h4>
-
-The library also provides <em>in-memory</em> binary streams which are modeled after <a href="http://www.lispworks.com/documentation/HyperSpec/Body/t_stg_st.htm">string streams</a> and behave very similar only that they deal with <a href="#octet">octets</a> instead of characters and the underlying data structure is not a string but either a list or a vector. These streams can obviously be used as the underlying streams for <a href="#flexi-streams">flexi streams</a>.
-
-<p><br>[Standard class]
-<br><a class=none name="in-memory-stream"><b>in-memory-stream</b></a>
-
-<blockquote><br>
-Every <a href="#in-memory"><em>in-memory stream</em></a> returned by <a href="#make-in-memory-input-stream"><code>MAKE-IN-MEMORY-INPUT-STREAM</code></a> or <a href="#make-in-memory-output-stream"><code>MAKE-IN-MEMORY-OUTPUT-STREAM</code></a> is of this type which is a subtype of <a href="http://www.lispworks.com/documentation/HyperSpec/Body/t_stream.htm"><code>STREAM</code></a>.
-</blockquote>
-
-<p><br>[Standard class]
-<br><a class=none name="in-memory-input-stream"><b>in-memory-input-stream</b></a>
-
-<blockquote><br>
-Every <a href="#in-memory"><em>in-memory stream</em></a> returned by <a href="#make-in-memory-input-stream"><code>MAKE-IN-MEMORY-INPUT-STREAM</code></a> is of this type which is a subtype of <a href="#in-memory-stream"><code>IN-MEMORY-STREAM</code></a>.
-</blockquote>
-
-<p><br>[Standard class]
-<br><a class=none name="in-memory-output-stream"><b>in-memory-output-stream</b></a>
-
-<blockquote><br>
-Every <a href="#in-memory"><em>in-memory stream</em></a> returned by <a href="#make-in-memory-output-stream"><code>MAKE-IN-MEMORY-OUTPUT-STREAM</code></a> is of this type which is a subtype of <a href="#in-memory-stream"><code>IN-MEMORY-STREAM</code></a>.
-</blockquote>
-
-<p><br>[Standard class]
-<br><a class=none name="list-stream"><b>list-stream</b></a>
-
-<blockquote><br>
-Every <a href="#in-memory"><em>in-memory input stream</em></a> is of this type if it reads from a list.
-</blockquote>
-
-<p><br>[Standard class]
-<br><a class=none name="vector-stream"><b>vector-stream</b></a>
-
-<blockquote><br>
-Every <a href="#in-memory"><em>in-memory stream</em></a> is of this type if it reads from or writes to a vector.
-</blockquote>
-
-<p><br>[Generic function]
-<br><a class=none name="make-in-memory-input-stream"><b>make-in-memory-input-stream</b> <i>sequence <tt>&key</tt> start end transformer</i> => <i>in-memory-input-stream</i></a>
-
-<blockquote><br>
-Returns a <a href="http://www.lispworks.com/documentation/HyperSpec/Body/26_glo_b.htm#binary">binary</a> <a href="http://www.lispworks.com/documentation/HyperSpec/Body/26_glo_i.htm#input">input</a> stream (of type <a href="#in-memory-input-stream"><code>IN-MEMORY-INPUT-STREAM</code></a>) which will supply, in order, the
-octets in the subsequence of <code><i>sequence</i></code> bounded by <code><i>start</i></code> (the default is <code>0</code>) and <code><i>end</i></code> (the default is the length of <code><i>sequence</i></code>). <code><i>sequence</i></code> must either be a list or a vector of <a href="#octet">octets</a>.
-Each octet returned will be transformed in turn by the optional
-<code><i>transformer</i></code> function.
-</blockquote>
-
-<p><br>[Function]
-<br><a class=none name="make-in-memory-output-stream"><b>make-in-memory-output-stream</b> <i><tt>&key</tt> element-type transformer</i> => <i>in-memory-output-stream</i></a>
-
-<blockquote><br>
-Returns a <a href="http://www.lispworks.com/documentation/HyperSpec/Body/26_glo_b.htm#binary">binary</a> <a href="http://www.lispworks.com/documentation/HyperSpec/Body/26_glo_o.htm#output">output</a> stream (of type <a href="#in-memory-output-stream"><code>IN-MEMORY-OUTPUT-STREAM</code></a>) which accepts objects of type <code><i>element-type</i></code> (a subtype of <a href="#octet"><code>OCTET</code></a>) and makes
-available a sequence (see <a href="#get-output-stream-sequence"><code>GET-OUTPUT-STREAM-SEQUENCE</code></a>) that contains the octets that were actually
-output. The octets stored will each be transformed by the optional <code><i>transformer</i></code> function.
-</blockquote>
-
-<p><br>[Generic function]
-<br><a class=none name="get-output-stream-sequence"><b>get-output-stream-sequence</b> <i>stream <tt>&key</tt> as-list</i> => <i>sequence</i></a>
-
-<blockquote><br>
-Returns a vector containing, in order, all the octets that have
-been output to the <a href="#in-memory">in-memory output stream</a> <code><i>stream</i></code>. This operation clears any
-octets on <code><i>stream</i></code>, so the vector contains only those octets which have
-been output since the last call to <a href="#get-output-stream-sequence"><code>GET-OUTPUT-STREAM-SEQUENCE</code></a> or since
-the creation of the stream, whichever occurred most recently. If
-<code><i>as-list</i></code> is true the return value is coerced to a list.
-</blockquote>
-
-<p><br>[Generic function]
-<br><a class=none name="output-stream-sequence-length"><b>output-stream-sequence-length</b> <i>stream</i> => <i>length</i></a>
-
-<blockquote><br> Returns the current length of the underlying vector
-of the <a href="#in-memory">in-memory output
-stream</a> <code><i>stream</i></code>, i.e. this is the length of the
-sequence that <a href="#get-output-stream-sequence"><code>GET-OUTPUT-STREAM-SEQUENCE</code></a> would return if called at
-this very moment.
-</blockquote>
-
-<p><br>[Macro]
-<br><a class=none name="with-input-from-sequence"><b>with-input-from-sequence</b> <i>(var sequence <tt>&key</tt> start end transformer) statement*</i> => <i>result*</i></a>
-
-<blockquote><br> Creates an <a href="#in-memory">in-memory input
-stream</a> from the sequence <code><i>sequence</i></code> using the
-parameters <code><i>start</i></code> and <code><i>end</i></code>
-(see <a
-href="#make-in-memory-input-stream"><code>MAKE-IN-MEMORY-INPUT-STREAM</code></a>),
-binds <code><i>var</i></code> to this stream and then executes
-the <code><i>statement*</i></code> forms. A
-function <code><i>transformer</i></code> may optionally be specified
-to transform the returned octets. The stream is automatically closed
-on exit from
-<a href="#with-output-to-sequence"><code>WITH-OUTPUT-TO-SEQUENCE</code></a>, no matter whether the exit is normal or
-abnormal. The return value of this macro is the return value of
-the last statement of <code><i>statement*</i></code>.
-</blockquote>
-
-<p><br>[Macro]
-<br><a class=none name="with-output-to-sequence"><b>with-output-to-sequence</b> <i>(var <tt>&key</tt> as-list element-type transformer) statement*</i> => <i>sequence</i></a>
-
-<blockquote><br>
-Creates an <a href="#in-memory">in-memory output stream</a>, binds <code><i>var</i></code> to this stream and
-then executes the <code><i>statement*</i></code> forms. The stream stores
-data of type <code><i>element-type</i></code> (a subtype of <a href="#octet"><code>OCTET</code></a>) which is (optionally) transformed by the
-function <code><i>transformer</i></code> prior to storage. The stream is automatically closed on
-exit from <a href="#with-output-to-sequence"><code>WITH-OUTPUT-TO-SEQUENCE</code></a>, no matter whether the exit is
-normal or abnormal. The return value of this macro is a vector (or a
-list if <code><i>as-list</i></code> is true) containing the octets that were sent to the
-stream within the body of the macro.
-</blockquote>
-
-<p><br>[Condition]
-<br><a class=none name="in-memory-stream-error"><b>in-memory-stream-error</b></a>
-
-<blockquote><br>
-All errors related to <a href="#in-memory">in-memory streams</a> are of this type. This is a subtype of <a href="http://www.lispworks.com/documentation/HyperSpec/Body/e_stm_er.htm"><code>STREAM-ERROR</code></a>.
-</blockquote>
-
-<p><br>[Condition]
-<br><a class=none name="in-memory-stream-closed-error"><b>in-memory-stream-closed-error</b></a>
-
-<blockquote><br>
-An error of this type is signalled if one tries to read from or write to an <a href="#in-memory">in-memory stream</a> which had already been closed. This is a subtype of <a href="#in-memory-stream-error"><code>IN-MEMORY-STREAM-ERROR</code></a>.
-</blockquote>
-
-<p><br>[Condition]
-<br><a class=none name="in-memory-stream-position-spec-error"><b>in-memory-stream-position-spec-error</b></a>
-
-<blockquote><br> Errors of this type are signalled if an erroneous
-position spec is used in conjunction
-with <a href="#position"><code>FILE-POSITION</code></a>. This is a
-subtype
-of <a href="#in-memory-stream-error"><code>IN-MEMORY-STREAM-ERROR</code></a>
-and has an additional slot for the position spec which can be accessed
-with <a href="#in-memory-stream-position-spec-error-position-spec"><code>IN-MEMORY-STREAM-POSITION-SPEC-ERROR-POSITION-SPEC</code></a>.
-</blockquote>
-
-<p><br>[Reader]
-<br><a class=none name="in-memory-stream-position-spec-error-position-spec"><b>in-memory-stream-position-spec-error-position-spec</b> <i>condition</i> => <i>position-spec</i></a>
-
-<blockquote><br>
-If <code><i>condition</i></code> is of type <a href="#in-memory-stream-position-spec-error"><code>IN-MEMORY-STREAM-POSITION-SPEC-ERROR</code></a>, this function will return the offending position spec.
-</blockquote>
-
-<h4><a name="strings" class=none>Strings</a></h4>
-
-This section collects a few convenience functions for strings conversions.
-
-<p><br>[Function]
-<br><a class=none name="string-to-octets"><b>string-to-octets</b> <i>string <tt>&key</tt> external-format start end</i> => <i>vector</i></a>
-
-<blockquote><br>
-
-Converts the Lisp string <code><i>string</i></code> from <code><i>start</i></code> to <code><i>end</i></code> to an array of
-<a href="#octet">octets</a> corresponding to the <a href="#external-formats">external
-format</a> designated by <code><i>external-format</i></code>. The defaults for
-<code><i>start</i></code> and <code><i>end</i></code>
-are <code>0</code> and the length of the string. The default
-for <code><i>external-format</i></code> is <code>:LATIN1</code>.
-<p>
-In spite of the name, <code><i>string</i></code> can be any sequence of characters, but
-the function is optimized for strings.
-</blockquote>
-
-<p><br>[Function]
-<br><a class=none name="octets-to-string"><b>octets-to-string</b> <i>sequence <tt>&key</tt> external-format start end</i> => <i>string</i></a>
-
-<blockquote><br> Converts the Lisp
-sequence <code><i>sequence</i></code> of <a href="#octet">octets</a>
-from <code><i>start</i></code> to <code><i>end</i></code> to a string
-using the <a href="#external-formats">external format</a> designated
-by <code><i>external-format</i></code>. The defaults for
-<code><i>start</i></code> and <code><i>end</i></code>
-are <code>0</code> and the length of the sequence. The default
-for <code><i>external-format</i></code> is <code>:LATIN1</code>.
-<p>
-This function is optimized for the case
-of <code><i>sequence</i></code> being
-a <a href="http://www.lispworks.com/documentation/HyperSpec/Body/t_vector.htm">vector</a>.
-Don't use lists if you are in hurry.
-</blockquote>
-
-<p><br>[Function]
-<br><a class=none name="octet-length"><b>octet-length</b> <i>string <tt>&key</tt> external-format start end</i> => <i>length</i></a>
-
-<blockquote><br>
-
-Returns the length of the subsequence of <code><i>string</i></code> from <code><i>start</i></code> to <code><i>end</i></code> in
-<a href="#octet">octets</a> if encoded using
-the <a href="#external-formats">external format</a> designated
-by <code><i>external-format</i></code>.
-The defaults for
-<code><i>start</i></code> and <code><i>end</i></code>
-are <code>0</code> and the length of <code><i>string</i></code>. The default
-for <code><i>external-format</i></code> is <code>:LATIN1</code>.
-<p>
-In spite of the name, <code><i>string</i></code> can be any sequence of characters, but
-the function is optimized for strings.
-</blockquote>
-
-<p><br>[Function]
-<br><a class=none name="char-length"><b>char-length</b> <i>sequence <tt>&key</tt> external-format start end</i> => <i>length</i></a>
-
-<blockquote><br>
-
-Kind of the inverse of <a href="#octet-length"><code>OCTET-LENGTH</code></a>.
-Returns the length of the subsequence (of <a href="#octet">octets</a>) of <code><i>sequence</i></code> from <code><i>start</i></code> to <code><i>end</i></code> in
-characters if decoded using
-the <a href="#external-formats">external format</a> designated
-by <code><i>external-format</i></code>.
-The defaults for
-<code><i>start</i></code> and <code><i>end</i></code>
-are <code>0</code> and the length of the sequence. The default
-for <code><i>external-format</i></code> is <code>:LATIN1</code>. Note that this function doesn't check for the validity of the data in <code><i>sequence</i></code>.
-<p>
-This function is optimized for the case
-of <code><i>sequence</i></code> being
-a <a href="http://www.lispworks.com/documentation/HyperSpec/Body/t_vector.htm">vector</a>.
-Don't use lists if you are in hurry.
-</blockquote>
-
-<br> <br><h3><a class=none name="position">File positions</a></h3>
-
-For <a href="#flexi-streams">flexi streams</a> as well
-as for <a href="#input-memory">in-memory
-streams</a>, <a
-href="http://www.lispworks.com/documentation/HyperSpec/Body/f_file_p.htm">FILE-POSITION</a>
-will usually return <code>NIL</code> and do nothing when a second
-argument is supplied. This is correct
-w.r.t. the <a
-href="http://www.lispworks.com/documentation/HyperSpec/">ANSI
-standard</a>, but not very helpful. However, even
-with <a
-href="http://www.nhplace.com/kent/CL/Issues/stream-definition-by-user.html">Gray
-streams</a> there is no <em>portable</em> way to implement a better
-behaviour.
-<p>
-For <a href="http://www.lispworks.com/">LispWorks</a>
-and <a href="http://clisp.sf.net/">CLISP</a>,
-<a
-href="http://www.lispworks.com/documentation/HyperSpec/Body/f_file_p.htm">FILE-POSITION</a>
-for <a href="#flexi-streams">flexi streams</a> will work as if the
-function had been applied to the underlying stream, and
-for <a href="#input-memory">in-memory streams</a> it will try to do
-something sensible if the underlying data structure is a vector
-(i.e. <em>not</em> a list). Patches for other Common Lisp
-implementations should be sent to
-the <a
-href="http://common-lisp.net/project/cl-plus-ssl/#trivial-gray-streams">trivial-gray-streams</a>
-maintainers.
-
-<br> <br><h3><a class=none name="ack">Acknowledgements</a></h3>
-
-Thanks to David Lichteblau for numerous portability patches. Thanks
-to Igor Plekhov for the KOI8-R code. Thanks to Anton Vodonosov for
-numerous patches and additions. Thanks
-to <a href="http://netzhansa.blogspot.com/">Hans Hübner</a> for
-his work on making FLEXI-STREAMS faster.
-
-</body>
-</html>
(DIR) diff --git a/3rdparties/software/flexi-streams-20190107-git/encode.lisp b/3rdparties/software/flexi-streams-20190107-git/encode.lisp
@@ -1,282 +0,0 @@
-;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: FLEXI-STREAMS; Base: 10 -*-
-;;; $Header: /usr/local/cvsrep/flexi-streams/encode.lisp,v 1.26 2008/05/26 10:55:08 edi Exp $
-
-;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved.
-
-;;; Redistribution and use in source and binary forms, with or without
-;;; modification, are permitted provided that the following conditions
-;;; are met:
-
-;;; * Redistributions of source code must retain the above copyright
-;;; notice, this list of conditions and the following disclaimer.
-
-;;; * Redistributions in binary form must reproduce the above
-;;; copyright notice, this list of conditions and the following
-;;; disclaimer in the documentation and/or other materials
-;;; provided with the distribution.
-
-;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED
-;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
-;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
-;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
-;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
-;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
-;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
-;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
-;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
-;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
-;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-
-(in-package :flexi-streams)
-
-(defgeneric char-to-octets (format char writer)
- (declare #.*standard-optimize-settings*)
- (:documentation "Converts the character CHAR to a sequence of octets
-using the external format FORMAT. The conversion is performed by
-calling the unary function \(which must be a functional object) WRITER
-repeatedly each octet. The return value of this function is
-unspecified."))
-
-(defgeneric write-sequence* (format stream sequence start end)
- (declare #.*standard-optimize-settings*)
- (:documentation "A generic function which dispatches on the external
-format and does the real work for STREAM-WRITE-SEQUENCE."))
-
-(defgeneric string-to-octets* (format string start end)
- (declare #.*standard-optimize-settings*)
- (:documentation "A generic function which dispatches on the external
-format and does the real work for STRING-TO-OCTETS."))
-
-(defmethod string-to-octets* :around (format (list list) start end)
- (declare #.*standard-optimize-settings*)
- (string-to-octets* format (coerce list 'string*) start end))
-
-(defmacro define-sequence-writers ((format-class) &body body)
- "Non-hygienic utility macro which defines methods for
-WRITE-SEQUENCE* and STRING-TO-OCTETS* for the class FORMAT-CLASS. For
-BODY see the docstring of DEFINE-CHAR-ENCODERS."
- (let ((body `((locally
- (declare #.*fixnum-optimize-settings*)
- ,@body))))
- `(progn
- (defmethod string-to-octets* ((format ,format-class) string start end)
- (declare #.*standard-optimize-settings*)
- (declare (fixnum start end) (string string))
- (let ((octets (make-array (compute-number-of-octets format string start end)
- :element-type 'octet))
- (j 0))
- (declare (fixnum j))
- (loop for i of-type fixnum from start below end do
- (macrolet ((octet-writer (form)
- `(progn
- (setf (aref (the (array octet *) octets) j) ,form)
- (incf j))))
- (symbol-macrolet ((char-getter (char string i)))
- (progn ,@body))))
- octets))
- (defmethod write-sequence* ((format ,format-class) stream sequence start end)
- (declare #.*standard-optimize-settings*)
- (declare (fixnum start end))
- (with-accessors ((column flexi-stream-column))
- stream
- (let* ((octet-seen-p nil)
- (buffer-pos 0)
- ;; estimate should be good enough...
- (factor (encoding-factor format))
- ;; we don't want arbitrarily large buffer, do we?
- (buffer-size (min +buffer-size+ (ceiling (* factor (- end start)))))
- (buffer (make-octet-buffer buffer-size))
- (underlying-stream (flexi-stream-stream stream)))
- (declare (fixnum buffer-pos buffer-size)
- (boolean octet-seen-p)
- (type (array octet *) buffer))
- (macrolet ((octet-writer (form)
- `(write-octet ,form)))
- (labels ((flush-buffer ()
- "Sends all octets in BUFFER to the underlying stream."
- (write-sequence buffer underlying-stream :end buffer-pos)
- (setq buffer-pos 0))
- (write-octet (octet)
- "Adds one octet to the buffer and flushes it if necessary."
- (declare (type octet octet))
- (when (>= buffer-pos buffer-size)
- (flush-buffer))
- (setf (aref buffer buffer-pos) octet)
- (incf buffer-pos))
- (write-object (object)
- "Dispatches to WRITE-OCTET or WRITE-CHARACTER
-depending on the type of OBJECT."
- (etypecase object
- (octet (setq octet-seen-p t)
- (write-octet object))
- (character (symbol-macrolet ((char-getter object))
- ,@body)))))
- (macrolet ((iterate (&body output-forms)
- "An unhygienic macro to implement the actual
-iteration through SEQUENCE. OUTPUT-FORM is the form to retrieve one
-sequence element and put its octet representation into the buffer."
- `(loop for index of-type fixnum from start below end
- do (progn ,@output-forms)
- finally (when (plusp buffer-pos)
- (flush-buffer)))))
- (etypecase sequence
- (string (iterate
- (symbol-macrolet ((char-getter (char sequence index)))
- ,@body)))
- (array (iterate
- (symbol-macrolet ((char-getter (aref sequence index)))
- ,@body)))
- (list (iterate (write-object (nth index sequence))))))
- ;; update the column slot, setting it to NIL if we sent
- ;; octets
- (setq column
- (cond (octet-seen-p nil)
- (t (let ((last-newline-pos (position #\Newline sequence
- :test #'char=
- :start start
- :end end
- :from-end t)))
- (cond (last-newline-pos (- end last-newline-pos 1))
- (column (+ column (- end start))))))))))))))))
-
-(defmacro define-char-encoders ((lf-format-class cr-format-class crlf-format-class) &body body)
- "Non-hygienic utility macro which defines several encoding-related
-methods for the classes LF-FORMAT-CLASS, CR-FORMAT-CLASS, and
-CRLF-FORMAT-CLASS where it is assumed that CR-FORMAT-CLASS is the same
-encoding as LF-FORMAT-CLASS but with CR instead of LF line endings and
-similar for CRLF-FORMAT-CLASS, i.e. LF-FORMAT-CLASS is the base class.
-BODY is a code template for the code to convert one character to
-octets. BODY must contain a symbol CHAR-GETTER representing the form
-which is used to obtain the character and a forms like \(OCTET-WRITE
-<thing>) to write the octet <thing>. The CHAR-GETTER form might be
-called more than once."
- `(progn
- (defmethod char-to-octets ((format ,lf-format-class) char writer)
- (declare #.*fixnum-optimize-settings*)
- (declare (character char) (function writer))
- (symbol-macrolet ((char-getter char))
- (macrolet ((octet-writer (form)
- `(funcall writer ,form)))
- ,@body)))
- (define-sequence-writers (,lf-format-class) ,@body)
- (define-sequence-writers (,cr-format-class)
- ;; modify the body so that the getter replaces a #\Newline
- ;; with a #\Return
- ,@(sublis `((char-getter . ,(with-unique-names (char)
- `(let ((,char char-getter))
- (declare (character ,char))
- (if (char= ,char #\Newline)
- #\Return
- ,char)))))
- body))
- (define-sequence-writers (,crlf-format-class)
- ;; modify the body so that we potentially write octets for
- ;; two characters (#\Return and #\Linefeed) - the original
- ;; body is wrapped with the WRITE-CHAR local function
- ,(with-unique-names (char write-char)
- `(flet ((,write-char (,char)
- ,@(sublis `((char-getter . ,char)) body)))
- (let ((,char char-getter))
- (declare (character ,char))
- (cond ((char= ,char #\Newline)
- (,write-char #\Return)
- (,write-char #\Linefeed))
- (t (,write-char ,char)))))))))
-
-(define-char-encoders (flexi-latin-1-format flexi-cr-latin-1-format flexi-crlf-latin-1-format)
- (let ((octet (char-code char-getter)))
- (when (> octet 255)
- (signal-encoding-error format "~S (code ~A) is not a LATIN-1 character." char-getter octet))
- (octet-writer octet)))
-
-(define-char-encoders (flexi-ascii-format flexi-cr-ascii-format flexi-crlf-ascii-format)
- (let ((octet (char-code char-getter)))
- (when (> octet 127)
- (signal-encoding-error format "~S (code ~A) is not an ASCII character." char-getter octet))
- (octet-writer octet)))
-
-(define-char-encoders (flexi-8-bit-format flexi-cr-8-bit-format flexi-crlf-8-bit-format)
- (with-accessors ((encoding-hash external-format-encoding-hash))
- format
- (let ((octet (gethash (char-code char-getter) encoding-hash)))
- (unless octet
- (signal-encoding-error format "~S (code ~A) is not in this encoding." char-getter octet))
- (octet-writer octet))))
-
-(define-char-encoders (flexi-utf-8-format flexi-cr-utf-8-format flexi-crlf-utf-8-format)
- ;; the old version using LDB was more elegant, but some Lisps had
- ;; trouble optimizing it
- (let ((char-code (char-code char-getter)))
- (tagbody
- (cond ((< char-code #x80)
- (octet-writer char-code)
- (go zero))
- ((< char-code #x800)
- (octet-writer (logior* #b11000000 (ash* char-code -6)))
- (go one))
- ((< char-code #x10000)
- (octet-writer (logior* #b11100000 (ash* char-code -12)))
- (go two))
- (t
- (octet-writer (logior* #b11110000 (ash* char-code -18)))))
- (octet-writer (logior* #b10000000 (logand* #b00111111 (ash* char-code -12))))
- two
- (octet-writer (logior* #b10000000 (logand* #b00111111 (ash* char-code -6))))
- one
- (octet-writer (logior* #b10000000 (logand* #b00111111 char-code)))
- zero)))
-
-(define-char-encoders (flexi-utf-16-le-format flexi-cr-utf-16-le-format flexi-crlf-utf-16-le-format)
- (flet ((write-word (word)
- (octet-writer (logand* #x00ff word))
- (octet-writer (ash* (logand* #xff00 word) -8))))
- (declare (inline write-word))
- (let ((char-code (char-code char-getter)))
- (declare (type char-code-integer char-code))
- (cond ((< char-code #x10000)
- (write-word char-code))
- (t (decf char-code #x10000)
- (write-word (logior* #xd800 (ash* char-code -10)))
- (write-word (logior* #xdc00 (logand* #x03ff char-code))))))))
-
-(define-char-encoders (flexi-utf-16-be-format flexi-cr-utf-16-be-format flexi-crlf-utf-16-be-format)
- (flet ((write-word (word)
- (octet-writer (ash* (logand* #xff00 word) -8))
- (octet-writer (logand* #x00ff word))))
- (declare (inline write-word))
- (let ((char-code (char-code char-getter)))
- (declare (type char-code-integer char-code))
- (cond ((< char-code #x10000)
- (write-word char-code))
- (t (decf char-code #x10000)
- (write-word (logior* #xd800 (ash* char-code -10)))
- (write-word (logior* #xdc00 (logand* #x03ff char-code))))))))
-
-(define-char-encoders (flexi-utf-32-le-format flexi-cr-utf-32-le-format flexi-crlf-utf-32-le-format)
- (let ((char-code (char-code char-getter)))
- (octet-writer (logand* #x00ff char-code))
- (octet-writer (logand* #x00ff (ash* char-code -8)))
- (octet-writer (logand* #x00ff (ash* char-code -16)))
- (octet-writer (logand* #x00ff (ash* char-code -24)))))
-
-(define-char-encoders (flexi-utf-32-be-format flexi-cr-utf-32-be-format flexi-crlf-utf-32-be-format)
- (let ((char-code (char-code char-getter)))
- (octet-writer (logand* #x00ff (ash* char-code -24)))
- (octet-writer (logand* #x00ff (ash* char-code -16)))
- (octet-writer (logand* #x00ff (ash* char-code -8)))
- (octet-writer (logand* #x00ff char-code))))
-
-(defmethod char-to-octets ((format flexi-cr-mixin) char writer)
- (declare #.*fixnum-optimize-settings*)
- (declare (character char))
- (if (char= char #\Newline)
- (call-next-method format #\Return writer)
- (call-next-method)))
-
-(defmethod char-to-octets ((format flexi-crlf-mixin) char writer)
- (declare #.*fixnum-optimize-settings*)
- (declare (character char))
- (cond ((char= char #\Newline)
- (call-next-method format #\Return writer)
- (call-next-method format #\Linefeed writer))
- (t (call-next-method))))
(DIR) diff --git a/3rdparties/software/flexi-streams-20190107-git/external-format.lisp b/3rdparties/software/flexi-streams-20190107-git/external-format.lisp
@@ -1,389 +0,0 @@
-;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: FLEXI-STREAMS; Base: 10 -*-
-;;; $Header: /usr/local/cvsrep/flexi-streams/external-format.lisp,v 1.24 2008/05/26 10:55:08 edi Exp $
-
-;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved.
-
-;;; Redistribution and use in source and binary forms, with or without
-;;; modification, are permitted provided that the following conditions
-;;; are met:
-
-;;; * Redistributions of source code must retain the above copyright
-;;; notice, this list of conditions and the following disclaimer.
-
-;;; * Redistributions in binary form must reproduce the above
-;;; copyright notice, this list of conditions and the following
-;;; disclaimer in the documentation and/or other materials
-;;; provided with the distribution.
-
-;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED
-;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
-;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
-;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
-;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
-;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
-;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
-;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
-;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
-;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
-;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-
-(in-package :flexi-streams)
-
-(defclass external-format ()
- ((name :initarg :name
- :reader external-format-name
- :documentation "The name of the external format - a
-keyword.")
- (id :initarg :id
- :initform nil
- :reader external-format-id
- :documentation "If the external format denotes a Windows
-code page this ID specifies which one to use. Otherwise the
-value is ignored \(and usually NIL).")
- (little-endian :initarg :little-endian
- :initform *default-little-endian*
- :reader external-format-little-endian
- :documentation "Whether multi-octet values are
-read and written with the least significant octet first. For
-8-bit encodings like :ISO-8859-1 this value is ignored.")
- (eol-style :initarg :eol-style
- :reader external-format-eol-style
- :documentation "The character\(s) to or from which
-a #\Newline will be translated - one of the keywords :CR, :LF,
-or :CRLF."))
- (:documentation "EXTERNAL-FORMAT objects are used to denote
-encodings for flexi streams or for the string functions defined in
-strings.lisp."))
-
-(defmethod make-load-form ((thing external-format) &optional environment)
- "Defines a way to reconstruct external formats. Needed for OpenMCL."
- (make-load-form-saving-slots thing :environment environment))
-
-(defclass flexi-cr-mixin ()
- ()
- (:documentation "A mixin for external-formats where the end-of-line
-designator is #\Return."))
-
-(defclass flexi-crlf-mixin ()
- ()
- (:documentation "A mixin for external-formats where the end-of-line
-designator is the sequence #\Return #\Linefeed."))
-
-(defclass flexi-8-bit-format (external-format)
- ((encoding-hash :accessor external-format-encoding-hash)
- (decoding-table :accessor external-format-decoding-table))
- (:documentation "The class for all flexi streams which use an 8-bit
-encoding and thus need additional slots for the encoding/decoding
-tables."))
-
-(defclass flexi-cr-8-bit-format (flexi-cr-mixin flexi-8-bit-format)
- ()
- (:documentation "Special class for external formats which use an
-8-bit encoding /and/ have #\Return as the line-end character."))
-
-(defclass flexi-crlf-8-bit-format (flexi-crlf-mixin flexi-8-bit-format)
- ()
- (:documentation "Special class for external formats which use an
-8-bit encoding /and/ have the sequence #\Return #\Linefeed as the
-line-end character."))
-
-(defclass flexi-ascii-format (flexi-8-bit-format)
- ()
- (:documentation "Special class for external formats which use the
-US-ASCII encoding."))
-
-(defclass flexi-cr-ascii-format (flexi-cr-mixin flexi-ascii-format)
- ()
- (:documentation "Special class for external formats which use the
-US-ASCII encoding /and/ have #\Return as the line-end character."))
-
-(defclass flexi-crlf-ascii-format (flexi-crlf-mixin flexi-ascii-format)
- ()
- (:documentation "Special class for external formats which use the
-US-ASCII encoding /and/ have the sequence #\Return #\Linefeed as the
-line-end character."))
-
-(defclass flexi-latin-1-format (flexi-8-bit-format)
- ()
- (:documentation "Special class for external formats which use the
-ISO-8859-1 encoding."))
-
-(defclass flexi-cr-latin-1-format (flexi-cr-mixin flexi-latin-1-format)
- ()
- (:documentation "Special class for external formats which use the
-ISO-8859-1 encoding /and/ have #\Return as the line-end character."))
-
-(defclass flexi-crlf-latin-1-format (flexi-crlf-mixin flexi-latin-1-format)
- ()
- (:documentation "Special class for external formats which use the
-ISO-8859-1 encoding /and/ have the sequence #\Return #\Linefeed as the
-line-end character."))
-
-(defclass flexi-utf-32-format (external-format)
- ()
- (:documentation "Abstract class for external formats which use the
-UTF-32 encoding."))
-
-(defclass flexi-utf-32-le-format (flexi-utf-32-format)
- ()
- (:documentation "Special class for external formats which use the
-UTF-32 encoding with little-endian byte ordering."))
-
-(defclass flexi-cr-utf-32-le-format (flexi-cr-mixin flexi-utf-32-le-format)
- ()
- (:documentation "Special class for external formats which use the
-UTF-32 encoding with little-endian byte ordering /and/ have #\Return
-as the line-end character."))
-
-(defclass flexi-crlf-utf-32-le-format (flexi-crlf-mixin flexi-utf-32-le-format)
- ()
- (:documentation "Special class for external formats which use the
-UTF-32 encoding with little-endian byte ordering /and/ have the
-sequence #\Return #\Linefeed as the line-end character."))
-
-(defclass flexi-utf-32-be-format (flexi-utf-32-format)
- ()
- (:documentation "Special class for external formats which use the
-UTF-32 encoding with big-endian byte ordering."))
-
-(defclass flexi-cr-utf-32-be-format (flexi-cr-mixin flexi-utf-32-be-format)
- ()
- (:documentation "Special class for external formats which use the
-UTF-32 encoding with big-endian byte ordering /and/ have #\Return as
-the line-end character."))
-
-(defclass flexi-crlf-utf-32-be-format (flexi-crlf-mixin flexi-utf-32-be-format)
- ()
- (:documentation "Special class for external formats which use the
-the UTF-32 encoding with big-endian byte ordering /and/ have the
-sequence #\Return #\Linefeed as the line-end character."))
-
-(defclass flexi-utf-16-format (external-format)
- ()
- (:documentation "Abstract class for external formats which use the
-UTF-16 encoding."))
-
-(defclass flexi-utf-16-le-format (flexi-utf-16-format)
- ()
- (:documentation "Special class for external formats which use the
-UTF-16 encoding with little-endian byte ordering."))
-
-(defclass flexi-cr-utf-16-le-format (flexi-cr-mixin flexi-utf-16-le-format)
- ()
- (:documentation "Special class for external formats which use the
-UTF-16 encoding with little-endian byte ordering /and/ have #\Return
-as the line-end character."))
-
-(defclass flexi-crlf-utf-16-le-format (flexi-crlf-mixin flexi-utf-16-le-format)
- ()
- (:documentation "Special class for external formats which use the
-UTF-16 encoding with little-endian byte ordering /and/ have the
-sequence #\Return #\Linefeed as the line-end character."))
-
-(defclass flexi-utf-16-be-format (flexi-utf-16-format)
- ()
- (:documentation "Special class for external formats which use the
-UTF-16 encoding with big-endian byte ordering."))
-
-(defclass flexi-cr-utf-16-be-format (flexi-cr-mixin flexi-utf-16-be-format)
- ()
- (:documentation "Special class for external formats which use the
-UTF-16 encoding with big-endian byte ordering /and/ have #\Return as
-the line-end character."))
-
-(defclass flexi-crlf-utf-16-be-format (flexi-crlf-mixin flexi-utf-16-be-format)
- ()
- (:documentation "Special class for external formats which use the
-UTF-16 encoding with big-endian byte ordering /and/ have the sequence
-#\Return #\Linefeed as the line-end character."))
-
-(defclass flexi-utf-8-format (external-format)
- ()
- (:documentation "Special class for external formats which use the
-UTF-8 encoding."))
-
-(defclass flexi-cr-utf-8-format (flexi-cr-mixin flexi-utf-8-format)
- ()
- (:documentation "Special class for external formats which use the
-UTF-8 encoding /and/ have #\Return as the line-end character."))
-
-(defclass flexi-crlf-utf-8-format (flexi-crlf-mixin flexi-utf-8-format)
- ()
- (:documentation "Special class for external formats which use the
-UTF-8 encoding /and/ have the sequence #\Return #\Linefeed as the
-line-end character."))
-
-(defmethod initialize-instance :after ((external-format flexi-8-bit-format) &rest initargs)
- "Sets the fixed encoding/decoding tables for this particular
-external format."
- (declare #.*standard-optimize-settings*)
- (declare (ignore initargs))
- (with-accessors ((encoding-hash external-format-encoding-hash)
- (decoding-table external-format-decoding-table)
- (name external-format-name)
- (id external-format-id))
- external-format
- (multiple-value-setq (encoding-hash decoding-table)
- (cond ((ascii-name-p name)
- (values +ascii-hash+ +ascii-table+))
- ((koi8-r-name-p name)
- (values +koi8-r-hash+ +koi8-r-table+))
- ((iso-8859-name-p name)
- (values (cdr (assoc name +iso-8859-hashes+ :test #'eq))
- (cdr (assoc name +iso-8859-tables+ :test #'eq))))
- ((code-page-name-p name)
- (values (cdr (assoc id +code-page-hashes+))
- (cdr (assoc id +code-page-tables+))))))))
-
-(defun external-format-class-name (real-name &key eol-style little-endian id)
- "Given the initargs for a general external format returns the name
-\(a symbol) of the most specific subclass matching these arguments."
- (declare #.*standard-optimize-settings*)
- (declare (ignore id))
- (cond ((ascii-name-p real-name)
- (ecase eol-style
- (:lf 'flexi-ascii-format)
- (:cr 'flexi-cr-ascii-format)
- (:crlf 'flexi-crlf-ascii-format)))
- ((eq real-name :iso-8859-1)
- (ecase eol-style
- (:lf 'flexi-latin-1-format)
- (:cr 'flexi-cr-latin-1-format)
- (:crlf 'flexi-crlf-latin-1-format)))
- ((or (koi8-r-name-p real-name)
- (iso-8859-name-p real-name)
- (code-page-name-p real-name))
- (ecase eol-style
- (:lf 'flexi-8-bit-format)
- (:cr 'flexi-cr-8-bit-format)
- (:crlf 'flexi-crlf-8-bit-format)))
- (t (ecase real-name
- (:utf-8 (ecase eol-style
- (:lf 'flexi-utf-8-format)
- (:cr 'flexi-cr-utf-8-format)
- (:crlf 'flexi-crlf-utf-8-format)))
- (:utf-16 (ecase eol-style
- (:lf (if little-endian
- 'flexi-utf-16-le-format
- 'flexi-utf-16-be-format))
- (:cr (if little-endian
- 'flexi-cr-utf-16-le-format
- 'flexi-cr-utf-16-be-format))
- (:crlf (if little-endian
- 'flexi-crlf-utf-16-le-format
- 'flexi-crlf-utf-16-be-format))))
- (:utf-32 (ecase eol-style
- (:lf (if little-endian
- 'flexi-utf-32-le-format
- 'flexi-utf-32-be-format))
- (:cr (if little-endian
- 'flexi-cr-utf-32-le-format
- 'flexi-cr-utf-32-be-format))
- (:crlf (if little-endian
- 'flexi-crlf-utf-32-le-format
- 'flexi-crlf-utf-32-be-format))))))))
-
-(defun make-external-format% (name &key (little-endian *default-little-endian*)
- id eol-style)
- "Used internally by MAKE-EXTERNAL-FORMAT to default some of the
-keywords arguments and to determine the right subclass of
-EXTERNAL-FORMAT."
- (declare #.*standard-optimize-settings*)
- (let* ((real-name (normalize-external-format-name name))
- (initargs
- (cond ((or (iso-8859-name-p real-name)
- (koi8-r-name-p real-name)
- (ascii-name-p real-name))
- (list :eol-style (or eol-style *default-eol-style*)))
- ((code-page-name-p real-name)
- (list :id (or (known-code-page-id-p id)
- (error 'external-format-error
- :format-control "Unknown code page ID ~S"
- :format-arguments (list id)))
- ;; default EOL style for Windows code pages is :CRLF
- :eol-style (or eol-style :crlf)))
- (t (list :eol-style (or eol-style *default-eol-style*)
- :little-endian little-endian)))))
- (apply #'make-instance (apply #'external-format-class-name real-name initargs)
- :name real-name
- initargs)))
-
-(defun make-external-format (name &rest args
- &key (little-endian *default-little-endian*)
- id eol-style)
- "Creates and returns an external format object as specified.
-NAME is a keyword like :LATIN1 or :UTF-8, LITTLE-ENDIAN specifies
-the `endianess' of the external format and is ignored for 8-bit
-encodings, EOL-STYLE is one of the keywords :CR, :LF, or :CRLF
-which denote the end-of-line character \(sequence), ID is the ID
-of a Windows code page \(and ignored for other encodings)."
- (declare #.*standard-optimize-settings*)
- ;; the keyword arguments are only there for arglist display in the IDE
- (declare (ignore id little-endian))
- (let ((shortcut-args (cdr (assoc name +shortcut-map+ :test #'string-equal))))
- (cond (shortcut-args
- (apply #'make-external-format%
- (append shortcut-args
- `(:eol-style ,eol-style))))
- (t (apply #'make-external-format% name args)))))
-
-(defun maybe-convert-external-format (external-format)
- "Given an external format designator \(a keyword, a list, or an
-EXTERNAL-FORMAT object) returns the corresponding EXTERNAL-FORMAT
-object."
- (declare #.*standard-optimize-settings*)
- (typecase external-format
- (symbol (make-external-format external-format))
- (list (apply #'make-external-format external-format))
- (otherwise external-format)))
-
-(defun external-format-equal (ef1 ef2)
- "Checks whether two EXTERNAL-FORMAT objects denote the same encoding."
- (declare #.*standard-optimize-settings*)
- (let* ((name1 (external-format-name ef1))
- (code-page-name-p (code-page-name-p name1)))
- ;; they must habe the same canonical name
- (and (eq name1
- (external-format-name ef2))
- ;; if both are code pages the IDs must be the same
- (or (not code-page-name-p)
- (eql (external-format-id ef1)
- (external-format-id ef2)))
- ;; for non-8-bit encodings the endianess must be the same
- (or code-page-name-p
- (ascii-name-p name1)
- (koi8-r-name-p name1)
- (iso-8859-name-p name1)
- (eq name1 :utf-8)
- (eq (not (external-format-little-endian ef1))
- (not (external-format-little-endian ef2))))
- ;; the EOL style must also be the same
- (eq (external-format-eol-style ef1)
- (external-format-eol-style ef2)))))
-
-(defun normalize-external-format (external-format)
- "Returns a list which is a `normalized' representation of the
-external format EXTERNAL-FORMAT. Used internally by PRINT-OBJECT, for
-example. Basically, the result is an argument list that can be fed
-back to MAKE-EXTERNAL-FORMAT to create an equivalent object."
- (declare #.*standard-optimize-settings*)
- (let ((name (external-format-name external-format))
- (eol-style (external-format-eol-style external-format)))
- (cond ((or (ascii-name-p name)
- (koi8-r-name-p name)
- (iso-8859-name-p name)
- (eq name :utf-8))
- (list name :eol-style eol-style))
- ((code-page-name-p name)
- (list name
- :id (external-format-id external-format)
- :eol-style eol-style))
- (t (list name
- :eol-style eol-style
- :little-endian (external-format-little-endian external-format))))))
-
-(defmethod print-object ((object external-format) stream)
- "How an EXTERNAL-FORMAT object is rendered. Uses
-NORMALIZE-EXTERNAL-FORMAT."
- (print-unreadable-object (object stream :type t :identity t)
- (prin1 (normalize-external-format object) stream)))
(DIR) diff --git a/3rdparties/software/flexi-streams-20190107-git/flexi-streams.asd b/3rdparties/software/flexi-streams-20190107-git/flexi-streams.asd
@@ -1,79 +0,0 @@
-;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-USER; Base: 10 -*-
-;;; $Header: /usr/local/cvsrep/flexi-streams/flexi-streams.asd,v 1.79 2008/08/26 10:59:22 edi Exp $
-
-;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved.
-
-;;; Redistribution and use in source and binary forms, with or without
-;;; modification, are permitted provided that the following conditions
-;;; are met:
-
-;;; * Redistributions of source code must retain the above copyright
-;;; notice, this list of conditions and the following disclaimer.
-
-;;; * Redistributions in binary form must reproduce the above
-;;; copyright notice, this list of conditions and the following
-;;; disclaimer in the documentation and/or other materials
-;;; provided with the distribution.
-
-;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED
-;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
-;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
-;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
-;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
-;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
-;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
-;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
-;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
-;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
-;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-
-(in-package :cl-user)
-
-(defpackage :flexi-streams-system
- (:use :asdf :cl))
-
-(in-package :flexi-streams-system)
-
-;;; Maybe it can be made work for some encodings
-(when (<= char-code-limit 65533)
- (error "flexi-streams doesn't work on implementations with CHAR-CODE-LIMIT (~a) less than 65533"
- char-code-limit))
-
-(defsystem :flexi-streams
- :version "1.0.18"
- :serial t
- :description "Flexible bivalent streams for Common Lisp"
- :license "BSD-2-Clause"
- :components ((:file "packages")
- (:file "mapping")
- (:file "ascii")
- (:file "koi8-r")
- (:file "iso-8859")
- (:file "code-pages")
- (:file "specials")
- (:file "util")
- (:file "conditions")
- (:file "external-format")
- (:file "length")
- (:file "encode")
- (:file "decode")
- (:file "in-memory")
- (:file "stream")
- #+:lispworks (:file "lw-char-stream")
- (:file "output")
- (:file "input")
- (:file "io")
- (:file "strings"))
- :depends-on (:trivial-gray-streams))
-
-(defsystem :flexi-streams-test
- :components ((:module "test"
- :serial t
- :components ((:file "packages")
- (:file "test"))))
- :depends-on (:flexi-streams))
-
-(defmethod perform ((o test-op) (c (eql (find-system 'flexi-streams))))
- (operate 'load-op 'flexi-streams-test)
- (funcall (intern (symbol-name :run-all-tests)
- (find-package :flexi-streams-test))))
(DIR) diff --git a/3rdparties/software/flexi-streams-20190107-git/in-memory.lisp b/3rdparties/software/flexi-streams-20190107-git/in-memory.lisp
@@ -1,442 +0,0 @@
-;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: FLEXI-STREAMS; Base: 10 -*-
-;;; $Header: /usr/local/cvsrep/flexi-streams/in-memory.lisp,v 1.31 2008/05/19 07:57:07 edi Exp $
-
-;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved.
-
-;;; Redistribution and use in source and binary forms, with or without
-;;; modification, are permitted provided that the following conditions
-;;; are met:
-
-;;; * Redistributions of source code must retain the above copyright
-;;; notice, this list of conditions and the following disclaimer.
-
-;;; * Redistributions in binary form must reproduce the above
-;;; copyright notice, this list of conditions and the following
-;;; disclaimer in the documentation and/or other materials
-;;; provided with the distribution.
-
-;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED
-;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
-;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
-;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
-;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
-;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
-;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
-;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
-;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
-;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
-;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-
-(in-package :flexi-streams)
-
-(defclass in-memory-stream (trivial-gray-stream-mixin)
- ((transformer :initarg :transformer
- :accessor in-memory-stream-transformer
- :documentation "A function used to transform the
-written/read octet to the value stored/retrieved in/from the
-underlying vector.")
- #+:cmu
- (open-p :initform t
- :accessor in-memory-stream-open-p
- :documentation "For CMUCL we have to keep track of this
-manually."))
- (:documentation "An IN-MEMORY-STREAM is a binary stream that reads
-octets from or writes octets to a sequence in RAM."))
-
-(defclass in-memory-input-stream (in-memory-stream fundamental-binary-input-stream)
- ()
- (:documentation "An IN-MEMORY-INPUT-STREAM is a binary stream that
-reads octets from a sequence in RAM."))
-
-#+:cmu
-(defmethod output-stream-p ((stream in-memory-input-stream))
- "Explicitly states whether this is an output stream."
- (declare (optimize speed))
- nil)
-
-(defclass in-memory-output-stream (in-memory-stream fundamental-binary-output-stream)
- ()
- (:documentation "An IN-MEMORY-OUTPUT-STREAM is a binary stream that
-writes octets to a sequence in RAM."))
-
-#+:cmu
-(defmethod input-stream-p ((stream in-memory-output-stream))
- "Explicitly states whether this is an input stream."
- (declare (optimize speed))
- nil)
-
-(defclass list-stream ()
- ((list :initarg :list
- :accessor list-stream-list
- :documentation "The underlying list of the stream."))
- (:documentation "A LIST-STREAM is a mixin for IN-MEMORY streams
-where the underlying sequence is a list."))
-
-(defclass vector-stream ()
- ((vector :initarg :vector
- :accessor vector-stream-vector
- :documentation "The underlying vector of the stream which
-\(for output) must always be adjustable and have a fill pointer."))
- (:documentation "A VECTOR-STREAM is a mixin for IN-MEMORY streams
-where the underlying sequence is a vector."))
-
-(defclass list-input-stream (list-stream in-memory-input-stream)
- ()
- (:documentation "A binary input stream that gets its data from an
-associated list of octets."))
-
-(defclass vector-input-stream (vector-stream in-memory-input-stream)
- ((index :initarg :index
- :accessor vector-stream-index
- :type (integer 0 #.array-dimension-limit)
- :documentation "An index into the underlying vector denoting
-the current position.")
- (end :initarg :end
- :accessor vector-stream-end
- :type (integer 0 #.array-dimension-limit)
- :documentation "An index into the underlying vector denoting
-the end of the available data."))
- (:documentation "A binary input stream that gets its data from an
-associated vector of octets."))
-
-(defclass vector-output-stream (vector-stream in-memory-output-stream)
- ()
- (:documentation "A binary output stream that writes its data to an
-associated vector."))
-
-#+:cmu
-(defmethod open-stream-p ((stream in-memory-stream))
- "Returns a true value if STREAM is open. See ANSI standard."
- (declare #.*standard-optimize-settings*)
- (in-memory-stream-open-p stream))
-
-#+:cmu
-(defmethod close ((stream in-memory-stream) &key abort)
- "Closes the stream STREAM. See ANSI standard."
- (declare #.*standard-optimize-settings*)
- (declare (ignore abort))
- (prog1
- (in-memory-stream-open-p stream)
- (setf (in-memory-stream-open-p stream) nil)))
-
-(defmethod check-if-open ((stream in-memory-stream))
- "Checks if STREAM is open and signals an error otherwise."
- (declare #.*standard-optimize-settings*)
- (unless (open-stream-p stream)
- (error 'in-memory-stream-closed-error
- :stream stream)))
-
-(defmethod stream-element-type ((stream in-memory-stream))
- "The element type is always OCTET by definition."
- (declare #.*standard-optimize-settings*)
- 'octet)
-
-(defgeneric peek-byte (stream &optional peek-type eof-err-p eof-value)
- (:documentation
- "PEEK-BYTE is like PEEK-CHAR, i.e. it returns a byte from the stream without
- actually removing it. If PEEK-TYPE is NIL the next byte is returned, if
- PEEK-TYPE is T, the next byte which is not 0 is returned, if PEEK-TYPE is an
- byte, the next byte which equals PEEK-TYPE is returned. EOF-ERROR-P and
- EOF-VALUE are interpreted as usual."))
-
-(defmethod peek-byte ((stream vector-input-stream) &optional peek-type (eof-error-p t) eof-value)
- "Returns a byte from VECTOR-INPUT-STREAM without actually removing it."
- (declare #.*standard-optimize-settings*)
- (let ((index (vector-stream-index stream)))
- (loop :for byte = (read-byte stream eof-error-p :eof)
- :for new-index :from index
- :until (cond ((eq byte :eof)
- (return eof-value))
- ((null peek-type))
- ((eq peek-type 't)
- (plusp byte))
- ((= byte peek-type)))
- :finally (setf (slot-value stream 'index) new-index)
- (return byte))))
-
-(defmethod peek-byte ((stream list-input-stream) &optional peek-type (eof-error-p t) eof-value)
- "Returns a byte from VECTOR-INPUT-STREAM without actually removing it."
- (declare #.*standard-optimize-settings*)
- (loop
- :for list-elem = (car (list-stream-list stream))
- :for byte = (read-byte stream eof-error-p :eof)
- :until (cond ((eq byte :eof)
- (return eof-value))
- ((null peek-type))
- ((eq peek-type 't)
- (plusp byte))
- ((= byte peek-type)))
- :finally (push list-elem (list-stream-list stream))
- (return byte)))
-
-(defmethod transform-octet ((stream in-memory-stream) octet)
- "Applies the transformer of STREAM to octet and returns the result."
- (declare #.*standard-optimize-settings*)
- (funcall (or (in-memory-stream-transformer stream)
- #'identity) octet))
-
-(defmethod stream-read-byte ((stream list-input-stream))
- "Reads one byte by simply popping it off of the top of the list."
- (declare #.*standard-optimize-settings*)
- (check-if-open stream)
- (with-accessors ((list list-stream-list))
- stream
- (transform-octet stream (or (pop list) (return-from stream-read-byte :eof)))))
-
-(defmethod stream-listen ((stream list-input-stream))
- "Checks whether list is not empty."
- (declare #.*standard-optimize-settings*)
- (check-if-open stream)
- (with-accessors ((list list-stream-list))
- stream
- list))
-
-(defmethod stream-read-sequence ((stream list-input-stream) sequence start end &key)
- "Repeatedly pops elements from the list until it's empty."
- (declare #.*standard-optimize-settings*)
- (declare (fixnum start end))
- (with-accessors ((list list-stream-list))
- stream
- (loop for index of-type fixnum from start below end
- while list
- do (setf (elt sequence index) (pop list))
- finally (return index))))
-
-(defmethod stream-read-byte ((stream vector-input-stream))
- "Reads one byte and increments INDEX pointer unless we're beyond
-END pointer."
- (declare #.*standard-optimize-settings*)
- (check-if-open stream)
- (with-accessors ((index vector-stream-index)
- (end vector-stream-end)
- (vector vector-stream-vector))
- stream
- (let ((current-index index))
- (declare (fixnum current-index))
- (cond ((< current-index (the fixnum end))
- (incf (the fixnum index))
- (transform-octet stream (aref vector current-index)))
- (t :eof)))))
-
-(defmethod stream-listen ((stream vector-input-stream))
- "Checking whether INDEX is beyond END."
- (declare #.*standard-optimize-settings*)
- (check-if-open stream)
- (with-accessors ((index vector-stream-index)
- (end vector-stream-end))
- stream
- (< (the fixnum index) (the fixnum end))))
-
-(defmethod stream-read-sequence ((stream vector-input-stream) sequence start end &key)
- "Traverses both sequences in parallel until the end of one of them
-is reached."
- (declare #.*standard-optimize-settings*)
- (declare (fixnum start end))
- (loop with vector-end of-type fixnum = (vector-stream-end stream)
- with vector = (vector-stream-vector stream)
- for index of-type fixnum from start below end
- for vector-index of-type fixnum = (vector-stream-index stream)
- while (< vector-index vector-end)
- do (setf (elt sequence index)
- (aref vector vector-index))
- (incf (the fixnum (vector-stream-index stream)))
- finally (return index)))
-
-(defmethod stream-write-byte ((stream vector-output-stream) byte)
- "Writes a byte \(octet) by extending the underlying vector."
- (declare #.*standard-optimize-settings*)
- (check-if-open stream)
- (with-accessors ((vector vector-stream-vector))
- stream
- (vector-push-extend (transform-octet stream byte) vector)))
-
-(defmethod stream-write-sequence ((stream vector-output-stream) sequence start end &key)
- "Just calls VECTOR-PUSH-EXTEND repeatedly."
- (declare #.*standard-optimize-settings*)
- (declare (fixnum start end))
- (with-accessors ((vector vector-stream-vector))
- stream
- (loop for index of-type fixnum from start below end
- do (vector-push-extend (transform-octet stream (elt sequence index)) vector))
- sequence))
-
-(defmethod stream-file-position ((stream vector-input-stream))
- "Simply returns the index into the underlying vector."
- (declare #.*standard-optimize-settings*)
- (with-accessors ((index vector-stream-index))
- stream
- index))
-
-(defmethod (setf stream-file-position) (position-spec (stream vector-input-stream))
- "Sets the index into the underlying vector if POSITION-SPEC is acceptable."
- (declare #.*standard-optimize-settings*)
- (with-accessors ((index vector-stream-index)
- (end vector-stream-end))
- stream
- (setq index
- (case position-spec
- (:start 0)
- (:end end)
- (otherwise
- (unless (integerp position-spec)
- (error 'in-memory-stream-position-spec-error
- :format-control "Unknown file position designator: ~S."
- :format-arguments (list position-spec)
- :stream stream
- :position-spec position-spec))
- (unless (<= 0 position-spec end)
- (error 'in-memory-stream-position-spec-error
- :format-control "File position designator ~S is out of bounds."
- :format-arguments (list position-spec)
- :stream stream
- :position-spec position-spec))
- position-spec)))
- position-spec))
-
-(defmethod stream-file-position ((stream vector-output-stream))
- "Simply returns the fill pointer of the underlying vector."
- (declare #.*standard-optimize-settings*)
- (with-accessors ((vector vector-stream-vector))
- stream
- (fill-pointer vector)))
-
-(defmethod (setf stream-file-position) (position-spec (stream vector-output-stream))
- "Sets the fill pointer underlying vector if POSITION-SPEC is
-acceptable. Adjusts the vector if necessary."
- (declare #.*standard-optimize-settings*)
- (with-accessors ((vector vector-stream-vector))
- stream
- (let* ((total-size (array-total-size vector))
- (new-fill-pointer
- (case position-spec
- (:start 0)
- (:end
- (warn "File position designator :END doesn't really make sense for an output stream.")
- total-size)
- (otherwise
- (unless (integerp position-spec)
- (error 'in-memory-stream-position-spec-error
- :format-control "Unknown file position designator: ~S."
- :format-arguments (list position-spec)
- :stream stream
- :position-spec position-spec))
- (unless (<= 0 position-spec array-total-size-limit)
- (error 'in-memory-stream-position-spec-error
- :format-control "File position designator ~S is out of bounds."
- :format-arguments (list position-spec)
- :stream stream
- :position-spec position-spec))
- position-spec))))
- (declare (fixnum total-size new-fill-pointer))
- (when (> new-fill-pointer total-size)
- (adjust-array vector new-fill-pointer))
- (setf (fill-pointer vector) new-fill-pointer)
- position-spec)))
-
-(defmethod make-in-memory-input-stream ((vector vector) &key (start 0)
- (end (length vector))
- transformer)
- "Returns a binary input stream which will supply, in order, the
-octets in the subsequence of VECTOR bounded by START and END.
-Each octet returned will be transformed in turn by the optional
-TRANSFORMER function."
- (declare #.*standard-optimize-settings*)
- (make-instance 'vector-input-stream
- :vector vector
- :index start
- :end end
- :transformer transformer))
-
-(defmethod make-in-memory-input-stream ((list list) &key (start 0)
- (end (length list))
- transformer)
- "Returns a binary input stream which will supply, in order, the
-octets in the subsequence of LIST bounded by START and END. Each
-octet returned will be transformed in turn by the optional
-TRANSFORMER function."
- (declare #.*standard-optimize-settings*)
- (make-instance 'list-input-stream
- :list (subseq list start end)
- :transformer transformer))
-
-(defun make-output-vector (&key (element-type 'octet))
- "Creates and returns an array which can be used as the underlying
-vector for a VECTOR-OUTPUT-STREAM."
- (declare #.*standard-optimize-settings*)
- (make-array 0 :adjustable t
- :fill-pointer 0
- :element-type element-type))
-
-(defun make-in-memory-output-stream (&key (element-type 'octet) transformer)
- "Returns a binary output stream which accepts objects of type
-ELEMENT-TYPE \(a subtype of OCTET) and makes available a sequence
-that contains the octes that were actually output. The octets
-stored will each be transformed by the optional TRANSFORMER
-function."
- (declare #.*standard-optimize-settings*)
- (make-instance 'vector-output-stream
- :vector (make-output-vector :element-type element-type)
- :transformer transformer))
-
-(defmethod get-output-stream-sequence ((stream in-memory-output-stream) &key as-list)
- "Returns a vector containing, in order, all the octets that have
-been output to the IN-MEMORY stream STREAM. This operation clears any
-octets on STREAM, so the vector contains only those octets which have
-been output since the last call to GET-OUTPUT-STREAM-SEQUENCE or since
-the creation of the stream, whichever occurred most recently. If
-AS-LIST is true the return value is coerced to a list."
- (declare #.*standard-optimize-settings*)
- (with-accessors ((vector vector-stream-vector))
- stream
- (prog1
- (if as-list
- (coerce vector 'list)
- vector)
- (setq vector
- (make-output-vector)))))
-
-(defmethod output-stream-sequence-length ((stream in-memory-output-stream))
- "Returns the current length of the underlying vector of the
-IN-MEMORY output stream STREAM."
- (declare (optimize speed))
- (length (the vector (vector-stream-vector stream))))
-
-(defmacro with-input-from-sequence ((var sequence &key start end transformer)
- &body body)
- "Creates an IN-MEMORY input stream from SEQUENCE using the
-parameters START and END, binds VAR to this stream and then
-executes the code in BODY. A function TRANSFORMER may optionally
-be specified to transform the returned octets. The stream is
-automatically closed on exit from WITH-INPUT-FROM-SEQUENCE, no
-matter whether the exit is normal or abnormal. The return value
-of this macro is the return value of BODY."
- (with-rebinding (sequence)
- `(let (,var)
- (unwind-protect
- (progn
- (setq ,var (make-in-memory-input-stream ,sequence
- :start (or ,start 0)
- :end (or ,end (length ,sequence))
- :transformer ,transformer))
- ,@body)
- (when ,var (close ,var))))))
-
-(defmacro with-output-to-sequence ((var &key as-list (element-type ''octet) transformer)
- &body body)
- "Creates an IN-MEMORY output stream, binds VAR to this stream
-and then executes the code in BODY. The stream stores data of
-type ELEMENT-TYPE \(a subtype of OCTET) which is \(optionally)
-transformed by the function TRANSFORMER prior to storage. The
-stream is automatically closed on exit from
-WITH-OUTPUT-TO-SEQUENCE, no matter whether the exit is normal or
-abnormal. The return value of this macro is a vector \(or a list
-if AS-LIST is true) containing the octets that were sent to the
-stream within BODY."
- `(let (,var)
- (unwind-protect
- (progn
- (setq ,var (make-in-memory-output-stream :element-type ,element-type
- :transformer ,transformer))
- ,@body
- (get-output-stream-sequence ,var :as-list ,as-list))
- (when ,var (close ,var)))))
(DIR) diff --git a/3rdparties/software/flexi-streams-20190107-git/input.lisp b/3rdparties/software/flexi-streams-20190107-git/input.lisp
@@ -1,289 +0,0 @@
-;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: FLEXI-STREAMS; Base: 10 -*-
-;;; $Header: /usr/local/cvsrep/flexi-streams/input.lisp,v 1.78 2008/05/25 19:25:44 edi Exp $
-
-;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved.
-
-;;; Redistribution and use in source and binary forms, with or without
-;;; modification, are permitted provided that the following conditions
-;;; are met:
-
-;;; * Redistributions of source code must retain the above copyright
-;;; notice, this list of conditions and the following disclaimer.
-
-;;; * Redistributions in binary form must reproduce the above
-;;; copyright notice, this list of conditions and the following
-;;; disclaimer in the documentation and/or other materials
-;;; provided with the distribution.
-
-;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED
-;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
-;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
-;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
-;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
-;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
-;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
-;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
-;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
-;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
-;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-
-(in-package :flexi-streams)
-
-#-:lispworks
-(defmethod read-byte* ((flexi-input-stream flexi-input-stream))
- "Reads one byte \(octet) from the underlying stream of
-FLEXI-OUTPUT-STREAM \(or from the internal stack if it's not
-empty)."
- (declare #.*standard-optimize-settings*)
- ;; we're using S instead of STREAM here because of an
- ;; issue with SBCL:
- ;; <http://article.gmane.org/gmane.lisp.steel-bank.general/1386>
- (with-accessors ((position flexi-stream-position)
- (bound flexi-stream-bound)
- (octet-stack flexi-stream-octet-stack)
- (s flexi-stream-stream))
- flexi-input-stream
- (declare (integer position)
- (type (or null integer) bound))
- (when (and bound
- (>= position bound))
- (return-from read-byte* nil))
- (incf position)
- (or (pop octet-stack)
- (read-byte s nil nil)
- (progn (decf position) nil))))
-
-#+:lispworks
-(defmethod read-byte* ((flexi-input-stream flexi-input-stream))
- "Reads one byte \(octet) from the underlying \(binary) stream of
-FLEXI-OUTPUT-STREAM \(or from the internal stack if it's not empty)."
- (declare #.*standard-optimize-settings*)
- (with-accessors ((position flexi-stream-position)
- (bound flexi-stream-bound)
- (octet-stack flexi-stream-octet-stack)
- (stream flexi-stream-stream))
- flexi-input-stream
- (declare (integer position)
- (type (or null integer) bound))
- (when (and bound
- (>= position bound))
- (return-from read-byte* nil))
- (incf position)
- (or (pop octet-stack)
- (read-byte stream nil nil)
- (progn (decf position) nil))))
-
-#+:lispworks
-(defmethod read-byte* ((flexi-input-stream flexi-char-input-stream))
- "Reads one byte \(octet) from the underlying stream of
-FLEXI-OUTPUT-STREAM \(or from the internal stack if it's not empty).
-Only used for LispWorks bivalent streams which aren't binary."
- (declare #.*standard-optimize-settings*)
- (with-accessors ((position flexi-stream-position)
- (bound flexi-stream-bound)
- (octet-stack flexi-stream-octet-stack)
- (stream flexi-stream-stream))
- flexi-input-stream
- (declare (integer position)
- (type (or null integer) bound))
- (when (and bound
- (>= position bound))
- (return-from read-byte* nil))
- (incf position)
- (or (pop octet-stack)
- ;; we use READ-SEQUENCE because READ-BYTE doesn't work with all
- ;; bivalent streams in LispWorks
- (let* ((buffer (make-array 1 :element-type 'octet))
- (new-position (read-sequence buffer stream)))
- (cond ((zerop new-position)
- (decf position) nil)
- (t (aref buffer 0)))))))
-
-(defmethod stream-clear-input ((flexi-input-stream flexi-input-stream))
- "Calls the corresponding method for the underlying input stream
-and also clears the value of the OCTET-STACK slot."
- (declare #.*standard-optimize-settings*)
- ;; note that we don't reset the POSITION slot
- (with-accessors ((octet-stack flexi-stream-octet-stack)
- (stream flexi-stream-stream))
- flexi-input-stream
- (setq octet-stack nil)
- (clear-input stream)))
-
-(defmethod stream-listen ((flexi-input-stream flexi-input-stream))
- "Calls the corresponding method for the underlying input stream
-but first checks if \(old) input is available in the OCTET-STACK
-slot."
- (declare #.*standard-optimize-settings*)
- (with-accessors ((position flexi-stream-position)
- (bound flexi-stream-bound)
- (octet-stack flexi-stream-octet-stack)
- (stream flexi-stream-stream))
- flexi-input-stream
- (declare (integer position)
- (type (or null integer) bound))
- (when (and bound
- (>= position bound))
- (return-from stream-listen nil))
- (or octet-stack (listen stream))))
-
-(defmethod stream-read-byte ((stream flexi-input-stream))
- "Reads one byte \(octet) from the underlying stream."
- (declare #.*standard-optimize-settings*)
- ;; set LAST-CHAR-CODE slot to NIL because we can't UNREAD-CHAR after
- ;; this operation
- (with-accessors ((last-char-code flexi-stream-last-char-code)
- (last-octet flexi-stream-last-octet))
- stream
- (setq last-char-code nil)
- (let ((octet (read-byte* stream)))
- (setq last-octet octet)
- (or octet :eof))))
-
-(defun unread-char% (char flexi-input-stream)
- "Used internally to put a character CHAR which was already read back
-on the stream. Uses the OCTET-STACK slot and decrements the POSITION
-slot accordingly."
- (declare #.*standard-optimize-settings*)
- (with-accessors ((position flexi-stream-position)
- (octet-stack flexi-stream-octet-stack)
- (external-format flexi-stream-external-format))
- flexi-input-stream
- (let ((counter 0) octets-reversed)
- (declare (fixnum counter))
- (flet ((writer (octet)
- (incf counter)
- (push octet octets-reversed)))
- (declare (dynamic-extent (function writer)))
- (char-to-octets external-format char #'writer)
- (decf position counter)
- (setq octet-stack (nreconc octets-reversed octet-stack))))))
-
-(defmethod stream-read-char ((stream flexi-input-stream))
- (declare #.*standard-optimize-settings*)
- ;; note that we do nothing for the :LF EOL style because we assume
- ;; that #\Newline is the same as #\Linefeed in all Lisps which will
- ;; use this library
- (with-accessors ((external-format flexi-stream-external-format)
- (last-octet flexi-stream-last-octet)
- (last-char-code flexi-stream-last-char-code))
- stream
- ;; set LAST-OCTET slot to NIL because we can't UNREAD-BYTE after
- ;; this operation
- (setq last-octet nil)
- (flet ((reader ()
- (read-byte* stream))
- (unreader (char)
- (unread-char% char stream)))
- (declare (dynamic-extent (function reader) (function unreader)))
- (let* ((*current-unreader* #'unreader)
- (char-code (or (octets-to-char-code external-format #'reader)
- (return-from stream-read-char :eof))))
- ;; remember this character and its char code for UNREAD-CHAR
- (setq last-char-code char-code)
- (or (code-char char-code) char-code)))))
-
-(defmethod stream-read-char-no-hang ((stream flexi-input-stream))
- "Reads one character if the underlying stream has at least one
-octet available."
- (declare #.*standard-optimize-settings*)
- ;; note that this may block for non-8-bit encodings - I think
- ;; there's no easy way to handle this correctly
- (and (stream-listen stream)
- (stream-read-char stream)))
-
-(defmethod stream-read-sequence ((flexi-input-stream flexi-input-stream) sequence start end &key)
- "An optimized version which uses a buffer underneath. The function
-can deliver characters as well as octets and it decides what to do
-based on the element type of the sequence \(which takes precedence)
-and the element type of the stream. What you'll really get might also
-depend on your Lisp. Some of the implementations are more picky than
-others - see for example FLEXI-STREAMS-TEST::SEQUENCE-TEST."
- (declare #.*standard-optimize-settings*)
- (declare (fixnum start end))
- (with-accessors ((octet-stack flexi-stream-octet-stack)
- (external-format flexi-stream-external-format)
- (last-octet flexi-stream-last-octet)
- (last-char-code flexi-stream-last-char-code)
- (element-type flexi-stream-element-type)
- (stream flexi-stream-stream))
- flexi-input-stream
- (when (>= start end)
- (return-from stream-read-sequence start))
- (when (or (subtypep (etypecase sequence
- (vector (array-element-type sequence))
- (list t))
- 'integer)
- (and (not (stringp sequence))
- (type-equal element-type 'octet)))
- ;; if binary data is requested, just read from the underlying
- ;; stream directly and skip the rest (but flush octet stack
- ;; first)
- (let ((index start))
- (declare (fixnum index))
- (when octet-stack
- (replace sequence octet-stack :start1 start :end1 end)
- (let ((octets-flushed (min (length octet-stack) (- end start))))
- (incf index octets-flushed)
- (setq octet-stack (nthcdr octets-flushed octet-stack))))
- (setq index (read-sequence sequence stream :start index :end end))
- (when (> index start)
- (setq last-char-code nil
- last-octet (elt sequence (1- index))))
- (return-from stream-read-sequence index)))
- ;; otherwise hand over to the external format to do the work
- (read-sequence* external-format flexi-input-stream sequence start end)))
-
-(defmethod stream-unread-char ((stream flexi-input-stream) char)
- "Implements UNREAD-CHAR for streams of type FLEXI-INPUT-STREAM.
-Makes sure CHAR will only be unread if it was the last character
-read and if it was read with the same encoding that's currently
-being used by the stream."
- (declare #.*standard-optimize-settings*)
- (with-accessors ((last-char-code flexi-stream-last-char-code))
- stream
- (unless last-char-code
- (error 'flexi-stream-error
- :format-control "No character to unread from this stream \(or external format has changed or last reading operation was binary)."))
- (unless (= (char-code char) last-char-code)
- (error 'flexi-stream-error
- :format-control "Last character read (~S) was different from ~S."
- :format-arguments (list (code-char last-char-code) char)))
- (unread-char% char stream)
- (setq last-char-code nil)
- nil))
-
-(defmethod unread-byte (byte (flexi-input-stream flexi-input-stream))
- "Similar to UNREAD-CHAR in that it `unreads' the last octet from
-STREAM. Note that you can only call UNREAD-BYTE after a corresponding
-READ-BYTE."
- (declare #.*standard-optimize-settings*)
- (with-accessors ((last-octet flexi-stream-last-octet)
- (octet-stack flexi-stream-octet-stack)
- (position flexi-stream-position))
- flexi-input-stream
- (unless last-octet
- (error 'flexi-stream-error
- :format-control "No byte to unread from this stream \(or last reading operation read a character)."))
- (unless (= byte last-octet)
- (error 'flexi-stream-error
- :format-control "Last byte read was different from #x~X."
- :format-arguments (list byte)))
- (setq last-octet nil)
- (decf (the integer position))
- (push byte octet-stack)
- nil))
-
-(defmethod peek-byte ((flexi-input-stream flexi-input-stream)
- &optional peek-type (eof-error-p t) eof-value)
- "Returns an octet from FLEXI-INPUT-STREAM without actually removing it."
- (declare #.*standard-optimize-settings*)
- (loop for octet = (read-byte flexi-input-stream eof-error-p :eof)
- until (cond ((eq octet :eof)
- (return eof-value))
- ((null peek-type))
- ((eq peek-type t)
- (plusp octet))
- ((= octet peek-type)))
- finally (unread-byte octet flexi-input-stream)
- (return octet)))
(DIR) diff --git a/3rdparties/software/flexi-streams-20190107-git/io.lisp b/3rdparties/software/flexi-streams-20190107-git/io.lisp
@@ -1,110 +0,0 @@
-;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: FLEXI-STREAMS; Base: 10 -*-
-;;; $Header: /usr/local/cvsrep/flexi-streams/io.lisp,v 1.2 2008/05/20 23:44:45 edi Exp $
-
-;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved.
-
-;;; Redistribution and use in source and binary forms, with or without
-;;; modification, are permitted provided that the following conditions
-;;; are met:
-
-;;; * Redistributions of source code must retain the above copyright
-;;; notice, this list of conditions and the following disclaimer.
-
-;;; * Redistributions in binary form must reproduce the above
-;;; copyright notice, this list of conditions and the following
-;;; disclaimer in the documentation and/or other materials
-;;; provided with the distribution.
-
-;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED
-;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
-;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
-;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
-;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
-;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
-;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
-;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
-;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
-;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
-;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-
-(in-package :flexi-streams)
-
-(defmethod reset-input-state ((flexi-io-stream flexi-io-stream))
- "This method is used to clear any state associated with previous
-input before output is attempted on the stream. It can fail if the
-octet stack is not empty and the stream can't be `rewound'."
- (declare #.*standard-optimize-settings*)
- (with-accessors ((last-char-code flexi-stream-last-char-code)
- (last-octet flexi-stream-last-octet)
- (octet-stack flexi-stream-octet-stack)
- (stream flexi-stream-stream))
- flexi-io-stream
- (when octet-stack
- (unless (maybe-rewind stream (length octet-stack))
- (error 'flexi-stream-out-of-sync-error
- :stream flexi-io-stream))
- (setq octet-stack nil))
- (setq last-octet nil
- last-char-code nil)))
-
-(defmethod stream-write-byte :before ((stream flexi-io-stream) byte)
- (declare #.*standard-optimize-settings*)
- (declare (ignore byte))
- (reset-input-state stream))
-
-(defmethod stream-write-char :before ((stream flexi-io-stream) char)
- (declare #.*standard-optimize-settings*)
- (declare (ignore char))
- (reset-input-state stream))
-
-(defmethod stream-write-sequence :before ((stream flexi-io-stream) sequence start end &key)
- (declare #.*standard-optimize-settings*)
- (declare (ignore sequence start end))
- (reset-input-state stream))
-
-(defmethod stream-clear-output :before ((stream flexi-io-stream))
- (declare #.*standard-optimize-settings*)
- (reset-input-state stream))
-
-(defmethod reset-output-state ((flexi-io-stream flexi-io-stream))
- "This method is used to clear any state associated with previous
-output before the stream is used for input."
- (declare #.*standard-optimize-settings*)
- (with-accessors ((column flexi-stream-column))
- flexi-io-stream
- (setq column nil)))
-
-(defmethod stream-read-byte :before ((stream flexi-io-stream))
- (declare #.*standard-optimize-settings*)
- (reset-output-state stream))
-
-(defmethod stream-read-char :before ((stream flexi-io-stream))
- (declare #.*standard-optimize-settings*)
- (reset-output-state stream))
-
-(defmethod stream-read-sequence :before ((stream flexi-io-stream) sequence start end &key)
- (declare #.*standard-optimize-settings*)
- (declare (ignore sequence start end))
- (reset-output-state stream))
-
-(defmethod stream-unread-char :before ((stream flexi-io-stream) char)
- (declare #.*standard-optimize-settings*)
- (declare (ignore char))
- (reset-output-state stream))
-
-(defmethod unread-byte :before (byte (stream flexi-io-stream))
- (declare #.*standard-optimize-settings*)
- (declare (ignore byte))
- (reset-output-state stream))
-
-(defmethod stream-clear-input :before ((stream flexi-io-stream))
- (declare #.*standard-optimize-settings*)
- (reset-output-state stream))
-
-(defmethod write-byte* :after (byte (stream flexi-io-stream))
- "Keep POSITION slot up to date even when performing output."
- (declare #.*standard-optimize-settings*)
- (declare (ignore byte))
- (with-accessors ((position flexi-stream-position))
- stream
- (incf position)))
-\ No newline at end of file
(DIR) diff --git a/3rdparties/software/flexi-streams-20190107-git/iso-8859.lisp b/3rdparties/software/flexi-streams-20190107-git/iso-8859.lisp
@@ -1,53 +0,0 @@
-;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: FLEXI-STREAMS; Base: 10 -*-
-;;; $Header: /usr/local/cvsrep/flexi-streams/iso-8859.lisp,v 1.7 2008/05/18 21:32:15 edi Exp $
-
-;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved.
-
-;;; Redistribution and use in source and binary forms, with or without
-;;; modification, are permitted provided that the following conditions
-;;; are met:
-
-;;; * Redistributions of source code must retain the above copyright
-;;; notice, this list of conditions and the following disclaimer.
-
-;;; * Redistributions in binary form must reproduce the above
-;;; copyright notice, this list of conditions and the following
-;;; disclaimer in the documentation and/or other materials
-;;; provided with the distribution.
-
-;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED
-;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
-;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
-;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
-;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
-;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
-;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
-;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
-;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
-;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
-;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-
-(in-package :flexi-streams)
-
-;;; the following code was auto-generated from files which can be
-;;; found at <ftp://ftp.unicode.org/Public/MAPPINGS/ISO8859/>
-
-(defconstant +iso-8859-tables+
- `((:iso-8859-1 . ,(make-decoding-table '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255)))
- (:iso-8859-2 . ,(make-decoding-table '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 260 728 321 164 317 346 167 168 352 350 356 377 173 381 379 176 261 731 322 180 318 347 711 184 353 351 357 378 733 382 380 340 193 194 258 196 313 262 199 268 201 280 203 282 205 206 270 272 323 327 211 212 336 214 215 344 366 218 368 220 221 354 223 341 225 226 259 228 314 263 231 269 233 281 235 283 237 238 271 273 324 328 243 244 337 246 247 345 367 250 369 252 253 355 729)))
- (:iso-8859-3 . ,(make-decoding-table '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 294 728 163 164 65533 292 167 168 304 350 286 308 173 65533 379 176 295 178 179 180 181 293 183 184 305 351 287 309 189 65533 380 192 193 194 65533 196 266 264 199 200 201 202 203 204 205 206 207 65533 209 210 211 212 288 214 215 284 217 218 219 220 364 348 223 224 225 226 65533 228 267 265 231 232 233 234 235 236 237 238 239 65533 241 242 243 244 289 246 247 285 249 250 251 252 365 349 729)))
- (:iso-8859-4 . ,(make-decoding-table '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 260 312 342 164 296 315 167 168 352 274 290 358 173 381 175 176 261 731 343 180 297 316 711 184 353 275 291 359 330 382 331 256 193 194 195 196 197 198 302 268 201 280 203 278 205 206 298 272 325 332 310 212 213 214 215 216 370 218 219 220 360 362 223 257 225 226 227 228 229 230 303 269 233 281 235 279 237 238 299 273 326 333 311 244 245 246 247 248 371 250 251 252 361 363 729)))
- (:iso-8859-5 . ,(make-decoding-table '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 1025 1026 1027 1028 1029 1030 1031 1032 1033 1034 1035 1036 173 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079 1080 1081 1082 1083 1084 1085 1086 1087 1088 1089 1090 1091 1092 1093 1094 1095 1096 1097 1098 1099 1100 1101 1102 1103 8470 1105 1106 1107 1108 1109 1110 1111 1112 1113 1114 1115 1116 167 1118 1119)))
- (:iso-8859-6 . ,(make-decoding-table '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 65533 65533 65533 164 65533 65533 65533 65533 65533 65533 65533 1548 173 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 1563 65533 65533 65533 1567 65533 1569 1570 1571 1572 1573 1574 1575 1576 1577 1578 1579 1580 1581 1582 1583 1584 1585 1586 1587 1588 1589 1590 1591 1592 1593 1594 65533 65533 65533 65533 65533 1600 1601 1602 1603 1604 1605 1606 1607 1608 1609 1610 1611 1612 1613 1614 1615 1616 1617 1618 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533)))
- (:iso-8859-7 . ,(make-decoding-table '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 8216 8217 163 8364 8367 166 167 168 169 890 171 172 173 65533 8213 176 177 178 179 900 901 902 183 904 905 906 187 908 189 910 911 912 913 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 65533 931 932 933 934 935 936 937 938 939 940 941 942 943 944 945 946 947 948 949 950 951 952 953 954 955 956 957 958 959 960 961 962 963 964 965 966 967 968 969 970 971 972 973 974 65533)))
- (:iso-8859-8 . ,(make-decoding-table '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 65533 162 163 164 165 166 167 168 169 215 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 247 187 188 189 190 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 65533 8215 1488 1489 1490 1491 1492 1493 1494 1495 1496 1497 1498 1499 1500 1501 1502 1503 1504 1505 1506 1507 1508 1509 1510 1511 1512 1513 1514 65533 65533 8206 8207 65533)))
- (:iso-8859-9 . ,(make-decoding-table '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 286 209 210 211 212 213 214 215 216 217 218 219 220 304 350 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 287 241 242 243 244 245 246 247 248 249 250 251 252 305 351 255)))
- (:iso-8859-10 . ,(make-decoding-table '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 260 274 290 298 296 310 167 315 272 352 358 381 173 362 330 176 261 275 291 299 297 311 183 316 273 353 359 382 8213 363 331 256 193 194 195 196 197 198 302 268 201 280 203 278 205 206 207 208 325 332 211 212 213 214 360 216 370 218 219 220 221 222 223 257 225 226 227 228 229 230 303 269 233 281 235 279 237 238 239 240 326 333 243 244 245 246 361 248 371 250 251 252 253 254 312)))
- (:iso-8859-11 . ,(make-decoding-table '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 3585 3586 3587 3588 3589 3590 3591 3592 3593 3594 3595 3596 3597 3598 3599 3600 3601 3602 3603 3604 3605 3606 3607 3608 3609 3610 3611 3612 3613 3614 3615 3616 3617 3618 3619 3620 3621 3622 3623 3624 3625 3626 3627 3628 3629 3630 3631 3632 3633 3634 3635 3636 3637 3638 3639 3640 3641 3642 65533 65533 65533 65533 3647 3648 3649 3650 3651 3652 3653 3654 3655 3656 3657 3658 3659 3660 3661 3662 3663 3664 3665 3666 3667 3668 3669 3670 3671 3672 3673 3674 3675 65533 65533 65533 65533)))
- (:iso-8859-13 . ,(make-decoding-table '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 8221 162 163 164 8222 166 167 216 169 342 171 172 173 174 198 176 177 178 179 8220 181 182 183 248 185 343 187 188 189 190 230 260 302 256 262 196 197 280 274 268 201 377 278 290 310 298 315 352 323 325 211 332 213 214 215 370 321 346 362 220 379 381 223 261 303 257 263 228 229 281 275 269 233 378 279 291 311 299 316 353 324 326 243 333 245 246 247 371 322 347 363 252 380 382 8217)))
- (:iso-8859-14 . ,(make-decoding-table '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 7682 7683 163 266 267 7690 167 7808 169 7810 7691 7922 173 174 376 7710 7711 288 289 7744 7745 182 7766 7809 7767 7811 7776 7923 7812 7813 7777 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 372 209 210 211 212 213 214 7786 216 217 218 219 220 221 374 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 373 241 242 243 244 245 246 7787 248 249 250 251 252 253 375 255)))
- (:iso-8859-15 . ,(make-decoding-table '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 8364 165 352 167 353 169 170 171 172 173 174 175 176 177 178 179 381 181 182 183 382 185 186 187 338 339 376 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255)))
- (:iso-8859-16 . ,(make-decoding-table '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 260 261 321 8364 8222 352 167 353 169 536 171 377 173 378 379 176 177 268 322 381 8221 182 183 382 269 537 187 338 339 376 380 192 193 194 258 196 262 198 199 200 201 202 203 204 205 206 207 272 323 210 211 212 336 214 346 368 217 218 219 220 280 538 223 224 225 226 259 228 263 230 231 232 233 234 235 236 237 238 239 273 324 242 243 244 337 246 347 369 249 250 251 252 281 539 255))))
- "A list of the ISO-8859 encodings where each element is a cons
-with the car being a keyword denoting the encoding and the cdr
-being a vector enumerating the corresponding character codes.")
(DIR) diff --git a/3rdparties/software/flexi-streams-20190107-git/koi8-r.lisp b/3rdparties/software/flexi-streams-20190107-git/koi8-r.lisp
@@ -1,36 +0,0 @@
-;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: FLEXI-STREAMS; Base: 10 -*-
-;;; $Header: /usr/local/cvsrep/flexi-streams/koi8-r.lisp,v 1.2 2008/05/18 21:32:15 edi Exp $
-
-;;; Copyright (c) 2006, Igor Plekhov. All rights reserved.
-;;; Copyright (c) 2006-2008, Dr. Edmund Weitz. All rights reserved.
-
-;;; Redistribution and use in source and binary forms, with or without
-;;; modification, are permitted provided that the following conditions
-;;; are met:
-
-;;; * Redistributions of source code must retain the above copyright
-;;; notice, this list of conditions and the following disclaimer.
-
-;;; * Redistributions in binary form must reproduce the above
-;;; copyright notice, this list of conditions and the following
-;;; disclaimer in the documentation and/or other materials
-;;; provided with the distribution.
-
-;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED
-;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
-;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
-;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
-;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
-;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
-;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
-;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
-;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
-;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
-;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-
-(in-package :flexi-streams)
-
-;; http://unicode.org/Public/MAPPINGS/VENDORS/MISC/KOI8-R.TXT
-(defconstant +koi8-r-table+
- (make-decoding-table '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 9472 9474 9484 9488 9492 9496 9500 9508 9516 9524 9532 9600 9604 9608 9612 9616 9617 9618 9619 8992 9632 8729 8730 8776 8804 8805 160 8993 176 178 183 247 9552 9553 9554 1105 9555 9556 9557 9558 9559 9560 9561 9562 9563 9564 9565 9566 9567 9568 9569 1025 9570 9571 9572 9573 9574 9575 9576 9577 9578 9579 9580 169 1102 1072 1073 1094 1076 1077 1092 1075 1093 1080 1081 1082 1083 1084 1085 1086 1087 1103 1088 1089 1090 1091 1078 1074 1100 1099 1079 1096 1101 1097 1095 1098 1070 1040 1041 1062 1044 1045 1060 1043 1061 1048 1049 1050 1051 1052 1053 1054 1055 1071 1056 1057 1058 1059 1046 1042 1068 1067 1047 1064 1069 1065 1063 1066))
- "An array enumerating the character codes for the KOI8-R encoding.")
(DIR) diff --git a/3rdparties/software/flexi-streams-20190107-git/length.lisp b/3rdparties/software/flexi-streams-20190107-git/length.lisp
@@ -1,468 +0,0 @@
-;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: FLEXI-STREAMS; Base: 10 -*-
-;;; $Header: /usr/local/cvsrep/flexi-streams/length.lisp,v 1.6 2008/05/29 10:25:14 edi Exp $
-
-;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved.
-
-;;; Redistribution and use in source and binary forms, with or without
-;;; modification, are permitted provided that the following conditions
-;;; are met:
-
-;;; * Redistributions of source code must retain the above copyright
-;;; notice, this list of conditions and the following disclaimer.
-
-;;; * Redistributions in binary form must reproduce the above
-;;; copyright notice, this list of conditions and the following
-;;; disclaimer in the documentation and/or other materials
-;;; provided with the distribution.
-
-;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED
-;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
-;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
-;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
-;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
-;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
-;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
-;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
-;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
-;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
-;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-
-(in-package :flexi-streams)
-
-(defgeneric encoding-factor (format)
- (:documentation "Given an external format FORMAT, returns a factor
-which denotes the octets to characters ratio to expect when
-encoding/decoding. If the returned value is an integer, the factor is
-assumed to be exact. If it is a \(double) float, the factor is
-supposed to be based on heuristics and usually not exact.
-
-This factor is used in string.lisp.")
- (declare #.*standard-optimize-settings*))
-
-(defmethod encoding-factor ((format flexi-8-bit-format))
- (declare #.*standard-optimize-settings*)
- ;; 8-bit encodings map octets to characters in an exact one-to-one
- ;; fashion
- 1)
-
-(defmethod encoding-factor ((format flexi-utf-8-format))
- (declare #.*standard-optimize-settings*)
- ;; UTF-8 characters can be anything from one to six octets, but we
- ;; assume that the "overhead" is only about 5 percent - this
- ;; estimate is obviously very much dependant on the content
- 1.05d0)
-
-(defmethod encoding-factor ((format flexi-utf-16-format))
- (declare #.*standard-optimize-settings*)
- ;; usually one character maps to two octets, but characters with
- ;; code points above #x10000 map to four octets - we assume that we
- ;; usually don't see these characters but of course have to return a
- ;; float
- 2.0d0)
-
-(defmethod encoding-factor ((format flexi-utf-32-format))
- (declare #.*standard-optimize-settings*)
- ;; UTF-32 always matches every character to four octets
- 4)
-
-(defmethod encoding-factor ((format flexi-crlf-mixin))
- (declare #.*standard-optimize-settings*)
- ;; if the sequence #\Return #\Linefeed is the line-end marker, this
- ;; obviously makes encodings potentially longer and definitely makes
- ;; the estimate unexact
- (* 1.02d0 (call-next-method)))
-
-(defgeneric check-end (format start end i)
- (declare #.*fixnum-optimize-settings*)
- (:documentation "Helper function used below to determine if we tried
-to read past the end of the sequence.")
- (:method (format start end i)
- (declare #.*fixnum-optimize-settings*)
- (declare (ignore start))
- (declare (fixnum end i))
- (when (> i end)
- (signal-encoding-error format "This sequence can't be decoded ~
-using ~A as it is too short. ~A octet~:P missing at the end."
- (external-format-name format)
- (- i end))))
- (:method ((format flexi-utf-16-format) start end i)
- (declare #.*fixnum-optimize-settings*)
- (declare (fixnum start end i))
- (declare (ignore i))
- ;; don't warn twice
- (when (evenp (- end start))
- (call-next-method))))
-
-(defgeneric compute-number-of-chars (format sequence start end)
- (declare #.*standard-optimize-settings*)
- (:documentation "Computes the exact number of characters required to
-decode the sequence of octets in SEQUENCE from START to END using the
-external format FORMAT."))
-
-(defmethod compute-number-of-chars :around (format (list list) start end)
- (declare #.*standard-optimize-settings*)
- (call-next-method format (coerce list 'vector) start end))
-
-(defmethod compute-number-of-chars ((format flexi-8-bit-format) sequence start end)
- (declare #.*fixnum-optimize-settings*)
- (declare (fixnum start end))
- (declare (ignore sequence))
- (- end start))
-
-(defmethod compute-number-of-chars ((format flexi-crlf-mixin) sequence start end)
- ;; this method only applies to the 8-bit formats as all other
- ;; formats with CRLF line endings have their own specialized methods
- ;; below
- (declare #.*fixnum-optimize-settings*)
- (declare (fixnum start end) (vector sequence))
- (let ((i start)
- (length (- end start)))
- (declare (fixnum i length))
- (loop
- (when (>= i end)
- (return))
- (let ((position (search #.(vector +cr+ +lf+) sequence :start2 i :end2 end :test #'=)))
- (unless position
- (return))
- (setq i (1+ position))
- (decf length)))
- length))
-
-(defmethod compute-number-of-chars ((format flexi-utf-8-format) sequence start end)
- (declare #.*fixnum-optimize-settings*)
- (declare (fixnum start end) (vector sequence))
- (let ((sum 0)
- (i start))
- (declare (fixnum i sum))
- (loop
- (when (>= i end)
- (return))
- (let* ((octet (aref sequence i))
- ;; note that there are no validity checks here
- (length (cond ((not (logbitp 7 octet)) 1)
- ((= #b11000000 (logand* octet #b11100000)) 2)
- ((= #b11100000 (logand* octet #b11110000)) 3)
- (t 4))))
- (declare (fixnum length) (type octet octet))
- (incf sum)
- (incf i length)))
- (check-end format start end i)
- sum))
-
-(defmethod compute-number-of-chars ((format flexi-crlf-utf-8-format) sequence start end)
- (declare #.*fixnum-optimize-settings*)
- (declare (fixnum start end) (vector sequence))
- (let ((sum 0)
- (i start)
- (last-octet 0))
- (declare (fixnum i sum) (type octet last-octet))
- (loop
- (when (>= i end)
- (return))
- (let* ((octet (aref sequence i))
- ;; note that there are no validity checks here
- (length (cond ((not (logbitp 7 octet)) 1)
- ((= #b11000000 (logand* octet #b11100000)) 2)
- ((= #b11100000 (logand* octet #b11110000)) 3)
- (t 4))))
- (declare (fixnum length) (type octet octet))
- (unless (and (= octet +lf+) (= last-octet +cr+))
- (incf sum))
- (incf i length)
- (setq last-octet octet)))
- (check-end format start end i)
- sum))
-
-(defmethod compute-number-of-chars :before ((format flexi-utf-16-format) sequence start end)
- (declare #.*fixnum-optimize-settings*)
- (declare (fixnum start end) (vector sequence))
- (declare (ignore sequence))
- (when (oddp (- end start))
- (signal-encoding-error format "~A octet~:P cannot be decoded ~
-using UTF-16 as ~:*~A is not even."
- (- end start))))
-
-(defmethod compute-number-of-chars ((format flexi-utf-16-le-format) sequence start end)
- (declare #.*fixnum-optimize-settings*)
- (declare (fixnum start end))
- (let ((sum 0)
- (i start))
- (declare (fixnum i sum))
- (decf end 2)
- (loop
- (when (> i end)
- (return))
- (let* ((high-octet (aref sequence (1+ i)))
- (length (cond ((<= #xd8 high-octet #xdf) 4)
- (t 2))))
- (declare (fixnum length) (type octet high-octet))
- (incf sum)
- (incf i length)))
- (check-end format start (+ end 2) i)
- sum))
-
-(defmethod compute-number-of-chars ((format flexi-utf-16-be-format) sequence start end)
- (declare #.*fixnum-optimize-settings*)
- (declare (fixnum start end) (vector sequence))
- (let ((sum 0)
- (i start))
- (declare (fixnum i sum))
- (decf end 2)
- (loop
- (when (> i end)
- (return))
- (let* ((high-octet (aref sequence i))
- (length (cond ((<= #xd8 high-octet #xdf) 4)
- (t 2))))
- (declare (fixnum length) (type octet high-octet))
- (incf sum)
- (incf i length)))
- (check-end format start (+ end 2) i)
- sum))
-
-(defmethod compute-number-of-chars ((format flexi-crlf-utf-16-le-format) sequence start end)
- (declare #.*fixnum-optimize-settings*)
- (declare (fixnum start end) (vector sequence))
- (let ((sum 0)
- (i start)
- (last-octet 0))
- (declare (fixnum i sum) (type octet last-octet))
- (decf end 2)
- (loop
- (when (> i end)
- (return))
- (let* ((high-octet (aref sequence (1+ i)))
- (length (cond ((<= #xd8 high-octet #xdf) 4)
- (t 2))))
- (declare (fixnum length) (type octet high-octet))
- (unless (and (zerop high-octet)
- (= (the octet (aref sequence i)) +lf+)
- (= last-octet +cr+))
- (incf sum))
- (setq last-octet (if (zerop high-octet)
- (aref sequence i)
- 0))
- (incf i length)))
- (check-end format start (+ end 2) i)
- sum))
-
-(defmethod compute-number-of-chars ((format flexi-crlf-utf-16-be-format) sequence start end)
- (declare #.*fixnum-optimize-settings*)
- (declare (fixnum start end) (vector sequence))
- (let ((sum 0)
- (i start)
- (last-octet 0))
- (declare (fixnum i sum) (type octet last-octet))
- (decf end 2)
- (loop
- (when (> i end)
- (return))
- (let* ((high-octet (aref sequence i))
- (length (cond ((<= #xd8 high-octet #xdf) 4)
- (t 2))))
- (declare (fixnum length) (type octet high-octet))
- (unless (and (zerop high-octet)
- (= (the octet (aref sequence (1+ i))) +lf+)
- (= last-octet +cr+))
- (incf sum))
- (setq last-octet (if (zerop high-octet)
- (aref sequence (1+ i))
- 0))
- (incf i length)))
- (check-end format start (+ end 2) i)
- sum))
-
-(defmethod compute-number-of-chars :before ((format flexi-utf-32-format) sequence start end)
- (declare #.*fixnum-optimize-settings*)
- (declare (fixnum start end))
- (declare (ignore sequence))
- (let ((length (- end start)))
- (when (plusp (mod length 4))
- (signal-encoding-error format "~A octet~:P cannot be decoded ~
-using UTF-32 as ~:*~A is not a multiple-value of four."
- length))))
-
-(defmethod compute-number-of-chars ((format flexi-utf-32-format) sequence start end)
- (declare #.*fixnum-optimize-settings*)
- (declare (fixnum start end))
- (declare (ignore sequence))
- (ceiling (- end start) 4))
-
-(defmethod compute-number-of-chars ((format flexi-crlf-utf-32-le-format) sequence start end)
- (declare #.*fixnum-optimize-settings*)
- (declare (fixnum start end) (vector sequence))
- (let ((i start)
- (length (ceiling (- end start) 4)))
- (decf end 8)
- (loop
- (when (> i end)
- (return))
- (cond ((loop for j of-type fixnum from i
- for octet across #.(vector +cr+ 0 0 0 +lf+ 0 0 0)
- always (= octet (aref sequence j)))
- (decf length)
- (incf i 8))
- (t (incf i 4))))
- length))
-
-(defmethod compute-number-of-chars ((format flexi-crlf-utf-32-be-format) sequence start end)
- (declare #.*fixnum-optimize-settings*)
- (declare (fixnum start end) (vector sequence))
- (let ((i start)
- (length (ceiling (- end start) 4)))
- (decf end 8)
- (loop
- (when (> i end)
- (return))
- (cond ((loop for j of-type fixnum from i
- for octet across #.(vector 0 0 0 +cr+ 0 0 0 +lf+)
- always (= octet (aref sequence j)))
- (decf length)
- (incf i 8))
- (t (incf i 4))))
- length))
-
-(defgeneric compute-number-of-octets (format sequence start end)
- (declare #.*standard-optimize-settings*)
- (:documentation "Computes the exact number of octets required to
-encode the sequence of characters in SEQUENCE from START to END using
-the external format FORMAT."))
-
-(defmethod compute-number-of-octets :around (format (list list) start end)
- (declare #.*standard-optimize-settings*)
- (call-next-method format (coerce list 'string*) start end))
-
-(defmethod compute-number-of-octets ((format flexi-8-bit-format) string start end)
- (declare #.*fixnum-optimize-settings*)
- (declare (fixnum start end))
- (declare (ignore string))
- (- end start))
-
-(defmethod compute-number-of-octets ((format flexi-utf-8-format) string start end)
- (declare #.*fixnum-optimize-settings*)
- (declare (fixnum start end) (string string))
- (let ((sum 0)
- (i start))
- (declare (fixnum i sum))
- (loop
- (when (>= i end)
- (return))
- (let* ((char-code (char-code (char string i)))
- (char-length (cond ((< char-code #x80) 1)
- ((< char-code #x800) 2)
- ((< char-code #x10000) 3)
- (t 4))))
- (declare (fixnum char-length) (type char-code-integer char-code))
- (incf sum char-length)
- (incf i)))
- sum))
-
-(defmethod compute-number-of-octets ((format flexi-crlf-utf-8-format) string start end)
- (declare #.*fixnum-optimize-settings*)
- (declare (fixnum start end) (string string))
- (let ((sum 0)
- (i start))
- (declare (fixnum i sum))
- (loop
- (when (>= i end)
- (return))
- (let* ((char-code (char-code (char string i)))
- (char-length (cond ((= char-code #.(char-code #\Newline)) 2)
- ((< char-code #x80) 1)
- ((< char-code #x800) 2)
- ((< char-code #x10000) 3)
- (t 4))))
- (declare (fixnum char-length) (type char-code-integer char-code))
- (incf sum char-length)
- (incf i)))
- sum))
-
-(defmethod compute-number-of-octets ((format flexi-utf-16-format) string start end)
- (declare #.*fixnum-optimize-settings*)
- (declare (fixnum start end) (string string))
- (let ((sum 0)
- (i start))
- (declare (fixnum i sum))
- (loop
- (when (>= i end)
- (return))
- (let* ((char-code (char-code (char string i)))
- (char-length (cond ((< char-code #x10000) 2)
- (t 4))))
- (declare (fixnum char-length) (type char-code-integer char-code))
- (incf sum char-length)
- (incf i)))
- sum))
-
-(defmethod compute-number-of-octets ((format flexi-crlf-utf-16-le-format) string start end)
- (declare #.*fixnum-optimize-settings*)
- (declare (fixnum start end) (string string))
- (let ((sum 0)
- (i start))
- (declare (fixnum i sum))
- (loop
- (when (>= i end)
- (return))
- (let* ((char-code (char-code (char string i)))
- (char-length (cond ((= char-code #.(char-code #\Newline)) 4)
- ((< char-code #x10000) 2)
- (t 4))))
- (declare (fixnum char-length) (type char-code-integer char-code))
- (incf sum char-length)
- (incf i)))
- sum))
-
-(defmethod compute-number-of-octets ((format flexi-crlf-utf-16-be-format) string start end)
- (declare #.*fixnum-optimize-settings*)
- (declare (fixnum start end) (string string))
- (let ((sum 0)
- (i start))
- (declare (fixnum i sum))
- (loop
- (when (>= i end)
- (return))
- (let* ((char-code (char-code (char string i)))
- (char-length (cond ((= char-code #.(char-code #\Newline)) 4)
- ((< char-code #x10000) 2)
- (t 4))))
- (declare (fixnum char-length) (type char-code-integer char-code))
- (incf sum char-length)
- (incf i)))
- sum))
-
-(defmethod compute-number-of-octets ((format flexi-utf-32-format) string start end)
- (declare #.*fixnum-optimize-settings*)
- (declare (fixnum start end))
- (declare (ignore string))
- (* 4 (- end start)))
-
-(defmethod compute-number-of-octets ((format flexi-crlf-mixin) string start end)
- (declare #.*fixnum-optimize-settings*)
- (declare (fixnum start end) (string string))
- (+ (call-next-method)
- (* (case (external-format-name format)
- (:utf-32 4)
- (otherwise 1))
- (count #\Newline string :start start :end end :test #'char=))))
-
-(defgeneric character-length (format char)
- (declare #.*fixnum-optimize-settings*)
- (:documentation "Returns the number of octets needed to encode the
-single character CHAR.")
- (:method (format char)
- (compute-number-of-octets format (string char) 0 1)))
-
-(defmethod character-length :around ((format flexi-crlf-mixin) (char (eql #\Newline)))
- (declare #.*fixnum-optimize-settings*)
- (+ (call-next-method format +cr+)
- (call-next-method format +lf+)))
-
-(defmethod character-length ((format flexi-8-bit-format) char)
- (declare #.*fixnum-optimize-settings*)
- (declare (ignore char))
- 1)
-
-(defmethod character-length ((format flexi-utf-32-format) char)
- (declare #.*fixnum-optimize-settings*)
- (declare (ignore char))
- 4)
-\ No newline at end of file
(DIR) diff --git a/3rdparties/software/flexi-streams-20190107-git/lw-char-stream.lisp b/3rdparties/software/flexi-streams-20190107-git/lw-char-stream.lisp
@@ -1,77 +0,0 @@
-;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: FLEXI-STREAMS; Base: 10 -*-
-;;; $Header: /usr/local/cvsrep/flexi-streams/lw-char-stream.lisp,v 1.1 2008/05/23 14:43:09 edi Exp $
-
-;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved.
-
-;;; Redistribution and use in source and binary forms, with or without
-;;; modification, are permitted provided that the following conditions
-;;; are met:
-
-;;; * Redistributions of source code must retain the above copyright
-;;; notice, this list of conditions and the following disclaimer.
-
-;;; * Redistributions in binary form must reproduce the above
-;;; copyright notice, this list of conditions and the following
-;;; disclaimer in the documentation and/or other materials
-;;; provided with the distribution.
-
-;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED
-;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
-;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
-;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
-;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
-;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
-;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
-;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
-;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
-;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
-;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-
-(in-package :flexi-streams)
-
-(defclass flexi-char-output-stream (flexi-output-stream)
- ()
- (:documentation "This class is for output streams where the
-underlying stream is bivalent but not binary. It exists solely for
-the purpose of optimizing output to binary streams on LispWorks. See
-WRITE-BYTE*."))
-
-(defclass flexi-char-input-stream (flexi-input-stream)
- ()
- (:documentation "This class is for input streams where the
-underlying stream is bivalent but not binary. It exists solely for
-the purpose of optimizing input to binary streams on LispWorks. See
-READ-BYTE*."))
-
-(defclass flexi-char-io-stream (flexi-char-input-stream flexi-char-output-stream flexi-io-stream)
- ()
- (:documentation "This class is for bidirectional streams where the
-underlying stream is bivalent but not binary. It exists solely for
-the purpose of optimizing input and output from/to binary streams on
-LispWorks. See READ-BYTE* and WRITE-BYTE*."))
-
-(defmethod initialize-instance :after ((flexi-stream flexi-output-stream) &rest initargs)
- "Might change the class of FLEXI-STREAM for optimization purposes.
-Only needed for LispWorks."
- (declare #.*standard-optimize-settings*)
- (declare (ignore initargs))
- (with-accessors ((stream flexi-stream-stream))
- flexi-stream
- (unless (subtypep (stream-element-type stream) 'octet)
- (change-class flexi-stream
- (typecase flexi-stream
- (flexi-io-stream 'flexi-char-io-stream)
- (otherwise 'flexi-char-output-stream))))))
-
-(defmethod initialize-instance :after ((flexi-stream flexi-input-stream) &rest initargs)
- "Might change the class of FLEXI-STREAM for optimization purposes.
-Only needed for LispWorks."
- (declare #.*standard-optimize-settings*)
- (declare (ignore initargs))
- (with-accessors ((stream flexi-stream-stream))
- flexi-stream
- (unless (subtypep (stream-element-type stream) 'octet)
- (change-class flexi-stream
- (typecase flexi-stream
- (flexi-io-stream 'flexi-char-io-stream)
- (otherwise 'flexi-char-input-stream))))))
(DIR) diff --git a/3rdparties/software/flexi-streams-20190107-git/mapping.lisp b/3rdparties/software/flexi-streams-20190107-git/mapping.lisp
@@ -1,81 +0,0 @@
-;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: FLEXI-STREAMS; Base: 10 -*-
-;;; $Header: /usr/local/cvsrep/flexi-streams/mapping.lisp,v 1.3 2008/05/25 19:07:53 edi Exp $
-
-;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved.
-
-;;; Redistribution and use in source and binary forms, with or without
-;;; modification, are permitted provided that the following conditions
-;;; are met:
-
-;;; * Redistributions of source code must retain the above copyright
-;;; notice, this list of conditions and the following disclaimer.
-
-;;; * Redistributions in binary form must reproduce the above
-;;; copyright notice, this list of conditions and the following
-;;; disclaimer in the documentation and/or other materials
-;;; provided with the distribution.
-
-;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED
-;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
-;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
-;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
-;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
-;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
-;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
-;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
-;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
-;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
-;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-
-(in-package :flexi-streams)
-
-(deftype octet ()
- "A shortcut for \(UNSIGNED-BYTE 8)."
- '(unsigned-byte 8))
-
-(deftype char* ()
- "Convenience shortcut to paper over the difference between LispWorks
-and the other Lisps."
- #+:lispworks 'lw:simple-char
- #-:lispworks 'character)
-
-(deftype string* ()
- "Convenience shortcut to paper over the difference between LispWorks
-and the other Lisps."
- #+:lispworks 'lw:text-string
- #-:lispworks 'string)
-
-(deftype char-code-integer ()
- "The subtype of integers which can be returned by the function CHAR-CODE."
- #-:cmu '(integer 0 #.(1- char-code-limit))
- #+:cmu '(integer 0 65533))
-
-(deftype code-point ()
- "The subtype of integers that's just big enough to hold all Unicode
-codepoints.
-
-See for example <http://unicode.org/glossary/#C>."
- '(mod #x110000))
-
-(defmacro defconstant (name value &optional doc)
- "Make sure VALUE is evaluated only once \(to appease SBCL)."
- `(cl:defconstant ,name (if (boundp ',name) (symbol-value ',name) ,value)
- ,@(when doc (list doc))))
-
-(defun invert-table (table)
- "`Inverts' an array which maps octets to character codes to a hash
-table which maps character codes to octets."
- (let ((hash (make-hash-table)))
- (loop for octet from 0
- for char-code across table
- unless (= char-code 65533)
- do (setf (gethash char-code hash) octet))
- hash))
-
-(defun make-decoding-table (list)
- "Creates and returns an array which contains the elements in the
-list LIST and has an element type that's suitable for character
-codes."
- (make-array (length list)
- :element-type 'char-code-integer
- :initial-contents list))
-\ No newline at end of file
(DIR) diff --git a/3rdparties/software/flexi-streams-20190107-git/output.lisp b/3rdparties/software/flexi-streams-20190107-git/output.lisp
@@ -1,162 +0,0 @@
-;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: FLEXI-STREAMS; Base: 10 -*-
-;;; $Header: /usr/local/cvsrep/flexi-streams/output.lisp,v 1.65 2008/05/24 23:15:25 edi Exp $
-
-;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved.
-
-;;; Redistribution and use in source and binary forms, with or without
-;;; modification, are permitted provided that the following conditions
-;;; are met:
-
-;;; * Redistributions of source code must retain the above copyright
-;;; notice, this list of conditions and the following disclaimer.
-
-;;; * Redistributions in binary form must reproduce the above
-;;; copyright notice, this list of conditions and the following
-;;; disclaimer in the documentation and/or other materials
-;;; provided with the distribution.
-
-;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED
-;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
-;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
-;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
-;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
-;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
-;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
-;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
-;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
-;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
-;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-
-(in-package :flexi-streams)
-
-(defgeneric write-byte* (byte stream)
- (declare #.*standard-optimize-settings*)
- (:documentation "Writes one byte \(octet) to the underlying stream
-STREAM."))
-
-#-:lispworks
-(defmethod write-byte* (byte (flexi-output-stream flexi-output-stream))
- (declare #.*standard-optimize-settings*)
- (with-accessors ((stream flexi-stream-stream))
- flexi-output-stream
- (write-byte byte stream)))
-
-#+:lispworks
-(defmethod write-byte* (byte (flexi-output-stream flexi-output-stream))
- (declare #.*standard-optimize-settings*)
- (with-accessors ((stream flexi-stream-stream))
- flexi-output-stream
- (write-byte byte stream)))
-
-#+:lispworks
-(defmethod write-byte* (byte (flexi-output-stream flexi-char-output-stream))
- "This method is only used for LispWorks bivalent streams which
-aren't binary."
- (declare #.*standard-optimize-settings*)
- ;; we use WRITE-SEQUENCE because WRITE-BYTE doesn't work with all
- ;; bivalent streams in LispWorks (4.4.6)
- (with-accessors ((stream flexi-stream-stream))
- flexi-output-stream
- (write-sequence (make-array 1 :element-type 'octet
- :initial-element byte)
- stream)
- byte))
-
-(defmethod stream-write-char ((stream flexi-output-stream) char)
- (declare #.*standard-optimize-settings*)
- (with-accessors ((external-format flexi-stream-external-format))
- stream
- (flet ((writer (octet)
- (write-byte* octet stream)))
- (declare (dynamic-extent (function writer)))
- (char-to-octets external-format char #'writer))))
-
-(defmethod stream-write-char :after ((stream flexi-output-stream) char)
- (declare #.*standard-optimize-settings*)
- ;; update the column unless we're in the middle of the line and
- ;; the current value is NIL
- (with-accessors ((column flexi-stream-column))
- stream
- (cond ((char= char #\Newline) (setq column 0))
- (column (incf (the integer column))))))
-
-(defmethod stream-clear-output ((flexi-output-stream flexi-output-stream))
- "Simply calls the corresponding method for the underlying
-output stream."
- (declare #.*standard-optimize-settings*)
- (with-accessors ((stream flexi-stream-stream))
- flexi-output-stream
- (clear-output stream)))
-
-(defmethod stream-finish-output ((flexi-output-stream flexi-output-stream))
- "Simply calls the corresponding method for the underlying
-output stream."
- (declare #.*standard-optimize-settings*)
- (with-accessors ((stream flexi-stream-stream))
- flexi-output-stream
- (finish-output stream)))
-
-(defmethod stream-force-output ((flexi-output-stream flexi-output-stream))
- "Simply calls the corresponding method for the underlying
-output stream."
- (declare #.*standard-optimize-settings*)
- (with-accessors ((stream flexi-stream-stream))
- flexi-output-stream
- (force-output stream)))
-
-(defmethod stream-line-column ((flexi-output-stream flexi-output-stream))
- "Returns the column stored in the COLUMN slot of the
-FLEXI-OUTPUT-STREAM object STREAM."
- (declare #.*standard-optimize-settings*)
- (with-accessors ((column flexi-stream-column))
- flexi-output-stream
- column))
-
-(defmethod stream-write-byte ((flexi-output-stream flexi-output-stream) byte)
- "Writes a byte \(octet) to the underlying stream."
- (declare #.*standard-optimize-settings*)
- (with-accessors ((column flexi-stream-column))
- flexi-output-stream
- ;; set column to NIL because we don't know how to handle binary
- ;; output mixed with character output
- (setq column nil)
- (write-byte* byte flexi-output-stream)))
-
-#+:allegro
-(defmethod stream-terpri ((stream flexi-output-stream))
- "Writes a #\Newline character to the underlying stream."
- (declare #.*standard-optimize-settings*)
- ;; needed for AllegroCL - grrr...
- (stream-write-char stream #\Newline))
-
-(defmethod stream-write-sequence ((flexi-output-stream flexi-output-stream) sequence start end &key)
- "An optimized version which uses a buffer underneath. The function
-can accepts characters as well as octets and it decides what to do
-based on the element type of the sequence \(if possible) or on the
-individual elements, i.e. you can mix characters and octets in
-SEQUENCE if you want. Whether that really works might also depend on
-your Lisp, some of the implementations are more picky than others."
- (declare #.*standard-optimize-settings*)
- (declare (fixnum start end))
- (with-accessors ((column flexi-stream-column)
- (external-format flexi-stream-external-format)
- (stream flexi-stream-stream))
- flexi-output-stream
- (when (>= start end)
- (return-from stream-write-sequence sequence))
- (when (and (vectorp sequence)
- (subtypep (array-element-type sequence) 'integer))
- ;; if this is pure binary output, just send all the stuff to the
- ;; underlying stream directly and skip the rest
- (setq column nil)
- (return-from stream-write-sequence
- (write-sequence sequence stream :start start :end end)))
- ;; otherwise hand over to the external format to do the work
- (write-sequence* external-format flexi-output-stream sequence start end))
- sequence)
-
-(defmethod stream-write-string ((stream flexi-output-stream) string
- &optional (start 0) (end (length string)))
- "Simply hands over to the optimized method for STREAM-WRITE-SEQUENCE."
- (declare #.*standard-optimize-settings*)
- (stream-write-sequence stream string start (or end (length string))))
(DIR) diff --git a/3rdparties/software/flexi-streams-20190107-git/packages.lisp b/3rdparties/software/flexi-streams-20190107-git/packages.lisp
@@ -1,90 +0,0 @@
-;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-USER; Base: 10 -*-
-;;; $Header: /usr/local/cvsrep/flexi-streams/packages.lisp,v 1.39 2008/05/30 07:50:31 edi Exp $
-
-;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved.
-
-;;; Redistribution and use in source and binary forms, with or without
-;;; modification, are permitted provided that the following conditions
-;;; are met:
-
-;;; * Redistributions of source code must retain the above copyright
-;;; notice, this list of conditions and the following disclaimer.
-
-;;; * Redistributions in binary form must reproduce the above
-;;; copyright notice, this list of conditions and the following
-;;; disclaimer in the documentation and/or other materials
-;;; provided with the distribution.
-
-;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED
-;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
-;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
-;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
-;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
-;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
-;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
-;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
-;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
-;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
-;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-
-(in-package :cl-user)
-
-(unless (find-symbol (symbol-name :stream-file-position) :trivial-gray-streams)
- (error "You need a newer version of TRIVIAL-GRAY-STREAMS."))
-
-(defpackage :flexi-streams
- (:use :cl :trivial-gray-streams)
- (:nicknames :flex)
- (:shadow #+:lispworks :with-accessors
- :defconstant)
- (:export :*default-eol-style*
- :*default-little-endian*
- :*substitution-char*
- :accept-overlong-sequence
- :char-length
- :external-format-condition
- :external-format-condition-external-format
- :external-format-eol-style
- :external-format-error
- :external-format-encoding-error
- :external-format-equal
- :external-format-id
- :external-format-little-endian
- :external-format-name
- :flexi-input-stream
- :flexi-output-stream
- :flexi-io-stream
- :flexi-stream
- :flexi-stream-bound
- :flexi-stream-column
- :flexi-stream-external-format
- :flexi-stream-element-type
- :flexi-stream-element-type-error
- :flexi-stream-element-type-error-element-type
- :flexi-stream-error
- :flexi-stream-out-of-sync-error
- :flexi-stream-position
- :flexi-stream-stream
- :get-output-stream-sequence
- :in-memory-stream
- :in-memory-stream-closed-error
- :in-memory-stream-error
- :in-memory-stream-position-spec-error
- :in-memory-stream-position-spec-error-position-spec
- :in-memory-input-stream
- :in-memory-output-stream
- :list-stream
- :make-external-format
- :make-in-memory-input-stream
- :make-in-memory-output-stream
- :make-flexi-stream
- :octet
- :octet-length
- :octets-to-string
- :output-stream-sequence-length
- :peek-byte
- :string-to-octets
- :unread-byte
- :vector-stream
- :with-input-from-sequence
- :with-output-to-sequence))
(DIR) diff --git a/3rdparties/software/flexi-streams-20190107-git/specials.lisp b/3rdparties/software/flexi-streams-20190107-git/specials.lisp
@@ -1,199 +0,0 @@
-;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: FLEXI-STREAMS; Base: 10 -*-
-;;; $Header: /usr/local/cvsrep/flexi-streams/specials.lisp,v 1.33 2008/05/25 01:40:54 edi Exp $
-
-;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved.
-
-;;; Redistribution and use in source and binary forms, with or without
-;;; modification, are permitted provided that the following conditions
-;;; are met:
-
-;;; * Redistributions of source code must retain the above copyright
-;;; notice, this list of conditions and the following disclaimer.
-
-;;; * Redistributions in binary form must reproduce the above
-;;; copyright notice, this list of conditions and the following
-;;; disclaimer in the documentation and/or other materials
-;;; provided with the distribution.
-
-;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED
-;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
-;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
-;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
-;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
-;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
-;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
-;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
-;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
-;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
-;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-
-(in-package :flexi-streams)
-
-(defvar *standard-optimize-settings*
- '(optimize
- speed
- (space 0)
- (debug 1)
- (compilation-speed 0))
- "The standard optimize settings used by most declaration expressions.")
-
-(defvar *fixnum-optimize-settings*
- '(optimize
- speed
- (space 0)
- (debug 1)
- (compilation-speed 0)
- #+:lispworks (hcl:fixnum-safety 0))
- "Like *STANDARD-OPTIMIZE-SETTINGS*, but \(on LispWorks) with all
-arithmetic being fixnum arithmetic.")
-
-(defconstant +lf+ (char-code #\Linefeed))
-
-(defconstant +cr+ (char-code #\Return))
-
-(defvar *current-unreader* nil
- "A unary function which might be called to `unread' a character
-\(i.e. the sequence of octets it represents).
-
-Used by the function OCTETS-TO-CHAR-CODE and must always be bound to a
-suitable functional object when this function is called.")
-
-(defvar +name-map+
- '((:utf8 . :utf-8)
- (:utf16 . :utf-16)
- (:ucs2 . :utf-16)
- (:ucs-2 . :utf-16)
- (:unicode . :utf-16)
- (:utf32 . :utf-32)
- (:ucs4 . :utf-32)
- (:ucs-4 . :utf-32)
- (:ascii . :us-ascii)
- (:koi8r . :koi8-r)
- (:latin-1 . :iso-8859-1)
- (:latin1 . :iso-8859-1)
- (:latin-2 . :iso-8859-2)
- (:latin2 . :iso-8859-2)
- (:latin-3 . :iso-8859-3)
- (:latin3 . :iso-8859-3)
- (:latin-4 . :iso-8859-4)
- (:latin4 . :iso-8859-4)
- (:cyrillic . :iso-8859-5)
- (:arabic . :iso-8859-6)
- (:greek . :iso-8859-7)
- (:hebrew . :iso-8859-8)
- (:latin-5 . :iso-8859-9)
- (:latin5 . :iso-8859-9)
- (:latin-6 . :iso-8859-10)
- (:latin6 . :iso-8859-10)
- (:thai . :iso-8859-11)
- (:latin-7 . :iso-8859-13)
- (:latin7 . :iso-8859-13)
- (:latin-8 . :iso-8859-14)
- (:latin8 . :iso-8859-14)
- (:latin-9 . :iso-8859-15)
- (:latin9 . :iso-8859-15)
- (:latin-0 . :iso-8859-15)
- (:latin0 . :iso-8859-15)
- (:latin-10 . :iso-8859-16)
- (:latin10 . :iso-8859-16)
- (:codepage . :code-page)
- #+(and :lispworks :win32)
- (win32:code-page . :code-page))
- "An alist which mapes alternative names for external formats to
-their canonical counterparts.")
-
-(defvar +shortcut-map+
- '((:ucs-2le . (:ucs-2 :little-endian t))
- (:ucs-2be . (:ucs-2 :little-endian nil))
- (:ucs-4le . (:ucs-4 :little-endian t))
- (:ucs-4be . (:ucs-4 :little-endian nil))
- (:utf-16le . (:utf-16 :little-endian t))
- (:utf-16be . (:utf-16 :little-endian nil))
- (:utf-32le . (:utf-32 :little-endian t))
- (:utf-32be . (:utf-32 :little-endian nil))
- (:ibm437 . (:code-page :id 437))
- (:ibm850 . (:code-page :id 850))
- (:ibm852 . (:code-page :id 852))
- (:ibm855 . (:code-page :id 855))
- (:ibm857 . (:code-page :id 857))
- (:ibm860 . (:code-page :id 860))
- (:ibm861 . (:code-page :id 861))
- (:ibm862 . (:code-page :id 862))
- (:ibm863 . (:code-page :id 863))
- (:ibm864 . (:code-page :id 864))
- (:ibm865 . (:code-page :id 865))
- (:ibm866 . (:code-page :id 866))
- (:ibm869 . (:code-page :id 869))
- (:windows-1250 . (:code-page :id 1250))
- (:windows-1251 . (:code-page :id 1251))
- (:windows-1252 . (:code-page :id 1252))
- (:windows-1253 . (:code-page :id 1253))
- (:windows-1254 . (:code-page :id 1254))
- (:windows-1255 . (:code-page :id 1255))
- (:windows-1256 . (:code-page :id 1256))
- (:windows-1257 . (:code-page :id 1257))
- (:windows-1258 . (:code-page :id 1258)))
- "An alist which maps shortcuts for external formats to their
-long forms.")
-
-(defvar *default-eol-style*
- #+:win32 :crlf
- #-:win32 :lf
- "The end-of-line style used by external formats if none is
-explicitly given. Depends on the OS the code is compiled on.")
-
-(defvar *default-little-endian*
- #+:little-endian t
- #-:little-endian nil
- "Whether external formats are little-endian by default
-\(i.e. unless explicitly specified). Depends on the platform
-the code is compiled on.")
-
-(defvar *substitution-char* nil
- "If this value is not NIL, it should be a character which is used
-\(as if by a USE-VALUE restart) whenever during reading an error of
-type FLEXI-STREAM-ENCODING-ERROR would have been signalled otherwise.")
-
-(defconstant +iso-8859-hashes+
- (loop for (name . table) in +iso-8859-tables+
- collect (cons name (invert-table table)))
- "An alist which maps names for ISO-8859 encodings to hash
-tables which map character codes to the corresponding octets.")
-
-(defconstant +code-page-hashes+
- (loop for (id . table) in +code-page-tables+
- collect (cons id (invert-table table)))
- "An alist which maps IDs of Windows code pages to hash tables
-which map character codes to the corresponding octets.")
-
-(defconstant +ascii-hash+ (invert-table +ascii-table+)
- "A hash table which maps US-ASCII character codes to the
-corresponding octets.")
-
-(defconstant +koi8-r-hash+ (invert-table +koi8-r-table+)
- "A hash table which maps KOI8-R character codes to the
-corresponding octets.")
-
-(defconstant +buffer-size+ 8192
- "Default size for buffers used for internal purposes.")
-
-(pushnew :flexi-streams *features*)
-
-;; stuff for Nikodemus Siivola's HYPERDOC
-;; see <http://common-lisp.net/project/hyperdoc/>
-;; and <http://www.cliki.net/hyperdoc>
-;; also used by LW-ADD-ONS
-
-(defvar *hyperdoc-base-uri* "http://weitz.de/flexi-streams/")
-
-(let ((exported-symbols-alist
- (loop for symbol being the external-symbols of :flexi-streams
- collect (cons symbol
- (concatenate 'string
- "#"
- (string-downcase symbol))))))
- (defun hyperdoc-lookup (symbol type)
- (declare (ignore type))
- (cdr (assoc symbol
- exported-symbols-alist
- :test #'eq))))
(DIR) diff --git a/3rdparties/software/flexi-streams-20190107-git/stream.lisp b/3rdparties/software/flexi-streams-20190107-git/stream.lisp
@@ -1,241 +0,0 @@
-;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: FLEXI-STREAMS; Base: 10 -*-
-;;; $Header: /usr/local/cvsrep/flexi-streams/stream.lisp,v 1.61 2008/05/19 22:32:56 edi Exp $
-
-;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved.
-
-;;; Redistribution and use in source and binary forms, with or without
-;;; modification, are permitted provided that the following conditions
-;;; are met:
-
-;;; * Redistributions of source code must retain the above copyright
-;;; notice, this list of conditions and the following disclaimer.
-
-;;; * Redistributions in binary form must reproduce the above
-;;; copyright notice, this list of conditions and the following
-;;; disclaimer in the documentation and/or other materials
-;;; provided with the distribution.
-
-;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED
-;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
-;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
-;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
-;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
-;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
-;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
-;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
-;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
-;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
-;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-
-(in-package :flexi-streams)
-
-(defclass flexi-stream (trivial-gray-stream-mixin)
- ((stream :initarg :stream
- :reader flexi-stream-stream
- :documentation "The actual stream that's used for
-input and/or output. It must be capable of reading/writing
-octets with READ-SEQUENCE and/or WRITE-SEQUENCE.")
- (external-format :initform (make-external-format :iso-8859-1)
- :initarg :flexi-stream-external-format
- :accessor flexi-stream-external-format
- :documentation "The encoding currently used
-by this stream. Can be changed on the fly.")
- (element-type :initform 'char*
- :initarg :element-type
- :accessor flexi-stream-element-type
- :documentation "The element type of this stream."))
- (:documentation "A FLEXI-STREAM object is a stream that's
-`layered' atop an existing binary/bivalent stream in order to
-allow for multi-octet external formats. FLEXI-STREAM itself is a
-mixin and should not be instantiated."))
-
-(defmethod initialize-instance :after ((flexi-stream flexi-stream) &rest initargs)
- "Makes sure the EXTERNAL-FORMAT and ELEMENT-TYPE slots contain
-reasonable values."
- (declare #.*standard-optimize-settings*)
- (declare (ignore initargs))
- (with-accessors ((external-format flexi-stream-external-format)
- (element-type flexi-stream-element-type))
- flexi-stream
- (unless (or (subtypep element-type 'character)
- (subtypep element-type 'octet))
- (error 'flexi-stream-element-type-error
- :element-type element-type
- :stream flexi-stream))
- (setq external-format (maybe-convert-external-format external-format))))
-
-(defmethod (setf flexi-stream-external-format) :around (new-value (flexi-stream flexi-stream))
- "Converts the new value to an EXTERNAL-FORMAT object if
-necessary."
- (declare #.*standard-optimize-settings*)
- (call-next-method (maybe-convert-external-format new-value) flexi-stream))
-
-(defmethod (setf flexi-stream-element-type) :before (new-value (flexi-stream flexi-stream))
- "Checks whether the new value makes sense before it is set."
- (declare #.*standard-optimize-settings*)
- (unless (or (subtypep new-value 'character)
- (type-equal new-value 'octet))
- (error 'flexi-stream-element-type-error
- :element-type new-value
- :stream flexi-stream)))
-
-(defmethod stream-element-type ((stream flexi-stream))
- "Returns the element type that was provided by the creator of
-the stream."
- (declare #.*standard-optimize-settings*)
- (with-accessors ((element-type flexi-stream-element-type))
- stream
- element-type))
-
-(defmethod close ((stream flexi-stream) &key abort)
- "Closes the flexi stream by closing the underlying `real'
-stream."
- (declare #.*standard-optimize-settings*)
- (with-accessors ((stream flexi-stream-stream))
- stream
- (cond ((open-stream-p stream)
- (close stream :abort abort))
- (t nil))))
-
-(defmethod open-stream-p ((stream flexi-stream))
- "A flexi stream is open if its underlying stream is open."
- (declare #.*standard-optimize-settings*)
- (with-accessors ((stream flexi-stream-stream))
- stream
- (open-stream-p stream)))
-
-(defmethod stream-file-position ((stream flexi-stream))
- "Dispatch to method for underlying stream."
- (declare #.*standard-optimize-settings*)
- (with-accessors ((stream flexi-stream-stream))
- stream
- (file-position stream)))
-
-(defmethod (setf stream-file-position) (position-spec (stream flexi-stream))
- "Dispatch to method for underlying stream."
- (declare #.*standard-optimize-settings*)
- (with-accessors ((underlying-stream flexi-stream-stream))
- stream
- (if (file-position underlying-stream position-spec)
- (setf (flexi-stream-position stream) (file-position underlying-stream))
- nil)))
-
-(defclass flexi-output-stream (flexi-stream fundamental-binary-output-stream
- fundamental-character-output-stream)
- ((column :initform 0
- :accessor flexi-stream-column
- :documentation "The current output column. A
-non-negative integer or NIL."))
- (:documentation "A FLEXI-OUTPUT-STREAM is a FLEXI-STREAM that
-can actually be instatiated and used for output. Don't use
-MAKE-INSTANCE to create a new FLEXI-OUTPUT-STREAM but use
-MAKE-FLEXI-STREAM instead."))
-
-#+:cmu
-(defmethod input-stream-p ((stream flexi-output-stream))
- "Explicitly states whether this is an input stream."
- (declare #.*standard-optimize-settings*)
- nil)
-
-(defclass flexi-input-stream (flexi-stream fundamental-binary-input-stream
- fundamental-character-input-stream)
- ((last-char-code :initform nil
- :accessor flexi-stream-last-char-code
- :documentation "This slot either holds NIL or the
-last character \(code) read successfully. This is mainly used for
-UNREAD-CHAR sanity checks.")
- (last-octet :initform nil
- :accessor flexi-stream-last-octet
- :documentation "This slot either holds NIL or the last
-octet read successfully from the stream using a `binary' operation
-such as READ-BYTE. This is mainly used for UNREAD-BYTE sanity
-checks.")
- (octet-stack :initform nil
- :accessor flexi-stream-octet-stack
- :documentation "A small buffer which holds octets
-that were already read from the underlying stream but not yet
-used to produce characters. This is mainly used if we have to
-look ahead for a CR/LF line ending.")
- (position :initform 0
- :initarg :position
- :type integer
- :accessor flexi-stream-position
- :documentation "The position within the stream where each
-octet read counts as one.")
- (bound :initform nil
- :initarg :bound
- :type (or null integer)
- :accessor flexi-stream-bound
- :documentation "When this is not NIL, it must be an integer
-and the stream will behave as if no more data is available as soon as
-POSITION is greater or equal than this value."))
- (:documentation "A FLEXI-INPUT-STREAM is a FLEXI-STREAM that
-can actually be instatiated and used for input. Don't use
-MAKE-INSTANCE to create a new FLEXI-INPUT-STREAM but use
-MAKE-FLEXI-STREAM instead."))
-
-#+:cmu
-(defmethod output-stream-p ((stream flexi-input-stream))
- "Explicitly states whether this is an output stream."
- (declare #.*standard-optimize-settings*)
- nil)
-
-(defclass flexi-io-stream (flexi-input-stream flexi-output-stream)
- ()
- (:documentation "A FLEXI-IO-STREAM is a FLEXI-STREAM that can
-actually be instatiated and used for input and output. Don't use
-MAKE-INSTANCE to create a new FLEXI-IO-STREAM but use
-MAKE-FLEXI-STREAM instead."))
-
-#+:cmu
-(defmethod input-stream-p ((stream flexi-io-stream))
- "Explicitly states whether this is an input stream."
- (declare #.*standard-optimize-settings*)
- t)
-
-#+:cmu
-(defmethod output-stream-p ((stream flexi-io-stream))
- "Explicitly states whether this is an output stream."
- (declare #.*standard-optimize-settings*)
- t)
-
-(defun make-flexi-stream (stream &rest args
- &key (external-format (make-external-format :iso-8859-1))
- element-type column position bound)
- "Creates and returns a new flexi stream. STREAM must be an open
-binary or `bivalent' stream, i.e. it must be capable of
-reading/writing octets with READ-SEQUENCE and/or WRITE-SEQUENCE. The
-resulting flexi stream is an input stream if and only if STREAM is an
-input stream. Likewise, it's an output stream if and only if STREAM
-is an output stream. The default for ELEMENT-TYPE is LW:SIMPLE-CHAR
-on LispWorks and CHARACTER on other Lisps. EXTERNAL-FORMAT must be an
-EXTERNAL-FORMAT object or a symbol or a list denoting such an object.
-COLUMN is the initial column of the stream which is either a
-non-negative integer or NIL. The COLUMN argument must only be used
-for output streams. POSITION \(only used for input streams) should be
-an integer and it denotes the position the stream is in - it will be
-increased by one for each octet read. BOUND \(only used for input
-streams) should be NIL or an integer. If BOUND is not NIL and
-POSITION has gone beyond BOUND, then the stream will behave as if no
-more input is available."
- (declare #.*standard-optimize-settings*)
- ;; these arguments are ignored - they are only there to provide a
- ;; meaningful parameter list for IDEs
- (declare (ignore element-type column position bound))
- (unless (and (streamp stream)
- (open-stream-p stream))
- (error "~S should have been an open stream." stream))
- (apply #'make-instance
- ;; actual type depends on STREAM
- (cond ((and (input-stream-p stream)
- (output-stream-p stream))
- 'flexi-io-stream)
- ((input-stream-p stream)
- 'flexi-input-stream)
- ((output-stream-p stream)
- 'flexi-output-stream)
- (t
- (error "~S is neither an input nor an output stream." stream)))
- :stream stream
- :flexi-stream-external-format external-format
- (sans args :external-format)))
(DIR) diff --git a/3rdparties/software/flexi-streams-20190107-git/strings.lisp b/3rdparties/software/flexi-streams-20190107-git/strings.lisp
@@ -1,82 +0,0 @@
-;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: FLEXI-STREAMS; Base: 10 -*-
-;;; $Header: /usr/local/cvsrep/flexi-streams/strings.lisp,v 1.34 2008/05/26 10:55:08 edi Exp $
-
-;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved.
-
-;;; Redistribution and use in source and binary forms, with or without
-;;; modification, are permitted provided that the following conditions
-;;; are met:
-
-;;; * Redistributions of source code must retain the above copyright
-;;; notice, this list of conditions and the following disclaimer.
-
-;;; * Redistributions in binary form must reproduce the above
-;;; copyright notice, this list of conditions and the following
-;;; disclaimer in the documentation and/or other materials
-;;; provided with the distribution.
-
-;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED
-;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
-;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
-;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
-;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
-;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
-;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
-;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
-;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
-;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
-;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-
-(in-package :flexi-streams)
-
-(defun string-to-octets (string &key
- (external-format :latin1)
- (start 0) (end (length string)))
- "Converts the Lisp string STRING from START to END to an array of
-octets corresponding to the external format designated by
-EXTERNAL-FORMAT.
-
-In spite of the name, STRING can be any sequence of characters, but
-the function is optimized for strings."
- (declare #.*standard-optimize-settings*)
- (setq external-format (maybe-convert-external-format external-format))
- ;; the external format knows how to do it...
- (string-to-octets* external-format string start end))
-
-(defun octets-to-string (sequence &key
- (external-format :latin1)
- (start 0) (end (length sequence)))
- "Converts the Lisp sequence SEQUENCE of octets from START to END to
-a string using the external format designated by EXTERNAL-FORMAT.
-
-This function is optimized for the case of SEQUENCE being a vector.
-Don't use lists if you're in a hurry."
- (declare #.*standard-optimize-settings*)
- (declare (fixnum start end))
- (setq external-format (maybe-convert-external-format external-format))
- ;; the external format knows how to do it...
- (octets-to-string* external-format sequence start end))
-
-(defun octet-length (string &key (external-format :latin1) (start 0) (end (length string)))
- "Returns the length of the substring of STRING from START to END in
-octets if encoded using the external format EXTERNAL-FORMAT.
-
-In spite of the name, STRING can be any sequence of characters, but
-the function is optimized for strings."
- (declare #.*standard-optimize-settings*)
- (declare (fixnum start end))
- (setq external-format (maybe-convert-external-format external-format))
- (compute-number-of-octets external-format string start end))
-
-(defun char-length (sequence &key (external-format :latin1) (start 0) (end (length sequence)))
- "Kind of the inverse of OCTET-LENGTH. Returns the length of the
-subsequence \(of octets) of SEQUENCE from START to END in characters
-if decoded using the external format EXTERNAL-FORMAT. Note that this
-function doesn't check for the validity of the data in SEQUENCE.
-
-This function is optimized for the case of SEQUENCE being a vector.
-Don't use lists if you're in a hurry."
- (declare #.*standard-optimize-settings*)
- (declare (fixnum start end))
- (setq external-format (maybe-convert-external-format external-format))
- (compute-number-of-chars external-format sequence start end))
(DIR) diff --git a/3rdparties/software/flexi-streams-20190107-git/test/README b/3rdparties/software/flexi-streams-20190107-git/test/README
@@ -1,4 +0,0 @@
-The reference files in this directory were created/converted using a
-mixture of GNU recode and the native internationalization facilities
-of LispWorks and AllegroCL, i.e. we're not testing FLEXI-STREAMS
-against files created by itself (which would be kind of useless).
-\ No newline at end of file
(DIR) diff --git a/3rdparties/software/flexi-streams-20190107-git/test/hebrew_latin8_cr.txt b/3rdparties/software/flexi-streams-20190107-git/test/hebrew_latin8_cr.txt
@@ -1 +0,0 @@
-: 1 - 2: - :- 3 - - 4: 5: - - 6: - 7 :-- - 8: - 9:- 10:- 11- - :- 12 - -:-: - - 13 14 : - 15:-- - 16 - : 17:- 18:- : - - 19 20: - - - - 21 :- - 22: -: - - 23 24:- - - - 25 - :- 26 :- - - - 27: 28 - :- - -- 29- -- - - : - - - 30 -- - -:- - -- 31: -
-\ No newline at end of file
(DIR) diff --git a/3rdparties/software/flexi-streams-20190107-git/test/hebrew_latin8_crlf.txt b/3rdparties/software/flexi-streams-20190107-git/test/hebrew_latin8_crlf.txt
@@ -1,68 +0,0 @@
-: 1
- - 2
-: -
-:- 3
- - - 4
-:
- 5
-: - -
- 6
-:
- - 7
-
-:-
-- - 8
-:
-- 9
-:-
- 10
-:-
- 11
-- -
-:-
- 12
- - -
-:-
-: - - 13
- 14
-
-:
-- 15
-:-
-- - 16
- -
-:
- 17
-:-
- 18
-:-
-: - - 19
- 20
-: - -
-- - 21
-
-:- -
- 22
-: -
-: - - 23
- 24
-:- -
-- - 25
- -
-:-
- 26
-
-:- - -
- - 27
-:
- 28
- -
-:- -
- -- 29
-- -- - -
-: -
- - - 30
- -- - -
-:-
- - -- 31
-: -
(DIR) diff --git a/3rdparties/software/flexi-streams-20190107-git/test/hebrew_latin8_lf.txt b/3rdparties/software/flexi-streams-20190107-git/test/hebrew_latin8_lf.txt
@@ -1,68 +0,0 @@
-: 1
- - 2
-: -
-:- 3
- - - 4
-:
- 5
-: - -
- 6
-:
- - 7
-
-:-
-- - 8
-:
-- 9
-:-
- 10
-:-
- 11
-- -
-:-
- 12
- - -
-:-
-: - - 13
- 14
-
-:
-- 15
-:-
-- - 16
- -
-:
- 17
-:-
- 18
-:-
-: - - 19
- 20
-: - -
-- - 21
-
-:- -
- 22
-: -
-: - - 23
- 24
-:- -
-- - 25
- -
-:-
- 26
-
-:- - -
- - 27
-:
- 28
- -
-:- -
- -- 29
-- -- - -
-: -
- - - 30
- -- - -
-:-
- - -- 31
-: -
(DIR) diff --git a/3rdparties/software/flexi-streams-20190107-git/test/hebrew_utf8_cr.txt b/3rdparties/software/flexi-streams-20190107-git/test/hebrew_utf8_cr.txt
@@ -1 +0,0 @@
-:ץראה תאו םימשה תא םיהלא ארב תישארב א 1םוהת ינפ-לע ךשחו והבו והת התיה ץראהו ב 2:םימה ינפ-לע תפחרמ םיהלא חורו:רוא-יהיו רוא יהי םיהלא רמאיו ג 3םיהלא לדביו בוט-יכ רואה-תא םיהלא אריו ד 4:ךשחה ןיבו רואה ןיבהליל ארק ךשחלו םוי רואל םיהלא ארקיו ה 5:דחא םוי רקב-יהיו ברע-יהיויהיו םימה ךותב עיקר יהי םיהלא רמאיו ו 6:םימל םימ ןיב לידבמרשא םימה ןיב לדביו עיקרה-תא םיהלא שעיו ז 7עיקרל לעמ רשא םימה ןיבו עיקרל תחתמ:ןכ-יהיורקב-יהיו ברע-יהיו םימש עיקרל םיהלא ארקיו ח 8:ינש םויםוקמ-לא םימשה תחתמ םימה ווקי םיהלא רמאיו ט 9:ןכ-יהיו השביה הארתו דחאארק םימה הוקמלו ץרא השביל םיהלא ארקיו י 10:בוט-יכ םיהלא אריו םימיערז עירזמ בשע אשד ץראה אשדת םיהלא רמאיו אי 11ץראה-לע וב-וערז רשא ונימל ירפ השע ירפ ץע:ןכ-יהיוץעו והנימל ערז עירזמ בשע אשד ץראה אצותו בי 12םיהלא אריו והנימל וב-וערז רשא ירפ-השע:בוט-יכ:ישילש םוי רקב-יהיו ברע-יהיו גי 13לידבהל םימשה עיקרב תראמ יהי םיהלא רמאיו די 14םידעומלו תתאל ויהו הלילה ןיבו םויה ןיב:םינשו םימילוץראה-לע ריאהל םימשה עיקרב תרואמל ויהו וט 15:ןכ-יהיורואמה-תא םילדגה תראמה ינש-תא םיהלא שעיו זט 16תלשממל ןטקה רואמה-תאו םויה תלשממל לדגה:םיבכוכה תאו הלילהריאהל םימשה עיקרב םיהלא םתא ןתיו זי 17:ץראה-לעןיבו רואה ןיב לידבהלו הלילבו םויב לשמלו חי 18:בוט-יכ םיהלא אריו ךשחה:יעיבר םוי רקב-יהיו ברע-יהיו טי 19ףועו היח שפנ ץרש םימה וצרשי םיהלא רמאיו כ 20:םימשה עיקר ינפ-לע ץראה-לע ףפועישפנ-לכ תאו םילדגה םנינתה-תא םיהלא ארביו אכ 21תאו םהנימל םימה וצרש רשא תשמרה היחה:בוט-יכ םיהלא אריו והנימל ףנכ ףוע-לכואלמו וברו ורפ רמאל םיהלא םתא ךרביו בכ 22:ץראב ברי ףועהו םימיב םימה-תא:ישימח םוי רקב-יהיו ברע-יהיו גכ 23המהב הנימל היח שפנ ץראה אצות םיהלא רמאיו דכ 24:ןכ-יהיו הנימל ץרא-ותיחו שמרוהמהבה-תאו הנימל ץראה תיח-תא םיהלא שעיו הכ 25םיהלא אריו והנימל המדאה שמר-לכ תאו הנימל:בוט-יכונתומדכ ונמלצב םדא השענ םיהלא רמאיו וכ 26המהבבו םימשה ףועבו םיה תגדב ודריו:ץראה-לע שמרה שמרה-לכבו ץראה-לכבוארב םיהלא םלצב ומלצב םדאה-תא םיהלא ארביו זכ 27:םתא ארב הבקנו רכז ותאוברו ורפ םיהלא םהל רמאיו םיהלא םתא ךרביו חכ 28ףועבו םיה תגדב ודרו השבכו ץראה-תא ואלמו:ץראה-לע תשמרה היח-לכבו םימשהערז בשע-לכ-תא םכל יתתנ הנה םיהלא רמאיו טכ 29וב-רשא ץעה-לכ-תאו ץראה-לכ ינפ-לע רשא ערז:הלכאל היהי םכל ערז ערז ץע-ירפשמור לכלו םימשה ףוע-לכלו ץראה תיח-לכלו ל 30בשע קרי-לכ-תא היח שפנ וב-רשא ץראה-לע:ןכ-יהיו הלכאלדאמ בוט-הנהו השע רשא-לכ-תא םיהלא אריו אל 31:יששה םוי רקב-יהיו בר
-\ No newline at end of file
(DIR) diff --git a/3rdparties/software/flexi-streams-20190107-git/test/hebrew_utf8_crlf.txt b/3rdparties/software/flexi-streams-20190107-git/test/hebrew_utf8_crlf.txt
@@ -1,68 +0,0 @@
-:ץראה תאו םימשה תא םיהלא ארב תישארב א 1
-םוהת ינפ-לע ךשחו והבו והת התיה ץראהו ב 2
-:םימה ינפ-לע תפחרמ םיהלא חורו
-:רוא-יהיו רוא יהי םיהלא רמאיו ג 3
-םיהלא לדביו בוט-יכ רואה-תא םיהלא אריו ד 4
-:ךשחה ןיבו רואה ןיב
-הליל ארק ךשחלו םוי רואל םיהלא ארקיו ה 5
-:דחא םוי רקב-יהיו ברע-יהיו
-יהיו םימה ךותב עיקר יהי םיהלא רמאיו ו 6
-:םימל םימ ןיב לידבמ
-רשא םימה ןיב לדביו עיקרה-תא םיהלא שעיו ז 7
-עיקרל לעמ רשא םימה ןיבו עיקרל תחתמ
-:ןכ-יהיו
-רקב-יהיו ברע-יהיו םימש עיקרל םיהלא ארקיו ח 8
-:ינש םוי
-םוקמ-לא םימשה תחתמ םימה ווקי םיהלא רמאיו ט 9
-:ןכ-יהיו השביה הארתו דחא
-ארק םימה הוקמלו ץרא השביל םיהלא ארקיו י 10
-:בוט-יכ םיהלא אריו םימי
-ערז עירזמ בשע אשד ץראה אשדת םיהלא רמאיו אי 11
-ץראה-לע וב-וערז רשא ונימל ירפ השע ירפ ץע
-:ןכ-יהיו
-ץעו והנימל ערז עירזמ בשע אשד ץראה אצותו בי 12
-םיהלא אריו והנימל וב-וערז רשא ירפ-השע
-:בוט-יכ
-:ישילש םוי רקב-יהיו ברע-יהיו גי 13
-לידבהל םימשה עיקרב תראמ יהי םיהלא רמאיו די 14
-םידעומלו תתאל ויהו הלילה ןיבו םויה ןיב
-:םינשו םימילו
-ץראה-לע ריאהל םימשה עיקרב תרואמל ויהו וט 15
-:ןכ-יהיו
-רואמה-תא םילדגה תראמה ינש-תא םיהלא שעיו זט 16
-תלשממל ןטקה רואמה-תאו םויה תלשממל לדגה
-:םיבכוכה תאו הלילה
-ריאהל םימשה עיקרב םיהלא םתא ןתיו זי 17
-:ץראה-לע
-ןיבו רואה ןיב לידבהלו הלילבו םויב לשמלו חי 18
-:בוט-יכ םיהלא אריו ךשחה
-:יעיבר םוי רקב-יהיו ברע-יהיו טי 19
-ףועו היח שפנ ץרש םימה וצרשי םיהלא רמאיו כ 20
-:םימשה עיקר ינפ-לע ץראה-לע ףפועי
-שפנ-לכ תאו םילדגה םנינתה-תא םיהלא ארביו אכ 21
-תאו םהנימל םימה וצרש רשא תשמרה היחה
-:בוט-יכ םיהלא אריו והנימל ףנכ ףוע-לכ
-ואלמו וברו ורפ רמאל םיהלא םתא ךרביו בכ 22
-:ץראב ברי ףועהו םימיב םימה-תא
-:ישימח םוי רקב-יהיו ברע-יהיו גכ 23
-המהב הנימל היח שפנ ץראה אצות םיהלא רמאיו דכ 24
-:ןכ-יהיו הנימל ץרא-ותיחו שמרו
-המהבה-תאו הנימל ץראה תיח-תא םיהלא שעיו הכ 25
-םיהלא אריו והנימל המדאה שמר-לכ תאו הנימל
-:בוט-יכ
-ונתומדכ ונמלצב םדא השענ םיהלא רמאיו וכ 26
-המהבבו םימשה ףועבו םיה תגדב ודריו
-:ץראה-לע שמרה שמרה-לכבו ץראה-לכבו
-ארב םיהלא םלצב ומלצב םדאה-תא םיהלא ארביו זכ 27
-:םתא ארב הבקנו רכז ותא
-וברו ורפ םיהלא םהל רמאיו םיהלא םתא ךרביו חכ 28
-ףועבו םיה תגדב ודרו השבכו ץראה-תא ואלמו
-:ץראה-לע תשמרה היח-לכבו םימשה
-ערז בשע-לכ-תא םכל יתתנ הנה םיהלא רמאיו טכ 29
-וב-רשא ץעה-לכ-תאו ץראה-לכ ינפ-לע רשא ערז
-:הלכאל היהי םכל ערז ערז ץע-ירפ
-שמור לכלו םימשה ףוע-לכלו ץראה תיח-לכלו ל 30
-בשע קרי-לכ-תא היח שפנ וב-רשא ץראה-לע
-:ןכ-יהיו הלכאל
-דאמ בוט-הנהו השע רשא-לכ-תא םיהלא אריו אל 31
-:יששה םוי רקב-יהיו בר
(DIR) diff --git a/3rdparties/software/flexi-streams-20190107-git/test/hebrew_utf8_lf.txt b/3rdparties/software/flexi-streams-20190107-git/test/hebrew_utf8_lf.txt
@@ -1,68 +0,0 @@
-:ץראה תאו םימשה תא םיהלא ארב תישארב א 1
-םוהת ינפ-לע ךשחו והבו והת התיה ץראהו ב 2
-:םימה ינפ-לע תפחרמ םיהלא חורו
-:רוא-יהיו רוא יהי םיהלא רמאיו ג 3
-םיהלא לדביו בוט-יכ רואה-תא םיהלא אריו ד 4
-:ךשחה ןיבו רואה ןיב
-הליל ארק ךשחלו םוי רואל םיהלא ארקיו ה 5
-:דחא םוי רקב-יהיו ברע-יהיו
-יהיו םימה ךותב עיקר יהי םיהלא רמאיו ו 6
-:םימל םימ ןיב לידבמ
-רשא םימה ןיב לדביו עיקרה-תא םיהלא שעיו ז 7
-עיקרל לעמ רשא םימה ןיבו עיקרל תחתמ
-:ןכ-יהיו
-רקב-יהיו ברע-יהיו םימש עיקרל םיהלא ארקיו ח 8
-:ינש םוי
-םוקמ-לא םימשה תחתמ םימה ווקי םיהלא רמאיו ט 9
-:ןכ-יהיו השביה הארתו דחא
-ארק םימה הוקמלו ץרא השביל םיהלא ארקיו י 10
-:בוט-יכ םיהלא אריו םימי
-ערז עירזמ בשע אשד ץראה אשדת םיהלא רמאיו אי 11
-ץראה-לע וב-וערז רשא ונימל ירפ השע ירפ ץע
-:ןכ-יהיו
-ץעו והנימל ערז עירזמ בשע אשד ץראה אצותו בי 12
-םיהלא אריו והנימל וב-וערז רשא ירפ-השע
-:בוט-יכ
-:ישילש םוי רקב-יהיו ברע-יהיו גי 13
-לידבהל םימשה עיקרב תראמ יהי םיהלא רמאיו די 14
-םידעומלו תתאל ויהו הלילה ןיבו םויה ןיב
-:םינשו םימילו
-ץראה-לע ריאהל םימשה עיקרב תרואמל ויהו וט 15
-:ןכ-יהיו
-רואמה-תא םילדגה תראמה ינש-תא םיהלא שעיו זט 16
-תלשממל ןטקה רואמה-תאו םויה תלשממל לדגה
-:םיבכוכה תאו הלילה
-ריאהל םימשה עיקרב םיהלא םתא ןתיו זי 17
-:ץראה-לע
-ןיבו רואה ןיב לידבהלו הלילבו םויב לשמלו חי 18
-:בוט-יכ םיהלא אריו ךשחה
-:יעיבר םוי רקב-יהיו ברע-יהיו טי 19
-ףועו היח שפנ ץרש םימה וצרשי םיהלא רמאיו כ 20
-:םימשה עיקר ינפ-לע ץראה-לע ףפועי
-שפנ-לכ תאו םילדגה םנינתה-תא םיהלא ארביו אכ 21
-תאו םהנימל םימה וצרש רשא תשמרה היחה
-:בוט-יכ םיהלא אריו והנימל ףנכ ףוע-לכ
-ואלמו וברו ורפ רמאל םיהלא םתא ךרביו בכ 22
-:ץראב ברי ףועהו םימיב םימה-תא
-:ישימח םוי רקב-יהיו ברע-יהיו גכ 23
-המהב הנימל היח שפנ ץראה אצות םיהלא רמאיו דכ 24
-:ןכ-יהיו הנימל ץרא-ותיחו שמרו
-המהבה-תאו הנימל ץראה תיח-תא םיהלא שעיו הכ 25
-םיהלא אריו והנימל המדאה שמר-לכ תאו הנימל
-:בוט-יכ
-ונתומדכ ונמלצב םדא השענ םיהלא רמאיו וכ 26
-המהבבו םימשה ףועבו םיה תגדב ודריו
-:ץראה-לע שמרה שמרה-לכבו ץראה-לכבו
-ארב םיהלא םלצב ומלצב םדאה-תא םיהלא ארביו זכ 27
-:םתא ארב הבקנו רכז ותא
-וברו ורפ םיהלא םהל רמאיו םיהלא םתא ךרביו חכ 28
-ףועבו םיה תגדב ודרו השבכו ץראה-תא ואלמו
-:ץראה-לע תשמרה היח-לכבו םימשה
-ערז בשע-לכ-תא םכל יתתנ הנה םיהלא רמאיו טכ 29
-וב-רשא ץעה-לכ-תאו ץראה-לכ ינפ-לע רשא ערז
-:הלכאל היהי םכל ערז ערז ץע-ירפ
-שמור לכלו םימשה ףוע-לכלו ץראה תיח-לכלו ל 30
-בשע קרי-לכ-תא היח שפנ וב-רשא ץראה-לע
-:ןכ-יהיו הלכאל
-דאמ בוט-הנהו השע רשא-לכ-תא םיהלא אריו אל 31
-:יששה םוי רקב-יהיו בר
(DIR) diff --git a/3rdparties/software/flexi-streams-20190107-git/test/kafka_cp1252_cr.txt b/3rdparties/software/flexi-streams-20190107-git/test/kafka_cp1252_cr.txt
@@ -1 +0,0 @@
-Als Gregor Samsa eines Morgens aus unruhigen Trumen erwachte, fand er sich in seinem Bett zu einem ungeheueren Ungeziefer verwandelt. Er lag auf seinem panzerartig harten Rcken und sah, wenn er den Kopf ein wenig hob, seinen gewlbten, braunen, von bogenfrmigen Versteifungen geteilten Bauch, auf dessen Hhe sich die Bettdecke, zum gnzlichen Niedergleiten bereit, kaum noch erhalten konnte. Seine vielen, im Vergleich zu seinem sonstigen Umfang klglich dnnen Beine flimmerten ihm hilflos vor den Augen.Was ist mit mir geschehen?, dachte er. Es war kein Traum. Sein Zimmer, ein richtiges, nur etwas zu kleines Menschenzimmer, lag ruhig zwischen den vier wohlbekannten Wnden. ber dem Tisch, auf dem eine auseinandergepackte Musterkollektion von Tuchwaren ausgebreitet war - Samsa war Reisender - hing das Bild, das er vor kurzem aus einer illustrierten Zeitschrift ausgeschnitten und in einem hbschen, vergoldeten Rahmen untergebracht hatte. Es stellte eine Dame dar, die mit einem Pelzhut und einer Pelzboa versehen, aufrecht dasa und einen schweren Pelzmuff, in dem ihr ganzer Unterarm verschwunden war, dem Beschauer entgegenhob.Gregors Blick richtete sich dann zum Fenster, und das trbe Wetter - man hrte Regentropfen auf das Fensterblech aufschlagen - machte ihn ganz melancholisch. Wie wre es, wenn ich noch ein wenig weiterschliefe und alle Narrheiten verge, dachte er, aber das war gnzlich undurchfhrbar, denn er war gewhnt, auf der rechten Seite zu schlafen, konnte sich aber in seinem gegenwrtigen Zustand nicht in diese Lage bringen. Mit welcher Kraft er sich auch auf die rechte Seite warf, immer wieder schaukelte er in die Rckenlage zurck. Er versuchte es wohl hundertmal, schlo die Augen, um die zappelnden Beine nicht sehen zu mssen, und lie erst ab, als er in der Seite einen noch nie gefhlten, leichten, dumpfen Schmerz zu fhlen begann.Ach Gott, dachte er, was fr einen anstrengenden Beruf habe ich gewhlt! Tag aus, Tag ein auf der Reise. Die geschftlichen Aufregungen sind viel grer, als im eigentlichen Geschft zu Hause, und auerdem ist mir noch diese Plage des Reisens auferlegt, die Sorgen um die Zuganschlsse, das unregelmige, schlechte Essen, ein immer wechselnder, nie andauernder, nie herzlich werdender menschlicher Verkehr. Der Teufel soll das alles holen! Er fhlte ein leichtes Jucken oben auf dem Bauch; schob sich auf dem Rcken langsam nher zum Bettpfosten, um den Kopf besser heben zu knnen; fand die juckende Stelle, die mit lauter kleinen weien Pnktchen besetzt war, die er nicht zu beurteilen verstand; und wollte mit einem Bein die Stelle betasten, zog es aber gleich zurck, denn bei der Berhrung umwehten ihn Klteschauer.Er glitt wieder in seine frhere Lage zurck. Dies frhzeitige Aufstehen, dachte er, macht einen ganz bldsinnig. Der Mensch mu seinen Schlaf haben. Andere Reisende leben wie Haremsfrauen. Wenn ich zum Beispiel im Laufe des Vormittags ins Gasthaus zurckgehe, um die erlangten Auftrge zu berschreiben, sitzen diese Herren erst beim Frhstck. Das sollte ich bei meinem Chef versuchen; ich wrde auf der Stelle hinausfliegen. Wer wei brigens, ob das nicht sehr gut fr mich wre. Wenn ich mich nicht wegen meiner Eltern zurckhielte, ich htte lngst gekndigt, ich wre vor den Chef hin getreten und htte ihm meine Meinung von Grund des Herzens aus gesagt. Vom Pult htte er fallen mssen! Es ist auch eine sonderbare Art, sich auf das Pult zu setzen und von der Hhe herab mit dem Angestellten zu reden, der berdies wegen der Schwerhrigkeit des Chefs ganz nahe herantreten mu. Nun, die Hoffnung ist noch nicht gnzlich aufgegeben; habe ich einmal das Geld beisammen, um die Schuld der Eltern an ihn abzuzahlen - es drfte noch fnf bis sechs Jahre dauern - , mache ich die Sache unbedingt. Dann wird der groe Schnitt gemacht. Vorlufig allerdings mu ich aufstehen, denn mein Zug fhrt um fnf.Und er sah zur Weckuhr hinber, die auf dem Kasten tickte. Himmlischer Vater!, dachte er. Es war halb sieben Uhr, und die Zeiger gingen ruhig vorwrts, es war sogar halb vorber, es nherte sich schon dreiviertel. Sollte der Wecker nicht gelutet haben? Man sah vom Bett aus, da er auf vier Uhr richtig eingestellt war; gewi hatte er auch gelutet. Ja, aber war es mglich, dieses mbelerschtternde Luten ruhig zu verschlafen? Nun, ruhig hatte er ja nicht geschlafen, aber wahrscheinlich desto fester. Was aber sollte er jetzt tun? Der nchste Zug ging um sieben Uhr; um den einzuholen, htte er sich unsinnig beeilen mssen, und die Kollektion war noch nicht eingepackt, und er selbst fhlte sich durchaus nicht besonders frisch und beweglich. Und selbst wenn er den Zug einholte, ein Donnerwetter des Chefs war nicht zu vermeiden, denn der Geschftsdiener hatte beim Fnfuhrzug gewartet und die Meldung von seiner Versumnis lngst erstattet. Es war eine Kreatur des Chefs, ohne Rckgrat und Verstand. Wie nun, wenn er sich krank meldete? Das wre aber uerst peinlich und verdchtig, denn Gregor war whrend seines fnfjhrigen Dienstes noch nicht einmal krank gewesen. Gewi wrde der Chef mit dem Krankenkassenarzt kommen, wrde den Eltern wegen des faulen Sohnes Vorwrfe machen und alle Einwnde durch den Hinweis auf den Krankenkassenarzt abschneiden, fr den es ja berhaupt nur ganz gesunde, aber arbeitsscheue Menschen gibt. Und htte er brigens in diesem Falle so ganz unrecht? Gregor fhlte sich tatschlich, abgesehen von einer nach dem langen Schlaf wirklich berflssigen Schlfrigkeit, ganz wohl und hatte sogar einen besonders krftigen Hunger.
-\ No newline at end of file
(DIR) diff --git a/3rdparties/software/flexi-streams-20190107-git/test/kafka_cp1252_crlf.txt b/3rdparties/software/flexi-streams-20190107-git/test/kafka_cp1252_crlf.txt
@@ -1,11 +0,0 @@
-Als Gregor Samsa eines Morgens aus unruhigen Trumen erwachte, fand er sich in seinem Bett zu einem ungeheueren Ungeziefer verwandelt. Er lag auf seinem panzerartig harten Rcken und sah, wenn er den Kopf ein wenig hob, seinen gewlbten, braunen, von bogenfrmigen Versteifungen geteilten Bauch, auf dessen Hhe sich die Bettdecke, zum gnzlichen Niedergleiten bereit, kaum noch erhalten konnte. Seine vielen, im Vergleich zu seinem sonstigen Umfang klglich dnnen Beine flimmerten ihm hilflos vor den Augen.
-
-Was ist mit mir geschehen?, dachte er. Es war kein Traum. Sein Zimmer, ein richtiges, nur etwas zu kleines Menschenzimmer, lag ruhig zwischen den vier wohlbekannten Wnden. ber dem Tisch, auf dem eine auseinandergepackte Musterkollektion von Tuchwaren ausgebreitet war - Samsa war Reisender - hing das Bild, das er vor kurzem aus einer illustrierten Zeitschrift ausgeschnitten und in einem hbschen, vergoldeten Rahmen untergebracht hatte. Es stellte eine Dame dar, die mit einem Pelzhut und einer Pelzboa versehen, aufrecht dasa und einen schweren Pelzmuff, in dem ihr ganzer Unterarm verschwunden war, dem Beschauer entgegenhob.
-
-Gregors Blick richtete sich dann zum Fenster, und das trbe Wetter - man hrte Regentropfen auf das Fensterblech aufschlagen - machte ihn ganz melancholisch. Wie wre es, wenn ich noch ein wenig weiterschliefe und alle Narrheiten verge, dachte er, aber das war gnzlich undurchfhrbar, denn er war gewhnt, auf der rechten Seite zu schlafen, konnte sich aber in seinem gegenwrtigen Zustand nicht in diese Lage bringen. Mit welcher Kraft er sich auch auf die rechte Seite warf, immer wieder schaukelte er in die Rckenlage zurck. Er versuchte es wohl hundertmal, schlo die Augen, um die zappelnden Beine nicht sehen zu mssen, und lie erst ab, als er in der Seite einen noch nie gefhlten, leichten, dumpfen Schmerz zu fhlen begann.
-
-Ach Gott, dachte er, was fr einen anstrengenden Beruf habe ich gewhlt! Tag aus, Tag ein auf der Reise. Die geschftlichen Aufregungen sind viel grer, als im eigentlichen Geschft zu Hause, und auerdem ist mir noch diese Plage des Reisens auferlegt, die Sorgen um die Zuganschlsse, das unregelmige, schlechte Essen, ein immer wechselnder, nie andauernder, nie herzlich werdender menschlicher Verkehr. Der Teufel soll das alles holen! Er fhlte ein leichtes Jucken oben auf dem Bauch; schob sich auf dem Rcken langsam nher zum Bettpfosten, um den Kopf besser heben zu knnen; fand die juckende Stelle, die mit lauter kleinen weien Pnktchen besetzt war, die er nicht zu beurteilen verstand; und wollte mit einem Bein die Stelle betasten, zog es aber gleich zurck, denn bei der Berhrung umwehten ihn Klteschauer.
-
-Er glitt wieder in seine frhere Lage zurck. Dies frhzeitige Aufstehen, dachte er, macht einen ganz bldsinnig. Der Mensch mu seinen Schlaf haben. Andere Reisende leben wie Haremsfrauen. Wenn ich zum Beispiel im Laufe des Vormittags ins Gasthaus zurckgehe, um die erlangten Auftrge zu berschreiben, sitzen diese Herren erst beim Frhstck. Das sollte ich bei meinem Chef versuchen; ich wrde auf der Stelle hinausfliegen. Wer wei brigens, ob das nicht sehr gut fr mich wre. Wenn ich mich nicht wegen meiner Eltern zurckhielte, ich htte lngst gekndigt, ich wre vor den Chef hin getreten und htte ihm meine Meinung von Grund des Herzens aus gesagt. Vom Pult htte er fallen mssen! Es ist auch eine sonderbare Art, sich auf das Pult zu setzen und von der Hhe herab mit dem Angestellten zu reden, der berdies wegen der Schwerhrigkeit des Chefs ganz nahe herantreten mu. Nun, die Hoffnung ist noch nicht gnzlich aufgegeben; habe ich einmal das Geld beisammen, um die Schuld der Eltern an ihn abzuzahlen - es drfte noch fnf bis sechs Jahre dauern - , mache ich die Sache unbedingt. Dann wird der groe Schnitt gemacht. Vorlufig allerdings mu ich aufstehen, denn mein Zug fhrt um fnf.
-
-Und er sah zur Weckuhr hinber, die auf dem Kasten tickte. Himmlischer Vater!, dachte er. Es war halb sieben Uhr, und die Zeiger gingen ruhig vorwrts, es war sogar halb vorber, es nherte sich schon dreiviertel. Sollte der Wecker nicht gelutet haben? Man sah vom Bett aus, da er auf vier Uhr richtig eingestellt war; gewi hatte er auch gelutet. Ja, aber war es mglich, dieses mbelerschtternde Luten ruhig zu verschlafen? Nun, ruhig hatte er ja nicht geschlafen, aber wahrscheinlich desto fester. Was aber sollte er jetzt tun? Der nchste Zug ging um sieben Uhr; um den einzuholen, htte er sich unsinnig beeilen mssen, und die Kollektion war noch nicht eingepackt, und er selbst fhlte sich durchaus nicht besonders frisch und beweglich. Und selbst wenn er den Zug einholte, ein Donnerwetter des Chefs war nicht zu vermeiden, denn der Geschftsdiener hatte beim Fnfuhrzug gewartet und die Meldung von seiner Versumnis lngst erstattet. Es war eine Kreatur des Chefs, ohne Rckgrat und Verstand. Wie nun, wenn er sich krank meldete? Das wre aber uerst peinlich und verdchtig, denn Gregor war whrend seines fnfjhrigen Dienstes noch nicht einmal krank gewesen. Gewi wrde der Chef mit dem Krankenkassenarzt kommen, wrde den Eltern wegen des faulen Sohnes Vorwrfe machen und alle Einwnde durch den Hinweis auf den Krankenkassenarzt abschneiden, fr den es ja berhaupt nur ganz gesunde, aber arbeitsscheue Menschen gibt. Und htte er brigens in diesem Falle so ganz unrecht? Gregor fhlte sich tatschlich, abgesehen von einer nach dem langen Schlaf wirklich berflssigen Schlfrigkeit, ganz wohl und hatte sogar einen besonders krftigen Hunger.
(DIR) diff --git a/3rdparties/software/flexi-streams-20190107-git/test/kafka_cp1252_lf.txt b/3rdparties/software/flexi-streams-20190107-git/test/kafka_cp1252_lf.txt
@@ -1,11 +0,0 @@
-Als Gregor Samsa eines Morgens aus unruhigen Trumen erwachte, fand er sich in seinem Bett zu einem ungeheueren Ungeziefer verwandelt. Er lag auf seinem panzerartig harten Rcken und sah, wenn er den Kopf ein wenig hob, seinen gewlbten, braunen, von bogenfrmigen Versteifungen geteilten Bauch, auf dessen Hhe sich die Bettdecke, zum gnzlichen Niedergleiten bereit, kaum noch erhalten konnte. Seine vielen, im Vergleich zu seinem sonstigen Umfang klglich dnnen Beine flimmerten ihm hilflos vor den Augen.
-
-Was ist mit mir geschehen?, dachte er. Es war kein Traum. Sein Zimmer, ein richtiges, nur etwas zu kleines Menschenzimmer, lag ruhig zwischen den vier wohlbekannten Wnden. ber dem Tisch, auf dem eine auseinandergepackte Musterkollektion von Tuchwaren ausgebreitet war - Samsa war Reisender - hing das Bild, das er vor kurzem aus einer illustrierten Zeitschrift ausgeschnitten und in einem hbschen, vergoldeten Rahmen untergebracht hatte. Es stellte eine Dame dar, die mit einem Pelzhut und einer Pelzboa versehen, aufrecht dasa und einen schweren Pelzmuff, in dem ihr ganzer Unterarm verschwunden war, dem Beschauer entgegenhob.
-
-Gregors Blick richtete sich dann zum Fenster, und das trbe Wetter - man hrte Regentropfen auf das Fensterblech aufschlagen - machte ihn ganz melancholisch. Wie wre es, wenn ich noch ein wenig weiterschliefe und alle Narrheiten verge, dachte er, aber das war gnzlich undurchfhrbar, denn er war gewhnt, auf der rechten Seite zu schlafen, konnte sich aber in seinem gegenwrtigen Zustand nicht in diese Lage bringen. Mit welcher Kraft er sich auch auf die rechte Seite warf, immer wieder schaukelte er in die Rckenlage zurck. Er versuchte es wohl hundertmal, schlo die Augen, um die zappelnden Beine nicht sehen zu mssen, und lie erst ab, als er in der Seite einen noch nie gefhlten, leichten, dumpfen Schmerz zu fhlen begann.
-
-Ach Gott, dachte er, was fr einen anstrengenden Beruf habe ich gewhlt! Tag aus, Tag ein auf der Reise. Die geschftlichen Aufregungen sind viel grer, als im eigentlichen Geschft zu Hause, und auerdem ist mir noch diese Plage des Reisens auferlegt, die Sorgen um die Zuganschlsse, das unregelmige, schlechte Essen, ein immer wechselnder, nie andauernder, nie herzlich werdender menschlicher Verkehr. Der Teufel soll das alles holen! Er fhlte ein leichtes Jucken oben auf dem Bauch; schob sich auf dem Rcken langsam nher zum Bettpfosten, um den Kopf besser heben zu knnen; fand die juckende Stelle, die mit lauter kleinen weien Pnktchen besetzt war, die er nicht zu beurteilen verstand; und wollte mit einem Bein die Stelle betasten, zog es aber gleich zurck, denn bei der Berhrung umwehten ihn Klteschauer.
-
-Er glitt wieder in seine frhere Lage zurck. Dies frhzeitige Aufstehen, dachte er, macht einen ganz bldsinnig. Der Mensch mu seinen Schlaf haben. Andere Reisende leben wie Haremsfrauen. Wenn ich zum Beispiel im Laufe des Vormittags ins Gasthaus zurckgehe, um die erlangten Auftrge zu berschreiben, sitzen diese Herren erst beim Frhstck. Das sollte ich bei meinem Chef versuchen; ich wrde auf der Stelle hinausfliegen. Wer wei brigens, ob das nicht sehr gut fr mich wre. Wenn ich mich nicht wegen meiner Eltern zurckhielte, ich htte lngst gekndigt, ich wre vor den Chef hin getreten und htte ihm meine Meinung von Grund des Herzens aus gesagt. Vom Pult htte er fallen mssen! Es ist auch eine sonderbare Art, sich auf das Pult zu setzen und von der Hhe herab mit dem Angestellten zu reden, der berdies wegen der Schwerhrigkeit des Chefs ganz nahe herantreten mu. Nun, die Hoffnung ist noch nicht gnzlich aufgegeben; habe ich einmal das Geld beisammen, um die Schuld der Eltern an ihn abzuzahlen - es drfte noch fnf bis sechs Jahre dauern - , mache ich die Sache unbedingt. Dann wird der groe Schnitt gemacht. Vorlufig allerdings mu ich aufstehen, denn mein Zug fhrt um fnf.
-
-Und er sah zur Weckuhr hinber, die auf dem Kasten tickte. Himmlischer Vater!, dachte er. Es war halb sieben Uhr, und die Zeiger gingen ruhig vorwrts, es war sogar halb vorber, es nherte sich schon dreiviertel. Sollte der Wecker nicht gelutet haben? Man sah vom Bett aus, da er auf vier Uhr richtig eingestellt war; gewi hatte er auch gelutet. Ja, aber war es mglich, dieses mbelerschtternde Luten ruhig zu verschlafen? Nun, ruhig hatte er ja nicht geschlafen, aber wahrscheinlich desto fester. Was aber sollte er jetzt tun? Der nchste Zug ging um sieben Uhr; um den einzuholen, htte er sich unsinnig beeilen mssen, und die Kollektion war noch nicht eingepackt, und er selbst fhlte sich durchaus nicht besonders frisch und beweglich. Und selbst wenn er den Zug einholte, ein Donnerwetter des Chefs war nicht zu vermeiden, denn der Geschftsdiener hatte beim Fnfuhrzug gewartet und die Meldung von seiner Versumnis lngst erstattet. Es war eine Kreatur des Chefs, ohne Rckgrat und Verstand. Wie nun, wenn er sich krank meldete? Das wre aber uerst peinlich und verdchtig, denn Gregor war whrend seines fnfjhrigen Dienstes noch nicht einmal krank gewesen. Gewi wrde der Chef mit dem Krankenkassenarzt kommen, wrde den Eltern wegen des faulen Sohnes Vorwrfe machen und alle Einwnde durch den Hinweis auf den Krankenkassenarzt abschneiden, fr den es ja berhaupt nur ganz gesunde, aber arbeitsscheue Menschen gibt. Und htte er brigens in diesem Falle so ganz unrecht? Gregor fhlte sich tatschlich, abgesehen von einer nach dem langen Schlaf wirklich berflssigen Schlfrigkeit, ganz wohl und hatte sogar einen besonders krftigen Hunger.
(DIR) diff --git a/3rdparties/software/flexi-streams-20190107-git/test/kafka_latin1_cr.txt b/3rdparties/software/flexi-streams-20190107-git/test/kafka_latin1_cr.txt
@@ -1 +0,0 @@
-Als Gregor Samsa eines Morgens aus unruhigen Trumen erwachte, fand er sich in seinem Bett zu einem ungeheueren Ungeziefer verwandelt. Er lag auf seinem panzerartig harten Rcken und sah, wenn er den Kopf ein wenig hob, seinen gewlbten, braunen, von bogenfrmigen Versteifungen geteilten Bauch, auf dessen Hhe sich die Bettdecke, zum gnzlichen Niedergleiten bereit, kaum noch erhalten konnte. Seine vielen, im Vergleich zu seinem sonstigen Umfang klglich dnnen Beine flimmerten ihm hilflos vor den Augen.Was ist mit mir geschehen?, dachte er. Es war kein Traum. Sein Zimmer, ein richtiges, nur etwas zu kleines Menschenzimmer, lag ruhig zwischen den vier wohlbekannten Wnden. ber dem Tisch, auf dem eine auseinandergepackte Musterkollektion von Tuchwaren ausgebreitet war - Samsa war Reisender - hing das Bild, das er vor kurzem aus einer illustrierten Zeitschrift ausgeschnitten und in einem hbschen, vergoldeten Rahmen untergebracht hatte. Es stellte eine Dame dar, die mit einem Pelzhut und einer Pelzboa versehen, aufrecht dasa und einen schweren Pelzmuff, in dem ihr ganzer Unterarm verschwunden war, dem Beschauer entgegenhob.Gregors Blick richtete sich dann zum Fenster, und das trbe Wetter - man hrte Regentropfen auf das Fensterblech aufschlagen - machte ihn ganz melancholisch. Wie wre es, wenn ich noch ein wenig weiterschliefe und alle Narrheiten verge, dachte er, aber das war gnzlich undurchfhrbar, denn er war gewhnt, auf der rechten Seite zu schlafen, konnte sich aber in seinem gegenwrtigen Zustand nicht in diese Lage bringen. Mit welcher Kraft er sich auch auf die rechte Seite warf, immer wieder schaukelte er in die Rckenlage zurck. Er versuchte es wohl hundertmal, schlo die Augen, um die zappelnden Beine nicht sehen zu mssen, und lie erst ab, als er in der Seite einen noch nie gefhlten, leichten, dumpfen Schmerz zu fhlen begann.Ach Gott, dachte er, was fr einen anstrengenden Beruf habe ich gewhlt! Tag aus, Tag ein auf der Reise. Die geschftlichen Aufregungen sind viel grer, als im eigentlichen Geschft zu Hause, und auerdem ist mir noch diese Plage des Reisens auferlegt, die Sorgen um die Zuganschlsse, das unregelmige, schlechte Essen, ein immer wechselnder, nie andauernder, nie herzlich werdender menschlicher Verkehr. Der Teufel soll das alles holen! Er fhlte ein leichtes Jucken oben auf dem Bauch; schob sich auf dem Rcken langsam nher zum Bettpfosten, um den Kopf besser heben zu knnen; fand die juckende Stelle, die mit lauter kleinen weien Pnktchen besetzt war, die er nicht zu beurteilen verstand; und wollte mit einem Bein die Stelle betasten, zog es aber gleich zurck, denn bei der Berhrung umwehten ihn Klteschauer.Er glitt wieder in seine frhere Lage zurck. Dies frhzeitige Aufstehen, dachte er, macht einen ganz bldsinnig. Der Mensch mu seinen Schlaf haben. Andere Reisende leben wie Haremsfrauen. Wenn ich zum Beispiel im Laufe des Vormittags ins Gasthaus zurckgehe, um die erlangten Auftrge zu berschreiben, sitzen diese Herren erst beim Frhstck. Das sollte ich bei meinem Chef versuchen; ich wrde auf der Stelle hinausfliegen. Wer wei brigens, ob das nicht sehr gut fr mich wre. Wenn ich mich nicht wegen meiner Eltern zurckhielte, ich htte lngst gekndigt, ich wre vor den Chef hin getreten und htte ihm meine Meinung von Grund des Herzens aus gesagt. Vom Pult htte er fallen mssen! Es ist auch eine sonderbare Art, sich auf das Pult zu setzen und von der Hhe herab mit dem Angestellten zu reden, der berdies wegen der Schwerhrigkeit des Chefs ganz nahe herantreten mu. Nun, die Hoffnung ist noch nicht gnzlich aufgegeben; habe ich einmal das Geld beisammen, um die Schuld der Eltern an ihn abzuzahlen - es drfte noch fnf bis sechs Jahre dauern - , mache ich die Sache unbedingt. Dann wird der groe Schnitt gemacht. Vorlufig allerdings mu ich aufstehen, denn mein Zug fhrt um fnf.Und er sah zur Weckuhr hinber, die auf dem Kasten tickte. Himmlischer Vater!, dachte er. Es war halb sieben Uhr, und die Zeiger gingen ruhig vorwrts, es war sogar halb vorber, es nherte sich schon dreiviertel. Sollte der Wecker nicht gelutet haben? Man sah vom Bett aus, da er auf vier Uhr richtig eingestellt war; gewi hatte er auch gelutet. Ja, aber war es mglich, dieses mbelerschtternde Luten ruhig zu verschlafen? Nun, ruhig hatte er ja nicht geschlafen, aber wahrscheinlich desto fester. Was aber sollte er jetzt tun? Der nchste Zug ging um sieben Uhr; um den einzuholen, htte er sich unsinnig beeilen mssen, und die Kollektion war noch nicht eingepackt, und er selbst fhlte sich durchaus nicht besonders frisch und beweglich. Und selbst wenn er den Zug einholte, ein Donnerwetter des Chefs war nicht zu vermeiden, denn der Geschftsdiener hatte beim Fnfuhrzug gewartet und die Meldung von seiner Versumnis lngst erstattet. Es war eine Kreatur des Chefs, ohne Rckgrat und Verstand. Wie nun, wenn er sich krank meldete? Das wre aber uerst peinlich und verdchtig, denn Gregor war whrend seines fnfjhrigen Dienstes noch nicht einmal krank gewesen. Gewi wrde der Chef mit dem Krankenkassenarzt kommen, wrde den Eltern wegen des faulen Sohnes Vorwrfe machen und alle Einwnde durch den Hinweis auf den Krankenkassenarzt abschneiden, fr den es ja berhaupt nur ganz gesunde, aber arbeitsscheue Menschen gibt. Und htte er brigens in diesem Falle so ganz unrecht? Gregor fhlte sich tatschlich, abgesehen von einer nach dem langen Schlaf wirklich berflssigen Schlfrigkeit, ganz wohl und hatte sogar einen besonders krftigen Hunger.
-\ No newline at end of file
(DIR) diff --git a/3rdparties/software/flexi-streams-20190107-git/test/kafka_latin1_crlf.txt b/3rdparties/software/flexi-streams-20190107-git/test/kafka_latin1_crlf.txt
@@ -1,11 +0,0 @@
-Als Gregor Samsa eines Morgens aus unruhigen Trumen erwachte, fand er sich in seinem Bett zu einem ungeheueren Ungeziefer verwandelt. Er lag auf seinem panzerartig harten Rcken und sah, wenn er den Kopf ein wenig hob, seinen gewlbten, braunen, von bogenfrmigen Versteifungen geteilten Bauch, auf dessen Hhe sich die Bettdecke, zum gnzlichen Niedergleiten bereit, kaum noch erhalten konnte. Seine vielen, im Vergleich zu seinem sonstigen Umfang klglich dnnen Beine flimmerten ihm hilflos vor den Augen.
-
-Was ist mit mir geschehen?, dachte er. Es war kein Traum. Sein Zimmer, ein richtiges, nur etwas zu kleines Menschenzimmer, lag ruhig zwischen den vier wohlbekannten Wnden. ber dem Tisch, auf dem eine auseinandergepackte Musterkollektion von Tuchwaren ausgebreitet war - Samsa war Reisender - hing das Bild, das er vor kurzem aus einer illustrierten Zeitschrift ausgeschnitten und in einem hbschen, vergoldeten Rahmen untergebracht hatte. Es stellte eine Dame dar, die mit einem Pelzhut und einer Pelzboa versehen, aufrecht dasa und einen schweren Pelzmuff, in dem ihr ganzer Unterarm verschwunden war, dem Beschauer entgegenhob.
-
-Gregors Blick richtete sich dann zum Fenster, und das trbe Wetter - man hrte Regentropfen auf das Fensterblech aufschlagen - machte ihn ganz melancholisch. Wie wre es, wenn ich noch ein wenig weiterschliefe und alle Narrheiten verge, dachte er, aber das war gnzlich undurchfhrbar, denn er war gewhnt, auf der rechten Seite zu schlafen, konnte sich aber in seinem gegenwrtigen Zustand nicht in diese Lage bringen. Mit welcher Kraft er sich auch auf die rechte Seite warf, immer wieder schaukelte er in die Rckenlage zurck. Er versuchte es wohl hundertmal, schlo die Augen, um die zappelnden Beine nicht sehen zu mssen, und lie erst ab, als er in der Seite einen noch nie gefhlten, leichten, dumpfen Schmerz zu fhlen begann.
-
-Ach Gott, dachte er, was fr einen anstrengenden Beruf habe ich gewhlt! Tag aus, Tag ein auf der Reise. Die geschftlichen Aufregungen sind viel grer, als im eigentlichen Geschft zu Hause, und auerdem ist mir noch diese Plage des Reisens auferlegt, die Sorgen um die Zuganschlsse, das unregelmige, schlechte Essen, ein immer wechselnder, nie andauernder, nie herzlich werdender menschlicher Verkehr. Der Teufel soll das alles holen! Er fhlte ein leichtes Jucken oben auf dem Bauch; schob sich auf dem Rcken langsam nher zum Bettpfosten, um den Kopf besser heben zu knnen; fand die juckende Stelle, die mit lauter kleinen weien Pnktchen besetzt war, die er nicht zu beurteilen verstand; und wollte mit einem Bein die Stelle betasten, zog es aber gleich zurck, denn bei der Berhrung umwehten ihn Klteschauer.
-
-Er glitt wieder in seine frhere Lage zurck. Dies frhzeitige Aufstehen, dachte er, macht einen ganz bldsinnig. Der Mensch mu seinen Schlaf haben. Andere Reisende leben wie Haremsfrauen. Wenn ich zum Beispiel im Laufe des Vormittags ins Gasthaus zurckgehe, um die erlangten Auftrge zu berschreiben, sitzen diese Herren erst beim Frhstck. Das sollte ich bei meinem Chef versuchen; ich wrde auf der Stelle hinausfliegen. Wer wei brigens, ob das nicht sehr gut fr mich wre. Wenn ich mich nicht wegen meiner Eltern zurckhielte, ich htte lngst gekndigt, ich wre vor den Chef hin getreten und htte ihm meine Meinung von Grund des Herzens aus gesagt. Vom Pult htte er fallen mssen! Es ist auch eine sonderbare Art, sich auf das Pult zu setzen und von der Hhe herab mit dem Angestellten zu reden, der berdies wegen der Schwerhrigkeit des Chefs ganz nahe herantreten mu. Nun, die Hoffnung ist noch nicht gnzlich aufgegeben; habe ich einmal das Geld beisammen, um die Schuld der Eltern an ihn abzuzahlen - es drfte noch fnf bis sechs Jahre dauern - , mache ich die Sache unbedingt. Dann wird der groe Schnitt gemacht. Vorlufig allerdings mu ich aufstehen, denn mein Zug fhrt um fnf.
-
-Und er sah zur Weckuhr hinber, die auf dem Kasten tickte. Himmlischer Vater!, dachte er. Es war halb sieben Uhr, und die Zeiger gingen ruhig vorwrts, es war sogar halb vorber, es nherte sich schon dreiviertel. Sollte der Wecker nicht gelutet haben? Man sah vom Bett aus, da er auf vier Uhr richtig eingestellt war; gewi hatte er auch gelutet. Ja, aber war es mglich, dieses mbelerschtternde Luten ruhig zu verschlafen? Nun, ruhig hatte er ja nicht geschlafen, aber wahrscheinlich desto fester. Was aber sollte er jetzt tun? Der nchste Zug ging um sieben Uhr; um den einzuholen, htte er sich unsinnig beeilen mssen, und die Kollektion war noch nicht eingepackt, und er selbst fhlte sich durchaus nicht besonders frisch und beweglich. Und selbst wenn er den Zug einholte, ein Donnerwetter des Chefs war nicht zu vermeiden, denn der Geschftsdiener hatte beim Fnfuhrzug gewartet und die Meldung von seiner Versumnis lngst erstattet. Es war eine Kreatur des Chefs, ohne Rckgrat und Verstand. Wie nun, wenn er sich krank meldete? Das wre aber uerst peinlich und verdchtig, denn Gregor war whrend seines fnfjhrigen Dienstes noch nicht einmal krank gewesen. Gewi wrde der Chef mit dem Krankenkassenarzt kommen, wrde den Eltern wegen des faulen Sohnes Vorwrfe machen und alle Einwnde durch den Hinweis auf den Krankenkassenarzt abschneiden, fr den es ja berhaupt nur ganz gesunde, aber arbeitsscheue Menschen gibt. Und htte er brigens in diesem Falle so ganz unrecht? Gregor fhlte sich tatschlich, abgesehen von einer nach dem langen Schlaf wirklich berflssigen Schlfrigkeit, ganz wohl und hatte sogar einen besonders krftigen Hunger.
(DIR) diff --git a/3rdparties/software/flexi-streams-20190107-git/test/kafka_latin1_lf.txt b/3rdparties/software/flexi-streams-20190107-git/test/kafka_latin1_lf.txt
@@ -1,11 +0,0 @@
-Als Gregor Samsa eines Morgens aus unruhigen Trumen erwachte, fand er sich in seinem Bett zu einem ungeheueren Ungeziefer verwandelt. Er lag auf seinem panzerartig harten Rcken und sah, wenn er den Kopf ein wenig hob, seinen gewlbten, braunen, von bogenfrmigen Versteifungen geteilten Bauch, auf dessen Hhe sich die Bettdecke, zum gnzlichen Niedergleiten bereit, kaum noch erhalten konnte. Seine vielen, im Vergleich zu seinem sonstigen Umfang klglich dnnen Beine flimmerten ihm hilflos vor den Augen.
-
-Was ist mit mir geschehen?, dachte er. Es war kein Traum. Sein Zimmer, ein richtiges, nur etwas zu kleines Menschenzimmer, lag ruhig zwischen den vier wohlbekannten Wnden. ber dem Tisch, auf dem eine auseinandergepackte Musterkollektion von Tuchwaren ausgebreitet war - Samsa war Reisender - hing das Bild, das er vor kurzem aus einer illustrierten Zeitschrift ausgeschnitten und in einem hbschen, vergoldeten Rahmen untergebracht hatte. Es stellte eine Dame dar, die mit einem Pelzhut und einer Pelzboa versehen, aufrecht dasa und einen schweren Pelzmuff, in dem ihr ganzer Unterarm verschwunden war, dem Beschauer entgegenhob.
-
-Gregors Blick richtete sich dann zum Fenster, und das trbe Wetter - man hrte Regentropfen auf das Fensterblech aufschlagen - machte ihn ganz melancholisch. Wie wre es, wenn ich noch ein wenig weiterschliefe und alle Narrheiten verge, dachte er, aber das war gnzlich undurchfhrbar, denn er war gewhnt, auf der rechten Seite zu schlafen, konnte sich aber in seinem gegenwrtigen Zustand nicht in diese Lage bringen. Mit welcher Kraft er sich auch auf die rechte Seite warf, immer wieder schaukelte er in die Rckenlage zurck. Er versuchte es wohl hundertmal, schlo die Augen, um die zappelnden Beine nicht sehen zu mssen, und lie erst ab, als er in der Seite einen noch nie gefhlten, leichten, dumpfen Schmerz zu fhlen begann.
-
-Ach Gott, dachte er, was fr einen anstrengenden Beruf habe ich gewhlt! Tag aus, Tag ein auf der Reise. Die geschftlichen Aufregungen sind viel grer, als im eigentlichen Geschft zu Hause, und auerdem ist mir noch diese Plage des Reisens auferlegt, die Sorgen um die Zuganschlsse, das unregelmige, schlechte Essen, ein immer wechselnder, nie andauernder, nie herzlich werdender menschlicher Verkehr. Der Teufel soll das alles holen! Er fhlte ein leichtes Jucken oben auf dem Bauch; schob sich auf dem Rcken langsam nher zum Bettpfosten, um den Kopf besser heben zu knnen; fand die juckende Stelle, die mit lauter kleinen weien Pnktchen besetzt war, die er nicht zu beurteilen verstand; und wollte mit einem Bein die Stelle betasten, zog es aber gleich zurck, denn bei der Berhrung umwehten ihn Klteschauer.
-
-Er glitt wieder in seine frhere Lage zurck. Dies frhzeitige Aufstehen, dachte er, macht einen ganz bldsinnig. Der Mensch mu seinen Schlaf haben. Andere Reisende leben wie Haremsfrauen. Wenn ich zum Beispiel im Laufe des Vormittags ins Gasthaus zurckgehe, um die erlangten Auftrge zu berschreiben, sitzen diese Herren erst beim Frhstck. Das sollte ich bei meinem Chef versuchen; ich wrde auf der Stelle hinausfliegen. Wer wei brigens, ob das nicht sehr gut fr mich wre. Wenn ich mich nicht wegen meiner Eltern zurckhielte, ich htte lngst gekndigt, ich wre vor den Chef hin getreten und htte ihm meine Meinung von Grund des Herzens aus gesagt. Vom Pult htte er fallen mssen! Es ist auch eine sonderbare Art, sich auf das Pult zu setzen und von der Hhe herab mit dem Angestellten zu reden, der berdies wegen der Schwerhrigkeit des Chefs ganz nahe herantreten mu. Nun, die Hoffnung ist noch nicht gnzlich aufgegeben; habe ich einmal das Geld beisammen, um die Schuld der Eltern an ihn abzuzahlen - es drfte noch fnf bis sechs Jahre dauern - , mache ich die Sache unbedingt. Dann wird der groe Schnitt gemacht. Vorlufig allerdings mu ich aufstehen, denn mein Zug fhrt um fnf.
-
-Und er sah zur Weckuhr hinber, die auf dem Kasten tickte. Himmlischer Vater!, dachte er. Es war halb sieben Uhr, und die Zeiger gingen ruhig vorwrts, es war sogar halb vorber, es nherte sich schon dreiviertel. Sollte der Wecker nicht gelutet haben? Man sah vom Bett aus, da er auf vier Uhr richtig eingestellt war; gewi hatte er auch gelutet. Ja, aber war es mglich, dieses mbelerschtternde Luten ruhig zu verschlafen? Nun, ruhig hatte er ja nicht geschlafen, aber wahrscheinlich desto fester. Was aber sollte er jetzt tun? Der nchste Zug ging um sieben Uhr; um den einzuholen, htte er sich unsinnig beeilen mssen, und die Kollektion war noch nicht eingepackt, und er selbst fhlte sich durchaus nicht besonders frisch und beweglich. Und selbst wenn er den Zug einholte, ein Donnerwetter des Chefs war nicht zu vermeiden, denn der Geschftsdiener hatte beim Fnfuhrzug gewartet und die Meldung von seiner Versumnis lngst erstattet. Es war eine Kreatur des Chefs, ohne Rckgrat und Verstand. Wie nun, wenn er sich krank meldete? Das wre aber uerst peinlich und verdchtig, denn Gregor war whrend seines fnfjhrigen Dienstes noch nicht einmal krank gewesen. Gewi wrde der Chef mit dem Krankenkassenarzt kommen, wrde den Eltern wegen des faulen Sohnes Vorwrfe machen und alle Einwnde durch den Hinweis auf den Krankenkassenarzt abschneiden, fr den es ja berhaupt nur ganz gesunde, aber arbeitsscheue Menschen gibt. Und htte er brigens in diesem Falle so ganz unrecht? Gregor fhlte sich tatschlich, abgesehen von einer nach dem langen Schlaf wirklich berflssigen Schlfrigkeit, ganz wohl und hatte sogar einen besonders krftigen Hunger.
(DIR) diff --git a/3rdparties/software/flexi-streams-20190107-git/test/kafka_utf8_cr.txt b/3rdparties/software/flexi-streams-20190107-git/test/kafka_utf8_cr.txt
@@ -1 +0,0 @@
-Als Gregor Samsa eines Morgens aus unruhigen Träumen erwachte, fand er sich in seinem Bett zu einem ungeheueren Ungeziefer verwandelt. Er lag auf seinem panzerartig harten Rücken und sah, wenn er den Kopf ein wenig hob, seinen gewölbten, braunen, von bogenförmigen Versteifungen geteilten Bauch, auf dessen Höhe sich die Bettdecke, zum gänzlichen Niedergleiten bereit, kaum noch erhalten konnte. Seine vielen, im Vergleich zu seinem sonstigen Umfang kläglich dünnen Beine flimmerten ihm hilflos vor den Augen.»Was ist mit mir geschehen?«, dachte er. Es war kein Traum. Sein Zimmer, ein richtiges, nur etwas zu kleines Menschenzimmer, lag ruhig zwischen den vier wohlbekannten Wänden. Über dem Tisch, auf dem eine auseinandergepackte Musterkollektion von Tuchwaren ausgebreitet war - Samsa war Reisender - hing das Bild, das er vor kurzem aus einer illustrierten Zeitschrift ausgeschnitten und in einem hübschen, vergoldeten Rahmen untergebracht hatte. Es stellte eine Dame dar, die mit einem Pelzhut und einer Pelzboa versehen, aufrecht dasaß und einen schweren Pelzmuff, in dem ihr ganzer Unterarm verschwunden war, dem Beschauer entgegenhob.Gregors Blick richtete sich dann zum Fenster, und das trübe Wetter - man hörte Regentropfen auf das Fensterblech aufschlagen - machte ihn ganz melancholisch. »Wie wäre es, wenn ich noch ein wenig weiterschliefe und alle Narrheiten vergäße«, dachte er, aber das war gänzlich undurchführbar, denn er war gewöhnt, auf der rechten Seite zu schlafen, konnte sich aber in seinem gegenwärtigen Zustand nicht in diese Lage bringen. Mit welcher Kraft er sich auch auf die rechte Seite warf, immer wieder schaukelte er in die Rückenlage zurück. Er versuchte es wohl hundertmal, schloß die Augen, um die zappelnden Beine nicht sehen zu müssen, und ließ erst ab, als er in der Seite einen noch nie gefühlten, leichten, dumpfen Schmerz zu fühlen begann.»Ach Gott«, dachte er, »was für einen anstrengenden Beruf habe ich gewählt! Tag aus, Tag ein auf der Reise. Die geschäftlichen Aufregungen sind viel größer, als im eigentlichen Geschäft zu Hause, und außerdem ist mir noch diese Plage des Reisens auferlegt, die Sorgen um die Zuganschlüsse, das unregelmäßige, schlechte Essen, ein immer wechselnder, nie andauernder, nie herzlich werdender menschlicher Verkehr. Der Teufel soll das alles holen!« Er fühlte ein leichtes Jucken oben auf dem Bauch; schob sich auf dem Rücken langsam näher zum Bettpfosten, um den Kopf besser heben zu können; fand die juckende Stelle, die mit lauter kleinen weißen Pünktchen besetzt war, die er nicht zu beurteilen verstand; und wollte mit einem Bein die Stelle betasten, zog es aber gleich zurück, denn bei der Berührung umwehten ihn Kälteschauer.Er glitt wieder in seine frühere Lage zurück. »Dies frühzeitige Aufstehen«, dachte er, »macht einen ganz blödsinnig. Der Mensch muß seinen Schlaf haben. Andere Reisende leben wie Haremsfrauen. Wenn ich zum Beispiel im Laufe des Vormittags ins Gasthaus zurückgehe, um die erlangten Aufträge zu überschreiben, sitzen diese Herren erst beim Frühstück. Das sollte ich bei meinem Chef versuchen; ich würde auf der Stelle hinausfliegen. Wer weiß übrigens, ob das nicht sehr gut für mich wäre. Wenn ich mich nicht wegen meiner Eltern zurückhielte, ich hätte längst gekündigt, ich wäre vor den Chef hin getreten und hätte ihm meine Meinung von Grund des Herzens aus gesagt. Vom Pult hätte er fallen müssen! Es ist auch eine sonderbare Art, sich auf das Pult zu setzen und von der Höhe herab mit dem Angestellten zu reden, der überdies wegen der Schwerhörigkeit des Chefs ganz nahe herantreten muß. Nun, die Hoffnung ist noch nicht gänzlich aufgegeben; habe ich einmal das Geld beisammen, um die Schuld der Eltern an ihn abzuzahlen - es dürfte noch fünf bis sechs Jahre dauern - , mache ich die Sache unbedingt. Dann wird der große Schnitt gemacht. Vorläufig allerdings muß ich aufstehen, denn mein Zug fährt um fünf.«Und er sah zur Weckuhr hinüber, die auf dem Kasten tickte. »Himmlischer Vater!«, dachte er. Es war halb sieben Uhr, und die Zeiger gingen ruhig vorwärts, es war sogar halb vorüber, es näherte sich schon dreiviertel. Sollte der Wecker nicht geläutet haben? Man sah vom Bett aus, daß er auf vier Uhr richtig eingestellt war; gewiß hatte er auch geläutet. Ja, aber war es möglich, dieses möbelerschütternde Läuten ruhig zu verschlafen? Nun, ruhig hatte er ja nicht geschlafen, aber wahrscheinlich desto fester. Was aber sollte er jetzt tun? Der nächste Zug ging um sieben Uhr; um den einzuholen, hätte er sich unsinnig beeilen müssen, und die Kollektion war noch nicht eingepackt, und er selbst fühlte sich durchaus nicht besonders frisch und beweglich. Und selbst wenn er den Zug einholte, ein Donnerwetter des Chefs war nicht zu vermeiden, denn der Geschäftsdiener hatte beim Fünfuhrzug gewartet und die Meldung von seiner Versäumnis längst erstattet. Es war eine Kreatur des Chefs, ohne Rückgrat und Verstand. Wie nun, wenn er sich krank meldete? Das wäre aber äußerst peinlich und verdächtig, denn Gregor war während seines fünfjährigen Dienstes noch nicht einmal krank gewesen. Gewiß würde der Chef mit dem Krankenkassenarzt kommen, würde den Eltern wegen des faulen Sohnes Vorwürfe machen und alle Einwände durch den Hinweis auf den Krankenkassenarzt abschneiden, für den es ja überhaupt nur ganz gesunde, aber arbeitsscheue Menschen gibt. Und hätte er übrigens in diesem Falle so ganz unrecht? Gregor fühlte sich tatsächlich, abgesehen von einer nach dem langen Schlaf wirklich überflüssigen Schläfrigkeit, ganz wohl und hatte sogar einen besonders kräftigen Hunger.
-\ No newline at end of file
(DIR) diff --git a/3rdparties/software/flexi-streams-20190107-git/test/kafka_utf8_crlf.txt b/3rdparties/software/flexi-streams-20190107-git/test/kafka_utf8_crlf.txt
@@ -1,11 +0,0 @@
-Als Gregor Samsa eines Morgens aus unruhigen Träumen erwachte, fand er sich in seinem Bett zu einem ungeheueren Ungeziefer verwandelt. Er lag auf seinem panzerartig harten Rücken und sah, wenn er den Kopf ein wenig hob, seinen gewölbten, braunen, von bogenförmigen Versteifungen geteilten Bauch, auf dessen Höhe sich die Bettdecke, zum gänzlichen Niedergleiten bereit, kaum noch erhalten konnte. Seine vielen, im Vergleich zu seinem sonstigen Umfang kläglich dünnen Beine flimmerten ihm hilflos vor den Augen.
-
-»Was ist mit mir geschehen?«, dachte er. Es war kein Traum. Sein Zimmer, ein richtiges, nur etwas zu kleines Menschenzimmer, lag ruhig zwischen den vier wohlbekannten Wänden. Über dem Tisch, auf dem eine auseinandergepackte Musterkollektion von Tuchwaren ausgebreitet war - Samsa war Reisender - hing das Bild, das er vor kurzem aus einer illustrierten Zeitschrift ausgeschnitten und in einem hübschen, vergoldeten Rahmen untergebracht hatte. Es stellte eine Dame dar, die mit einem Pelzhut und einer Pelzboa versehen, aufrecht dasaß und einen schweren Pelzmuff, in dem ihr ganzer Unterarm verschwunden war, dem Beschauer entgegenhob.
-
-Gregors Blick richtete sich dann zum Fenster, und das trübe Wetter - man hörte Regentropfen auf das Fensterblech aufschlagen - machte ihn ganz melancholisch. »Wie wäre es, wenn ich noch ein wenig weiterschliefe und alle Narrheiten vergäße«, dachte er, aber das war gänzlich undurchführbar, denn er war gewöhnt, auf der rechten Seite zu schlafen, konnte sich aber in seinem gegenwärtigen Zustand nicht in diese Lage bringen. Mit welcher Kraft er sich auch auf die rechte Seite warf, immer wieder schaukelte er in die Rückenlage zurück. Er versuchte es wohl hundertmal, schloß die Augen, um die zappelnden Beine nicht sehen zu müssen, und ließ erst ab, als er in der Seite einen noch nie gefühlten, leichten, dumpfen Schmerz zu fühlen begann.
-
-»Ach Gott«, dachte er, »was für einen anstrengenden Beruf habe ich gewählt! Tag aus, Tag ein auf der Reise. Die geschäftlichen Aufregungen sind viel größer, als im eigentlichen Geschäft zu Hause, und außerdem ist mir noch diese Plage des Reisens auferlegt, die Sorgen um die Zuganschlüsse, das unregelmäßige, schlechte Essen, ein immer wechselnder, nie andauernder, nie herzlich werdender menschlicher Verkehr. Der Teufel soll das alles holen!« Er fühlte ein leichtes Jucken oben auf dem Bauch; schob sich auf dem Rücken langsam näher zum Bettpfosten, um den Kopf besser heben zu können; fand die juckende Stelle, die mit lauter kleinen weißen Pünktchen besetzt war, die er nicht zu beurteilen verstand; und wollte mit einem Bein die Stelle betasten, zog es aber gleich zurück, denn bei der Berührung umwehten ihn Kälteschauer.
-
-Er glitt wieder in seine frühere Lage zurück. »Dies frühzeitige Aufstehen«, dachte er, »macht einen ganz blödsinnig. Der Mensch muß seinen Schlaf haben. Andere Reisende leben wie Haremsfrauen. Wenn ich zum Beispiel im Laufe des Vormittags ins Gasthaus zurückgehe, um die erlangten Aufträge zu überschreiben, sitzen diese Herren erst beim Frühstück. Das sollte ich bei meinem Chef versuchen; ich würde auf der Stelle hinausfliegen. Wer weiß übrigens, ob das nicht sehr gut für mich wäre. Wenn ich mich nicht wegen meiner Eltern zurückhielte, ich hätte längst gekündigt, ich wäre vor den Chef hin getreten und hätte ihm meine Meinung von Grund des Herzens aus gesagt. Vom Pult hätte er fallen müssen! Es ist auch eine sonderbare Art, sich auf das Pult zu setzen und von der Höhe herab mit dem Angestellten zu reden, der überdies wegen der Schwerhörigkeit des Chefs ganz nahe herantreten muß. Nun, die Hoffnung ist noch nicht gänzlich aufgegeben; habe ich einmal das Geld beisammen, um die Schuld der Eltern an ihn abzuzahlen - es dürfte noch fünf bis sechs Jahre dauern - , mache ich die Sache unbedingt. Dann wird der große Schnitt gemacht. Vorläufig allerdings muß ich aufstehen, denn mein Zug fährt um fünf.«
-
-Und er sah zur Weckuhr hinüber, die auf dem Kasten tickte. »Himmlischer Vater!«, dachte er. Es war halb sieben Uhr, und die Zeiger gingen ruhig vorwärts, es war sogar halb vorüber, es näherte sich schon dreiviertel. Sollte der Wecker nicht geläutet haben? Man sah vom Bett aus, daß er auf vier Uhr richtig eingestellt war; gewiß hatte er auch geläutet. Ja, aber war es möglich, dieses möbelerschütternde Läuten ruhig zu verschlafen? Nun, ruhig hatte er ja nicht geschlafen, aber wahrscheinlich desto fester. Was aber sollte er jetzt tun? Der nächste Zug ging um sieben Uhr; um den einzuholen, hätte er sich unsinnig beeilen müssen, und die Kollektion war noch nicht eingepackt, und er selbst fühlte sich durchaus nicht besonders frisch und beweglich. Und selbst wenn er den Zug einholte, ein Donnerwetter des Chefs war nicht zu vermeiden, denn der Geschäftsdiener hatte beim Fünfuhrzug gewartet und die Meldung von seiner Versäumnis längst erstattet. Es war eine Kreatur des Chefs, ohne Rückgrat und Verstand. Wie nun, wenn er sich krank meldete? Das wäre aber äußerst peinlich und verdächtig, denn Gregor war während seines fünfjährigen Dienstes noch nicht einmal krank gewesen. Gewiß würde der Chef mit dem Krankenkassenarzt kommen, würde den Eltern wegen des faulen Sohnes Vorwürfe machen und alle Einwände durch den Hinweis auf den Krankenkassenarzt abschneiden, für den es ja überhaupt nur ganz gesunde, aber arbeitsscheue Menschen gibt. Und hätte er übrigens in diesem Falle so ganz unrecht? Gregor fühlte sich tatsächlich, abgesehen von einer nach dem langen Schlaf wirklich überflüssigen Schläfrigkeit, ganz wohl und hatte sogar einen besonders kräftigen Hunger.
(DIR) diff --git a/3rdparties/software/flexi-streams-20190107-git/test/kafka_utf8_lf.txt b/3rdparties/software/flexi-streams-20190107-git/test/kafka_utf8_lf.txt
@@ -1,11 +0,0 @@
-Als Gregor Samsa eines Morgens aus unruhigen Träumen erwachte, fand er sich in seinem Bett zu einem ungeheueren Ungeziefer verwandelt. Er lag auf seinem panzerartig harten Rücken und sah, wenn er den Kopf ein wenig hob, seinen gewölbten, braunen, von bogenförmigen Versteifungen geteilten Bauch, auf dessen Höhe sich die Bettdecke, zum gänzlichen Niedergleiten bereit, kaum noch erhalten konnte. Seine vielen, im Vergleich zu seinem sonstigen Umfang kläglich dünnen Beine flimmerten ihm hilflos vor den Augen.
-
-»Was ist mit mir geschehen?«, dachte er. Es war kein Traum. Sein Zimmer, ein richtiges, nur etwas zu kleines Menschenzimmer, lag ruhig zwischen den vier wohlbekannten Wänden. Über dem Tisch, auf dem eine auseinandergepackte Musterkollektion von Tuchwaren ausgebreitet war - Samsa war Reisender - hing das Bild, das er vor kurzem aus einer illustrierten Zeitschrift ausgeschnitten und in einem hübschen, vergoldeten Rahmen untergebracht hatte. Es stellte eine Dame dar, die mit einem Pelzhut und einer Pelzboa versehen, aufrecht dasaß und einen schweren Pelzmuff, in dem ihr ganzer Unterarm verschwunden war, dem Beschauer entgegenhob.
-
-Gregors Blick richtete sich dann zum Fenster, und das trübe Wetter - man hörte Regentropfen auf das Fensterblech aufschlagen - machte ihn ganz melancholisch. »Wie wäre es, wenn ich noch ein wenig weiterschliefe und alle Narrheiten vergäße«, dachte er, aber das war gänzlich undurchführbar, denn er war gewöhnt, auf der rechten Seite zu schlafen, konnte sich aber in seinem gegenwärtigen Zustand nicht in diese Lage bringen. Mit welcher Kraft er sich auch auf die rechte Seite warf, immer wieder schaukelte er in die Rückenlage zurück. Er versuchte es wohl hundertmal, schloß die Augen, um die zappelnden Beine nicht sehen zu müssen, und ließ erst ab, als er in der Seite einen noch nie gefühlten, leichten, dumpfen Schmerz zu fühlen begann.
-
-»Ach Gott«, dachte er, »was für einen anstrengenden Beruf habe ich gewählt! Tag aus, Tag ein auf der Reise. Die geschäftlichen Aufregungen sind viel größer, als im eigentlichen Geschäft zu Hause, und außerdem ist mir noch diese Plage des Reisens auferlegt, die Sorgen um die Zuganschlüsse, das unregelmäßige, schlechte Essen, ein immer wechselnder, nie andauernder, nie herzlich werdender menschlicher Verkehr. Der Teufel soll das alles holen!« Er fühlte ein leichtes Jucken oben auf dem Bauch; schob sich auf dem Rücken langsam näher zum Bettpfosten, um den Kopf besser heben zu können; fand die juckende Stelle, die mit lauter kleinen weißen Pünktchen besetzt war, die er nicht zu beurteilen verstand; und wollte mit einem Bein die Stelle betasten, zog es aber gleich zurück, denn bei der Berührung umwehten ihn Kälteschauer.
-
-Er glitt wieder in seine frühere Lage zurück. »Dies frühzeitige Aufstehen«, dachte er, »macht einen ganz blödsinnig. Der Mensch muß seinen Schlaf haben. Andere Reisende leben wie Haremsfrauen. Wenn ich zum Beispiel im Laufe des Vormittags ins Gasthaus zurückgehe, um die erlangten Aufträge zu überschreiben, sitzen diese Herren erst beim Frühstück. Das sollte ich bei meinem Chef versuchen; ich würde auf der Stelle hinausfliegen. Wer weiß übrigens, ob das nicht sehr gut für mich wäre. Wenn ich mich nicht wegen meiner Eltern zurückhielte, ich hätte längst gekündigt, ich wäre vor den Chef hin getreten und hätte ihm meine Meinung von Grund des Herzens aus gesagt. Vom Pult hätte er fallen müssen! Es ist auch eine sonderbare Art, sich auf das Pult zu setzen und von der Höhe herab mit dem Angestellten zu reden, der überdies wegen der Schwerhörigkeit des Chefs ganz nahe herantreten muß. Nun, die Hoffnung ist noch nicht gänzlich aufgegeben; habe ich einmal das Geld beisammen, um die Schuld der Eltern an ihn abzuzahlen - es dürfte noch fünf bis sechs Jahre dauern - , mache ich die Sache unbedingt. Dann wird der große Schnitt gemacht. Vorläufig allerdings muß ich aufstehen, denn mein Zug fährt um fünf.«
-
-Und er sah zur Weckuhr hinüber, die auf dem Kasten tickte. »Himmlischer Vater!«, dachte er. Es war halb sieben Uhr, und die Zeiger gingen ruhig vorwärts, es war sogar halb vorüber, es näherte sich schon dreiviertel. Sollte der Wecker nicht geläutet haben? Man sah vom Bett aus, daß er auf vier Uhr richtig eingestellt war; gewiß hatte er auch geläutet. Ja, aber war es möglich, dieses möbelerschütternde Läuten ruhig zu verschlafen? Nun, ruhig hatte er ja nicht geschlafen, aber wahrscheinlich desto fester. Was aber sollte er jetzt tun? Der nächste Zug ging um sieben Uhr; um den einzuholen, hätte er sich unsinnig beeilen müssen, und die Kollektion war noch nicht eingepackt, und er selbst fühlte sich durchaus nicht besonders frisch und beweglich. Und selbst wenn er den Zug einholte, ein Donnerwetter des Chefs war nicht zu vermeiden, denn der Geschäftsdiener hatte beim Fünfuhrzug gewartet und die Meldung von seiner Versäumnis längst erstattet. Es war eine Kreatur des Chefs, ohne Rückgrat und Verstand. Wie nun, wenn er sich krank meldete? Das wäre aber äußerst peinlich und verdächtig, denn Gregor war während seines fünfjährigen Dienstes noch nicht einmal krank gewesen. Gewiß würde der Chef mit dem Krankenkassenarzt kommen, würde den Eltern wegen des faulen Sohnes Vorwürfe machen und alle Einwände durch den Hinweis auf den Krankenkassenarzt abschneiden, für den es ja überhaupt nur ganz gesunde, aber arbeitsscheue Menschen gibt. Und hätte er übrigens in diesem Falle so ganz unrecht? Gregor fühlte sich tatsächlich, abgesehen von einer nach dem langen Schlaf wirklich überflüssigen Schläfrigkeit, ganz wohl und hatte sogar einen besonders kräftigen Hunger.
(DIR) diff --git a/3rdparties/software/flexi-streams-20190107-git/test/packages.lisp b/3rdparties/software/flexi-streams-20190107-git/test/packages.lisp
@@ -1,41 +0,0 @@
-;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-USER; Base: 10 -*-
-;;; $Header: /usr/local/cvsrep/flexi-streams/test/packages.lisp,v 1.8 2008/08/01 10:12:43 edi Exp $
-
-;;; Copyright (c) 2006-2008, Dr. Edmund Weitz. All rights reserved.
-
-;;; Redistribution and use in source and binary forms, with or without
-;;; modification, are permitted provided that the following conditions
-;;; are met:
-
-;;; * Redistributions of source code must retain the above copyright
-;;; notice, this list of conditions and the following disclaimer.
-
-;;; * Redistributions in binary form must reproduce the above
-;;; copyright notice, this list of conditions and the following
-;;; disclaimer in the documentation and/or other materials
-;;; provided with the distribution.
-
-;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED
-;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
-;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
-;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
-;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
-;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
-;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
-;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
-;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
-;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
-;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-
-(in-package :cl-user)
-
-(defpackage :flexi-streams-test
- (:use :cl :flexi-streams)
- (:import-from :flexi-streams
- :with-unique-names
- :with-rebinding
- :char*
- :normalize-external-format
- :+name-map+
- :+shortcut-map+)
- (:export :run-all-tests))
(DIR) diff --git a/3rdparties/software/flexi-streams-20190107-git/test/russian_koi8r_cr.txt b/3rdparties/software/flexi-streams-20190107-git/test/russian_koi8r_cr.txt
@@ -1 +0,0 @@
- Unicode, 10-12 1997 . Unicode, , Unicode , , .
-\ No newline at end of file
(DIR) diff --git a/3rdparties/software/flexi-streams-20190107-git/test/russian_koi8r_crlf.txt b/3rdparties/software/flexi-streams-20190107-git/test/russian_koi8r_crlf.txt
@@ -1,6 +0,0 @@
-
-Unicode, 10-12 1997 .
-
- Unicode, ,
- Unicode
-, , .
(DIR) diff --git a/3rdparties/software/flexi-streams-20190107-git/test/russian_koi8r_lf.txt b/3rdparties/software/flexi-streams-20190107-git/test/russian_koi8r_lf.txt
@@ -1,6 +0,0 @@
-
-Unicode, 10-12 1997 .
-
- Unicode, ,
- Unicode
-, , .
(DIR) diff --git a/3rdparties/software/flexi-streams-20190107-git/test/russian_utf8_cr.txt b/3rdparties/software/flexi-streams-20190107-git/test/russian_utf8_cr.txt
@@ -1 +0,0 @@
-Зарегистрируйтесь сейчас на Десятую Международную Конференцию поUnicode, которая состоится 10-12 марта 1997 года в Майнце в Германии.Конференция соберет широкий круг экспертов по вопросам глобальногоИнтернета и Unicode, локализации и интернационализации, воплощению иприменению Unicode в различных операционных системах и программныхприложениях, шрифтах, верстке и многоязычных компьютерных системах.
-\ No newline at end of file
(DIR) diff --git a/3rdparties/software/flexi-streams-20190107-git/test/russian_utf8_crlf.txt b/3rdparties/software/flexi-streams-20190107-git/test/russian_utf8_crlf.txt
@@ -1,6 +0,0 @@
-Зарегистрируйтесь сейчас на Десятую Международную Конференцию по
-Unicode, которая состоится 10-12 марта 1997 года в Майнце в Германии.
-Конференция соберет широкий круг экспертов по вопросам глобального
-Интернета и Unicode, локализации и интернационализации, воплощению и
-применению Unicode в различных операционных системах и программных
-приложениях, шрифтах, верстке и многоязычных компьютерных системах.
(DIR) diff --git a/3rdparties/software/flexi-streams-20190107-git/test/russian_utf8_lf.txt b/3rdparties/software/flexi-streams-20190107-git/test/russian_utf8_lf.txt
@@ -1,6 +0,0 @@
-Зарегистрируйтесь сейчас на Десятую Международную Конференцию по
-Unicode, которая состоится 10-12 марта 1997 года в Майнце в Германии.
-Конференция соберет широкий круг экспертов по вопросам глобального
-Интернета и Unicode, локализации и интернационализации, воплощению и
-применению Unicode в различных операционных системах и программных
-приложениях, шрифтах, верстке и многоязычных компьютерных системах.
(DIR) diff --git a/3rdparties/software/flexi-streams-20190107-git/test/test.lisp b/3rdparties/software/flexi-streams-20190107-git/test/test.lisp
@@ -1,737 +0,0 @@
-;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: FLEXI-STREAMS-TEST; Base: 10 -*-
-;;; $Header: /usr/local/cvsrep/flexi-streams/test/test.lisp,v 1.39 2008/05/30 09:10:55 edi Exp $
-
-;;; Copyright (c) 2006-2008, Dr. Edmund Weitz. All rights reserved.
-
-;;; Redistribution and use in source and binary forms, with or without
-;;; modification, are permitted provided that the following conditions
-;;; are met:
-
-;;; * Redistributions of source code must retain the above copyright
-;;; notice, this list of conditions and the following disclaimer.
-
-;;; * Redistributions in binary form must reproduce the above
-;;; copyright notice, this list of conditions and the following
-;;; disclaimer in the documentation and/or other materials
-;;; provided with the distribution.
-
-;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED
-;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
-;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
-;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
-;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
-;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
-;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
-;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
-;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
-;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
-;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-
-(in-package :flexi-streams-test)
-
-(defmacro with-test-suite ((test-description &key show-progress-p) &body body)
- "Defines a test suite. Three utilities are available inside of the
-body of the macro: The function FAIL, and the macros CHECK and
-WITH-EXPECTED-ERROR. FAIL, the lowest level utility, marks the test
-defined by WITH-TEST-SUITE as failed. CHECK checks whether its argument is
-true, otherwise it calls FAIL. If during evaluation of the specified
-expression any condition is signalled, this is also considered a
-failure. WITH-EXPECTED-ERROR executes its body and considers the test
-a success if the specified error was signalled, otherwise it calls
-FAIL.
-
-WITH-TEST-SUITE prints a simple progress report if SHOW-PROGRESS-P is true."
- (with-unique-names (successp testcount)
- (with-rebinding (show-progress-p)
- `(let ((,successp t)
- (,testcount 1))
- (when (and ,show-progress-p (not (numberp ,show-progress-p)))
- (setq ,show-progress-p 1))
- (flet ((fail (format-str &rest format-args)
- (apply #'format t format-str format-args)
- (setq ,successp nil))
- (maybe-show-progress ()
- (when (and ,show-progress-p (zerop (mod ,testcount ,show-progress-p)))
- (format t ".")
- (when (zerop (mod ,testcount (* 10 ,show-progress-p)))
- (terpri))
- (force-output))
- (incf ,testcount)))
- (macrolet ((check (expression)
- `(progn
- (maybe-show-progress)
- (handler-case
- (unless ,expression
- (fail "~&Test ~S failed.~%" ',expression))
- (error (c)
- (fail "~&Test ~S failed signalling error of type ~A: ~A.~%"
- ',expression (type-of c) c)))))
- (with-expected-error ((condition-type) &body body)
- `(progn
- (maybe-show-progress)
- (handler-case (progn ,@body)
- (,condition-type () t)
- (:no-error (&rest args)
- (declare (ignore args))
- (fail "~&Expected condition ~S not signalled.~%"
- ',condition-type))))))
- (format t "~&Test suite: ~S~%" ,test-description)
- ,@body))
- ,successp))))
-
-;; LW can't indent this correctly because it's in a MACROLET
-#+:lispworks
-(editor:setup-indent "with-expected-error" 1 2 4)
-
-(defconstant +buffer-size+ 8192
- "Size of buffers for COPY-STREAM* below.")
-
-(defvar *copy-function* nil
- "Which function to use when copying from one stream to the other -
-see for example COPY-FILE below.")
-
-(defvar *this-file* (load-time-value
- (or #.*compile-file-pathname* *load-pathname*))
- "The pathname of the file \(`test.lisp') where this variable was
-defined.")
-
-#+:lispworks
-(defun get-env-variable-as-directory (name)
- (lw:when-let (string (lw:environment-variable name))
- (when (plusp (length string))
- (cond ((find (char string (1- (length string))) "\\/" :test #'char=) string)
- (t (lw:string-append string "/"))))))
-
-(defvar *tmp-dir*
- (load-time-value
- (merge-pathnames "odd-streams-test/"
- #+:allegro (system:temporary-directory)
- #+:lispworks (pathname (or (get-env-variable-as-directory "TEMP")
- (get-env-variable-as-directory "TMP")
- #+:win32 "C:/"
- #-:win32 "/tmp/"))
- #-(or :allegro :lispworks) #p"/tmp/"))
- "The pathname of a temporary directory used for testing.")
-
-(defvar *test-files*
- '(("kafka" (:utf8 :latin1 :cp1252))
- ("tilton" (:utf8 :ascii))
- ("hebrew" (:utf8 :latin8))
- ("russian" (:utf8 :koi8r))
- ("unicode_demo" (:utf8 :ucs2 :ucs4)))
- "A list of test files where each entry consists of the name
-prefix and a list of encodings.")
-
-(defun create-file-variants (file-name symbol)
- "For a name suffix FILE-NAME and a symbol SYMBOL denoting an
-encoding returns a list of pairs where the car is a full file
-name and the cdr is the corresponding external format. This list
-contains all possible variants w.r.t. to line-end conversion and
-endianness."
- (let ((args (ecase symbol
- (:ascii '(:ascii))
- (:latin1 '(:latin-1))
- (:latin8 '(:hebrew))
- (:cp1252 '(:code-page :id 1252))
- (:koi8r '(:koi8-r))
- (:utf8 '(:utf-8))
- (:ucs2 '(:utf-16))
- (:ucs4 '(:utf-32))))
- (endianp (member symbol '(:ucs2 :ucs4))))
- (loop for little-endian in (if endianp '(t nil) '(t))
- for endian-suffix in (if endianp '("_le" "_be") '(""))
- nconc (loop for eol-style in '(:lf :cr :crlf)
- collect (cons (format nil "~A_~(~A~)_~(~A~)~A.txt"
- file-name symbol eol-style endian-suffix)
- (apply #'make-external-format
- (append args `(:eol-style ,eol-style
- :little-endian ,little-endian))))))))
-
-(defun create-test-combinations (file-name symbols &optional simplep)
- "For a name suffix FILE-NAME and a list of symbols SYMBOLS denoting
-different encodings of the corresponding file returns a list of lists
-which can be used as arglists by COMPARE-FILES. If SIMPLEP is true, a
-list which can be used for the string and sequence tests below is
-returned."
- (let ((file-variants (loop for symbol in symbols
- nconc (create-file-variants file-name symbol))))
- (loop for (name-in . external-format-in) in file-variants
- when simplep
- collect (list name-in external-format-in)
- else
- nconc (loop for (name-out . external-format-out) in file-variants
- collect (list name-in external-format-in name-out external-format-out)))))
-
-(defun file-equal (file1 file2)
- "Returns a true value iff FILE1 and FILE2 have the same
-contents \(viewed as binary files)."
- (with-open-file (stream1 file1 :element-type 'octet)
- (with-open-file (stream2 file2 :element-type 'octet)
- (and (= (file-length stream1) (file-length stream2))
- (loop for byte1 = (read-byte stream1 nil nil)
- for byte2 = (read-byte stream2 nil nil)
- while (and byte1 byte2)
- always (= byte1 byte2))))))
-
-(defun copy-stream (stream-in external-format-in stream-out external-format-out)
- "Copies the contents of the binary stream STREAM-IN to the
-binary stream STREAM-OUT using flexi streams - STREAM-IN is read
-with the external format EXTERNAL-FORMAT-IN and STREAM-OUT is
-written with EXTERNAL-FORMAT-OUT."
- (let ((in (make-flexi-stream stream-in :external-format external-format-in))
- (out (make-flexi-stream stream-out :external-format external-format-out)))
- (loop for line = (read-line in nil nil)
- while line
- do (write-line line out))))
-
-(defun copy-stream* (stream-in external-format-in stream-out external-format-out)
- "Like COPY-STREAM, but uses READ-SEQUENCE and WRITE-SEQUENCE instead
-of READ-LINE and WRITE-LINE."
- (let ((in (make-flexi-stream stream-in :external-format external-format-in))
- (out (make-flexi-stream stream-out :external-format external-format-out))
- (buffer (make-array +buffer-size+ :element-type 'char*)))
- (loop
- (let ((position (read-sequence buffer in)))
- (when (zerop position) (return))
- (write-sequence buffer out :end position)))))
-
-(defun copy-file (path-in external-format-in path-out external-format-out direction-out direction-in)
- "Copies the contents of the file denoted by the pathname
-PATH-IN to the file denoted by the pathname PATH-OUT using flexi
-streams - STREAM-IN is read with the external format
-EXTERNAL-FORMAT-IN and STREAM-OUT is written with
-EXTERNAL-FORMAT-OUT. The input file is opened with
-the :DIRECTION keyword argument DIRECTION-IN, the output file is
-opened with the :DIRECTION keyword argument DIRECTION-OUT."
- (with-open-file (in path-in
- :element-type 'octet
- :direction direction-in
- :if-does-not-exist :error
- :if-exists :overwrite)
- (with-open-file (out path-out
- :element-type 'octet
- :direction direction-out
- :if-does-not-exist :create
- :if-exists :supersede)
- (funcall *copy-function* in external-format-in out external-format-out))))
-
-#+:lispworks
-(defun copy-file-lw (path-in external-format-in path-out external-format-out direction-out direction-in)
- "Same as COPY-FILE, but uses character streams instead of
-binary streams. Only used to test LispWorks-specific behaviour."
- (with-open-file (in path-in
- :external-format '(:latin-1 :eol-style :lf)
- :element-type 'base-char
- :direction direction-in
- :if-does-not-exist :error
- :if-exists :overwrite)
- (with-open-file (out path-out
- :external-format '(:latin-1 :eol-style :lf)
- :element-type 'base-char
- :direction direction-out
- :direction :output
- :if-does-not-exist :create
- :if-exists :supersede)
- (funcall *copy-function* in external-format-in out external-format-out))))
-
-(defun compare-files (&key verbose)
- "Each test in this suite copies the contents of one file \(in the
-`test' directory) to another file \(in a temporary directory) using
-flexi streams with different external formats. The resulting file is
-compared with an existing file in the `test' directory to check if the
-outcome is as expected. Uses various variants of the :DIRECTION
-keyword when opening the files.
-
-Returns a true value iff all tests succeeded. Prints information
-about each individual comparison if VERBOSE is true."
- (with-test-suite ("Reading/writing files" :show-progress-p (not verbose))
- (flet ((one-comparison (path-in external-format-in path-out external-format-out verbose)
- (when verbose
- (format t "~&File ~S, using copy function ~S" (file-namestring path-in) *copy-function*)
- (format t "~& and external formats ~S --> ~S"
- (normalize-external-format external-format-in)
- (normalize-external-format external-format-out)))
- (let ((full-path-in (merge-pathnames path-in *this-file*))
- (full-path-out (ensure-directories-exist
- (merge-pathnames path-out *tmp-dir*)))
- (full-path-orig (merge-pathnames path-out *this-file*)))
- (dolist (direction-out '(:output :io))
- (dolist (direction-in '(:input :io))
- (when verbose
- (format t "~&...directions ~S --> ~S" direction-in direction-out))
- (copy-file full-path-in external-format-in
- full-path-out external-format-out
- direction-out direction-in)
- (check (file-equal full-path-out full-path-orig))
- #+:lispworks
- (progn
- (when verbose
- (format t "~&...directions ~S --> ~S \(LispWorks)" direction-in direction-out))
- (copy-file-lw full-path-in external-format-in
- full-path-out external-format-out
- direction-out direction-in)
- (check (file-equal full-path-out full-path-orig))))))))
- (loop with compare-files-args-list = (loop for (file-name symbols) in *test-files*
- nconc (create-test-combinations file-name symbols))
- for *copy-function* in '(copy-stream copy-stream*)
- do (loop for (path-in external-format-in path-out external-format-out) in compare-files-args-list
- do (one-comparison path-in external-format-in path-out external-format-out verbose))))))
-
-(defun file-as-octet-vector (pathspec)
- "Returns the contents of the file denoted by PATHSPEC as a vector of
-octets."
- (with-open-file (in pathspec :element-type 'octet)
- (let ((vector (make-array (file-length in) :element-type 'octet)))
- (read-sequence vector in)
- vector)))
-
-(defun file-as-string (pathspec external-format)
- "Reads the contents of the file denoted by PATHSPEC using the
-external format EXTERNAL-FORMAT and returns the result as a string."
- (with-open-file (in pathspec :element-type 'octet)
- (let* ((number-of-octets (file-length in))
- (in (make-flexi-stream in :external-format external-format))
- (string (make-array number-of-octets
- :element-type #+:lispworks 'lw:simple-char
- #-:lispworks 'character
- :fill-pointer t)))
- (setf (fill-pointer string) (read-sequence string in))
- string)))
-
-(defun old-string-to-octets (string &key
- (external-format (make-external-format :latin1))
- (start 0) end)
- "The old version of STRING-TO-OCTETS. We can use it to test
-in-memory streams."
- (declare (optimize speed))
- (with-output-to-sequence (out)
- (let ((flexi (make-flexi-stream out :external-format external-format)))
- (write-string string flexi :start start :end end))))
-
-(defun old-octets-to-string (vector &key
- (external-format (make-external-format :latin1))
- (start 0) (end (length vector)))
- "The old version of OCTETS-TO-STRING. We can use it to test
-in-memory streams."
- (declare (optimize speed))
- (with-input-from-sequence (in vector :start start :end end)
- (let ((flexi (make-flexi-stream in :external-format external-format))
- (result (make-array (- end start)
- :element-type #+:lispworks 'lw:simple-char
- #-:lispworks 'character
- :fill-pointer t)))
- (setf (fill-pointer result)
- (read-sequence result flexi))
- result)))
-
-(defun string-tests (&key verbose)
- "Tests whether conversion from strings to octets and vice versa
-works as expected. Also tests with the old versions of the conversion
-functions in order to test in-memory streams."
- (with-test-suite ("String tests" :show-progress-p (and (not verbose) 10))
- (flet ((one-string-test (pathspec external-format verbose)
- (when verbose
- (format t "~&With external format ~S:" (normalize-external-format external-format)))
- (let* ((full-path (merge-pathnames pathspec *this-file*))
- (octets-vector (file-as-octet-vector full-path))
- (octets-list (coerce octets-vector 'list))
- (string (file-as-string full-path external-format)))
- (when verbose
- (format t "~&...testing OCTETS-TO-STRING"))
- (check (string= (octets-to-string octets-vector :external-format external-format) string))
- (check (string= (octets-to-string octets-list :external-format external-format) string))
- (when verbose
- (format t "~&...testing STRING-TO-OCTETS"))
- (check (equalp (string-to-octets string :external-format external-format) octets-vector))
- (when verbose
- (format t "~&...testing in-memory streams"))
- (check (string= (old-octets-to-string octets-vector :external-format external-format) string))
- (check (string= (old-octets-to-string octets-list :external-format external-format) string))
- (check (equalp (old-string-to-octets string :external-format external-format) octets-vector)))))
- (loop with simple-test-args-list = (loop for (file-name symbols) in *test-files*
- nconc (create-test-combinations file-name symbols t))
- for (pathspec external-format) in simple-test-args-list
- do (one-string-test pathspec external-format verbose)))))
-
-
-(defun sequence-equal (seq1 seq2)
- "Whether the two sequences have the same elements."
- (and (= (length seq1) (length seq2))
- (loop for i below (length seq1)
- always (eql (elt seq1 i) (elt seq2 i)))))
-
-(defun sequence-tests (&key verbose)
- "Several tests to confirm that READ-SEQUENCE and WRITE-SEQUENCE
-behave as expected."
- (with-test-suite ("Sequence tests" :show-progress-p (and (not verbose) 10))
- (flet ((one-sequence-test (pathspec external-format verbose)
- (when verbose
- (format t "~&With external format ~S:" (normalize-external-format external-format)))
- (let* ((full-path (merge-pathnames pathspec *this-file*))
- (file-string (file-as-string full-path external-format))
- (string-length (length file-string))
- (octets (file-as-octet-vector full-path))
- (octet-length (length octets)))
- (when (external-format-equal external-format (make-external-format :utf8))
- (when verbose
- (format t "~&...reading octets"))
- #-:openmcl
- ;; FLEXI-STREAMS puts integers into the list, but OpenMCL
- ;; thinks they are characters...
- (with-open-file (in full-path :element-type 'octet)
- (let* ((in (make-flexi-stream in :external-format external-format))
- (list (make-list octet-length)))
- (setf (flexi-stream-element-type in) 'octet)
- #-:clisp
- (read-sequence list in)
- #+:clisp
- (ext:read-byte-sequence list in)
- (check (sequence-equal list octets))))
- (with-open-file (in full-path :element-type 'octet)
- (let* ((in (make-flexi-stream in :external-format external-format))
- (third (floor octet-length 3))
- (half (floor octet-length 2))
- (vector (make-array half :element-type 'octet)))
- (check (sequence-equal (loop repeat third
- collect (read-byte in))
- (subseq octets 0 third)))
- (read-sequence vector in)
- (check (sequence-equal vector (subseq octets third (+ third half)))))))
- (when verbose
- (format t "~&...reading characters"))
- (with-open-file (in full-path :element-type 'octet)
- (let* ((in (make-flexi-stream in :external-format external-format))
- (string (make-string (- string-length 10) :element-type 'char*)))
- (setf (flexi-stream-element-type in) 'octet)
- (check (sequence-equal (loop repeat 10
- collect (read-char in))
- (subseq file-string 0 10)))
- (read-sequence string in)
- (check (sequence-equal string (subseq file-string 10)))))
- (with-open-file (in full-path :element-type 'octet)
- (let* ((in (make-flexi-stream in :external-format external-format))
- (list (make-list (- string-length 100))))
- (check (sequence-equal (loop repeat 50
- collect (read-char in))
- (subseq file-string 0 50)))
- #-:clisp
- (read-sequence list in)
- #+:clisp
- (ext:read-char-sequence list in)
- (check (sequence-equal list (subseq file-string 50 (- string-length 50))))
- (check (sequence-equal (loop repeat 50
- collect (read-char in))
- (subseq file-string (- string-length 50))))))
- (with-open-file (in full-path :element-type 'octet)
- (let* ((in (make-flexi-stream in :external-format external-format))
- (array (make-array (- string-length 50))))
- (check (sequence-equal (loop repeat 25
- collect (read-char in))
- (subseq file-string 0 25)))
- #-:clisp
- (read-sequence array in)
- #+:clisp
- (ext:read-char-sequence array in)
- (check (sequence-equal array (subseq file-string 25 (- string-length 25))))
- (check (sequence-equal (loop repeat 25
- collect (read-char in))
- (subseq file-string (- string-length 25))))))
- (let ((path-out (ensure-directories-exist (merge-pathnames pathspec *tmp-dir*))))
- (when verbose
- (format t "~&...writing sequences"))
- (with-open-file (out path-out
- :direction :output
- :if-exists :supersede
- :element-type 'octet)
- (let ((out (make-flexi-stream out :external-format external-format)))
- (write-sequence octets out)))
- (check (file-equal full-path path-out))
- (with-open-file (out path-out
- :direction :output
- :if-exists :supersede
- :element-type 'octet)
- (let ((out (make-flexi-stream out :external-format external-format)))
- (write-sequence file-string out)))
- (check (file-equal full-path path-out))
- (with-open-file (out path-out
- :direction :output
- :if-exists :supersede
- :element-type 'octet)
- (let ((out (make-flexi-stream out :external-format external-format)))
- (write-sequence file-string out :end 100)
- (write-sequence octets out
- :start (length (string-to-octets file-string
- :external-format external-format
- :end 100)))))
- (check (file-equal full-path path-out))))))
-
- (loop with simple-test-args-list = (loop for (file-name symbols) in *test-files*
- nconc (create-test-combinations file-name symbols t))
- for (pathspec external-format) in simple-test-args-list
- do (one-sequence-test pathspec external-format verbose)))))
-
-(defmacro using-values ((&rest values) &body body)
- "Executes BODY and feeds an element from VALUES to the USE-VALUE
-restart each time a EXTERNAL-FORMAT-ENCODING-ERROR is signalled.
-Signals an error when there are more or less
-EXTERNAL-FORMAT-ENCODING-ERRORs than there are elements in VALUES."
- (with-unique-names (value-stack condition-counter)
- `(let ((,value-stack ',values)
- (,condition-counter 0))
- (handler-bind ((external-format-encoding-error
- #'(lambda (c)
- (declare (ignore c))
- (unless ,value-stack
- (error "Too many encoding errors signalled, expected only ~A."
- ,(length values)))
- (incf ,condition-counter)
- (use-value (pop ,value-stack)))))
- (prog1 (progn ,@body)
- (when ,value-stack
- (error "~A encoding errors signalled, but ~A were expected."
- ,condition-counter ,(length values))))))))
-
-(defun accept-overlong (octets code-point)
- "Converts the `overlong' UTF-8 sequence OCTETS to using
-OCTETS-TO-STRINGS, accepts the expected error with the corresponding
-restart and checks that the result is CODE-POINT."
- (handler-bind ((external-format-encoding-error
- (lambda (c)
- (declare (ignore c))
- (invoke-restart 'accept-overlong-sequence))))
- (string= (octets-to-string octets :external-format :utf-8)
- (string (code-char code-point)))))
-
-(defun read-flexi-line (sequence external-format)
- "Creates and returns a string from the octet sequence SEQUENCE using
-the external format EXTERNAL-FORMAT."
- (with-input-from-sequence (in sequence)
- (setq in (make-flexi-stream in :external-format external-format))
- (read-line in)))
-
-(defun read-flexi-line* (sequence external-format)
- "Like READ-FLEXI-LINE but uses OCTETS-TO-STRING internally."
- (octets-to-string sequence :external-format external-format))
-
-(defun error-handling-tests (&key verbose)
- "Tests several possible errors and how they are handled."
- (with-test-suite ("Testing error handling" :show-progress-p (not verbose))
- (macrolet ((want-encoding-error (input format)
- `(with-expected-error (external-format-encoding-error)
- (read-flexi-line* ,input ,format))))
- (when verbose
- (format t "~&\"Overlong\" UTF-8 sequences"))
- (want-encoding-error #(#b11000000 #b10000000) :utf-8)
- (want-encoding-error #(#b11000001 #b10000000) :utf-8)
- (want-encoding-error #(#b11100000 #b10011111 #b10000000) :utf-8)
- (want-encoding-error #(#b11110000 #b10001111 #b10000000 #b10000000) :utf-8)
- (check (accept-overlong #(#b11000000 #b10000000) #b00000000))
- (check (accept-overlong #(#b11000001 #b10000000) #b01000000))
- (check (accept-overlong #(#b11100000 #b10011111 #b10000000) #b011111000000))
- (check (accept-overlong #(#b11110000 #b10001111 #b10000000 #b10000000)
- #b1111000000000000))
- (when verbose
- (format t "~&Invalid lead octets in UTF-8"))
- (want-encoding-error #(#b11111000) :utf-8)
- (want-encoding-error #(#b11111001) :utf-8)
- (want-encoding-error #(#b11111100) :utf-8)
- (want-encoding-error #(#b11111101) :utf-8)
- (want-encoding-error #(#b11111110) :utf-8)
- (want-encoding-error #(#b11111111) :utf-8)
- (when verbose
- (format t "~&Illegal code points"))
- (want-encoding-error #(#x00 #x00 #x11 #x00) :utf-32le)
- (want-encoding-error #(#x00 #xd8) :utf-16le)
- (want-encoding-error #(#xff #xdf) :utf-16le))
- (macrolet ((want-encoding-error (input format)
- `(with-expected-error (external-format-encoding-error)
- (read-flexi-line* ,input ,format))))
- (when verbose
- (format t "~&UTF-8 sequences which are too short"))
- (want-encoding-error #(#xe4 #xf6 #xfc) :utf8)
- (want-encoding-error #(#xc0) :utf8)
- (want-encoding-error #(#xe0 #xff) :utf8)
- (want-encoding-error #(#xf0 #xff #xff) :utf8)
- (when verbose
- (format t "~&UTF-16 sequences with an odd number of octets"))
- (want-encoding-error #(#x01) :utf-16le)
- (want-encoding-error #(#x01 #x01 #x01) :utf-16le)
- (want-encoding-error #(#x01) :utf-16be)
- (want-encoding-error #(#x01 #x01 #x01) :utf-16be)
- (when verbose
- (format t "~&Missing words in UTF-16"))
- (want-encoding-error #(#x01 #xd8) :utf-16le)
- (want-encoding-error #(#xd8 #x01) :utf-16be)
- (when verbose
- (format t "~&Missing octets in UTF-32"))
- (want-encoding-error #(#x01) :utf-32le)
- (want-encoding-error #(#x01 #x01) :utf-32le)
- (want-encoding-error #(#x01 #x01 #x01) :utf-32le)
- (want-encoding-error #(#x01 #x01 #x01 #x01 #x01) :utf-32le)
- (want-encoding-error #(#x01) :utf-32be)
- (want-encoding-error #(#x01 #x01) :utf-32be)
- (want-encoding-error #(#x01 #x01 #x01) :utf-32be)
- (want-encoding-error #(#x01 #x01 #x01 #x01 #x01) :utf-32be))
- (when verbose
- (format t "~&Handling of EOF in the middle of CRLF"))
- (check (string= #.(string #\Return)
- (read-flexi-line `(,(char-code #\Return)) '(:ascii :eol-style :crlf))))
- (let ((*substitution-char* #\?))
- (when verbose
- (format t "~&Fixed substitution character #\?")
- (format t "~&:ASCII doesn't have characters with char codes > 127"))
- (check (string= "a??" (read-flexi-line `(,(char-code #\a) 128 200) :ascii)))
- (check (string= "a??" (read-flexi-line* `#(,(char-code #\a) 128 200) :ascii)))
- (when verbose
- (format t "~&:WINDOWS-1253 doesn't have a characters with codes 170 and 210"))
- (check (string= "a??" (read-flexi-line `(,(char-code #\a) 170 210) :windows-1253)))
- (check (string= "a??" (read-flexi-line* `#(,(char-code #\a) 170 210) :windows-1253)))
- (when verbose
- (format t "~&Not a valid UTF-8 sequence"))
- (check (string= "??" (read-flexi-line '(#xe4 #xf6 #xfc) :utf8))))
- (let ((*substitution-char* nil))
- (when verbose
- (format t "~&Variable substitution using USE-VALUE restart")
- (format t "~&:ASCII doesn't have characters with char codes > 127"))
- (check (string= "abc" (using-values (#\b #\c)
- (read-flexi-line `(,(char-code #\a) 128 200) :ascii))))
- (check (string= "abc" (using-values (#\b #\c)
- (read-flexi-line* `#(,(char-code #\a) 128 200) :ascii))))
- (when verbose
- (format t "~&:WINDOWS-1253 doesn't have a characters with codes 170 and 210"))
- (check (string= "axy" (using-values (#\x #\y)
- (read-flexi-line `(,(char-code #\a) 170 210) :windows-1253))))
- (check (string= "axy" (using-values (#\x #\y)
- (read-flexi-line* `#(,(char-code #\a) 170 210) :windows-1253))))
- (when verbose
- (format t "~&Not a valid UTF-8 sequence"))
- (check (string= "QW" (using-values (#\Q #\W) (read-flexi-line '(#xe4 #xf6 #xfc) :utf8))))
- (when verbose
- (format t "~&UTF-8 can't start neither with #b11111110 nor with #b11111111"))
- (check (string= "QW" (using-values (#\Q #\W) (read-flexi-line '(#b11111110 #b11111111) :utf8))))
- (when verbose
- (format t "~&Only one octet in UTF-16 sequence"))
- (check (string= "E" (using-values (#\E) (read-flexi-line '(#x01) :utf-16le))))
- (when verbose
- (format t "~&Two octets in UTF-16, but value of resulting word suggests that another word follows"))
- (check (string= "R" (using-values (#\R) (read-flexi-line '(#x01 #xd8) :utf-16le))))
- (when verbose
- (format t "~&The second word must fit into the [#xdc00; #xdfff] interval, but it is #xdbff"))
- (check (string= "T" (using-values (#\T) (read-flexi-line '(#x01 #xd8 #xff #xdb) :utf-16le))))
- (check (string= "T" (using-values (#\T) (read-flexi-line* #(#x01 #xd8 #xff #xdb) :utf-16le))))
- (when verbose
- (format t "~&The same as for little endian above, but using inverse order of bytes in words"))
- (check (string= "E" (using-values (#\E) (read-flexi-line '(#x01) :utf-16be))))
- (check (string= "R" (using-values (#\R) (read-flexi-line '(#xd8 #x01) :utf-16be))))
- (check (string= "T" (using-values (#\T) (read-flexi-line '(#xd8 #x01 #xdb #xff) :utf-16be))))
- (check (string= "T" (using-values (#\T) (read-flexi-line* #(#xd8 #x01 #xdb #xff) :utf-16be))))
- (when verbose
- (format t "~&EOF in the middle of a 4-octet sequence in UTF-32"))
- (check (string= "Y" (using-values (#\Y) (read-flexi-line '(#x01) :utf-32le))))
- (check (string= "Y" (using-values (#\Y) (read-flexi-line '(#x01 #x01) :utf-32le))))
- (check (string= "Y" (using-values (#\Y) (read-flexi-line '(#x01 #x01 #x01) :utf-32le))))
- (check (string= "aY" (using-values (#\Y)
- (read-flexi-line `(,(char-code #\a) #x00 #x00 #x00 #x01) :utf-32le))))
- (check (string= "Y" (using-values (#\Y) (read-flexi-line '(#x01) :utf-32be))))
- (check (string= "Y" (using-values (#\Y) (read-flexi-line '(#x01 #x01) :utf-32be))))
- (check (string= "Y" (using-values (#\Y) (read-flexi-line '(#x01 #x01 #x01) :utf-32be))))
- (check (string= "aY" (using-values (#\Y)
- (read-flexi-line `(#x00 #x00 #x00 ,(char-code #\a) #x01) :utf-32be)))))))
-
-(defun unread-char-tests (&key verbose)
- "Tests whether UNREAD-CHAR behaves as expected."
- (with-test-suite ("UNREAD-CHAR behaviour." :show-progress-p (and (not verbose) 100))
- (flet ((test-one-file (file-name external-format)
- (when verbose
- (format t "~& ...and external format ~A" (normalize-external-format external-format)))
- (with-open-file (in (merge-pathnames file-name *this-file*)
- :element-type 'flex:octet)
- (let ((in (make-flexi-stream in :external-format external-format)))
- (loop repeat 300
- for char = (read-char in)
- do (unread-char char in)
- (check (char= (read-char in) char)))))))
- (loop for (file-name symbols) in *test-files*
- when verbose
- do (format t "~&With file ~S" file-name)
- do (loop for symbol in symbols
- do (loop for (file-name . external-format) in (create-file-variants file-name symbol)
- do (test-one-file file-name external-format)))))))
-
-(defun column-tests (&key verbose)
- (with-test-suite ("STREAM-LINE-COLUMN tests" :show-progress-p (not verbose))
- (let* ((binary-stream (flexi-streams:make-in-memory-output-stream))
- (stream (flexi-streams:make-flexi-stream binary-stream :external-format :iso-8859-1)))
- (write-sequence "hello" stream)
- (format stream "~12Tworld")
- (finish-output stream)
- (check (string= "hello world"
- (flexi-streams:octets-to-string
- (flexi-streams::vector-stream-vector binary-stream)
- :external-format :iso-8859-1)))
- (terpri stream)
- (check (= 0 (flexi-stream-column stream)))
- (write-sequence "abc" stream)
- (check (= 3 (flexi-stream-column stream)))
- (terpri stream)
- (check (= 0 (flexi-stream-column stream))))))
-
-(defun make-external-format-tests (&key verbose)
- (with-test-suite ("MAKE-EXTERNAL-FORMAT tests" :show-progress-p (not verbose))
- (flet ((make-case (real-name &key id name)
- (list real-name
- :id id
- :input-names (list name (string-upcase name) (string-downcase name)))))
- (let ((cases (append '((:utf-8 :id nil
- :input-names (:utf8 :utf-8 "utf8" "utf-8" "UTF8" "UTF-8")))
- (loop for (name . real-name) in +name-map+
- unless (member :code-page (list name real-name))
- append (list (make-case real-name :name name)
- (make-case real-name :name real-name)))
- (loop for (name . definition) in +shortcut-map+
- for key = (car definition)
- for id = (getf (cdr definition) :id)
- for expected = (or (cdr (assoc key +name-map+)) key)
- collect (make-case expected :id id :name name)))))
-
- (loop for (expected-name . kwargs) in cases
- for id = (getf kwargs :id)
- for input-names = (getf kwargs :input-names)
- do (loop for name in input-names
- for ext-format = (make-external-format name)
- do (check (eq (flex:external-format-name ext-format) expected-name))
- when id
- do (check (= (flex:external-format-id ext-format) id))))))
-
- (let ((error-cases '("utf-8 " " utf-8" "utf8 " " utf8" "utf89" :utf89 utf89 :code-page nil)))
- (loop for input-name in error-cases
- do (with-expected-error (external-format-error)
- (make-external-format input-name))))))
-
-(defun peek-byte-tests (&key verbose)
- (with-test-suite ("PEEK-BYTE tests" :show-progress-p (not verbose))
- (flex:with-input-from-sequence (input #(0 1 2))
- (let ((stream (flex:make-flexi-stream input)))
- ;; If peek-type was specified as 2 we need to peek the first octect equal to 2
- (check (= 2 (flex::peek-byte stream 2 nil 1)))
- ;; also, the octet should be unread to the stream so that we can peek it again
- (check (= 2 (flex::peek-byte stream nil nil nil)))))))
-
-(defun run-all-tests (&key verbose)
- "Runs all tests for FLEXI-STREAMS and returns a true value iff all
-tests succeeded. VERBOSE is interpreted by the individual test suites
-above."
- (let ((successp t))
- (macrolet ((run-test-suite (&body body)
- `(unless (progn ,@body)
- (setq successp nil))))
- (run-test-suite (compare-files :verbose verbose))
- (run-test-suite (string-tests :verbose verbose))
- (run-test-suite (sequence-tests :verbose verbose))
- (run-test-suite (error-handling-tests :verbose verbose))
- (run-test-suite (unread-char-tests :verbose verbose))
- (run-test-suite (column-tests :verbose verbose))
- (run-test-suite (make-external-format-tests :verbose verbose))
- (run-test-suite (peek-byte-tests :verbose verbose))
- (format t "~2&~:[Some tests failed~;All tests passed~]." successp)
- successp)))
(DIR) diff --git a/3rdparties/software/flexi-streams-20190107-git/test/tilton_ascii_cr.txt b/3rdparties/software/flexi-streams-20190107-git/test/tilton_ascii_cr.txt
@@ -1 +0,0 @@
-Programmers who lock onto a design decision and cling to it in the face ofcontradictory new information -- well, that's almost everyone in myexperience, so I better not say what I think of them or people will startsaying bad things about me on c.l.l. -- Ken Tilton%This reminds me of the NYC cabby who accepted a fare to Chicago. Whenthey got there and could not find the friend who was supposed to pay thefare he just laughed and said he should have known. -- Ken Tilton%>> Actually, I believe that Aikido, Jazz and Lisp are different appearances>> of the same thing.Yes, the Tao. /Everything/ is a different appearance of the tao. -- Ken Tilton"Ken, I went to the library and read up on Buddhism, and believe me, youare no Buddhist." -- Kenny's mom%That absolutely terrifies the herd-following, lockstep-marching,mainstream-saluting cowards that obediently dash out or online toscoop up books on The Latest Thing. They learn and use atrocities likeJava, C++, XML, and even Python for the security it gives them andthen sit there slaving away miserably, tediously, joylously paying offmortgages and supporting ungrateful teenagers who despise them, onlyto look out the double-sealed thermo-pane windows of theircentral-heated, sound-proofed, dead-bolted, suffocating little nestsinto the howling gale thinking "what do they know that I do not know?"when they see us under a lean-to hunched over our laptops to shieldthem from the rain laughing our asses off as we write great codebetween bong hits.... what was the question? -- Ken Tilton%Shut up! (That last phrase has four or more syllables if pronounced asintended.) -- Ken Tilton%Nonsense. You'll be using it for the GUI, not protein-folding. -- Ken Tilton (responding to a comment that LTK was slow because it was based on TK)%Continuations certainly are clever, but if we learned anything from therejection of the cover art for "Smell the Glove", it is that "there is afine line between stupid... and clever". -- Ken Tilton%Ah, there's no place like academia for dispassionate, intellectuallyhonest discussion of new ideas on their merits. Thank god for tenuregiving your bold antagonist the protection they needed to shout downyour iconoclastic..... hang on... -- Ken Tilton%Whoever objected must be in my killfile, ... -- Ken Tilton%From memory (but I think I have it right):"But Jesus said, Suffer captured variables, and forbid them not, to comeunto thine macro bodies: for of such is are DSLs made." -- Ken TiltonCan I get an Amen?%Awareness of defect is the first step to recovery. -- Ken Tilton%You made a bad analogy (there are no good ones, but you found a newlow) ... -- Ken Tilton%Yes, it is true that Kent Pitman was raised by a closet full of LispMachines, but the exception only proves the rule. -- Ken Tilton (in a postscript after positing that computer languages are not learned in infancy)%I suggest you try bartender's school to support yourself, startprogramming for fun again. -- Ken Tilton (responding to a comment that 98% of anything to do with computers was not interesting code)%You could add four lanes to my carpal tunnel and I still could notwrite all the code I am dying to write. -- Ken Tilton%Neutrality? I want to bury other languages, not have a gateway to them. -- Ken Tilton%Ken: "Cute puppy. Did you get it for companionship or to pick up chicks?"Simon: "Hunh? My puppy /always/ gives me companionship." -- Ken Tilton (on how he was understood by a native english speaker)%
-\ No newline at end of file
(DIR) diff --git a/3rdparties/software/flexi-streams-20190107-git/test/tilton_ascii_crlf.txt b/3rdparties/software/flexi-streams-20190107-git/test/tilton_ascii_crlf.txt
@@ -1,96 +0,0 @@
-Programmers who lock onto a design decision and cling to it in the face of
-contradictory new information -- well, that's almost everyone in my
-experience, so I better not say what I think of them or people will start
-saying bad things about me on c.l.l.
- -- Ken Tilton
-%
-This reminds me of the NYC cabby who accepted a fare to Chicago. When
-they got there and could not find the friend who was supposed to pay the
-fare he just laughed and said he should have known.
- -- Ken Tilton
-%
->> Actually, I believe that Aikido, Jazz and Lisp are different appearances
->> of the same thing.
-Yes, the Tao. /Everything/ is a different appearance of the tao.
- -- Ken Tilton
-
-"Ken, I went to the library and read up on Buddhism, and believe me, you
-are no Buddhist."
- -- Kenny's mom
-%
-That absolutely terrifies the herd-following, lockstep-marching,
-mainstream-saluting cowards that obediently dash out or online to
-scoop up books on The Latest Thing. They learn and use atrocities like
-Java, C++, XML, and even Python for the security it gives them and
-then sit there slaving away miserably, tediously, joylously paying off
-mortgages and supporting ungrateful teenagers who despise them, only
-to look out the double-sealed thermo-pane windows of their
-central-heated, sound-proofed, dead-bolted, suffocating little nests
-into the howling gale thinking "what do they know that I do not know?"
-when they see us under a lean-to hunched over our laptops to shield
-them from the rain laughing our asses off as we write great code
-between bong hits.... what was the question?
- -- Ken Tilton
-%
-Shut up! (That last phrase has four or more syllables if pronounced as
-intended.)
- -- Ken Tilton
-%
-Nonsense. You'll be using it for the GUI, not protein-folding.
- -- Ken Tilton
- (responding to a comment that LTK was slow because it
- was based on TK)
-%
-Continuations certainly are clever, but if we learned anything from the
-rejection of the cover art for "Smell the Glove", it is that "there is a
-fine line between stupid... and clever".
- -- Ken Tilton
-%
-Ah, there's no place like academia for dispassionate, intellectually
-honest discussion of new ideas on their merits. Thank god for tenure
-giving your bold antagonist the protection they needed to shout down
-your iconoclastic..... hang on...
- -- Ken Tilton
-%
-Whoever objected must be in my killfile, ...
- -- Ken Tilton
-%
-From memory (but I think I have it right):
-
-"But Jesus said, Suffer captured variables, and forbid them not, to come
-unto thine macro bodies: for of such is are DSLs made."
- -- Ken Tilton
-
-Can I get an Amen?
-%
-Awareness of defect is the first step to recovery.
- -- Ken Tilton
-%
-You made a bad analogy (there are no good ones, but you found a new
-low) ...
- -- Ken Tilton
-%
-Yes, it is true that Kent Pitman was raised by a closet full of Lisp
-Machines, but the exception only proves the rule.
- -- Ken Tilton
- (in a postscript after positing that computer
- languages are not learned in infancy)
-%
-I suggest you try bartender's school to support yourself, start
-programming for fun again.
- -- Ken Tilton
- (responding to a comment that 98% of anything to do
- with computers was not interesting code)
-%
-You could add four lanes to my carpal tunnel and I still could not
-write all the code I am dying to write.
- -- Ken Tilton
-%
-Neutrality? I want to bury other languages, not have a gateway to them.
- -- Ken Tilton
-%
-Ken: "Cute puppy. Did you get it for companionship or to pick up chicks?"
-Simon: "Hunh? My puppy /always/ gives me companionship."
- -- Ken Tilton
- (on how he was understood by a native english speaker)
-%
(DIR) diff --git a/3rdparties/software/flexi-streams-20190107-git/test/tilton_ascii_lf.txt b/3rdparties/software/flexi-streams-20190107-git/test/tilton_ascii_lf.txt
@@ -1,96 +0,0 @@
-Programmers who lock onto a design decision and cling to it in the face of
-contradictory new information -- well, that's almost everyone in my
-experience, so I better not say what I think of them or people will start
-saying bad things about me on c.l.l.
- -- Ken Tilton
-%
-This reminds me of the NYC cabby who accepted a fare to Chicago. When
-they got there and could not find the friend who was supposed to pay the
-fare he just laughed and said he should have known.
- -- Ken Tilton
-%
->> Actually, I believe that Aikido, Jazz and Lisp are different appearances
->> of the same thing.
-Yes, the Tao. /Everything/ is a different appearance of the tao.
- -- Ken Tilton
-
-"Ken, I went to the library and read up on Buddhism, and believe me, you
-are no Buddhist."
- -- Kenny's mom
-%
-That absolutely terrifies the herd-following, lockstep-marching,
-mainstream-saluting cowards that obediently dash out or online to
-scoop up books on The Latest Thing. They learn and use atrocities like
-Java, C++, XML, and even Python for the security it gives them and
-then sit there slaving away miserably, tediously, joylously paying off
-mortgages and supporting ungrateful teenagers who despise them, only
-to look out the double-sealed thermo-pane windows of their
-central-heated, sound-proofed, dead-bolted, suffocating little nests
-into the howling gale thinking "what do they know that I do not know?"
-when they see us under a lean-to hunched over our laptops to shield
-them from the rain laughing our asses off as we write great code
-between bong hits.... what was the question?
- -- Ken Tilton
-%
-Shut up! (That last phrase has four or more syllables if pronounced as
-intended.)
- -- Ken Tilton
-%
-Nonsense. You'll be using it for the GUI, not protein-folding.
- -- Ken Tilton
- (responding to a comment that LTK was slow because it
- was based on TK)
-%
-Continuations certainly are clever, but if we learned anything from the
-rejection of the cover art for "Smell the Glove", it is that "there is a
-fine line between stupid... and clever".
- -- Ken Tilton
-%
-Ah, there's no place like academia for dispassionate, intellectually
-honest discussion of new ideas on their merits. Thank god for tenure
-giving your bold antagonist the protection they needed to shout down
-your iconoclastic..... hang on...
- -- Ken Tilton
-%
-Whoever objected must be in my killfile, ...
- -- Ken Tilton
-%
-From memory (but I think I have it right):
-
-"But Jesus said, Suffer captured variables, and forbid them not, to come
-unto thine macro bodies: for of such is are DSLs made."
- -- Ken Tilton
-
-Can I get an Amen?
-%
-Awareness of defect is the first step to recovery.
- -- Ken Tilton
-%
-You made a bad analogy (there are no good ones, but you found a new
-low) ...
- -- Ken Tilton
-%
-Yes, it is true that Kent Pitman was raised by a closet full of Lisp
-Machines, but the exception only proves the rule.
- -- Ken Tilton
- (in a postscript after positing that computer
- languages are not learned in infancy)
-%
-I suggest you try bartender's school to support yourself, start
-programming for fun again.
- -- Ken Tilton
- (responding to a comment that 98% of anything to do
- with computers was not interesting code)
-%
-You could add four lanes to my carpal tunnel and I still could not
-write all the code I am dying to write.
- -- Ken Tilton
-%
-Neutrality? I want to bury other languages, not have a gateway to them.
- -- Ken Tilton
-%
-Ken: "Cute puppy. Did you get it for companionship or to pick up chicks?"
-Simon: "Hunh? My puppy /always/ gives me companionship."
- -- Ken Tilton
- (on how he was understood by a native english speaker)
-%
(DIR) diff --git a/3rdparties/software/flexi-streams-20190107-git/test/tilton_utf8_cr.txt b/3rdparties/software/flexi-streams-20190107-git/test/tilton_utf8_cr.txt
@@ -1 +0,0 @@
-Programmers who lock onto a design decision and cling to it in the face ofcontradictory new information -- well, that's almost everyone in myexperience, so I better not say what I think of them or people will startsaying bad things about me on c.l.l. -- Ken Tilton%This reminds me of the NYC cabby who accepted a fare to Chicago. Whenthey got there and could not find the friend who was supposed to pay thefare he just laughed and said he should have known. -- Ken Tilton%>> Actually, I believe that Aikido, Jazz and Lisp are different appearances>> of the same thing.Yes, the Tao. /Everything/ is a different appearance of the tao. -- Ken Tilton"Ken, I went to the library and read up on Buddhism, and believe me, youare no Buddhist." -- Kenny's mom%That absolutely terrifies the herd-following, lockstep-marching,mainstream-saluting cowards that obediently dash out or online toscoop up books on The Latest Thing. They learn and use atrocities likeJava, C++, XML, and even Python for the security it gives them andthen sit there slaving away miserably, tediously, joylously paying offmortgages and supporting ungrateful teenagers who despise them, onlyto look out the double-sealed thermo-pane windows of theircentral-heated, sound-proofed, dead-bolted, suffocating little nestsinto the howling gale thinking "what do they know that I do not know?"when they see us under a lean-to hunched over our laptops to shieldthem from the rain laughing our asses off as we write great codebetween bong hits.... what was the question? -- Ken Tilton%Shut up! (That last phrase has four or more syllables if pronounced asintended.) -- Ken Tilton%Nonsense. You'll be using it for the GUI, not protein-folding. -- Ken Tilton (responding to a comment that LTK was slow because it was based on TK)%Continuations certainly are clever, but if we learned anything from therejection of the cover art for "Smell the Glove", it is that "there is afine line between stupid... and clever". -- Ken Tilton%Ah, there's no place like academia for dispassionate, intellectuallyhonest discussion of new ideas on their merits. Thank god for tenuregiving your bold antagonist the protection they needed to shout downyour iconoclastic..... hang on... -- Ken Tilton%Whoever objected must be in my killfile, ... -- Ken Tilton%From memory (but I think I have it right):"But Jesus said, Suffer captured variables, and forbid them not, to comeunto thine macro bodies: for of such is are DSLs made." -- Ken TiltonCan I get an Amen?%Awareness of defect is the first step to recovery. -- Ken Tilton%You made a bad analogy (there are no good ones, but you found a newlow) ... -- Ken Tilton%Yes, it is true that Kent Pitman was raised by a closet full of LispMachines, but the exception only proves the rule. -- Ken Tilton (in a postscript after positing that computer languages are not learned in infancy)%I suggest you try bartender's school to support yourself, startprogramming for fun again. -- Ken Tilton (responding to a comment that 98% of anything to do with computers was not interesting code)%You could add four lanes to my carpal tunnel and I still could notwrite all the code I am dying to write. -- Ken Tilton%Neutrality? I want to bury other languages, not have a gateway to them. -- Ken Tilton%Ken: "Cute puppy. Did you get it for companionship or to pick up chicks?"Simon: "Hunh? My puppy /always/ gives me companionship." -- Ken Tilton (on how he was understood by a native english speaker)%
-\ No newline at end of file
(DIR) diff --git a/3rdparties/software/flexi-streams-20190107-git/test/tilton_utf8_crlf.txt b/3rdparties/software/flexi-streams-20190107-git/test/tilton_utf8_crlf.txt
@@ -1,96 +0,0 @@
-Programmers who lock onto a design decision and cling to it in the face of
-contradictory new information -- well, that's almost everyone in my
-experience, so I better not say what I think of them or people will start
-saying bad things about me on c.l.l.
- -- Ken Tilton
-%
-This reminds me of the NYC cabby who accepted a fare to Chicago. When
-they got there and could not find the friend who was supposed to pay the
-fare he just laughed and said he should have known.
- -- Ken Tilton
-%
->> Actually, I believe that Aikido, Jazz and Lisp are different appearances
->> of the same thing.
-Yes, the Tao. /Everything/ is a different appearance of the tao.
- -- Ken Tilton
-
-"Ken, I went to the library and read up on Buddhism, and believe me, you
-are no Buddhist."
- -- Kenny's mom
-%
-That absolutely terrifies the herd-following, lockstep-marching,
-mainstream-saluting cowards that obediently dash out or online to
-scoop up books on The Latest Thing. They learn and use atrocities like
-Java, C++, XML, and even Python for the security it gives them and
-then sit there slaving away miserably, tediously, joylously paying off
-mortgages and supporting ungrateful teenagers who despise them, only
-to look out the double-sealed thermo-pane windows of their
-central-heated, sound-proofed, dead-bolted, suffocating little nests
-into the howling gale thinking "what do they know that I do not know?"
-when they see us under a lean-to hunched over our laptops to shield
-them from the rain laughing our asses off as we write great code
-between bong hits.... what was the question?
- -- Ken Tilton
-%
-Shut up! (That last phrase has four or more syllables if pronounced as
-intended.)
- -- Ken Tilton
-%
-Nonsense. You'll be using it for the GUI, not protein-folding.
- -- Ken Tilton
- (responding to a comment that LTK was slow because it
- was based on TK)
-%
-Continuations certainly are clever, but if we learned anything from the
-rejection of the cover art for "Smell the Glove", it is that "there is a
-fine line between stupid... and clever".
- -- Ken Tilton
-%
-Ah, there's no place like academia for dispassionate, intellectually
-honest discussion of new ideas on their merits. Thank god for tenure
-giving your bold antagonist the protection they needed to shout down
-your iconoclastic..... hang on...
- -- Ken Tilton
-%
-Whoever objected must be in my killfile, ...
- -- Ken Tilton
-%
-From memory (but I think I have it right):
-
-"But Jesus said, Suffer captured variables, and forbid them not, to come
-unto thine macro bodies: for of such is are DSLs made."
- -- Ken Tilton
-
-Can I get an Amen?
-%
-Awareness of defect is the first step to recovery.
- -- Ken Tilton
-%
-You made a bad analogy (there are no good ones, but you found a new
-low) ...
- -- Ken Tilton
-%
-Yes, it is true that Kent Pitman was raised by a closet full of Lisp
-Machines, but the exception only proves the rule.
- -- Ken Tilton
- (in a postscript after positing that computer
- languages are not learned in infancy)
-%
-I suggest you try bartender's school to support yourself, start
-programming for fun again.
- -- Ken Tilton
- (responding to a comment that 98% of anything to do
- with computers was not interesting code)
-%
-You could add four lanes to my carpal tunnel and I still could not
-write all the code I am dying to write.
- -- Ken Tilton
-%
-Neutrality? I want to bury other languages, not have a gateway to them.
- -- Ken Tilton
-%
-Ken: "Cute puppy. Did you get it for companionship or to pick up chicks?"
-Simon: "Hunh? My puppy /always/ gives me companionship."
- -- Ken Tilton
- (on how he was understood by a native english speaker)
-%
(DIR) diff --git a/3rdparties/software/flexi-streams-20190107-git/test/tilton_utf8_lf.txt b/3rdparties/software/flexi-streams-20190107-git/test/tilton_utf8_lf.txt
@@ -1,96 +0,0 @@
-Programmers who lock onto a design decision and cling to it in the face of
-contradictory new information -- well, that's almost everyone in my
-experience, so I better not say what I think of them or people will start
-saying bad things about me on c.l.l.
- -- Ken Tilton
-%
-This reminds me of the NYC cabby who accepted a fare to Chicago. When
-they got there and could not find the friend who was supposed to pay the
-fare he just laughed and said he should have known.
- -- Ken Tilton
-%
->> Actually, I believe that Aikido, Jazz and Lisp are different appearances
->> of the same thing.
-Yes, the Tao. /Everything/ is a different appearance of the tao.
- -- Ken Tilton
-
-"Ken, I went to the library and read up on Buddhism, and believe me, you
-are no Buddhist."
- -- Kenny's mom
-%
-That absolutely terrifies the herd-following, lockstep-marching,
-mainstream-saluting cowards that obediently dash out or online to
-scoop up books on The Latest Thing. They learn and use atrocities like
-Java, C++, XML, and even Python for the security it gives them and
-then sit there slaving away miserably, tediously, joylously paying off
-mortgages and supporting ungrateful teenagers who despise them, only
-to look out the double-sealed thermo-pane windows of their
-central-heated, sound-proofed, dead-bolted, suffocating little nests
-into the howling gale thinking "what do they know that I do not know?"
-when they see us under a lean-to hunched over our laptops to shield
-them from the rain laughing our asses off as we write great code
-between bong hits.... what was the question?
- -- Ken Tilton
-%
-Shut up! (That last phrase has four or more syllables if pronounced as
-intended.)
- -- Ken Tilton
-%
-Nonsense. You'll be using it for the GUI, not protein-folding.
- -- Ken Tilton
- (responding to a comment that LTK was slow because it
- was based on TK)
-%
-Continuations certainly are clever, but if we learned anything from the
-rejection of the cover art for "Smell the Glove", it is that "there is a
-fine line between stupid... and clever".
- -- Ken Tilton
-%
-Ah, there's no place like academia for dispassionate, intellectually
-honest discussion of new ideas on their merits. Thank god for tenure
-giving your bold antagonist the protection they needed to shout down
-your iconoclastic..... hang on...
- -- Ken Tilton
-%
-Whoever objected must be in my killfile, ...
- -- Ken Tilton
-%
-From memory (but I think I have it right):
-
-"But Jesus said, Suffer captured variables, and forbid them not, to come
-unto thine macro bodies: for of such is are DSLs made."
- -- Ken Tilton
-
-Can I get an Amen?
-%
-Awareness of defect is the first step to recovery.
- -- Ken Tilton
-%
-You made a bad analogy (there are no good ones, but you found a new
-low) ...
- -- Ken Tilton
-%
-Yes, it is true that Kent Pitman was raised by a closet full of Lisp
-Machines, but the exception only proves the rule.
- -- Ken Tilton
- (in a postscript after positing that computer
- languages are not learned in infancy)
-%
-I suggest you try bartender's school to support yourself, start
-programming for fun again.
- -- Ken Tilton
- (responding to a comment that 98% of anything to do
- with computers was not interesting code)
-%
-You could add four lanes to my carpal tunnel and I still could not
-write all the code I am dying to write.
- -- Ken Tilton
-%
-Neutrality? I want to bury other languages, not have a gateway to them.
- -- Ken Tilton
-%
-Ken: "Cute puppy. Did you get it for companionship or to pick up chicks?"
-Simon: "Hunh? My puppy /always/ gives me companionship."
- -- Ken Tilton
- (on how he was understood by a native english speaker)
-%
(DIR) diff --git a/3rdparties/software/flexi-streams-20190107-git/test/unicode_demo_ucs2_cr_be.txt b/3rdparties/software/flexi-streams-20190107-git/test/unicode_demo_ucs2_cr_be.txt
Binary files differ.
(DIR) diff --git a/3rdparties/software/flexi-streams-20190107-git/test/unicode_demo_ucs2_cr_le.txt b/3rdparties/software/flexi-streams-20190107-git/test/unicode_demo_ucs2_cr_le.txt
Binary files differ.
(DIR) diff --git a/3rdparties/software/flexi-streams-20190107-git/test/unicode_demo_ucs2_crlf_be.txt b/3rdparties/software/flexi-streams-20190107-git/test/unicode_demo_ucs2_crlf_be.txt
Binary files differ.
(DIR) diff --git a/3rdparties/software/flexi-streams-20190107-git/test/unicode_demo_ucs2_crlf_le.txt b/3rdparties/software/flexi-streams-20190107-git/test/unicode_demo_ucs2_crlf_le.txt
Binary files differ.
(DIR) diff --git a/3rdparties/software/flexi-streams-20190107-git/test/unicode_demo_ucs2_lf_be.txt b/3rdparties/software/flexi-streams-20190107-git/test/unicode_demo_ucs2_lf_be.txt
Binary files differ.
(DIR) diff --git a/3rdparties/software/flexi-streams-20190107-git/test/unicode_demo_ucs2_lf_le.txt b/3rdparties/software/flexi-streams-20190107-git/test/unicode_demo_ucs2_lf_le.txt
Binary files differ.
(DIR) diff --git a/3rdparties/software/flexi-streams-20190107-git/test/unicode_demo_ucs4_cr_be.txt b/3rdparties/software/flexi-streams-20190107-git/test/unicode_demo_ucs4_cr_be.txt
Binary files differ.
(DIR) diff --git a/3rdparties/software/flexi-streams-20190107-git/test/unicode_demo_ucs4_cr_le.txt b/3rdparties/software/flexi-streams-20190107-git/test/unicode_demo_ucs4_cr_le.txt
Binary files differ.
(DIR) diff --git a/3rdparties/software/flexi-streams-20190107-git/test/unicode_demo_ucs4_crlf_be.txt b/3rdparties/software/flexi-streams-20190107-git/test/unicode_demo_ucs4_crlf_be.txt
Binary files differ.
(DIR) diff --git a/3rdparties/software/flexi-streams-20190107-git/test/unicode_demo_ucs4_crlf_le.txt b/3rdparties/software/flexi-streams-20190107-git/test/unicode_demo_ucs4_crlf_le.txt
Binary files differ.
(DIR) diff --git a/3rdparties/software/flexi-streams-20190107-git/test/unicode_demo_ucs4_lf_be.txt b/3rdparties/software/flexi-streams-20190107-git/test/unicode_demo_ucs4_lf_be.txt
Binary files differ.
(DIR) diff --git a/3rdparties/software/flexi-streams-20190107-git/test/unicode_demo_ucs4_lf_le.txt b/3rdparties/software/flexi-streams-20190107-git/test/unicode_demo_ucs4_lf_le.txt
Binary files differ.
(DIR) diff --git a/3rdparties/software/flexi-streams-20190107-git/test/unicode_demo_utf8_cr.txt b/3rdparties/software/flexi-streams-20190107-git/test/unicode_demo_utf8_cr.txt
@@ -1 +0,0 @@
-UTF-8 encoded sample plain-text file‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾Markus Kuhn [ˈmaʳkʊs kuːn] <http://www.cl.cam.ac.uk/~mgk25/> — 2002-07-25The ASCII compatible UTF-8 encoding used in this plain-text fileis defined in Unicode, ISO 10646-1, and RFC 2279.Using Unicode/UTF-8, you can write in emails and source code things such asMathematics and sciences: ∮ E⋅da = Q, n → ∞, ∑ f(i) = ∏ g(i), ⎧⎡⎛┌─────┐⎞⎤⎫ ⎪⎢⎜│a²+b³ ⎟⎥⎪ ∀x∈ℝ: ⌈x⌉ = −⌊−x⌋, α ∧ ¬β = ¬(¬α ∨ β), ⎪⎢⎜│───── ⎟⎥⎪ ⎪⎢⎜⎷ c₈ ⎟⎥⎪ ℕ ⊆ ℕ₀ ⊂ ℤ ⊂ ℚ ⊂ ℝ ⊂ ℂ, ⎨⎢⎜ ⎟⎥⎬ ⎪⎢⎜ ∞ ⎟⎥⎪ ⊥ < a ≠ b ≡ c ≤ d ≪ ⊤ ⇒ (⟦A⟧ ⇔ ⟪B⟫), ⎪⎢⎜ ⎲ ⎟⎥⎪ ⎪⎢⎜ ⎳aⁱ-bⁱ⎟⎥⎪ 2H₂ + O₂ ⇌ 2H₂O, R = 4.7 kΩ, ⌀ 200 mm ⎩⎣⎝i=1 ⎠⎦⎭Linguistics and dictionaries: ði ıntəˈnæʃənəl fəˈnɛtık əsoʊsiˈeıʃn Y [ˈʏpsilɔn], Yen [jɛn], Yoga [ˈjoːgɑ]APL: ((V⍳V)=⍳⍴V)/V←,V ⌷←⍳→⍴∆∇⊃‾⍎⍕⌈Nicer typography in plain text files: ╔══════════════════════════════════════════╗ ║ ║ ║ • ‘single’ and “double” quotes ║ ║ ║ ║ • Curly apostrophes: “We’ve been here” ║ ║ ║ ║ • Latin-1 apostrophe and accents: '´` ║ ║ ║ ║ • ‚deutsche‘ „Anführungszeichen“ ║ ║ ║ ║ • †, ‡, ‰, •, 3–4, —, −5/+5, ™, … ║ ║ ║ ║ • ASCII safety test: 1lI|, 0OD, 8B ║ ║ ╭─────────╮ ║ ║ • the euro symbol: │ 14.95 € │ ║ ║ ╰─────────╯ ║ ╚══════════════════════════════════════════╝Combining characters: STARGΛ̊TE SG-1, a = v̇ = r̈, a⃑ ⊥ b⃑Greek (in Polytonic): The Greek anthem: Σὲ γνωρίζω ἀπὸ τὴν κόψη τοῦ σπαθιοῦ τὴν τρομερή, σὲ γνωρίζω ἀπὸ τὴν ὄψη ποὺ μὲ βία μετράει τὴ γῆ. ᾿Απ᾿ τὰ κόκκαλα βγαλμένη τῶν ῾Ελλήνων τὰ ἱερά καὶ σὰν πρῶτα ἀνδρειωμένη χαῖρε, ὦ χαῖρε, ᾿Ελευθεριά! From a speech of Demosthenes in the 4th century BC: Οὐχὶ ταὐτὰ παρίσταταί μοι γιγνώσκειν, ὦ ἄνδρες ᾿Αθηναῖοι, ὅταν τ᾿ εἰς τὰ πράγματα ἀποβλέψω καὶ ὅταν πρὸς τοὺς λόγους οὓς ἀκούω· τοὺς μὲν γὰρ λόγους περὶ τοῦ τιμωρήσασθαι Φίλιππον ὁρῶ γιγνομένους, τὰ δὲ πράγματ᾿ εἰς τοῦτο προήκοντα, ὥσθ᾿ ὅπως μὴ πεισόμεθ᾿ αὐτοὶ πρότερον κακῶς σκέψασθαι δέον. οὐδέν οὖν ἄλλο μοι δοκοῦσιν οἱ τὰ τοιαῦτα λέγοντες ἢ τὴν ὑπόθεσιν, περὶ ἧς βουλεύεσθαι, οὐχὶ τὴν οὖσαν παριστάντες ὑμῖν ἁμαρτάνειν. ἐγὼ δέ, ὅτι μέν ποτ᾿ ἐξῆν τῇ πόλει καὶ τὰ αὑτῆς ἔχειν ἀσφαλῶς καὶ Φίλιππον τιμωρήσασθαι, καὶ μάλ᾿ ἀκριβῶς οἶδα· ἐπ᾿ ἐμοῦ γάρ, οὐ πάλαι γέγονεν ταῦτ᾿ ἀμφότερα· νῦν μέντοι πέπεισμαι τοῦθ᾿ ἱκανὸν προλαβεῖν ἡμῖν εἶναι τὴν πρώτην, ὅπως τοὺς συμμάχους σώσομεν. ἐὰν γὰρ τοῦτο βεβαίως ὑπάρξῃ, τότε καὶ περὶ τοῦ τίνα τιμωρήσεταί τις καὶ ὃν τρόπον ἐξέσται σκοπεῖν· πρὶν δὲ τὴν ἀρχὴν ὀρθῶς ὑποθέσθαι, μάταιον ἡγοῦμαι περὶ τῆς τελευτῆς ὁντινοῦν ποιεῖσθαι λόγον. Δημοσθένους, Γ´ ᾿ΟλυνθιακὸςGeorgian: From a Unicode conference invitation: გთხოვთ ახლავე გაიაროთ რეგისტრაცია Unicode-ის მეათე საერთაშორისო კონფერენციაზე დასასწრებად, რომელიც გაიმართება 10-12 მარტს, ქ. მაინცში, გერმანიაში. კონფერენცია შეჰკრებს ერთად მსოფლიოს ექსპერტებს ისეთ დარგებში როგორიცაა ინტერნეტი და Unicode-ი, ინტერნაციონალიზაცია და ლოკალიზაცია, Unicode-ის გამოყენება ოპერაციულ სისტემებსა, და გამოყენებით პროგრამებში, შრიფტებში, ტექსტების დამუშავებასა და მრავალენოვან კომპიუტერულ სისტემებში.Russian: From a Unicode conference invitation: Зарегистрируйтесь сейчас на Десятую Международную Конференцию по Unicode, которая состоится 10-12 марта 1997 года в Майнце в Германии. Конференция соберет широкий круг экспертов по вопросам глобального Интернета и Unicode, локализации и интернационализации, воплощению и применению Unicode в различных операционных системах и программных приложениях, шрифтах, верстке и многоязычных компьютерных системах.Thai (UCS Level 2): Excerpt from a poetry on The Romance of The Three Kingdoms (a Chinese classic 'San Gua'): [----------------------------|------------------------] ๏ แผ่นดินฮั่นเสื่อมโทรมแสนสังเวช พระปกเกศกองบู๊กู้ขึ้นใหม่ สิบสองกษัตริย์ก่อนหน้าแลถัดไป สององค์ไซร้โง่เขลาเบาปัญญา ทรงนับถือขันทีเป็นที่พึ่ง บ้านเมืองจึงวิปริตเป็นนักหนา โฮจิ๋นเรียกทัพทั่วหัวเมืองมา หมายจะฆ่ามดชั่วตัวสำคัญ เหมือนขับไสไล่เสือจากเคหา รับหมาป่าเข้ามาเลยอาสัญ ฝ่ายอ้องอุ้นยุแยกให้แตกกัน ใช้สาวนั้นเป็นชนวนชื่นชวนใจ พลันลิฉุยกุยกีกลับก่อเหตุ ช่างอาเพศจริงหนาฟ้าร้องไห้ ต้องรบราฆ่าฟันจนบรรลัย ฤๅหาใครค้ำชูกู้บรรลังก์ ฯ (The above is a two-column text. If combining characters are handled correctly, the lines of the second column should be aligned with the | character above.)Ethiopian: Proverbs in the Amharic language: ሰማይ አይታረስ ንጉሥ አይከሰስ። ብላ ካለኝ እንደአባቴ በቆመጠኝ። ጌጥ ያለቤቱ ቁምጥና ነው። ደሀ በሕልሙ ቅቤ ባይጠጣ ንጣት በገደለው። የአፍ ወለምታ በቅቤ አይታሽም። አይጥ በበላ ዳዋ ተመታ። ሲተረጉሙ ይደረግሙ። ቀስ በቀስ፥ ዕንቁላል በእግሩ ይሄዳል። ድር ቢያብር አንበሳ ያስር። ሰው እንደቤቱ እንጅ እንደ ጉረቤቱ አይተዳደርም። እግዜር የከፈተውን ጉሮሮ ሳይዘጋው አይድርም። የጎረቤት ሌባ፥ ቢያዩት ይስቅ ባያዩት ያጠልቅ። ሥራ ከመፍታት ልጄን ላፋታት። ዓባይ ማደሪያ የለው፥ ግንድ ይዞ ይዞራል። የእስላም አገሩ መካ የአሞራ አገሩ ዋርካ። ተንጋሎ ቢተፉ ተመልሶ ባፉ። ወዳጅህ ማር ቢሆን ጨርስህ አትላሰው። እግርህን በፍራሽህ ልክ ዘርጋ።Runes: ᚻᛖ ᚳᚹᚫᚦ ᚦᚫᛏ ᚻᛖ ᛒᚢᛞᛖ ᚩᚾ ᚦᚫᛗ ᛚᚪᚾᛞᛖ ᚾᚩᚱᚦᚹᛖᚪᚱᛞᚢᛗ ᚹᛁᚦ ᚦᚪ ᚹᛖᛥᚫ (Old English, which transcribed into Latin reads 'He cwaeth that he bude thaem lande northweardum with tha Westsae.' and means 'He said that he lived in the northern land near the Western Sea.')Braille: ⡌⠁⠧⠑ ⠼⠁⠒ ⡍⠜⠇⠑⠹⠰⠎ ⡣⠕⠌ ⡍⠜⠇⠑⠹ ⠺⠁⠎ ⠙⠑⠁⠙⠒ ⠞⠕ ⠃⠑⠛⠔ ⠺⠊⠹⠲ ⡹⠻⠑ ⠊⠎ ⠝⠕ ⠙⠳⠃⠞ ⠱⠁⠞⠑⠧⠻ ⠁⠃⠳⠞ ⠹⠁⠞⠲ ⡹⠑ ⠗⠑⠛⠊⠌⠻ ⠕⠋ ⠙⠊⠎ ⠃⠥⠗⠊⠁⠇ ⠺⠁⠎ ⠎⠊⠛⠝⠫ ⠃⠹ ⠹⠑ ⠊⠇⠻⠛⠹⠍⠁⠝⠂ ⠹⠑ ⠊⠇⠻⠅⠂ ⠹⠑ ⠥⠝⠙⠻⠞⠁⠅⠻⠂ ⠁⠝⠙ ⠹⠑ ⠡⠊⠑⠋ ⠍⠳⠗⠝⠻⠲ ⡎⠊⠗⠕⠕⠛⠑ ⠎⠊⠛⠝⠫ ⠊⠞⠲ ⡁⠝⠙ ⡎⠊⠗⠕⠕⠛⠑⠰⠎ ⠝⠁⠍⠑ ⠺⠁⠎ ⠛⠕⠕⠙ ⠥⠏⠕⠝ ⠰⡡⠁⠝⠛⠑⠂ ⠋⠕⠗ ⠁⠝⠹⠹⠔⠛ ⠙⠑ ⠡⠕⠎⠑ ⠞⠕ ⠏⠥⠞ ⠙⠊⠎ ⠙⠁⠝⠙ ⠞⠕⠲ ⡕⠇⠙ ⡍⠜⠇⠑⠹ ⠺⠁⠎ ⠁⠎ ⠙⠑⠁⠙ ⠁⠎ ⠁ ⠙⠕⠕⠗⠤⠝⠁⠊⠇⠲ ⡍⠔⠙⠖ ⡊ ⠙⠕⠝⠰⠞ ⠍⠑⠁⠝ ⠞⠕ ⠎⠁⠹ ⠹⠁⠞ ⡊ ⠅⠝⠪⠂ ⠕⠋ ⠍⠹ ⠪⠝ ⠅⠝⠪⠇⠫⠛⠑⠂ ⠱⠁⠞ ⠹⠻⠑ ⠊⠎ ⠏⠜⠞⠊⠊⠥⠇⠜⠇⠹ ⠙⠑⠁⠙ ⠁⠃⠳⠞ ⠁ ⠙⠕⠕⠗⠤⠝⠁⠊⠇⠲ ⡊ ⠍⠊⠣⠞ ⠙⠁⠧⠑ ⠃⠑⠲ ⠔⠊⠇⠔⠫⠂ ⠍⠹⠎⠑⠇⠋⠂ ⠞⠕ ⠗⠑⠛⠜⠙ ⠁ ⠊⠕⠋⠋⠔⠤⠝⠁⠊⠇ ⠁⠎ ⠹⠑ ⠙⠑⠁⠙⠑⠌ ⠏⠊⠑⠊⠑ ⠕⠋ ⠊⠗⠕⠝⠍⠕⠝⠛⠻⠹ ⠔ ⠹⠑ ⠞⠗⠁⠙⠑⠲ ⡃⠥⠞ ⠹⠑ ⠺⠊⠎⠙⠕⠍ ⠕⠋ ⠳⠗ ⠁⠝⠊⠑⠌⠕⠗⠎ ⠊⠎ ⠔ ⠹⠑ ⠎⠊⠍⠊⠇⠑⠆ ⠁⠝⠙ ⠍⠹ ⠥⠝⠙⠁⠇⠇⠪⠫ ⠙⠁⠝⠙⠎ ⠩⠁⠇⠇ ⠝⠕⠞ ⠙⠊⠌⠥⠗⠃ ⠊⠞⠂ ⠕⠗ ⠹⠑ ⡊⠳⠝⠞⠗⠹⠰⠎ ⠙⠕⠝⠑ ⠋⠕⠗⠲ ⡹⠳ ⠺⠊⠇⠇ ⠹⠻⠑⠋⠕⠗⠑ ⠏⠻⠍⠊⠞ ⠍⠑ ⠞⠕ ⠗⠑⠏⠑⠁⠞⠂ ⠑⠍⠏⠙⠁⠞⠊⠊⠁⠇⠇⠹⠂ ⠹⠁⠞ ⡍⠜⠇⠑⠹ ⠺⠁⠎ ⠁⠎ ⠙⠑⠁⠙ ⠁⠎ ⠁ ⠙⠕⠕⠗⠤⠝⠁⠊⠇⠲ (The first couple of paragraphs of "A Christmas Carol" by Dickens)Compact font selection example text: ABCDEFGHIJKLMNOPQRSTUVWXYZ /0123456789 abcdefghijklmnopqrstuvwxyz £©µÀÆÖÞßéöÿ –—‘“”„†•…‰™œŠŸž€ ΑΒΓΔΩαβγδω АБВГДабвгд ∀∂∈ℝ∧∪≡∞ ↑↗↨↻⇣ ┐┼╔╘░►☺♀ fi�⑀₂ἠḂӥẄɐː⍎אԱაGreetings in various languages: Hello world, Καλημέρα κόσμε, コンニチハBox drawing alignment tests: █ ▉ ╔══╦══╗ ┌──┬──┐ ╭──┬──╮ ╭──┬──╮ ┏━━┳━━┓ ┎┒┏┑ ╷ ╻ ┏┯┓ ┌┰┐ ▊ ╱╲╱╲╳╳╳ ║┌─╨─┐║ │╔═╧═╗│ │╒═╪═╕│ │╓─╁─╖│ ┃┌─╂─┐┃ ┗╃╄┙ ╶┼╴╺╋╸┠┼┨ ┝╋┥ ▋ ╲╱╲╱╳╳╳ ║│╲ ╱│║ │║ ║│ ││ │ ││ │║ ┃ ║│ ┃│ ╿ │┃ ┍╅╆┓ ╵ ╹ ┗┷┛ └┸┘ ▌ ╱╲╱╲╳╳╳ ╠╡ ╳ ╞╣ ├╢ ╟┤ ├┼─┼─┼┤ ├╫─╂─╫┤ ┣┿╾┼╼┿┫ ┕┛┖┚ ┌┄┄┐ ╎ ┏┅┅┓ ┋ ▍ ╲╱╲╱╳╳╳ ║│╱ ╲│║ │║ ║│ ││ │ ││ │║ ┃ ║│ ┃│ ╽ │┃ ░░▒▒▓▓██ ┊ ┆ ╎ ╏ ┇ ┋ ▎ ║└─╥─┘║ │╚═╤═╝│ │╘═╪═╛│ │╙─╀─╜│ ┃└─╂─┘┃ ░░▒▒▓▓██ ┊ ┆ ╎ ╏ ┇ ┋ ▏ ╚══╩══╝ └──┴──┘ ╰──┴──╯ ╰──┴──╯ ┗━━┻━━┛ ▗▄▖▛▀▜ └╌╌┘ ╎ ┗╍╍┛ ┋ ▁▂▃▄▅▆▇█ ▝▀▘▙▄▟
-\ No newline at end of file
(DIR) diff --git a/3rdparties/software/flexi-streams-20190107-git/test/unicode_demo_utf8_crlf.txt b/3rdparties/software/flexi-streams-20190107-git/test/unicode_demo_utf8_crlf.txt
@@ -1,212 +0,0 @@
-
-UTF-8 encoded sample plain-text file
-‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾
-
-Markus Kuhn [ˈmaʳkʊs kuːn] <http://www.cl.cam.ac.uk/~mgk25/> — 2002-07-25
-
-
-The ASCII compatible UTF-8 encoding used in this plain-text file
-is defined in Unicode, ISO 10646-1, and RFC 2279.
-
-
-Using Unicode/UTF-8, you can write in emails and source code things such as
-
-Mathematics and sciences:
-
- ∮ E⋅da = Q, n → ∞, ∑ f(i) = ∏ g(i), ⎧⎡⎛┌─────┐⎞⎤⎫
- ⎪⎢⎜│a²+b³ ⎟⎥⎪
- ∀x∈ℝ: ⌈x⌉ = −⌊−x⌋, α ∧ ¬β = ¬(¬α ∨ β), ⎪⎢⎜│───── ⎟⎥⎪
- ⎪⎢⎜⎷ c₈ ⎟⎥⎪
- ℕ ⊆ ℕ₀ ⊂ ℤ ⊂ ℚ ⊂ ℝ ⊂ ℂ, ⎨⎢⎜ ⎟⎥⎬
- ⎪⎢⎜ ∞ ⎟⎥⎪
- ⊥ < a ≠ b ≡ c ≤ d ≪ ⊤ ⇒ (⟦A⟧ ⇔ ⟪B⟫), ⎪⎢⎜ ⎲ ⎟⎥⎪
- ⎪⎢⎜ ⎳aⁱ-bⁱ⎟⎥⎪
- 2H₂ + O₂ ⇌ 2H₂O, R = 4.7 kΩ, ⌀ 200 mm ⎩⎣⎝i=1 ⎠⎦⎭
-
-Linguistics and dictionaries:
-
- ði ıntəˈnæʃənəl fəˈnɛtık əsoʊsiˈeıʃn
- Y [ˈʏpsilɔn], Yen [jɛn], Yoga [ˈjoːgɑ]
-
-APL:
-
- ((V⍳V)=⍳⍴V)/V←,V ⌷←⍳→⍴∆∇⊃‾⍎⍕⌈
-
-Nicer typography in plain text files:
-
- ╔══════════════════════════════════════════╗
- ║ ║
- ║ • ‘single’ and “double” quotes ║
- ║ ║
- ║ • Curly apostrophes: “We’ve been here” ║
- ║ ║
- ║ • Latin-1 apostrophe and accents: '´` ║
- ║ ║
- ║ • ‚deutsche‘ „Anführungszeichen“ ║
- ║ ║
- ║ • †, ‡, ‰, •, 3–4, —, −5/+5, ™, … ║
- ║ ║
- ║ • ASCII safety test: 1lI|, 0OD, 8B ║
- ║ ╭─────────╮ ║
- ║ • the euro symbol: │ 14.95 € │ ║
- ║ ╰─────────╯ ║
- ╚══════════════════════════════════════════╝
-
-Combining characters:
-
- STARGΛ̊TE SG-1, a = v̇ = r̈, a⃑ ⊥ b⃑
-
-Greek (in Polytonic):
-
- The Greek anthem:
-
- Σὲ γνωρίζω ἀπὸ τὴν κόψη
- τοῦ σπαθιοῦ τὴν τρομερή,
- σὲ γνωρίζω ἀπὸ τὴν ὄψη
- ποὺ μὲ βία μετράει τὴ γῆ.
-
- ᾿Απ᾿ τὰ κόκκαλα βγαλμένη
- τῶν ῾Ελλήνων τὰ ἱερά
- καὶ σὰν πρῶτα ἀνδρειωμένη
- χαῖρε, ὦ χαῖρε, ᾿Ελευθεριά!
-
- From a speech of Demosthenes in the 4th century BC:
-
- Οὐχὶ ταὐτὰ παρίσταταί μοι γιγνώσκειν, ὦ ἄνδρες ᾿Αθηναῖοι,
- ὅταν τ᾿ εἰς τὰ πράγματα ἀποβλέψω καὶ ὅταν πρὸς τοὺς
- λόγους οὓς ἀκούω· τοὺς μὲν γὰρ λόγους περὶ τοῦ
- τιμωρήσασθαι Φίλιππον ὁρῶ γιγνομένους, τὰ δὲ πράγματ᾿
- εἰς τοῦτο προήκοντα, ὥσθ᾿ ὅπως μὴ πεισόμεθ᾿ αὐτοὶ
- πρότερον κακῶς σκέψασθαι δέον. οὐδέν οὖν ἄλλο μοι δοκοῦσιν
- οἱ τὰ τοιαῦτα λέγοντες ἢ τὴν ὑπόθεσιν, περὶ ἧς βουλεύεσθαι,
- οὐχὶ τὴν οὖσαν παριστάντες ὑμῖν ἁμαρτάνειν. ἐγὼ δέ, ὅτι μέν
- ποτ᾿ ἐξῆν τῇ πόλει καὶ τὰ αὑτῆς ἔχειν ἀσφαλῶς καὶ Φίλιππον
- τιμωρήσασθαι, καὶ μάλ᾿ ἀκριβῶς οἶδα· ἐπ᾿ ἐμοῦ γάρ, οὐ πάλαι
- γέγονεν ταῦτ᾿ ἀμφότερα· νῦν μέντοι πέπεισμαι τοῦθ᾿ ἱκανὸν
- προλαβεῖν ἡμῖν εἶναι τὴν πρώτην, ὅπως τοὺς συμμάχους
- σώσομεν. ἐὰν γὰρ τοῦτο βεβαίως ὑπάρξῃ, τότε καὶ περὶ τοῦ
- τίνα τιμωρήσεταί τις καὶ ὃν τρόπον ἐξέσται σκοπεῖν· πρὶν δὲ
- τὴν ἀρχὴν ὀρθῶς ὑποθέσθαι, μάταιον ἡγοῦμαι περὶ τῆς
- τελευτῆς ὁντινοῦν ποιεῖσθαι λόγον.
-
- Δημοσθένους, Γ´ ᾿Ολυνθιακὸς
-
-Georgian:
-
- From a Unicode conference invitation:
-
- გთხოვთ ახლავე გაიაროთ რეგისტრაცია Unicode-ის მეათე საერთაშორისო
- კონფერენციაზე დასასწრებად, რომელიც გაიმართება 10-12 მარტს,
- ქ. მაინცში, გერმანიაში. კონფერენცია შეჰკრებს ერთად მსოფლიოს
- ექსპერტებს ისეთ დარგებში როგორიცაა ინტერნეტი და Unicode-ი,
- ინტერნაციონალიზაცია და ლოკალიზაცია, Unicode-ის გამოყენება
- ოპერაციულ სისტემებსა, და გამოყენებით პროგრამებში, შრიფტებში,
- ტექსტების დამუშავებასა და მრავალენოვან კომპიუტერულ სისტემებში.
-
-Russian:
-
- From a Unicode conference invitation:
-
- Зарегистрируйтесь сейчас на Десятую Международную Конференцию по
- Unicode, которая состоится 10-12 марта 1997 года в Майнце в Германии.
- Конференция соберет широкий круг экспертов по вопросам глобального
- Интернета и Unicode, локализации и интернационализации, воплощению и
- применению Unicode в различных операционных системах и программных
- приложениях, шрифтах, верстке и многоязычных компьютерных системах.
-
-Thai (UCS Level 2):
-
- Excerpt from a poetry on The Romance of The Three Kingdoms (a Chinese
- classic 'San Gua'):
-
- [----------------------------|------------------------]
- ๏ แผ่นดินฮั่นเสื่อมโทรมแสนสังเวช พระปกเกศกองบู๊กู้ขึ้นใหม่
- สิบสองกษัตริย์ก่อนหน้าแลถัดไป สององค์ไซร้โง่เขลาเบาปัญญา
- ทรงนับถือขันทีเป็นที่พึ่ง บ้านเมืองจึงวิปริตเป็นนักหนา
- โฮจิ๋นเรียกทัพทั่วหัวเมืองมา หมายจะฆ่ามดชั่วตัวสำคัญ
- เหมือนขับไสไล่เสือจากเคหา รับหมาป่าเข้ามาเลยอาสัญ
- ฝ่ายอ้องอุ้นยุแยกให้แตกกัน ใช้สาวนั้นเป็นชนวนชื่นชวนใจ
- พลันลิฉุยกุยกีกลับก่อเหตุ ช่างอาเพศจริงหนาฟ้าร้องไห้
- ต้องรบราฆ่าฟันจนบรรลัย ฤๅหาใครค้ำชูกู้บรรลังก์ ฯ
-
- (The above is a two-column text. If combining characters are handled
- correctly, the lines of the second column should be aligned with the
- | character above.)
-
-Ethiopian:
-
- Proverbs in the Amharic language:
-
- ሰማይ አይታረስ ንጉሥ አይከሰስ።
- ብላ ካለኝ እንደአባቴ በቆመጠኝ።
- ጌጥ ያለቤቱ ቁምጥና ነው።
- ደሀ በሕልሙ ቅቤ ባይጠጣ ንጣት በገደለው።
- የአፍ ወለምታ በቅቤ አይታሽም።
- አይጥ በበላ ዳዋ ተመታ።
- ሲተረጉሙ ይደረግሙ።
- ቀስ በቀስ፥ ዕንቁላል በእግሩ ይሄዳል።
- ድር ቢያብር አንበሳ ያስር።
- ሰው እንደቤቱ እንጅ እንደ ጉረቤቱ አይተዳደርም።
- እግዜር የከፈተውን ጉሮሮ ሳይዘጋው አይድርም።
- የጎረቤት ሌባ፥ ቢያዩት ይስቅ ባያዩት ያጠልቅ።
- ሥራ ከመፍታት ልጄን ላፋታት።
- ዓባይ ማደሪያ የለው፥ ግንድ ይዞ ይዞራል።
- የእስላም አገሩ መካ የአሞራ አገሩ ዋርካ።
- ተንጋሎ ቢተፉ ተመልሶ ባፉ።
- ወዳጅህ ማር ቢሆን ጨርስህ አትላሰው።
- እግርህን በፍራሽህ ልክ ዘርጋ።
-
-Runes:
-
- ᚻᛖ ᚳᚹᚫᚦ ᚦᚫᛏ ᚻᛖ ᛒᚢᛞᛖ ᚩᚾ ᚦᚫᛗ ᛚᚪᚾᛞᛖ ᚾᚩᚱᚦᚹᛖᚪᚱᛞᚢᛗ ᚹᛁᚦ ᚦᚪ ᚹᛖᛥᚫ
-
- (Old English, which transcribed into Latin reads 'He cwaeth that he
- bude thaem lande northweardum with tha Westsae.' and means 'He said
- that he lived in the northern land near the Western Sea.')
-
-Braille:
-
- ⡌⠁⠧⠑ ⠼⠁⠒ ⡍⠜⠇⠑⠹⠰⠎ ⡣⠕⠌
-
- ⡍⠜⠇⠑⠹ ⠺⠁⠎ ⠙⠑⠁⠙⠒ ⠞⠕ ⠃⠑⠛⠔ ⠺⠊⠹⠲ ⡹⠻⠑ ⠊⠎ ⠝⠕ ⠙⠳⠃⠞
- ⠱⠁⠞⠑⠧⠻ ⠁⠃⠳⠞ ⠹⠁⠞⠲ ⡹⠑ ⠗⠑⠛⠊⠌⠻ ⠕⠋ ⠙⠊⠎ ⠃⠥⠗⠊⠁⠇ ⠺⠁⠎
- ⠎⠊⠛⠝⠫ ⠃⠹ ⠹⠑ ⠊⠇⠻⠛⠹⠍⠁⠝⠂ ⠹⠑ ⠊⠇⠻⠅⠂ ⠹⠑ ⠥⠝⠙⠻⠞⠁⠅⠻⠂
- ⠁⠝⠙ ⠹⠑ ⠡⠊⠑⠋ ⠍⠳⠗⠝⠻⠲ ⡎⠊⠗⠕⠕⠛⠑ ⠎⠊⠛⠝⠫ ⠊⠞⠲ ⡁⠝⠙
- ⡎⠊⠗⠕⠕⠛⠑⠰⠎ ⠝⠁⠍⠑ ⠺⠁⠎ ⠛⠕⠕⠙ ⠥⠏⠕⠝ ⠰⡡⠁⠝⠛⠑⠂ ⠋⠕⠗ ⠁⠝⠹⠹⠔⠛ ⠙⠑
- ⠡⠕⠎⠑ ⠞⠕ ⠏⠥⠞ ⠙⠊⠎ ⠙⠁⠝⠙ ⠞⠕⠲
-
- ⡕⠇⠙ ⡍⠜⠇⠑⠹ ⠺⠁⠎ ⠁⠎ ⠙⠑⠁⠙ ⠁⠎ ⠁ ⠙⠕⠕⠗⠤⠝⠁⠊⠇⠲
-
- ⡍⠔⠙⠖ ⡊ ⠙⠕⠝⠰⠞ ⠍⠑⠁⠝ ⠞⠕ ⠎⠁⠹ ⠹⠁⠞ ⡊ ⠅⠝⠪⠂ ⠕⠋ ⠍⠹
- ⠪⠝ ⠅⠝⠪⠇⠫⠛⠑⠂ ⠱⠁⠞ ⠹⠻⠑ ⠊⠎ ⠏⠜⠞⠊⠊⠥⠇⠜⠇⠹ ⠙⠑⠁⠙ ⠁⠃⠳⠞
- ⠁ ⠙⠕⠕⠗⠤⠝⠁⠊⠇⠲ ⡊ ⠍⠊⠣⠞ ⠙⠁⠧⠑ ⠃⠑⠲ ⠔⠊⠇⠔⠫⠂ ⠍⠹⠎⠑⠇⠋⠂ ⠞⠕
- ⠗⠑⠛⠜⠙ ⠁ ⠊⠕⠋⠋⠔⠤⠝⠁⠊⠇ ⠁⠎ ⠹⠑ ⠙⠑⠁⠙⠑⠌ ⠏⠊⠑⠊⠑ ⠕⠋ ⠊⠗⠕⠝⠍⠕⠝⠛⠻⠹
- ⠔ ⠹⠑ ⠞⠗⠁⠙⠑⠲ ⡃⠥⠞ ⠹⠑ ⠺⠊⠎⠙⠕⠍ ⠕⠋ ⠳⠗ ⠁⠝⠊⠑⠌⠕⠗⠎
- ⠊⠎ ⠔ ⠹⠑ ⠎⠊⠍⠊⠇⠑⠆ ⠁⠝⠙ ⠍⠹ ⠥⠝⠙⠁⠇⠇⠪⠫ ⠙⠁⠝⠙⠎
- ⠩⠁⠇⠇ ⠝⠕⠞ ⠙⠊⠌⠥⠗⠃ ⠊⠞⠂ ⠕⠗ ⠹⠑ ⡊⠳⠝⠞⠗⠹⠰⠎ ⠙⠕⠝⠑ ⠋⠕⠗⠲ ⡹⠳
- ⠺⠊⠇⠇ ⠹⠻⠑⠋⠕⠗⠑ ⠏⠻⠍⠊⠞ ⠍⠑ ⠞⠕ ⠗⠑⠏⠑⠁⠞⠂ ⠑⠍⠏⠙⠁⠞⠊⠊⠁⠇⠇⠹⠂ ⠹⠁⠞
- ⡍⠜⠇⠑⠹ ⠺⠁⠎ ⠁⠎ ⠙⠑⠁⠙ ⠁⠎ ⠁ ⠙⠕⠕⠗⠤⠝⠁⠊⠇⠲
-
- (The first couple of paragraphs of "A Christmas Carol" by Dickens)
-
-Compact font selection example text:
-
- ABCDEFGHIJKLMNOPQRSTUVWXYZ /0123456789
- abcdefghijklmnopqrstuvwxyz £©µÀÆÖÞßéöÿ
- –—‘“”„†•…‰™œŠŸž€ ΑΒΓΔΩαβγδω АБВГДабвгд
- ∀∂∈ℝ∧∪≡∞ ↑↗↨↻⇣ ┐┼╔╘░►☺♀ fi�⑀₂ἠḂӥẄɐː⍎אԱა
-
-Greetings in various languages:
-
- Hello world, Καλημέρα κόσμε, コンニチハ
-
-Box drawing alignment tests: █
- ▉
- ╔══╦══╗ ┌──┬──┐ ╭──┬──╮ ╭──┬──╮ ┏━━┳━━┓ ┎┒┏┑ ╷ ╻ ┏┯┓ ┌┰┐ ▊ ╱╲╱╲╳╳╳
- ║┌─╨─┐║ │╔═╧═╗│ │╒═╪═╕│ │╓─╁─╖│ ┃┌─╂─┐┃ ┗╃╄┙ ╶┼╴╺╋╸┠┼┨ ┝╋┥ ▋ ╲╱╲╱╳╳╳
- ║│╲ ╱│║ │║ ║│ ││ │ ││ │║ ┃ ║│ ┃│ ╿ │┃ ┍╅╆┓ ╵ ╹ ┗┷┛ └┸┘ ▌ ╱╲╱╲╳╳╳
- ╠╡ ╳ ╞╣ ├╢ ╟┤ ├┼─┼─┼┤ ├╫─╂─╫┤ ┣┿╾┼╼┿┫ ┕┛┖┚ ┌┄┄┐ ╎ ┏┅┅┓ ┋ ▍ ╲╱╲╱╳╳╳
- ║│╱ ╲│║ │║ ║│ ││ │ ││ │║ ┃ ║│ ┃│ ╽ │┃ ░░▒▒▓▓██ ┊ ┆ ╎ ╏ ┇ ┋ ▎
- ║└─╥─┘║ │╚═╤═╝│ │╘═╪═╛│ │╙─╀─╜│ ┃└─╂─┘┃ ░░▒▒▓▓██ ┊ ┆ ╎ ╏ ┇ ┋ ▏
- ╚══╩══╝ └──┴──┘ ╰──┴──╯ ╰──┴──╯ ┗━━┻━━┛ ▗▄▖▛▀▜ └╌╌┘ ╎ ┗╍╍┛ ┋ ▁▂▃▄▅▆▇█
- ▝▀▘▙▄▟
(DIR) diff --git a/3rdparties/software/flexi-streams-20190107-git/test/unicode_demo_utf8_lf.txt b/3rdparties/software/flexi-streams-20190107-git/test/unicode_demo_utf8_lf.txt
@@ -1,212 +0,0 @@
-
-UTF-8 encoded sample plain-text file
-‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾
-
-Markus Kuhn [ˈmaʳkʊs kuːn] <http://www.cl.cam.ac.uk/~mgk25/> — 2002-07-25
-
-
-The ASCII compatible UTF-8 encoding used in this plain-text file
-is defined in Unicode, ISO 10646-1, and RFC 2279.
-
-
-Using Unicode/UTF-8, you can write in emails and source code things such as
-
-Mathematics and sciences:
-
- ∮ E⋅da = Q, n → ∞, ∑ f(i) = ∏ g(i), ⎧⎡⎛┌─────┐⎞⎤⎫
- ⎪⎢⎜│a²+b³ ⎟⎥⎪
- ∀x∈ℝ: ⌈x⌉ = −⌊−x⌋, α ∧ ¬β = ¬(¬α ∨ β), ⎪⎢⎜│───── ⎟⎥⎪
- ⎪⎢⎜⎷ c₈ ⎟⎥⎪
- ℕ ⊆ ℕ₀ ⊂ ℤ ⊂ ℚ ⊂ ℝ ⊂ ℂ, ⎨⎢⎜ ⎟⎥⎬
- ⎪⎢⎜ ∞ ⎟⎥⎪
- ⊥ < a ≠ b ≡ c ≤ d ≪ ⊤ ⇒ (⟦A⟧ ⇔ ⟪B⟫), ⎪⎢⎜ ⎲ ⎟⎥⎪
- ⎪⎢⎜ ⎳aⁱ-bⁱ⎟⎥⎪
- 2H₂ + O₂ ⇌ 2H₂O, R = 4.7 kΩ, ⌀ 200 mm ⎩⎣⎝i=1 ⎠⎦⎭
-
-Linguistics and dictionaries:
-
- ði ıntəˈnæʃənəl fəˈnɛtık əsoʊsiˈeıʃn
- Y [ˈʏpsilɔn], Yen [jɛn], Yoga [ˈjoːgɑ]
-
-APL:
-
- ((V⍳V)=⍳⍴V)/V←,V ⌷←⍳→⍴∆∇⊃‾⍎⍕⌈
-
-Nicer typography in plain text files:
-
- ╔══════════════════════════════════════════╗
- ║ ║
- ║ • ‘single’ and “double” quotes ║
- ║ ║
- ║ • Curly apostrophes: “We’ve been here” ║
- ║ ║
- ║ • Latin-1 apostrophe and accents: '´` ║
- ║ ║
- ║ • ‚deutsche‘ „Anführungszeichen“ ║
- ║ ║
- ║ • †, ‡, ‰, •, 3–4, —, −5/+5, ™, … ║
- ║ ║
- ║ • ASCII safety test: 1lI|, 0OD, 8B ║
- ║ ╭─────────╮ ║
- ║ • the euro symbol: │ 14.95 € │ ║
- ║ ╰─────────╯ ║
- ╚══════════════════════════════════════════╝
-
-Combining characters:
-
- STARGΛ̊TE SG-1, a = v̇ = r̈, a⃑ ⊥ b⃑
-
-Greek (in Polytonic):
-
- The Greek anthem:
-
- Σὲ γνωρίζω ἀπὸ τὴν κόψη
- τοῦ σπαθιοῦ τὴν τρομερή,
- σὲ γνωρίζω ἀπὸ τὴν ὄψη
- ποὺ μὲ βία μετράει τὴ γῆ.
-
- ᾿Απ᾿ τὰ κόκκαλα βγαλμένη
- τῶν ῾Ελλήνων τὰ ἱερά
- καὶ σὰν πρῶτα ἀνδρειωμένη
- χαῖρε, ὦ χαῖρε, ᾿Ελευθεριά!
-
- From a speech of Demosthenes in the 4th century BC:
-
- Οὐχὶ ταὐτὰ παρίσταταί μοι γιγνώσκειν, ὦ ἄνδρες ᾿Αθηναῖοι,
- ὅταν τ᾿ εἰς τὰ πράγματα ἀποβλέψω καὶ ὅταν πρὸς τοὺς
- λόγους οὓς ἀκούω· τοὺς μὲν γὰρ λόγους περὶ τοῦ
- τιμωρήσασθαι Φίλιππον ὁρῶ γιγνομένους, τὰ δὲ πράγματ᾿
- εἰς τοῦτο προήκοντα, ὥσθ᾿ ὅπως μὴ πεισόμεθ᾿ αὐτοὶ
- πρότερον κακῶς σκέψασθαι δέον. οὐδέν οὖν ἄλλο μοι δοκοῦσιν
- οἱ τὰ τοιαῦτα λέγοντες ἢ τὴν ὑπόθεσιν, περὶ ἧς βουλεύεσθαι,
- οὐχὶ τὴν οὖσαν παριστάντες ὑμῖν ἁμαρτάνειν. ἐγὼ δέ, ὅτι μέν
- ποτ᾿ ἐξῆν τῇ πόλει καὶ τὰ αὑτῆς ἔχειν ἀσφαλῶς καὶ Φίλιππον
- τιμωρήσασθαι, καὶ μάλ᾿ ἀκριβῶς οἶδα· ἐπ᾿ ἐμοῦ γάρ, οὐ πάλαι
- γέγονεν ταῦτ᾿ ἀμφότερα· νῦν μέντοι πέπεισμαι τοῦθ᾿ ἱκανὸν
- προλαβεῖν ἡμῖν εἶναι τὴν πρώτην, ὅπως τοὺς συμμάχους
- σώσομεν. ἐὰν γὰρ τοῦτο βεβαίως ὑπάρξῃ, τότε καὶ περὶ τοῦ
- τίνα τιμωρήσεταί τις καὶ ὃν τρόπον ἐξέσται σκοπεῖν· πρὶν δὲ
- τὴν ἀρχὴν ὀρθῶς ὑποθέσθαι, μάταιον ἡγοῦμαι περὶ τῆς
- τελευτῆς ὁντινοῦν ποιεῖσθαι λόγον.
-
- Δημοσθένους, Γ´ ᾿Ολυνθιακὸς
-
-Georgian:
-
- From a Unicode conference invitation:
-
- გთხოვთ ახლავე გაიაროთ რეგისტრაცია Unicode-ის მეათე საერთაშორისო
- კონფერენციაზე დასასწრებად, რომელიც გაიმართება 10-12 მარტს,
- ქ. მაინცში, გერმანიაში. კონფერენცია შეჰკრებს ერთად მსოფლიოს
- ექსპერტებს ისეთ დარგებში როგორიცაა ინტერნეტი და Unicode-ი,
- ინტერნაციონალიზაცია და ლოკალიზაცია, Unicode-ის გამოყენება
- ოპერაციულ სისტემებსა, და გამოყენებით პროგრამებში, შრიფტებში,
- ტექსტების დამუშავებასა და მრავალენოვან კომპიუტერულ სისტემებში.
-
-Russian:
-
- From a Unicode conference invitation:
-
- Зарегистрируйтесь сейчас на Десятую Международную Конференцию по
- Unicode, которая состоится 10-12 марта 1997 года в Майнце в Германии.
- Конференция соберет широкий круг экспертов по вопросам глобального
- Интернета и Unicode, локализации и интернационализации, воплощению и
- применению Unicode в различных операционных системах и программных
- приложениях, шрифтах, верстке и многоязычных компьютерных системах.
-
-Thai (UCS Level 2):
-
- Excerpt from a poetry on The Romance of The Three Kingdoms (a Chinese
- classic 'San Gua'):
-
- [----------------------------|------------------------]
- ๏ แผ่นดินฮั่นเสื่อมโทรมแสนสังเวช พระปกเกศกองบู๊กู้ขึ้นใหม่
- สิบสองกษัตริย์ก่อนหน้าแลถัดไป สององค์ไซร้โง่เขลาเบาปัญญา
- ทรงนับถือขันทีเป็นที่พึ่ง บ้านเมืองจึงวิปริตเป็นนักหนา
- โฮจิ๋นเรียกทัพทั่วหัวเมืองมา หมายจะฆ่ามดชั่วตัวสำคัญ
- เหมือนขับไสไล่เสือจากเคหา รับหมาป่าเข้ามาเลยอาสัญ
- ฝ่ายอ้องอุ้นยุแยกให้แตกกัน ใช้สาวนั้นเป็นชนวนชื่นชวนใจ
- พลันลิฉุยกุยกีกลับก่อเหตุ ช่างอาเพศจริงหนาฟ้าร้องไห้
- ต้องรบราฆ่าฟันจนบรรลัย ฤๅหาใครค้ำชูกู้บรรลังก์ ฯ
-
- (The above is a two-column text. If combining characters are handled
- correctly, the lines of the second column should be aligned with the
- | character above.)
-
-Ethiopian:
-
- Proverbs in the Amharic language:
-
- ሰማይ አይታረስ ንጉሥ አይከሰስ።
- ብላ ካለኝ እንደአባቴ በቆመጠኝ።
- ጌጥ ያለቤቱ ቁምጥና ነው።
- ደሀ በሕልሙ ቅቤ ባይጠጣ ንጣት በገደለው።
- የአፍ ወለምታ በቅቤ አይታሽም።
- አይጥ በበላ ዳዋ ተመታ።
- ሲተረጉሙ ይደረግሙ።
- ቀስ በቀስ፥ ዕንቁላል በእግሩ ይሄዳል።
- ድር ቢያብር አንበሳ ያስር።
- ሰው እንደቤቱ እንጅ እንደ ጉረቤቱ አይተዳደርም።
- እግዜር የከፈተውን ጉሮሮ ሳይዘጋው አይድርም።
- የጎረቤት ሌባ፥ ቢያዩት ይስቅ ባያዩት ያጠልቅ።
- ሥራ ከመፍታት ልጄን ላፋታት።
- ዓባይ ማደሪያ የለው፥ ግንድ ይዞ ይዞራል።
- የእስላም አገሩ መካ የአሞራ አገሩ ዋርካ።
- ተንጋሎ ቢተፉ ተመልሶ ባፉ።
- ወዳጅህ ማር ቢሆን ጨርስህ አትላሰው።
- እግርህን በፍራሽህ ልክ ዘርጋ።
-
-Runes:
-
- ᚻᛖ ᚳᚹᚫᚦ ᚦᚫᛏ ᚻᛖ ᛒᚢᛞᛖ ᚩᚾ ᚦᚫᛗ ᛚᚪᚾᛞᛖ ᚾᚩᚱᚦᚹᛖᚪᚱᛞᚢᛗ ᚹᛁᚦ ᚦᚪ ᚹᛖᛥᚫ
-
- (Old English, which transcribed into Latin reads 'He cwaeth that he
- bude thaem lande northweardum with tha Westsae.' and means 'He said
- that he lived in the northern land near the Western Sea.')
-
-Braille:
-
- ⡌⠁⠧⠑ ⠼⠁⠒ ⡍⠜⠇⠑⠹⠰⠎ ⡣⠕⠌
-
- ⡍⠜⠇⠑⠹ ⠺⠁⠎ ⠙⠑⠁⠙⠒ ⠞⠕ ⠃⠑⠛⠔ ⠺⠊⠹⠲ ⡹⠻⠑ ⠊⠎ ⠝⠕ ⠙⠳⠃⠞
- ⠱⠁⠞⠑⠧⠻ ⠁⠃⠳⠞ ⠹⠁⠞⠲ ⡹⠑ ⠗⠑⠛⠊⠌⠻ ⠕⠋ ⠙⠊⠎ ⠃⠥⠗⠊⠁⠇ ⠺⠁⠎
- ⠎⠊⠛⠝⠫ ⠃⠹ ⠹⠑ ⠊⠇⠻⠛⠹⠍⠁⠝⠂ ⠹⠑ ⠊⠇⠻⠅⠂ ⠹⠑ ⠥⠝⠙⠻⠞⠁⠅⠻⠂
- ⠁⠝⠙ ⠹⠑ ⠡⠊⠑⠋ ⠍⠳⠗⠝⠻⠲ ⡎⠊⠗⠕⠕⠛⠑ ⠎⠊⠛⠝⠫ ⠊⠞⠲ ⡁⠝⠙
- ⡎⠊⠗⠕⠕⠛⠑⠰⠎ ⠝⠁⠍⠑ ⠺⠁⠎ ⠛⠕⠕⠙ ⠥⠏⠕⠝ ⠰⡡⠁⠝⠛⠑⠂ ⠋⠕⠗ ⠁⠝⠹⠹⠔⠛ ⠙⠑
- ⠡⠕⠎⠑ ⠞⠕ ⠏⠥⠞ ⠙⠊⠎ ⠙⠁⠝⠙ ⠞⠕⠲
-
- ⡕⠇⠙ ⡍⠜⠇⠑⠹ ⠺⠁⠎ ⠁⠎ ⠙⠑⠁⠙ ⠁⠎ ⠁ ⠙⠕⠕⠗⠤⠝⠁⠊⠇⠲
-
- ⡍⠔⠙⠖ ⡊ ⠙⠕⠝⠰⠞ ⠍⠑⠁⠝ ⠞⠕ ⠎⠁⠹ ⠹⠁⠞ ⡊ ⠅⠝⠪⠂ ⠕⠋ ⠍⠹
- ⠪⠝ ⠅⠝⠪⠇⠫⠛⠑⠂ ⠱⠁⠞ ⠹⠻⠑ ⠊⠎ ⠏⠜⠞⠊⠊⠥⠇⠜⠇⠹ ⠙⠑⠁⠙ ⠁⠃⠳⠞
- ⠁ ⠙⠕⠕⠗⠤⠝⠁⠊⠇⠲ ⡊ ⠍⠊⠣⠞ ⠙⠁⠧⠑ ⠃⠑⠲ ⠔⠊⠇⠔⠫⠂ ⠍⠹⠎⠑⠇⠋⠂ ⠞⠕
- ⠗⠑⠛⠜⠙ ⠁ ⠊⠕⠋⠋⠔⠤⠝⠁⠊⠇ ⠁⠎ ⠹⠑ ⠙⠑⠁⠙⠑⠌ ⠏⠊⠑⠊⠑ ⠕⠋ ⠊⠗⠕⠝⠍⠕⠝⠛⠻⠹
- ⠔ ⠹⠑ ⠞⠗⠁⠙⠑⠲ ⡃⠥⠞ ⠹⠑ ⠺⠊⠎⠙⠕⠍ ⠕⠋ ⠳⠗ ⠁⠝⠊⠑⠌⠕⠗⠎
- ⠊⠎ ⠔ ⠹⠑ ⠎⠊⠍⠊⠇⠑⠆ ⠁⠝⠙ ⠍⠹ ⠥⠝⠙⠁⠇⠇⠪⠫ ⠙⠁⠝⠙⠎
- ⠩⠁⠇⠇ ⠝⠕⠞ ⠙⠊⠌⠥⠗⠃ ⠊⠞⠂ ⠕⠗ ⠹⠑ ⡊⠳⠝⠞⠗⠹⠰⠎ ⠙⠕⠝⠑ ⠋⠕⠗⠲ ⡹⠳
- ⠺⠊⠇⠇ ⠹⠻⠑⠋⠕⠗⠑ ⠏⠻⠍⠊⠞ ⠍⠑ ⠞⠕ ⠗⠑⠏⠑⠁⠞⠂ ⠑⠍⠏⠙⠁⠞⠊⠊⠁⠇⠇⠹⠂ ⠹⠁⠞
- ⡍⠜⠇⠑⠹ ⠺⠁⠎ ⠁⠎ ⠙⠑⠁⠙ ⠁⠎ ⠁ ⠙⠕⠕⠗⠤⠝⠁⠊⠇⠲
-
- (The first couple of paragraphs of "A Christmas Carol" by Dickens)
-
-Compact font selection example text:
-
- ABCDEFGHIJKLMNOPQRSTUVWXYZ /0123456789
- abcdefghijklmnopqrstuvwxyz £©µÀÆÖÞßéöÿ
- –—‘“”„†•…‰™œŠŸž€ ΑΒΓΔΩαβγδω АБВГДабвгд
- ∀∂∈ℝ∧∪≡∞ ↑↗↨↻⇣ ┐┼╔╘░►☺♀ fi�⑀₂ἠḂӥẄɐː⍎אԱა
-
-Greetings in various languages:
-
- Hello world, Καλημέρα κόσμε, コンニチハ
-
-Box drawing alignment tests: █
- ▉
- ╔══╦══╗ ┌──┬──┐ ╭──┬──╮ ╭──┬──╮ ┏━━┳━━┓ ┎┒┏┑ ╷ ╻ ┏┯┓ ┌┰┐ ▊ ╱╲╱╲╳╳╳
- ║┌─╨─┐║ │╔═╧═╗│ │╒═╪═╕│ │╓─╁─╖│ ┃┌─╂─┐┃ ┗╃╄┙ ╶┼╴╺╋╸┠┼┨ ┝╋┥ ▋ ╲╱╲╱╳╳╳
- ║│╲ ╱│║ │║ ║│ ││ │ ││ │║ ┃ ║│ ┃│ ╿ │┃ ┍╅╆┓ ╵ ╹ ┗┷┛ └┸┘ ▌ ╱╲╱╲╳╳╳
- ╠╡ ╳ ╞╣ ├╢ ╟┤ ├┼─┼─┼┤ ├╫─╂─╫┤ ┣┿╾┼╼┿┫ ┕┛┖┚ ┌┄┄┐ ╎ ┏┅┅┓ ┋ ▍ ╲╱╲╱╳╳╳
- ║│╱ ╲│║ │║ ║│ ││ │ ││ │║ ┃ ║│ ┃│ ╽ │┃ ░░▒▒▓▓██ ┊ ┆ ╎ ╏ ┇ ┋ ▎
- ║└─╥─┘║ │╚═╤═╝│ │╘═╪═╛│ │╙─╀─╜│ ┃└─╂─┘┃ ░░▒▒▓▓██ ┊ ┆ ╎ ╏ ┇ ┋ ▏
- ╚══╩══╝ └──┴──┘ ╰──┴──╯ ╰──┴──╯ ┗━━┻━━┛ ▗▄▖▛▀▜ └╌╌┘ ╎ ┗╍╍┛ ┋ ▁▂▃▄▅▆▇█
- ▝▀▘▙▄▟
(DIR) diff --git a/3rdparties/software/flexi-streams-20190107-git/util.lisp b/3rdparties/software/flexi-streams-20190107-git/util.lisp
@@ -1,206 +0,0 @@
-;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: FLEXI-STREAMS; Base: 10 -*-
-;;; $Header: /usr/local/cvsrep/flexi-streams/util.lisp,v 1.24 2008/05/25 21:26:12 edi Exp $
-
-;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved.
-
-;;; Redistribution and use in source and binary forms, with or without
-;;; modification, are permitted provided that the following conditions
-;;; are met:
-
-;;; * Redistributions of source code must retain the above copyright
-;;; notice, this list of conditions and the following disclaimer.
-
-;;; * Redistributions in binary form must reproduce the above
-;;; copyright notice, this list of conditions and the following
-;;; disclaimer in the documentation and/or other materials
-;;; provided with the distribution.
-
-;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED
-;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
-;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
-;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
-;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
-;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
-;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
-;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
-;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
-;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
-;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-
-(in-package :flexi-streams)
-
-#+:lispworks
-(eval-when (:compile-toplevel :load-toplevel :execute)
- (import '(lw:with-unique-names lw:when-let)))
-
-#-:lispworks
-(defmacro when-let ((var form) &body body)
- "Evaluates FORM and binds VAR to the result, then executes BODY
-if VAR has a true value."
- `(let ((,var ,form))
- (when ,var ,@body)))
-
-#-:lispworks
-(defmacro with-unique-names ((&rest bindings) &body body)
- "Syntax: WITH-UNIQUE-NAMES ( { var | (var x) }* ) declaration* form*
-
-Executes a series of forms with each VAR bound to a fresh,
-uninterned symbol. The uninterned symbol is as if returned by a call
-to GENSYM with the string denoted by X - or, if X is not supplied, the
-string denoted by VAR - as argument.
-
-The variable bindings created are lexical unless special declarations
-are specified. The scopes of the name bindings and declarations do not
-include the Xs.
-
-The forms are evaluated in order, and the values of all but the last
-are discarded \(that is, the body is an implicit PROGN)."
- ;; reference implementation posted to comp.lang.lisp as
- ;; <cy3bshuf30f.fsf@ljosa.com> by Vebjorn Ljosa - see also
- ;; <http://www.cliki.net/Common%20Lisp%20Utilities>
- `(let ,(mapcar #'(lambda (binding)
- (check-type binding (or cons symbol))
- (if (consp binding)
- (destructuring-bind (var x) binding
- (check-type var symbol)
- `(,var (gensym ,(etypecase x
- (symbol (symbol-name x))
- (character (string x))
- (string x)))))
- `(,binding (gensym ,(symbol-name binding)))))
- bindings)
- ,@body))
-
-#+:lispworks
-(eval-when (:compile-toplevel :load-toplevel :execute)
- (setf (macro-function 'with-rebinding)
- (macro-function 'lw:rebinding)))
-
-#-:lispworks
-(defmacro with-rebinding (bindings &body body)
- "WITH-REBINDING ( { var | (var prefix) }* ) form*
-
-Evaluates a series of forms in the lexical environment that is
-formed by adding the binding of each VAR to a fresh, uninterned
-symbol, and the binding of that fresh, uninterned symbol to VAR's
-original value, i.e., its value in the current lexical environment.
-
-The uninterned symbol is created as if by a call to GENSYM with the
-string denoted by PREFIX - or, if PREFIX is not supplied, the string
-denoted by VAR - as argument.
-
-The forms are evaluated in order, and the values of all but the last
-are discarded \(that is, the body is an implicit PROGN)."
- ;; reference implementation posted to comp.lang.lisp as
- ;; <cy3wv0fya0p.fsf@ljosa.com> by Vebjorn Ljosa - see also
- ;; <http://www.cliki.net/Common%20Lisp%20Utilities>
- (loop for binding in bindings
- for var = (if (consp binding) (car binding) binding)
- for name = (gensym)
- collect `(,name ,var) into renames
- collect ``(,,var ,,name) into temps
- finally (return `(let ,renames
- (with-unique-names ,bindings
- `(let (,,@temps)
- ,,@body))))))
-
-(defun normalize-external-format-name (name)
- "Converts NAME \(a symbol) to a `canonical' name for an
-external format, e.g. :LATIN1 will be converted to :ISO-8859-1.
-Also checks if there is an external format with that name and
-signals an error otherwise."
- (let ((real-name (cdr (find name flex::+name-map+
- :test (lambda (item pair)
- (or (string-equal item (cdr pair))
- (string-equal item (car pair))))))))
- (unless real-name
- (error 'external-format-error
- :format-control "~S is not known to be a name for an external format."
- :format-arguments (list name)))
- real-name))
-
-(defun ascii-name-p (name)
- "Checks whether NAME is the keyword :ASCII."
- (eq name :us-ascii))
-
-(defun koi8-r-name-p (name)
- "Checks whether NAME is the keyword :KOI8-R."
- (eq name :koi8-r))
-
-(defun code-page-name-p (name)
- "Checks whether NAME is the keyword :CODE-PAGE."
- (eq name :code-page))
-
-(defun iso-8859-name-p (name)
- "Checks whether NAME \(a keyword) names one of the known
-ISO-8859 encodings."
- (find name +iso-8859-tables+ :key #'car))
-
-(defun known-code-page-id-p (id)
- "Checks whether ID \(a number) denotes one of the known Windows
-code pages."
- (and (find id +code-page-tables+ :key #'car)
- id))
-
-#+:lispworks
-(defun sans (plist &rest keys)
- "Returns PLIST with keyword arguments from KEYS removed."
- (sys::remove-properties plist keys))
-
-#-:lispworks
-(defun sans (plist &rest keys)
- "Returns PLIST with keyword arguments from KEYS removed."
- ;; stolen from Usenet posting <3247672165664225@naggum.no> by Erik
- ;; Naggum
- (let ((sans ()))
- (loop
- (let ((tail (nth-value 2 (get-properties plist keys))))
- ;; this is how it ends
- (unless tail
- (return (nreconc sans plist)))
- ;; copy all the unmatched keys
- (loop until (eq plist tail) do
- (push (pop plist) sans)
- (push (pop plist) sans))
- ;; skip the matched key
- (setq plist (cddr plist))))))
-
-#+:lispworks
-(defmacro with-accessors (slot-entries instance &body body)
- "For LispWorks, we prefer SLOT-VALUE over accessors for better
-performance."
- ;; note that we assume that the variables have the same names as the
- ;; slots
- `(with-slots ,(mapcar #'car slot-entries)
- ,instance
- ,@body))
-
-(defun make-octet-buffer (&optional (size +buffer-size+))
- "Creates and returns a fresh buffer \(a specialized array) of size
-+BUFFER-SIZE+ to hold octets."
- (declare #.*standard-optimize-settings*)
- (make-array size :element-type 'octet))
-
-(defun type-equal (type1 type2)
- "Whether TYPE1 and TYPE2 denote the same type."
- (declare #.*standard-optimize-settings*)
- (and (subtypep type1 type2)
- (subtypep type2 type1)))
-
-(defun maybe-rewind (stream octets)
- "Tries to `rewind' the \(binary) stream STREAM by OCTETS octets.
-Returns T if it succeeds, otherwise NIL."
- (when-let (position (file-position stream))
- (if (file-position stream (- position octets)) t nil)))
-
-(defmacro logand* (x y)
- "Solely for optimization purposes. Some Lisps need it, some don't."
- `(the fixnum (logand ,x ,y)))
-
-(defmacro logior* (x y)
- "Solely for optimization purposes. Some Lisps need it, some don't."
- `(the fixnum (logior ,x ,y)))
-
-(defmacro ash* (integer count)
- "Solely for optimization purposes. Some Lisps need it, some don't."
- `(the fixnum (ash ,integer ,count)))
(DIR) diff --git a/3rdparties/software/split-sequence-v1.5.0/LICENSE b/3rdparties/software/split-sequence-v1.5.0/LICENSE
@@ -1,21 +0,0 @@
-Copyright (C) 2001-2018, Arthur Lemmens et al.
-
-Permission is hereby granted, free of charge, to any person
-obtaining a copy of this software and associated documentation
-files (the "Software"), to deal in the Software without
-restriction, including without limitation the rights to use, copy,
-modify, merge, publish, distribute, sublicense, and/or sell copies
-of the Software, and to permit persons to whom the Software is
-furnished to do so, subject to the following conditions:
-
-The above copyright notice and this permission notice shall be
-included in all copies or substantial portions of the Software.
-
-THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
-EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
-MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
-NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
-HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
-WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
-DEALINGS IN THE SOFTWARE.
(DIR) diff --git a/3rdparties/software/split-sequence-v1.5.0/README.md b/3rdparties/software/split-sequence-v1.5.0/README.md
@@ -1,109 +0,0 @@
-SPLIT-SEQUENCE
-==============
-
-[SPLIT-SEQUENCE](http://cliki.net/split-sequence) is a member of the
-[Common Lisp Utilities](http://cliki.net/Common%20Lisp%20Utilities)
-family of programs, designed by community consensus.
-
-
-_Function_ __SPLIT-SEQUENCE, SPLIT-SEQUENCE-IF, SPLIT-SEQUENCE-IF-NOT__
-
-
-__Syntax:__
-
-__split-sequence__ _delimiter sequence `&key` count
-remove-empty-subseqs from-end start end test test-not key ⇒ list,
-index_
-
-__split-sequence-if__ _predicate sequence `&key` count
-remove-empty-subseqs from-end start end key ⇒ list, index_
-
-__split-sequence-if-not__ _predicate sequence `&key` count
-remove-empty-subseqs from-end start end key ⇒ list, index_
-
-
-__Arguments and Values:__
-
-_delimiter_—an _object_.
-
-_predicate_—a designator for a _function_ of one _argument_ that
-returns a _generalized boolean_.
-
-_sequence_—a _proper sequence_.
-
-_count_—an _integer_ or __nil__. The default is __nil__.
-
-_remove-empty-subseqs_—a _generalized boolean_. The default is
-_false_.
-
-_from-end_—a _generalized boolean_. The default is _false_.
-
-_start, end_—_bounding index designators_ of _sequence_. The
-defaults for _start_ and _end_ are __0__ and __nil__, respectively.
-
-_test_—a _designator_ for a _function_ of two _arguments_ that
-returns a _generalized boolean_.
-
-_test-not_—a _designator_ for a _function_ of two _arguments_
-that returns a _generalized boolean_.
-
-_key_—a _designator_ for a _function_ of one _argument_, or
-__nil__.
-
-_list_—a _proper sequence_.
-
-_index_—an _integer_ greater than or equal to zero, and less
-than or equal to the _length_ of the _sequence_.
-
-
-__Description:__
-
-Splits _sequence_ into a list of subsequences delimited by objects
-_satisfying the test_.
-
-_List_ is a list of sequences of the same kind as _sequence_ that has
-elements consisting of subsequences of _sequence_ that were delimited
-in the argument by elements _satisfying the test_. Index is an index
-into _sequence_ indicating the unprocessed region, suitable as an
-argument to
-[subseq](http://www.lispworks.com/documentation/HyperSpec/Body/f_subseq.htm)
-to continue processing in the same manner if desired.
-
-The _count_ argument, if supplied, limits the number of subsequences
-in the first return value; if more than _count_ delimited subsequences
-exist in _sequence_, the _count_ leftmost delimited subsequences will
-be in order in the first return value, and the second return value
-will be the index into _sequence_ at which processing stopped.
-
-If _from-end_ is non-null, _sequence_ is conceptually processed from
-right to left, accumulating the subsequences in reverse order;
-_from-end_ only makes a difference in the case of a non-null _count_
-argument. In the presence of _from-end_, the _count_ rightmost
-delimited subsequences will be in the order that they are in
-_sequence_ in the first return value, and the second is the index
-indicating the end of the unprocessed region.
-
-The _start_ and _end_ keyword arguments permit a certain subsequence
-of the _sequence_ to be processed without the need for a copying
-stage; their use is conceptually equivalent to partitioning the
-subsequence delimited by _start_ and _end_, only without the need for
-copying.
-
-If _remove-empty-subseqs_ is null (the default), then empty
-subsequences will be included in the result.
-
-In all cases, the subsequences in the first return value will be in
-the order that they appeared in _sequence_.
-
-
-__Examples:__
-
-<pre>
-SPLIT-SEQUENCE> (split-sequence #\Space "A stitch in time saves nine.")
-⇒ ("A" "stitch" "in" "time" "saves" "nine.")
-⇒ 28
-
-SPLIT-SEQUENCE> (split-sequence #\, "foo,bar ,baz, foobar , barbaz,")
-⇒ ("foo" "bar " "baz" " foobar " " barbaz" "")
-⇒ 30
-</pre>
(DIR) diff --git a/3rdparties/software/split-sequence-v1.5.0/split-sequence.asd b/3rdparties/software/split-sequence-v1.5.0/split-sequence.asd
@@ -1,23 +0,0 @@
-;;; -*- Lisp -*-
-
-(defsystem :split-sequence
- :author "Arthur Lemmens <alemmens@xs4all.nl>"
- :maintainer "Sharp Lispers <sharplispers@googlegroups.com>"
- :description "Splits a sequence into a list of subsequences
- delimited by objects satisfying a test."
- :license "MIT"
- :version (:read-file-form "version.sexp")
- :components ((:static-file "version.sexp")
- (:file "split-sequence")))
-
-(defsystem :split-sequence/tests
- :author "Arthur Lemmens <alemmens@xs4all.nl>"
- :maintainer "Sharp Lispers <sharplispers@googlegroups.com>"
- :description "Split-Sequence test suite"
- :license "MIT"
- :depends-on (:split-sequence :fiveam)
- :components ((:file "tests")))
-
-(defmethod perform ((o test-op) (c (eql (find-system :split-sequence))))
- (load-system :split-sequence/tests)
- (symbol-call :5am :run! :split-sequence))
(DIR) diff --git a/3rdparties/software/split-sequence-v1.5.0/split-sequence.lisp b/3rdparties/software/split-sequence-v1.5.0/split-sequence.lisp
@@ -1,172 +0,0 @@
-;;;; -*- Mode: Lisp; indent-tabs-mode: nil -*-
-;;;
-;;; SPLIT-SEQUENCE
-;;;
-;;; This code was based on Arthur Lemmens' in
-;;; <URL:http://groups.google.com/groups?as_umsgid=39F36F1A.B8F19D20%40simplex.nl>;
-;;;
-;;; changes include:
-;;;
-;;; * altering the behaviour of the :from-end keyword argument to
-;;; return the subsequences in original order, for consistency with
-;;; CL:REMOVE, CL:SUBSTITUTE et al. (:from-end being non-NIL only
-;;; affects the answer if :count is less than the number of
-;;; subsequences, by analogy with the above-referenced functions).
-;;;
-;;; * changing the :maximum keyword argument to :count, by analogy
-;;; with CL:REMOVE, CL:SUBSTITUTE, and so on.
-;;;
-;;; * naming the function SPLIT-SEQUENCE rather than PARTITION rather
-;;; than SPLIT.
-;;;
-;;; * adding SPLIT-SEQUENCE-IF and SPLIT-SEQUENCE-IF-NOT.
-;;;
-;;; * The second return value is now an index rather than a copy of a
-;;; portion of the sequence; this index is the `right' one to feed to
-;;; CL:SUBSEQ for continued processing.
-
-;;; There's a certain amount of code duplication here, which is kept
-;;; to illustrate the relationship between the SPLIT-SEQUENCE
-;;; functions and the CL:POSITION functions.
-
-(defpackage :split-sequence
- (:use :common-lisp)
- (:export #:split-sequence
- #:split-sequence-if
- #:split-sequence-if-not))
-
-(in-package :split-sequence)
-
-(deftype array-index (&optional (length array-dimension-limit))
- `(integer 0 (,length)))
-
-(declaim (ftype (function (&rest t) (values list integer))
- split-sequence split-sequence-if split-sequence-if-not))
-
-(declaim (ftype (function (function sequence array-index
- (or null array-index) (or null array-index) boolean)
- (values list integer))
- split-from-start split-from-end))
-
-(macrolet ((check-bounds (sequence start end)
- (let ((length (gensym (string '#:length))))
- `(let ((,length (length ,sequence)))
- (check-type ,start unsigned-byte "a non-negative integer")
- (when ,end (check-type ,end unsigned-byte "a non-negative integer or NIL"))
- (unless ,end
- (setf ,end ,length))
- (unless (<= ,start ,end ,length)
- (error "Wrong sequence bounds. start: ~S end: ~S" ,start ,end))))))
-
- (defun split-sequence (delimiter sequence &key (start 0) (end nil) (from-end nil)
- (count nil) (remove-empty-subseqs nil)
- (test #'eql) (test-not nil) (key #'identity))
- "Return a list of subsequences in seq delimited by delimiter.
-
-If :remove-empty-subseqs is NIL, empty subsequences will be included
-in the result; otherwise they will be discarded. All other keywords
-work analogously to those for CL:SUBSTITUTE. In particular, the
-behaviour of :from-end is possibly different from other versions of
-this function; :from-end values of NIL and T are equivalent unless
-:count is supplied. The second return value is an index suitable as an
-argument to CL:SUBSEQ into the sequence indicating where processing
-stopped."
- (check-bounds sequence start end)
- (cond
- ((and (not from-end) (null test-not))
- (split-from-start (lambda (sequence start)
- (position delimiter sequence :start start :key key :test test))
- sequence start end count remove-empty-subseqs))
- ((and (not from-end) test-not)
- (split-from-start (lambda (sequence start)
- (position delimiter sequence :start start :key key :test-not test-not))
- sequence start end count remove-empty-subseqs))
- ((and from-end (null test-not))
- (split-from-end (lambda (sequence end)
- (position delimiter sequence :end end :from-end t :key key :test test))
- sequence start end count remove-empty-subseqs))
- (t
- (split-from-end (lambda (sequence end)
- (position delimiter sequence :end end :from-end t :key key :test-not test-not))
- sequence start end count remove-empty-subseqs))))
-
- (defun split-sequence-if (predicate sequence &key (start 0) (end nil) (from-end nil)
- (count nil) (remove-empty-subseqs nil) (key #'identity))
- "Return a list of subsequences in seq delimited by items satisfying
-predicate.
-
-If :remove-empty-subseqs is NIL, empty subsequences will be included
-in the result; otherwise they will be discarded. All other keywords
-work analogously to those for CL:SUBSTITUTE-IF. In particular, the
-behaviour of :from-end is possibly different from other versions of
-this function; :from-end values of NIL and T are equivalent unless
-:count is supplied. The second return value is an index suitable as an
-argument to CL:SUBSEQ into the sequence indicating where processing
-stopped."
- (check-bounds sequence start end)
- (if from-end
- (split-from-end (lambda (sequence end)
- (position-if predicate sequence :end end :from-end t :key key))
- sequence start end count remove-empty-subseqs)
- (split-from-start (lambda (sequence start)
- (position-if predicate sequence :start start :key key))
- sequence start end count remove-empty-subseqs)))
-
- (defun split-sequence-if-not (predicate sequence &key (count nil) (remove-empty-subseqs nil)
- (from-end nil) (start 0) (end nil) (key #'identity))
- "Return a list of subsequences in seq delimited by items satisfying
-\(CL:COMPLEMENT predicate).
-
-If :remove-empty-subseqs is NIL, empty subsequences will be included
-in the result; otherwise they will be discarded. All other keywords
-work analogously to those for CL:SUBSTITUTE-IF-NOT. In particular,
-the behaviour of :from-end is possibly different from other versions
-of this function; :from-end values of NIL and T are equivalent unless
-:count is supplied. The second return value is an index suitable as an
-argument to CL:SUBSEQ into the sequence indicating where processing
-stopped."
- (check-bounds sequence start end)
- (if from-end
- (split-from-end (lambda (sequence end)
- (position-if-not predicate sequence :end end :from-end t :key key))
- sequence start end count remove-empty-subseqs)
- (split-from-start (lambda (sequence start)
- (position-if-not predicate sequence :start start :key key))
- sequence start end count remove-empty-subseqs))))
-
-(defun split-from-end (position-fn sequence start end count remove-empty-subseqs)
- (declare (optimize (speed 3) (debug 0)))
- (loop
- :for right := end :then left
- :for left := (max (or (funcall position-fn sequence right) -1)
- (1- start))
- :unless (and (= right (1+ left))
- remove-empty-subseqs) ; empty subseq we don't want
- :if (and count (>= nr-elts count))
- ;; We can't take any more. Return now.
- :return (values (nreverse subseqs) right)
- :else
- :collect (subseq sequence (1+ left) right) into subseqs
- :and :sum 1 :into nr-elts
- :until (< left start)
- :finally (return (values (nreverse subseqs) (1+ left)))))
-
-(defun split-from-start (position-fn sequence start end count remove-empty-subseqs)
- (declare (optimize (speed 3) (debug 0)))
- (let ((length (length sequence)))
- (loop
- :for left := start :then (+ right 1)
- :for right := (min (or (funcall position-fn sequence left) length)
- end)
- :unless (and (= right left)
- remove-empty-subseqs) ; empty subseq we don't want
- :if (and count (>= nr-elts count))
- ;; We can't take any more. Return now.
- :return (values subseqs left)
- :else
- :collect (subseq sequence left right) :into subseqs
- :and :sum 1 :into nr-elts
- :until (>= right end)
- :finally (return (values subseqs right)))))
-
-(pushnew :split-sequence *features*)
(DIR) diff --git a/3rdparties/software/split-sequence-v1.5.0/tests.lisp b/3rdparties/software/split-sequence-v1.5.0/tests.lisp
@@ -1,38 +0,0 @@
-;;;; -*- Mode: Lisp; indent-tabs-mode: nil -*-
-
-(defpackage :split-sequence/tests
- (:use :common-lisp :split-sequence :fiveam))
-
-(in-package :split-sequence/tests)
-
-(in-suite* :split-sequence)
-
-;;;; SPLIT-SEQUENCE
-
-(test (split-sequence.1 :compile-at :definition-time)
- (is (equalp (split-sequence #\; "a;;b;c")
- (values '("a" "" "b" "c") 6))))
-
-(test (split-sequence.2 :compile-at :definition-time)
- (is (equalp (split-sequence #\; "a;;b;c" :from-end t)
- (values '("a" "" "b" "c") 0))))
-
-(test (split-sequence.3 :compile-at :definition-time)
- (is (equalp (split-sequence #\; "a;;b;c" :from-end t :count 1)
- (values '("c") 4))))
-
-(test (split-sequence.4 :compile-at :definition-time)
- (is (equalp (split-sequence #\; "a;;b;c" :remove-empty-subseqs t)
- (values '("a" "b" "c") 6))))
-
-(test (split-sequence.5 :compile-at :definition-time)
- (is (equalp (split-sequence #\; ";oo;bar;ba;" :start 1 :end 9)
- (values '("oo" "bar" "b") 9))))
-
-(test (split-sequence-if.1 :compile-at :definition-time)
- (is (equalp (split-sequence-if (lambda (x) (member x '(#\a #\b))) "abracadabra")
- (values '("" "" "r" "c" "d" "" "r" "") 11))))
-
-(test (split-sequence-if-not.1 :compile-at :definition-time)
- (is (equalp (split-sequence-if-not (lambda (x) (member x '(#\a #\b))) "abracadabra")
- (values '("ab" "a" "a" "ab" "a") 11))))
(DIR) diff --git a/3rdparties/software/split-sequence-v1.5.0/version.sexp b/3rdparties/software/split-sequence-v1.5.0/version.sexp
@@ -1,2 +0,0 @@
-;; -*- lisp -*-
-"1.5.0"
(DIR) diff --git a/3rdparties/software/trivial-features-20161204-git/.travis.yml b/3rdparties/software/trivial-features-20161204-git/.travis.yml
@@ -1,30 +0,0 @@
-language: lisp
-
-env:
- matrix:
- # - LISP=abcl
- # - LISP=allegro
- - LISP=sbcl
- - LISP=sbcl32
- - LISP=ccl
- - LISP=ccl32
- - LISP=clisp
- - LISP=clisp32
- # - LISP=cmucl
- - LISP=ecl
-
-matrix:
- allow_failures:
- - env: LISP=ecl
-
-install:
- - curl -L https://github.com/luismbo/cl-travis/raw/master/install.sh | sh
- - if [ "${LISP:(-2)}" = "32" ]; then
- sudo apt-get install libc6-dev-i386;
- fi
-
-script:
- - cl -e '(ql:quickload :cffi-grovel)
- (ql:quickload :trivial-features-tests)
- (unless (trivial-features-tests:run)
- (uiop:quit 1))'
(DIR) diff --git a/3rdparties/software/trivial-features-20161204-git/COPYRIGHT b/3rdparties/software/trivial-features-20161204-git/COPYRIGHT
@@ -1,21 +0,0 @@
-Copyright (C) 2007, Luis Oliveira <loliveira@common-lisp.net>
-
-Permission is hereby granted, free of charge, to any person
-obtaining a copy of this software and associated documentation
-files (the "Software"), to deal in the Software without
-restriction, including without limitation the rights to use, copy,
-modify, merge, publish, distribute, sublicense, and/or sell copies
-of the Software, and to permit persons to whom the Software is
-furnished to do so, subject to the following conditions:
-
-The above copyright notice and this permission notice shall be
-included in all copies or substantial portions of the Software.
-
-THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
-EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
-MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
-NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
-HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
-WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
-DEALINGS IN THE SOFTWARE.
(DIR) diff --git a/3rdparties/software/trivial-features-20161204-git/README.md b/3rdparties/software/trivial-features-20161204-git/README.md
@@ -1,32 +0,0 @@
-[](https://travis-ci.org/trivial-features/trivial-features)
-
-trivial-features ensures consistent `*FEATURES*` across multiple
-Common Lisp implementations.
-
-For example, on MacOS X platforms, while most Lisps push `:DARWIN` to
-`*FEATURES*`, CLISP and Allegro push `:MACOS` and `:MACOSX` instead,
-respectively. Some Lisps might not push any feature suggesting MacOS
-X at all. trivial-features will make sure all Lisps will have
-`:DARWIN` in the `*FEATURES*` list when running on MacOS X. This
-way, you can write
-
- #+darwin foo #-darwin bar
-
-instead of
-
- #+(or darwin macos macosx) foo
- #-(or darwin macos macosx) bar
-
-The included [SPEC.md][1] document describes the set of symbols that
-should or should not be present in `CL:*FEATURES*` on certain
-circumstances. This specification is implemented by the
-TRIVIAL-FEATURES system which supports a handful of Lisps.
-
-The test suite is, in effect, an implementation using [CFFI][2] that
-is checked against the various implementations in `src/tf-*.lisp`.
-
-trivial-features is MIT-licenced.
-
-
-[1]: https://github.com/trivial-features/trivial-features/blob/master/SPEC.md
-[2]: http://common-lisp.net/project/cffi
(DIR) diff --git a/3rdparties/software/trivial-features-20161204-git/SPEC.md b/3rdparties/software/trivial-features-20161204-git/SPEC.md
@@ -1,86 +0,0 @@
-TRIVIAL-FEATURES
-================
-
-This is a first *draft* of a description of what symbols should be
-present in `CL:*FEATURES*` for various platforms. A possible future
-direction of this documentation might be a CDR document, if it turns
-out to be a good idea. (Making the language of this document much
-more precise will be necessary then.)
-
-We will start by limiting ourselves to OS, CPU and endianness features
-on Windows and POSIX platforms.
-
-There are various possible implementation strategies ranging from null
-implementations (when the host Lisp already pushes the wanted feature)
-to using FFI (e.g. calling uname() to grab system information.
-
-
-Specification
--------------
-
-### ENDIANNESS
-
-Either `:LITTLE-ENDIAN` or `:BIG-ENDIAN` should present in
-`\*FEATURES\*`. For the time being, we will not concern ourselves
-with other orderings, switchable endianness, etc.
-
-
-### OPERATING SYSTEM
-
-On Windows, `:WINDOWS` should be present in `*FEATURES*`.
-
-On POSIX systems, the "sysname" information from uname(3) should be
-used to push the appropriate symbol to `*FEATURES*` by upcasing that
-string (or downcasing for the "modern" lisps) and interning it in the
-keyword package.
-
-Examples:
-
- - `:DARWIN`
- - `:LINUX`
- - `:NETBSD`
- - `:OPENBSD`
- - `:FREEBSD`
-
-For convenience, `:UNIX` should be pushed when running on
-POSIX/UNIX-like operating system (that doesn't include Windows) and
-`:BSD` should be present when running on BSD-based systems (that
-includes Darwin)
-
-[add `:MACH` too?]
-
-
-### CPU
-
-These features should be mutually exclusive:
-
- - `:X86`
- - `:X86-64`
- - `:PPC`
- - `:PPC64`
- - `:MIPS`
- - `:ALPHA`
- - `:SPARC`
- - `:SPARC64`
- - `:HPPA`
- - `:HPPA64`
-
-[add more ...]
-
-[note: it's debatable whether `:X86` shouldn't also be exported on
-x86-64, and `:PPC` on ppc64. SBCL doesn't. Other ways
-to handle, for example, the x86/x86-64 case would be to export
-something like `:PC386` in both cases or have an additional `:X86-32`. Or
-finally, have just `:X86`, `:PPC`, etc, and add `:32-BIT-CPU` and
-`:64-BIT-CPU` features.]
-
-
-Unreferenced References
------------------------
-
- * [CLHS: Variable \*FEATURES\*][1]
- * [Maintaining Portable Lisp Programs][2], by Christophe Rhodes
-
-
-[1]: http://www.lispworks.com/documentation/HyperSpec/Body/v_featur.htm
-[2]: http://www-jcsu.jesus.cam.ac.uk/~csr21/papers/features.pdf
(DIR) diff --git a/3rdparties/software/trivial-features-20161204-git/release.lisp b/3rdparties/software/trivial-features-20161204-git/release.lisp
@@ -1,247 +0,0 @@
-#!/usr/bin/env clisp
-;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
-
-(defpackage :release-script (:use #:cl #:regexp))
-(in-package :release-script)
-
-;;;; Configuration ------------------------------------------------------------
-
-(defparameter *project-name* "trivial-features")
-(defparameter *asdf-file* (format nil "~A.asd" *project-name*))
-
-(defparameter *host* "common-lisp.net")
-(defparameter *release-dir*
- (format nil "public_html/tarballs/~A/" *project-name*))
-
-(defparameter *version-file* nil)
-(defparameter *version-file-dir* nil)
-
-;;;; --------------------------------------------------------------------------
-
-;;;; Utilities
-
-(defun ensure-list (x)
- (if (listp x) x (list x)))
-
-(defmacro string-case (expression &body clauses)
- `(let ((it ,expression)) ; yes, anaphoric, deal with it.
- (cond
- ,@(loop for clause in clauses collect
- `((or ,@(loop for alternative in (ensure-list (first clause))
- collect (or (eq t alternative)
- `(string= it ,alternative))))
- ,@(rest clause))))))
-
-(defparameter *development-mode* t)
-
-(defun die (format-control &rest format-args)
- (format *error-output* "~?" format-control format-args)
- (if *development-mode*
- (cerror "continue" "die")
- (ext:quit 1)))
-
-(defun numeric-split (string)
- (if (digit-char-p (char string 0))
- (multiple-value-bind (number next-position)
- (parse-integer string :junk-allowed t)
- (cons number (when (< next-position (length string))
- (numeric-split (subseq string next-position)))))
- (let ((next-digit-position (position-if #'digit-char-p string)))
- (if next-digit-position
- (cons (subseq string 0 next-digit-position)
- (numeric-split (subseq string next-digit-position)))
- (list string)))))
-
-(defun natural-string-< (s1 s2)
- (labels ((aux< (l1 l2)
- (cond ((null l1) (not (null l2)))
- ((null l2) nil)
- (t (destructuring-bind (x . xs) l1
- (destructuring-bind (y . ys) l2
- (cond ((and (numberp x) (stringp y))
- t)
- ((and (numberp y) (stringp x))
- nil)
- ((and (numberp x) (numberp y))
- (or (< x y) (and (= x y) (aux< xs ys))))
- (t
- (or (string-lessp x y)
- (and (string-equal x y)
- (aux< xs ys)))))))))))
- (aux< (numeric-split s1)
- (numeric-split s2))))
-
-;;;; Running commands
-
-(defparameter *dry-run* nil)
-
-(defun cmd? (format-control &rest format-args)
- (let ((cmd (format nil "~?" format-control format-args)))
- (with-open-stream (s1 (ext:run-shell-command cmd :output :stream))
- (loop for line = (read-line s1 nil nil)
- while line
- collect line))))
-
-;; XXX: quote arguments.
-(defun cmd (format-control &rest format-args)
- (when *development-mode*
- (format *debug-io* "CMD: ~?~%" format-control format-args))
- (let ((ret (ext:run-shell-command (format nil "~?" format-control format-args))))
- (or (null ret)
- (zerop ret))))
-
-(defun cmd! (format-control &rest format-args)
- (or (apply #'cmd format-control format-args)
- (die "cmd '~?' failed." format-control format-args)))
-
-(defun maybe-cmd! (format-control &rest format-args)
- (if *dry-run*
- (format t "SUPPRESSING: ~?~%" format-control format-args)
- (apply #'cmd! format-control format-args)))
-
-;;;;
-
-(defun find-current-version ()
- (subseq (reduce (lambda (x y) (if (natural-string-< x y) y x))
- (cmd? "git tag -l v\\*"))
- 1))
-
-(defun parse-version (string)
- (mapcar (lambda (x)
- (parse-integer x :junk-allowed t))
- (loop repeat 3 ; XXX: parameterize
- for el in (regexp-split "\\." (find-current-version))
- collect el)))
-
-(defun check-for-unrecorded-changes (&optional force)
- (unless (cmd "git diff --exit-code")
- (write-line "Unrecorded changes.")
- (if force
- (write-line "Continuing anyway.")
- (die "Aborting.~@
- Use -f or --force if you want to make a release anyway."))))
-
-(defun new-version-number-candidates (current-version)
- (let ((current-version (parse-version current-version)))
- (labels ((alternatives (before after)
- (when after
- (cons (append before (list (1+ (first after)))
- (mapcar (constantly 0) (rest after)))
- (alternatives (append before (list (first after)))
- (rest after))))))
- (loop for alt in (alternatives nil current-version)
- collect (reduce (lambda (acc next)
- (format nil "~a.~a" acc next))
- alt)))))
-
-(defun ask-user-for-version (current-version next-versions)
- (format *query-io* "Current version is ~A. Which will be the next one?~%"
- current-version)
- (loop for i from 1 and version in next-versions
- do (format *query-io* "~T~A) ~A~%" i version))
- (format *query-io* "? ")
- (finish-output *query-io*)
- (nth (1- (parse-integer (read-line) :junk-allowed t))
- next-versions))
-
-(defun git-tag-tree (version)
- (write-line "Tagging the tree...")
- (maybe-cmd! "git tag \"v~A\"" version))
-
-(defun add-version-to-system-file (version path-in path-out)
- (with-open-file (in path-in :direction :input)
- (with-open-file (out path-out :direction :output)
- (loop for line = (read-line in nil nil) while line
- do (write-line line out)
- when (string= #1="(defsystem " line
- :end2 (min (length #1#) (length line)))
- do (format out " :version ~s~%" version)))))
-
-(defun create-dist (version distname)
- (write-line "Creating distribution...")
- (cmd! "mkdir \"~a\"" distname)
- (cmd! "git archive master | tar xC \"~A\"" distname)
- (format t "Updating ~A with new version: ~A~%" *asdf-file* version)
- (let* ((asdf-file-path (format nil "~A/~A" distname *asdf-file*))
- (tmp-asdf-file-path (format nil "~a.tmp" asdf-file-path)))
- (add-version-to-system-file version asdf-file-path tmp-asdf-file-path)
- (cmd! "mv \"~a\" \"~a\"" tmp-asdf-file-path asdf-file-path)))
-
-(defun tar-and-sign (distname tarball)
- (write-line "Creating and signing tarball...")
- (cmd! "tar czf \"~a\" \"~a\"" tarball distname)
- (cmd! "gpg -b -a \"~a\"" tarball))
-
-(defparameter *remote-directory* (format nil "~A:~A" *host* *release-dir*))
-
-(defun upload-tarball (tarball signature remote-directory)
- (write-line "Copying tarball to web server...")
- (maybe-cmd! "scp \"~A\" \"~A\" \"~A\"" tarball signature remote-directory)
- (format t "Uploaded ~A and ~A.~%" tarball signature))
-
-(defun update-remote-links (tarball signature host release-dir project-name)
- (format t "Updating ~A_latest links...~%" project-name)
- (maybe-cmd! "ssh \"~A\" ln -sf \"~A\" \"~A/~A_latest.tar.gz\""
- host tarball release-dir project-name)
- (maybe-cmd! "ssh \"~A\" ln -sf \"~A\" \"~A/~A_latest.tar.gz.asc\""
- host signature release-dir project-name))
-
-(defun upload-version-file (version version-file host version-file-dir)
- (format t "Uploading ~A...~%" version-file)
- (maybe-cmd! "echo -n \"~A\" > \"~A\"" version version-file)
- (maybe-cmd! "scp \"~A\" \"~A\":\"~A\"" version-file host version-file-dir)
- (maybe-cmd! "rm \"~A\"" version-file))
-
-(defun maybe-clean-things-up (tarball signature)
- (when (y-or-n-p "Clean local tarball and signature?")
- (cmd! "rm \"~A\" \"~A\"" tarball signature)))
-
-(defun run (force version)
- (check-for-unrecorded-changes force)
- ;; figure out what version we'll be preparing.
- (unless version
- (let* ((current-version (find-current-version))
- (next-versions (new-version-number-candidates current-version)))
- (setf version (or (ask-user-for-version current-version next-versions)
- (die "invalid selection.")))))
- (git-tag-tree version)
- (let* ((distname (format nil "~A_~A" *project-name* version))
- (tarball (format nil "~A.tar.gz" distname))
- (signature (format nil "~A.asc" tarball)))
- ;; package things up.
- (create-dist version distname)
- (tar-and-sign distname tarball)
- ;; upload.
- (upload-tarball tarball signature *remote-directory*)
- (update-remote-links tarball signature *host* *release-dir* *project-name*)
- (when *version-file*
- (upload-version-file version *version-file* *host* *version-file-dir*))
- ;; clean up.
- (maybe-clean-things-up tarball signature)
- ;; documentation.
- ;; (write-line "Building and uploading documentation...")
- ;; (maybe-cmd! "make -C doc upload-docs")
- ;; push tags and any outstanding changes.
- (write-line "Pushing tags and changes...")
- (maybe-cmd! "git push --tags origin master")))
-
-
-;;;; Do it to it
-
-(let ((force nil)
- (version nil)
- (args ext:*args*))
- (loop while args
- do (string-case (pop args)
- (("-h" "--help")
- (write-line "No help, sorry. Read the source.")
- (ext:quit 0))
- (("-f" "--force")
- (setf force t))
- (("-v" "--version")
- (setf version (pop args)))
- (("-n" "--dry-run")
- (setf *dry-run* t))
- (t
- (die "Unrecognized argument '~a'" it))))
- (run force version))
(DIR) diff --git a/3rdparties/software/trivial-features-20161204-git/src/tf-abcl.lisp b/3rdparties/software/trivial-features-20161204-git/src/tf-abcl.lisp
@@ -1,46 +0,0 @@
-;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
-;;;
-;;; tf-abcl.lisp --- ABCL trivial-features implementation.
-;;;
-;;; Copyright (C) 2009, Luis Oliveira <loliveira@common-lisp.net>
-;;;
-;;; Permission is hereby granted, free of charge, to any person
-;;; obtaining a copy of this software and associated documentation
-;;; files (the "Software"), to deal in the Software without
-;;; restriction, including without limitation the rights to use, copy,
-;;; modify, merge, publish, distribute, sublicense, and/or sell copies
-;;; of the Software, and to permit persons to whom the Software is
-;;; furnished to do so, subject to the following conditions:
-;;;
-;;; The above copyright notice and this permission notice shall be
-;;; included in all copies or substantial portions of the Software.
-;;;
-;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
-;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
-;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
-;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
-;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
-;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
-;;; DEALINGS IN THE SOFTWARE.
-
-(in-package :cl-user)
-
-;;;; Endianness
-
-(pushnew (let ((order (jcall "toString"
- (jstatic "nativeOrder" "java.nio.ByteOrder"))))
- (cond ((string-equal order "LITTLE_ENDIAN")
- :little-endian)
- ((string-equal order "BIG_ENDIAN")
- :big-endian)
- (t (error "Byte order ~A unknown" order))))
- *features*)
-
-;;;; OS
-
-;;; ABCL already pushes :LINUX and :UNIX.
-
-;;;; CPU
-
-;;; ABCL already pushes :x86-64
-\ No newline at end of file
(DIR) diff --git a/3rdparties/software/trivial-features-20161204-git/src/tf-allegro.lisp b/3rdparties/software/trivial-features-20161204-git/src/tf-allegro.lisp
@@ -1,49 +0,0 @@
-;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
-;;;
-;;; tf-allegro.lisp --- Allegro implementation of trivial-features.
-;;;
-;;; Copyright (C) 2007, Luis Oliveira <loliveira@common-lisp.net>
-;;;
-;;; Permission is hereby granted, free of charge, to any person
-;;; obtaining a copy of this software and associated documentation
-;;; files (the "Software"), to deal in the Software without
-;;; restriction, including without limitation the rights to use, copy,
-;;; modify, merge, publish, distribute, sublicense, and/or sell copies
-;;; of the Software, and to permit persons to whom the Software is
-;;; furnished to do so, subject to the following conditions:
-;;;
-;;; The above copyright notice and this permission notice shall be
-;;; included in all copies or substantial portions of the Software.
-;;;
-;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
-;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
-;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
-;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
-;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
-;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
-;;; DEALINGS IN THE SOFTWARE.
-
-(in-package :cl-user)
-
-;;;; Endianness
-
-;;; Allegro already pushes :LITTLE-ENDIAN and :BIG-ENDIAN.
-
-;;;; OS
-
-;;; Allegro already pushes :LINUX and :UNIX.
-
-#+mswindows (pushnew :windows *features*)
-#+macosx (pushnew :darwin *features*)
-
-;;; Pushing :BSD. (Make sure this list is complete.)
-#+(or macosx darwin freebsd netbsd openbsd)
-(pushnew :bsd *features*)
-
-;;;; CPU
-
-;;; Allegro already pushes :X86 and :X86-64.
-
-;;; what about PPC64?
-#+powerpc (pushnew :ppc *features*)
(DIR) diff --git a/3rdparties/software/trivial-features-20161204-git/src/tf-clasp.lisp b/3rdparties/software/trivial-features-20161204-git/src/tf-clasp.lisp
@@ -1,36 +0,0 @@
-;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
-;;;
-;;; tf-clasp.lisp --- CLASP implementation of trivial-features.
-;;;
-;;; Permission is hereby granted, free of charge, to any person
-;;; obtaining a copy of this software and associated documentation
-;;; files (the "Software"), to deal in the Software without
-;;; restriction, including without limitation the rights to use, copy,
-;;; modify, merge, publish, distribute, sublicense, and/or sell copies
-;;; of the Software, and to permit persons to whom the Software is
-;;; furnished to do so, subject to the following conditions:
-;;;
-;;; The above copyright notice and this permission notice shall be
-;;; included in all copies or substantial portions of the Software.
-;;;
-;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
-;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
-;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
-;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
-;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
-;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
-;;; DEALINGS IN THE SOFTWARE.
-
-(in-package :cl-user)
-
-;;;; Endianness
-;;; - Set by CLASP directly. Sets :LITTLE-ENDIAN or :BIG-ENDIAN
-
-;;;; OS
-;;; - Set by CLASP directly. Already pushes :DARWIN, :LINUX, :UNIX, :BSD
-
-;;;; CPU
-;;; - Set by CLASP directly. Already pushes :X86-64 (currently the only
-;;; supported platform) - More will be added directly in CLASP as soon as
-;;; porting is done.
(DIR) diff --git a/3rdparties/software/trivial-features-20161204-git/src/tf-clisp.lisp b/3rdparties/software/trivial-features-20161204-git/src/tf-clisp.lisp
@@ -1,72 +0,0 @@
-;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
-;;;
-;;; tf-clisp.lisp --- CLISP trivial-features implementation.
-;;;
-;;; Copyright (C) 2007, Luis Oliveira <loliveira@common-lisp.net>
-;;;
-;;; Permission is hereby granted, free of charge, to any person
-;;; obtaining a copy of this software and associated documentation
-;;; files (the "Software"), to deal in the Software without
-;;; restriction, including without limitation the rights to use, copy,
-;;; modify, merge, publish, distribute, sublicense, and/or sell copies
-;;; of the Software, and to permit persons to whom the Software is
-;;; furnished to do so, subject to the following conditions:
-;;;
-;;; The above copyright notice and this permission notice shall be
-;;; included in all copies or substantial portions of the Software.
-;;;
-;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
-;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
-;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
-;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
-;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
-;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
-;;; DEALINGS IN THE SOFTWARE.
-
-(in-package :cl-user)
-
-;;;; Endianness
-
-(pushnew (intern (symbol-name (if sys::*big-endian*
- '#:big-endian
- '#:little-endian))
- '#:keyword)
- *features*)
-
-;;;; OS
-
-;;; CLISP already exports :UNIX.
-
-#+win32 (pushnew :windows *features*)
-
-#-win32
-(eval-when (:compile-toplevel :load-toplevel :execute)
- (pushnew (with-standard-io-syntax
- (read-from-string
- (format nil ":~(~A~)" (posix:uname-sysname (posix:uname)))))
- *features*))
-
-#+(or darwin freebsd netbsd openbsd)
-(pushnew :bsd *features*)
-
-;;;; CPU
-
-;;; FIXME: not complete
-(let ((cpu (cond
- ((or (member :pc386 *features*)
- (member (machine-type) '("x86" "x86_64")
- :test #'string-equal))
- (if (member :word-size=64 *features*)
- '#:x86-64
- '#:x86))
- ((string= (machine-type) "POWER MACINTOSH")
- '#:ppc)
- ((or (member (machine-type) '("SPARC" "SPARC64")
- :test #'string-equal))
- (if (member :word-size=64 *features*)
- '#:sparc64
- '#:sparc)))))
- (when cpu
- (pushnew (intern (symbol-name cpu) '#:keyword)
- *features*)))
(DIR) diff --git a/3rdparties/software/trivial-features-20161204-git/src/tf-cmucl.lisp b/3rdparties/software/trivial-features-20161204-git/src/tf-cmucl.lisp
@@ -1,44 +0,0 @@
-;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
-;;;
-;;; tf-cmucl.lisp --- CMUCL implementation of trivial-features.
-;;;
-;;; Copyright (C) 2007, Luis Oliveira <loliveira@common-lisp.net>
-;;;
-;;; Permission is hereby granted, free of charge, to any person
-;;; obtaining a copy of this software and associated documentation
-;;; files (the "Software"), to deal in the Software without
-;;; restriction, including without limitation the rights to use, copy,
-;;; modify, merge, publish, distribute, sublicense, and/or sell copies
-;;; of the Software, and to permit persons to whom the Software is
-;;; furnished to do so, subject to the following conditions:
-;;;
-;;; The above copyright notice and this permission notice shall be
-;;; included in all copies or substantial portions of the Software.
-;;;
-;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
-;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
-;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
-;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
-;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
-;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
-;;; DEALINGS IN THE SOFTWARE.
-
-(in-package :cl-user)
-
-;;;; Endianness
-
-(pushnew (alien:with-alien ((ptr (array (alien:unsigned 8) 2)))
- (setf (sys:sap-ref-16 (alien:alien-sap ptr) 0) #xfeff)
- (ecase (sys:sap-ref-8 (alien:alien-sap ptr) 0)
- (#xfe (intern "BIG-ENDIAN" :keyword))
- (#xff (intern "LITTLE-ENDIAN" :keyword))))
- *features*)
-
-;;;; OS
-
-;;; CMUCL already pushes :UNIX, :BSD, :LINUX and :DARWIN.
-
-;;;; CPU
-
-;;; CMUCL already pushes :PPC and :X86.
(DIR) diff --git a/3rdparties/software/trivial-features-20161204-git/src/tf-corman.lisp b/3rdparties/software/trivial-features-20161204-git/src/tf-corman.lisp
@@ -1,39 +0,0 @@
-;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
-;;;
-;;; tf-corman.lisp --- Corman Lisp implementation of trivial-features.
-;;;
-;;; Copyright (C) 2007, Luis Oliveira <loliveira@common-lisp.net>
-;;;
-;;; Permission is hereby granted, free of charge, to any person
-;;; obtaining a copy of this software and associated documentation
-;;; files (the "Software"), to deal in the Software without
-;;; restriction, including without limitation the rights to use, copy,
-;;; modify, merge, publish, distribute, sublicense, and/or sell copies
-;;; of the Software, and to permit persons to whom the Software is
-;;; furnished to do so, subject to the following conditions:
-;;;
-;;; The above copyright notice and this permission notice shall be
-;;; included in all copies or substantial portions of the Software.
-;;;
-;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
-;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
-;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
-;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
-;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
-;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
-;;; DEALINGS IN THE SOFTWARE.
-
-(in-package :cl-user)
-
-;;;; Endianness
-
-(pushnew :little-endian *features*)
-
-;;;; OS
-
-(pushnew :windows *features*)
-
-;;;; CPU
-
-(pushnew :x86 *features*)
(DIR) diff --git a/3rdparties/software/trivial-features-20161204-git/src/tf-ecl.lisp b/3rdparties/software/trivial-features-20161204-git/src/tf-ecl.lisp
@@ -1,55 +0,0 @@
-;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
-;;;
-;;; tf-ecl.lisp --- ECL implementation of trivial-features.
-;;;
-;;; Copyright (C) 2007-2009, Luis Oliveira <loliveira@common-lisp.net>
-;;;
-;;; Permission is hereby granted, free of charge, to any person
-;;; obtaining a copy of this software and associated documentation
-;;; files (the "Software"), to deal in the Software without
-;;; restriction, including without limitation the rights to use, copy,
-;;; modify, merge, publish, distribute, sublicense, and/or sell copies
-;;; of the Software, and to permit persons to whom the Software is
-;;; furnished to do so, subject to the following conditions:
-;;;
-;;; The above copyright notice and this permission notice shall be
-;;; included in all copies or substantial portions of the Software.
-;;;
-;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
-;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
-;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
-;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
-;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
-;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
-;;; DEALINGS IN THE SOFTWARE.
-
-(in-package :cl-user)
-
-;;;; Endianness
-
-(pushnew (let ((ptr (ffi:allocate-foreign-object :unsigned-short)))
- (unwind-protect
- (progn
- (setf (ffi:deref-pointer ptr :unsigned-short) #xfeff)
- (ecase (ffi:deref-pointer ptr :unsigned-byte)
- (#xfe (intern "BIG-ENDIAN" "KEYWORD"))
- (#xff (intern "LITTLE-ENDIAN" "KEYWORD"))))
- (ffi:free-foreign-object ptr)))
- *features*)
-
-;;;; OS
-
-;;; ECL already pushes :DARWIN, :LINUX, :UNIX (except on Darwin) and :BSD.
-
-#+darwin (pushnew :unix *features*)
-#+win32 (pushnew :windows *features*)
-
-;;;; CPU
-
-;;; FIXME: add more
-#+powerpc7450 (pushnew :ppc *features*)
-#+x86_64 (pushnew :x86-64 *features*)
-#+(or i386 i486 i586 i686) (pushnew :x86 *features*)
-#+(or armv5l armv6l armv7l) (pushnew :arm *features*)
-#+mipsel (pushnew :mips *features*)
(DIR) diff --git a/3rdparties/software/trivial-features-20161204-git/src/tf-lispworks.lisp b/3rdparties/software/trivial-features-20161204-git/src/tf-lispworks.lisp
@@ -1,58 +0,0 @@
-;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
-;;;
-;;; tf-lispworks.lisp --- Lispworks implementation of trivial-features.
-;;;
-;;; Copyright (C) 2007, Luis Oliveira <loliveira@common-lisp.net>
-;;;
-;;; Permission is hereby granted, free of charge, to any person
-;;; obtaining a copy of this software and associated documentation
-;;; files (the "Software"), to deal in the Software without
-;;; restriction, including without limitation the rights to use, copy,
-;;; modify, merge, publish, distribute, sublicense, and/or sell copies
-;;; of the Software, and to permit persons to whom the Software is
-;;; furnished to do so, subject to the following conditions:
-;;;
-;;; The above copyright notice and this permission notice shall be
-;;; included in all copies or substantial portions of the Software.
-;;;
-;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
-;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
-;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
-;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
-;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
-;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
-;;; DEALINGS IN THE SOFTWARE.
-
-(in-package :cl-user)
-
-;;;; Endianness
-
-;;; Lispworks pushes :LITTLE-ENDIAN.
-
-#-little-endian (pushnew :big-endian *features*)
-
-#-(and)
-(pushnew (fli:with-dynamic-foreign-objects ()
- (let ((ptr (fli:alloca :type :byte :nelems 2)))
- (setf (fli:dereference ptr :type '(:unsigned :short)) #xfeff)
- (ecase (fli:dereference ptr :type '(:unsigned :byte))
- (#xfe (intern "BIG-ENDIAN" :keyword))
- (#xff (intern "LITTLE-ENDIAN" :keyword)))))
- *features*)
-
-;;;; OS
-
-;;; Lispworks already pushes :DARWIN, :LINUX and :UNIX.
-
-#+win32 (pushnew :windows *features*)
-
-;;; Pushing :BSD. (Make sure this list is complete.)
-#+(or darwin freebsd netbsd openbsd)
-(pushnew :bsd *features*)
-
-;;;; CPU
-
-;;; Lispworks already pushes :X86.
-
-#+powerpc (pushnew :ppc *features*)
(DIR) diff --git a/3rdparties/software/trivial-features-20161204-git/src/tf-mcl.lisp b/3rdparties/software/trivial-features-20161204-git/src/tf-mcl.lisp
@@ -1,41 +0,0 @@
-;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
-;;;
-;;; tf-mcl.lisp --- Digitool MCL trivial-features implementation.
-;;;
-;;; Copyright (C) 2010, Chun Tian (binghe) <binghe.lisp@gmail.com>
-;;;
-;;; Permission is hereby granted, free of charge, to any person
-;;; obtaining a copy of this software and associated documentation
-;;; files (the "Software"), to deal in the Software without
-;;; restriction, including without limitation the rights to use, copy,
-;;; modify, merge, publish, distribute, sublicense, and/or sell copies
-;;; of the Software, and to permit persons to whom the Software is
-;;; furnished to do so, subject to the following conditions:
-;;;
-;;; The above copyright notice and this permission notice shall be
-;;; included in all copies or substantial portions of the Software.
-;;;
-;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
-;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
-;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
-;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
-;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
-;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
-;;; DEALINGS IN THE SOFTWARE.
-
-(in-package :cl-user)
-
-;;;; Endianness
-
-(pushnew :big-endian *features*)
-
-;;;; OS
-
-;;; MCL already pushes :UNIX and :DARWIN.
-
-(pushnew :bsd *features*)
-
-;;;; CPU
-
-#+ppc-target (pushnew :ppc *features*)
(DIR) diff --git a/3rdparties/software/trivial-features-20161204-git/src/tf-mkcl.lisp b/3rdparties/software/trivial-features-20161204-git/src/tf-mkcl.lisp
@@ -1,49 +0,0 @@
-;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
-;;;
-;;; tf-mkcl.lisp --- MKCL implementation of trivial-features.
-;;;
-;;; Copyright (C) 2007-2009, Luis Oliveira <loliveira@common-lisp.net>
-;;;
-;;; Permission is hereby granted, free of charge, to any person
-;;; obtaining a copy of this software and associated documentation
-;;; files (the "Software"), to deal in the Software without
-;;; restriction, including without limitation the rights to use, copy,
-;;; modify, merge, publish, distribute, sublicense, and/or sell copies
-;;; of the Software, and to permit persons to whom the Software is
-;;; furnished to do so, subject to the following conditions:
-;;;
-;;; The above copyright notice and this permission notice shall be
-;;; included in all copies or substantial portions of the Software.
-;;;
-;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
-;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
-;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
-;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
-;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
-;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
-;;; DEALINGS IN THE SOFTWARE.
-
-(in-package :cl-user)
-
-;;;; Endianness
-
-#-(or :little-endian :big-endian)
-(pushnew (let ((ptr (ffi:allocate-foreign-object :unsigned-short)))
- (unwind-protect
- (progn
- (setf (ffi:deref-pointer ptr :unsigned-short) #xfeff)
- (ecase (ffi:deref-pointer ptr :unsigned-byte)
- (#xfe (intern "BIG-ENDIAN" "KEYWORD"))
- (#xff (intern "LITTLE-ENDIAN" "KEYWORD"))))
- (ffi:free-foreign-object ptr)))
- *features*)
-
-;;;; OS
-
-;;; MKCL conforms to SPEC
-
-;;;; CPU
-
-;;; MKCL conforms to SPEC
-
(DIR) diff --git a/3rdparties/software/trivial-features-20161204-git/src/tf-mocl.lisp b/3rdparties/software/trivial-features-20161204-git/src/tf-mocl.lisp
@@ -1,40 +0,0 @@
-;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
-;;;
-;;; tf-mocl.lisp --- MOCL trivial-features implementation.
-;;;
-;;; Copyright (C) 2007, Luis Oliveira <loliveira@common-lisp.net>
-;;;
-;;; Permission is hereby granted, free of charge, to any person
-;;; obtaining a copy of this software and associated documentation
-;;; files (the "Software"), to deal in the Software without
-;;; restriction, including without limitation the rights to use, copy,
-;;; modify, merge, publish, distribute, sublicense, and/or sell copies
-;;; of the Software, and to permit persons to whom the Software is
-;;; furnished to do so, subject to the following conditions:
-;;;
-;;; The above copyright notice and this permission notice shall be
-;;; included in all copies or substantial portions of the Software.
-;;;
-;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
-;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
-;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
-;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
-;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
-;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
-;;; DEALINGS IN THE SOFTWARE.
-
-(in-package :cl-user)
-
-;;;; Endianness
-
-;;; MOCL already pushes :LITTLE-ENDIAN.
-
-;;;; OS
-
-;;; MOCL already pushes :IOS, :DARWIN, :BSD, and :UNIX for iOS,
-;;; and :ANDROID, :LINUX, and :UNIX for Android.
-
-;;;; CPU
-
-;;; MOCL already pushes :ARM.
(DIR) diff --git a/3rdparties/software/trivial-features-20161204-git/src/tf-openmcl.lisp b/3rdparties/software/trivial-features-20161204-git/src/tf-openmcl.lisp
@@ -1,47 +0,0 @@
-;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
-;;;
-;;; tf-openmcl.lisp --- OpenMCL trivial-features implementation.
-;;;
-;;; Copyright (C) 2007, Luis Oliveira <loliveira@common-lisp.net>
-;;;
-;;; Permission is hereby granted, free of charge, to any person
-;;; obtaining a copy of this software and associated documentation
-;;; files (the "Software"), to deal in the Software without
-;;; restriction, including without limitation the rights to use, copy,
-;;; modify, merge, publish, distribute, sublicense, and/or sell copies
-;;; of the Software, and to permit persons to whom the Software is
-;;; furnished to do so, subject to the following conditions:
-;;;
-;;; The above copyright notice and this permission notice shall be
-;;; included in all copies or substantial portions of the Software.
-;;;
-;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
-;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
-;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
-;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
-;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
-;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
-;;; DEALINGS IN THE SOFTWARE.
-
-(in-package :cl-user)
-
-;;;; Endianness
-
-(pushnew #+big-endian-target :big-endian
- #+little-endian-target :little-endian
- *features*)
-
-;;;; OS
-
-;;; OpenMCL already pushes :UNIX and :DARWIN.
-
-#+linux-target (pushnew :linux *features*)
-
-#+darwin (pushnew :bsd *features*)
-
-;;;; CPU
-
-;;; what about ppc64?
-#+ppc-target (pushnew :ppc *features*)
-#+x8664-target (pushnew :x86-64 *features*)
(DIR) diff --git a/3rdparties/software/trivial-features-20161204-git/src/tf-sbcl.lisp b/3rdparties/software/trivial-features-20161204-git/src/tf-sbcl.lisp
@@ -1,51 +0,0 @@
-;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
-;;;
-;;; tf-sbcl.lisp --- SBCL trivial-features implementation.
-;;;
-;;; Copyright (C) 2007-2009, Luis Oliveira <loliveira@common-lisp.net>
-;;;
-;;; Permission is hereby granted, free of charge, to any person
-;;; obtaining a copy of this software and associated documentation
-;;; files (the "Software"), to deal in the Software without
-;;; restriction, including without limitation the rights to use, copy,
-;;; modify, merge, publish, distribute, sublicense, and/or sell copies
-;;; of the Software, and to permit persons to whom the Software is
-;;; furnished to do so, subject to the following conditions:
-;;;
-;;; The above copyright notice and this permission notice shall be
-;;; included in all copies or substantial portions of the Software.
-;;;
-;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
-;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
-;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
-;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
-;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
-;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
-;;; DEALINGS IN THE SOFTWARE.
-
-(in-package :cl-user)
-
-;;;; Endianness
-
-(pushnew (sb-alien:with-alien ((ptr (array (sb-alien:unsigned 8) 2)))
- (setf (sb-sys:sap-ref-16 (sb-alien:alien-sap ptr) 0) #xfeff)
- (ecase (sb-sys:sap-ref-8 (sb-alien:alien-sap ptr) 0)
- (#xfe (intern "BIG-ENDIAN" :keyword))
- (#xff (intern "LITTLE-ENDIAN" :keyword))))
- *features*)
-
-;;;; OS
-
-;;; SBCL already pushes :DARWIN, :LINUX, :BSD and :UNIX.
-
-#+win32
-(progn
- ;; note: as of 2008 or so, SBCL doesn't push :UNIX and :WIN32
- ;; simultaneously anymore.
- (setq *features* (remove :unix *features*))
- (pushnew :windows *features*))
-
-;;;; CPU
-
-;;; SBCL already pushes: :X86, :X86-64, and :PPC
(DIR) diff --git a/3rdparties/software/trivial-features-20161204-git/src/tf-scl.lisp b/3rdparties/software/trivial-features-20161204-git/src/tf-scl.lisp
@@ -1,47 +0,0 @@
-;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
-;;;
-;;; tf-scl.lisp --- SCL implementation of trivial-features.
-;;;
-;;; Copyright (C) 2007, Luis Oliveira <loliveira@common-lisp.net>
-;;;
-;;; Permission is hereby granted, free of charge, to any person
-;;; obtaining a copy of this software and associated documentation
-;;; files (the "Software"), to deal in the Software without
-;;; restriction, including without limitation the rights to use, copy,
-;;; modify, merge, publish, distribute, sublicense, and/or sell copies
-;;; of the Software, and to permit persons to whom the Software is
-;;; furnished to do so, subject to the following conditions:
-;;;
-;;; The above copyright notice and this permission notice shall be
-;;; included in all copies or substantial portions of the Software.
-;;;
-;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
-;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
-;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
-;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
-;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
-;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
-;;; DEALINGS IN THE SOFTWARE.
-
-(in-package :cl-user)
-
-;;;; Endianness
-
-(pushnew (alien:with-alien ((ptr (array (alien:unsigned 8) 2)))
- (setf (sys:sap-ref-16 (alien:alien-sap ptr) 0) #xfeff)
- (ecase (sys:sap-ref-8 (alien:alien-sap ptr) 0)
- (#xfe (intern (symbol-name '#:big-endian) '#:keyword))
- (#xff (intern (symbol-name '#:little-endian) '#:keyword))))
- *features*)
-
-;;;; OS
-
-;;; SCL already pushes :unix, :bsd, :linux, :hpux, and :solaris
-
-;;;; CPU
-
-;;; SCL already pushes :amd64, :x86, :sparc, :sparc64, :hppa and :hppa64.
-;;; For 64 bit CPUs the SCL pushes: :64bit
-
-#+amd64 (pushnew :x86-64 *features*)
(DIR) diff --git a/3rdparties/software/trivial-features-20161204-git/src/tf-xcl.lisp b/3rdparties/software/trivial-features-20161204-git/src/tf-xcl.lisp
@@ -1,39 +0,0 @@
-;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
-;;;
-;;; tf-xcl.lisp --- XCL trivial-features implementation.
-;;;
-;;; Copyright (C) 2009, Luis Oliveira <loliveira@common-lisp.net>
-;;;
-;;; Permission is hereby granted, free of charge, to any person
-;;; obtaining a copy of this software and associated documentation
-;;; files (the "Software"), to deal in the Software without
-;;; restriction, including without limitation the rights to use, copy,
-;;; modify, merge, publish, distribute, sublicense, and/or sell copies
-;;; of the Software, and to permit persons to whom the Software is
-;;; furnished to do so, subject to the following conditions:
-;;;
-;;; The above copyright notice and this permission notice shall be
-;;; included in all copies or substantial portions of the Software.
-;;;
-;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
-;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
-;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
-;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
-;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
-;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
-;;; DEALINGS IN THE SOFTWARE.
-
-(in-package :cl-user)
-
-;;;; Endianness
-
-;;; XCL already pushes :LITTLE-ENDIAN.
-
-;;;; OS
-
-;;; XCL already pushes :LINUX, :UNIX, :FREEBSD, :NETBSD, :BSD and :WINDOWS.
-
-;;;; CPU
-
-;;; XCL already pushes :X86 and :X86-64.
(DIR) diff --git a/3rdparties/software/trivial-features-20161204-git/tests/package.lisp b/3rdparties/software/trivial-features-20161204-git/tests/package.lisp
@@ -1,34 +0,0 @@
-;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
-;;;
-;;; package.lisp --- TRIVIAL-FEATURES-TESTS package definition.
-;;;
-;;; Copyright (C) 2007, Luis Oliveira <loliveira@common-lisp.net>
-;;;
-;;; Permission is hereby granted, free of charge, to any person
-;;; obtaining a copy of this software and associated documentation
-;;; files (the "Software"), to deal in the Software without
-;;; restriction, including without limitation the rights to use, copy,
-;;; modify, merge, publish, distribute, sublicense, and/or sell copies
-;;; of the Software, and to permit persons to whom the Software is
-;;; furnished to do so, subject to the following conditions:
-;;;
-;;; The above copyright notice and this permission notice shall be
-;;; included in all copies or substantial portions of the Software.
-;;;
-;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
-;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
-;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
-;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
-;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
-;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
-;;; DEALINGS IN THE SOFTWARE.
-
-(in-package :cl-user)
-
-(defpackage :trivial-features-tests
- (:use :common-lisp
- :regression-test
- :alexandria
- :cffi)
- (:export #:run))
(DIR) diff --git a/3rdparties/software/trivial-features-20161204-git/tests/sysinfo.lisp b/3rdparties/software/trivial-features-20161204-git/tests/sysinfo.lisp
@@ -1,49 +0,0 @@
-;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
-;;;
-;;; sysinfo.lisp --- FFI definitions for GetSystemInfo().
-;;;
-;;; Copyright (C) 2007, Luis Oliveira <loliveira@common-lisp.net>
-;;;
-;;; Permission is hereby granted, free of charge, to any person
-;;; obtaining a copy of this software and associated documentation
-;;; files (the "Software"), to deal in the Software without
-;;; restriction, including without limitation the rights to use, copy,
-;;; modify, merge, publish, distribute, sublicense, and/or sell copies
-;;; of the Software, and to permit persons to whom the Software is
-;;; furnished to do so, subject to the following conditions:
-;;;
-;;; The above copyright notice and this permission notice shall be
-;;; included in all copies or substantial portions of the Software.
-;;;
-;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
-;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
-;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
-;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
-;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
-;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
-;;; DEALINGS IN THE SOFTWARE.
-
-(in-package :trivial-features-tests)
-
-(defctype word :unsigned-short)
-
-(defcenum (architecture word)
- (:amd64 9)
- (:ia64 6)
- (:intel 0)
- (:unknown #xffff))
-
-(defcstruct (system-info :size 36)
- (processor-architecture architecture))
-
-(load-foreign-library "kernel32.dll")
-
-(defcfun ("GetSystemInfo" %get-system-info :cconv :stdcall) :void
- (system-info :pointer))
-
-;;; only getting at the CPU architecture for now.
-(defun get-system-info ()
- (with-foreign-object (si 'system-info)
- (%get-system-info si)
- (foreign-slot-value si 'system-info 'processor-architecture)))
(DIR) diff --git a/3rdparties/software/trivial-features-20161204-git/tests/tests.lisp b/3rdparties/software/trivial-features-20161204-git/tests/tests.lisp
@@ -1,130 +0,0 @@
-;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
-;;;
-;;; tests.lisp --- trivial-features tests.
-;;;
-;;; Copyright (C) 2007, Luis Oliveira <loliveira@common-lisp.net>
-;;;
-;;; Permission is hereby granted, free of charge, to any person
-;;; obtaining a copy of this software and associated documentation
-;;; files (the "Software"), to deal in the Software without
-;;; restriction, including without limitation the rights to use, copy,
-;;; modify, merge, publish, distribute, sublicense, and/or sell copies
-;;; of the Software, and to permit persons to whom the Software is
-;;; furnished to do so, subject to the following conditions:
-;;;
-;;; The above copyright notice and this permission notice shall be
-;;; included in all copies or substantial portions of the Software.
-;;;
-;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
-;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
-;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
-;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
-;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
-;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
-;;; DEALINGS IN THE SOFTWARE.
-
-(in-package :trivial-features-tests)
-
-(defun run ()
- (let ((*package* (find-package :trivial-features-tests)))
- (do-tests)
- (null (regression-test:pending-tests))))
-
-;;;; Support Code
-
-#-windows
-(progn
- ;; Hmm, why not just use OSICAT-POSIX:UNAME?
- (defcfun ("uname" %uname) :int
- (buf :pointer))
-
- ;; Get system identification.
- (defun uname ()
- (with-foreign-object (buf '(:struct utsname))
- (when (= (%uname buf) -1)
- (error "uname() returned -1"))
- (macrolet ((utsname-slot (name)
- `(foreign-string-to-lisp
- (foreign-slot-pointer buf 'utsname ',name))))
- (values (utsname-slot sysname)
- ;; (utsname-slot nodename)
- ;; (utsname-slot release)
- ;; (utsname-slot version)
- (utsname-slot machine))))))
-
-(defun mutually-exclusive-p (features)
- (= 1 (loop for feature in features when (featurep feature) count 1)))
-
-;;;; Tests
-
-(deftest endianness.1
- (with-foreign-object (p :uint16)
- (setf (mem-ref p :uint16) #xfeff)
- (ecase (mem-ref p :uint8)
- (#xfe (featurep :big-endian))
- (#xff (featurep :little-endian))))
- t)
-
-(defparameter *bsds* '(:darwin :netbsd :openbsd :freebsd))
-(defparameter *unices* (list* :linux *bsds*))
-
-#+windows
-(deftest os.1
- (featurep (list* :or :unix *unices*))
- nil)
-
-#-windows
-(deftest os.1
- (featurep (make-keyword (string-upcase (uname))))
- t)
-
-(deftest os.2
- (if (featurep :bsd)
- (mutually-exclusive-p *bsds*)
- (featurep `(:not (:or ,@*bsds*))))
- t)
-
-(deftest os.3
- (if (featurep `(:or ,@*unices*))
- (featurep :unix)
- t)
- t)
-
-(deftest os.4
- (if (featurep :windows)
- (not (featurep :unix))
- t)
- t)
-
-(deftest cpu.1
- (mutually-exclusive-p '(:ppc :ppc64 :x86 :x86-64 :alpha :mips))
- t)
-
-#+windows
-(deftest cpu.2
- (case (get-system-info)
- (:intel (featurep :x86))
- (:amd64 (featurep :x86-64))
- (:ia64 nil) ; add this feature later!
- (t t))
- t)
-
-#-windows
-(deftest cpu.2
- (let ((machine (nth-value 1 (uname))))
- (cond ((member machine '("x86" "x86_64") :test #'string=)
- (ecase (foreign-type-size :pointer)
- (4 (featurep :x86))
- (8 (featurep :x86-64))))
- (t
- (format *debug-io*
- "~&; NOTE: unhandled machine type, ~a, in CPU.2 test.~%"
- machine)
- t)))
- t)
-
-;; regression test: sometimes, silly logic leads to pushing nil to
-;; *features*.
-(deftest nil.1 (featurep nil) nil)
-(deftest nil.2 (featurep :nil) nil)
(DIR) diff --git a/3rdparties/software/trivial-features-20161204-git/tests/utsname.lisp b/3rdparties/software/trivial-features-20161204-git/tests/utsname.lisp
@@ -1,36 +0,0 @@
-;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
-;;;
-;;; utsname.lisp --- Grovel definitions for uname(3).
-;;;
-;;; Copyright (C) 2007, Luis Oliveira <loliveira@common-lisp.net>
-;;;
-;;; Permission is hereby granted, free of charge, to any person
-;;; obtaining a copy of this software and associated documentation
-;;; files (the "Software"), to deal in the Software without
-;;; restriction, including without limitation the rights to use, copy,
-;;; modify, merge, publish, distribute, sublicense, and/or sell copies
-;;; of the Software, and to permit persons to whom the Software is
-;;; furnished to do so, subject to the following conditions:
-;;;
-;;; The above copyright notice and this permission notice shall be
-;;; included in all copies or substantial portions of the Software.
-;;;
-;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
-;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
-;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
-;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
-;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
-;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
-;;; DEALINGS IN THE SOFTWARE.
-
-(in-package :trivial-features-tests)
-
-(include "sys/utsname.h")
-
-(cstruct utsname "struct utsname"
- (sysname "sysname" :type :char)
- (nodename "nodename" :type :char)
- (release "release" :type :char)
- (version "version" :type :char)
- (machine "machine" :type :char))
(DIR) diff --git a/3rdparties/software/trivial-features-20161204-git/trivial-features-tests.asd b/3rdparties/software/trivial-features-20161204-git/trivial-features-tests.asd
@@ -1,50 +0,0 @@
-;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
-;;;
-;;; trivial-features-tests.asd --- ASDF definition.
-;;;
-;;; Copyright (C) 2007, Luis Oliveira <loliveira@common-lisp.net>
-;;;
-;;; Permission is hereby granted, free of charge, to any person
-;;; obtaining a copy of this software and associated documentation
-;;; files (the "Software"), to deal in the Software without
-;;; restriction, including without limitation the rights to use, copy,
-;;; modify, merge, publish, distribute, sublicense, and/or sell copies
-;;; of the Software, and to permit persons to whom the Software is
-;;; furnished to do so, subject to the following conditions:
-;;;
-;;; The above copyright notice and this permission notice shall be
-;;; included in all copies or substantial portions of the Software.
-;;;
-;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
-;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
-;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
-;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
-;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
-;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
-;;; DEALINGS IN THE SOFTWARE.
-
-(eval-when (:load-toplevel :execute)
- ;; We need to load trivial-features this way before the the
- ;; defsystem form is read for the corner case when someone loads
- ;; trivial-features-tests before trivial-features since the system
- ;; definition's got a #+windows reader conditional that is supplied
- ;; by trivial-features.
- (oos 'load-op 'trivial-features))
-
-(defsystem trivial-features-tests
- :description "Unit tests for TRIVIAL-FEATURES."
- :defsystem-depends-on (cffi-grovel)
- :depends-on (trivial-features rt cffi alexandria)
- :components
- ((:module tests
- :serial t
- :components
- ((:file "package")
- #-windows (:cffi-grovel-file "utsname")
- #+windows (:file "sysinfo")
- (:file "tests")))))
-
-(defmethod perform ((o test-op) (c (eql (find-system 'trivial-features-tests))))
- (let ((*package* (find-package 'trivial-features-tests)))
- (funcall (find-symbol (symbol-name '#:do-tests)))))
(DIR) diff --git a/3rdparties/software/trivial-features-20161204-git/trivial-features.asd b/3rdparties/software/trivial-features-20161204-git/trivial-features.asd
@@ -1,57 +0,0 @@
-;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
-;;;
-;;; trivial-features.asd --- ASDF system definition.
-;;;
-;;; Copyright (C) 2007, Luis Oliveira <loliveira@common-lisp.net>
-;;;
-;;; Permission is hereby granted, free of charge, to any person
-;;; obtaining a copy of this software and associated documentation
-;;; files (the "Software"), to deal in the Software without
-;;; restriction, including without limitation the rights to use, copy,
-;;; modify, merge, publish, distribute, sublicense, and/or sell copies
-;;; of the Software, and to permit persons to whom the Software is
-;;; furnished to do so, subject to the following conditions:
-;;;
-;;; The above copyright notice and this permission notice shall be
-;;; included in all copies or substantial portions of the Software.
-;;;
-;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
-;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
-;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
-;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
-;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
-;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
-;;; DEALINGS IN THE SOFTWARE.
-
-#-(or sbcl clisp allegro openmcl mcl mkcl lispworks ecl cmu scl cormanlisp abcl xcl mocl clasp)
-(error "Sorry, your Lisp is not supported. Patches welcome.")
-
-(defsystem trivial-features
- :description "Ensures consistent *FEATURES* across multiple CLs."
- :author "Luis Oliveira <loliveira@common-lisp.net>"
- :licence "MIT"
- :components
- ((:module src
- :serial t
- :components
- (#+allegro (:file "tf-allegro")
- #+clisp (:file "tf-clisp")
- #+cmu (:file "tf-cmucl")
- #+cormanlisp (:file "tf-cormanlisp")
- #+ecl (:file "tf-ecl")
- #+lispworks (:file "tf-lispworks")
- #+openmcl (:file "tf-openmcl")
- #+mcl (:file "tf-mcl")
- #+mkcl (:file "tf-mkcl")
- #+sbcl (:file "tf-sbcl")
- #+scl (:file "tf-scl")
- #+abcl (:file "tf-abcl")
- #+xcl (:file "tf-xcl")
- #+mocl (:file "tf-mocl")
- #+clasp (:file "tf-clasp")
- ))))
-
-(defmethod perform ((o test-op) (c (eql (find-system 'trivial-features))))
- (operate 'load-op 'trivial-features-tests)
- (operate 'test-op 'trivial-features-tests))
(DIR) diff --git a/3rdparties/software/trivial-garbage-20181018-git/.gitignore b/3rdparties/software/trivial-garbage-20181018-git/.gitignore
@@ -1,4 +0,0 @@
-*~
-doc/.atdoc.xml
-doc/header.gif
-doc/index.html
(DIR) diff --git a/3rdparties/software/trivial-garbage-20181018-git/.travis.yml b/3rdparties/software/trivial-garbage-20181018-git/.travis.yml
@@ -1,26 +0,0 @@
-language: lisp
-
-env:
- matrix:
- - LISP=abcl
- - LISP=allegro
- - LISP=sbcl
- - LISP=sbcl32
- - LISP=ccl
- - LISP=ccl32
- - LISP=clisp
- - LISP=clisp32
- # - LISP=cmucl
- - LISP=ecl
-
-# matrix:
-# allow_failures:
-# - env: LISP=ecl
-
-install:
- - curl -L https://github.com/luismbo/cl-travis/raw/master/install.sh | sh
-
-script:
- - cl -e '(ql:quickload :trivial-garbage-tests)
- (unless (trivial-garbage-tests:run)
- (uiop:quit 1))'
(DIR) diff --git a/3rdparties/software/trivial-garbage-20181018-git/README.md b/3rdparties/software/trivial-garbage-20181018-git/README.md
@@ -1,12 +0,0 @@
-[](https://travis-ci.org/trivial-garbage/trivial-garbage)
-
-trivial-garbage provides a portable API to finalizers, weak
-hash-tables and weak pointers on all major implementations of the
-Common Lisp programming language.
-
-Documentation is available at the [project's website][1].
-
-It is placed in the public domain with absolutely no warranty.
-
-
-[1]: http://common-lisp.net/project/trivial-garbage/
(DIR) diff --git a/3rdparties/software/trivial-garbage-20181018-git/build.xcvb b/3rdparties/software/trivial-garbage-20181018-git/build.xcvb
@@ -1 +0,0 @@
-#+xcvb (module (:fullname "/trivial-garbage" :depends-on ("trivial-garbage")))
(DIR) diff --git a/3rdparties/software/trivial-garbage-20181018-git/doc/index.css b/3rdparties/software/trivial-garbage-20181018-git/doc/index.css
@@ -1,178 +0,0 @@
-/* based on atdoc's orange-sans.css */
-
-div.sidebar {
- float: right;
- min-width: 15%;
- padding: 0pt 5pt 5pt 5pt;
- font-family: verdana, arial;
-}
-
-a {
- text-decoration: none;
- color: #ee8500;
-/*
- border-bottom: 1px dotted black;
- border-top: 1px solid white;
- border-left: 1px solid white;
- border-right: 1px solid white;
- padding-top: 1px;
- padding-bottom: 1px;
-*/
-}
-
-.nonlink {
- border-bottom: 1px solid white;
- border-top: 1px solid white;
- border-left: 1px solid white;
- border-right: 1px solid white;
- padding-top: 1px;
- padding-bottom: 1px;
-}
-
-.sidebar a {
- border-top: 1px solid #eeeeee;
- border-left: 1px solid #eeeeee;
- border-right: 1px solid #eeeeee;
-}
-
-/*
-a:hover {
- color: #000000;
- border: 1px solid black;
-}
-*/
-
-#headerlink {
- border: none;
-}
-
-#headerlink:hover {
- border: none;
-}
-
-body {
- color: #000000;
- background-color: #ffffff;
- margin-top: 2em;
- margin-right: 10em;
- margin-left: 10em;
- font-family: helvetica, verdana, arial;
-}
-
-.main {
- margin-top: 20px;
- margin-left: 40px;
-}
-
-.padded {
- padding-left: 30px;
-}
-
-.padded h1,h2 {
- margin-left: -30px;
-}
-
-h1 {
- color: #ee8500;
- font-size: 22pt;
-}
-
-h3 {
- color: #000000;
- border-bottom: 2px solid #ff9500;
- margin-left: -3px;
- padding-left: 3px;
- padding-top: 2em;
-}
-
-h4 {
-}
-
-.grau {
- padding-top: 1em;
-}
-
-.code {
- border: solid 1px #d0d0d0;
- padding: 1em;
- margin-right: 10%;
-}
-
-.indent {
- /*margin-left: 20px;
- padding-bottom: 1em;*/
-}
-
-.def {
- padding: 1px 1px 1px 1px;
- margin-bottom: 1px;
- font-weight: bold;
- margin-right: 40px;
-}
-
-.nomargin {
- margin-bottom: 0;
- margin-top: 0;
-}
-
-.noindent {
- margin-left: -30px;
- padding-bottom: 1em;
-}
-
-#header {
- margin-right: 22px;
- /*border-bottom: 1px solid black;*/
- font-family: verdana, arial;
- font-size: 18pt;
- padding-bottom: 1px;
-}
-
-pre {
- background-color: #eeeeee;
- border: solid 1px #d0d0d0;
- padding: 1em;
- margin-right: 10%;
-}
-#sp-package-list {
- /* ... */
-}
-
-#sp-about-packages {
- /* ... */
-}
-
-.sp-lambda-list {
- background-color: #f4f4f4;
- padding: 3px 3px 3px 3px;
-}
-
-.sp-definition {
- border: 1px solid #cccccc;
- padding: 3px 3px 3px 3px;
-}
-
-.sp-definition-body {
- padding-left: 2em;
- padding-right: 2em;
- padding-top: 0.5em;
- padding-bottom: 1em;
-}
-
-.sp-definition-body ul {
- margin-top: 0;
- margin-bottom: 0;
-}
-
-.sp-return {
-}
-
-.sph3 {
- padding-top: 1em;
- font-weight: bold;
-}
-
-#about-package-legend { display: none }
-#contents { display: none }
-.function-details-legend { display: none }
-#heading2 { display: none }
(DIR) diff --git a/3rdparties/software/trivial-garbage-20181018-git/gendocs.lisp b/3rdparties/software/trivial-garbage-20181018-git/gendocs.lisp
@@ -1,15 +0,0 @@
-(in-package :cl-user)
-
-(asdf:load-system :atdoc)
-(asdf:load-system :trivial-garbage)
-
-(let* ((base (asdf:component-pathname (asdf:find-system :trivial-garbage)))
- (output-directory (merge-pathnames "doc/" base))
- (css-file (merge-pathnames "doc/index.css" base)))
- (ensure-directories-exist output-directory)
- (atdoc:generate-html-documentation '(:trivial-garbage)
- output-directory
- :single-page-p t
- :heading "Trivial Garbage"
- :index-title "Trivial Garbage"
- :css css-file))
(DIR) diff --git a/3rdparties/software/trivial-garbage-20181018-git/release.lisp b/3rdparties/software/trivial-garbage-20181018-git/release.lisp
@@ -1,250 +0,0 @@
-#!/usr/bin/env clisp
-;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
-
-(defpackage :release-script (:use #:cl #:regexp))
-(in-package :release-script)
-
-;;;; Configuration ------------------------------------------------------------
-
-(defparameter *project-name* "trivial-garbage")
-(defparameter *asdf-file* (format nil "~A.asd" *project-name*))
-
-(defparameter *host* "common-lisp.net")
-(defparameter *release-dir*
- (format nil "/project/~A/public_html/releases" *project-name*))
-
-(defparameter *version-file* "VERSION")
-(defparameter *version-file-dir*
- (format nil "/project/~A/public_html" *project-name*))
-
-;;;; --------------------------------------------------------------------------
-
-;;;; Utilities
-
-(defun ensure-list (x)
- (if (listp x) x (list x)))
-
-(defmacro string-case (expression &body clauses)
- `(let ((it ,expression)) ; yes, anaphoric, deal with it.
- (cond
- ,@(loop for clause in clauses collect
- `((or ,@(loop for alternative in (ensure-list (first clause))
- collect (or (eq t alternative)
- `(string= it ,alternative))))
- ,@(rest clause))))))
-
-(defparameter *development-mode* nil)
-
-(defun die (format-control &rest format-args)
- (format *error-output* "~?" format-control format-args)
- (if *development-mode*
- (cerror "continue" "die")
- (ext:quit 1)))
-
-(defun numeric-split (string)
- (if (digit-char-p (char string 0))
- (multiple-value-bind (number next-position)
- (parse-integer string :junk-allowed t)
- (cons number (when (< next-position (length string))
- (numeric-split (subseq string next-position)))))
- (let ((next-digit-position (position-if #'digit-char-p string)))
- (if next-digit-position
- (cons (subseq string 0 next-digit-position)
- (numeric-split (subseq string next-digit-position)))
- (list string)))))
-
-(defun natural-string-< (s1 s2)
- (labels ((aux< (l1 l2)
- (cond ((null l1) (not (null l2)))
- ((null l2) nil)
- (t (destructuring-bind (x . xs) l1
- (destructuring-bind (y . ys) l2
- (cond ((and (numberp x) (stringp y))
- t)
- ((and (numberp y) (stringp x))
- nil)
- ((and (numberp x) (numberp y))
- (or (< x y) (and (= x y) (aux< xs ys))))
- (t
- (or (string-lessp x y)
- (and (string-equal x y)
- (aux< xs ys)))))))))))
- (aux< (numeric-split s1)
- (numeric-split s2))))
-
-;;;; Running commands
-
-(defparameter *dry-run* nil)
-
-(defun cmd? (format-control &rest format-args)
- (let ((cmd (format nil "~?" format-control format-args)))
- (with-open-stream (s1 (ext:run-shell-command cmd :output :stream))
- (loop for line = (read-line s1 nil nil)
- while line
- collect line))))
-
-;; XXX: quote arguments.
-(defun cmd (format-control &rest format-args)
- (when *development-mode*
- (format *debug-io* "CMD: ~?~%" format-control format-args))
- (let ((ret (ext:run-shell-command (format nil "~?" format-control format-args))))
- (or (null ret)
- (zerop ret))))
-
-(defun cmd! (format-control &rest format-args)
- (or (apply #'cmd format-control format-args)
- (die "cmd '~?' failed." format-control format-args)))
-
-(defun maybe-cmd! (format-control &rest format-args)
- (if *dry-run*
- (format t "SUPPRESSING: ~?~%" format-control format-args)
- (apply #'cmd! format-control format-args)))
-
-;;;;
-
-(defun find-current-version ()
- (subseq (reduce (lambda (x y) (if (natural-string-< x y) y x))
- (or (cmd? "git tag -l v\\*")
- (die "no version tags found. Please specify initial version.")))
- 1))
-
-(defun parse-version (string)
- (mapcar (lambda (x)
- (parse-integer x :junk-allowed t))
- (loop repeat 3 ; XXX: parameterize
- for el in (regexp-split "\\." (find-current-version))
- collect el)))
-
-(defun check-for-unrecorded-changes (&optional force)
- (unless (cmd "git diff --exit-code")
- (write-line "Unrecorded changes.")
- (if force
- (write-line "Continuing anyway.")
- (die "Aborting.~@
- Use -f or --force if you want to make a release anyway."))))
-
-(defun new-version-number-candidates (current-version)
- (let ((current-version (parse-version current-version)))
- (labels ((alternatives (before after)
- (when after
- (cons (append before (list (1+ (first after)))
- (mapcar (constantly 0) (rest after)))
- (alternatives (append before (list (first after)))
- (rest after))))))
- (loop for alt in (alternatives nil current-version)
- collect (reduce (lambda (acc next)
- (format nil "~a.~a" acc next))
- alt)))))
-
-(defun ask-user-for-version (current-version next-versions)
- (format *query-io* "Current version is ~A. Which will be the next one?~%"
- current-version)
- (loop for i from 1 and version in next-versions
- do (format *query-io* "~T~A) ~A~%" i version))
- (format *query-io* "? ")
- (finish-output *query-io*)
- (nth (1- (parse-integer (read-line) :junk-allowed t))
- next-versions))
-
-(defun git-tag-tree (version)
- (write-line "Tagging the tree...")
- (maybe-cmd! "git tag \"v~A\"" version))
-
-(defun add-version-to-system-file (version path-in path-out)
- (let ((defsystem-line (format nil "(defsystem ~A" *project-name*)))
- (with-open-file (in path-in :direction :input)
- (with-open-file (out path-out :direction :output)
- (loop for line = (read-line in nil nil) while line
- do (write-line line out)
- when (string= defsystem-line line)
- do (format out " :version ~s~%" version))))))
-
-(defun create-dist (version distname)
- (write-line "Creating distribution...")
- (cmd! "mkdir \"~a\"" distname)
- (cmd! "git archive master | tar xC \"~A\"" distname)
- (format t "Updating ~A with new version: ~A~%" *asdf-file* version)
- (let* ((asdf-file-path (format nil "~A/~A" distname *asdf-file*))
- (tmp-asdf-file-path (format nil "~a.tmp" asdf-file-path)))
- (add-version-to-system-file version asdf-file-path tmp-asdf-file-path)
- (cmd! "mv \"~a\" \"~a\"" tmp-asdf-file-path asdf-file-path)))
-
-(defun tar-and-sign (distname tarball)
- (write-line "Creating and signing tarball...")
- (cmd! "tar czf \"~a\" \"~a\"" tarball distname)
- (cmd! "gpg -b -a \"~a\"" tarball))
-
-(defparameter *remote-directory* (format nil "~A:~A" *host* *release-dir*))
-
-(defun upload-tarball (tarball signature remote-directory)
- (write-line "Copying tarball to web server...")
- (maybe-cmd! "scp \"~A\" \"~A\" \"~A\"" tarball signature remote-directory)
- (format t "Uploaded ~A and ~A.~%" tarball signature))
-
-(defun update-remote-links (tarball signature host release-dir project-name)
- (format t "Updating ~A_latest links...~%" project-name)
- (maybe-cmd! "ssh \"~A\" ln -sf \"~A\" \"~A/~A_latest.tar.gz\""
- host tarball release-dir project-name)
- (maybe-cmd! "ssh \"~A\" ln -sf \"~A\" \"~A/~A_latest.tar.gz.asc\""
- host signature release-dir project-name))
-
-(defun upload-version-file (version version-file host version-file-dir)
- (format t "Uploading ~A...~%" version-file)
- (with-open-file (out version-file :direction :output)
- (write-string version out))
- (maybe-cmd! "scp \"~A\" \"~A\":\"~A\"" version-file host version-file-dir)
- (maybe-cmd! "rm \"~A\"" version-file))
-
-(defun maybe-clean-things-up (tarball signature)
- (when (y-or-n-p "Clean local tarball and signature?")
- (cmd! "rm \"~A\" \"~A\"" tarball signature)))
-
-(defun run (force version)
- (check-for-unrecorded-changes force)
- ;; figure out what version we'll be preparing.
- (unless version
- (let* ((current-version (find-current-version))
- (next-versions (new-version-number-candidates current-version)))
- (setf version (or (ask-user-for-version current-version next-versions)
- (die "invalid selection.")))))
- (git-tag-tree version)
- (let* ((distname (format nil "~A_~A" *project-name* version))
- (tarball (format nil "~A.tar.gz" distname))
- (signature (format nil "~A.asc" tarball)))
- ;; package things up.
- (create-dist version distname)
- (tar-and-sign distname tarball)
- ;; upload.
- (upload-tarball tarball signature *remote-directory*)
- (update-remote-links tarball signature *host* *release-dir* *project-name*)
- (when *version-file*
- (upload-version-file version *version-file* *host* *version-file-dir*))
- ;; clean up.
- (maybe-clean-things-up tarball signature)
- ;; documentation.
- ;; (write-line "Building and uploading documentation...")
- ;; (maybe-cmd! "make -C doc upload-docs")
- ;; push tags and any outstanding changes.
- (write-line "Pushing tags and changes...")
- (maybe-cmd! "git push --tags origin master")))
-
-
-;;;; Do it to it
-
-(let ((force nil)
- (version nil)
- (args ext:*args*))
- (loop while args
- do (string-case (pop args)
- (("-h" "--help")
- (write-line "No help, sorry. Read the source.")
- (ext:quit 0))
- (("-f" "--force")
- (setf force t))
- (("-v" "--version")
- (setf version (pop args)))
- (("-n" "--dry-run")
- (setf *dry-run* t))
- (t
- (die "Unrecognized argument '~a'" it))))
- (run force version))
(DIR) diff --git a/3rdparties/software/trivial-garbage-20181018-git/tests.lisp b/3rdparties/software/trivial-garbage-20181018-git/tests.lisp
@@ -1,133 +0,0 @@
-;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
-;;;
-;;; tests.lisp --- trivial-garbage tests.
-;;;
-;;; This software is placed in the public domain by Luis Oliveira
-;;; <loliveira@common-lisp.net> and is provided with absolutely no
-;;; warranty.
-
-(defpackage #:trivial-garbage-tests
- (:use #:cl #:trivial-garbage #:regression-test)
- (:nicknames #:tg-tests)
- (:export #:run))
-
-(in-package #:trivial-garbage-tests)
-
-(defun run ()
- (let ((*package* (find-package :trivial-garbage-tests)))
- (do-tests)
- (null (set-difference (regression-test:pending-tests)
- rtest::*expected-failures*))))
-
-;;;; Weak Pointers
-
-(deftest pointers.1
- (weak-pointer-p (make-weak-pointer 42))
- t)
-
-(deftest pointers.2
- (weak-pointer-value (make-weak-pointer 42))
- 42)
-
-;;;; Weak Hashtables
-
-(eval-when (:compile-toplevel :load-toplevel :execute)
- (defun sbcl-without-weak-hash-tables-p ()
- (if (and (find :sbcl *features*)
- (not (find-symbol "HASH-TABLE-WEAKNESS" "SB-EXT")))
- '(:and)
- '(:or))))
-
-#+(or corman scl #.(tg-tests::sbcl-without-weak-hash-tables-p))
-(progn
- (pushnew 'hashtables.weak-key.1 rt::*expected-failures*)
- (pushnew 'hashtables.weak-key.2 rt::*expected-failures*)
- (pushnew 'hashtables.weak-value.1 rt::*expected-failures*))
-
-#+clasp
-(pushnew 'hashtables.weak-value.1 rt::*expected-failures*)
-
-(deftest hashtables.weak-key.1
- (let ((ht (make-weak-hash-table :weakness :key)))
- (values (hash-table-p ht)
- (hash-table-weakness ht)))
- t :key)
-
-(deftest hashtables.weak-key.2
- (let ((ht (make-weak-hash-table :weakness :key :test 'eq)))
- (values (hash-table-p ht)
- (hash-table-weakness ht)))
- t :key)
-
-(deftest hashtables.weak-value.1
- (let ((ht (make-weak-hash-table :weakness :value)))
- (values (hash-table-p ht)
- (hash-table-weakness ht)))
- t :value)
-
-(deftest hashtables.not-weak.1
- (hash-table-weakness (make-hash-table))
- nil)
-
-;;;; Finalizers
-;;;
-;;; These tests are, of course, not very reliable.
-
-(defun dummy (x)
- (declare (ignore x))
- nil)
-
-(defun test-finalizers-aux (count extra-action)
- (let ((cons (list 0))
- (obj (string (gensym))))
- (dotimes (i count)
- (finalize obj (lambda () (incf (car cons)))))
- (when extra-action
- (cancel-finalization obj)
- (when (eq extra-action :add-again)
- (dotimes (i count)
- (finalize obj (lambda () (incf (car cons)))))))
- (setq obj (gensym))
- (setq obj (dummy obj))
- cons))
-
-(defvar *result*)
-
-;;; I don't really understand this, but it seems to work, and stems
-;;; from the observation that typing the code in sequence at the REPL
-;;; achieves the desired result. Superstition at its best.
-(defmacro voodoo (string)
- `(funcall
- (compile nil `(lambda ()
- (eval (let ((*package* (find-package :tg-tests)))
- (read-from-string ,,string)))))))
-
-(defun test-finalizers (count &optional remove)
- (gc :full t)
- (voodoo (format nil "(setq *result* (test-finalizers-aux ~S ~S))"
- count remove))
- (voodoo "(gc :full t)")
- ;; Normally done by a background thread every 0.3 sec:
- #+openmcl (ccl::drain-termination-queue)
- ;; (an alternative is to sleep a bit)
- (voodoo "(car *result*)"))
-
-(deftest finalizers.1
- (test-finalizers 1)
- 1)
-
-(deftest finalizers.2
- (test-finalizers 1 t)
- 0)
-
-(deftest finalizers.3
- (test-finalizers 5)
- 5)
-
-(deftest finalizers.4
- (test-finalizers 5 t)
- 0)
-
-(deftest finalizers.5
- (test-finalizers 5 :add-again)
- 5)
(DIR) diff --git a/3rdparties/software/trivial-garbage-20181018-git/trivial-garbage.asd b/3rdparties/software/trivial-garbage-20181018-git/trivial-garbage.asd
@@ -1,29 +0,0 @@
-;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
-;;;
-;;; trivial-garbage.asd --- ASDF system definition for trivial-garbage.
-;;;
-;;; This software is placed in the public domain by Luis Oliveira
-;;; <loliveira@common-lisp.net> and is provided with absolutely no
-;;; warranty.
-
-#-(or cmu scl sbcl allegro clisp openmcl corman lispworks ecl abcl clasp)
-(error "Sorry, your Lisp is not supported by trivial-garbage.")
-
-(defsystem trivial-garbage
- :description "Portable finalizers, weak hash-tables and weak pointers."
- :author "Luis Oliveira <loliveira@common-lisp.net>"
- :licence "Public Domain"
- :components ((:file "trivial-garbage")))
-
-(defmethod perform ((op test-op) (sys (eql (find-system :trivial-garbage))))
- (operate 'test-op :trivial-garbage-tests))
-
-(defsystem trivial-garbage-tests
- :description "Unit tests for TRIVIAL-GARBAGE."
- :depends-on (trivial-garbage rt)
- :components ((:file "tests")))
-
-(defmethod perform ((op test-op)
- (sys (eql (find-system :trivial-garbage-tests))))
- (operate 'load-op :trivial-garbage-tests)
- (funcall (find-symbol (string '#:do-tests) '#:rtest)))
(DIR) diff --git a/3rdparties/software/trivial-garbage-20181018-git/trivial-garbage.lisp b/3rdparties/software/trivial-garbage-20181018-git/trivial-garbage.lisp
@@ -1,404 +0,0 @@
-;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
-;;;
-;;; trivial-garbage.lisp --- Trivial Garbage!
-;;;
-;;; This software is placed in the public domain by Luis Oliveira
-;;; <loliveira@common-lisp.net> and is provided with absolutely no
-;;; warranty.
-
-#+xcvb (module ())
-
-(defpackage #:trivial-garbage
- (:use #:cl)
- (:shadow #:make-hash-table)
- (:nicknames #:tg)
- (:export #:gc
- #:make-weak-pointer
- #:weak-pointer-value
- #:weak-pointer-p
- #:make-weak-hash-table
- #:hash-table-weakness
- #:finalize
- #:cancel-finalization)
- (:documentation
- "@a[http://common-lisp.net/project/trivial-garbage]{trivial-garbage}
- provides a portable API to finalizers, weak hash-tables and weak
- pointers on all major implementations of the Common Lisp
- programming language. For a good introduction to these
- data-structures, have a look at
- @a[http://www.haible.de/bruno/papers/cs/weak/WeakDatastructures-writeup.html]{Weak
- References: Data Types and Implementation} by Bruno Haible.
-
- Source code is available at
- @a[https://github.com/trivial-garbage/trivial-garbage]{github},
- which you are welcome to use for submitting patches and/or
- @a[https://github.com/trivial-garbage/trivial-garbage/issues]{bug
- reports}. Discussion takes place on
- @a[http://lists.common-lisp.net/cgi-bin/mailman/listinfo/trivial-garbage-devel]{trivial-garbage-devel
- at common-lisp.net}.
-
- @a[http://common-lisp.net/project/trivial-garbage/releases/]{Tarball
- releases} are available, but the easiest way to install this
- library is via @a[http://www.quicklisp.org/]{Quicklisp}:
- @code{(ql:quickload :trivial-garbage)}.
-
- @begin[Weak Pointers]{section}
- A @em{weak pointer} holds an object in a way that does not prevent
- it from being reclaimed by the garbage collector. An object
- referenced only by weak pointers is considered unreachable (or
- \"weakly reachable\") and so may be collected at any time. When
- that happens, the weak pointer's value becomes @code{nil}.
-
- @aboutfun{make-weak-pointer}
- @aboutfun{weak-pointer-value}
- @aboutfun{weak-pointer-p}
- @end{section}
-
- @begin[Weak Hash-Tables]{section}
- A @em{weak hash-table} is one that weakly references its keys
- and/or values. When both key and value are unreachable (or weakly
- reachable) that pair is reclaimed by the garbage collector.
-
- @aboutfun{make-weak-hash-table}
- @aboutfun{hash-table-weakness}
- @end{section}
-
- @begin[Finalizers]{section}
- A @em{finalizer} is a hook that is executed after a given object
- has been reclaimed by the garbage collector.
-
- @aboutfun{finalize}
- @aboutfun{cancel-finalization}
- @end{section}"))
-
-(in-package #:trivial-garbage)
-
-;;;; GC
-
-(defun gc (&key full verbose)
- "Initiates a garbage collection. @code{full} forces the collection
- of all generations, when applicable. When @code{verbose} is
- @em{true}, diagnostic information about the collection is printed
- if possible."
- (declare (ignorable verbose full))
- #+(or cmu scl) (ext:gc :verbose verbose :full full)
- #+sbcl (sb-ext:gc :full full)
- #+allegro (excl:gc (not (null full)))
- #+(or abcl clisp) (ext:gc)
- #+ecl (si:gc t)
- #+openmcl (ccl:gc)
- #+corman (ccl:gc (if full 3 0))
- #+lispworks (hcl:gc-generation (if full t 0))
- #+clasp (gctools:garbage-collect))
-
-;;;; Weak Pointers
-
-#+openmcl
-(defvar *weak-pointers* (cl:make-hash-table :test 'eq :weak :value)
- "Weak value hash-table mapping between pseudo weak pointers and its values.")
-
-#+(or allegro openmcl lispworks)
-(defstruct (weak-pointer (:constructor %make-weak-pointer))
- #-openmcl pointer)
-
-(defun make-weak-pointer (object)
- "Creates a new weak pointer which points to @code{object}. For
- portability reasons, @code{object} must not be @code{nil}."
- (assert (not (null object)))
- #+sbcl (sb-ext:make-weak-pointer object)
- #+(or cmu scl) (ext:make-weak-pointer object)
- #+clisp (ext:make-weak-pointer object)
- #+abcl (ext:make-weak-reference object)
- #+ecl (ext:make-weak-pointer object)
- #+allegro
- (let ((wv (excl:weak-vector 1)))
- (setf (svref wv 0) object)
- (%make-weak-pointer :pointer wv))
- #+openmcl
- (let ((wp (%make-weak-pointer)))
- (setf (gethash wp *weak-pointers*) object)
- wp)
- #+corman (ccl:make-weak-pointer object)
- #+lispworks
- (let ((array (make-array 1 :weak t)))
- (setf (svref array 0) object)
- (%make-weak-pointer :pointer array))
- #+clasp (core:make-weak-pointer object))
-
-#-(or allegro openmcl lispworks)
-(defun weak-pointer-p (object)
- "Returns @em{true} if @code{object} is a weak pointer and @code{nil}
- otherwise."
- #+sbcl (sb-ext:weak-pointer-p object)
- #+(or cmu scl) (ext:weak-pointer-p object)
- #+clisp (ext:weak-pointer-p object)
- #+abcl (typep object 'ext:weak-reference)
- #+ecl (typep object 'ext:weak-pointer)
- #+corman (ccl:weak-pointer-p object)
- #+clasp (core:weak-pointer-valid object))
-
-(defun weak-pointer-value (weak-pointer)
- "If @code{weak-pointer} is valid, returns its value. Otherwise,
- returns @code{nil}."
- #+sbcl (values (sb-ext:weak-pointer-value weak-pointer))
- #+(or cmu scl) (values (ext:weak-pointer-value weak-pointer))
- #+clisp (values (ext:weak-pointer-value weak-pointer))
- #+abcl (values (ext:weak-reference-value weak-pointer))
- #+ecl (values (ext:weak-pointer-value weak-pointer))
- #+allegro (svref (weak-pointer-pointer weak-pointer) 0)
- #+openmcl (values (gethash weak-pointer *weak-pointers*))
- #+corman (ccl:weak-pointer-obj weak-pointer)
- #+lispworks (svref (weak-pointer-pointer weak-pointer) 0)
- #+clasp (core:weak-pointer-value weak-pointer))
-
-;;;; Weak Hash-tables
-
-;;; Allegro can apparently create weak hash-tables with both weak keys
-;;; and weak values but it's not obvious whether it's an OR or an AND
-;;; relation. TODO: figure that out.
-
-(defun weakness-keyword-arg (weakness)
- (declare (ignorable weakness))
- #+(or sbcl abcl clasp ecl-weak-hash) :weakness
- #+(or clisp openmcl) :weak
- #+lispworks :weak-kind
- #+allegro (case weakness (:key :weak-keys) (:value :values))
- #+cmu :weak-p)
-
-(defvar *weakness-warnings* '()
- "List of weaknesses that have already been warned about this
- session. Used by `weakness-missing'.")
-
-(defun weakness-missing (weakness errorp)
- "Signal an error or warning, depending on ERRORP, about lack of Lisp
- support for WEAKNESS."
- (cond (errorp
- (error "Your Lisp does not support weak ~(~A~) hash-tables."
- weakness))
- ((member weakness *weakness-warnings*) nil)
- (t (push weakness *weakness-warnings*)
- (warn "Your Lisp does not support weak ~(~A~) hash-tables."
- weakness))))
-
-(defun weakness-keyword-opt (weakness errorp)
- (declare (ignorable errorp))
- (ecase weakness
- (:key
- #+(or lispworks sbcl abcl clasp clisp openmcl ecl-weak-hash) :key
- #+(or allegro cmu) t
- #-(or lispworks sbcl abcl clisp openmcl allegro cmu ecl-weak-hash clasp)
- (weakness-missing weakness errorp))
- (:value
- #+allegro :weak
- #+(or clisp openmcl sbcl abcl lispworks cmu ecl-weak-hash) :value
- #-(or allegro clisp openmcl sbcl abcl lispworks cmu ecl-weak-hash clasp)
- (weakness-missing weakness errorp))
- (:key-or-value
- #+(or clisp sbcl abcl cmu) :key-or-value
- #+lispworks :either
- #-(or clisp sbcl abcl lispworks cmu clasp)
- (weakness-missing weakness errorp))
- (:key-and-value
- #+(or clisp abcl sbcl cmu ecl-weak-hash) :key-and-value
- #+lispworks :both
- #-(or clisp sbcl abcl lispworks cmu ecl-weak-hash clasp)
- (weakness-missing weakness errorp))))
-
-(defun make-weak-hash-table (&rest args &key weakness (weakness-matters t)
- #+openmcl (test #'eql)
- &allow-other-keys)
- "Returns a new weak hash table. In addition to the standard
- arguments accepted by @code{cl:make-hash-table}, this function adds
- extra keywords: @code{:weakness} being the kind of weak table it
- should create, and @code{:weakness-matters} being whether an error
- should be signalled when that weakness isn't available (the default
- is to signal an error). @code{weakness} can be one of @code{:key},
- @code{:value}, @code{:key-or-value}, @code{:key-and-value}.
-
- If @code{weakness} is @code{:key} or @code{:value}, an entry is
- kept as long as its key or value is reachable, respectively. If
- @code{weakness} is @code{:key-or-value} or @code{:key-and-value},
- an entry is kept if either or both of its key and value are
- reachable, respectively.
-
- @code{tg::make-hash-table} is available as an alias for this
- function should you wish to import it into your package and shadow
- @code{cl:make-hash-table}."
- (remf args :weakness)
- (remf args :weakness-matters)
- (if weakness
- (let ((arg (weakness-keyword-arg weakness))
- (opt (weakness-keyword-opt weakness weakness-matters)))
- (apply #'cl:make-hash-table
- #+openmcl :test #+openmcl (if (eq opt :key) #'eq test)
- (if arg
- (list* arg opt args)
- args)))
- (apply #'cl:make-hash-table args)))
-
-;;; If you want to use this function to override CL:MAKE-HASH-TABLE,
-;;; it's necessary to shadow-import it. For example:
-;;;
-;;; (defpackage #:foo
-;;; (:use #:common-lisp #:trivial-garbage)
-;;; (:shadowing-import-from #:trivial-garbage #:make-hash-table))
-;;;
-(defun make-hash-table (&rest args)
- (apply #'make-weak-hash-table args))
-
-(defun hash-table-weakness (ht)
- "Returns one of @code{nil}, @code{:key}, @code{:value},
- @code{:key-or-value} or @code{:key-and-value}."
- #-(or allegro sbcl abcl clisp cmu openmcl lispworks
- ecl-weak-hash clasp)
- (declare (ignore ht))
- ;; keep this first if any of the other lisps bugously insert a NIL
- ;; for the returned (values) even when *read-suppress* is NIL (e.g. clisp)
- #.(if (find :sbcl *features*)
- (if (find-symbol "HASH-TABLE-WEAKNESS" "SB-EXT")
- (read-from-string "(sb-ext:hash-table-weakness ht)")
- nil)
- (values))
- #+abcl (sys:hash-table-weakness ht)
- #+ecl-weak-hash (ext:hash-table-weakness ht)
- #+allegro (cond ((excl:hash-table-weak-keys ht) :key)
- ((eq (excl:hash-table-values ht) :weak) :value))
- #+clisp (ext:hash-table-weak-p ht)
- #+cmu (let ((weakness (lisp::hash-table-weak-p ht)))
- (if (eq t weakness) :key weakness))
- #+openmcl (ccl::hash-table-weak-p ht)
- #+lispworks (system::hash-table-weak-kind ht)
- #+clasp (core:hash-table-weakness ht))
-
-;;;; Finalizers
-
-;;; Note: Lispworks can't finalize gensyms.
-
-#+(or allegro clisp lispworks openmcl)
-(defvar *finalizers*
- (cl:make-hash-table :test 'eq
- #+allegro :weak-keys #+:allegro t
- #+(or clisp openmcl) :weak
- #+lispworks :weak-kind
- #+(or clisp openmcl lispworks) :key
- #+clasp :weakness #+clasp :key)
- "Weak hashtable that holds registered finalizers.")
-
-#+corman
-(progn
- (defvar *finalizers* '()
- "Weak alist that holds registered finalizers.")
-
- (defvar *finalizers-cs* (threads:allocate-critical-section)))
-
-#+lispworks
-(progn
- (hcl:add-special-free-action 'free-action)
- (defun free-action (object)
- (let ((finalizers (gethash object *finalizers*)))
- (unless (null finalizers)
- (mapc #'funcall finalizers)))))
-
-(defun finalize (object function)
- "Pushes a new @code{function} to the @code{object}'s list of
- finalizers. @code{function} should take no arguments. Returns
- @code{object}.
-
- @b{Note:} @code{function} should not attempt to look at
- @code{object} by closing over it because that will prevent it from
- being garbage collected."
- #+(or cmu scl) (ext:finalize object function)
- #+sbcl (sb-ext:finalize object function)
- #+abcl (ext:finalize object function)
- #+ecl (let ((next-fn (ext:get-finalizer object)))
- (ext:set-finalizer
- object (lambda (obj)
- (declare (ignore obj))
- (funcall function)
- (when next-fn
- (funcall next-fn nil)))))
- #+allegro
- (progn
- (push (excl:schedule-finalization
- object (lambda (obj) (declare (ignore obj)) (funcall function)))
- (gethash object *finalizers*))
- object)
- #+clasp (gctools:finalize object function)
- #+clisp
- ;; The CLISP code used to be a bit simpler but we had to workaround
- ;; a bug regarding the interaction between GC and weak hashtables.
- ;; See <http://article.gmane.org/gmane.lisp.clisp.general/11028>
- ;; and <http://article.gmane.org/gmane.lisp.cffi.devel/994>.
- (multiple-value-bind (finalizers presentp)
- (gethash object *finalizers* (cons 'finalizers nil))
- (unless presentp
- (setf (gethash object *finalizers*) finalizers)
- (ext:finalize object (lambda (obj)
- (declare (ignore obj))
- (mapc #'funcall (cdr finalizers)))))
- (push function (cdr finalizers))
- object)
- #+openmcl
- (progn
- (ccl:terminate-when-unreachable
- object (lambda (obj) (declare (ignore obj)) (funcall function)))
- ;; store number of finalizers
- (incf (gethash object *finalizers* 0))
- object)
- #+corman
- (flet ((get-finalizers (obj)
- (assoc obj *finalizers* :test #'eq :key #'ccl:weak-pointer-obj)))
- (threads:with-synchronization *finalizers-cs*
- (let ((pair (get-finalizers object)))
- (if (null pair)
- (push (list (ccl:make-weak-pointer object) function) *finalizers*)
- (push function (cdr pair)))))
- (ccl:register-finalization
- object (lambda (obj)
- (threads:with-synchronization *finalizers-cs*
- (mapc #'funcall (cdr (get-finalizers obj)))
- (setq *finalizers*
- (delete obj *finalizers*
- :test #'eq :key #'ccl:weak-pointer-obj)))))
- object)
- #+lispworks
- (progn
- (let ((finalizers (gethash object *finalizers*)))
- (unless finalizers
- (hcl:flag-special-free-action object))
- (setf (gethash object *finalizers*)
- (cons function finalizers)))
- object))
-
-(defun cancel-finalization (object)
- "Cancels all of @code{object}'s finalizers, if any."
- #+cmu (ext:cancel-finalization object)
- #+scl (ext:cancel-finalization object nil)
- #+sbcl (sb-ext:cancel-finalization object)
- #+abcl (ext:cancel-finalization object)
- #+ecl (ext:set-finalizer object nil)
- #+allegro
- (progn
- (mapc #'excl:unschedule-finalization
- (gethash object *finalizers*))
- (remhash object *finalizers*))
- #+clasp (gctools:definalize object)
- #+clisp
- (multiple-value-bind (finalizers present-p)
- (gethash object *finalizers*)
- (when present-p
- (setf (cdr finalizers) nil))
- (remhash object *finalizers*))
- #+openmcl
- (let ((count (gethash object *finalizers*)))
- (unless (null count)
- (dotimes (i count)
- (ccl:cancel-terminate-when-unreachable object))))
- #+corman
- (threads:with-synchronization *finalizers-cs*
- (setq *finalizers*
- (delete object *finalizers* :test #'eq :key #'ccl:weak-pointer-obj)))
- #+lispworks
- (progn
- (remhash object *finalizers*)
- (hcl:flag-not-special-free-action object)))
(DIR) diff --git a/3rdparties/software/uiop-3.3.2/README.md b/3rdparties/software/uiop-3.3.2/README.md
@@ -1,217 +0,0 @@
-UIOP, the Utilities for Implementation- and OS- Portability
-===========================================================
-
-UIOP is the portability layer of ASDF.
-It provides utilities that abstract over discrepancies between implementations,
-between operating systems, and between what the standard provides and
-what programmers actually need, to write portable Common Lisp programs.
-
-It is organized by topic in many files, each of which defines its own package
-according to its topic: e.g [pathname.lisp](pathname.lisp)
-will define package `UIOP/PATHNAME` and contain utilities related to
-the handling of pathname objects.
-All exported symbols are reexported in a convenience package `UIOP`,
-except for those from `UIOP/COMMON-LISP`.
-We recommend package `UIOP` be used to access all the symbols.
-
-The files that constitute UIOP are, in dependency loading order:
-
-* [package](package.lisp):
- deals with packages and their symbols, most notably including
- `define-package`, a variant of `defpackage` capable of hot-upgrade,
- or `symbol-call` and `find-symbol*` that are also useful for use in `.asd`
- files before packages have been defined.
-
-* [common-lisp](common-lisp.lisp):
- lets you paper over various sub-standard implementations.
- Big offenders are Corman, GCL, Genera, MCL, none of them regularly maintained.
- Supported without serious issues are:
- ABCL, Allegro, CCL, CMUCL, CLASP, CLISP, ECL, LispWorks, MKCL, SBCL, SCL, XCL.
-
-* [utility](utility.lisp):
- provides macros and functions that do not involve I/O;
- it handles control-flow, (p)lists, characters, strings, functions, classes,
- conditions, "stamps" (real number or boolean for +/- infinity), etc.
- It also sports `uiop-debug`, a useful tool to help you debug programs.
-
-* [version](version.lisp):
- manages ASDF-style versioning and a related `with-deprecation` facility
- to gracefully declare that users should stop using some deprecated functions.
-
-* [os](os.lisp):
- extracts information from your environment, including an ABI identifier,
- features that distinguish Unix vs Windows,
- `getenv`, `hostname`, `getcwd` and `chdir`, etc.
-
-* [pathname](pathname.lisp):
- overcomes the gruesome non-portability trap that are CL pathnames
- (and their lovecraftian "logical" variant), offering a vast array of functions
- and a sensible, usable abstraction to specify relative pathnames.
- It has a function `merge-pathnames*` to use instead of `merge-pathnames`, or
- even better, `subpathname` and its variant `subpathname*`; it has also plenty
- of functions for dealing with pathnames being directory vs file,
- physical vs logical, absolute vs relative, and more.
-
-* [filesystem](filesystem.lisp):
- provides portable access to the filesystem, inspecting it,
- only using truename when desired, using native OS namestrings,
- atomic file renaming, creating or deleting directories, etc.
-
-* [stream](stream.lisp):
- portably deals with `*stderr*` vs `*error-output*`, character encodings
- (external formats), element types, safe `read`ing and `write`ing,
- opening files, using temporary files, flushing output buffers,
- providing `format`-like designators for streams, consuming or copying streams,
- concatenating streams or files, copying files, etc.
-
-* [image](image.lisp):
- portably deals with images, dumping them, restoring from them,
- registering hooks to run at suitable events in the image lifetime,
- printing backtraces, handling fatal conditions, using or avoiding debug modes,
- accessing command line arguments or quitting the process.
-
-* [lisp-build](lisp-build.lisp):
- portably compiles Common Lisp code, handles compilation results,
- muffles uninteresting conditions, saves and restores deferred warnings,
- runs hooks around compilation (to e.g. control optimizations or syntax),
- identifies the pathname of the current file, combines FASLs, etc.
-
-* [launch-program](launch-program.lisp):
- semi-portably launches a program as an asynchronous external subprocess.
- Available functionality may depend on the underlying implementation.
-
-* [run-program](run-program.lisp):
- fully portably runs a program as a synchronous external subprocess,
- feed it input and capture its output.
- Most implementations also allow interactive console subprocesses.
-
-* [configuration](configuration.lisp):
- portably locates and parses configuration files, using best practices to
- define and validate syntax, search standard paths,
- let users specify pathnames or pathname patterns, etc.
-
-* [backward-driver](backward-driver.lisp):
- provides backward-compatibility with earlier incarnations of this library
- (i.e. ASDF internals that have leaked, ASDF-UTILS, or older versions of UIOP).
-
-* [driver](driver.lisp):
- reexports all the above utilities in a single package `UIOP`.
-
-
-Documentation
--------------
-
-Each file starts with a package definition form that lists the exported symbols.
-
-All the exported functions, macros and variables ought to have proper docstrings.
-If not, then it's a legitimate bug that we invite you to report.
-
-Maybe some automated tool will extract all that information and
-make a webpage from it, at which point it would be nice to insert a link here.
-
-One tool with which you can extract all the documentation is HEΛP.
-At this time, the interface is not great: it isn't obvious at all that you can indeed
-use a scrollbar on the right of the top left side panel to navigate the many packages;
-once you click on the package you're interested in, you can see its defined symbols:
-
-* <http://bimib.disco.unimib.it/people/Marco.Antoniotti/Projects/CL/HELAMBDAP/tests/asdf-uiop/docs/html/dictionary/dictionary.html>
-
-Another automated documentation tool is quickdocs, but unhappily, at the time of this writing,
-it only extracts information from the first package
-(see [bug #24](https://github.com/fukamachi/quickdocs/issues/24)):
-
-* <http://quickdocs.org/uiop/api>
-
-
-Help wanted extracting working documentation from UIOP's docstrings.
-
-
-Using UIOP
-----------
-
-UIOP is part of ASDF 3, and any modern Common Lisp implementation
-will have all of UIOP available when you `(require "asdf")`.
-NB: `(require :asdf)` also works on all implementations but CLISP.
-Every implementation has sported ASDF 3 for years, and if yours only provides
-ASDF 2, we recommend you install ASDF 3 on top of it,
-using the facility in [tools/install-asdf.lisp](../tools/install-asdf.lisp).
-
-If you need some functionality only available in a recent version of UIOP,
-but cannot or will not upgrade ASDF, UIOP is also distributed separately;
-see e.g. in Quicklisp. You may then have to load it like any other library,
-by adding `"uiop"` or some versioned constraint `(:version "uiop" "3.2.0")`
-in your system's `:depends-on` declaration, or at the REPL using:
-
- (asdf:load-system :uiop)
-
-When refering to symbols in UIOP, we recommend you either have your package
-`:use` the package `:uiop` or `:import-from` it, or that you shall use `uiop:`
-as a prefix to the symbols. Please *DO NOT* refer to specific subpackages such as
-`uiop/run-program` from the outside of UIOP, because functions may occasionally
-be moved from one internal package to the other, without notification.
-They have in the past and will in the future.
-
-
-When to use UIOP
-----------------
-
-UIOP is the ideal tool to use when:
-
-* You need utilities that are always available,
- portably, with no installation needed.
-* You work in a cooperative environment, where the user is a developer
- who understands what he's doing and is trusted not to be malicious.
-* You are writing a build system, build tools, developer-facing tools.
-* You are writing bootstrap scripts, in which you cannot suppose
- that any third-party library has been installed (yet),
- much less a C compiler or any external tool.
-* You are trying to make existing Common Lisp code more robust and portable,
- or replacing developer "scripts"
- (in shell, perl, python, ruby, js, and other blub languages)
- with Common Lisp code, but without concerns about
- either end-user usability or security
- (at the very least, you, not end-users, are fully controlling pathnames,
- and filtering off or portably encoding any unusual character, etc.)
-
-UIOP is the wrong tool when:
-
-* You need to have total control on syscalls,
- to use special characters in pathnames, to handle symlinks yourself,
- or otherwise to have low-level system access.
-* You work in an adversarial environment, where some users are stupid,
- uneducated or outright malicious, and cannot be trusted not to try and
- abuse the system with pathnames, symlinks, race conditions, etc.
- (or be tricked into it by attackers).
-* You are writing end-user facing tools that pass along user-provided
- pathnames, with bad usability implications if a user tries to use weird
- pathnames, or even security implications if an attackers crafts bad
- pathnames or filesystem setups.
-
-In those latter cases, we recommend you use IOlib, or osicat,
-or some similar library that isn't as portable as UIOP,
-but provides fine-grained control over low-level system access.
-Also, please use extreme caution.
-
-
-Some history
-------------
-
-UIOP, formerly known as ASDF-DRIVER (the package and system nicknames are
-deprecated), evolved from ASDF 2's internal utilities and portability layer.
-It has since fully superseded functionality from the following libraries:
-ASDF-UTILS (UIOP carries on the ASDF 2 utilities that this exported),
-CL-FAD (UIOP completely replaces it with better design and implementation),
-CL-LAUNCH (UIOP took its image and command-line argument handling),
-EXTERNAL-PROGRAM, TRIVIAL-SHELL and XCVB-DRIVER
-(UIOP's `run-program` and now `launch-program` evolved from XCVB-DRIVER,
-from which UIOP also initially got its condition muffling),
-SLIME's swank-loader (UIOP has better compilation and ABI identification),
-TRIVIAL-BACKTRACE (UIOP/IMAGE has all of it and more), etc.
-
-UIOP also captures a large subset of the functionality from TRIVIAL-FEATURES,
-and a small subset of the functionality from ALEXANDRIA or FARE-UTILS.
-
-We recommend you use UIOP instead of any of the above, where applicable,
-since UIOP is more portable, more robust, more ubiquitous, better designed,
-better documented, etc. If you see any way in which UIOP isn't superior,
-please tell us: we're interested in improving it so it become so.
(DIR) diff --git a/3rdparties/software/uiop-3.3.2/asdf-driver.asd b/3rdparties/software/uiop-3.3.2/asdf-driver.asd
@@ -1,2 +0,0 @@
-;;; -*- mode: lisp -*-
-(defsystem :asdf-driver :depends-on (:uiop))
(DIR) diff --git a/3rdparties/software/uiop-3.3.2/backward-driver.lisp b/3rdparties/software/uiop-3.3.2/backward-driver.lisp
@@ -1,68 +0,0 @@
-;;; -------------------------------------------------------------------------
-;;; Hacks for backward-compatibility with older versions of UIOP
-
-(uiop/package:define-package :uiop/backward-driver
- (:recycle :uiop/backward-driver :asdf/backward-driver :uiop)
- (:use :uiop/common-lisp :uiop/package :uiop/utility :uiop/version
- :uiop/pathname :uiop/stream :uiop/os :uiop/image
- :uiop/run-program :uiop/lisp-build :uiop/configuration)
- (:export
- #:coerce-pathname
- #:user-configuration-directories #:system-configuration-directories
- #:in-first-directory #:in-user-configuration-directory #:in-system-configuration-directory
- #:version-compatible-p))
-(in-package :uiop/backward-driver)
-
-(eval-when (:compile-toplevel :load-toplevel :execute)
-(with-deprecation ((version-deprecation *uiop-version* :style-warning "3.2" :warning "3.4"))
- ;; Backward compatibility with ASDF 2.000 to 2.26
-
- ;; For backward-compatibility only, for people using internals
- ;; Reported users in quicklisp 2015-11: hu.dwim.asdf (removed in next release)
- ;; Will be removed after 2015-12.
- (defun coerce-pathname (name &key type defaults)
- "DEPRECATED. Please use UIOP:PARSE-UNIX-NAMESTRING instead."
- (parse-unix-namestring name :type type :defaults defaults))
-
- ;; Backward compatibility for ASDF 2.27 to 3.1.4
- (defun user-configuration-directories ()
- "Return the current user's list of user configuration directories
-for configuring common-lisp.
-DEPRECATED. Use UIOP:XDG-CONFIG-PATHNAMES instead."
- (xdg-config-pathnames "common-lisp"))
- (defun system-configuration-directories ()
- "Return the list of system configuration directories for common-lisp.
-DEPRECATED. Use UIOP:CONFIG-SYSTEM-PATHNAMES instead."
- (system-config-pathnames "common-lisp"))
- (defun in-first-directory (dirs x &key (direction :input))
- "Finds the first appropriate file named X in the list of DIRS for I/O
-in DIRECTION \(which may be :INPUT, :OUTPUT, :IO, or :PROBE).
-If direction is :INPUT or :PROBE, will return the first extant file named
-X in one of the DIRS.
-If direction is :OUTPUT or :IO, will simply return the file named X in the
-first element of DIRS that exists. DEPRECATED."
- (find-preferred-file
- (mapcar #'(lambda (dir) (subpathname (ensure-directory-pathname dir) x)) dirs)
- :direction direction))
- (defun in-user-configuration-directory (x &key (direction :input))
- "Return the file named X in the user configuration directory for common-lisp.
-DEPRECATED."
- (xdg-config-pathname `("common-lisp" ,x) direction))
- (defun in-system-configuration-directory (x &key (direction :input))
- "Return the pathname for the file named X under the system configuration directory
-for common-lisp. DEPRECATED."
- (find-preferred-file (system-config-pathnames "common-lisp" x) :direction direction))
-
-
- ;; Backward compatibility with ASDF 1 to ASDF 2.32
-
- (defun version-compatible-p (provided-version required-version)
- "Is the provided version a compatible substitution for the required-version?
-If major versions differ, it's not compatible.
-If they are equal, then any later version is compatible,
-with later being determined by a lexicographical comparison of minor numbers.
-DEPRECATED."
- (let ((x (parse-version provided-version nil))
- (y (parse-version required-version nil)))
- (and x y (= (car x) (car y)) (lexicographic<= '< (cdr y) (cdr x)))))))
-
(DIR) diff --git a/3rdparties/software/uiop-3.3.2/common-lisp.lisp b/3rdparties/software/uiop-3.3.2/common-lisp.lisp
@@ -1,219 +0,0 @@
-;;;; -------------------------------------------------------------------------
-;;;; Handle compatibility with multiple implementations.
-;;; This file is for papering over the deficiencies and peculiarities
-;;; of various Common Lisp implementations.
-;;; For implementation-specific access to the system, see os.lisp instead.
-;;; A few functions are defined here, but actually exported from utility;
-;;; from this package only common-lisp symbols are exported.
-
-(uiop/package:define-package :uiop/common-lisp
- (:nicknames :uoip/cl)
- (:use :uiop/package)
- (:use-reexport #-genera :common-lisp #+genera :future-common-lisp)
- #+allegro (:intern #:*acl-warn-save*)
- #+cormanlisp (:shadow #:user-homedir-pathname)
- #+cormanlisp
- (:export
- #:logical-pathname #:translate-logical-pathname
- #:make-broadcast-stream #:file-namestring)
- #+genera (:shadowing-import-from :scl #:boolean)
- #+genera (:export #:boolean #:ensure-directories-exist #:read-sequence #:write-sequence)
- #+(or mcl cmucl) (:shadow #:user-homedir-pathname))
-(in-package :uiop/common-lisp)
-
-#-(or abcl allegro clasp clisp clozure cmucl cormanlisp ecl gcl genera lispworks mcl mezzano mkcl sbcl scl xcl)
-(error "ASDF is not supported on your implementation. Please help us port it.")
-
-;; (declaim (optimize (speed 1) (debug 3) (safety 3))) ; DON'T: trust implementation defaults.
-
-
-;;;; Early meta-level tweaks
-
-#+(or allegro clasp clisp clozure cmucl ecl mezzano mkcl sbcl)
-(eval-when (:load-toplevel :compile-toplevel :execute)
- (when (and #+allegro (member :ics *features*)
- #+(or clasp clisp cmucl ecl mkcl) (member :unicode *features*)
- #+clozure (member :openmcl-unicode-strings *features*)
- #+sbcl (member :sb-unicode *features*))
- ;; Check for unicode at runtime, so that a hypothetical FASL compiled with unicode
- ;; but loaded in a non-unicode setting (e.g. on Allegro) won't tell a lie.
- (pushnew :asdf-unicode *features*)))
-
-#+allegro
-(eval-when (:load-toplevel :compile-toplevel :execute)
- ;; We need to disable autoloading BEFORE any mention of package ASDF.
- ;; In particular, there must NOT be a mention of package ASDF in the defpackage of this file
- ;; or any previous file.
- (setf excl::*autoload-package-name-alist*
- (remove "asdf" excl::*autoload-package-name-alist*
- :test 'equalp :key 'car))
- (defparameter *acl-warn-save*
- (when (boundp 'excl:*warn-on-nested-reader-conditionals*)
- excl:*warn-on-nested-reader-conditionals*))
- (when (boundp 'excl:*warn-on-nested-reader-conditionals*)
- (setf excl:*warn-on-nested-reader-conditionals* nil))
- (setf *print-readably* nil))
-
-#+clasp
-(eval-when (:load-toplevel :compile-toplevel :execute)
- (setf *load-verbose* nil)
- (defun use-ecl-byte-compiler-p () nil))
-
-#+clozure (in-package :ccl)
-#+(and clozure windows-target) ;; See http://trac.clozure.com/ccl/ticket/1117
-(eval-when (:load-toplevel :compile-toplevel :execute)
- (unless (fboundp 'external-process-wait)
- (in-development-mode
- (defun external-process-wait (proc)
- (when (and (external-process-pid proc) (eq (external-process-%status proc) :running))
- (with-interrupts-enabled
- (wait-on-semaphore (external-process-completed proc))))
- (values (external-process-%exit-code proc)
- (external-process-%status proc))))))
-#+clozure (in-package :uiop/common-lisp) ;; back in this package.
-
-#+cmucl
-(eval-when (:load-toplevel :compile-toplevel :execute)
- (setf ext:*gc-verbose* nil)
- (defun user-homedir-pathname ()
- (first (ext:search-list (cl:user-homedir-pathname)))))
-
-#+cormanlisp
-(eval-when (:load-toplevel :compile-toplevel :execute)
- (deftype logical-pathname () nil)
- (defun make-broadcast-stream () *error-output*)
- (defun translate-logical-pathname (x) x)
- (defun user-homedir-pathname (&optional host)
- (declare (ignore host))
- (parse-namestring (format nil "~A\\" (cl:user-homedir-pathname))))
- (defun file-namestring (p)
- (setf p (pathname p))
- (format nil "~@[~A~]~@[.~A~]" (pathname-name p) (pathname-type p))))
-
-#+ecl
-(eval-when (:load-toplevel :compile-toplevel :execute)
- (setf *load-verbose* nil)
- (defun use-ecl-byte-compiler-p () (and (member :ecl-bytecmp *features*) t))
- (unless (use-ecl-byte-compiler-p) (require :cmp)))
-
-#+gcl
-(eval-when (:load-toplevel :compile-toplevel :execute)
- (unless (member :ansi-cl *features*)
- (error "ASDF only supports GCL in ANSI mode. Aborting.~%"))
- (setf compiler::*compiler-default-type* (pathname "")
- compiler::*lsp-ext* "")
- #.(let ((code ;; Only support very recent GCL 2.7.0 from November 2013 or later.
- (cond
- #+gcl
- ((or (< system::*gcl-major-version* 2)
- (and (= system::*gcl-major-version* 2)
- (< system::*gcl-minor-version* 7)))
- '(error "GCL 2.7 or later required to use ASDF")))))
- (eval code)
- code))
-
-#+genera
-(eval-when (:load-toplevel :compile-toplevel :execute)
- (unless (fboundp 'lambda)
- (defmacro lambda (&whole form &rest bvl-decls-and-body)
- (declare (ignore bvl-decls-and-body)(zwei::indentation 1 1))
- `#',(cons 'lisp::lambda (cdr form))))
- (unless (fboundp 'ensure-directories-exist)
- (defun ensure-directories-exist (path)
- (fs:create-directories-recursively (pathname path))))
- (unless (fboundp 'read-sequence)
- (defun read-sequence (sequence stream &key (start 0) end)
- (scl:send stream :string-in nil sequence start end)))
- (unless (fboundp 'write-sequence)
- (defun write-sequence (sequence stream &key (start 0) end)
- (scl:send stream :string-out sequence start end)
- sequence)))
-
-#+lispworks
-(eval-when (:load-toplevel :compile-toplevel :execute)
- ;; lispworks 3 and earlier cannot be checked for so we always assume
- ;; at least version 4
- (unless (member :lispworks4 *features*)
- (pushnew :lispworks5+ *features*)
- (unless (member :lispworks5 *features*)
- (pushnew :lispworks6+ *features*)
- (unless (member :lispworks6 *features*)
- (pushnew :lispworks7+ *features*)))))
-
-#.(or #+mcl ;; the #$ doesn't work on other lisps, even protected by #+mcl, so we use this trick
- (read-from-string
- "(eval-when (:load-toplevel :compile-toplevel :execute)
- (ccl:define-entry-point (_getenv \"getenv\") ((name :string)) :string)
- (ccl:define-entry-point (_system \"system\") ((name :string)) :int)
- ;; Note: ASDF may expect user-homedir-pathname to provide
- ;; the pathname of the current user's home directory, whereas
- ;; MCL by default provides the directory from which MCL was started.
- ;; See http://code.google.com/p/mcl/wiki/Portability
- (defun user-homedir-pathname ()
- (ccl::findfolder #$kuserdomain #$kCurrentUserFolderType))
- (defun probe-posix (posix-namestring)
- \"If a file exists for the posix namestring, return the pathname\"
- (ccl::with-cstrs ((cpath posix-namestring))
- (ccl::rlet ((is-dir :boolean)
- (fsref :fsref))
- (when (eq #$noerr (#_fspathmakeref cpath fsref is-dir))
- (ccl::%path-from-fsref fsref is-dir))))))"))
-
-#+mkcl
-(eval-when (:load-toplevel :compile-toplevel :execute)
- (require :cmp)
- (setq clos::*redefine-class-in-place* t)) ;; Make sure we have strict ANSI class redefinition semantics
-
-
-;;;; Looping
-(eval-when (:load-toplevel :compile-toplevel :execute)
- (defmacro loop* (&rest rest)
- #-genera `(loop ,@rest)
- #+genera `(lisp:loop ,@rest))) ;; In genera, CL:LOOP can't destructure, so we use LOOP*. Sigh.
-
-
-;;;; compatfmt: avoid fancy format directives when unsupported
-(eval-when (:load-toplevel :compile-toplevel :execute)
- (defun frob-substrings (string substrings &optional frob)
- "for each substring in SUBSTRINGS, find occurrences of it within STRING
-that don't use parts of matched occurrences of previous strings, and
-FROB them, that is to say, remove them if FROB is NIL,
-replace by FROB if FROB is a STRING, or if FROB is a FUNCTION,
-call FROB with the match and a function that emits a string in the output.
-Return a string made of the parts not omitted or emitted by FROB."
- (declare (optimize (speed 0) (safety #-gcl 3 #+gcl 0) (debug 3)))
- (let ((length (length string)) (stream nil))
- (labels ((emit-string (x &optional (start 0) (end (length x)))
- (when (< start end)
- (unless stream (setf stream (make-string-output-stream)))
- (write-string x stream :start start :end end)))
- (emit-substring (start end)
- (when (and (zerop start) (= end length))
- (return-from frob-substrings string))
- (emit-string string start end))
- (recurse (substrings start end)
- (cond
- ((>= start end))
- ((null substrings) (emit-substring start end))
- (t (let* ((sub-spec (first substrings))
- (sub (if (consp sub-spec) (car sub-spec) sub-spec))
- (fun (if (consp sub-spec) (cdr sub-spec) frob))
- (found (search sub string :start2 start :end2 end))
- (more (rest substrings)))
- (cond
- (found
- (recurse more start found)
- (etypecase fun
- (null)
- (string (emit-string fun))
- (function (funcall fun sub #'emit-string)))
- (recurse substrings (+ found (length sub)) end))
- (t
- (recurse more start end))))))))
- (recurse substrings 0 length))
- (if stream (get-output-stream-string stream) "")))
-
- (defmacro compatfmt (format)
- #+(or gcl genera)
- (frob-substrings format `("~3i~_" #+genera ,@'("~@<" "~@;" "~@:>" "~:>")))
- #-(or gcl genera) format))
(DIR) diff --git a/3rdparties/software/uiop-3.3.2/configuration.lisp b/3rdparties/software/uiop-3.3.2/configuration.lisp
@@ -1,413 +0,0 @@
-;;;; ---------------------------------------------------------------------------
-;;;; Generic support for configuration files
-
-(uiop/package:define-package :uiop/configuration
- (:recycle :uiop/configuration :asdf/configuration) ;; necessary to upgrade from 2.27.
- (:use :uiop/common-lisp :uiop/utility
- :uiop/os :uiop/pathname :uiop/filesystem :uiop/stream :uiop/image :uiop/lisp-build)
- (:export
- #:user-configuration-directories #:system-configuration-directories ;; implemented in backward-driver
- #:in-first-directory #:in-user-configuration-directory #:in-system-configuration-directory ;; idem
- #:get-folder-path
- #:xdg-data-home #:xdg-config-home #:xdg-data-dirs #:xdg-config-dirs
- #:xdg-cache-home #:xdg-runtime-dir #:system-config-pathnames
- #:filter-pathname-set #:xdg-data-pathnames #:xdg-config-pathnames
- #:find-preferred-file #:xdg-data-pathname #:xdg-config-pathname
- #:validate-configuration-form #:validate-configuration-file #:validate-configuration-directory
- #:configuration-inheritance-directive-p
- #:report-invalid-form #:invalid-configuration #:*ignored-configuration-form* #:*user-cache*
- #:*clear-configuration-hook* #:clear-configuration #:register-clear-configuration-hook
- #:resolve-location #:location-designator-p #:location-function-p #:*here-directory*
- #:resolve-relative-location #:resolve-absolute-location #:upgrade-configuration))
-(in-package :uiop/configuration)
-
-(with-upgradability ()
- (define-condition invalid-configuration ()
- ((form :reader condition-form :initarg :form)
- (location :reader condition-location :initarg :location)
- (format :reader condition-format :initarg :format)
- (arguments :reader condition-arguments :initarg :arguments :initform nil))
- (:report (lambda (c s)
- (format s (compatfmt "~@<~? (will be skipped)~@:>")
- (condition-format c)
- (list* (condition-form c) (condition-location c)
- (condition-arguments c))))))
-
- (defun configuration-inheritance-directive-p (x)
- "Is X a configuration inheritance directive?"
- (let ((kw '(:inherit-configuration :ignore-inherited-configuration)))
- (or (member x kw)
- (and (length=n-p x 1) (member (car x) kw)))))
-
- (defun report-invalid-form (reporter &rest args)
- "Report an invalid form according to REPORTER and various ARGS"
- (etypecase reporter
- (null
- (apply 'error 'invalid-configuration args))
- (function
- (apply reporter args))
- ((or symbol string)
- (apply 'error reporter args))
- (cons
- (apply 'apply (append reporter args)))))
-
- (defvar *ignored-configuration-form* nil
- "Have configuration forms been ignored while parsing the configuration?")
-
- (defun validate-configuration-form (form tag directive-validator
- &key location invalid-form-reporter)
- "Validate a configuration FORM. By default it will raise an error if the
-FORM is not valid. Otherwise it will return the validated form.
- Arguments control the behavior:
- The configuration FORM should be of the form (TAG . <rest>)
- Each element of <rest> will be checked by first seeing if it's a configuration inheritance
-directive (see CONFIGURATION-INHERITANCE-DIRECTIVE-P) then invoking DIRECTIVE-VALIDATOR
-on it.
- In the event of an invalid form, INVALID-FORM-REPORTER will be used to control
-reporting (see REPORT-INVALID-FORM) with LOCATION providing information about where
-the configuration form appeared."
- (unless (and (consp form) (eq (car form) tag))
- (setf *ignored-configuration-form* t)
- (report-invalid-form invalid-form-reporter :form form :location location)
- (return-from validate-configuration-form nil))
- (loop :with inherit = 0 :with ignore-invalid-p = nil :with x = (list tag)
- :for directive :in (cdr form)
- :when (cond
- ((configuration-inheritance-directive-p directive)
- (incf inherit) t)
- ((eq directive :ignore-invalid-entries)
- (setf ignore-invalid-p t) t)
- ((funcall directive-validator directive)
- t)
- (ignore-invalid-p
- nil)
- (t
- (setf *ignored-configuration-form* t)
- (report-invalid-form invalid-form-reporter :form directive :location location)
- nil))
- :do (push directive x)
- :finally
- (unless (= inherit 1)
- (report-invalid-form invalid-form-reporter
- :form form :location location
- ;; we throw away the form and location arguments, hence the ~2*
- ;; this is necessary because of the report in INVALID-CONFIGURATION
- :format (compatfmt "~@<Invalid source registry ~S~@[ in ~S~]. ~
- One and only one of ~S or ~S is required.~@:>")
- :arguments '(:inherit-configuration :ignore-inherited-configuration)))
- (return (nreverse x))))
-
- (defun validate-configuration-file (file validator &key description)
- "Validate a configuration FILE. The configuration file should have only one s-expression
-in it, which will be checked with the VALIDATOR FORM. DESCRIPTION argument used for error
-reporting."
- (let ((forms (read-file-forms file)))
- (unless (length=n-p forms 1)
- (error (compatfmt "~@<One and only one form allowed for ~A. Got: ~3i~_~S~@:>~%")
- description forms))
- (funcall validator (car forms) :location file)))
-
- (defun validate-configuration-directory (directory tag validator &key invalid-form-reporter)
- "Map the VALIDATOR across the .conf files in DIRECTORY, the TAG will
-be applied to the results to yield a configuration form. Current
-values of TAG include :source-registry and :output-translations."
- (let ((files (sort (ignore-errors ;; SORT w/o COPY-LIST is OK: DIRECTORY returns a fresh list
- (remove-if
- 'hidden-pathname-p
- (directory* (make-pathname :name *wild* :type "conf" :defaults directory))))
- #'string< :key #'namestring)))
- `(,tag
- ,@(loop :for file :in files :append
- (loop :with ignore-invalid-p = nil
- :for form :in (read-file-forms file)
- :when (eq form :ignore-invalid-entries)
- :do (setf ignore-invalid-p t)
- :else
- :when (funcall validator form)
- :collect form
- :else
- :when ignore-invalid-p
- :do (setf *ignored-configuration-form* t)
- :else
- :do (report-invalid-form invalid-form-reporter :form form :location file)))
- :inherit-configuration)))
-
- (defun resolve-relative-location (x &key ensure-directory wilden)
- "Given a designator X for an relative location, resolve it to a pathname."
- (ensure-pathname
- (etypecase x
- (null nil)
- (pathname x)
- (string (parse-unix-namestring
- x :ensure-directory ensure-directory))
- (cons
- (if (null (cdr x))
- (resolve-relative-location
- (car x) :ensure-directory ensure-directory :wilden wilden)
- (let* ((car (resolve-relative-location
- (car x) :ensure-directory t :wilden nil)))
- (merge-pathnames*
- (resolve-relative-location
- (cdr x) :ensure-directory ensure-directory :wilden wilden)
- car))))
- ((eql :*/) *wild-directory*)
- ((eql :**/) *wild-inferiors*)
- ((eql :*.*.*) *wild-file*)
- ((eql :implementation)
- (parse-unix-namestring
- (implementation-identifier) :ensure-directory t))
- ((eql :implementation-type)
- (parse-unix-namestring
- (string-downcase (implementation-type)) :ensure-directory t))
- ((eql :hostname)
- (parse-unix-namestring (hostname) :ensure-directory t)))
- :wilden (and wilden (not (pathnamep x)) (not (member x '(:*/ :**/ :*.*.*))))
- :want-relative t))
-
- (defvar *here-directory* nil
- "This special variable is bound to the currect directory during calls to
-PROCESS-SOURCE-REGISTRY in order that we be able to interpret the :here
-directive.")
-
- (defvar *user-cache* nil
- "A specification as per RESOLVE-LOCATION of where the user keeps his FASL cache")
-
- (defun resolve-absolute-location (x &key ensure-directory wilden)
- "Given a designator X for an absolute location, resolve it to a pathname"
- (ensure-pathname
- (etypecase x
- (null nil)
- (pathname x)
- (string
- (let ((p #-mcl (parse-namestring x)
- #+mcl (probe-posix x)))
- #+mcl (unless p (error "POSIX pathname ~S does not exist" x))
- (if ensure-directory (ensure-directory-pathname p) p)))
- (cons
- (return-from resolve-absolute-location
- (if (null (cdr x))
- (resolve-absolute-location
- (car x) :ensure-directory ensure-directory :wilden wilden)
- (merge-pathnames*
- (resolve-relative-location
- (cdr x) :ensure-directory ensure-directory :wilden wilden)
- (resolve-absolute-location
- (car x) :ensure-directory t :wilden nil)))))
- ((eql :root)
- ;; special magic! we return a relative pathname,
- ;; but what it means to the output-translations is
- ;; "relative to the root of the source pathname's host and device".
- (return-from resolve-absolute-location
- (let ((p (make-pathname :directory '(:relative))))
- (if wilden (wilden p) p))))
- ((eql :home) (user-homedir-pathname))
- ((eql :here) (resolve-absolute-location
- (or *here-directory* (pathname-directory-pathname (load-pathname)))
- :ensure-directory t :wilden nil))
- ((eql :user-cache) (resolve-absolute-location
- *user-cache* :ensure-directory t :wilden nil)))
- :wilden (and wilden (not (pathnamep x)))
- :resolve-symlinks *resolve-symlinks*
- :want-absolute t))
-
- ;; Try to override declaration in previous versions of ASDF.
- (declaim (ftype (function (t &key (:directory boolean) (:wilden boolean)
- (:ensure-directory boolean)) t) resolve-location))
-
- (defun* (resolve-location) (x &key ensure-directory wilden directory)
- "Resolve location designator X into a PATHNAME"
- ;; :directory backward compatibility, until 2014-01-16: accept directory as well as ensure-directory
- (loop* :with dirp = (or directory ensure-directory)
- :with (first . rest) = (if (atom x) (list x) x)
- :with path = (or (resolve-absolute-location
- first :ensure-directory (and (or dirp rest) t)
- :wilden (and wilden (null rest)))
- (return nil))
- :for (element . morep) :on rest
- :for dir = (and (or morep dirp) t)
- :for wild = (and wilden (not morep))
- :for sub = (merge-pathnames*
- (resolve-relative-location
- element :ensure-directory dir :wilden wild)
- path)
- :do (setf path (if (absolute-pathname-p sub) (resolve-symlinks* sub) sub))
- :finally (return path)))
-
- (defun location-designator-p (x)
- "Is X a designator for a location?"
- ;; NIL means "skip this entry", or as an output translation, same as translation input.
- ;; T means "any input" for a translation, or as output, same as translation input.
- (flet ((absolute-component-p (c)
- (typep c '(or string pathname
- (member :root :home :here :user-cache))))
- (relative-component-p (c)
- (typep c '(or string pathname
- (member :*/ :**/ :*.*.* :implementation :implementation-type)))))
- (or (typep x 'boolean)
- (absolute-component-p x)
- (and (consp x) (absolute-component-p (first x)) (every #'relative-component-p (rest x))))))
-
- (defun location-function-p (x)
- "Is X the specification of a location function?"
- ;; Location functions are allowed in output translations, and notably used by ABCL for JAR file support.
- (and (length=n-p x 2) (eq (car x) :function)))
-
- (defvar *clear-configuration-hook* '())
-
- (defun register-clear-configuration-hook (hook-function &optional call-now-p)
- "Register a function to be called when clearing configuration"
- (register-hook-function '*clear-configuration-hook* hook-function call-now-p))
-
- (defun clear-configuration ()
- "Call the functions in *CLEAR-CONFIGURATION-HOOK*"
- (call-functions *clear-configuration-hook*))
-
- (register-image-dump-hook 'clear-configuration)
-
- (defun upgrade-configuration ()
- "If a previous version of ASDF failed to read some configuration, try again now."
- (when *ignored-configuration-form*
- (clear-configuration)
- (setf *ignored-configuration-form* nil)))
-
-
- (defun get-folder-path (folder)
- "Semi-portable implementation of a subset of LispWorks' sys:get-folder-path,
-this function tries to locate the Windows FOLDER for one of
-:LOCAL-APPDATA, :APPDATA or :COMMON-APPDATA.
- Returns NIL when the folder is not defined (e.g., not on Windows)."
- (or #+(and lispworks os-windows) (sys:get-folder-path folder)
- ;; read-windows-registry HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\User Shell Folders\AppData
- (ecase folder
- (:local-appdata (or (getenv-absolute-directory "LOCALAPPDATA")
- (subpathname* (get-folder-path :appdata) "Local")))
- (:appdata (getenv-absolute-directory "APPDATA"))
- (:common-appdata (or (getenv-absolute-directory "ALLUSERSAPPDATA")
- (subpathname* (getenv-absolute-directory "ALLUSERSPROFILE") "Application Data/"))))))
-
-
- ;; Support for the XDG Base Directory Specification
- (defun xdg-data-home (&rest more)
- "Returns an absolute pathname for the directory containing user-specific data files.
-MORE may contain specifications for a subpath relative to this directory: a
-subpathname specification and keyword arguments as per RESOLVE-LOCATION \(see
-also \"Configuration DSL\"\) in the ASDF manual."
- (resolve-absolute-location
- `(,(or (getenv-absolute-directory "XDG_DATA_HOME")
- (os-cond
- ((os-windows-p) (get-folder-path :local-appdata))
- (t (subpathname (user-homedir-pathname) ".local/share/"))))
- ,more)))
-
- (defun xdg-config-home (&rest more)
- "Returns a pathname for the directory containing user-specific configuration files.
-MORE may contain specifications for a subpath relative to this directory: a
-subpathname specification and keyword arguments as per RESOLVE-LOCATION \(see
-also \"Configuration DSL\"\) in the ASDF manual."
- (resolve-absolute-location
- `(,(or (getenv-absolute-directory "XDG_CONFIG_HOME")
- (os-cond
- ((os-windows-p) (xdg-data-home "config/"))
- (t (subpathname (user-homedir-pathname) ".config/"))))
- ,more)))
-
- (defun xdg-data-dirs (&rest more)
- "The preference-ordered set of additional paths to search for data files.
-Returns a list of absolute directory pathnames.
-MORE may contain specifications for a subpath relative to these directories: a
-subpathname specification and keyword arguments as per RESOLVE-LOCATION \(see
-also \"Configuration DSL\"\) in the ASDF manual."
- (mapcar #'(lambda (d) (resolve-location `(,d ,more)))
- (or (remove nil (getenv-absolute-directories "XDG_DATA_DIRS"))
- (os-cond
- ((os-windows-p) (mapcar 'get-folder-path '(:appdata :common-appdata)))
- (t (mapcar 'parse-unix-namestring '("/usr/local/share/" "/usr/share/")))))))
-
- (defun xdg-config-dirs (&rest more)
- "The preference-ordered set of additional base paths to search for configuration files.
-Returns a list of absolute directory pathnames.
-MORE may contain specifications for a subpath relative to these directories:
-subpathname specification and keyword arguments as per RESOLVE-LOCATION \(see
-also \"Configuration DSL\"\) in the ASDF manual."
- (mapcar #'(lambda (d) (resolve-location `(,d ,more)))
- (or (remove nil (getenv-absolute-directories "XDG_CONFIG_DIRS"))
- (os-cond
- ((os-windows-p) (xdg-data-dirs "config/"))
- (t (mapcar 'parse-unix-namestring '("/etc/xdg/")))))))
-
- (defun xdg-cache-home (&rest more)
- "The base directory relative to which user specific non-essential data files should be stored.
-Returns an absolute directory pathname.
-MORE may contain specifications for a subpath relative to this directory: a
-subpathname specification and keyword arguments as per RESOLVE-LOCATION \(see
-also \"Configuration DSL\"\) in the ASDF manual."
- (resolve-absolute-location
- `(,(or (getenv-absolute-directory "XDG_CACHE_HOME")
- (os-cond
- ((os-windows-p) (xdg-data-home "cache/"))
- (t (subpathname* (user-homedir-pathname) ".cache/"))))
- ,more)))
-
- (defun xdg-runtime-dir (&rest more)
- "Pathname for user-specific non-essential runtime files and other file objects,
-such as sockets, named pipes, etc.
-Returns an absolute directory pathname.
-MORE may contain specifications for a subpath relative to this directory: a
-subpathname specification and keyword arguments as per RESOLVE-LOCATION \(see
-also \"Configuration DSL\"\) in the ASDF manual."
- ;; The XDG spec says that if not provided by the login system, the application should
- ;; issue a warning and provide a replacement. UIOP is not equipped to do that and returns NIL.
- (resolve-absolute-location `(,(getenv-absolute-directory "XDG_RUNTIME_DIR") ,more)))
-
- ;;; NOTE: modified the docstring because "system user configuration
- ;;; directories" seems self-contradictory. I'm not sure my wording is right.
- (defun system-config-pathnames (&rest more)
- "Return a list of directories where are stored the system's default user configuration information.
-MORE may contain specifications for a subpath relative to these directories: a
-subpathname specification and keyword arguments as per RESOLVE-LOCATION \(see
-also \"Configuration DSL\"\) in the ASDF manual."
- (declare (ignorable more))
- (os-cond
- ((os-unix-p) (list (resolve-absolute-location `(,(parse-unix-namestring "/etc/") ,more))))))
-
- (defun filter-pathname-set (dirs)
- "Parse strings as unix namestrings and remove duplicates and non absolute-pathnames in a list."
- (remove-duplicates (remove-if-not #'absolute-pathname-p dirs) :from-end t :test 'equal))
-
- (defun xdg-data-pathnames (&rest more)
- "Return a list of absolute pathnames for application data directories. With APP,
-returns directory for data for that application, without APP, returns the set of directories
-for storing all application configurations.
-MORE may contain specifications for a subpath relative to these directories: a
-subpathname specification and keyword arguments as per RESOLVE-LOCATION \(see
-also \"Configuration DSL\"\) in the ASDF manual."
- (filter-pathname-set
- `(,(xdg-data-home more)
- ,@(xdg-data-dirs more))))
-
- (defun xdg-config-pathnames (&rest more)
- "Return a list of pathnames for application configuration.
-MORE may contain specifications for a subpath relative to these directories: a
-subpathname specification and keyword arguments as per RESOLVE-LOCATION \(see
-also \"Configuration DSL\"\) in the ASDF manual."
- (filter-pathname-set
- `(,(xdg-config-home more)
- ,@(xdg-config-dirs more))))
-
- (defun find-preferred-file (files &key (direction :input))
- "Find first file in the list of FILES that exists (for direction :input or :probe)
-or just the first one (for direction :output or :io).
- Note that when we say \"file\" here, the files in question may be directories."
- (find-if (ecase direction ((:probe :input) 'probe-file*) ((:output :io) 'identity)) files))
-
- (defun xdg-data-pathname (&optional more (direction :input))
- (find-preferred-file (xdg-data-pathnames more) :direction direction))
-
- (defun xdg-config-pathname (&optional more (direction :input))
- (find-preferred-file (xdg-config-pathnames more) :direction direction))
-
- (defun compute-user-cache ()
- "Compute (and return) the location of the default user-cache for translate-output
-objects. Side-effects for cached file location computation."
- (setf *user-cache* (xdg-cache-home "common-lisp" :implementation)))
- (register-image-restore-hook 'compute-user-cache))
(DIR) diff --git a/3rdparties/software/uiop-3.3.2/debug.lisp b/3rdparties/software/uiop-3.3.2/debug.lisp
@@ -1,118 +0,0 @@
-;;;;; A few essential debugging utilities by fare@tunes.org,
-;;;;; to be loaded in the *PACKAGE* that you wish to debug.
-;;
-;; We want debugging utilities in the _current_ package,
-;; so we don't have to either change the package structure
-;; or use heavy package prefixes everywhere.
-;;
-;; The short names of symbols below are unlikely to clash
-;; with global bindings of any well-designed source file being debugged,
-;; yet are quite practical in a debugging session.
-#|
-;;; If ASDF is already loaded,
-;;; you can load these utilities in the current package as follows:
-(uiop:uiop-debug)
-;; which is the same as:
-(uiop/utility:uiop-debug)
-
-;; The above macro can be configured to load any other debugging utility
-;; that you may prefer to this one, with your customizations,
-;; by setting the variable
-;; uiop/utility:*uiop-debug-utility*
-;; to a form that evaluates to a designator of the pathname to your file.
-;; For instance, on a home directory shared via NFS with different names
-;; on different machines, with your debug file in ~/lisp/debug-utils.lisp
-;; you could in your ~/.sbclrc have the following configuration setting:
-(require :asdf)
-(setf uiop/utility:*uiop-debug-utility*
- '(uiop/pathname:subpathname (uiop/os:user-homedir) "lisp/debug-utils.lisp"))
-
-;;; If ASDF is not loaded (for instance, when debugging ASDF itself),
-;;; Try the below, fixing the pathname to point to this file:
-(eval-when (:compile-toplevel :load-toplevel :execute)
- (let ((kw (read-from-string (format nil ":DBG-~A" (package-name *package*)))))
- (unless (member kw *features*)
- (load "/home/tunes/cl/asdf/contrib/debug.lisp"))))
-
-|#
-
-;;; Here we define the magic package-dependent feature.
-;;; With it, you should be able to use #+DBG-/PACKAGE-NAME/
-;;; to annotate your debug statements, e.g. upper-case #+DBG-ASDF
-;;; This will be all upper-case even in lower-case lisps.
-
-(eval-when (:compile-toplevel :load-toplevel :execute)
- (let ((kw (read-from-string
- (format nil ":DBG-~:@(~A~)" (package-name *package*)))))
- (pushnew kw *features*)))
-
-;;; Now for the debugging stuff itself.
-;;; First, my all-purpose print-debugging macro
-(defmacro DBG (tag &rest exprs)
- "debug macro for print-debugging:
-TAG is typically a constant string or keyword to identify who is printing,
-but can be an arbitrary expression returning a tag to be princ'ed first;
-if the expression returns NIL, nothing is printed.
-EXPRS are expressions, which when the TAG was not NIL are evaluated in order,
-with their source code then their return values being printed each time.
-The last expression is *always* evaluated and its multiple values are returned,
-but its source and return values are only printed if TAG was not NIL;
-previous expressions are not evaluated at all if TAG was NIL.
-The macro expansion has relatively low overhead in space or time."
- (let* ((last-expr (car (last exprs)))
- (other-exprs (butlast exprs))
- (tag-var (gensym "TAG"))
- (thunk-var (gensym "THUNK")))
- `(let ((,tag-var ,tag))
- (flet ,(when exprs `((,thunk-var () ,last-expr)))
- (if ,tag-var
- (DBG-helper ,tag-var
- (list ,@(loop :for x :in other-exprs :collect
- `(cons ',x #'(lambda () ,x))))
- ',last-expr ,(if exprs `#',thunk-var nil))
- ,(if exprs `(,thunk-var) '(values)))))))
-
-(defun DBG-helper (tag expressions-thunks last-expression last-thunk)
- ;; Helper for the above debugging macro
- (labels
- ((f (stream fmt &rest args)
- (with-standard-io-syntax
- (let ((*print-readably* nil)
- (*package* (find-package :cl)))
- (apply 'format stream fmt args)
- (finish-output stream))))
- (z (stream)
- (f stream "~&"))
- (e (fmt arg)
- (f *error-output* fmt arg))
- (x (expression thunk)
- (e "~& ~S => " expression)
- (let ((results (multiple-value-list (funcall thunk))))
- (e "~{~S~^ ~}~%" results)
- (values-list results))))
- (map () #'z (list *standard-output* *error-output* *trace-output*))
- (e "~A~%" tag)
- (loop :for (expression . thunk) :in expressions-thunks
- :do (x expression thunk))
- (if last-thunk
- (x last-expression last-thunk)
- (values))))
-
-
-;;; Quick definitions for use at the REPL
-(defun w (&rest x) (format t "~&~{~S~^ ~}~%" x)) ;Write, space separated + LF
-(defun a (&rest x) (format t "~&~{~A~}~%" x)) ;print Anything, no separator, LF
-(defun e (x) (cons x (ignore-errors (list (eval x))))) ;Evaluate
-(defmacro x (x) `(format t "~&~S => ~S~%" ',x ,x)) ;eXamine
-(defun i (&rest x) (apply (read-from-string "swank:inspect-in-emacs") x)) ; SLIME inspection
-(defun ra (&rest x) (require :cl-ppcre) (apply (read-from-string "cl-ppcre:regex-apropos") x))
-(defmacro !a (&rest foo) ; define! Alias
- `(progn ,@(loop :for (alias name) :on foo :by #'cddr
- :collect (if (macro-function name)
- `(defmacro ,alias (&rest x) `(,',name ,@x))
- `(defun ,alias (&rest x) (apply ',name x))))))
-(!a ;;; common aliases
- d describe
- ap apropos
- !p defparameter
- m1 macroexpand-1)
(DIR) diff --git a/3rdparties/software/uiop-3.3.2/driver.lisp b/3rdparties/software/uiop-3.3.2/driver.lisp
@@ -1,19 +0,0 @@
-;;;; ---------------------------------------------------------------------------
-;;;; Re-export all the functionality in UIOP
-
-(uiop/package:define-package :uiop/driver
- (:nicknames :uiop :asdf/driver) ;; asdf/driver is obsolete (uiop isn't);
- ;; but asdf/driver is still used by swap-bytes, static-vectors.
- (:use :uiop/common-lisp)
- ;; NB: not reexporting uiop/common-lisp
- ;; which include all of CL with compatibility modifications on select platforms,
- ;; that could cause potential conflicts for packages that would :use (cl uiop)
- ;; or :use (closer-common-lisp uiop), etc.
- (:use-reexport
- :uiop/package :uiop/utility :uiop/version
- :uiop/os :uiop/pathname :uiop/filesystem :uiop/stream :uiop/image
- :uiop/launch-program :uiop/run-program
- :uiop/lisp-build :uiop/configuration :uiop/backward-driver))
-
-;; Provide both lowercase and uppercase, to satisfy more people.
-(provide "uiop") (provide "UIOP")
(DIR) diff --git a/3rdparties/software/uiop-3.3.2/filesystem.lisp b/3rdparties/software/uiop-3.3.2/filesystem.lisp
@@ -1,681 +0,0 @@
-;;;; -------------------------------------------------------------------------
-;;;; Portability layer around Common Lisp filesystem access
-
-(uiop/package:define-package :uiop/filesystem
- (:use :uiop/common-lisp :uiop/package :uiop/utility :uiop/os :uiop/pathname)
- (:export
- ;; Native namestrings
- #:native-namestring #:parse-native-namestring
- ;; Probing the filesystem
- #:truename* #:safe-file-write-date #:probe-file* #:directory-exists-p #:file-exists-p
- #:directory* #:filter-logical-directory-results #:directory-files #:subdirectories
- #:collect-sub*directories
- ;; Resolving symlinks somewhat
- #:truenamize #:resolve-symlinks #:*resolve-symlinks* #:resolve-symlinks*
- ;; merging with cwd
- #:get-pathname-defaults #:call-with-current-directory #:with-current-directory
- ;; Environment pathnames
- #:inter-directory-separator #:split-native-pathnames-string
- #:getenv-pathname #:getenv-pathnames
- #:getenv-absolute-directory #:getenv-absolute-directories
- #:lisp-implementation-directory #:lisp-implementation-pathname-p
- ;; Simple filesystem operations
- #:ensure-all-directories-exist
- #:rename-file-overwriting-target
- #:delete-file-if-exists #:delete-empty-directory #:delete-directory-tree))
-(in-package :uiop/filesystem)
-
-;;; Native namestrings, as seen by the operating system calls rather than Lisp
-(with-upgradability ()
- (defun native-namestring (x)
- "From a non-wildcard CL pathname, a return namestring suitable for passing to the operating system"
- (when x
- (let ((p (pathname x)))
- #+clozure (with-pathname-defaults () (ccl:native-translated-namestring p)) ; see ccl bug 978
- #+(or cmucl scl) (ext:unix-namestring p nil)
- #+sbcl (sb-ext:native-namestring p)
- #-(or clozure cmucl sbcl scl)
- (os-cond
- ((os-unix-p) (unix-namestring p))
- (t (namestring p))))))
-
- (defun parse-native-namestring (string &rest constraints &key ensure-directory &allow-other-keys)
- "From a native namestring suitable for use by the operating system, return
-a CL pathname satisfying all the specified constraints as per ENSURE-PATHNAME"
- (check-type string (or string null))
- (let* ((pathname
- (when string
- (with-pathname-defaults ()
- #+clozure (ccl:native-to-pathname string)
- #+cmucl (uiop/os::parse-unix-namestring* string)
- #+sbcl (sb-ext:parse-native-namestring string)
- #+scl (lisp::parse-unix-namestring string)
- #-(or clozure cmucl sbcl scl)
- (os-cond
- ((os-unix-p) (parse-unix-namestring string :ensure-directory ensure-directory))
- (t (parse-namestring string))))))
- (pathname
- (if ensure-directory
- (and pathname (ensure-directory-pathname pathname))
- pathname)))
- (apply 'ensure-pathname pathname constraints))))
-
-
-;;; Probing the filesystem
-(with-upgradability ()
- (defun truename* (p)
- "Nicer variant of TRUENAME that plays well with NIL, avoids logical pathname contexts, and tries both files and directories"
- (when p
- (when (stringp p) (setf p (with-pathname-defaults () (parse-namestring p))))
- (values
- (or (ignore-errors (truename p))
- ;; this is here because trying to find the truename of a directory pathname WITHOUT supplying
- ;; a trailing directory separator, causes an error on some lisps.
- #+(or clisp gcl) (if-let (d (ensure-directory-pathname p nil)) (ignore-errors (truename d)))))))
-
- (defun safe-file-write-date (pathname)
- "Safe variant of FILE-WRITE-DATE that may return NIL rather than raise an error."
- ;; If FILE-WRITE-DATE returns NIL, it's possible that
- ;; the user or some other agent has deleted an input file.
- ;; Also, generated files will not exist at the time planning is done
- ;; and calls compute-action-stamp which calls safe-file-write-date.
- ;; So it is very possible that we can't get a valid file-write-date,
- ;; and we can survive and we will continue the planning
- ;; as if the file were very old.
- ;; (or should we treat the case in a different, special way?)
- (and pathname
- (handler-case (file-write-date (physicalize-pathname pathname))
- (file-error () nil))))
-
- (defun probe-file* (p &key truename)
- "when given a pathname P (designated by a string as per PARSE-NAMESTRING),
-probes the filesystem for a file or directory with given pathname.
-If it exists, return its truename if TRUENAME is true,
-or the original (parsed) pathname if it is false (the default)."
- (values
- (ignore-errors
- (setf p (funcall 'ensure-pathname p
- :namestring :lisp
- :ensure-physical t
- :ensure-absolute t :defaults 'get-pathname-defaults
- :want-non-wild t
- :on-error nil))
- (when p
- #+allegro
- (probe-file p :follow-symlinks truename)
- #+gcl
- (if truename
- (truename* p)
- (let ((kind (car (si::stat p))))
- (when (eq kind :link)
- (setf kind (ignore-errors (car (si::stat (truename* p))))))
- (ecase kind
- ((nil) nil)
- ((:file :link)
- (cond
- ((file-pathname-p p) p)
- ((directory-pathname-p p)
- (subpathname p (car (last (pathname-directory p)))))))
- (:directory (ensure-directory-pathname p)))))
- #+clisp
- #.(let* ((fs (or #-os-windows (find-symbol* '#:file-stat :posix nil)))
- (pp (find-symbol* '#:probe-pathname :ext nil)))
- `(if truename
- ,(if pp
- `(values (,pp p))
- '(or (truename* p)
- (truename* (ignore-errors (ensure-directory-pathname p)))))
- ,(cond
- (fs `(and (,fs p) p))
- (pp `(nth-value 1 (,pp p)))
- (t '(or (and (truename* p) p)
- (if-let (d (ensure-directory-pathname p))
- (and (truename* d) d)))))))
- #-(or allegro clisp gcl)
- (if truename
- (probe-file p)
- (and
- #+(or cmucl scl) (unix:unix-stat (ext:unix-namestring p))
- #+(and lispworks os-unix) (system:get-file-stat p)
- #+sbcl (sb-unix:unix-stat (sb-ext:native-namestring p))
- #-(or cmucl (and lispworks os-unix) sbcl scl) (file-write-date p)
- p))))))
-
- (defun directory-exists-p (x)
- "Is X the name of a directory that exists on the filesystem?"
- #+allegro
- (excl:probe-directory x)
- #+clisp
- (handler-case (ext:probe-directory x)
- (sys::simple-file-error ()
- nil))
- #-(or allegro clisp)
- (let ((p (probe-file* x :truename t)))
- (and (directory-pathname-p p) p)))
-
- (defun file-exists-p (x)
- "Is X the name of a file that exists on the filesystem?"
- (let ((p (probe-file* x :truename t)))
- (and (file-pathname-p p) p)))
-
- (defun directory* (pathname-spec &rest keys &key &allow-other-keys)
- "Return a list of the entries in a directory by calling DIRECTORY.
-Try to override the defaults to not resolving symlinks, if implementation allows."
- (apply 'directory pathname-spec
- (append keys '#.(or #+allegro '(:directories-are-files nil :follow-symbolic-links nil)
- #+(or clozure digitool) '(:follow-links nil)
- #+clisp '(:circle t :if-does-not-exist :ignore)
- #+(or cmucl scl) '(:follow-links nil :truenamep nil)
- #+lispworks '(:link-transparency nil)
- #+sbcl (when (find-symbol* :resolve-symlinks '#:sb-impl nil)
- '(:resolve-symlinks nil))))))
-
- (defun filter-logical-directory-results (directory entries merger)
- "If DIRECTORY isn't a logical pathname, return ENTRIES. If it is,
-given ENTRIES in the DIRECTORY, remove the entries which are physical yet
-when transformed by MERGER have a different TRUENAME.
-Also remove duplicates as may appear with some translation rules.
-This function is used as a helper to DIRECTORY-FILES to avoid invalid entries
-when using logical-pathnames."
- (if (logical-pathname-p directory)
- (remove-duplicates ;; on CLISP, querying ~/ will return duplicates
- ;; Try hard to not resolve logical-pathname into physical pathnames;
- ;; otherwise logical-pathname users/lovers will be disappointed.
- ;; If directory* could use some implementation-dependent magic,
- ;; we will have logical pathnames already; otherwise,
- ;; we only keep pathnames for which specifying the name and
- ;; translating the LPN commute.
- (loop :for f :in entries
- :for p = (or (and (logical-pathname-p f) f)
- (let* ((u (ignore-errors (call-function merger f))))
- ;; The first u avoids a cumbersome (truename u) error.
- ;; At this point f should already be a truename,
- ;; but isn't quite in CLISP, for it doesn't have :version :newest
- (and u (equal (truename* u) (truename* f)) u)))
- :when p :collect p)
- :test 'pathname-equal)
- entries))
-
- (defun directory-files (directory &optional (pattern *wild-file-for-directory*))
- "Return a list of the files in a directory according to the PATTERN.
-Subdirectories should NOT be returned.
- PATTERN defaults to a pattern carefully chosen based on the implementation;
-override the default at your own risk.
- DIRECTORY-FILES tries NOT to resolve symlinks if the implementation permits this,
-but the behavior in presence of symlinks is not portable. Use IOlib to handle such situations."
- (let ((dir (pathname directory)))
- (when (logical-pathname-p dir)
- ;; Because of the filtering we do below,
- ;; logical pathnames have restrictions on wild patterns.
- ;; Not that the results are very portable when you use these patterns on physical pathnames.
- (when (wild-pathname-p dir)
- (parameter-error "~S: Invalid wild pattern in logical directory ~S"
- 'directory-files directory))
- (unless (member (pathname-directory pattern) '(() (:relative)) :test 'equal)
- (parameter-error "~S: Invalid file pattern ~S for logical directory ~S" 'directory-files pattern directory))
- (setf pattern (make-pathname-logical pattern (pathname-host dir))))
- (let* ((pat (merge-pathnames* pattern dir))
- (entries (ignore-errors (directory* pat))))
- (remove-if 'directory-pathname-p
- (filter-logical-directory-results
- directory entries
- #'(lambda (f)
- (make-pathname :defaults dir
- :name (make-pathname-component-logical (pathname-name f))
- :type (make-pathname-component-logical (pathname-type f))
- :version (make-pathname-component-logical (pathname-version f)))))))))
-
- (defun subdirectories (directory)
- "Given a DIRECTORY pathname designator, return a list of the subdirectories under it.
-The behavior in presence of symlinks is not portable. Use IOlib to handle such situations."
- (let* ((directory (ensure-directory-pathname directory))
- #-(or abcl cormanlisp genera xcl)
- (wild (merge-pathnames*
- #-(or abcl allegro cmucl lispworks sbcl scl xcl)
- *wild-directory*
- #+(or abcl allegro cmucl lispworks sbcl scl xcl) "*.*"
- directory))
- (dirs
- #-(or abcl cormanlisp genera xcl)
- (ignore-errors
- (directory* wild . #.(or #+clozure '(:directories t :files nil)
- #+mcl '(:directories t))))
- #+(or abcl xcl) (system:list-directory directory)
- #+cormanlisp (cl::directory-subdirs directory)
- #+genera (handler-case (fs:directory-list directory) (fs:directory-not-found () nil)))
- #+(or abcl allegro cmucl genera lispworks sbcl scl xcl)
- (dirs (loop :for x :in dirs
- :for d = #+(or abcl xcl) (extensions:probe-directory x)
- #+allegro (excl:probe-directory x)
- #+(or cmucl sbcl scl) (directory-pathname-p x)
- #+genera (getf (cdr x) :directory)
- #+lispworks (lw:file-directory-p x)
- :when d :collect #+(or abcl allegro xcl) (ensure-directory-pathname d)
- #+genera (ensure-directory-pathname (first x))
- #+(or cmucl lispworks sbcl scl) x)))
- (filter-logical-directory-results
- directory dirs
- (let ((prefix (or (normalize-pathname-directory-component (pathname-directory directory))
- '(:absolute)))) ; because allegro returns NIL for #p"FOO:"
- #'(lambda (d)
- (let ((dir (normalize-pathname-directory-component (pathname-directory d))))
- (and (consp dir) (consp (cdr dir))
- (make-pathname
- :defaults directory :name nil :type nil :version nil
- :directory (append prefix (make-pathname-component-logical (last dir)))))))))))
-
- (defun collect-sub*directories (directory collectp recursep collector)
- "Given a DIRECTORY, when COLLECTP returns true when CALL-FUNCTION'ed with the directory,
-call-function the COLLECTOR function designator on the directory,
-and recurse each of its subdirectories on which the RECURSEP returns true when CALL-FUNCTION'ed with them.
-This function will thus let you traverse a filesystem hierarchy,
-superseding the functionality of CL-FAD:WALK-DIRECTORY.
-The behavior in presence of symlinks is not portable. Use IOlib to handle such situations."
- (when (call-function collectp directory)
- (call-function collector directory)
- (dolist (subdir (subdirectories directory))
- (when (call-function recursep subdir)
- (collect-sub*directories subdir collectp recursep collector))))))
-
-;;; Resolving symlinks somewhat
-(with-upgradability ()
- (defun truenamize (pathname)
- "Resolve as much of a pathname as possible"
- (block nil
- (when (typep pathname '(or null logical-pathname)) (return pathname))
- (let ((p pathname))
- (unless (absolute-pathname-p p)
- (setf p (or (absolute-pathname-p (ensure-absolute-pathname p 'get-pathname-defaults nil))
- (return p))))
- (when (logical-pathname-p p) (return p))
- (let ((found (probe-file* p :truename t)))
- (when found (return found)))
- (let* ((directory (normalize-pathname-directory-component (pathname-directory p)))
- (up-components (reverse (rest directory)))
- (down-components ()))
- (assert (eq :absolute (first directory)))
- (loop :while up-components :do
- (if-let (parent
- (ignore-errors
- (probe-file* (make-pathname :directory `(:absolute ,@(reverse up-components))
- :name nil :type nil :version nil :defaults p))))
- (if-let (simplified
- (ignore-errors
- (merge-pathnames*
- (make-pathname :directory `(:relative ,@down-components)
- :defaults p)
- (ensure-directory-pathname parent))))
- (return simplified)))
- (push (pop up-components) down-components)
- :finally (return p))))))
-
- (defun resolve-symlinks (path)
- "Do a best effort at resolving symlinks in PATH, returning a partially or totally resolved PATH."
- #-allegro (truenamize path)
- #+allegro
- (if (physical-pathname-p path)
- (or (ignore-errors (excl:pathname-resolve-symbolic-links path)) path)
- path))
-
- (defvar *resolve-symlinks* t
- "Determine whether or not ASDF resolves symlinks when defining systems.
-Defaults to T.")
-
- (defun resolve-symlinks* (path)
- "RESOLVE-SYMLINKS in PATH iff *RESOLVE-SYMLINKS* is T (the default)."
- (if *resolve-symlinks*
- (and path (resolve-symlinks path))
- path)))
-
-
-;;; Check pathname constraints
-(with-upgradability ()
- (defun ensure-pathname
- (pathname &key
- on-error
- defaults type dot-dot namestring
- empty-is-nil
- want-pathname
- want-logical want-physical ensure-physical
- want-relative want-absolute ensure-absolute ensure-subpath
- want-non-wild want-wild wilden
- want-file want-directory ensure-directory
- want-existing ensure-directories-exist
- truename resolve-symlinks truenamize
- &aux (p pathname)) ;; mutable working copy, preserve original
- "Coerces its argument into a PATHNAME,
-optionally doing some transformations and checking specified constraints.
-
-If the argument is NIL, then NIL is returned unless the WANT-PATHNAME constraint is specified.
-
-If the argument is a STRING, it is first converted to a pathname via
-PARSE-UNIX-NAMESTRING, PARSE-NAMESTRING or PARSE-NATIVE-NAMESTRING respectively
-depending on the NAMESTRING argument being :UNIX, :LISP or :NATIVE respectively,
-or else by using CALL-FUNCTION on the NAMESTRING argument;
-if :UNIX is specified (or NIL, the default, which specifies the same thing),
-then PARSE-UNIX-NAMESTRING it is called with the keywords
-DEFAULTS TYPE DOT-DOT ENSURE-DIRECTORY WANT-RELATIVE, and
-the result is optionally merged into the DEFAULTS if ENSURE-ABSOLUTE is true.
-
-The pathname passed or resulting from parsing the string
-is then subjected to all the checks and transformations below are run.
-
-Each non-nil constraint argument can be one of the symbols T, ERROR, CERROR or IGNORE.
-The boolean T is an alias for ERROR.
-ERROR means that an error will be raised if the constraint is not satisfied.
-CERROR means that an continuable error will be raised if the constraint is not satisfied.
-IGNORE means just return NIL instead of the pathname.
-
-The ON-ERROR argument, if not NIL, is a function designator (as per CALL-FUNCTION)
-that will be called with the the following arguments:
-a generic format string for ensure pathname, the pathname,
-the keyword argument corresponding to the failed check or transformation,
-a format string for the reason ENSURE-PATHNAME failed,
-and a list with arguments to that format string.
-If ON-ERROR is NIL, ERROR is used instead, which does the right thing.
-You could also pass (CERROR \"CONTINUE DESPITE FAILED CHECK\").
-
-The transformations and constraint checks are done in this order,
-which is also the order in the lambda-list:
-
-EMPTY-IS-NIL returns NIL if the argument is an empty string.
-WANT-PATHNAME checks that pathname (after parsing if needed) is not null.
-Otherwise, if the pathname is NIL, ensure-pathname returns NIL.
-WANT-LOGICAL checks that pathname is a LOGICAL-PATHNAME
-WANT-PHYSICAL checks that pathname is not a LOGICAL-PATHNAME
-ENSURE-PHYSICAL ensures that pathname is physical via TRANSLATE-LOGICAL-PATHNAME
-WANT-RELATIVE checks that pathname has a relative directory component
-WANT-ABSOLUTE checks that pathname does have an absolute directory component
-ENSURE-ABSOLUTE merges with the DEFAULTS, then checks again
-that the result absolute is an absolute pathname indeed.
-ENSURE-SUBPATH checks that the pathname is a subpath of the DEFAULTS.
-WANT-FILE checks that pathname has a non-nil FILE component
-WANT-DIRECTORY checks that pathname has nil FILE and TYPE components
-ENSURE-DIRECTORY uses ENSURE-DIRECTORY-PATHNAME to interpret
-any file and type components as being actually a last directory component.
-WANT-NON-WILD checks that pathname is not a wild pathname
-WANT-WILD checks that pathname is a wild pathname
-WILDEN merges the pathname with **/*.*.* if it is not wild
-WANT-EXISTING checks that a file (or directory) exists with that pathname.
-ENSURE-DIRECTORIES-EXIST creates any parent directory with ENSURE-DIRECTORIES-EXIST.
-TRUENAME replaces the pathname by its truename, or errors if not possible.
-RESOLVE-SYMLINKS replaces the pathname by a variant with symlinks resolved by RESOLVE-SYMLINKS.
-TRUENAMIZE uses TRUENAMIZE to resolve as many symlinks as possible."
- (block nil
- (flet ((report-error (keyword description &rest arguments)
- (call-function (or on-error 'error)
- "Invalid pathname ~S: ~*~?"
- pathname keyword description arguments)))
- (macrolet ((err (constraint &rest arguments)
- `(report-error ',(intern* constraint :keyword) ,@arguments))
- (check (constraint condition &rest arguments)
- `(when ,constraint
- (unless ,condition (err ,constraint ,@arguments))))
- (transform (transform condition expr)
- `(when ,transform
- (,@(if condition `(when ,condition) '(progn))
- (setf p ,expr)))))
- (etypecase p
- ((or null pathname))
- (string
- (when (and (emptyp p) empty-is-nil)
- (return-from ensure-pathname nil))
- (setf p (case namestring
- ((:unix nil)
- (parse-unix-namestring
- p :defaults defaults :type type :dot-dot dot-dot
- :ensure-directory ensure-directory :want-relative want-relative))
- ((:native)
- (parse-native-namestring p))
- ((:lisp)
- (parse-namestring p))
- (t
- (call-function namestring p))))))
- (etypecase p
- (pathname)
- (null
- (check want-pathname (pathnamep p) "Expected a pathname, not NIL")
- (return nil)))
- (check want-logical (logical-pathname-p p) "Expected a logical pathname")
- (check want-physical (physical-pathname-p p) "Expected a physical pathname")
- (transform ensure-physical () (physicalize-pathname p))
- (check ensure-physical (physical-pathname-p p) "Could not translate to a physical pathname")
- (check want-relative (relative-pathname-p p) "Expected a relative pathname")
- (check want-absolute (absolute-pathname-p p) "Expected an absolute pathname")
- (transform ensure-absolute (not (absolute-pathname-p p))
- (ensure-absolute-pathname p defaults (list #'report-error :ensure-absolute "~@?")))
- (check ensure-absolute (absolute-pathname-p p)
- "Could not make into an absolute pathname even after merging with ~S" defaults)
- (check ensure-subpath (absolute-pathname-p defaults)
- "cannot be checked to be a subpath of non-absolute pathname ~S" defaults)
- (check ensure-subpath (subpathp p defaults) "is not a sub pathname of ~S" defaults)
- (check want-file (file-pathname-p p) "Expected a file pathname")
- (check want-directory (directory-pathname-p p) "Expected a directory pathname")
- (transform ensure-directory (not (directory-pathname-p p)) (ensure-directory-pathname p))
- (check want-non-wild (not (wild-pathname-p p)) "Expected a non-wildcard pathname")
- (check want-wild (wild-pathname-p p) "Expected a wildcard pathname")
- (transform wilden (not (wild-pathname-p p)) (wilden p))
- (when want-existing
- (let ((existing (probe-file* p :truename truename)))
- (if existing
- (when truename
- (return existing))
- (err want-existing "Expected an existing pathname"))))
- (when ensure-directories-exist (ensure-directories-exist p))
- (when truename
- (let ((truename (truename* p)))
- (if truename
- (return truename)
- (err truename "Can't get a truename for pathname"))))
- (transform resolve-symlinks () (resolve-symlinks p))
- (transform truenamize () (truenamize p))
- p)))))
-
-
-;;; Pathname defaults
-(with-upgradability ()
- (defun get-pathname-defaults (&optional (defaults *default-pathname-defaults*))
- "Find the actual DEFAULTS to use for pathnames, including
-resolving them with respect to GETCWD if the DEFAULTS were relative"
- (or (absolute-pathname-p defaults)
- (merge-pathnames* defaults (getcwd))))
-
- (defun call-with-current-directory (dir thunk)
- "call the THUNK in a context where the current directory was changed to DIR, if not NIL.
-Note that this operation is usually NOT thread-safe."
- (if dir
- (let* ((dir (resolve-symlinks* (get-pathname-defaults (pathname-directory-pathname dir))))
- (cwd (getcwd))
- (*default-pathname-defaults* dir))
- (chdir dir)
- (unwind-protect
- (funcall thunk)
- (chdir cwd)))
- (funcall thunk)))
-
- (defmacro with-current-directory ((&optional dir) &body body)
- "Call BODY while the POSIX current working directory is set to DIR"
- `(call-with-current-directory ,dir #'(lambda () ,@body))))
-
-
-;;; Environment pathnames
-(with-upgradability ()
- (defun inter-directory-separator ()
- "What character does the current OS conventionally uses to separate directories?"
- (os-cond ((os-unix-p) #\:) (t #\;)))
-
- (defun split-native-pathnames-string (string &rest constraints &key &allow-other-keys)
- "Given a string of pathnames specified in native OS syntax, separate them in a list,
-check constraints and normalize each one as per ENSURE-PATHNAME,
-where an empty string denotes NIL."
- (loop :for namestring :in (split-string string :separator (string (inter-directory-separator)))
- :collect (unless (emptyp namestring) (apply 'parse-native-namestring namestring constraints))))
-
- (defun getenv-pathname (x &rest constraints &key ensure-directory want-directory on-error &allow-other-keys)
- "Extract a pathname from a user-configured environment variable, as per native OS,
-check constraints and normalize as per ENSURE-PATHNAME."
- ;; For backward compatibility with ASDF 2, want-directory implies ensure-directory
- (apply 'parse-native-namestring (getenvp x)
- :ensure-directory (or ensure-directory want-directory)
- :on-error (or on-error
- `(error "In (~S ~S), invalid pathname ~*~S: ~*~?" getenv-pathname ,x))
- constraints))
- (defun getenv-pathnames (x &rest constraints &key on-error &allow-other-keys)
- "Extract a list of pathname from a user-configured environment variable, as per native OS,
-check constraints and normalize each one as per ENSURE-PATHNAME.
- Any empty entries in the environment variable X will be returned as NILs."
- (unless (getf constraints :empty-is-nil t)
- (parameter-error "Cannot have EMPTY-IS-NIL false for ~S" 'getenv-pathnames))
- (apply 'split-native-pathnames-string (getenvp x)
- :on-error (or on-error
- `(error "In (~S ~S), invalid pathname ~*~S: ~*~?" getenv-pathnames ,x))
- :empty-is-nil t
- constraints))
- (defun getenv-absolute-directory (x)
- "Extract an absolute directory pathname from a user-configured environment variable,
-as per native OS"
- (getenv-pathname x :want-absolute t :ensure-directory t))
- (defun getenv-absolute-directories (x)
- "Extract a list of absolute directories from a user-configured environment variable,
-as per native OS. Any empty entries in the environment variable X will be returned as
-NILs."
- (getenv-pathnames x :want-absolute t :ensure-directory t))
-
- (defun lisp-implementation-directory (&key truename)
- "Where are the system files of the current installation of the CL implementation?"
- (declare (ignorable truename))
- (let ((dir
- #+abcl extensions:*lisp-home*
- #+(or allegro clasp ecl mkcl) #p"SYS:"
- #+clisp custom:*lib-directory*
- #+clozure #p"ccl:"
- #+cmucl (ignore-errors (pathname-parent-directory-pathname (truename #p"modules:")))
- #+gcl system::*system-directory*
- #+lispworks lispworks:*lispworks-directory*
- #+sbcl (if-let (it (find-symbol* :sbcl-homedir-pathname :sb-int nil))
- (funcall it)
- (getenv-pathname "SBCL_HOME" :ensure-directory t))
- #+scl (ignore-errors (pathname-parent-directory-pathname (truename #p"file://modules/")))
- #+xcl ext:*xcl-home*))
- (if (and dir truename)
- (truename* dir)
- dir)))
-
- (defun lisp-implementation-pathname-p (pathname)
- "Is the PATHNAME under the current installation of the CL implementation?"
- ;; Other builtin systems are those under the implementation directory
- (and (when pathname
- (if-let (impdir (lisp-implementation-directory))
- (or (subpathp pathname impdir)
- (when *resolve-symlinks*
- (if-let (truename (truename* pathname))
- (if-let (trueimpdir (truename* impdir))
- (subpathp truename trueimpdir)))))))
- t)))
-
-
-;;; Simple filesystem operations
-(with-upgradability ()
- (defun ensure-all-directories-exist (pathnames)
- "Ensure that for every pathname in PATHNAMES, we ensure its directories exist"
- (dolist (pathname pathnames)
- (when pathname
- (ensure-directories-exist (physicalize-pathname pathname)))))
-
- (defun delete-file-if-exists (x)
- "Delete a file X if it already exists"
- (when x (handler-case (delete-file x) (file-error () nil))))
-
- (defun rename-file-overwriting-target (source target)
- "Rename a file, overwriting any previous file with the TARGET name,
-in an atomic way if the implementation allows."
- (let ((source (ensure-pathname source :namestring :lisp :ensure-physical t :want-file t))
- (target (ensure-pathname target :namestring :lisp :ensure-physical t :want-file t)))
- #+clisp ;; in recent enough versions of CLISP, :if-exists :overwrite would make it atomic
- (progn (funcall 'require "syscalls")
- (symbol-call :posix :copy-file source target :method :rename))
- #+(and sbcl os-windows) (delete-file-if-exists target) ;; not atomic
- #-clisp
- (rename-file source target
- #+(or clasp clozure ecl) :if-exists
- #+clozure :rename-and-delete #+(or clasp ecl) t)))
-
- (defun delete-empty-directory (directory-pathname)
- "Delete an empty directory"
- #+(or abcl digitool gcl) (delete-file directory-pathname)
- #+allegro (excl:delete-directory directory-pathname)
- #+clisp (ext:delete-directory directory-pathname)
- #+clozure (ccl::delete-empty-directory directory-pathname)
- #+(or cmucl scl) (multiple-value-bind (ok errno)
- (unix:unix-rmdir (native-namestring directory-pathname))
- (unless ok
- #+cmucl (error "Error number ~A when trying to delete directory ~A"
- errno directory-pathname)
- #+scl (error "~@<Error deleting ~S: ~A~@:>"
- directory-pathname (unix:get-unix-error-msg errno))))
- #+cormanlisp (win32:delete-directory directory-pathname)
- #+(or clasp ecl) (si:rmdir directory-pathname)
- #+genera (fs:delete-directory directory-pathname)
- #+lispworks (lw:delete-directory directory-pathname)
- #+mkcl (mkcl:rmdir directory-pathname)
- #+sbcl #.(if-let (dd (find-symbol* :delete-directory :sb-ext nil))
- `(,dd directory-pathname) ;; requires SBCL 1.0.44 or later
- `(progn (require :sb-posix) (symbol-call :sb-posix :rmdir directory-pathname)))
- #+xcl (symbol-call :uiop :run-program `("rmdir" ,(native-namestring directory-pathname)))
- #-(or abcl allegro clasp clisp clozure cmucl cormanlisp digitool ecl gcl genera lispworks mkcl sbcl scl xcl)
- (not-implemented-error 'delete-empty-directory "(on your platform)")) ; genera
-
- (defun delete-directory-tree (directory-pathname &key (validate nil validatep) (if-does-not-exist :error))
- "Delete a directory including all its recursive contents, aka rm -rf.
-
-To reduce the risk of infortunate mistakes, DIRECTORY-PATHNAME must be
-a physical non-wildcard directory pathname (not namestring).
-
-If the directory does not exist, the IF-DOES-NOT-EXIST argument specifies what happens:
-if it is :ERROR (the default), an error is signaled, whereas if it is :IGNORE, nothing is done.
-
-Furthermore, before any deletion is attempted, the DIRECTORY-PATHNAME must pass
-the validation function designated (as per ENSURE-FUNCTION) by the VALIDATE keyword argument
-which in practice is thus compulsory, and validates by returning a non-NIL result.
-If you're suicidal or extremely confident, just use :VALIDATE T."
- (check-type if-does-not-exist (member :error :ignore))
- (cond
- ((not (and (pathnamep directory-pathname) (directory-pathname-p directory-pathname)
- (physical-pathname-p directory-pathname) (not (wild-pathname-p directory-pathname))))
- (parameter-error "~S was asked to delete ~S but it is not a physical non-wildcard directory pathname"
- 'delete-directory-tree directory-pathname))
- ((not validatep)
- (parameter-error "~S was asked to delete ~S but was not provided a validation predicate"
- 'delete-directory-tree directory-pathname))
- ((not (call-function validate directory-pathname))
- (parameter-error "~S was asked to delete ~S but it is not valid ~@[according to ~S~]"
- 'delete-directory-tree directory-pathname validate))
- ((not (directory-exists-p directory-pathname))
- (ecase if-does-not-exist
- (:error
- (error "~S was asked to delete ~S but the directory does not exist"
- 'delete-directory-tree directory-pathname))
- (:ignore nil)))
- #-(or allegro cmucl clozure genera sbcl scl)
- ((os-unix-p) ;; On Unix, don't recursively walk the directory and delete everything in Lisp,
- ;; except on implementations where we can prevent DIRECTORY from following symlinks;
- ;; instead spawn a standard external program to do the dirty work.
- (symbol-call :uiop :run-program `("rm" "-rf" ,(native-namestring directory-pathname))))
- (t
- ;; On supported implementation, call supported system functions
- #+allegro (symbol-call :excl.osi :delete-directory-and-files
- directory-pathname :if-does-not-exist if-does-not-exist)
- #+clozure (ccl:delete-directory directory-pathname)
- #+genera (fs:delete-directory directory-pathname :confirm nil)
- #+sbcl #.(if-let (dd (find-symbol* :delete-directory :sb-ext nil))
- `(,dd directory-pathname :recursive t) ;; requires SBCL 1.0.44 or later
- '(error "~S requires SBCL 1.0.44 or later" 'delete-directory-tree))
- ;; Outside Unix or on CMUCL and SCL that can avoid following symlinks,
- ;; do things the hard way.
- #-(or allegro clozure genera sbcl)
- (let ((sub*directories
- (while-collecting (c)
- (collect-sub*directories directory-pathname t t #'c))))
- (dolist (d (nreverse sub*directories))
- (map () 'delete-file (directory-files d))
- (delete-empty-directory d)))))))
(DIR) diff --git a/3rdparties/software/uiop-3.3.2/image.lisp b/3rdparties/software/uiop-3.3.2/image.lisp
@@ -1,483 +0,0 @@
-;;;; -------------------------------------------------------------------------
-;;;; Starting, Stopping, Dumping a Lisp image
-
-(uiop/package:define-package :uiop/image
- (:use :uiop/common-lisp :uiop/package :uiop/utility :uiop/pathname :uiop/stream :uiop/os)
- (:export
- #:*image-dumped-p* #:raw-command-line-arguments #:*command-line-arguments*
- #:command-line-arguments #:raw-command-line-arguments #:setup-command-line-arguments #:argv0
- #:*lisp-interaction*
- #:fatal-condition #:fatal-condition-p
- #:handle-fatal-condition
- #:call-with-fatal-condition-handler #:with-fatal-condition-handler
- #:*image-restore-hook* #:*image-prelude* #:*image-entry-point*
- #:*image-postlude* #:*image-dump-hook*
- #:quit #:die #:raw-print-backtrace #:print-backtrace #:print-condition-backtrace
- #:shell-boolean-exit
- #:register-image-restore-hook #:register-image-dump-hook
- #:call-image-restore-hook #:call-image-dump-hook
- #:restore-image #:dump-image #:create-image
-))
-(in-package :uiop/image)
-
-(with-upgradability ()
- (defvar *lisp-interaction* t
- "Is this an interactive Lisp environment, or is it batch processing?")
-
- (defvar *command-line-arguments* nil
- "Command-line arguments")
-
- (defvar *image-dumped-p* nil ; may matter as to how to get to command-line-arguments
- "Is this a dumped image? As a standalone executable?")
-
- (defvar *image-restore-hook* nil
- "Functions to call (in reverse order) when the image is restored")
-
- (defvar *image-restored-p* nil
- "Has the image been restored? A boolean, or :in-progress while restoring, :in-regress while dumping")
-
- (defvar *image-prelude* nil
- "a form to evaluate, or string containing forms to read and evaluate
-when the image is restarted, but before the entry point is called.")
-
- (defvar *image-entry-point* nil
- "a function with which to restart the dumped image when execution is restored from it.")
-
- (defvar *image-postlude* nil
- "a form to evaluate, or string containing forms to read and evaluate
-before the image dump hooks are called and before the image is dumped.")
-
- (defvar *image-dump-hook* nil
- "Functions to call (in order) when before an image is dumped"))
-
-(eval-when (#-lispworks :compile-toplevel :load-toplevel :execute)
- (deftype fatal-condition ()
- `(and serious-condition #+clozure (not ccl:process-reset))))
-
-;;; Exiting properly or im-
-(with-upgradability ()
- (defun quit (&optional (code 0) (finish-output t))
- "Quits from the Lisp world, with the given exit status if provided.
-This is designed to abstract away the implementation specific quit forms."
- (when finish-output ;; essential, for ClozureCL, and for standard compliance.
- (finish-outputs))
- #+(or abcl xcl) (ext:quit :status code)
- #+allegro (excl:exit code :quiet t)
- #+(or clasp ecl) (si:quit code)
- #+clisp (ext:quit code)
- #+clozure (ccl:quit code)
- #+cormanlisp (win32:exitprocess code)
- #+(or cmucl scl) (unix:unix-exit code)
- #+gcl (system:quit code)
- #+genera (error "~S: You probably don't want to Halt Genera. (code: ~S)" 'quit code)
- #+lispworks (lispworks:quit :status code :confirm nil :return nil :ignore-errors-p t)
- #+mcl (progn code (ccl:quit)) ;; or should we use FFI to call libc's exit(3) ?
- #+mkcl (mk-ext:quit :exit-code code)
- #+sbcl #.(let ((exit (find-symbol* :exit :sb-ext nil))
- (quit (find-symbol* :quit :sb-ext nil)))
- (cond
- (exit `(,exit :code code :abort (not finish-output)))
- (quit `(,quit :unix-status code :recklessly-p (not finish-output)))))
- #-(or abcl allegro clasp clisp clozure cmucl ecl gcl genera lispworks mcl mkcl sbcl scl xcl)
- (not-implemented-error 'quit "(called with exit code ~S)" code))
-
- (defun die (code format &rest arguments)
- "Die in error with some error message"
- (with-safe-io-syntax ()
- (ignore-errors
- (format! *stderr* "~&~?~&" format arguments)))
- (quit code))
-
- (defun raw-print-backtrace (&key (stream *debug-io*) count condition)
- "Print a backtrace, directly accessing the implementation"
- (declare (ignorable stream count condition))
- #+abcl
- (loop :for i :from 0
- :for frame :in (sys:backtrace (or count most-positive-fixnum)) :do
- (safe-format! stream "~&~D: ~A~%" i frame))
- #+allegro
- (let ((*terminal-io* stream)
- (*standard-output* stream)
- (tpl:*zoom-print-circle* *print-circle*)
- (tpl:*zoom-print-level* *print-level*)
- (tpl:*zoom-print-length* *print-length*))
- (tpl:do-command "zoom"
- :from-read-eval-print-loop nil
- :count (or count t)
- :all t))
- #+(or clasp ecl mkcl)
- (let* ((top (si:ihs-top))
- (repeats (if count (min top count) top))
- (backtrace (loop :for ihs :from 0 :below top
- :collect (list (si::ihs-fun ihs)
- (si::ihs-env ihs)))))
- (loop :for i :from 0 :below repeats
- :for frame :in (nreverse backtrace) :do
- (safe-format! stream "~&~D: ~S~%" i frame)))
- #+clisp
- (system::print-backtrace :out stream :limit count)
- #+(or clozure mcl)
- (let ((*debug-io* stream))
- #+clozure (ccl:print-call-history :count count :start-frame-number 1)
- #+mcl (ccl:print-call-history :detailed-p nil)
- (finish-output stream))
- #+(or cmucl scl)
- (let ((debug:*debug-print-level* *print-level*)
- (debug:*debug-print-length* *print-length*))
- (debug:backtrace (or count most-positive-fixnum) stream))
- #+gcl
- (let ((*debug-io* stream))
- (ignore-errors
- (with-safe-io-syntax ()
- (if condition
- (conditions::condition-backtrace condition)
- (system::simple-backtrace)))))
- #+lispworks
- (let ((dbg::*debugger-stack*
- (dbg::grab-stack nil :how-many (or count most-positive-fixnum)))
- (*debug-io* stream)
- (dbg:*debug-print-level* *print-level*)
- (dbg:*debug-print-length* *print-length*))
- (dbg:bug-backtrace nil))
- #+mezzano
- (let ((*standard-output* stream))
- (sys.int::backtrace count))
- #+sbcl
- (sb-debug:print-backtrace :stream stream :count (or count most-positive-fixnum))
- #+xcl
- (loop :for i :from 0 :below (or count most-positive-fixnum)
- :for frame :in (extensions:backtrace-as-list) :do
- (safe-format! stream "~&~D: ~S~%" i frame)))
-
- (defun print-backtrace (&rest keys &key stream count condition)
- "Print a backtrace"
- (declare (ignore stream count condition))
- (with-safe-io-syntax (:package :cl)
- (let ((*print-readably* nil)
- (*print-circle* t)
- (*print-miser-width* 75)
- (*print-length* nil)
- (*print-level* nil)
- (*print-pretty* t))
- (ignore-errors (apply 'raw-print-backtrace keys)))))
-
- (defun print-condition-backtrace (condition &key (stream *stderr*) count)
- "Print a condition after a backtrace triggered by that condition"
- ;; We print the condition *after* the backtrace,
- ;; for the sake of who sees the backtrace at a terminal.
- ;; It is up to the caller to print the condition *before*, with some context.
- (print-backtrace :stream stream :count count :condition condition)
- (when condition
- (safe-format! stream "~&Above backtrace due to this condition:~%~A~&"
- condition)))
-
- (defun fatal-condition-p (condition)
- "Is the CONDITION fatal?"
- (typep condition 'fatal-condition))
-
- (defun handle-fatal-condition (condition)
- "Handle a fatal CONDITION:
-depending on whether *LISP-INTERACTION* is set, enter debugger or die"
- (cond
- (*lisp-interaction*
- (invoke-debugger condition))
- (t
- (safe-format! *stderr* "~&Fatal condition:~%~A~%" condition)
- (print-condition-backtrace condition :stream *stderr*)
- (die 99 "~A" condition))))
-
- (defun call-with-fatal-condition-handler (thunk)
- "Call THUNK in a context where fatal conditions are appropriately handled"
- (handler-bind ((fatal-condition #'handle-fatal-condition))
- (funcall thunk)))
-
- (defmacro with-fatal-condition-handler ((&optional) &body body)
- "Execute BODY in a context where fatal conditions are appropriately handled"
- `(call-with-fatal-condition-handler #'(lambda () ,@body)))
-
- (defun shell-boolean-exit (x)
- "Quit with a return code that is 0 iff argument X is true"
- (quit (if x 0 1))))
-
-
-;;; Using image hooks
-(with-upgradability ()
- (defun register-image-restore-hook (hook &optional (call-now-p t))
- "Regiter a hook function to be run when restoring a dumped image"
- (register-hook-function '*image-restore-hook* hook call-now-p))
-
- (defun register-image-dump-hook (hook &optional (call-now-p nil))
- "Register a the hook function to be run before to dump an image"
- (register-hook-function '*image-dump-hook* hook call-now-p))
-
- (defun call-image-restore-hook ()
- "Call the hook functions registered to be run when restoring a dumped image"
- (call-functions (reverse *image-restore-hook*)))
-
- (defun call-image-dump-hook ()
- "Call the hook functions registered to be run before to dump an image"
- (call-functions *image-dump-hook*)))
-
-
-;;; Proper command-line arguments
-(with-upgradability ()
- (defun raw-command-line-arguments ()
- "Find what the actual command line for this process was."
- #+abcl ext:*command-line-argument-list* ; Use 1.0.0 or later!
- #+allegro (sys:command-line-arguments) ; default: :application t
- #+(or clasp ecl) (loop :for i :from 0 :below (si:argc) :collect (si:argv i))
- #+clisp (coerce (ext:argv) 'list)
- #+clozure ccl:*command-line-argument-list*
- #+(or cmucl scl) extensions:*command-line-strings*
- #+gcl si:*command-args*
- #+(or genera mcl mezzano) nil
- #+lispworks sys:*line-arguments-list*
- #+mkcl (loop :for i :from 0 :below (mkcl:argc) :collect (mkcl:argv i))
- #+sbcl sb-ext:*posix-argv*
- #+xcl system:*argv*
- #-(or abcl allegro clasp clisp clozure cmucl ecl gcl genera lispworks mcl mezzano mkcl sbcl scl xcl)
- (not-implemented-error 'raw-command-line-arguments))
-
- (defun command-line-arguments (&optional (arguments (raw-command-line-arguments)))
- "Extract user arguments from command-line invocation of current process.
-Assume the calling conventions of a generated script that uses --
-if we are not called from a directly executable image."
- (block nil
- #+abcl (return arguments)
- ;; SBCL and Allegro already separate user arguments from implementation arguments.
- #-(or sbcl allegro)
- (unless (eq *image-dumped-p* :executable)
- ;; LispWorks command-line processing isn't transparent to the user
- ;; unless you create a standalone executable; in that case,
- ;; we rely on cl-launch or some other script to set the arguments for us.
- #+lispworks (return *command-line-arguments*)
- ;; On other implementations, on non-standalone executables,
- ;; we trust cl-launch or whichever script starts the program
- ;; to use -- as a delimiter between implementation arguments and user arguments.
- #-lispworks (setf arguments (member "--" arguments :test 'string-equal)))
- (rest arguments)))
-
- (defun argv0 ()
- "On supported implementations (most that matter), or when invoked by a proper wrapper script,
-return a string that for the name with which the program was invoked, i.e. argv[0] in C.
-Otherwise, return NIL."
- (cond
- ((eq *image-dumped-p* :executable) ; yes, this ARGV0 is our argv0 !
- ;; NB: not currently available on ABCL, Corman, Genera, MCL
- (or #+(or allegro clisp clozure cmucl gcl lispworks sbcl scl xcl)
- (first (raw-command-line-arguments))
- #+(or clasp ecl) (si:argv 0) #+mkcl (mkcl:argv 0)))
- (t ;; argv[0] is the name of the interpreter.
- ;; The wrapper script can export __CL_ARGV0. cl-launch does as of 4.0.1.8.
- (getenvp "__CL_ARGV0"))))
-
- (defun setup-command-line-arguments ()
- (setf *command-line-arguments* (command-line-arguments)))
-
- (defun restore-image (&key
- (lisp-interaction *lisp-interaction*)
- (restore-hook *image-restore-hook*)
- (prelude *image-prelude*)
- (entry-point *image-entry-point*)
- (if-already-restored '(cerror "RUN RESTORE-IMAGE ANYWAY")))
- "From a freshly restarted Lisp image, restore the saved Lisp environment
-by setting appropriate variables, running various hooks, and calling any specified entry point.
-
-If the image has already been restored or is already being restored, as per *IMAGE-RESTORED-P*,
-call the IF-ALREADY-RESTORED error handler (by default, a continuable error), and do return
-immediately to the surrounding restore process if allowed to continue.
-
-Then, comes the restore process itself:
-First, call each function in the RESTORE-HOOK,
-in the order they were registered with REGISTER-IMAGE-RESTORE-HOOK.
-Second, evaluate the prelude, which is often Lisp text that is read,
-as per EVAL-INPUT.
-Third, call the ENTRY-POINT function, if any is specified, with no argument.
-
-The restore process happens in a WITH-FATAL-CONDITION-HANDLER, so that if LISP-INTERACTION is NIL,
-any unhandled error leads to a backtrace and an exit with an error status.
-If LISP-INTERACTION is NIL, the process also exits when no error occurs:
-if neither restart nor entry function is provided, the program will exit with status 0 (success);
-if a function was provided, the program will exit after the function returns (if it returns),
-with status 0 if and only if the primary return value of result is generalized boolean true,
-and with status 1 if this value is NIL.
-
-If LISP-INTERACTION is true, unhandled errors will take you to the debugger, and the result
-of the function will be returned rather than interpreted as a boolean designating an exit code."
- (when *image-restored-p*
- (if if-already-restored
- (call-function if-already-restored "Image already ~:[being ~;~]restored"
- (eq *image-restored-p* t))
- (return-from restore-image)))
- (with-fatal-condition-handler ()
- (setf *lisp-interaction* lisp-interaction)
- (setf *image-restore-hook* restore-hook)
- (setf *image-prelude* prelude)
- (setf *image-restored-p* :in-progress)
- (call-image-restore-hook)
- (standard-eval-thunk prelude)
- (setf *image-restored-p* t)
- (let ((results (multiple-value-list
- (if entry-point
- (call-function entry-point)
- t))))
- (if lisp-interaction
- (values-list results)
- (shell-boolean-exit (first results)))))))
-
-
-;;; Dumping an image
-
-(with-upgradability ()
- (defun dump-image (filename &key output-name executable
- (postlude *image-postlude*)
- (dump-hook *image-dump-hook*)
- #+clozure prepend-symbols #+clozure (purify t)
- #+sbcl compression
- #+(and sbcl os-windows) application-type)
- "Dump an image of the current Lisp environment at pathname FILENAME, with various options.
-
-First, finalize the image, by evaluating the POSTLUDE as per EVAL-INPUT, then calling each of
- the functions in DUMP-HOOK, in reverse order of registration by REGISTER-DUMP-HOOK.
-
-If EXECUTABLE is true, create an standalone executable program that calls RESTORE-IMAGE on startup.
-
-Pass various implementation-defined options, such as PREPEND-SYMBOLS and PURITY on CCL,
-or COMPRESSION on SBCL, and APPLICATION-TYPE on SBCL/Windows."
- ;; Note: at least SBCL saves only global values of variables in the heap image,
- ;; so make sure things you want to dump are NOT just local bindings shadowing the global values.
- (declare (ignorable filename output-name executable))
- (setf *image-dumped-p* (if executable :executable t))
- (setf *image-restored-p* :in-regress)
- (setf *image-postlude* postlude)
- (standard-eval-thunk *image-postlude*)
- (setf *image-dump-hook* dump-hook)
- (call-image-dump-hook)
- (setf *image-restored-p* nil)
- #-(or clisp clozure (and cmucl executable) lispworks sbcl scl)
- (when executable
- (not-implemented-error 'dump-image "dumping an executable"))
- #+allegro
- (progn
- (sys:resize-areas :global-gc t :pack-heap t :sift-old-areas t :tenure t) ; :new 5000000
- (excl:dumplisp :name filename :suppress-allegro-cl-banner t))
- #+clisp
- (apply #'ext:saveinitmem filename
- :quiet t
- :start-package *package*
- :keep-global-handlers nil
- :executable (if executable 0 t) ;--- requires clisp 2.48 or later, still catches --clisp-x
- (when executable
- (list
- ;; :parse-options nil ;--- requires a non-standard patch to clisp.
- :norc t :script nil :init-function #'restore-image)))
- #+clozure
- (flet ((dump (prepend-kernel)
- (ccl:save-application filename :prepend-kernel prepend-kernel :purify purify
- :toplevel-function (when executable #'restore-image))))
- ;;(setf ccl::*application* (make-instance 'ccl::lisp-development-system))
- (if prepend-symbols
- (with-temporary-file (:prefix "ccl-symbols-" :direction :output :pathname path)
- (require 'elf)
- (funcall (fdefinition 'ccl::write-elf-symbols-to-file) path)
- (dump path))
- (dump t)))
- #+(or cmucl scl)
- (progn
- (ext:gc :full t)
- (setf ext:*batch-mode* nil)
- (setf ext::*gc-run-time* 0)
- (apply 'ext:save-lisp filename
- :allow-other-keys t ;; hush SCL and old versions of CMUCL
- #+(and cmucl executable) :executable #+(and cmucl executable) t
- (when executable '(:init-function restore-image :process-command-line nil
- :quiet t :load-init-file nil :site-init nil))))
- #+gcl
- (progn
- (si::set-hole-size 500) (si::gbc nil) (si::sgc-on t)
- (si::save-system filename))
- #+lispworks
- (if executable
- (lispworks:deliver 'restore-image filename 0 :interface nil)
- (hcl:save-image filename :environment nil))
- #+sbcl
- (progn
- ;;(sb-pcl::precompile-random-code-segments) ;--- it is ugly slow at compile-time (!) when the initial core is a big CLOS program. If you want it, do it yourself
- (setf sb-ext::*gc-run-time* 0)
- (apply 'sb-ext:save-lisp-and-die filename
- :executable t ;--- always include the runtime that goes with the core
- (append
- (when compression (list :compression compression))
- ;;--- only save runtime-options for standalone executables
- (when executable (list :toplevel #'restore-image :save-runtime-options t))
- #+(and sbcl os-windows) ;; passing :application-type :gui will disable the console window.
- ;; the default is :console - only works with SBCL 1.1.15 or later.
- (when application-type (list :application-type application-type)))))
- #-(or allegro clisp clozure cmucl gcl lispworks sbcl scl)
- (not-implemented-error 'dump-image))
-
- (defun create-image (destination lisp-object-files
- &key kind output-name prologue-code epilogue-code extra-object-files
- (prelude () preludep) (postlude () postludep)
- (entry-point () entry-point-p) build-args no-uiop)
- (declare (ignorable destination lisp-object-files extra-object-files kind output-name
- prologue-code epilogue-code prelude preludep postlude postludep
- entry-point entry-point-p build-args no-uiop))
- "On ECL, create an executable at pathname DESTINATION from the specified OBJECT-FILES and options"
- ;; Is it meaningful to run these in the current environment?
- ;; only if we also track the object files that constitute the "current" image,
- ;; and otherwise simulate dump-image, including quitting at the end.
- #-(or clasp ecl mkcl) (not-implemented-error 'create-image)
- #+(or clasp ecl mkcl)
- (let ((epilogue-code
- (if no-uiop
- epilogue-code
- (let ((forms
- (append
- (when epilogue-code `(,epilogue-code))
- (when postludep `((setf *image-postlude* ',postlude)))
- (when preludep `((setf *image-prelude* ',prelude)))
- (when entry-point-p `((setf *image-entry-point* ',entry-point)))
- (case kind
- ((:image)
- (setf kind :program) ;; to ECL, it's just another program.
- `((setf *image-dumped-p* t)
- (si::top-level #+(or clasp ecl) t) (quit)))
- ((:program)
- `((setf *image-dumped-p* :executable)
- (shell-boolean-exit
- (restore-image))))))))
- (when forms `(progn ,@forms))))))
- #+(or clasp ecl mkcl)
- (check-type kind (member :dll :shared-library :lib :static-library
- :fasl :fasb :program))
- (apply #+clasp 'cmp:builder #+clasp kind
- #+(or ecl mkcl)
- (ecase kind
- ((:dll :shared-library)
- #+ecl 'c::build-shared-library #+mkcl 'compiler:build-shared-library)
- ((:lib :static-library)
- #+ecl 'c::build-static-library #+mkcl 'compiler:build-static-library)
- ((:fasl #+ecl :fasb)
- #+ecl 'c::build-fasl #+mkcl 'compiler:build-fasl)
- #+mkcl ((:fasb) 'compiler:build-bundle)
- ((:program)
- #+ecl 'c::build-program #+mkcl 'compiler:build-program))
- (pathname destination)
- #+(or clasp ecl) :lisp-files #+mkcl :lisp-object-files
- (append lisp-object-files #+(or clasp ecl) extra-object-files)
- #+ecl :init-name
- #+ecl (getf build-args :init-name)
- (append
- (when prologue-code `(:prologue-code ,prologue-code))
- (when epilogue-code `(:epilogue-code ,epilogue-code))
- #+mkcl (when extra-object-files `(:object-files ,extra-object-files))
- build-args)))))
-
-
-;;; Some universal image restore hooks
-(with-upgradability ()
- (map () 'register-image-restore-hook
- '(setup-stdin setup-stdout setup-stderr
- setup-command-line-arguments setup-temporary-directory
- #+abcl detect-os)))
(DIR) diff --git a/3rdparties/software/uiop-3.3.2/launch-program.lisp b/3rdparties/software/uiop-3.3.2/launch-program.lisp
@@ -1,682 +0,0 @@
-;;;; -------------------------------------------------------------------------
-;;;; launch-program - semi-portably spawn asynchronous subprocesses
-
-(uiop/package:define-package :uiop/launch-program
- (:use :uiop/common-lisp :uiop/package :uiop/utility
- :uiop/pathname :uiop/os :uiop/filesystem :uiop/stream)
- (:export
- ;;; Escaping the command invocation madness
- #:easy-sh-character-p #:escape-sh-token #:escape-sh-command
- #:escape-windows-token #:escape-windows-command
- #:escape-shell-token #:escape-shell-command
- #:escape-token #:escape-command
-
- ;;; launch-program
- #:launch-program
- #:close-streams #:process-alive-p #:terminate-process #:wait-process
- #:process-info-error-output #:process-info-input #:process-info-output #:process-info-pid))
-(in-package :uiop/launch-program)
-
-;;;; ----- Escaping strings for the shell -----
-(with-upgradability ()
- (defun requires-escaping-p (token &key good-chars bad-chars)
- "Does this token require escaping, given the specification of
-either good chars that don't need escaping or bad chars that do need escaping,
-as either a recognizing function or a sequence of characters."
- (some
- (cond
- ((and good-chars bad-chars)
- (parameter-error "~S: only one of good-chars and bad-chars can be provided"
- 'requires-escaping-p))
- ((typep good-chars 'function)
- (complement good-chars))
- ((typep bad-chars 'function)
- bad-chars)
- ((and good-chars (typep good-chars 'sequence))
- #'(lambda (c) (not (find c good-chars))))
- ((and bad-chars (typep bad-chars 'sequence))
- #'(lambda (c) (find c bad-chars)))
- (t (parameter-error "~S: no good-char criterion" 'requires-escaping-p)))
- token))
-
- (defun escape-token (token &key stream quote good-chars bad-chars escaper)
- "Call the ESCAPER function on TOKEN string if it needs escaping as per
-REQUIRES-ESCAPING-P using GOOD-CHARS and BAD-CHARS, otherwise output TOKEN,
-using STREAM as output (or returning result as a string if NIL)"
- (if (requires-escaping-p token :good-chars good-chars :bad-chars bad-chars)
- (with-output (stream)
- (apply escaper token stream (when quote `(:quote ,quote))))
- (output-string token stream)))
-
- (defun escape-windows-token-within-double-quotes (x &optional s)
- "Escape a string token X within double-quotes
-for use within a MS Windows command-line, outputing to S."
- (labels ((issue (c) (princ c s))
- (issue-backslash (n) (loop :repeat n :do (issue #\\))))
- (loop
- :initially (issue #\") :finally (issue #\")
- :with l = (length x) :with i = 0
- :for i+1 = (1+ i) :while (< i l) :do
- (case (char x i)
- ((#\") (issue-backslash 1) (issue #\") (setf i i+1))
- ((#\\)
- (let* ((j (and (< i+1 l) (position-if-not
- #'(lambda (c) (eql c #\\)) x :start i+1)))
- (n (- (or j l) i)))
- (cond
- ((null j)
- (issue-backslash (* 2 n)) (setf i l))
- ((and (< j l) (eql (char x j) #\"))
- (issue-backslash (1+ (* 2 n))) (issue #\") (setf i (1+ j)))
- (t
- (issue-backslash n) (setf i j)))))
- (otherwise
- (issue (char x i)) (setf i i+1))))))
-
- (defun easy-windows-character-p (x)
- "Is X an \"easy\" character that does not require quoting by the shell?"
- (or (alphanumericp x) (find x "+-_.,@:/=")))
-
- (defun escape-windows-token (token &optional s)
- "Escape a string TOKEN within double-quotes if needed
-for use within a MS Windows command-line, outputing to S."
- (escape-token token :stream s :good-chars #'easy-windows-character-p :quote nil
- :escaper 'escape-windows-token-within-double-quotes))
-
- (defun escape-sh-token-within-double-quotes (x s &key (quote t))
- "Escape a string TOKEN within double-quotes
-for use within a POSIX Bourne shell, outputing to S;
-omit the outer double-quotes if key argument :QUOTE is NIL"
- (when quote (princ #\" s))
- (loop :for c :across x :do
- (when (find c "$`\\\"") (princ #\\ s))
- (princ c s))
- (when quote (princ #\" s)))
-
- (defun easy-sh-character-p (x)
- "Is X an \"easy\" character that does not require quoting by the shell?"
- (or (alphanumericp x) (find x "+-_.,%@:/=")))
-
- (defun escape-sh-token (token &optional s)
- "Escape a string TOKEN within double-quotes if needed
-for use within a POSIX Bourne shell, outputing to S."
- (escape-token token :stream s :quote #\" :good-chars #'easy-sh-character-p
- :escaper 'escape-sh-token-within-double-quotes))
-
- (defun escape-shell-token (token &optional s)
- "Escape a token for the current operating system shell"
- (os-cond
- ((os-unix-p) (escape-sh-token token s))
- ((os-windows-p) (escape-windows-token token s))))
-
- (defun escape-command (command &optional s
- (escaper 'escape-shell-token))
- "Given a COMMAND as a list of tokens, return a string of the
-spaced, escaped tokens, using ESCAPER to escape."
- (etypecase command
- (string (output-string command s))
- (list (with-output (s)
- (loop :for first = t :then nil :for token :in command :do
- (unless first (princ #\space s))
- (funcall escaper token s))))))
-
- (defun escape-windows-command (command &optional s)
- "Escape a list of command-line arguments into a string suitable for parsing
-by CommandLineToArgv in MS Windows"
- ;; http://msdn.microsoft.com/en-us/library/bb776391(v=vs.85).aspx
- ;; http://msdn.microsoft.com/en-us/library/17w5ykft(v=vs.85).aspx
- (escape-command command s 'escape-windows-token))
-
- (defun escape-sh-command (command &optional s)
- "Escape a list of command-line arguments into a string suitable for parsing
-by /bin/sh in POSIX"
- (escape-command command s 'escape-sh-token))
-
- (defun escape-shell-command (command &optional stream)
- "Escape a command for the current operating system's shell"
- (escape-command command stream 'escape-shell-token)))
-
-
-(with-upgradability ()
- ;;; Internal helpers for run-program
- (defun %normalize-io-specifier (specifier &optional role)
- "Normalizes a portable I/O specifier for LAUNCH-PROGRAM into an implementation-dependent
-argument to pass to the internal RUN-PROGRAM"
- (declare (ignorable role))
- (typecase specifier
- (null (or #+(or allegro lispworks) (null-device-pathname)))
- (string (parse-native-namestring specifier))
- (pathname specifier)
- (stream specifier)
- ((eql :stream) :stream)
- ((eql :interactive)
- #+(or allegro lispworks) nil
- #+clisp :terminal
- #+(or abcl clozure cmucl ecl mkcl sbcl scl) t
- #-(or abcl clozure cmucl ecl mkcl sbcl scl allegro lispworks clisp)
- (not-implemented-error :interactive-output
- "On this lisp implementation, cannot interpret ~a value of ~a"
- specifier role))
- ((eql :output)
- (cond ((eq role :error-output)
- #+(or abcl allegro clozure cmucl ecl lispworks mkcl sbcl scl)
- :output
- #-(or abcl allegro clozure cmucl ecl lispworks mkcl sbcl scl)
- (not-implemented-error :error-output-redirect
- "Can't send ~a to ~a on this lisp implementation."
- role specifier))
- (t (parameter-error "~S IO specifier invalid for ~S" specifier role))))
- (otherwise
- (parameter-error "Incorrect I/O specifier ~S for ~S"
- specifier role))))
-
- (defun %interactivep (input output error-output)
- (member :interactive (list input output error-output)))
-
- (defun %signal-to-exit-code (signum)
- (+ 128 signum))
-
- (defun %code-to-status (exit-code signal-code)
- (cond ((null exit-code) :running)
- ((null signal-code) (values :exited exit-code))
- (t (values :signaled signal-code))))
-
- #+mkcl
- (defun %mkcl-signal-to-number (signal)
- (require :mk-unix)
- (symbol-value (find-symbol signal :mk-unix)))
-
- (defclass process-info ()
- (;; The process field is highly platform-, implementation-, and
- ;; even version-dependent.
- ;; Prior to LispWorks 7, the only information that
- ;; `sys:run-shell-command` with `:wait nil` was certain to return
- ;; is a PID (e.g. when all streams are nil), hence we stored it
- ;; and used `sys:pid-exit-status` to obtain an exit status
- ;; later. That is still what we do.
- ;; From LispWorks 7 on, if `sys:run-shell-command` does not
- ;; return a proper stream, we are instead given a dummy stream.
- ;; We can thus always store a stream and use
- ;; `sys:pipe-exit-status` to obtain an exit status later.
- ;; The advantage of dealing with streams instead of PID is the
- ;; availability of functions like `sys:pipe-kill-process`.
- (process :initform nil)
- (input-stream :initform nil)
- (output-stream :initform nil)
- (bidir-stream :initform nil)
- (error-output-stream :initform nil)
- ;; For backward-compatibility, to maintain the property (zerop
- ;; exit-code) <-> success, an exit in response to a signal is
- ;; encoded as 128+signum.
- (exit-code :initform nil)
- ;; If the platform allows it, distinguish exiting with a code
- ;; >128 from exiting in response to a signal by setting this code
- (signal-code :initform nil)))
-
-;;;---------------------------------------------------------------------------
-;;; The following two helper functions take care of handling the IF-EXISTS and
-;;; IF-DOES-NOT-EXIST arguments for RUN-PROGRAM. In particular, they process the
-;;; :ERROR, :APPEND, and :SUPERSEDE arguments *here*, allowing the master
-;;; function to treat input and output files unconditionally for reading and
-;;; writing.
-;;;---------------------------------------------------------------------------
-
- (defun %handle-if-exists (file if-exists)
- (when (or (stringp file) (pathnamep file))
- (ecase if-exists
- ((:append :supersede :error)
- (with-open-file (dummy file :direction :output :if-exists if-exists)
- (declare (ignorable dummy)))))))
-
- (defun %handle-if-does-not-exist (file if-does-not-exist)
- (when (or (stringp file) (pathnamep file))
- (ecase if-does-not-exist
- ((:create :error)
- (with-open-file (dummy file :direction :probe
- :if-does-not-exist if-does-not-exist)
- (declare (ignorable dummy)))))))
-
- (defun process-info-error-output (process-info)
- (slot-value process-info 'error-output-stream))
- (defun process-info-input (process-info)
- (or (slot-value process-info 'bidir-stream)
- (slot-value process-info 'input-stream)))
- (defun process-info-output (process-info)
- (or (slot-value process-info 'bidir-stream)
- (slot-value process-info 'output-stream)))
-
- (defun process-info-pid (process-info)
- (let ((process (slot-value process-info 'process)))
- (declare (ignorable process))
- #+abcl (symbol-call :sys :process-pid process)
- #+allegro process
- #+clozure (ccl:external-process-id process)
- #+ecl (ext:external-process-pid process)
- #+(or cmucl scl) (ext:process-pid process)
- #+lispworks7+ (sys:pipe-pid process)
- #+(and lispworks (not lispworks7+)) process
- #+mkcl (mkcl:process-id process)
- #+sbcl (sb-ext:process-pid process)
- #-(or abcl allegro clozure cmucl ecl mkcl lispworks sbcl scl)
- (not-implemented-error 'process-info-pid)))
-
- (defun %process-status (process-info)
- (if-let (exit-code (slot-value process-info 'exit-code))
- (return-from %process-status
- (if-let (signal-code (slot-value process-info 'signal-code))
- (values :signaled signal-code)
- (values :exited exit-code))))
- #-(or allegro clozure cmucl ecl lispworks mkcl sbcl scl)
- (not-implemented-error '%process-status)
- (if-let (process (slot-value process-info 'process))
- (multiple-value-bind (status code)
- (progn
- #+allegro (multiple-value-bind (exit-code pid signal-code)
- (sys:reap-os-subprocess :pid process :wait nil)
- (assert pid)
- (%code-to-status exit-code signal-code))
- #+clozure (ccl:external-process-status process)
- #+(or cmucl scl) (let ((status (ext:process-status process)))
- (if (member status '(:exited :signaled))
- ;; Calling ext:process-exit-code on
- ;; processes that are still alive
- ;; yields an undefined result
- (values status (ext:process-exit-code process))
- status))
- #+ecl (ext:external-process-status process)
- #+lispworks
- ;; a signal is only returned on LispWorks 7+
- (multiple-value-bind (exit-code signal-code)
- (symbol-call :sys
- #+lispworks7+ :pipe-exit-status
- #-lispworks7+ :pid-exit-status
- process :wait nil)
- (%code-to-status exit-code signal-code))
- #+mkcl (let ((status (mk-ext:process-status process)))
- (if (eq status :exited)
- ;; Only call mk-ext:process-exit-code when
- ;; necessary since it leads to another waitpid()
- (let ((code (mk-ext:process-exit-code process)))
- (if (stringp code)
- (values :signaled (%mkcl-signal-to-number code))
- (values :exited code)))
- status))
- #+sbcl (let ((status (sb-ext:process-status process)))
- (if (eq status :running)
- :running
- ;; sb-ext:process-exit-code can also be
- ;; called for stopped processes to determine
- ;; the signal that stopped them
- (values status (sb-ext:process-exit-code process)))))
- (case status
- (:exited (setf (slot-value process-info 'exit-code) code))
- (:signaled (let ((%code (%signal-to-exit-code code)))
- (setf (slot-value process-info 'exit-code) %code
- (slot-value process-info 'signal-code) code))))
- (if code
- (values status code)
- status))))
-
- (defun process-alive-p (process-info)
- "Check if a process has yet to exit."
- (unless (slot-value process-info 'exit-code)
- #+abcl (sys:process-alive-p (slot-value process-info 'process))
- #+(or cmucl scl) (ext:process-alive-p (slot-value process-info 'process))
- #+sbcl (sb-ext:process-alive-p (slot-value process-info 'process))
- #-(or abcl cmucl sbcl scl) (find (%process-status process-info)
- '(:running :stopped :continued :resumed))))
-
- (defun wait-process (process-info)
- "Wait for the process to terminate, if it is still running.
-Otherwise, return immediately. An exit code (a number) will be
-returned, with 0 indicating success, and anything else indicating
-failure. If the process exits after receiving a signal, the exit code
-will be the sum of 128 and the (positive) numeric signal code. A second
-value may be returned in this case: the numeric signal code itself.
-Any asynchronously spawned process requires this function to be run
-before it is garbage-collected in order to free up resources that
-might otherwise be irrevocably lost."
- (if-let (exit-code (slot-value process-info 'exit-code))
- (if-let (signal-code (slot-value process-info 'signal-code))
- (values exit-code signal-code)
- exit-code)
- (let ((process (slot-value process-info 'process)))
- #-(or abcl allegro clozure cmucl ecl lispworks mkcl sbcl scl)
- (not-implemented-error 'wait-process)
- (when process
- ;; 1- wait
- #+clozure (ccl::external-process-wait process)
- #+(or cmucl scl) (ext:process-wait process)
- #+sbcl (sb-ext:process-wait process)
- ;; 2- extract result
- (multiple-value-bind (exit-code signal-code)
- (progn
- #+abcl (sys:process-wait process)
- #+allegro (multiple-value-bind (exit-code pid signal)
- (sys:reap-os-subprocess :pid process :wait t)
- (assert pid)
- (values exit-code signal))
- #+clozure (multiple-value-bind (status code)
- (ccl:external-process-status process)
- (if (eq status :signaled)
- (values nil code)
- code))
- #+(or cmucl scl) (let ((status (ext:process-status process))
- (code (ext:process-exit-code process)))
- (if (eq status :signaled)
- (values nil code)
- code))
- #+ecl (multiple-value-bind (status code)
- (ext:external-process-wait process t)
- (if (eq status :signaled)
- (values nil code)
- code))
- #+lispworks (symbol-call :sys
- #+lispworks7+ :pipe-exit-status
- #-lispworks7+ :pid-exit-status
- process :wait t)
- #+mkcl (let ((code (mkcl:join-process process)))
- (if (stringp code)
- (values nil (%mkcl-signal-to-number code))
- code))
- #+sbcl (let ((status (sb-ext:process-status process))
- (code (sb-ext:process-exit-code process)))
- (if (eq status :signaled)
- (values nil code)
- code)))
- (if signal-code
- (let ((%exit-code (%signal-to-exit-code signal-code)))
- (setf (slot-value process-info 'exit-code) %exit-code
- (slot-value process-info 'signal-code) signal-code)
- (values %exit-code signal-code))
- (progn (setf (slot-value process-info 'exit-code) exit-code)
- exit-code)))))))
-
- ;; WARNING: For signals other than SIGTERM and SIGKILL this may not
- ;; do what you expect it to. Sending SIGSTOP to a process spawned
- ;; via LAUNCH-PROGRAM, e.g., will stop the shell /bin/sh that is used
- ;; to run the command (via `sh -c command`) but not the actual
- ;; command.
- #+os-unix
- (defun %posix-send-signal (process-info signal)
- #+allegro (excl.osi:kill (slot-value process-info 'process) signal)
- #+clozure (ccl:signal-external-process (slot-value process-info 'process)
- signal :error-if-exited nil)
- #+(or cmucl scl) (ext:process-kill (slot-value process-info 'process) signal)
- #+sbcl (sb-ext:process-kill (slot-value process-info 'process) signal)
- #-(or allegro clozure cmucl sbcl scl)
- (if-let (pid (process-info-pid process-info))
- (symbol-call :uiop :run-program
- (format nil "kill -~a ~a" signal pid) :ignore-error-status t)))
-
- ;;; this function never gets called on Windows, but the compiler cannot tell
- ;;; that. [2016/09/25:rpg]
- #+os-windows
- (defun %posix-send-signal (process-info signal)
- (declare (ignore process-info signal))
- (values))
-
- (defun terminate-process (process-info &key urgent)
- "Cause the process to exit. To that end, the process may or may
-not be sent a signal, which it will find harder (or even impossible)
-to ignore if URGENT is T. On some platforms, it may also be subject to
-race conditions."
- (declare (ignorable urgent))
- #+abcl (sys:process-kill (slot-value process-info 'process))
- ;; On ECL, this will only work on versions later than 2016-09-06,
- ;; but we still want to compile on earlier versions, so we use symbol-call
- #+ecl (symbol-call :ext :terminate-process (slot-value process-info 'process) urgent)
- #+lispworks7+ (sys:pipe-kill-process (slot-value process-info 'process))
- #+mkcl (mk-ext:terminate-process (slot-value process-info 'process)
- :force urgent)
- #-(or abcl ecl lispworks7+ mkcl)
- (os-cond
- ((os-unix-p) (%posix-send-signal process-info (if urgent 9 15)))
- ((os-windows-p) (if-let (pid (process-info-pid process-info))
- (symbol-call :uiop :run-program
- (format nil "taskkill ~:[~;/f ~]/pid ~a" urgent pid)
- :ignore-error-status t)))
- (t (not-implemented-error 'terminate-process))))
-
- (defun close-streams (process-info)
- "Close any stream that the process might own. Needs to be run
-whenever streams were requested by passing :stream to :input, :output,
-or :error-output."
- (dolist (stream
- (cons (slot-value process-info 'error-output-stream)
- (if-let (bidir-stream (slot-value process-info 'bidir-stream))
- (list bidir-stream)
- (list (slot-value process-info 'input-stream)
- (slot-value process-info 'output-stream)))))
- (when stream (close stream))))
-
- (defun launch-program (command &rest keys
- &key
- input (if-input-does-not-exist :error)
- output (if-output-exists :supersede)
- error-output (if-error-output-exists :supersede)
- (element-type #-clozure *default-stream-element-type*
- #+clozure 'character)
- (external-format *utf-8-external-format*)
- directory
- #+allegro separate-streams
- &allow-other-keys)
- "Launch program specified by COMMAND,
-either a list of strings specifying a program and list of arguments,
-or a string specifying a shell command (/bin/sh on Unix, CMD.EXE on
-Windows) _asynchronously_.
-
-If OUTPUT is a pathname, a string designating a pathname, or NIL (the
-default) designating the null device, the file at that path is used as
-output.
-If it's :INTERACTIVE, output is inherited from the current process;
-beware that this may be different from your *STANDARD-OUTPUT*, and
-under SLIME will be on your *inferior-lisp* buffer. If it's T, output
-goes to your current *STANDARD-OUTPUT* stream. If it's :STREAM, a new
-stream will be made available that can be accessed via
-PROCESS-INFO-OUTPUT and read from. Otherwise, OUTPUT should be a value
-that the underlying lisp implementation knows how to handle.
-
-IF-OUTPUT-EXISTS, which is only meaningful if OUTPUT is a string or a
-pathname, can take the values :ERROR, :APPEND, and :SUPERSEDE (the
-default). The meaning of these values and their effect on the case
-where OUTPUT does not exist, is analogous to the IF-EXISTS parameter
-to OPEN with :DIRECTION :OUTPUT.
-
-ERROR-OUTPUT is similar to OUTPUT. T designates the *ERROR-OUTPUT*,
-:OUTPUT means redirecting the error output to the output stream,
-and :STREAM causes a stream to be made available via
-PROCESS-INFO-ERROR-OUTPUT.
-
-IF-ERROR-OUTPUT-EXISTS is similar to IF-OUTPUT-EXIST, except that it
-affects ERROR-OUTPUT rather than OUTPUT.
-
-INPUT is similar to OUTPUT, except that T designates the
-*STANDARD-INPUT* and a stream requested through the :STREAM keyword
-would be available through PROCESS-INFO-INPUT.
-
-IF-INPUT-DOES-NOT-EXIST, which is only meaningful if INPUT is a string
-or a pathname, can take the values :CREATE and :ERROR (the
-default). The meaning of these values is analogous to the
-IF-DOES-NOT-EXIST parameter to OPEN with :DIRECTION :INPUT.
-
-ELEMENT-TYPE and EXTERNAL-FORMAT are passed on to your Lisp
-implementation, when applicable, for creation of the output stream.
-
-LAUNCH-PROGRAM returns a PROCESS-INFO object."
- #-(or abcl allegro clozure cmucl ecl (and lispworks os-unix) mkcl sbcl scl)
- (progn command keys input output error-output directory element-type external-format
- if-input-does-not-exist if-output-exists if-error-output-exists ;; ignore
- (not-implemented-error 'launch-program))
- #+allegro
- (when (some #'(lambda (stream)
- (and (streamp stream)
- (not (file-stream-p stream))))
- (list input output error-output))
- (parameter-error "~S: Streams passed as I/O parameters need to be file streams on this lisp"
- 'launch-program))
- #+(or abcl clisp lispworks)
- (when (some #'streamp (list input output error-output))
- (parameter-error "~S: I/O parameters cannot be foreign streams on this lisp"
- 'launch-program))
- #+clisp
- (unless (eq error-output :interactive)
- (parameter-error "~S: The only admissible value for ~S is ~S on this lisp"
- 'launch-program :error-output :interactive))
- #+ecl
- (when (some #'(lambda (stream)
- (and (streamp stream)
- (not (file-or-synonym-stream-p stream))))
- (list input output error-output))
- (parameter-error "~S: Streams passed as I/O parameters need to be (synonymous with) file streams on this lisp"
- 'launch-program))
- #+(or abcl allegro clozure cmucl ecl (and lispworks os-unix) mkcl sbcl scl)
- (nest
- (progn ;; see comments for these functions
- (%handle-if-does-not-exist input if-input-does-not-exist)
- (%handle-if-exists output if-output-exists)
- (%handle-if-exists error-output if-error-output-exists))
- #+ecl (let ((*standard-input* *stdin*)
- (*standard-output* *stdout*)
- (*error-output* *stderr*)))
- (let ((process-info (make-instance 'process-info))
- (input (%normalize-io-specifier input :input))
- (output (%normalize-io-specifier output :output))
- (error-output (%normalize-io-specifier error-output :error-output))
- #+(and allegro os-windows) (interactive (%interactivep input output error-output))
- (command
- (etypecase command
- #+os-unix (string `("/bin/sh" "-c" ,command))
- #+os-unix (list command)
- #+os-windows
- (string
- ;; NB: On other Windows implementations, this is utterly bogus
- ;; except in the most trivial cases where no quoting is needed.
- ;; Use at your own risk.
- #-(or allegro clisp clozure ecl)
- (nest
- #+(or ecl sbcl) (unless (find-symbol* :escape-arguments #+ecl :ext #+sbcl :sb-impl nil))
- (parameter-error "~S doesn't support string commands on Windows on this Lisp"
- 'launch-program command))
- ;; NB: We add cmd /c here. Behavior without going through cmd is not well specified
- ;; when the command contains spaces or special characters:
- ;; IIUC, the system will use space as a separator,
- ;; but the C++ argv-decoding libraries won't, and
- ;; you're supposed to use an extra argument to CreateProcess to bridge the gap,
- ;; yet neither allegro nor clisp provide access to that argument.
- #+(or allegro clisp) (strcat "cmd /c " command)
- ;; On ClozureCL for Windows, we assume you are using
- ;; r15398 or later in 1.9 or later,
- ;; so that bug 858 is fixed http://trac.clozure.com/ccl/ticket/858
- ;; On ECL, commit 2040629 https://gitlab.com/embeddable-common-lisp/ecl/issues/304
- ;; On SBCL, we assume the patch from fcae0fd (to be part of SBCL 1.3.13)
- #+(or clozure ecl sbcl) (cons "cmd" (strcat "/c " command)))
- #+os-windows
- (list
- #+allegro (escape-windows-command command)
- #-allegro command)))))
- #+(or abcl (and allegro os-unix) clozure cmucl ecl mkcl sbcl)
- (let ((program (car command))
- #-allegro (arguments (cdr command))))
- #+(and (or ecl sbcl) os-windows)
- (multiple-value-bind (arguments escape-arguments)
- (if (listp arguments)
- (values arguments t)
- (values (list arguments) nil)))
- #-(or allegro mkcl sbcl) (with-current-directory (directory))
- (multiple-value-bind
- #+(or abcl clozure cmucl sbcl scl) (process)
- #+allegro (in-or-io out-or-err err-or-pid pid-or-nil)
- #+ecl (stream code process)
- #+lispworks (io-or-pid err-or-nil #-lispworks7+ pid-or-nil)
- #+mkcl (stream process code)
- #.`(apply
- #+abcl 'sys:run-program
- #+allegro ,@'('excl:run-shell-command
- #+os-unix (coerce (cons program command) 'vector)
- #+os-windows command)
- #+clozure 'ccl:run-program
- #+(or cmucl ecl scl) 'ext:run-program
- #+lispworks ,@'('system:run-shell-command `("/usr/bin/env" ,@command)) ; full path needed
- #+mkcl 'mk-ext:run-program
- #+sbcl 'sb-ext:run-program
- #+(or abcl clozure cmucl ecl mkcl sbcl) ,@'(program arguments)
- #+(and (or ecl sbcl) os-windows) ,@'(:escape-arguments escape-arguments)
- :input input :if-input-does-not-exist :error
- :output output :if-output-exists :append
- ,(or #+(or allegro lispworks) :error-output :error) error-output
- ,(or #+(or allegro lispworks) :if-error-output-exists :if-error-exists) :append
- :wait nil :element-type element-type :external-format external-format
- :allow-other-keys t
- #+allegro ,@`(:directory directory
- #+os-windows ,@'(:show-window (if interactive nil :hide)))
- #+lispworks ,@'(:save-exit-status t)
- #+mkcl ,@'(:directory (native-namestring directory))
- #-sbcl keys ;; on SBCL, don't pass :directory nil but remove it from the keys
- #+sbcl ,@'(:search t (if directory keys (remove-plist-key :directory keys)))))
- (labels ((prop (key value) (setf (slot-value process-info key) value)))
- #+allegro
- (cond
- (separate-streams
- (prop 'process pid-or-nil)
- (when (eq input :stream) (prop 'input-stream in-or-io))
- (when (eq output :stream) (prop 'output-stream out-or-err))
- (when (eq error-output :stream) (prop 'error-stream err-or-pid)))
- (t
- (prop 'process err-or-pid)
- (ecase (+ (if (eq input :stream) 1 0) (if (eq output :stream) 2 0))
- (0)
- (1 (prop 'input-stream in-or-io))
- (2 (prop 'output-stream in-or-io))
- (3 (prop 'bidir-stream in-or-io)))
- (when (eq error-output :stream)
- (prop 'error-stream out-or-err))))
- #+(or abcl clozure cmucl sbcl scl)
- (progn
- (prop 'process process)
- (when (eq input :stream)
- (nest
- (prop 'input-stream)
- #+abcl (symbol-call :sys :process-input)
- #+clozure (ccl:external-process-input-stream)
- #+(or cmucl scl) (ext:process-input)
- #+sbcl (sb-ext:process-input)
- process))
- (when (eq output :stream)
- (nest
- (prop 'output-stream)
- #+abcl (symbol-call :sys :process-output)
- #+clozure (ccl:external-process-output-stream)
- #+(or cmucl scl) (ext:process-output)
- #+sbcl (sb-ext:process-output)
- process))
- (when (eq error-output :stream)
- (nest
- (prop 'error-output-stream)
- #+abcl (symbol-call :sys :process-error)
- #+clozure (ccl:external-process-error-stream)
- #+(or cmucl scl) (ext:process-error)
- #+sbcl (sb-ext:process-error)
- process)))
- #+(or ecl mkcl)
- (let ((mode (+ (if (eq input :stream) 1 0) (if (eq output :stream) 2 0))))
- code ;; ignore
- (unless (zerop mode)
- (prop (case mode (1 'input-stream) (2 'output-stream) (3 'bidir-stream)) stream))
- (prop 'process process))
- #+lispworks
- ;; See also the comments on the process-info class
- (let ((mode (+ (if (eq input :stream) 1 0) (if (eq output :stream) 2 0))))
- (cond
- ((or (plusp mode) (eq error-output :stream))
- (prop 'process #+lispworks7+ io-or-pid #-lispworks7+ pid-or-nil)
- (when (plusp mode)
- (prop (ecase mode (1 'input-stream) (2 'output-stream) (3 'bidir-stream))
- io-or-pid))
- (when (eq error-output :stream)
- (prop 'error-stream err-or-nil)))
- ;; Prior to Lispworks 7, this returned (pid); now it
- ;; returns (io err pid) of which we keep io.
- (t (prop 'process io-or-pid)))))
- process-info)))
-
(DIR) diff --git a/3rdparties/software/uiop-3.3.2/lisp-build.lisp b/3rdparties/software/uiop-3.3.2/lisp-build.lisp
@@ -1,800 +0,0 @@
-;;;; -------------------------------------------------------------------------
-;;;; Support to build (compile and load) Lisp files
-
-(uiop/package:define-package :uiop/lisp-build
- (:nicknames :asdf/lisp-build) ;; OBSOLETE, used by slime/contrib/swank-asdf.lisp
- (:use :uiop/common-lisp :uiop/package :uiop/utility
- :uiop/os :uiop/pathname :uiop/filesystem :uiop/stream :uiop/image)
- (:export
- ;; Variables
- #:*compile-file-warnings-behaviour* #:*compile-file-failure-behaviour*
- #:*output-translation-function*
- #:*optimization-settings* #:*previous-optimization-settings*
- #:*base-build-directory*
- #:compile-condition #:compile-file-error #:compile-warned-error #:compile-failed-error
- #:compile-warned-warning #:compile-failed-warning
- #:check-lisp-compile-results #:check-lisp-compile-warnings
- #:*uninteresting-conditions* #:*usual-uninteresting-conditions*
- #:*uninteresting-compiler-conditions* #:*uninteresting-loader-conditions*
- ;; Types
- #+sbcl #:sb-grovel-unknown-constant-condition
- ;; Functions & Macros
- #:get-optimization-settings #:proclaim-optimization-settings #:with-optimization-settings
- #:call-with-muffled-compiler-conditions #:with-muffled-compiler-conditions
- #:call-with-muffled-loader-conditions #:with-muffled-loader-conditions
- #:reify-simple-sexp #:unreify-simple-sexp
- #:reify-deferred-warnings #:unreify-deferred-warnings
- #:reset-deferred-warnings #:save-deferred-warnings #:check-deferred-warnings
- #:with-saved-deferred-warnings #:warnings-file-p #:warnings-file-type #:*warnings-file-type*
- #:enable-deferred-warnings-check #:disable-deferred-warnings-check
- #:current-lisp-file-pathname #:load-pathname
- #:lispize-pathname #:compile-file-type #:call-around-hook
- #:compile-file* #:compile-file-pathname* #:*compile-check*
- #:load* #:load-from-string #:combine-fasls)
- (:intern #:defaults #:failure-p #:warnings-p #:s #:y #:body))
-(in-package :uiop/lisp-build)
-
-(with-upgradability ()
- (defvar *compile-file-warnings-behaviour*
- (or #+clisp :ignore :warn)
- "How should ASDF react if it encounters a warning when compiling a file?
-Valid values are :error, :warn, and :ignore.")
-
- (defvar *compile-file-failure-behaviour*
- (or #+(or mkcl sbcl) :error #+clisp :ignore :warn)
- "How should ASDF react if it encounters a failure (per the ANSI spec of COMPILE-FILE)
-when compiling a file, which includes any non-style-warning warning.
-Valid values are :error, :warn, and :ignore.
-Note that ASDF ALWAYS raises an error if it fails to create an output file when compiling.")
-
- (defvar *base-build-directory* nil
- "When set to a non-null value, it should be an absolute directory pathname,
-which will serve as the *DEFAULT-PATHNAME-DEFAULTS* around a COMPILE-FILE,
-what more while the input-file is shortened if possible to ENOUGH-PATHNAME relative to it.
-This can help you produce more deterministic output for FASLs."))
-
-;;; Optimization settings
-(with-upgradability ()
- (defvar *optimization-settings* nil
- "Optimization settings to be used by PROCLAIM-OPTIMIZATION-SETTINGS")
- (defvar *previous-optimization-settings* nil
- "Optimization settings saved by PROCLAIM-OPTIMIZATION-SETTINGS")
- (defparameter +optimization-variables+
- ;; TODO: allegro genera corman mcl
- (or #+(or abcl xcl) '(system::*speed* system::*space* system::*safety* system::*debug*)
- #+clisp '() ;; system::*optimize* is a constant hash-table! (with non-constant contents)
- #+clozure '(ccl::*nx-speed* ccl::*nx-space* ccl::*nx-safety*
- ccl::*nx-debug* ccl::*nx-cspeed*)
- #+(or cmucl scl) '(c::*default-cookie*)
- #+clasp '()
- #+ecl (unless (use-ecl-byte-compiler-p) '(c::*speed* c::*space* c::*safety* c::*debug*))
- #+gcl '(compiler::*speed* compiler::*space* compiler::*compiler-new-safety* compiler::*debug*)
- #+lispworks '(compiler::*optimization-level*)
- #+mkcl '(si::*speed* si::*space* si::*safety* si::*debug*)
- #+sbcl '(sb-c::*policy*)))
- (defun get-optimization-settings ()
- "Get current compiler optimization settings, ready to PROCLAIM again"
- #-(or abcl allegro clasp clisp clozure cmucl ecl lispworks mkcl sbcl scl xcl)
- (warn "~S does not support ~S. Please help me fix that."
- 'get-optimization-settings (implementation-type))
- #+(or abcl allegro clasp clisp clozure cmucl ecl lispworks mkcl sbcl scl xcl)
- (let ((settings '(speed space safety debug compilation-speed #+(or cmucl scl) c::brevity)))
- #.`(loop #+(or allegro clozure)
- ,@'(:with info = #+allegro (sys:declaration-information 'optimize)
- #+clozure (ccl:declaration-information 'optimize nil))
- :for x :in settings
- ,@(or #+(or abcl clasp ecl gcl mkcl xcl) '(:for v :in +optimization-variables+))
- :for y = (or #+(or allegro clozure) (second (assoc x info)) ; normalize order
- #+clisp (gethash x system::*optimize* 1)
- #+(or abcl clasp ecl mkcl xcl) (symbol-value v)
- #+(or cmucl scl) (slot-value c::*default-cookie*
- (case x (compilation-speed 'c::cspeed)
- (otherwise x)))
- #+lispworks (slot-value compiler::*optimization-level* x)
- #+sbcl (sb-c::policy-quality sb-c::*policy* x))
- :when y :collect (list x y))))
- (defun proclaim-optimization-settings ()
- "Proclaim the optimization settings in *OPTIMIZATION-SETTINGS*"
- (proclaim `(optimize ,@*optimization-settings*))
- (let ((settings (get-optimization-settings)))
- (unless (equal *previous-optimization-settings* settings)
- (setf *previous-optimization-settings* settings))))
- (defmacro with-optimization-settings ((&optional (settings *optimization-settings*)) &body body)
- #+(or allegro clisp)
- (let ((previous-settings (gensym "PREVIOUS-SETTINGS")))
- `(let ((,previous-settings (get-optimization-settings)))
- ,@(when settings `((proclaim `(optimize ,@,settings))))
- (unwind-protect (progn ,@body)
- (proclaim `(optimize ,@,previous-settings)))))
- #-(or allegro clisp)
- `(let ,(loop :for v :in +optimization-variables+ :collect `(,v ,v))
- ,@(when settings `((proclaim `(optimize ,@,settings))))
- ,@body)))
-
-
-;;; Condition control
-(with-upgradability ()
- #+sbcl
- (progn
- (defun sb-grovel-unknown-constant-condition-p (c)
- "Detect SB-GROVEL unknown-constant conditions on older versions of SBCL"
- (and (typep c 'sb-int:simple-style-warning)
- (string-enclosed-p
- "Couldn't grovel for "
- (simple-condition-format-control c)
- " (unknown to the C compiler).")))
- (deftype sb-grovel-unknown-constant-condition ()
- '(and style-warning (satisfies sb-grovel-unknown-constant-condition-p))))
-
- (defvar *usual-uninteresting-conditions*
- (append
- ;;#+clozure '(ccl:compiler-warning)
- #+cmucl '("Deleting unreachable code.")
- #+lispworks '("~S being redefined in ~A (previously in ~A)."
- "~S defined more than once in ~A.") ;; lispworks gets confused by eval-when.
- #+sbcl
- '(sb-c::simple-compiler-note
- "&OPTIONAL and &KEY found in the same lambda list: ~S"
- #+sb-eval sb-kernel:lexical-environment-too-complex
- sb-kernel:undefined-alien-style-warning
- sb-grovel-unknown-constant-condition ; defined above.
- sb-ext:implicit-generic-function-warning ;; Controversial.
- sb-int:package-at-variance
- sb-kernel:uninteresting-redefinition
- ;; BEWARE: the below four are controversial to include here.
- sb-kernel:redefinition-with-defun
- sb-kernel:redefinition-with-defgeneric
- sb-kernel:redefinition-with-defmethod
- sb-kernel::redefinition-with-defmacro) ; not exported by old SBCLs
- '("No generic function ~S present when encountering macroexpansion of defmethod. Assuming it will be an instance of standard-generic-function.")) ;; from closer2mop
- "A suggested value to which to set or bind *uninteresting-conditions*.")
-
- (defvar *uninteresting-conditions* '()
- "Conditions that may be skipped while compiling or loading Lisp code.")
- (defvar *uninteresting-compiler-conditions* '()
- "Additional conditions that may be skipped while compiling Lisp code.")
- (defvar *uninteresting-loader-conditions*
- (append
- '("Overwriting already existing readtable ~S." ;; from named-readtables
- #(#:finalizers-off-warning :asdf-finalizers)) ;; from asdf-finalizers
- #+clisp '(clos::simple-gf-replacing-method-warning))
- "Additional conditions that may be skipped while loading Lisp code."))
-
-;;;; ----- Filtering conditions while building -----
-(with-upgradability ()
- (defun call-with-muffled-compiler-conditions (thunk)
- "Call given THUNK in a context where uninteresting conditions and compiler conditions are muffled"
- (call-with-muffled-conditions
- thunk (append *uninteresting-conditions* *uninteresting-compiler-conditions*)))
- (defmacro with-muffled-compiler-conditions ((&optional) &body body)
- "Trivial syntax for CALL-WITH-MUFFLED-COMPILER-CONDITIONS"
- `(call-with-muffled-compiler-conditions #'(lambda () ,@body)))
- (defun call-with-muffled-loader-conditions (thunk)
- "Call given THUNK in a context where uninteresting conditions and loader conditions are muffled"
- (call-with-muffled-conditions
- thunk (append *uninteresting-conditions* *uninteresting-loader-conditions*)))
- (defmacro with-muffled-loader-conditions ((&optional) &body body)
- "Trivial syntax for CALL-WITH-MUFFLED-LOADER-CONDITIONS"
- `(call-with-muffled-loader-conditions #'(lambda () ,@body))))
-
-
-;;;; Handle warnings and failures
-(with-upgradability ()
- (define-condition compile-condition (condition)
- ((context-format
- :initform nil :reader compile-condition-context-format :initarg :context-format)
- (context-arguments
- :initform nil :reader compile-condition-context-arguments :initarg :context-arguments)
- (description
- :initform nil :reader compile-condition-description :initarg :description))
- (:report (lambda (c s)
- (format s (compatfmt "~@<~A~@[ while ~?~]~@:>")
- (or (compile-condition-description c) (type-of c))
- (compile-condition-context-format c)
- (compile-condition-context-arguments c)))))
- (define-condition compile-file-error (compile-condition error) ())
- (define-condition compile-warned-warning (compile-condition warning) ())
- (define-condition compile-warned-error (compile-condition error) ())
- (define-condition compile-failed-warning (compile-condition warning) ())
- (define-condition compile-failed-error (compile-condition error) ())
-
- (defun check-lisp-compile-warnings (warnings-p failure-p
- &optional context-format context-arguments)
- "Given the warnings or failures as resulted from COMPILE-FILE or checking deferred warnings,
-raise an error or warning as appropriate"
- (when failure-p
- (case *compile-file-failure-behaviour*
- (:warn (warn 'compile-failed-warning
- :description "Lisp compilation failed"
- :context-format context-format
- :context-arguments context-arguments))
- (:error (error 'compile-failed-error
- :description "Lisp compilation failed"
- :context-format context-format
- :context-arguments context-arguments))
- (:ignore nil)))
- (when warnings-p
- (case *compile-file-warnings-behaviour*
- (:warn (warn 'compile-warned-warning
- :description "Lisp compilation had style-warnings"
- :context-format context-format
- :context-arguments context-arguments))
- (:error (error 'compile-warned-error
- :description "Lisp compilation had style-warnings"
- :context-format context-format
- :context-arguments context-arguments))
- (:ignore nil))))
-
- (defun check-lisp-compile-results (output warnings-p failure-p
- &optional context-format context-arguments)
- "Given the results of COMPILE-FILE, raise an error or warning as appropriate"
- (unless output
- (error 'compile-file-error :context-format context-format :context-arguments context-arguments))
- (check-lisp-compile-warnings warnings-p failure-p context-format context-arguments)))
-
-
-;;;; Deferred-warnings treatment, originally implemented by Douglas Katzman.
-;;;
-;;; To support an implementation, three functions must be implemented:
-;;; reify-deferred-warnings unreify-deferred-warnings reset-deferred-warnings
-;;; See their respective docstrings.
-(with-upgradability ()
- (defun reify-simple-sexp (sexp)
- "Given a simple SEXP, return a representation of it as a portable SEXP.
-Simple means made of symbols, numbers, characters, simple-strings, pathnames, cons cells."
- (etypecase sexp
- (symbol (reify-symbol sexp))
- ((or number character simple-string pathname) sexp)
- (cons (cons (reify-simple-sexp (car sexp)) (reify-simple-sexp (cdr sexp))))
- (simple-vector (vector (mapcar 'reify-simple-sexp (coerce sexp 'list))))))
-
- (defun unreify-simple-sexp (sexp)
- "Given the portable output of REIFY-SIMPLE-SEXP, return the simple SEXP it represents"
- (etypecase sexp
- ((or symbol number character simple-string pathname) sexp)
- (cons (cons (unreify-simple-sexp (car sexp)) (unreify-simple-sexp (cdr sexp))))
- ((simple-vector 2) (unreify-symbol sexp))
- ((simple-vector 1) (coerce (mapcar 'unreify-simple-sexp (aref sexp 0)) 'vector))))
-
- #+clozure
- (progn
- (defun reify-source-note (source-note)
- (when source-note
- (with-accessors ((source ccl::source-note-source) (filename ccl:source-note-filename)
- (start-pos ccl:source-note-start-pos) (end-pos ccl:source-note-end-pos)) source-note
- (declare (ignorable source))
- (list :filename filename :start-pos start-pos :end-pos end-pos
- #|:source (reify-source-note source)|#))))
- (defun unreify-source-note (source-note)
- (when source-note
- (destructuring-bind (&key filename start-pos end-pos source) source-note
- (ccl::make-source-note :filename filename :start-pos start-pos :end-pos end-pos
- :source (unreify-source-note source)))))
- (defun unsymbolify-function-name (name)
- (if-let (setfed (gethash name ccl::%setf-function-name-inverses%))
- `(setf ,setfed)
- name))
- (defun symbolify-function-name (name)
- (if (and (consp name) (eq (first name) 'setf))
- (let ((setfed (second name)))
- (gethash setfed ccl::%setf-function-names%))
- name))
- (defun reify-function-name (function-name)
- (let ((name (or (first function-name) ;; defun: extract the name
- (let ((sec (second function-name)))
- (or (and (atom sec) sec) ; scoped method: drop scope
- (first sec)))))) ; method: keep gf name, drop method specializers
- (list name)))
- (defun unreify-function-name (function-name)
- function-name)
- (defun nullify-non-literals (sexp)
- (typecase sexp
- ((or number character simple-string symbol pathname) sexp)
- (cons (cons (nullify-non-literals (car sexp))
- (nullify-non-literals (cdr sexp))))
- (t nil)))
- (defun reify-deferred-warning (deferred-warning)
- (with-accessors ((warning-type ccl::compiler-warning-warning-type)
- (args ccl::compiler-warning-args)
- (source-note ccl:compiler-warning-source-note)
- (function-name ccl:compiler-warning-function-name)) deferred-warning
- (list :warning-type warning-type :function-name (reify-function-name function-name)
- :source-note (reify-source-note source-note)
- :args (destructuring-bind (fun &rest more)
- args
- (cons (unsymbolify-function-name fun)
- (nullify-non-literals more))))))
- (defun unreify-deferred-warning (reified-deferred-warning)
- (destructuring-bind (&key warning-type function-name source-note args)
- reified-deferred-warning
- (make-condition (or (cdr (ccl::assq warning-type ccl::*compiler-whining-conditions*))
- 'ccl::compiler-warning)
- :function-name (unreify-function-name function-name)
- :source-note (unreify-source-note source-note)
- :warning-type warning-type
- :args (destructuring-bind (fun . more) args
- (cons (symbolify-function-name fun) more))))))
- #+(or cmucl scl)
- (defun reify-undefined-warning (warning)
- ;; Extracting undefined-warnings from the compilation-unit
- ;; To be passed through the above reify/unreify link, it must be a "simple-sexp"
- (list*
- (c::undefined-warning-kind warning)
- (c::undefined-warning-name warning)
- (c::undefined-warning-count warning)
- (mapcar
- #'(lambda (frob)
- ;; the lexenv slot can be ignored for reporting purposes
- `(:enclosing-source ,(c::compiler-error-context-enclosing-source frob)
- :source ,(c::compiler-error-context-source frob)
- :original-source ,(c::compiler-error-context-original-source frob)
- :context ,(c::compiler-error-context-context frob)
- :file-name ,(c::compiler-error-context-file-name frob) ; a pathname
- :file-position ,(c::compiler-error-context-file-position frob) ; an integer
- :original-source-path ,(c::compiler-error-context-original-source-path frob)))
- (c::undefined-warning-warnings warning))))
-
- #+sbcl
- (defun reify-undefined-warning (warning)
- ;; Extracting undefined-warnings from the compilation-unit
- ;; To be passed through the above reify/unreify link, it must be a "simple-sexp"
- (list*
- (sb-c::undefined-warning-kind warning)
- (sb-c::undefined-warning-name warning)
- (sb-c::undefined-warning-count warning)
- (mapcar
- #'(lambda (frob)
- ;; the lexenv slot can be ignored for reporting purposes
- `(:enclosing-source ,(sb-c::compiler-error-context-enclosing-source frob)
- :source ,(sb-c::compiler-error-context-source frob)
- :original-source ,(sb-c::compiler-error-context-original-source frob)
- :context ,(sb-c::compiler-error-context-context frob)
- :file-name ,(sb-c::compiler-error-context-file-name frob) ; a pathname
- :file-position ,(sb-c::compiler-error-context-file-position frob) ; an integer
- :original-source-path ,(sb-c::compiler-error-context-original-source-path frob)))
- (sb-c::undefined-warning-warnings warning))))
-
- (defun reify-deferred-warnings ()
- "return a portable S-expression, portably readable and writeable in any Common Lisp implementation
-using READ within a WITH-SAFE-IO-SYNTAX, that represents the warnings currently deferred by
-WITH-COMPILATION-UNIT. One of three functions required for deferred-warnings support in ASDF."
- #+allegro
- (list :functions-defined excl::.functions-defined.
- :functions-called excl::.functions-called.)
- #+clozure
- (mapcar 'reify-deferred-warning
- (if-let (dw ccl::*outstanding-deferred-warnings*)
- (let ((mdw (ccl::ensure-merged-deferred-warnings dw)))
- (ccl::deferred-warnings.warnings mdw))))
- #+(or cmucl scl)
- (when lisp::*in-compilation-unit*
- ;; Try to send nothing through the pipe if nothing needs to be accumulated
- `(,@(when c::*undefined-warnings*
- `((c::*undefined-warnings*
- ,@(mapcar #'reify-undefined-warning c::*undefined-warnings*))))
- ,@(loop :for what :in '(c::*compiler-error-count*
- c::*compiler-warning-count*
- c::*compiler-note-count*)
- :for value = (symbol-value what)
- :when (plusp value)
- :collect `(,what . ,value))))
- #+sbcl
- (when sb-c::*in-compilation-unit*
- ;; Try to send nothing through the pipe if nothing needs to be accumulated
- `(,@(when sb-c::*undefined-warnings*
- `((sb-c::*undefined-warnings*
- ,@(mapcar #'reify-undefined-warning sb-c::*undefined-warnings*))))
- ,@(loop :for what :in '(sb-c::*aborted-compilation-unit-count*
- sb-c::*compiler-error-count*
- sb-c::*compiler-warning-count*
- sb-c::*compiler-style-warning-count*
- sb-c::*compiler-note-count*)
- :for value = (symbol-value what)
- :when (plusp value)
- :collect `(,what . ,value)))))
-
- (defun unreify-deferred-warnings (reified-deferred-warnings)
- "given a S-expression created by REIFY-DEFERRED-WARNINGS, reinstantiate the corresponding
-deferred warnings as to be handled at the end of the current WITH-COMPILATION-UNIT.
-Handle any warning that has been resolved already,
-such as an undefined function that has been defined since.
-One of three functions required for deferred-warnings support in ASDF."
- (declare (ignorable reified-deferred-warnings))
- #+allegro
- (destructuring-bind (&key functions-defined functions-called)
- reified-deferred-warnings
- (setf excl::.functions-defined.
- (append functions-defined excl::.functions-defined.)
- excl::.functions-called.
- (append functions-called excl::.functions-called.)))
- #+clozure
- (let ((dw (or ccl::*outstanding-deferred-warnings*
- (setf ccl::*outstanding-deferred-warnings* (ccl::%defer-warnings t)))))
- (appendf (ccl::deferred-warnings.warnings dw)
- (mapcar 'unreify-deferred-warning reified-deferred-warnings)))
- #+(or cmucl scl)
- (dolist (item reified-deferred-warnings)
- ;; Each item is (symbol . adjustment) where the adjustment depends on the symbol.
- ;; For *undefined-warnings*, the adjustment is a list of initargs.
- ;; For everything else, it's an integer.
- (destructuring-bind (symbol . adjustment) item
- (case symbol
- ((c::*undefined-warnings*)
- (setf c::*undefined-warnings*
- (nconc (mapcan
- #'(lambda (stuff)
- (destructuring-bind (kind name count . rest) stuff
- (unless (case kind (:function (fboundp name)))
- (list
- (c::make-undefined-warning
- :name name
- :kind kind
- :count count
- :warnings
- (mapcar #'(lambda (x)
- (apply #'c::make-compiler-error-context x))
- rest))))))
- adjustment)
- c::*undefined-warnings*)))
- (otherwise
- (set symbol (+ (symbol-value symbol) adjustment))))))
- #+sbcl
- (dolist (item reified-deferred-warnings)
- ;; Each item is (symbol . adjustment) where the adjustment depends on the symbol.
- ;; For *undefined-warnings*, the adjustment is a list of initargs.
- ;; For everything else, it's an integer.
- (destructuring-bind (symbol . adjustment) item
- (case symbol
- ((sb-c::*undefined-warnings*)
- (setf sb-c::*undefined-warnings*
- (nconc (mapcan
- #'(lambda (stuff)
- (destructuring-bind (kind name count . rest) stuff
- (unless (case kind (:function (fboundp name)))
- (list
- (sb-c::make-undefined-warning
- :name name
- :kind kind
- :count count
- :warnings
- (mapcar #'(lambda (x)
- (apply #'sb-c::make-compiler-error-context x))
- rest))))))
- adjustment)
- sb-c::*undefined-warnings*)))
- (otherwise
- (set symbol (+ (symbol-value symbol) adjustment)))))))
-
- (defun reset-deferred-warnings ()
- "Reset the set of deferred warnings to be handled at the end of the current WITH-COMPILATION-UNIT.
-One of three functions required for deferred-warnings support in ASDF."
- #+allegro
- (setf excl::.functions-defined. nil
- excl::.functions-called. nil)
- #+clozure
- (if-let (dw ccl::*outstanding-deferred-warnings*)
- (let ((mdw (ccl::ensure-merged-deferred-warnings dw)))
- (setf (ccl::deferred-warnings.warnings mdw) nil)))
- #+(or cmucl scl)
- (when lisp::*in-compilation-unit*
- (setf c::*undefined-warnings* nil
- c::*compiler-error-count* 0
- c::*compiler-warning-count* 0
- c::*compiler-note-count* 0))
- #+sbcl
- (when sb-c::*in-compilation-unit*
- (setf sb-c::*undefined-warnings* nil
- sb-c::*aborted-compilation-unit-count* 0
- sb-c::*compiler-error-count* 0
- sb-c::*compiler-warning-count* 0
- sb-c::*compiler-style-warning-count* 0
- sb-c::*compiler-note-count* 0)))
-
- (defun save-deferred-warnings (warnings-file)
- "Save forward reference conditions so they may be issued at a latter time,
-possibly in a different process."
- (with-open-file (s warnings-file :direction :output :if-exists :supersede
- :element-type *default-stream-element-type*
- :external-format *utf-8-external-format*)
- (with-safe-io-syntax ()
- (let ((*read-eval* t))
- (write (reify-deferred-warnings) :stream s :pretty t :readably t))
- (terpri s))))
-
- (defun warnings-file-type (&optional implementation-type)
- "The pathname type for warnings files on given IMPLEMENTATION-TYPE,
-where NIL designates the current one"
- (case (or implementation-type *implementation-type*)
- ((:acl :allegro) "allegro-warnings")
- ;;((:clisp) "clisp-warnings")
- ((:cmu :cmucl) "cmucl-warnings")
- ((:sbcl) "sbcl-warnings")
- ((:clozure :ccl) "ccl-warnings")
- ((:scl) "scl-warnings")))
-
- (defvar *warnings-file-type* nil
- "Pathname type for warnings files, or NIL if disabled")
-
- (defun enable-deferred-warnings-check ()
- "Enable the saving of deferred warnings"
- (setf *warnings-file-type* (warnings-file-type)))
-
- (defun disable-deferred-warnings-check ()
- "Disable the saving of deferred warnings"
- (setf *warnings-file-type* nil))
-
- (defun warnings-file-p (file &optional implementation-type)
- "Is FILE a saved warnings file for the given IMPLEMENTATION-TYPE?
-If that given type is NIL, use the currently configured *WARNINGS-FILE-TYPE* instead."
- (if-let (type (if implementation-type
- (warnings-file-type implementation-type)
- *warnings-file-type*))
- (equal (pathname-type file) type)))
-
- (defun check-deferred-warnings (files &optional context-format context-arguments)
- "Given a list of FILES containing deferred warnings saved by CALL-WITH-SAVED-DEFERRED-WARNINGS,
-re-intern and raise any warnings that are still meaningful."
- (let ((file-errors nil)
- (failure-p nil)
- (warnings-p nil))
- (handler-bind
- ((warning #'(lambda (c)
- (setf warnings-p t)
- (unless (typep c 'style-warning)
- (setf failure-p t)))))
- (with-compilation-unit (:override t)
- (reset-deferred-warnings)
- (dolist (file files)
- (unreify-deferred-warnings
- (handler-case
- (with-safe-io-syntax ()
- (let ((*read-eval* t))
- (read-file-form file)))
- (error (c)
- ;;(delete-file-if-exists file) ;; deleting forces rebuild but prevents debugging
- (push c file-errors)
- nil))))))
- (dolist (error file-errors) (error error))
- (check-lisp-compile-warnings
- (or failure-p warnings-p) failure-p context-format context-arguments)))
-
- #|
- Mini-guide to adding support for deferred warnings on an implementation.
-
- First, look at what such a warning looks like:
-
- (describe
- (handler-case
- (and (eval '(lambda () (some-undefined-function))) nil)
- (t (c) c)))
-
- Then you can grep for the condition type in your compiler sources
- and see how to catch those that have been deferred,
- and/or read, clear and restore the deferred list.
-
- Also look at
- (macroexpand-1 '(with-compilation-unit () foo))
- |#
-
- (defun call-with-saved-deferred-warnings (thunk warnings-file &key source-namestring)
- "If WARNINGS-FILE is not nil, record the deferred-warnings around a call to THUNK
-and save those warnings to the given file for latter use,
-possibly in a different process. Otherwise just call THUNK."
- (declare (ignorable source-namestring))
- (if warnings-file
- (with-compilation-unit (:override t #+sbcl :source-namestring #+sbcl source-namestring)
- (unwind-protect
- (let (#+sbcl (sb-c::*undefined-warnings* nil))
- (multiple-value-prog1
- (funcall thunk)
- (save-deferred-warnings warnings-file)))
- (reset-deferred-warnings)))
- (funcall thunk)))
-
- (defmacro with-saved-deferred-warnings ((warnings-file &key source-namestring) &body body)
- "Trivial syntax for CALL-WITH-SAVED-DEFERRED-WARNINGS"
- `(call-with-saved-deferred-warnings
- #'(lambda () ,@body) ,warnings-file :source-namestring ,source-namestring)))
-
-
-;;; from ASDF
-(with-upgradability ()
- (defun current-lisp-file-pathname ()
- "Portably return the PATHNAME of the current Lisp source file being compiled or loaded"
- (or *compile-file-pathname* *load-pathname*))
-
- (defun load-pathname ()
- "Portably return the LOAD-PATHNAME of the current source file or fasl"
- *load-pathname*) ;; magic no longer needed for GCL.
-
- (defun lispize-pathname (input-file)
- "From a INPUT-FILE pathname, return a corresponding .lisp source pathname"
- (make-pathname :type "lisp" :defaults input-file))
-
- (defun compile-file-type (&rest keys)
- "pathname TYPE for lisp FASt Loading files"
- (declare (ignorable keys))
- #-(or clasp ecl mkcl) (load-time-value (pathname-type (compile-file-pathname "foo.lisp")))
- #+(or clasp ecl mkcl) (pathname-type (apply 'compile-file-pathname "foo" keys)))
-
- (defun call-around-hook (hook function)
- "Call a HOOK around the execution of FUNCTION"
- (call-function (or hook 'funcall) function))
-
- (defun compile-file-pathname* (input-file &rest keys &key output-file &allow-other-keys)
- "Variant of COMPILE-FILE-PATHNAME that works well with COMPILE-FILE*"
- (let* ((keys
- (remove-plist-keys `(#+(or (and allegro (not (version>= 8 2)))) :external-format
- ,@(unless output-file '(:output-file))) keys)))
- (if (absolute-pathname-p output-file)
- ;; what cfp should be doing, w/ mp* instead of mp
- (let* ((type (pathname-type (apply 'compile-file-type keys)))
- (defaults (make-pathname
- :type type :defaults (merge-pathnames* input-file))))
- (merge-pathnames* output-file defaults))
- (funcall *output-translation-function*
- (apply 'compile-file-pathname input-file keys)))))
-
- (defvar *compile-check* nil
- "A hook for user-defined compile-time invariants")
-
- (defun* (compile-file*) (input-file &rest keys
- &key (compile-check *compile-check*) output-file warnings-file
- #+clisp lib-file #+(or clasp ecl mkcl) object-file #+sbcl emit-cfasl
- &allow-other-keys)
- "This function provides a portable wrapper around COMPILE-FILE.
-It ensures that the OUTPUT-FILE value is only returned and
-the file only actually created if the compilation was successful,
-even though your implementation may not do that. It also checks an optional
-user-provided consistency function COMPILE-CHECK to determine success;
-it will call this function if not NIL at the end of the compilation
-with the arguments sent to COMPILE-FILE*, except with :OUTPUT-FILE TMP-FILE
-where TMP-FILE is the name of a temporary output-file.
-It also checks two flags (with legacy british spelling from ASDF1),
-*COMPILE-FILE-FAILURE-BEHAVIOUR* and *COMPILE-FILE-WARNINGS-BEHAVIOUR*
-with appropriate implementation-dependent defaults,
-and if a failure (respectively warnings) are reported by COMPILE-FILE,
-it will consider that an error unless the respective behaviour flag
-is one of :SUCCESS :WARN :IGNORE.
-If WARNINGS-FILE is defined, deferred warnings are saved to that file.
-On ECL or MKCL, it creates both the linkable object and loadable fasl files.
-On implementations that erroneously do not recognize standard keyword arguments,
-it will filter them appropriately."
- #+(or clasp ecl)
- (when (and object-file (equal (compile-file-type) (pathname object-file)))
- (format t "Whoa, some funky ASDF upgrade switched ~S calling convention for ~S and ~S~%"
- 'compile-file* output-file object-file)
- (rotatef output-file object-file))
- (let* ((keywords (remove-plist-keys
- `(:output-file :compile-check :warnings-file
- #+clisp :lib-file #+(or clasp ecl mkcl) :object-file) keys))
- (output-file
- (or output-file
- (apply 'compile-file-pathname* input-file :output-file output-file keywords)))
- (physical-output-file (physicalize-pathname output-file))
- #+(or clasp ecl)
- (object-file
- (unless (use-ecl-byte-compiler-p)
- (or object-file
- #+ecl (compile-file-pathname output-file :type :object)
- #+clasp (compile-file-pathname output-file :output-type :object))))
- #+mkcl
- (object-file
- (or object-file
- (compile-file-pathname output-file :fasl-p nil)))
- (tmp-file (tmpize-pathname physical-output-file))
- #+sbcl
- (cfasl-file (etypecase emit-cfasl
- (null nil)
- ((eql t) (make-pathname :type "cfasl" :defaults physical-output-file))
- (string (parse-namestring emit-cfasl))
- (pathname emit-cfasl)))
- #+sbcl
- (tmp-cfasl (when cfasl-file (make-pathname :type "cfasl" :defaults tmp-file)))
- #+clisp
- (tmp-lib (make-pathname :type "lib" :defaults tmp-file)))
- (multiple-value-bind (output-truename warnings-p failure-p)
- (with-enough-pathname (input-file :defaults *base-build-directory*)
- (with-saved-deferred-warnings (warnings-file :source-namestring (namestring input-file))
- (with-muffled-compiler-conditions ()
- (or #-(or clasp ecl mkcl)
- (apply 'compile-file input-file :output-file tmp-file
- #+sbcl (if emit-cfasl (list* :emit-cfasl tmp-cfasl keywords) keywords)
- #-sbcl keywords)
- #+ecl (apply 'compile-file input-file :output-file
- (if object-file
- (list* object-file :system-p t keywords)
- (list* tmp-file keywords)))
- #+clasp (apply 'compile-file input-file :output-file
- (if object-file
- (list* object-file :output-type :object #|:system-p t|# keywords)
- (list* tmp-file keywords)))
- #+mkcl (apply 'compile-file input-file
- :output-file object-file :fasl-p nil keywords)))))
- (cond
- ((and output-truename
- (flet ((check-flag (flag behaviour)
- (or (not flag) (member behaviour '(:success :warn :ignore)))))
- (and (check-flag failure-p *compile-file-failure-behaviour*)
- (check-flag warnings-p *compile-file-warnings-behaviour*)))
- (progn
- #+(or clasp ecl mkcl)
- (when (and #+(or clasp ecl) object-file)
- (setf output-truename
- (compiler::build-fasl tmp-file
- #+(or clasp ecl) :lisp-files #+mkcl :lisp-object-files (list object-file))))
- (or (not compile-check)
- (apply compile-check input-file
- :output-file output-truename
- keywords))))
- (delete-file-if-exists physical-output-file)
- (when output-truename
- #+clasp (when output-truename (rename-file-overwriting-target tmp-file output-truename))
- ;; see CLISP bug 677
- #+clisp
- (progn
- (setf tmp-lib (make-pathname :type "lib" :defaults output-truename))
- (unless lib-file (setf lib-file (make-pathname :type "lib" :defaults physical-output-file)))
- (rename-file-overwriting-target tmp-lib lib-file))
- #+sbcl (when cfasl-file (rename-file-overwriting-target tmp-cfasl cfasl-file))
- (rename-file-overwriting-target output-truename physical-output-file)
- (setf output-truename (truename physical-output-file)))
- #+clasp (delete-file-if-exists tmp-file)
- #+clisp (progn (delete-file-if-exists tmp-file) ;; this one works around clisp BUG 677
- (delete-file-if-exists tmp-lib))) ;; this one is "normal" defensive cleanup
- (t ;; error or failed check
- (delete-file-if-exists output-truename)
- #+clisp (delete-file-if-exists tmp-lib)
- #+sbcl (delete-file-if-exists tmp-cfasl)
- (setf output-truename nil)))
- (values output-truename warnings-p failure-p))))
-
- (defun load* (x &rest keys &key &allow-other-keys)
- "Portable wrapper around LOAD that properly handles loading from a stream."
- (with-muffled-loader-conditions ()
- (etypecase x
- ((or pathname string #-(or allegro clozure genera) stream #+clozure file-stream)
- (apply 'load x keys))
- ;; Genera can't load from a string-input-stream
- ;; ClozureCL 1.6 can only load from file input stream
- ;; Allegro 5, I don't remember but it must have been broken when I tested.
- #+(or allegro clozure genera)
- (stream ;; make do this way
- (let ((*package* *package*)
- (*readtable* *readtable*)
- (*load-pathname* nil)
- (*load-truename* nil))
- (eval-input x))))))
-
- (defun load-from-string (string)
- "Portably read and evaluate forms from a STRING."
- (with-input-from-string (s string) (load* s))))
-
-;;; Links FASLs together
-(with-upgradability ()
- (defun combine-fasls (inputs output)
- "Combine a list of FASLs INPUTS into a single FASL OUTPUT"
- #-(or abcl allegro clisp clozure cmucl lispworks sbcl scl xcl)
- (not-implemented-error 'combine-fasls "~%inputs: ~S~%output: ~S" inputs output)
- #+abcl (funcall 'sys::concatenate-fasls inputs output) ; requires ABCL 1.2.0
- #+(or allegro clisp cmucl sbcl scl xcl) (concatenate-files inputs output)
- #+clozure (ccl:fasl-concatenate output inputs :if-exists :supersede)
- #+lispworks
- (let (fasls)
- (unwind-protect
- (progn
- (loop :for i :in inputs
- :for n :from 1
- :for f = (add-pathname-suffix
- output (format nil "-FASL~D" n))
- :do (copy-file i f)
- (push f fasls))
- (ignore-errors (lispworks:delete-system :fasls-to-concatenate))
- (eval `(scm:defsystem :fasls-to-concatenate
- (:default-pathname ,(pathname-directory-pathname output))
- :members
- ,(loop :for f :in (reverse fasls)
- :collect `(,(namestring f) :load-only t))))
- (scm:concatenate-system output :fasls-to-concatenate :force t))
- (loop :for f :in fasls :do (ignore-errors (delete-file f)))
- (ignore-errors (lispworks:delete-system :fasls-to-concatenate))))))
(DIR) diff --git a/3rdparties/software/uiop-3.3.2/os.lisp b/3rdparties/software/uiop-3.3.2/os.lisp
@@ -1,403 +0,0 @@
-;;;; ---------------------------------------------------------------------------
-;;;; Access to the Operating System
-
-(uiop/package:define-package :uiop/os
- (:use :uiop/common-lisp :uiop/package :uiop/utility)
- (:export
- #:featurep #:os-unix-p #:os-macosx-p #:os-windows-p #:os-genera-p #:detect-os ;; features
- #:os-cond
- #:getenv #:getenvp ;; environment variables
- #:implementation-identifier ;; implementation identifier
- #:implementation-type #:*implementation-type*
- #:operating-system #:architecture #:lisp-version-string
- #:hostname #:getcwd #:chdir
- ;; Windows shortcut support
- #:read-null-terminated-string #:read-little-endian
- #:parse-file-location-info #:parse-windows-shortcut))
-(in-package :uiop/os)
-
-;;; Features
-(with-upgradability ()
- (defun featurep (x &optional (*features* *features*))
- "Checks whether a feature expression X is true with respect to the *FEATURES* set,
-as per the CLHS standard for #+ and #-. Beware that just like the CLHS,
-we assume symbols from the KEYWORD package are used, but that unless you're using #+/#-
-your reader will not have magically used the KEYWORD package, so you need specify
-keywords explicitly."
- (cond
- ((atom x) (and (member x *features*) t))
- ((eq :not (car x)) (assert (null (cddr x))) (not (featurep (cadr x))))
- ((eq :or (car x)) (some #'featurep (cdr x)))
- ((eq :and (car x)) (every #'featurep (cdr x)))
- (t (parameter-error "~S: malformed feature specification ~S" 'featurep x))))
-
- ;; Starting with UIOP 3.1.5, these are runtime tests.
- ;; You may bind *features* with a copy of what your target system offers to test its properties.
- (defun os-macosx-p ()
- "Is the underlying operating system MacOS X?"
- ;; OS-MACOSX is not mutually exclusive with OS-UNIX,
- ;; in fact the former implies the latter.
- (featurep '(:or :darwin (:and :allegro :macosx) (:and :clisp :macos))))
-
- (defun os-unix-p ()
- "Is the underlying operating system some Unix variant?"
- (or (featurep '(:or :unix :cygwin)) (os-macosx-p)))
-
- (defun os-windows-p ()
- "Is the underlying operating system Microsoft Windows?"
- (and (not (os-unix-p)) (featurep '(:or :win32 :windows :mswindows :mingw32 :mingw64))))
-
- (defun os-genera-p ()
- "Is the underlying operating system Genera (running on a Symbolics Lisp Machine)?"
- (featurep :genera))
-
- (defun os-oldmac-p ()
- "Is the underlying operating system an (emulated?) MacOS 9 or earlier?"
- (featurep :mcl))
-
- (defun os-haiku-p ()
- "Is the underlying operating system Haiku?"
- (featurep :haiku))
-
- (defun os-mezzano-p ()
- "Is the underlying operating system Mezzano?"
- (featurep :mezzano))
-
- (defun detect-os ()
- "Detects the current operating system. Only needs be run at compile-time,
-except on ABCL where it might change between FASL compilation and runtime."
- (loop* :with o
- :for (feature . detect) :in '((:os-unix . os-unix-p) (:os-macosx . os-macosx-p)
- (:os-windows . os-windows-p)
- (:genera . os-genera-p) (:os-oldmac . os-oldmac-p)
- (:haiku . os-haiku-p)
- (:mezzano . os-mezzano-p))
- :when (and (or (not o) (eq feature :os-macosx)) (funcall detect))
- :do (setf o feature) (pushnew feature *features*)
- :else :do (setf *features* (remove feature *features*))
- :finally
- (return (or o (error "Congratulations for trying ASDF on an operating system~%~
-that is neither Unix, nor Windows, nor Genera, nor even old MacOS.~%Now you port it.")))))
-
- (defmacro os-cond (&rest clauses)
- #+abcl `(cond ,@clauses)
- #-abcl (loop* :for (test . body) :in clauses :when (eval test) :return `(progn ,@body)))
-
- (detect-os))
-
-;;;; Environment variables: getting them, and parsing them.
-(with-upgradability ()
- (defun getenv (x)
- "Query the environment, as in C getenv.
-Beware: may return empty string if a variable is present but empty;
-use getenvp to return NIL in such a case."
- (declare (ignorable x))
- #+(or abcl clasp clisp ecl xcl) (ext:getenv x)
- #+allegro (sys:getenv x)
- #+clozure (ccl:getenv x)
- #+cmucl (unix:unix-getenv x)
- #+scl (cdr (assoc x ext:*environment-list* :test #'string=))
- #+cormanlisp
- (let* ((buffer (ct:malloc 1))
- (cname (ct:lisp-string-to-c-string x))
- (needed-size (win:getenvironmentvariable cname buffer 0))
- (buffer1 (ct:malloc (1+ needed-size))))
- (prog1 (if (zerop (win:getenvironmentvariable cname buffer1 needed-size))
- nil
- (ct:c-string-to-lisp-string buffer1))
- (ct:free buffer)
- (ct:free buffer1)))
- #+gcl (system:getenv x)
- #+(or genera mezzano) nil
- #+lispworks (lispworks:environment-variable x)
- #+mcl (ccl:with-cstrs ((name x))
- (let ((value (_getenv name)))
- (unless (ccl:%null-ptr-p value)
- (ccl:%get-cstring value))))
- #+mkcl (#.(or (find-symbol* 'getenv :si nil) (find-symbol* 'getenv :mk-ext nil)) x)
- #+sbcl (sb-ext:posix-getenv x)
- #-(or abcl allegro clasp clisp clozure cmucl cormanlisp ecl gcl genera lispworks mcl mezzano mkcl sbcl scl xcl)
- (not-implemented-error 'getenv))
-
- (defsetf getenv (x) (val)
- "Set an environment variable."
- (declare (ignorable x val))
- #+allegro `(setf (sys:getenv ,x) ,val)
- #+clisp `(system::setenv ,x ,val)
- #+clozure `(ccl:setenv ,x ,val)
- #+cmucl `(unix:unix-setenv ,x ,val 1)
- #+ecl `(ext:setenv ,x ,val)
- #+lispworks `(hcl:setenv ,x ,val)
- #+mkcl `(mkcl:setenv ,x ,val)
- #+sbcl `(progn (require :sb-posix) (symbol-call :sb-posix :setenv ,x ,val 1))
- #-(or allegro clisp clozure cmucl ecl lispworks mkcl sbcl)
- '(not-implemented-error '(setf getenv)))
-
- (defun getenvp (x)
- "Predicate that is true if the named variable is present in the libc environment,
-then returning the non-empty string value of the variable"
- (let ((g (getenv x))) (and (not (emptyp g)) g))))
-
-
-;;;; implementation-identifier
-;;
-;; produce a string to identify current implementation.
-;; Initially stolen from SLIME's SWANK, completely rewritten since.
-;; We're back to runtime checking, for the sake of e.g. ABCL.
-
-(with-upgradability ()
- (defun first-feature (feature-sets)
- "A helper for various feature detection functions"
- (dolist (x feature-sets)
- (multiple-value-bind (short long feature-expr)
- (if (consp x)
- (values (first x) (second x) (cons :or (rest x)))
- (values x x x))
- (when (featurep feature-expr)
- (return (values short long))))))
-
- (defun implementation-type ()
- "The type of Lisp implementation used, as a short UIOP-standardized keyword"
- (first-feature
- '(:abcl (:acl :allegro) (:ccl :clozure) :clisp (:corman :cormanlisp)
- (:cmu :cmucl :cmu) :clasp :ecl :gcl
- (:lwpe :lispworks-personal-edition) (:lw :lispworks)
- :mcl :mezzano :mkcl :sbcl :scl (:smbx :symbolics) :xcl)))
-
- (defvar *implementation-type* (implementation-type)
- "The type of Lisp implementation used, as a short UIOP-standardized keyword")
-
- (defun operating-system ()
- "The operating system of the current host"
- (first-feature
- '(:cygwin
- (:win :windows :mswindows :win32 :mingw32) ;; try cygwin first!
- (:linux :linux :linux-target) ;; for GCL at least, must appear before :bsd
- (:macosx :macosx :darwin :darwin-target :apple) ; also before :bsd
- (:solaris :solaris :sunos)
- (:bsd :bsd :freebsd :netbsd :openbsd :dragonfly)
- :unix
- :genera
- :mezzano)))
-
- (defun architecture ()
- "The CPU architecture of the current host"
- (first-feature
- '((:x64 :x86-64 :x86_64 :x8664-target :amd64 (:and :word-size=64 :pc386))
- (:x86 :x86 :i386 :i486 :i586 :i686 :pentium3 :pentium4 :pc386 :iapx386 :x8632-target)
- (:ppc64 :ppc64 :ppc64-target) (:ppc32 :ppc32 :ppc32-target :ppc :powerpc)
- :hppa64 :hppa :sparc64 (:sparc32 :sparc32 :sparc)
- :mipsel :mipseb :mips :alpha (:arm :arm :arm-target) :imach
- ;; Java comes last: if someone uses C via CFFI or otherwise JNA or JNI,
- ;; we may have to segregate the code still by architecture.
- (:java :java :java-1.4 :java-1.5 :java-1.6 :java-1.7))))
-
- #+clozure
- (defun ccl-fasl-version ()
- ;; the fasl version is target-dependent from CCL 1.8 on.
- (or (let ((s 'ccl::target-fasl-version))
- (and (fboundp s) (funcall s)))
- (and (boundp 'ccl::fasl-version)
- (symbol-value 'ccl::fasl-version))
- (error "Can't determine fasl version.")))
-
- (defun lisp-version-string ()
- "return a string that identifies the current Lisp implementation version"
- (let ((s (lisp-implementation-version)))
- (car ; as opposed to OR, this idiom prevents some unreachable code warning
- (list
- #+allegro
- (format nil "~A~@[~A~]~@[~A~]~@[~A~]"
- excl::*common-lisp-version-number*
- ;; M means "modern", as opposed to ANSI-compatible mode (which I consider default)
- (and (eq excl:*current-case-mode* :case-sensitive-lower) "M")
- ;; Note if not using International ACL
- ;; see http://www.franz.com/support/documentation/8.1/doc/operators/excl/ics-target-case.htm
- (excl:ics-target-case (:-ics "8"))
- (and (member :smp *features*) "S"))
- #+armedbear (format nil "~a-fasl~a" s system::*fasl-version*)
- #+clisp
- (subseq s 0 (position #\space s)) ; strip build information (date, etc.)
- #+clozure
- (format nil "~d.~d-f~d" ; shorten for windows
- ccl::*openmcl-major-version*
- ccl::*openmcl-minor-version*
- (logand (ccl-fasl-version) #xFF))
- #+cmucl (substitute #\- #\/ s)
- #+scl (format nil "~A~A" s
- ;; ANSI upper case vs lower case.
- (ecase ext:*case-mode* (:upper "") (:lower "l")))
- #+ecl (format nil "~A~@[-~A~]" s
- (let ((vcs-id (ext:lisp-implementation-vcs-id)))
- (unless (equal vcs-id "UNKNOWN")
- (subseq vcs-id 0 (min (length vcs-id) 8)))))
- #+gcl (subseq s (1+ (position #\space s)))
- #+genera
- (multiple-value-bind (major minor) (sct:get-system-version "System")
- (format nil "~D.~D" major minor))
- #+mcl (subseq s 8) ; strip the leading "Version "
- #+mezzano (format nil "~A-~D"
- (subseq s 0 (position #\space s)) ; strip commit hash
- sys.int::*llf-version*)
- ;; seems like there should be a shorter way to do this, like ACALL.
- #+mkcl (or
- (let ((fname (find-symbol* '#:git-describe-this-mkcl :mkcl nil)))
- (when (and fname (fboundp fname))
- (funcall fname)))
- s)
- s))))
-
- (defun implementation-identifier ()
- "Return a string that identifies the ABI of the current implementation,
-suitable for use as a directory name to segregate Lisp FASLs, C dynamic libraries, etc."
- (substitute-if
- #\_ #'(lambda (x) (find x " /:;&^\\|?<>(){}[]$#`'\""))
- (format nil "~(~a~@{~@[-~a~]~}~)"
- (or (implementation-type) (lisp-implementation-type))
- (lisp-version-string)
- (or (operating-system) (software-type))
- (or (architecture) (machine-type))))))
-
-
-;;;; Other system information
-
-(with-upgradability ()
- (defun hostname ()
- "return the hostname of the current host"
- #+(or abcl clasp clozure cmucl ecl genera lispworks mcl mezzano mkcl sbcl scl xcl) (machine-instance)
- #+cormanlisp "localhost" ;; is there a better way? Does it matter?
- #+allegro (symbol-call :excl.osi :gethostname)
- #+clisp (first (split-string (machine-instance) :separator " "))
- #+gcl (system:gethostname)))
-
-
-;;; Current directory
-(with-upgradability ()
-
- #+cmucl
- (defun parse-unix-namestring* (unix-namestring)
- "variant of LISP::PARSE-UNIX-NAMESTRING that returns a pathname object"
- (multiple-value-bind (host device directory name type version)
- (lisp::parse-unix-namestring unix-namestring 0 (length unix-namestring))
- (make-pathname :host (or host lisp::*unix-host*) :device device
- :directory directory :name name :type type :version version)))
-
- (defun getcwd ()
- "Get the current working directory as per POSIX getcwd(3), as a pathname object"
- (or #+(or abcl genera mezzano xcl) (truename *default-pathname-defaults*) ;; d-p-d is canonical!
- #+allegro (excl::current-directory)
- #+clisp (ext:default-directory)
- #+clozure (ccl:current-directory)
- #+(or cmucl scl) (#+cmucl parse-unix-namestring* #+scl lisp::parse-unix-namestring
- (strcat (nth-value 1 (unix:unix-current-directory)) "/"))
- #+cormanlisp (pathname (pl::get-current-directory)) ;; Q: what type does it return?
- #+(or clasp ecl) (ext:getcwd)
- #+gcl (let ((*default-pathname-defaults* #p"")) (truename #p""))
- #+lispworks (hcl:get-working-directory)
- #+mkcl (mk-ext:getcwd)
- #+sbcl (sb-ext:parse-native-namestring (sb-unix:posix-getcwd/))
- #+xcl (extensions:current-directory)
- (not-implemented-error 'getcwd)))
-
- (defun chdir (x)
- "Change current directory, as per POSIX chdir(2), to a given pathname object"
- (if-let (x (pathname x))
- #+(or abcl genera mezzano xcl) (setf *default-pathname-defaults* (truename x)) ;; d-p-d is canonical!
- #+allegro (excl:chdir x)
- #+clisp (ext:cd x)
- #+clozure (setf (ccl:current-directory) x)
- #+(or cmucl scl) (unix:unix-chdir (ext:unix-namestring x))
- #+cormanlisp (unless (zerop (win32::_chdir (namestring x)))
- (error "Could not set current directory to ~A" x))
- #+(or clasp ecl) (ext:chdir x)
- #+gcl (system:chdir x)
- #+lispworks (hcl:change-directory x)
- #+mkcl (mk-ext:chdir x)
- #+sbcl (progn (require :sb-posix) (symbol-call :sb-posix :chdir (sb-ext:native-namestring x)))
- #-(or abcl allegro clasp clisp clozure cmucl cormanlisp ecl gcl genera lispworks mkcl sbcl scl xcl)
- (not-implemented-error 'chdir))))
-
-
-;;;; -----------------------------------------------------------------
-;;;; Windows shortcut support. Based on:
-;;;;
-;;;; Jesse Hager: The Windows Shortcut File Format.
-;;;; http://www.wotsit.org/list.asp?fc=13
-
-#-(or clisp genera) ; CLISP doesn't need it, and READ-SEQUENCE annoys old Genera that doesn't need it
-(with-upgradability ()
- (defparameter *link-initial-dword* 76)
- (defparameter *link-guid* #(1 20 2 0 0 0 0 0 192 0 0 0 0 0 0 70))
-
- (defun read-null-terminated-string (s)
- "Read a null-terminated string from an octet stream S"
- ;; note: doesn't play well with UNICODE
- (with-output-to-string (out)
- (loop :for code = (read-byte s)
- :until (zerop code)
- :do (write-char (code-char code) out))))
-
- (defun read-little-endian (s &optional (bytes 4))
- "Read a number in little-endian format from an byte (octet) stream S,
-the number having BYTES octets (defaulting to 4)."
- (loop :for i :from 0 :below bytes
- :sum (ash (read-byte s) (* 8 i))))
-
- (defun parse-file-location-info (s)
- "helper to parse-windows-shortcut"
- (let ((start (file-position s))
- (total-length (read-little-endian s))
- (end-of-header (read-little-endian s))
- (fli-flags (read-little-endian s))
- (local-volume-offset (read-little-endian s))
- (local-offset (read-little-endian s))
- (network-volume-offset (read-little-endian s))
- (remaining-offset (read-little-endian s)))
- (declare (ignore total-length end-of-header local-volume-offset))
- (unless (zerop fli-flags)
- (cond
- ((logbitp 0 fli-flags)
- (file-position s (+ start local-offset)))
- ((logbitp 1 fli-flags)
- (file-position s (+ start
- network-volume-offset
- #x14))))
- (strcat (read-null-terminated-string s)
- (progn
- (file-position s (+ start remaining-offset))
- (read-null-terminated-string s))))))
-
- (defun parse-windows-shortcut (pathname)
- "From a .lnk windows shortcut, extract the pathname linked to"
- ;; NB: doesn't do much checking & doesn't look like it will work well with UNICODE.
- (with-open-file (s pathname :element-type '(unsigned-byte 8))
- (handler-case
- (when (and (= (read-little-endian s) *link-initial-dword*)
- (let ((header (make-array (length *link-guid*))))
- (read-sequence header s)
- (equalp header *link-guid*)))
- (let ((flags (read-little-endian s)))
- (file-position s 76) ;skip rest of header
- (when (logbitp 0 flags)
- ;; skip shell item id list
- (let ((length (read-little-endian s 2)))
- (file-position s (+ length (file-position s)))))
- (cond
- ((logbitp 1 flags)
- (parse-file-location-info s))
- (t
- (when (logbitp 2 flags)
- ;; skip description string
- (let ((length (read-little-endian s 2)))
- (file-position s (+ length (file-position s)))))
- (when (logbitp 3 flags)
- ;; finally, our pathname
- (let* ((length (read-little-endian s 2))
- (buffer (make-array length)))
- (read-sequence buffer s)
- (map 'string #'code-char buffer)))))))
- (end-of-file (c)
- (declare (ignore c))
- nil)))))
-
-
(DIR) diff --git a/3rdparties/software/uiop-3.3.2/package.lisp b/3rdparties/software/uiop-3.3.2/package.lisp
@@ -1,742 +0,0 @@
-;;;; ---------------------------------------------------------------------------
-;;;; Handle ASDF package upgrade, including implementation-dependent magic.
-;;
-;; See https://bugs.launchpad.net/asdf/+bug/485687
-;;
-
-(defpackage :uiop/package
- ;; CAUTION: we must handle the first few packages specially for hot-upgrade.
- ;; This package definition MUST NOT change unless its name too changes;
- ;; if/when it changes, don't forget to add new functions missing from below.
- ;; Until then, uiop/package is frozen to forever
- ;; import and export the same exact symbols as for ASDF 2.27.
- ;; Any other symbol must be import-from'ed and re-export'ed in a different package.
- (:use :common-lisp)
- (:export
- #:find-package* #:find-symbol* #:symbol-call
- #:intern* #:export* #:import* #:shadowing-import* #:shadow* #:make-symbol* #:unintern*
- #:symbol-shadowing-p #:home-package-p
- #:symbol-package-name #:standard-common-lisp-symbol-p
- #:reify-package #:unreify-package #:reify-symbol #:unreify-symbol
- #:nuke-symbol-in-package #:nuke-symbol #:rehome-symbol
- #:ensure-package-unused #:delete-package*
- #:package-names #:packages-from-names #:fresh-package-name #:rename-package-away
- #:package-definition-form #:parse-define-package-form
- #:ensure-package #:define-package))
-
-(in-package :uiop/package)
-
-;;;; General purpose package utilities
-
-(eval-when (:load-toplevel :compile-toplevel :execute)
- (defun find-package* (package-designator &optional (error t))
- (let ((package (find-package package-designator)))
- (cond
- (package package)
- (error (error "No package named ~S" (string package-designator)))
- (t nil))))
- (defun find-symbol* (name package-designator &optional (error t))
- "Find a symbol in a package of given string'ified NAME;
-unlike CL:FIND-SYMBOL, work well with 'modern' case sensitive syntax
-by letting you supply a symbol or keyword for the name;
-also works well when the package is not present.
-If optional ERROR argument is NIL, return NIL instead of an error
-when the symbol is not found."
- (block nil
- (let ((package (find-package* package-designator error)))
- (when package ;; package error handled by find-package* already
- (multiple-value-bind (symbol status) (find-symbol (string name) package)
- (cond
- (status (return (values symbol status)))
- (error (error "There is no symbol ~S in package ~S" name (package-name package))))))
- (values nil nil))))
- (defun symbol-call (package name &rest args)
- "Call a function associated with symbol of given name in given package,
-with given ARGS. Useful when the call is read before the package is loaded,
-or when loading the package is optional."
- (apply (find-symbol* name package) args))
- (defun intern* (name package-designator &optional (error t))
- (intern (string name) (find-package* package-designator error)))
- (defun export* (name package-designator)
- (let* ((package (find-package* package-designator))
- (symbol (intern* name package)))
- (export (or symbol (list symbol)) package)))
- (defun import* (symbol package-designator)
- (import (or symbol (list symbol)) (find-package* package-designator)))
- (defun shadowing-import* (symbol package-designator)
- (shadowing-import (or symbol (list symbol)) (find-package* package-designator)))
- (defun shadow* (name package-designator)
- (shadow (list (string name)) (find-package* package-designator)))
- (defun make-symbol* (name)
- (etypecase name
- (string (make-symbol name))
- (symbol (copy-symbol name))))
- (defun unintern* (name package-designator &optional (error t))
- (block nil
- (let ((package (find-package* package-designator error)))
- (when package
- (multiple-value-bind (symbol status) (find-symbol* name package error)
- (cond
- (status (unintern symbol package)
- (return (values symbol status)))
- (error (error "symbol ~A not present in package ~A"
- (string symbol) (package-name package))))))
- (values nil nil))))
- (defun symbol-shadowing-p (symbol package)
- (and (member symbol (package-shadowing-symbols package)) t))
- (defun home-package-p (symbol package)
- (and package (let ((sp (symbol-package symbol)))
- (and sp (let ((pp (find-package* package)))
- (and pp (eq sp pp))))))))
-
-
-(eval-when (:load-toplevel :compile-toplevel :execute)
- (defun symbol-package-name (symbol)
- (let ((package (symbol-package symbol)))
- (and package (package-name package))))
- (defun standard-common-lisp-symbol-p (symbol)
- (multiple-value-bind (sym status) (find-symbol* symbol :common-lisp nil)
- (and (eq sym symbol) (eq status :external))))
- (defun reify-package (package &optional package-context)
- (if (eq package package-context) t
- (etypecase package
- (null nil)
- ((eql (find-package :cl)) :cl)
- (package (package-name package)))))
- (defun unreify-package (package &optional package-context)
- (etypecase package
- (null nil)
- ((eql t) package-context)
- ((or symbol string) (find-package package))))
- (defun reify-symbol (symbol &optional package-context)
- (etypecase symbol
- ((or keyword (satisfies standard-common-lisp-symbol-p)) symbol)
- (symbol (vector (symbol-name symbol)
- (reify-package (symbol-package symbol) package-context)))))
- (defun unreify-symbol (symbol &optional package-context)
- (etypecase symbol
- (symbol symbol)
- ((simple-vector 2)
- (let* ((symbol-name (svref symbol 0))
- (package-foo (svref symbol 1))
- (package (unreify-package package-foo package-context)))
- (if package (intern* symbol-name package)
- (make-symbol* symbol-name)))))))
-
-(eval-when (:load-toplevel :compile-toplevel :execute)
- (defvar *all-package-happiness* '())
- (defvar *all-package-fishiness* (list t))
- (defun record-fishy (info)
- ;;(format t "~&FISHY: ~S~%" info)
- (push info *all-package-fishiness*))
- (defmacro when-package-fishiness (&body body)
- `(when *all-package-fishiness* ,@body))
- (defmacro note-package-fishiness (&rest info)
- `(when-package-fishiness (record-fishy (list ,@info)))))
-
-(eval-when (:load-toplevel :compile-toplevel :execute)
- #+(or clisp clozure)
- (defun get-setf-function-symbol (symbol)
- #+clisp (let ((sym (get symbol 'system::setf-function)))
- (if sym (values sym :setf-function)
- (let ((sym (get symbol 'system::setf-expander)))
- (if sym (values sym :setf-expander)
- (values nil nil)))))
- #+clozure (gethash symbol ccl::%setf-function-names%))
- #+(or clisp clozure)
- (defun set-setf-function-symbol (new-setf-symbol symbol &optional kind)
- #+clisp (assert (member kind '(:setf-function :setf-expander)))
- #+clozure (assert (eq kind t))
- #+clisp
- (cond
- ((null new-setf-symbol)
- (remprop symbol 'system::setf-function)
- (remprop symbol 'system::setf-expander))
- ((eq kind :setf-function)
- (setf (get symbol 'system::setf-function) new-setf-symbol))
- ((eq kind :setf-expander)
- (setf (get symbol 'system::setf-expander) new-setf-symbol))
- (t (error "invalid kind of setf-function ~S for ~S to be set to ~S"
- kind symbol new-setf-symbol)))
- #+clozure
- (progn
- (gethash symbol ccl::%setf-function-names%) new-setf-symbol
- (gethash new-setf-symbol ccl::%setf-function-name-inverses%) symbol))
- #+(or clisp clozure)
- (defun create-setf-function-symbol (symbol)
- #+clisp (system::setf-symbol symbol)
- #+clozure (ccl::construct-setf-function-name symbol))
- (defun set-dummy-symbol (symbol reason other-symbol)
- (setf (get symbol 'dummy-symbol) (cons reason other-symbol)))
- (defun make-dummy-symbol (symbol)
- (let ((dummy (copy-symbol symbol)))
- (set-dummy-symbol dummy 'replacing symbol)
- (set-dummy-symbol symbol 'replaced-by dummy)
- dummy))
- (defun dummy-symbol (symbol)
- (get symbol 'dummy-symbol))
- (defun get-dummy-symbol (symbol)
- (let ((existing (dummy-symbol symbol)))
- (if existing (values (cdr existing) (car existing))
- (make-dummy-symbol symbol))))
- (defun nuke-symbol-in-package (symbol package-designator)
- (let ((package (find-package* package-designator))
- (name (symbol-name symbol)))
- (multiple-value-bind (sym stat) (find-symbol name package)
- (when (and (member stat '(:internal :external)) (eq symbol sym))
- (if (symbol-shadowing-p symbol package)
- (shadowing-import* (get-dummy-symbol symbol) package)
- (unintern* symbol package))))))
- (defun nuke-symbol (symbol &optional (packages (list-all-packages)))
- #+(or clisp clozure)
- (multiple-value-bind (setf-symbol kind)
- (get-setf-function-symbol symbol)
- (when kind (nuke-symbol setf-symbol)))
- (loop :for p :in packages :do (nuke-symbol-in-package symbol p)))
- (defun rehome-symbol (symbol package-designator)
- "Changes the home package of a symbol, also leaving it present in its old home if any"
- (let* ((name (symbol-name symbol))
- (package (find-package* package-designator))
- (old-package (symbol-package symbol))
- (old-status (and old-package (nth-value 1 (find-symbol name old-package))))
- (shadowing (and old-package (symbol-shadowing-p symbol old-package) (make-symbol name))))
- (multiple-value-bind (overwritten-symbol overwritten-symbol-status) (find-symbol name package)
- (unless (eq package old-package)
- (let ((overwritten-symbol-shadowing-p
- (and overwritten-symbol-status
- (symbol-shadowing-p overwritten-symbol package))))
- (note-package-fishiness
- :rehome-symbol name
- (when old-package (package-name old-package)) old-status (and shadowing t)
- (package-name package) overwritten-symbol-status overwritten-symbol-shadowing-p)
- (when old-package
- (if shadowing
- (shadowing-import* shadowing old-package))
- (unintern* symbol old-package))
- (cond
- (overwritten-symbol-shadowing-p
- (shadowing-import* symbol package))
- (t
- (when overwritten-symbol-status
- (unintern* overwritten-symbol package))
- (import* symbol package)))
- (if shadowing
- (shadowing-import* symbol old-package)
- (import* symbol old-package))
- #+(or clisp clozure)
- (multiple-value-bind (setf-symbol kind)
- (get-setf-function-symbol symbol)
- (when kind
- (let* ((setf-function (fdefinition setf-symbol))
- (new-setf-symbol (create-setf-function-symbol symbol)))
- (note-package-fishiness
- :setf-function
- name (package-name package)
- (symbol-name setf-symbol) (symbol-package-name setf-symbol)
- (symbol-name new-setf-symbol) (symbol-package-name new-setf-symbol))
- (when (symbol-package setf-symbol)
- (unintern* setf-symbol (symbol-package setf-symbol)))
- (setf (fdefinition new-setf-symbol) setf-function)
- (set-setf-function-symbol new-setf-symbol symbol kind))))
- #+(or clisp clozure)
- (multiple-value-bind (overwritten-setf foundp)
- (get-setf-function-symbol overwritten-symbol)
- (when foundp
- (unintern overwritten-setf)))
- (when (eq old-status :external)
- (export* symbol old-package))
- (when (eq overwritten-symbol-status :external)
- (export* symbol package))))
- (values overwritten-symbol overwritten-symbol-status))))
- (defun ensure-package-unused (package)
- (loop :for p :in (package-used-by-list package) :do
- (unuse-package package p)))
- (defun delete-package* (package &key nuke)
- (let ((p (find-package package)))
- (when p
- (when nuke (do-symbols (s p) (when (home-package-p s p) (nuke-symbol s))))
- (ensure-package-unused p)
- (delete-package package))))
- (defun package-names (package)
- (cons (package-name package) (package-nicknames package)))
- (defun packages-from-names (names)
- (remove-duplicates (remove nil (mapcar #'find-package names)) :from-end t))
- (defun fresh-package-name (&key (prefix :%TO-BE-DELETED)
- separator
- (index (random most-positive-fixnum)))
- (loop :for i :from index
- :for n = (format nil "~A~@[~A~D~]" prefix (and (plusp i) (or separator "")) i)
- :thereis (and (not (find-package n)) n)))
- (defun rename-package-away (p &rest keys &key prefix &allow-other-keys)
- (let ((new-name
- (apply 'fresh-package-name
- :prefix (or prefix (format nil "__~A__" (package-name p))) keys)))
- (record-fishy (list :rename-away (package-names p) new-name))
- (rename-package p new-name))))
-
-
-;;; Communicable representation of symbol and package information
-
-(eval-when (:load-toplevel :compile-toplevel :execute)
- (defun package-definition-form (package-designator
- &key (nicknamesp t) (usep t)
- (shadowp t) (shadowing-import-p t)
- (exportp t) (importp t) internp (error t))
- (let* ((package (or (find-package* package-designator error)
- (return-from package-definition-form nil)))
- (name (package-name package))
- (nicknames (package-nicknames package))
- (use (mapcar #'package-name (package-use-list package)))
- (shadow ())
- (shadowing-import (make-hash-table :test 'equal))
- (import (make-hash-table :test 'equal))
- (export ())
- (intern ()))
- (when package
- (loop :for sym :being :the :symbols :in package
- :for status = (nth-value 1 (find-symbol* sym package)) :do
- (ecase status
- ((nil :inherited))
- ((:internal :external)
- (let* ((name (symbol-name sym))
- (external (eq status :external))
- (home (symbol-package sym))
- (home-name (package-name home))
- (imported (not (eq home package)))
- (shadowing (symbol-shadowing-p sym package)))
- (cond
- ((and shadowing imported)
- (push name (gethash home-name shadowing-import)))
- (shadowing
- (push name shadow))
- (imported
- (push name (gethash home-name import))))
- (cond
- (external
- (push name export))
- (imported)
- (t (push name intern)))))))
- (labels ((sort-names (names)
- (sort (copy-list names) #'string<))
- (table-keys (table)
- (loop :for k :being :the :hash-keys :of table :collect k))
- (when-relevant (key value)
- (when value (list (cons key value))))
- (import-options (key table)
- (loop :for i :in (sort-names (table-keys table))
- :collect `(,key ,i ,@(sort-names (gethash i table))))))
- `(defpackage ,name
- ,@(when-relevant :nicknames (and nicknamesp (sort-names nicknames)))
- (:use ,@(and usep (sort-names use)))
- ,@(when-relevant :shadow (and shadowp (sort-names shadow)))
- ,@(import-options :shadowing-import-from (and shadowing-import-p shadowing-import))
- ,@(import-options :import-from (and importp import))
- ,@(when-relevant :export (and exportp (sort-names export)))
- ,@(when-relevant :intern (and internp (sort-names intern)))))))))
-
-
-;;; ensure-package, define-package
-(eval-when (:load-toplevel :compile-toplevel :execute)
- (defun ensure-shadowing-import (name to-package from-package shadowed imported)
- (check-type name string)
- (check-type to-package package)
- (check-type from-package package)
- (check-type shadowed hash-table)
- (check-type imported hash-table)
- (let ((import-me (find-symbol* name from-package)))
- (multiple-value-bind (existing status) (find-symbol name to-package)
- (cond
- ((gethash name shadowed)
- (unless (eq import-me existing)
- (error "Conflicting shadowings for ~A" name)))
- (t
- (setf (gethash name shadowed) t)
- (setf (gethash name imported) t)
- (unless (or (null status)
- (and (member status '(:internal :external))
- (eq existing import-me)
- (symbol-shadowing-p existing to-package)))
- (note-package-fishiness
- :shadowing-import name
- (package-name from-package)
- (or (home-package-p import-me from-package) (symbol-package-name import-me))
- (package-name to-package) status
- (and status (or (home-package-p existing to-package) (symbol-package-name existing)))))
- (shadowing-import* import-me to-package))))))
- (defun ensure-imported (import-me into-package &optional from-package)
- (check-type import-me symbol)
- (check-type into-package package)
- (check-type from-package (or null package))
- (let ((name (symbol-name import-me)))
- (multiple-value-bind (existing status) (find-symbol name into-package)
- (cond
- ((not status)
- (import* import-me into-package))
- ((eq import-me existing))
- (t
- (let ((shadowing-p (symbol-shadowing-p existing into-package)))
- (note-package-fishiness
- :ensure-imported name
- (and from-package (package-name from-package))
- (or (home-package-p import-me from-package) (symbol-package-name import-me))
- (package-name into-package)
- status
- (and status (or (home-package-p existing into-package) (symbol-package-name existing)))
- shadowing-p)
- (cond
- ((or shadowing-p (eq status :inherited))
- (shadowing-import* import-me into-package))
- (t
- (unintern* existing into-package)
- (import* import-me into-package))))))))
- (values))
- (defun ensure-import (name to-package from-package shadowed imported)
- (check-type name string)
- (check-type to-package package)
- (check-type from-package package)
- (check-type shadowed hash-table)
- (check-type imported hash-table)
- (multiple-value-bind (import-me import-status) (find-symbol name from-package)
- (when (null import-status)
- (note-package-fishiness
- :import-uninterned name (package-name from-package) (package-name to-package))
- (setf import-me (intern* name from-package)))
- (multiple-value-bind (existing status) (find-symbol name to-package)
- (cond
- ((and imported (gethash name imported))
- (unless (and status (eq import-me existing))
- (error "Can't import ~S from both ~S and ~S"
- name (package-name (symbol-package existing)) (package-name from-package))))
- ((gethash name shadowed)
- (error "Can't both shadow ~S and import it from ~S" name (package-name from-package)))
- (t
- (setf (gethash name imported) t))))
- (ensure-imported import-me to-package from-package)))
- (defun ensure-inherited (name symbol to-package from-package mixp shadowed imported inherited)
- (check-type name string)
- (check-type symbol symbol)
- (check-type to-package package)
- (check-type from-package package)
- (check-type mixp (member nil t)) ; no cl:boolean on Genera
- (check-type shadowed hash-table)
- (check-type imported hash-table)
- (check-type inherited hash-table)
- (multiple-value-bind (existing status) (find-symbol name to-package)
- (let* ((sp (symbol-package symbol))
- (in (gethash name inherited))
- (xp (and status (symbol-package existing))))
- (when (null sp)
- (note-package-fishiness
- :import-uninterned name
- (package-name from-package) (package-name to-package) mixp)
- (import* symbol from-package)
- (setf sp (package-name from-package)))
- (cond
- ((gethash name shadowed))
- (in
- (unless (equal sp (first in))
- (if mixp
- (ensure-shadowing-import name to-package (second in) shadowed imported)
- (error "Can't inherit ~S from ~S, it is inherited from ~S"
- name (package-name sp) (package-name (first in))))))
- ((gethash name imported)
- (unless (eq symbol existing)
- (error "Can't inherit ~S from ~S, it is imported from ~S"
- name (package-name sp) (package-name xp))))
- (t
- (setf (gethash name inherited) (list sp from-package))
- (when (and status (not (eq sp xp)))
- (let ((shadowing (symbol-shadowing-p existing to-package)))
- (note-package-fishiness
- :inherited name
- (package-name from-package)
- (or (home-package-p symbol from-package) (symbol-package-name symbol))
- (package-name to-package)
- (or (home-package-p existing to-package) (symbol-package-name existing)))
- (if shadowing (ensure-shadowing-import name to-package from-package shadowed imported)
- (unintern* existing to-package)))))))))
- (defun ensure-mix (name symbol to-package from-package shadowed imported inherited)
- (check-type name string)
- (check-type symbol symbol)
- (check-type to-package package)
- (check-type from-package package)
- (check-type shadowed hash-table)
- (check-type imported hash-table)
- (check-type inherited hash-table)
- (unless (gethash name shadowed)
- (multiple-value-bind (existing status) (find-symbol name to-package)
- (let* ((sp (symbol-package symbol))
- (im (gethash name imported))
- (in (gethash name inherited)))
- (cond
- ((or (null status)
- (and status (eq symbol existing))
- (and in (eq sp (first in))))
- (ensure-inherited name symbol to-package from-package t shadowed imported inherited))
- (in
- (remhash name inherited)
- (ensure-shadowing-import name to-package (second in) shadowed imported))
- (im
- (error "Symbol ~S import from ~S~:[~; actually ~:[uninterned~;~:*from ~S~]~] conflicts with existing symbol in ~S~:[~; actually ~:[uninterned~;from ~:*~S~]~]"
- name (package-name from-package)
- (home-package-p symbol from-package) (symbol-package-name symbol)
- (package-name to-package)
- (home-package-p existing to-package) (symbol-package-name existing)))
- (t
- (ensure-inherited name symbol to-package from-package t shadowed imported inherited)))))))
-
- (defun recycle-symbol (name recycle exported)
- ;; Takes a symbol NAME (a string), a list of package designators for RECYCLE
- ;; packages, and a hash-table of names (strings) of symbols scheduled to be
- ;; EXPORTED from the package being defined. It returns two values, the
- ;; symbol found (if any, or else NIL), and a boolean flag indicating whether
- ;; a symbol was found. The caller (DEFINE-PACKAGE) will then do the
- ;; re-homing of the symbol, etc.
- (check-type name string)
- (check-type recycle list)
- (check-type exported hash-table)
- (when (gethash name exported) ;; don't bother recycling private symbols
- (let (recycled foundp)
- (dolist (r recycle (values recycled foundp))
- (multiple-value-bind (symbol status) (find-symbol name r)
- (when (and status (home-package-p symbol r))
- (cond
- (foundp
- ;; (nuke-symbol symbol)) -- even simple variable names like O or C will do that.
- (note-package-fishiness :recycled-duplicate name (package-name foundp) (package-name r)))
- (t
- (setf recycled symbol foundp r)))))))))
- (defun symbol-recycled-p (sym recycle)
- (check-type sym symbol)
- (check-type recycle list)
- (and (member (symbol-package sym) recycle) t))
- (defun ensure-symbol (name package intern recycle shadowed imported inherited exported)
- (check-type name string)
- (check-type package package)
- (check-type intern (member nil t)) ; no cl:boolean on Genera
- (check-type shadowed hash-table)
- (check-type imported hash-table)
- (check-type inherited hash-table)
- (unless (or (gethash name shadowed)
- (gethash name imported)
- (gethash name inherited))
- (multiple-value-bind (existing status)
- (find-symbol name package)
- (multiple-value-bind (recycled previous) (recycle-symbol name recycle exported)
- (cond
- ((and status (eq existing recycled) (eq previous package)))
- (previous
- (rehome-symbol recycled package))
- ((and status (eq package (symbol-package existing))))
- (t
- (when status
- (note-package-fishiness
- :ensure-symbol name
- (reify-package (symbol-package existing) package)
- status intern)
- (unintern existing))
- (when intern
- (intern* name package))))))))
- (declaim (ftype (function (t t t &optional t) t) ensure-exported))
- (defun ensure-exported-to-user (name symbol to-package &optional recycle)
- (check-type name string)
- (check-type symbol symbol)
- (check-type to-package package)
- (check-type recycle list)
- (assert (equal name (symbol-name symbol)))
- (multiple-value-bind (existing status) (find-symbol name to-package)
- (unless (and status (eq symbol existing))
- (let ((accessible
- (or (null status)
- (let ((shadowing (symbol-shadowing-p existing to-package))
- (recycled (symbol-recycled-p existing recycle)))
- (unless (and shadowing (not recycled))
- (note-package-fishiness
- :ensure-export name (symbol-package-name symbol)
- (package-name to-package)
- (or (home-package-p existing to-package) (symbol-package-name existing))
- status shadowing)
- (if (or (eq status :inherited) shadowing)
- (shadowing-import* symbol to-package)
- (unintern existing to-package))
- t)))))
- (when (and accessible (eq status :external))
- (ensure-exported name symbol to-package recycle))))))
- (defun ensure-exported (name symbol from-package &optional recycle)
- (dolist (to-package (package-used-by-list from-package))
- (ensure-exported-to-user name symbol to-package recycle))
- (unless (eq from-package (symbol-package symbol))
- (ensure-imported symbol from-package))
- (export* name from-package))
- (defun ensure-export (name from-package &optional recycle)
- (multiple-value-bind (symbol status) (find-symbol* name from-package)
- (unless (eq status :external)
- (ensure-exported name symbol from-package recycle))))
- (defun ensure-package (name &key
- nicknames documentation use
- shadow shadowing-import-from
- import-from export intern
- recycle mix reexport
- unintern)
- #+genera (declare (ignore documentation))
- (let* ((package-name (string name))
- (nicknames (mapcar #'string nicknames))
- (names (cons package-name nicknames))
- (previous (packages-from-names names))
- (discarded (cdr previous))
- (to-delete ())
- (package (or (first previous) (make-package package-name :nicknames nicknames)))
- (recycle (packages-from-names recycle))
- (use (mapcar 'find-package* use))
- (mix (mapcar 'find-package* mix))
- (reexport (mapcar 'find-package* reexport))
- (shadow (mapcar 'string shadow))
- (export (mapcar 'string export))
- (intern (mapcar 'string intern))
- (unintern (mapcar 'string unintern))
- (shadowed (make-hash-table :test 'equal)) ; string to bool
- (imported (make-hash-table :test 'equal)) ; string to bool
- (exported (make-hash-table :test 'equal)) ; string to bool
- ;; string to list home package and use package:
- (inherited (make-hash-table :test 'equal)))
- (when-package-fishiness (record-fishy package-name))
- #-genera
- (when documentation (setf (documentation package t) documentation))
- (loop :for p :in (set-difference (package-use-list package) (append mix use))
- :do (note-package-fishiness :over-use name (package-names p))
- (unuse-package p package))
- (loop :for p :in discarded
- :for n = (remove-if #'(lambda (x) (member x names :test 'equal))
- (package-names p))
- :do (note-package-fishiness :nickname name (package-names p))
- (cond (n (rename-package p (first n) (rest n)))
- (t (rename-package-away p)
- (push p to-delete))))
- (rename-package package package-name nicknames)
- (dolist (name unintern)
- (multiple-value-bind (existing status) (find-symbol name package)
- (when status
- (unless (eq status :inherited)
- (note-package-fishiness
- :unintern (package-name package) name (symbol-package-name existing) status)
- (unintern* name package nil)))))
- (dolist (name export)
- (setf (gethash name exported) t))
- (dolist (p reexport)
- (do-external-symbols (sym p)
- (setf (gethash (string sym) exported) t)))
- (do-external-symbols (sym package)
- (let ((name (symbol-name sym)))
- (unless (gethash name exported)
- (note-package-fishiness
- :over-export (package-name package) name
- (or (home-package-p sym package) (symbol-package-name sym)))
- (unexport sym package))))
- (dolist (name shadow)
- (setf (gethash name shadowed) t)
- (multiple-value-bind (existing status) (find-symbol name package)
- (multiple-value-bind (recycled previous) (recycle-symbol name recycle exported)
- (let ((shadowing (and status (symbol-shadowing-p existing package))))
- (cond
- ((eq previous package))
- (previous
- (rehome-symbol recycled package))
- ((or (member status '(nil :inherited))
- (home-package-p existing package)))
- (t
- (let ((dummy (make-symbol name)))
- (note-package-fishiness
- :shadow-imported (package-name package) name
- (symbol-package-name existing) status shadowing)
- (shadowing-import* dummy package)
- (import* dummy package)))))))
- (shadow* name package))
- (loop :for (p . syms) :in shadowing-import-from
- :for pp = (find-package* p) :do
- (dolist (sym syms) (ensure-shadowing-import (string sym) package pp shadowed imported)))
- (loop :for p :in mix
- :for pp = (find-package* p) :do
- (do-external-symbols (sym pp) (ensure-mix (symbol-name sym) sym package pp shadowed imported inherited)))
- (loop :for (p . syms) :in import-from
- :for pp = (find-package p) :do
- (dolist (sym syms) (ensure-import (symbol-name sym) package pp shadowed imported)))
- (dolist (p (append use mix))
- (do-external-symbols (sym p) (ensure-inherited (string sym) sym package p nil shadowed imported inherited))
- (use-package p package))
- (loop :for name :being :the :hash-keys :of exported :do
- (ensure-symbol name package t recycle shadowed imported inherited exported)
- (ensure-export name package recycle))
- (dolist (name intern)
- (ensure-symbol name package t recycle shadowed imported inherited exported))
- (do-symbols (sym package)
- (ensure-symbol (symbol-name sym) package nil recycle shadowed imported inherited exported))
- (map () 'delete-package* to-delete)
- package)))
-
-(eval-when (:load-toplevel :compile-toplevel :execute)
- (defun parse-define-package-form (package clauses)
- (loop
- :with use-p = nil :with recycle-p = nil
- :with documentation = nil
- :for (kw . args) :in clauses
- :when (eq kw :nicknames) :append args :into nicknames :else
- :when (eq kw :documentation)
- :do (cond
- (documentation (error "define-package: can't define documentation twice"))
- ((or (atom args) (cdr args)) (error "define-package: bad documentation"))
- (t (setf documentation (car args)))) :else
- :when (eq kw :use) :append args :into use :and :do (setf use-p t) :else
- :when (eq kw :shadow) :append args :into shadow :else
- :when (eq kw :shadowing-import-from) :collect args :into shadowing-import-from :else
- :when (eq kw :import-from) :collect args :into import-from :else
- :when (eq kw :export) :append args :into export :else
- :when (eq kw :intern) :append args :into intern :else
- :when (eq kw :recycle) :append args :into recycle :and :do (setf recycle-p t) :else
- :when (eq kw :mix) :append args :into mix :else
- :when (eq kw :reexport) :append args :into reexport :else
- :when (eq kw :use-reexport) :append args :into use :and :append args :into reexport
- :and :do (setf use-p t) :else
- :when (eq kw :mix-reexport) :append args :into mix :and :append args :into reexport
- :and :do (setf use-p t) :else
- :when (eq kw :unintern) :append args :into unintern :else
- :do (error "unrecognized define-package keyword ~S" kw)
- :finally (return `(',package
- :nicknames ',nicknames :documentation ',documentation
- :use ',(if use-p use '(:common-lisp))
- :shadow ',shadow :shadowing-import-from ',shadowing-import-from
- :import-from ',import-from :export ',export :intern ',intern
- :recycle ',(if recycle-p recycle (cons package nicknames))
- :mix ',mix :reexport ',reexport :unintern ',unintern)))))
-
-(defmacro define-package (package &rest clauses)
- "DEFINE-PACKAGE takes a PACKAGE and a number of CLAUSES, of the form
-\(KEYWORD . ARGS\).
-DEFINE-PACKAGE supports the following keywords:
-USE, SHADOW, SHADOWING-IMPORT-FROM, IMPORT-FROM, EXPORT, INTERN -- as per CL:DEFPACKAGE.
-RECYCLE -- Recycle the package's exported symbols from the specified packages,
-in order. For every symbol scheduled to be exported by the DEFINE-PACKAGE,
-either through an :EXPORT option or a :REEXPORT option, if the symbol exists in
-one of the :RECYCLE packages, the first such symbol is re-homed to the package
-being defined.
-For the sake of idempotence, it is important that the package being defined
-should appear in first position if it already exists, and even if it doesn't,
-ahead of any package that is not going to be deleted afterwards and never
-created again. In short, except for special cases, always make it the first
-package on the list if the list is not empty.
-MIX -- Takes a list of package designators. MIX behaves like
-\(:USE PKG1 PKG2 ... PKGn\) but additionally uses :SHADOWING-IMPORT-FROM to
-resolve conflicts in favor of the first found symbol. It may still yield
-an error if there is a conflict with an explicitly :IMPORT-FROM symbol.
-REEXPORT -- Takes a list of package designators. For each package, p, in the list,
-export symbols with the same name as those exported from p. Note that in the case
-of shadowing, etc. the symbols with the same name may not be the same symbols.
-UNINTERN -- Remove symbols here from PACKAGE."
- (let ((ensure-form
- `(prog1
- (funcall 'ensure-package ,@(parse-define-package-form package clauses))
- #+sbcl (setf (sb-impl::package-source-location (find-package ',package))
- (sb-c:source-location)))))
- `(progn
- #+(or clasp ecl gcl mkcl) (defpackage ,package (:use))
- (eval-when (:compile-toplevel :load-toplevel :execute)
- ,ensure-form))))
(DIR) diff --git a/3rdparties/software/uiop-3.3.2/pathname.lisp b/3rdparties/software/uiop-3.3.2/pathname.lisp
@@ -1,741 +0,0 @@
-;;;; -------------------------------------------------------------------------
-;;;; Portability layer around Common Lisp pathnames
-;; This layer allows for portable manipulation of pathname objects themselves,
-;; which all is necessary prior to any access the filesystem or environment.
-
-(uiop/package:define-package :uiop/pathname
- (:nicknames :asdf/pathname) ;; deprecated. Used by ceramic
- (:use :uiop/common-lisp :uiop/package :uiop/utility :uiop/os)
- (:export
- ;; Making and merging pathnames, portably
- #:normalize-pathname-directory-component #:denormalize-pathname-directory-component
- #:merge-pathname-directory-components #:*unspecific-pathname-type* #:make-pathname*
- #:make-pathname-component-logical #:make-pathname-logical
- #:merge-pathnames*
- #:nil-pathname #:*nil-pathname* #:with-pathname-defaults
- ;; Predicates
- #:pathname-equal #:logical-pathname-p #:physical-pathname-p #:physicalize-pathname
- #:absolute-pathname-p #:relative-pathname-p #:hidden-pathname-p #:file-pathname-p
- ;; Directories
- #:pathname-directory-pathname #:pathname-parent-directory-pathname
- #:directory-pathname-p #:ensure-directory-pathname
- ;; Parsing filenames
- #:split-name-type #:parse-unix-namestring #:unix-namestring
- #:split-unix-namestring-directory-components
- ;; Absolute and relative pathnames
- #:subpathname #:subpathname*
- #:ensure-absolute-pathname
- #:pathname-root #:pathname-host-pathname
- #:subpathp #:enough-pathname #:with-enough-pathname #:call-with-enough-pathname
- ;; Checking constraints
- #:ensure-pathname ;; implemented in filesystem.lisp to accommodate for existence constraints
- ;; Wildcard pathnames
- #:*wild* #:*wild-file* #:*wild-file-for-directory* #:*wild-directory*
- #:*wild-inferiors* #:*wild-path* #:wilden
- ;; Translate a pathname
- #:relativize-directory-component #:relativize-pathname-directory
- #:directory-separator-for-host #:directorize-pathname-host-device
- #:translate-pathname*
- #:*output-translation-function*))
-(in-package :uiop/pathname)
-
-;;; Normalizing pathnames across implementations
-
-(with-upgradability ()
- (defun normalize-pathname-directory-component (directory)
- "Convert the DIRECTORY component from a format usable by the underlying
-implementation's MAKE-PATHNAME and other primitives to a CLHS-standard format
-that is a list and not a string."
- (cond
- #-(or cmucl sbcl scl) ;; these implementations already normalize directory components.
- ((stringp directory) `(:absolute ,directory))
- ((or (null directory)
- (and (consp directory) (member (first directory) '(:absolute :relative))))
- directory)
- #+gcl
- ((consp directory)
- (cons :relative directory))
- (t
- (parameter-error (compatfmt "~@<~S: Unrecognized pathname directory component ~S~@:>")
- 'normalize-pathname-directory-component directory))))
-
- (defun denormalize-pathname-directory-component (directory-component)
- "Convert the DIRECTORY-COMPONENT from a CLHS-standard format to a format usable
-by the underlying implementation's MAKE-PATHNAME and other primitives"
- directory-component)
-
- (defun merge-pathname-directory-components (specified defaults)
- "Helper for MERGE-PATHNAMES* that handles directory components"
- (let ((directory (normalize-pathname-directory-component specified)))
- (ecase (first directory)
- ((nil) defaults)
- (:absolute specified)
- (:relative
- (let ((defdir (normalize-pathname-directory-component defaults))
- (reldir (cdr directory)))
- (cond
- ((null defdir)
- directory)
- ((not (eq :back (first reldir)))
- (append defdir reldir))
- (t
- (loop :with defabs = (first defdir)
- :with defrev = (reverse (rest defdir))
- :while (and (eq :back (car reldir))
- (or (and (eq :absolute defabs) (null defrev))
- (stringp (car defrev))))
- :do (pop reldir) (pop defrev)
- :finally (return (cons defabs (append (reverse defrev) reldir)))))))))))
-
- ;; Giving :unspecific as :type argument to make-pathname is not portable.
- ;; See CLHS make-pathname and 19.2.2.2.3.
- ;; This will be :unspecific if supported, or NIL if not.
- (defparameter *unspecific-pathname-type*
- #+(or abcl allegro clozure cmucl genera lispworks sbcl scl) :unspecific
- #+(or clasp clisp ecl mkcl gcl xcl #|These haven't been tested:|# cormanlisp mcl mezzano) nil
- "Unspecific type component to use with the underlying implementation's MAKE-PATHNAME")
-
- (defun make-pathname* (&rest keys &key directory host device name type version defaults
- #+scl &allow-other-keys)
- "Takes arguments like CL:MAKE-PATHNAME in the CLHS, and
- tries hard to make a pathname that will actually behave as documented,
- despite the peculiarities of each implementation. DEPRECATED: just use MAKE-PATHNAME."
- (declare (ignore host device directory name type version defaults))
- (apply 'make-pathname keys))
-
- (defun make-pathname-component-logical (x)
- "Make a pathname component suitable for use in a logical-pathname"
- (typecase x
- ((eql :unspecific) nil)
- #+clisp (string (string-upcase x))
- #+clisp (cons (mapcar 'make-pathname-component-logical x))
- (t x)))
-
- (defun make-pathname-logical (pathname host)
- "Take a PATHNAME's directory, name, type and version components,
-and make a new pathname with corresponding components and specified logical HOST"
- (make-pathname
- :host host
- :directory (make-pathname-component-logical (pathname-directory pathname))
- :name (make-pathname-component-logical (pathname-name pathname))
- :type (make-pathname-component-logical (pathname-type pathname))
- :version (make-pathname-component-logical (pathname-version pathname))))
-
- (defun merge-pathnames* (specified &optional (defaults *default-pathname-defaults*))
- "MERGE-PATHNAMES* is like MERGE-PATHNAMES except that
-if the SPECIFIED pathname does not have an absolute directory,
-then the HOST and DEVICE both come from the DEFAULTS, whereas
-if the SPECIFIED pathname does have an absolute directory,
-then the HOST and DEVICE both come from the SPECIFIED pathname.
-This is what users want on a modern Unix or Windows operating system,
-unlike the MERGE-PATHNAMES behavior.
-Also, if either argument is NIL, then the other argument is returned unmodified;
-this is unlike MERGE-PATHNAMES which always merges with a pathname,
-by default *DEFAULT-PATHNAME-DEFAULTS*, which cannot be NIL."
- (when (null specified) (return-from merge-pathnames* defaults))
- (when (null defaults) (return-from merge-pathnames* specified))
- #+scl
- (ext:resolve-pathname specified defaults)
- #-scl
- (let* ((specified (pathname specified))
- (defaults (pathname defaults))
- (directory (normalize-pathname-directory-component (pathname-directory specified)))
- (name (or (pathname-name specified) (pathname-name defaults)))
- (type (or (pathname-type specified) (pathname-type defaults)))
- (version (or (pathname-version specified) (pathname-version defaults))))
- (labels ((unspecific-handler (p)
- (if (typep p 'logical-pathname) #'make-pathname-component-logical #'identity)))
- (multiple-value-bind (host device directory unspecific-handler)
- (ecase (first directory)
- ((:absolute)
- (values (pathname-host specified)
- (pathname-device specified)
- directory
- (unspecific-handler specified)))
- ((nil :relative)
- (values (pathname-host defaults)
- (pathname-device defaults)
- (merge-pathname-directory-components directory (pathname-directory defaults))
- (unspecific-handler defaults))))
- (make-pathname :host host :device device :directory directory
- :name (funcall unspecific-handler name)
- :type (funcall unspecific-handler type)
- :version (funcall unspecific-handler version))))))
-
- (defun logical-pathname-p (x)
- "is X a logical-pathname?"
- (typep x 'logical-pathname))
-
- (defun physical-pathname-p (x)
- "is X a pathname that is not a logical-pathname?"
- (and (pathnamep x) (not (logical-pathname-p x))))
-
- (defun physicalize-pathname (x)
- "if X is a logical pathname, use translate-logical-pathname on it."
- ;; Ought to be the same as translate-logical-pathname, except the latter borks on CLISP
- (let ((p (when x (pathname x))))
- (if (logical-pathname-p p) (translate-logical-pathname p) p)))
-
- (defun nil-pathname (&optional (defaults *default-pathname-defaults*))
- "A pathname that is as neutral as possible for use as defaults
-when merging, making or parsing pathnames"
- ;; 19.2.2.2.1 says a NIL host can mean a default host;
- ;; see also "valid physical pathname host" in the CLHS glossary, that suggests
- ;; strings and lists of strings or :unspecific
- ;; But CMUCL decides to die on NIL.
- ;; MCL has issues with make-pathname, nil and defaulting
- (declare (ignorable defaults))
- #.`(make-pathname :directory nil :name nil :type nil :version nil
- :device (or #+(and mkcl os-unix) :unspecific)
- :host (or #+cmucl lisp::*unix-host* #+(and mkcl os-unix) "localhost")
- #+scl ,@'(:scheme nil :scheme-specific-part nil
- :username nil :password nil :parameters nil :query nil :fragment nil)
- ;; the default shouldn't matter, but we really want something physical
- #-mcl ,@'(:defaults defaults)))
-
- (defvar *nil-pathname* (nil-pathname (physicalize-pathname (user-homedir-pathname)))
- "A pathname that is as neutral as possible for use as defaults
-when merging, making or parsing pathnames")
-
- (defmacro with-pathname-defaults ((&optional defaults) &body body)
- "Execute BODY in a context where the *DEFAULT-PATHNAME-DEFAULTS* is as specified,
-where leaving the defaults NIL or unspecified means a (NIL-PATHNAME), except
-on ABCL, Genera and XCL, where it remains unchanged for it doubles as current-directory."
- `(let ((*default-pathname-defaults*
- ,(or defaults
- #-(or abcl genera xcl) '*nil-pathname*
- #+(or abcl genera xcl) '*default-pathname-defaults*)))
- ,@body)))
-
-
-;;; Some pathname predicates
-(with-upgradability ()
- (defun pathname-equal (p1 p2)
- "Are the two pathnames P1 and P2 reasonably equal in the paths they denote?"
- (when (stringp p1) (setf p1 (pathname p1)))
- (when (stringp p2) (setf p2 (pathname p2)))
- (flet ((normalize-component (x)
- (unless (member x '(nil :unspecific :newest (:relative)) :test 'equal)
- x)))
- (macrolet ((=? (&rest accessors)
- (flet ((frob (x)
- (reduce 'list (cons 'normalize-component accessors)
- :initial-value x :from-end t)))
- `(equal ,(frob 'p1) ,(frob 'p2)))))
- (or (and (null p1) (null p2))
- (and (pathnamep p1) (pathnamep p2)
- (and (=? pathname-host)
- #-(and mkcl os-unix) (=? pathname-device)
- (=? normalize-pathname-directory-component pathname-directory)
- (=? pathname-name)
- (=? pathname-type)
- #-mkcl (=? pathname-version)))))))
-
- (defun absolute-pathname-p (pathspec)
- "If PATHSPEC is a pathname or namestring object that parses as a pathname
-possessing an :ABSOLUTE directory component, return the (parsed) pathname.
-Otherwise return NIL"
- (and pathspec
- (typep pathspec '(or null pathname string))
- (let ((pathname (pathname pathspec)))
- (and (eq :absolute (car (normalize-pathname-directory-component
- (pathname-directory pathname))))
- pathname))))
-
- (defun relative-pathname-p (pathspec)
- "If PATHSPEC is a pathname or namestring object that parses as a pathname
-possessing a :RELATIVE or NIL directory component, return the (parsed) pathname.
-Otherwise return NIL"
- (and pathspec
- (typep pathspec '(or null pathname string))
- (let* ((pathname (pathname pathspec))
- (directory (normalize-pathname-directory-component
- (pathname-directory pathname))))
- (when (or (null directory) (eq :relative (car directory)))
- pathname))))
-
- (defun hidden-pathname-p (pathname)
- "Return a boolean that is true if the pathname is hidden as per Unix style,
-i.e. its name starts with a dot."
- (and pathname (equal (first-char (pathname-name pathname)) #\.)))
-
- (defun file-pathname-p (pathname)
- "Does PATHNAME represent a file, i.e. has a non-null NAME component?
-
-Accepts NIL, a string (converted through PARSE-NAMESTRING) or a PATHNAME.
-
-Note that this does _not_ check to see that PATHNAME points to an
-actually-existing file.
-
-Returns the (parsed) PATHNAME when true"
- (when pathname
- (let ((pathname (pathname pathname)))
- (unless (and (member (pathname-name pathname) '(nil :unspecific "") :test 'equal)
- (member (pathname-type pathname) '(nil :unspecific "") :test 'equal))
- pathname)))))
-
-
-;;; Directory pathnames
-(with-upgradability ()
- (defun pathname-directory-pathname (pathname)
- "Returns a new pathname with same HOST, DEVICE, DIRECTORY as PATHNAME,
-and NIL NAME, TYPE and VERSION components"
- (when pathname
- (make-pathname :name nil :type nil :version nil :defaults pathname)))
-
- (defun pathname-parent-directory-pathname (pathname)
- "Returns a new pathname that corresponds to the parent of the current pathname's directory,
-i.e. removing one level of depth in the DIRECTORY component. e.g. if pathname is
-Unix pathname /foo/bar/baz/file.type then return /foo/bar/"
- (when pathname
- (make-pathname :name nil :type nil :version nil
- :directory (merge-pathname-directory-components
- '(:relative :back) (pathname-directory pathname))
- :defaults pathname)))
-
- (defun directory-pathname-p (pathname)
- "Does PATHNAME represent a directory?
-
-A directory-pathname is a pathname _without_ a filename. The three
-ways that the filename components can be missing are for it to be NIL,
-:UNSPECIFIC or the empty string.
-
-Note that this does _not_ check to see that PATHNAME points to an
-actually-existing directory."
- (when pathname
- ;; I tried using Allegro's excl:file-directory-p, but this cannot be done,
- ;; because it rejects apparently legal pathnames as
- ;; ill-formed. [2014/02/10:rpg]
- (let ((pathname (pathname pathname)))
- (flet ((check-one (x)
- (member x '(nil :unspecific) :test 'equal)))
- (and (not (wild-pathname-p pathname))
- (check-one (pathname-name pathname))
- (check-one (pathname-type pathname))
- t)))))
-
- (defun ensure-directory-pathname (pathspec &optional (on-error 'error))
- "Converts the non-wild pathname designator PATHSPEC to directory form."
- (cond
- ((stringp pathspec)
- (ensure-directory-pathname (pathname pathspec)))
- ((not (pathnamep pathspec))
- (call-function on-error (compatfmt "~@<Invalid pathname designator ~S~@:>") pathspec))
- ((wild-pathname-p pathspec)
- (call-function on-error (compatfmt "~@<Can't reliably convert wild pathname ~3i~_~S~@:>") pathspec))
- ((directory-pathname-p pathspec)
- pathspec)
- (t
- (handler-case
- (make-pathname :directory (append (or (normalize-pathname-directory-component
- (pathname-directory pathspec))
- (list :relative))
- (list (file-namestring pathspec)))
- :name nil :type nil :version nil :defaults pathspec)
- (error (c) (call-function on-error (compatfmt "~@<error while trying to create a directory pathname for ~S: ~A~@:>") pathspec c)))))))
-
-
-;;; Parsing filenames
-(with-upgradability ()
- (declaim (ftype function ensure-pathname)) ; forward reference
-
- (defun split-unix-namestring-directory-components
- (unix-namestring &key ensure-directory dot-dot)
- "Splits the path string UNIX-NAMESTRING, returning four values:
-A flag that is either :absolute or :relative, indicating
- how the rest of the values are to be interpreted.
-A directory path --- a list of strings and keywords, suitable for
- use with MAKE-PATHNAME when prepended with the flag value.
- Directory components with an empty name or the name . are removed.
- Any directory named .. is read as DOT-DOT, or :BACK if it's NIL (not :UP).
-A last-component, either a file-namestring including type extension,
- or NIL in the case of a directory pathname.
-A flag that is true iff the unix-style-pathname was just
- a file-namestring without / path specification.
-ENSURE-DIRECTORY forces the namestring to be interpreted as a directory pathname:
-the third return value will be NIL, and final component of the namestring
-will be treated as part of the directory path.
-
-An empty string is thus read as meaning a pathname object with all fields nil.
-
-Note that colon characters #\: will NOT be interpreted as host specification.
-Absolute pathnames are only appropriate on Unix-style systems.
-
-The intention of this function is to support structured component names,
-e.g., \(:file \"foo/bar\"\), which will be unpacked to relative pathnames."
- (check-type unix-namestring string)
- (check-type dot-dot (member nil :back :up))
- (if (and (not (find #\/ unix-namestring)) (not ensure-directory)
- (plusp (length unix-namestring)))
- (values :relative () unix-namestring t)
- (let* ((components (split-string unix-namestring :separator "/"))
- (last-comp (car (last components))))
- (multiple-value-bind (relative components)
- (if (equal (first components) "")
- (if (equal (first-char unix-namestring) #\/)
- (values :absolute (cdr components))
- (values :relative nil))
- (values :relative components))
- (setf components (remove-if #'(lambda (x) (member x '("" ".") :test #'equal))
- components))
- (setf components (substitute (or dot-dot :back) ".." components :test #'equal))
- (cond
- ((equal last-comp "")
- (values relative components nil nil)) ; "" already removed from components
- (ensure-directory
- (values relative components nil nil))
- (t
- (values relative (butlast components) last-comp nil)))))))
-
- (defun split-name-type (filename)
- "Split a filename into two values NAME and TYPE that are returned.
-We assume filename has no directory component.
-The last . if any separates name and type from from type,
-except that if there is only one . and it is in first position,
-the whole filename is the NAME with an empty type.
-NAME is always a string.
-For an empty type, *UNSPECIFIC-PATHNAME-TYPE* is returned."
- (check-type filename string)
- (assert (plusp (length filename)))
- (destructuring-bind (name &optional (type *unspecific-pathname-type*))
- (split-string filename :max 2 :separator ".")
- (if (equal name "")
- (values filename *unspecific-pathname-type*)
- (values name type))))
-
- (defun parse-unix-namestring (name &rest keys &key type defaults dot-dot ensure-directory
- &allow-other-keys)
- "Coerce NAME into a PATHNAME using standard Unix syntax.
-
-Unix syntax is used whether or not the underlying system is Unix;
-on such non-Unix systems it is reliably usable only for relative pathnames.
-This function is especially useful to manipulate relative pathnames portably,
-where it is of crucial to possess a portable pathname syntax independent of the underlying OS.
-This is what PARSE-UNIX-NAMESTRING provides, and why we use it in ASDF.
-
-When given a PATHNAME object, just return it untouched.
-When given NIL, just return NIL.
-When given a non-null SYMBOL, first downcase its name and treat it as a string.
-When given a STRING, portably decompose it into a pathname as below.
-
-#\\/ separates directory components.
-
-The last #\\/-separated substring is interpreted as follows:
-1- If TYPE is :DIRECTORY or ENSURE-DIRECTORY is true,
- the string is made the last directory component, and NAME and TYPE are NIL.
- if the string is empty, it's the empty pathname with all slots NIL.
-2- If TYPE is NIL, the substring is a file-namestring, and its NAME and TYPE
- are separated by SPLIT-NAME-TYPE.
-3- If TYPE is a string, it is the given TYPE, and the whole string is the NAME.
-
-Directory components with an empty name or the name \".\" are removed.
-Any directory named \"..\" is read as DOT-DOT,
-which must be one of :BACK or :UP and defaults to :BACK.
-
-HOST, DEVICE and VERSION components are taken from DEFAULTS,
-which itself defaults to *NIL-PATHNAME*, also used if DEFAULTS is NIL.
-No host or device can be specified in the string itself,
-which makes it unsuitable for absolute pathnames outside Unix.
-
-For relative pathnames, these components (and hence the defaults) won't matter
-if you use MERGE-PATHNAMES* but will matter if you use MERGE-PATHNAMES,
-which is an important reason to always use MERGE-PATHNAMES*.
-
-Arbitrary keys are accepted, and the parse result is passed to ENSURE-PATHNAME
-with those keys, removing TYPE DEFAULTS and DOT-DOT.
-When you're manipulating pathnames that are supposed to make sense portably
-even though the OS may not be Unixish, we recommend you use :WANT-RELATIVE T
-to throw an error if the pathname is absolute"
- (block nil
- (check-type type (or null string (eql :directory)))
- (when ensure-directory
- (setf type :directory))
- (etypecase name
- ((or null pathname) (return name))
- (symbol
- (setf name (string-downcase name)))
- (string))
- (multiple-value-bind (relative path filename file-only)
- (split-unix-namestring-directory-components
- name :dot-dot dot-dot :ensure-directory (eq type :directory))
- (multiple-value-bind (name type)
- (cond
- ((or (eq type :directory) (null filename))
- (values nil nil))
- (type
- (values filename type))
- (t
- (split-name-type filename)))
- (apply 'ensure-pathname
- (make-pathname
- :directory (unless file-only (cons relative path))
- :name name :type type
- :defaults (or #-mcl defaults *nil-pathname*))
- (remove-plist-keys '(:type :dot-dot :defaults) keys))))))
-
- (defun unix-namestring (pathname)
- "Given a non-wild PATHNAME, return a Unix-style namestring for it.
-If the PATHNAME is NIL or a STRING, return it unchanged.
-
-This only considers the DIRECTORY, NAME and TYPE components of the pathname.
-This is a portable solution for representing relative pathnames,
-But unless you are running on a Unix system, it is not a general solution
-to representing native pathnames.
-
-An error is signaled if the argument is not NULL, a STRING or a PATHNAME,
-or if it is a PATHNAME but some of its components are not recognized."
- (etypecase pathname
- ((or null string) pathname)
- (pathname
- (with-output-to-string (s)
- (flet ((err () (parameter-error "~S: invalid unix-namestring ~S"
- 'unix-namestring pathname)))
- (let* ((dir (normalize-pathname-directory-component (pathname-directory pathname)))
- (name (pathname-name pathname))
- (name (and (not (eq name :unspecific)) name))
- (type (pathname-type pathname))
- (type (and (not (eq type :unspecific)) type)))
- (cond
- ((member dir '(nil :unspecific)))
- ((eq dir '(:relative)) (princ "./" s))
- ((consp dir)
- (destructuring-bind (relabs &rest dirs) dir
- (or (member relabs '(:relative :absolute)) (err))
- (when (eq relabs :absolute) (princ #\/ s))
- (loop :for x :in dirs :do
- (cond
- ((member x '(:back :up)) (princ "../" s))
- ((equal x "") (err))
- ;;((member x '("." "..") :test 'equal) (err))
- ((stringp x) (format s "~A/" x))
- (t (err))))))
- (t (err)))
- (cond
- (name
- (unless (and (stringp name) (or (null type) (stringp type))) (err))
- (format s "~A~@[.~A~]" name type))
- (t
- (or (null type) (err)))))))))))
-
-;;; Absolute and relative pathnames
-(with-upgradability ()
- (defun subpathname (pathname subpath &key type)
- "This function takes a PATHNAME and a SUBPATH and a TYPE.
-If SUBPATH is already a PATHNAME object (not namestring),
-and is an absolute pathname at that, it is returned unchanged;
-otherwise, SUBPATH is turned into a relative pathname with given TYPE
-as per PARSE-UNIX-NAMESTRING with :WANT-RELATIVE T :TYPE TYPE,
-then it is merged with the PATHNAME-DIRECTORY-PATHNAME of PATHNAME."
- (or (and (pathnamep subpath) (absolute-pathname-p subpath))
- (merge-pathnames* (parse-unix-namestring subpath :type type :want-relative t)
- (pathname-directory-pathname pathname))))
-
- (defun subpathname* (pathname subpath &key type)
- "returns NIL if the base pathname is NIL, otherwise like SUBPATHNAME."
- (and pathname
- (subpathname (ensure-directory-pathname pathname) subpath :type type)))
-
- (defun pathname-root (pathname)
- "return the root directory for the host and device of given PATHNAME"
- (make-pathname :directory '(:absolute)
- :name nil :type nil :version nil
- :defaults pathname ;; host device, and on scl, *some*
- ;; scheme-specific parts: port username password, not others:
- . #.(or #+scl '(:parameters nil :query nil :fragment nil))))
-
- (defun pathname-host-pathname (pathname)
- "return a pathname with the same host as given PATHNAME, and all other fields NIL"
- (make-pathname :directory nil
- :name nil :type nil :version nil :device nil
- :defaults pathname ;; host device, and on scl, *some*
- ;; scheme-specific parts: port username password, not others:
- . #.(or #+scl '(:parameters nil :query nil :fragment nil))))
-
- (defun ensure-absolute-pathname (path &optional defaults (on-error 'error))
- "Given a pathname designator PATH, return an absolute pathname as specified by PATH
-considering the DEFAULTS, or, if not possible, use CALL-FUNCTION on the specified ON-ERROR behavior,
-with a format control-string and other arguments as arguments"
- (cond
- ((absolute-pathname-p path))
- ((stringp path) (ensure-absolute-pathname (pathname path) defaults on-error))
- ((not (pathnamep path)) (call-function on-error "not a valid pathname designator ~S" path))
- ((let ((default-pathname (if (pathnamep defaults) defaults (call-function defaults))))
- (or (if (absolute-pathname-p default-pathname)
- (absolute-pathname-p (merge-pathnames* path default-pathname))
- (call-function on-error "Default pathname ~S is not an absolute pathname"
- default-pathname))
- (call-function on-error "Failed to merge ~S with ~S into an absolute pathname"
- path default-pathname))))
- (t (call-function on-error
- "Cannot ensure ~S is evaluated as an absolute pathname with defaults ~S"
- path defaults))))
-
- (defun subpathp (maybe-subpath base-pathname)
- "if MAYBE-SUBPATH is a pathname that is under BASE-PATHNAME, return a pathname object that
-when used with MERGE-PATHNAMES* with defaults BASE-PATHNAME, returns MAYBE-SUBPATH."
- (and (pathnamep maybe-subpath) (pathnamep base-pathname)
- (absolute-pathname-p maybe-subpath) (absolute-pathname-p base-pathname)
- (directory-pathname-p base-pathname) (not (wild-pathname-p base-pathname))
- (pathname-equal (pathname-root maybe-subpath) (pathname-root base-pathname))
- (with-pathname-defaults (*nil-pathname*)
- (let ((enough (enough-namestring maybe-subpath base-pathname)))
- (and (relative-pathname-p enough) (pathname enough))))))
-
- (defun enough-pathname (maybe-subpath base-pathname)
- "if MAYBE-SUBPATH is a pathname that is under BASE-PATHNAME, return a pathname object that
-when used with MERGE-PATHNAMES* with defaults BASE-PATHNAME, returns MAYBE-SUBPATH."
- (let ((sub (when maybe-subpath (pathname maybe-subpath)))
- (base (when base-pathname (ensure-absolute-pathname (pathname base-pathname)))))
- (or (and base (subpathp sub base)) sub)))
-
- (defun call-with-enough-pathname (maybe-subpath defaults-pathname thunk)
- "In a context where *DEFAULT-PATHNAME-DEFAULTS* is bound to DEFAULTS-PATHNAME (if not null,
-or else to its current value), call THUNK with ENOUGH-PATHNAME for MAYBE-SUBPATH
-given DEFAULTS-PATHNAME as a base pathname."
- (let ((enough (enough-pathname maybe-subpath defaults-pathname))
- (*default-pathname-defaults* (or defaults-pathname *default-pathname-defaults*)))
- (funcall thunk enough)))
-
- (defmacro with-enough-pathname ((pathname-var &key (pathname pathname-var)
- (defaults *default-pathname-defaults*))
- &body body)
- "Shorthand syntax for CALL-WITH-ENOUGH-PATHNAME"
- `(call-with-enough-pathname ,pathname ,defaults #'(lambda (,pathname-var) ,@body))))
-
-
-;;; Wildcard pathnames
-(with-upgradability ()
- (defparameter *wild* (or #+cormanlisp "*" :wild)
- "Wild component for use with MAKE-PATHNAME")
- (defparameter *wild-directory-component* (or :wild)
- "Wild directory component for use with MAKE-PATHNAME")
- (defparameter *wild-inferiors-component* (or :wild-inferiors)
- "Wild-inferiors directory component for use with MAKE-PATHNAME")
- (defparameter *wild-file*
- (make-pathname :directory nil :name *wild* :type *wild*
- :version (or #-(or allegro abcl xcl) *wild*))
- "A pathname object with wildcards for matching any file with TRANSLATE-PATHNAME")
- (defparameter *wild-file-for-directory*
- (make-pathname :directory nil :name *wild* :type (or #-(or clisp gcl) *wild*)
- :version (or #-(or allegro abcl clisp gcl xcl) *wild*))
- "A pathname object with wildcards for matching any file with DIRECTORY")
- (defparameter *wild-directory*
- (make-pathname :directory `(:relative ,*wild-directory-component*)
- :name nil :type nil :version nil)
- "A pathname object with wildcards for matching any subdirectory")
- (defparameter *wild-inferiors*
- (make-pathname :directory `(:relative ,*wild-inferiors-component*)
- :name nil :type nil :version nil)
- "A pathname object with wildcards for matching any recursive subdirectory")
- (defparameter *wild-path*
- (merge-pathnames* *wild-file* *wild-inferiors*)
- "A pathname object with wildcards for matching any file in any recursive subdirectory")
-
- (defun wilden (path)
- "From a pathname, return a wildcard pathname matching any file in any subdirectory of given pathname's directory"
- (merge-pathnames* *wild-path* path)))
-
-
-;;; Translate a pathname
-(with-upgradability ()
- (defun relativize-directory-component (directory-component)
- "Given the DIRECTORY-COMPONENT of a pathname, return an otherwise similar relative directory component"
- (let ((directory (normalize-pathname-directory-component directory-component)))
- (cond
- ((stringp directory)
- (list :relative directory))
- ((eq (car directory) :absolute)
- (cons :relative (cdr directory)))
- (t
- directory))))
-
- (defun relativize-pathname-directory (pathspec)
- "Given a PATHNAME, return a relative pathname with otherwise the same components"
- (let ((p (pathname pathspec)))
- (make-pathname
- :directory (relativize-directory-component (pathname-directory p))
- :defaults p)))
-
- (defun directory-separator-for-host (&optional (pathname *default-pathname-defaults*))
- "Given a PATHNAME, return the character used to delimit directory names on this host and device."
- (let ((foo (make-pathname :directory '(:absolute "FOO") :defaults pathname)))
- (last-char (namestring foo))))
-
- #-scl
- (defun directorize-pathname-host-device (pathname)
- "Given a PATHNAME, return a pathname that has representations of its HOST and DEVICE components
-added to its DIRECTORY component. This is useful for output translations."
- (os-cond
- ((os-unix-p)
- (when (physical-pathname-p pathname)
- (return-from directorize-pathname-host-device pathname))))
- (let* ((root (pathname-root pathname))
- (wild-root (wilden root))
- (absolute-pathname (merge-pathnames* pathname root))
- (separator (directory-separator-for-host root))
- (root-namestring (namestring root))
- (root-string
- (substitute-if #\/
- #'(lambda (x) (or (eql x #\:)
- (eql x separator)))
- root-namestring)))
- (multiple-value-bind (relative path filename)
- (split-unix-namestring-directory-components root-string :ensure-directory t)
- (declare (ignore relative filename))
- (let ((new-base (make-pathname :defaults root :directory `(:absolute ,@path))))
- (translate-pathname absolute-pathname wild-root (wilden new-base))))))
-
- #+scl
- (defun directorize-pathname-host-device (pathname)
- (let ((scheme (ext:pathname-scheme pathname))
- (host (pathname-host pathname))
- (port (ext:pathname-port pathname))
- (directory (pathname-directory pathname)))
- (flet ((specificp (x) (and x (not (eq x :unspecific)))))
- (if (or (specificp port)
- (and (specificp host) (plusp (length host)))
- (specificp scheme))
- (let ((prefix ""))
- (when (specificp port)
- (setf prefix (format nil ":~D" port)))
- (when (and (specificp host) (plusp (length host)))
- (setf prefix (strcat host prefix)))
- (setf prefix (strcat ":" prefix))
- (when (specificp scheme)
- (setf prefix (strcat scheme prefix)))
- (assert (and directory (eq (first directory) :absolute)))
- (make-pathname :directory `(:absolute ,prefix ,@(rest directory))
- :defaults pathname)))
- pathname)))
-
- (defun* (translate-pathname*) (path absolute-source destination &optional root source)
- "A wrapper around TRANSLATE-PATHNAME to be used by the ASDF output-translations facility.
-PATH is the pathname to be translated.
-ABSOLUTE-SOURCE is an absolute pathname to use as source for translate-pathname,
-DESTINATION is either a function, to be called with PATH and ABSOLUTE-SOURCE,
-or a relative pathname, to be merged with ROOT and used as destination for translate-pathname
-or an absolute pathname, to be used as destination for translate-pathname.
-In that last case, if ROOT is non-NIL, PATH is first transformated by DIRECTORIZE-PATHNAME-HOST-DEVICE."
- (declare (ignore source))
- (cond
- ((functionp destination)
- (funcall destination path absolute-source))
- ((eq destination t)
- path)
- ((not (pathnamep destination))
- (parameter-error "~S: Invalid destination" 'translate-pathname*))
- ((not (absolute-pathname-p destination))
- (translate-pathname path absolute-source (merge-pathnames* destination root)))
- (root
- (translate-pathname (directorize-pathname-host-device path) absolute-source destination))
- (t
- (translate-pathname path absolute-source destination))))
-
- (defvar *output-translation-function* 'identity
- "Hook for output translations.
-
-This function needs to be idempotent, so that actions can work
-whether their inputs were translated or not,
-which they will be if we are composing operations. e.g. if some
-create-lisp-op creates a lisp file from some higher-level input,
-you need to still be able to use compile-op on that lisp file."))
(DIR) diff --git a/3rdparties/software/uiop-3.3.2/run-program.lisp b/3rdparties/software/uiop-3.3.2/run-program.lisp
@@ -1,578 +0,0 @@
-;;;; -------------------------------------------------------------------------
-;;;; run-program initially from xcvb-driver.
-
-(uiop/package:define-package :uiop/run-program
- (:nicknames :asdf/run-program) ; OBSOLETE. Used by cl-sane, printv.
- (:use :uiop/common-lisp :uiop/package :uiop/utility :uiop/version
- :uiop/pathname :uiop/os :uiop/filesystem :uiop/stream :uiop/launch-program)
- (:export
- #:run-program
- #:slurp-input-stream #:vomit-output-stream
- #:subprocess-error
- #:subprocess-error-code #:subprocess-error-command #:subprocess-error-process)
- (:import-from :uiop/launch-program
- #:%handle-if-does-not-exist #:%handle-if-exists #:%interactivep
- #:input-stream #:output-stream #:error-output-stream))
-(in-package :uiop/run-program)
-
-;;;; Slurping a stream, typically the output of another program
-(with-upgradability ()
- (defun call-stream-processor (fun processor stream)
- "Given FUN (typically SLURP-INPUT-STREAM or VOMIT-OUTPUT-STREAM,
-a PROCESSOR specification which is either an atom or a list specifying
-a processor an keyword arguments, call the specified processor with
-the given STREAM as input"
- (if (consp processor)
- (apply fun (first processor) stream (rest processor))
- (funcall fun processor stream)))
-
- (defgeneric slurp-input-stream (processor input-stream &key)
- (:documentation
- "SLURP-INPUT-STREAM is a generic function with two positional arguments
-PROCESSOR and INPUT-STREAM and additional keyword arguments, that consumes (slurps)
-the contents of the INPUT-STREAM and processes them according to a method
-specified by PROCESSOR.
-
-Built-in methods include the following:
-* if PROCESSOR is a function, it is called with the INPUT-STREAM as its argument
-* if PROCESSOR is a list, its first element should be a function. It will be applied to a cons of the
- INPUT-STREAM and the rest of the list. That is (x . y) will be treated as
- \(APPLY x <stream> y\)
-* if PROCESSOR is an output-stream, the contents of INPUT-STREAM is copied to the output-stream,
- per copy-stream-to-stream, with appropriate keyword arguments.
-* if PROCESSOR is the symbol CL:STRING or the keyword :STRING, then the contents of INPUT-STREAM
- are returned as a string, as per SLURP-STREAM-STRING.
-* if PROCESSOR is the keyword :LINES then the INPUT-STREAM will be handled by SLURP-STREAM-LINES.
-* if PROCESSOR is the keyword :LINE then the INPUT-STREAM will be handled by SLURP-STREAM-LINE.
-* if PROCESSOR is the keyword :FORMS then the INPUT-STREAM will be handled by SLURP-STREAM-FORMS.
-* if PROCESSOR is the keyword :FORM then the INPUT-STREAM will be handled by SLURP-STREAM-FORM.
-* if PROCESSOR is T, it is treated the same as *standard-output*. If it is NIL, NIL is returned.
-
-Programmers are encouraged to define their own methods for this generic function."))
-
- #-genera
- (defmethod slurp-input-stream ((function function) input-stream &key)
- (funcall function input-stream))
-
- (defmethod slurp-input-stream ((list cons) input-stream &key)
- (apply (first list) input-stream (rest list)))
-
- #-genera
- (defmethod slurp-input-stream ((output-stream stream) input-stream
- &key linewise prefix (element-type 'character) buffer-size)
- (copy-stream-to-stream
- input-stream output-stream
- :linewise linewise :prefix prefix :element-type element-type :buffer-size buffer-size))
-
- (defmethod slurp-input-stream ((x (eql 'string)) stream &key stripped)
- (slurp-stream-string stream :stripped stripped))
-
- (defmethod slurp-input-stream ((x (eql :string)) stream &key stripped)
- (slurp-stream-string stream :stripped stripped))
-
- (defmethod slurp-input-stream ((x (eql :lines)) stream &key count)
- (slurp-stream-lines stream :count count))
-
- (defmethod slurp-input-stream ((x (eql :line)) stream &key (at 0))
- (slurp-stream-line stream :at at))
-
- (defmethod slurp-input-stream ((x (eql :forms)) stream &key count)
- (slurp-stream-forms stream :count count))
-
- (defmethod slurp-input-stream ((x (eql :form)) stream &key (at 0))
- (slurp-stream-form stream :at at))
-
- (defmethod slurp-input-stream ((x (eql t)) stream &rest keys &key &allow-other-keys)
- (apply 'slurp-input-stream *standard-output* stream keys))
-
- (defmethod slurp-input-stream ((x null) (stream t) &key)
- nil)
-
- (defmethod slurp-input-stream ((pathname pathname) input
- &key
- (element-type *default-stream-element-type*)
- (external-format *utf-8-external-format*)
- (if-exists :rename-and-delete)
- (if-does-not-exist :create)
- buffer-size
- linewise)
- (with-output-file (output pathname
- :element-type element-type
- :external-format external-format
- :if-exists if-exists
- :if-does-not-exist if-does-not-exist)
- (copy-stream-to-stream
- input output
- :element-type element-type :buffer-size buffer-size :linewise linewise)))
-
- (defmethod slurp-input-stream (x stream
- &key linewise prefix (element-type 'character) buffer-size)
- (declare (ignorable stream linewise prefix element-type buffer-size))
- (cond
- #+genera
- ((functionp x) (funcall x stream))
- #+genera
- ((output-stream-p x)
- (copy-stream-to-stream
- stream x
- :linewise linewise :prefix prefix :element-type element-type :buffer-size buffer-size))
- (t
- (parameter-error "Invalid ~S destination ~S" 'slurp-input-stream x)))))
-
-;;;; Vomiting a stream, typically into the input of another program.
-(with-upgradability ()
- (defgeneric vomit-output-stream (processor output-stream &key)
- (:documentation
- "VOMIT-OUTPUT-STREAM is a generic function with two positional arguments
-PROCESSOR and OUTPUT-STREAM and additional keyword arguments, that produces (vomits)
-some content onto the OUTPUT-STREAM, according to a method specified by PROCESSOR.
-
-Built-in methods include the following:
-* if PROCESSOR is a function, it is called with the OUTPUT-STREAM as its argument
-* if PROCESSOR is a list, its first element should be a function.
- It will be applied to a cons of the OUTPUT-STREAM and the rest of the list.
- That is (x . y) will be treated as \(APPLY x <stream> y\)
-* if PROCESSOR is an input-stream, its contents will be copied the OUTPUT-STREAM,
- per copy-stream-to-stream, with appropriate keyword arguments.
-* if PROCESSOR is a string, its contents will be printed to the OUTPUT-STREAM.
-* if PROCESSOR is T, it is treated the same as *standard-input*. If it is NIL, nothing is done.
-
-Programmers are encouraged to define their own methods for this generic function."))
-
- #-genera
- (defmethod vomit-output-stream ((function function) output-stream &key)
- (funcall function output-stream))
-
- (defmethod vomit-output-stream ((list cons) output-stream &key)
- (apply (first list) output-stream (rest list)))
-
- #-genera
- (defmethod vomit-output-stream ((input-stream stream) output-stream
- &key linewise prefix (element-type 'character) buffer-size)
- (copy-stream-to-stream
- input-stream output-stream
- :linewise linewise :prefix prefix :element-type element-type :buffer-size buffer-size))
-
- (defmethod vomit-output-stream ((x string) stream &key fresh-line terpri)
- (princ x stream)
- (when fresh-line (fresh-line stream))
- (when terpri (terpri stream))
- (values))
-
- (defmethod vomit-output-stream ((x (eql t)) stream &rest keys &key &allow-other-keys)
- (apply 'vomit-output-stream *standard-input* stream keys))
-
- (defmethod vomit-output-stream ((x null) (stream t) &key)
- (values))
-
- (defmethod vomit-output-stream ((pathname pathname) input
- &key
- (element-type *default-stream-element-type*)
- (external-format *utf-8-external-format*)
- (if-exists :rename-and-delete)
- (if-does-not-exist :create)
- buffer-size
- linewise)
- (with-output-file (output pathname
- :element-type element-type
- :external-format external-format
- :if-exists if-exists
- :if-does-not-exist if-does-not-exist)
- (copy-stream-to-stream
- input output
- :element-type element-type :buffer-size buffer-size :linewise linewise)))
-
- (defmethod vomit-output-stream (x stream
- &key linewise prefix (element-type 'character) buffer-size)
- (declare (ignorable stream linewise prefix element-type buffer-size))
- (cond
- #+genera
- ((functionp x) (funcall x stream))
- #+genera
- ((input-stream-p x)
- (copy-stream-to-stream
- x stream
- :linewise linewise :prefix prefix :element-type element-type :buffer-size buffer-size))
- (t
- (parameter-error "Invalid ~S source ~S" 'vomit-output-stream x)))))
-
-
-;;;; Run-program: synchronously run a program in a subprocess, handling input, output and error-output.
-(with-upgradability ()
- (define-condition subprocess-error (error)
- ((code :initform nil :initarg :code :reader subprocess-error-code)
- (command :initform nil :initarg :command :reader subprocess-error-command)
- (process :initform nil :initarg :process :reader subprocess-error-process))
- (:report (lambda (condition stream)
- (format stream "Subprocess ~@[~S~% ~]~@[with command ~S~% ~]exited with error~@[ code ~D~]"
- (subprocess-error-process condition)
- (subprocess-error-command condition)
- (subprocess-error-code condition)))))
-
- (defun %check-result (exit-code &key command process ignore-error-status)
- (unless ignore-error-status
- (unless (eql exit-code 0)
- (cerror "IGNORE-ERROR-STATUS"
- 'subprocess-error :command command :code exit-code :process process)))
- exit-code)
-
- (defun %active-io-specifier-p (specifier)
- "Determines whether a run-program I/O specifier requires Lisp-side processing
-via SLURP-INPUT-STREAM or VOMIT-OUTPUT-STREAM (return T),
-or whether it's already taken care of by the implementation's underlying run-program."
- (not (typep specifier '(or null string pathname (member :interactive :output)
- #+(or cmucl (and sbcl os-unix) scl) (or stream (eql t))
- #+lispworks file-stream))))
-
- (defun %run-program (command &rest keys &key &allow-other-keys)
- "DEPRECATED. Use LAUNCH-PROGRAM instead."
- (apply 'launch-program command keys))
-
- (defun %call-with-program-io (gf tval stream-easy-p fun direction spec activep returner
- &key
- (element-type #-clozure *default-stream-element-type* #+clozure 'character)
- (external-format *utf-8-external-format*) &allow-other-keys)
- ;; handle redirection for run-program and system
- ;; SPEC is the specification for the subprocess's input or output or error-output
- ;; TVAL is the value used if the spec is T
- ;; GF is the generic function to call to handle arbitrary values of SPEC
- ;; STREAM-EASY-P is T if we're going to use a RUN-PROGRAM that copies streams in the background
- ;; (it's only meaningful on CMUCL, SBCL, SCL that actually do it)
- ;; DIRECTION is :INPUT, :OUTPUT or :ERROR-OUTPUT for the direction of this io argument
- ;; FUN is a function of the new reduced spec and an activity function to call with a stream
- ;; when the subprocess is active and communicating through that stream.
- ;; ACTIVEP is a boolean true if we will get to run code while the process is running
- ;; ELEMENT-TYPE and EXTERNAL-FORMAT control what kind of temporary file we may open.
- ;; RETURNER is a function called with the value of the activity.
- ;; --- TODO (fare@tunes.org): handle if-output-exists and such when doing it the hard way.
- (declare (ignorable stream-easy-p))
- (let* ((actual-spec (if (eq spec t) tval spec))
- (activity-spec (if (eq actual-spec :output)
- (ecase direction
- ((:input :output)
- (parameter-error "~S does not allow ~S as a ~S spec"
- 'run-program :output direction))
- ((:error-output)
- nil))
- actual-spec)))
- (labels ((activity (stream)
- (call-function returner (call-stream-processor gf activity-spec stream)))
- (easy-case ()
- (funcall fun actual-spec nil))
- (hard-case ()
- (if activep
- (funcall fun :stream #'activity)
- (with-temporary-file (:pathname tmp)
- (ecase direction
- (:input
- (with-output-file (s tmp :if-exists :overwrite
- :external-format external-format
- :element-type element-type)
- (activity s))
- (funcall fun tmp nil))
- ((:output :error-output)
- (multiple-value-prog1 (funcall fun tmp nil)
- (with-input-file (s tmp
- :external-format external-format
- :element-type element-type)
- (activity s)))))))))
- (typecase activity-spec
- ((or null string pathname (eql :interactive))
- (easy-case))
- #+(or cmucl (and sbcl os-unix) scl) ;; streams are only easy on implementations that try very hard
- (stream
- (if stream-easy-p (easy-case) (hard-case)))
- (t
- (hard-case))))))
-
- (defmacro place-setter (place)
- (when place
- (let ((value (gensym)))
- `#'(lambda (,value) (setf ,place ,value)))))
-
- (defmacro with-program-input (((reduced-input-var
- &optional (input-activity-var (gensym) iavp))
- input-form &key setf stream-easy-p active keys) &body body)
- `(apply '%call-with-program-io 'vomit-output-stream *standard-input* ,stream-easy-p
- #'(lambda (,reduced-input-var ,input-activity-var)
- ,@(unless iavp `((declare (ignore ,input-activity-var))))
- ,@body)
- :input ,input-form ,active (place-setter ,setf) ,keys))
-
- (defmacro with-program-output (((reduced-output-var
- &optional (output-activity-var (gensym) oavp))
- output-form &key setf stream-easy-p active keys) &body body)
- `(apply '%call-with-program-io 'slurp-input-stream *standard-output* ,stream-easy-p
- #'(lambda (,reduced-output-var ,output-activity-var)
- ,@(unless oavp `((declare (ignore ,output-activity-var))))
- ,@body)
- :output ,output-form ,active (place-setter ,setf) ,keys))
-
- (defmacro with-program-error-output (((reduced-error-output-var
- &optional (error-output-activity-var (gensym) eoavp))
- error-output-form &key setf stream-easy-p active keys)
- &body body)
- `(apply '%call-with-program-io 'slurp-input-stream *error-output* ,stream-easy-p
- #'(lambda (,reduced-error-output-var ,error-output-activity-var)
- ,@(unless eoavp `((declare (ignore ,error-output-activity-var))))
- ,@body)
- :error-output ,error-output-form ,active (place-setter ,setf) ,keys))
-
- (defun %use-launch-program (command &rest keys
- &key input output error-output ignore-error-status &allow-other-keys)
- ;; helper for RUN-PROGRAM when using LAUNCH-PROGRAM
- #+(or cormanlisp gcl (and lispworks os-windows) mcl xcl)
- (progn
- command keys input output error-output ignore-error-status ;; ignore
- (not-implemented-error '%use-launch-program))
- (when (member :stream (list input output error-output))
- (parameter-error "~S: ~S is not allowed as synchronous I/O redirection argument"
- 'run-program :stream))
- (let* ((active-input-p (%active-io-specifier-p input))
- (active-output-p (%active-io-specifier-p output))
- (active-error-output-p (%active-io-specifier-p error-output))
- (activity
- (cond
- (active-output-p :output)
- (active-input-p :input)
- (active-error-output-p :error-output)
- (t nil)))
- output-result error-output-result exit-code process-info)
- (with-program-output ((reduced-output output-activity)
- output :keys keys :setf output-result
- :stream-easy-p t :active (eq activity :output))
- (with-program-error-output ((reduced-error-output error-output-activity)
- error-output :keys keys :setf error-output-result
- :stream-easy-p t :active (eq activity :error-output))
- (with-program-input ((reduced-input input-activity)
- input :keys keys
- :stream-easy-p t :active (eq activity :input))
- (setf process-info
- (apply 'launch-program command
- :input reduced-input :output reduced-output
- :error-output (if (eq error-output :output) :output reduced-error-output)
- keys))
- (labels ((get-stream (stream-name &optional fallbackp)
- (or (slot-value process-info stream-name)
- (when fallbackp
- (slot-value process-info 'bidir-stream))))
- (run-activity (activity stream-name &optional fallbackp)
- (if-let (stream (get-stream stream-name fallbackp))
- (funcall activity stream)
- (error 'subprocess-error
- :code `(:missing ,stream-name)
- :command command :process process-info))))
- (unwind-protect
- (ecase activity
- ((nil))
- (:input (run-activity input-activity 'input-stream t))
- (:output (run-activity output-activity 'output-stream t))
- (:error-output (run-activity error-output-activity 'error-output-stream)))
- (close-streams process-info)
- (setf exit-code (wait-process process-info)))))))
- (%check-result exit-code
- :command command :process process-info
- :ignore-error-status ignore-error-status)
- (values output-result error-output-result exit-code)))
-
- (defun %normalize-system-command (command) ;; helper for %USE-SYSTEM
- (etypecase command
- (string command)
- (list (escape-shell-command
- (os-cond
- ((os-unix-p) (cons "exec" command))
- (t command))))))
-
- (defun %redirected-system-command (command in out err directory) ;; helper for %USE-SYSTEM
- (flet ((redirect (spec operator)
- (let ((pathname
- (typecase spec
- (null (null-device-pathname))
- (string (parse-native-namestring spec))
- (pathname spec)
- ((eql :output)
- (unless (equal operator " 2>>")
- (parameter-error "~S: only the ~S argument can be ~S"
- 'run-program :error-output :output))
- (return-from redirect '(" 2>&1"))))))
- (when pathname
- (list operator " "
- (escape-shell-token (native-namestring pathname)))))))
- (let* ((redirections (append (redirect in " <") (redirect out " >>") (redirect err " 2>>")))
- (normalized (%normalize-system-command command))
- (directory (or directory #+(or abcl xcl) (getcwd)))
- (chdir (when directory
- (let ((dir-arg (escape-shell-token (native-namestring directory))))
- (os-cond
- ((os-unix-p) `("cd " ,dir-arg " ; "))
- ((os-windows-p) `("cd /d " ,dir-arg " & ")))))))
- (reduce/strcat
- (os-cond
- ((os-unix-p) `(,@(when redirections `("exec " ,@redirections " ; ")) ,@chdir ,normalized))
- ((os-windows-p) `(,@redirections " (" ,@chdir ,normalized ")")))))))
-
- (defun %system (command &rest keys &key directory
- input (if-input-does-not-exist :error)
- output (if-output-exists :supersede)
- error-output (if-error-output-exists :supersede)
- &allow-other-keys)
- "A portable abstraction of a low-level call to libc's system()."
- (declare (ignorable keys directory input if-input-does-not-exist output
- if-output-exists error-output if-error-output-exists))
- (when (member :stream (list input output error-output))
- (parameter-error "~S: ~S is not allowed as synchronous I/O redirection argument"
- 'run-program :stream))
- #+(or abcl allegro clozure cmucl ecl (and lispworks os-unix) mkcl sbcl scl)
- (let (#+(or abcl ecl mkcl)
- (version (parse-version
- #-abcl
- (lisp-implementation-version)
- #+abcl
- (second (split-string (implementation-identifier) :separator '(#\-))))))
- (nest
- #+abcl (unless (lexicographic< '< version '(1 4 0)))
- #+ecl (unless (lexicographic<= '< version '(16 0 0)))
- #+mkcl (unless (lexicographic<= '< version '(1 1 9)))
- (return-from %system
- (wait-process
- (apply 'launch-program (%normalize-system-command command) keys)))))
- #+(or abcl clasp clisp cormanlisp ecl gcl genera (and lispworks os-windows) mkcl xcl)
- (let ((%command (%redirected-system-command command input output error-output directory)))
- ;; see comments for these functions
- (%handle-if-does-not-exist input if-input-does-not-exist)
- (%handle-if-exists output if-output-exists)
- (%handle-if-exists error-output if-error-output-exists)
- #+abcl (ext:run-shell-command %command)
- #+(or clasp ecl) (let ((*standard-input* *stdin*)
- (*standard-output* *stdout*)
- (*error-output* *stderr*))
- (ext:system %command))
- #+clisp
- (let ((raw-exit-code
- (or
- #.`(#+os-windows ,@'(ext:run-shell-command %command)
- #+os-unix ,@'(ext:run-program "/bin/sh" :arguments `("-c" ,%command))
- :wait t :input :terminal :output :terminal)
- 0)))
- (if (minusp raw-exit-code)
- (- 128 raw-exit-code)
- raw-exit-code))
- #+cormanlisp (win32:system %command)
- #+gcl (system:system %command)
- #+genera (not-implemented-error '%system)
- #+(and lispworks os-windows)
- (system:call-system %command :current-directory directory :wait t)
- #+mcl (ccl::with-cstrs ((%%command %command)) (_system %%command))
- #+mkcl (mkcl:system %command)
- #+xcl (system:%run-shell-command %command)))
-
- (defun %use-system (command &rest keys
- &key input output error-output ignore-error-status &allow-other-keys)
- ;; helper for RUN-PROGRAM when using %system
- (let (output-result error-output-result exit-code)
- (with-program-output ((reduced-output)
- output :keys keys :setf output-result)
- (with-program-error-output ((reduced-error-output)
- error-output :keys keys :setf error-output-result)
- (with-program-input ((reduced-input) input :keys keys)
- (setf exit-code (apply '%system command
- :input reduced-input :output reduced-output
- :error-output reduced-error-output keys)))))
- (%check-result exit-code
- :command command
- :ignore-error-status ignore-error-status)
- (values output-result error-output-result exit-code)))
-
- (defun run-program (command &rest keys
- &key ignore-error-status (force-shell nil force-shell-suppliedp)
- input (if-input-does-not-exist :error)
- output (if-output-exists :supersede)
- error-output (if-error-output-exists :supersede)
- (element-type #-clozure *default-stream-element-type* #+clozure 'character)
- (external-format *utf-8-external-format*)
- &allow-other-keys)
- "Run program specified by COMMAND,
-either a list of strings specifying a program and list of arguments,
-or a string specifying a shell command (/bin/sh on Unix, CMD.EXE on Windows);
-_synchronously_ process its output as specified and return the processing results
-when the program and its output processing are complete.
-
-Always call a shell (rather than directly execute the command when possible)
-if FORCE-SHELL is specified. Similarly, never call a shell if FORCE-SHELL is
-specified to be NIL.
-
-Signal a continuable SUBPROCESS-ERROR if the process wasn't successful (exit-code 0),
-unless IGNORE-ERROR-STATUS is specified.
-
-If OUTPUT is a pathname, a string designating a pathname, or NIL (the default)
-designating the null device, the file at that path is used as output.
-If it's :INTERACTIVE, output is inherited from the current process;
-beware that this may be different from your *STANDARD-OUTPUT*,
-and under SLIME will be on your *inferior-lisp* buffer.
-If it's T, output goes to your current *STANDARD-OUTPUT* stream.
-Otherwise, OUTPUT should be a value that is a suitable first argument to
-SLURP-INPUT-STREAM (qv.), or a list of such a value and keyword arguments.
-In this case, RUN-PROGRAM will create a temporary stream for the program output;
-the program output, in that stream, will be processed by a call to SLURP-INPUT-STREAM,
-using OUTPUT as the first argument (or the first element of OUTPUT, and the rest as keywords).
-The primary value resulting from that call (or NIL if no call was needed)
-will be the first value returned by RUN-PROGRAM.
-E.g., using :OUTPUT :STRING will have it return the entire output stream as a string.
-And using :OUTPUT '(:STRING :STRIPPED T) will have it return the same string
-stripped of any ending newline.
-
-IF-OUTPUT-EXISTS, which is only meaningful if OUTPUT is a string or a
-pathname, can take the values :ERROR, :APPEND, and :SUPERSEDE (the
-default). The meaning of these values and their effect on the case
-where OUTPUT does not exist, is analogous to the IF-EXISTS parameter
-to OPEN with :DIRECTION :OUTPUT.
-
-ERROR-OUTPUT is similar to OUTPUT, except that the resulting value is returned
-as the second value of RUN-PROGRAM. T designates the *ERROR-OUTPUT*.
-Also :OUTPUT means redirecting the error output to the output stream,
-in which case NIL is returned.
-
-IF-ERROR-OUTPUT-EXISTS is similar to IF-OUTPUT-EXIST, except that it
-affects ERROR-OUTPUT rather than OUTPUT.
-
-INPUT is similar to OUTPUT, except that VOMIT-OUTPUT-STREAM is used,
-no value is returned, and T designates the *STANDARD-INPUT*.
-
-IF-INPUT-DOES-NOT-EXIST, which is only meaningful if INPUT is a string
-or a pathname, can take the values :CREATE and :ERROR (the
-default). The meaning of these values is analogous to the
-IF-DOES-NOT-EXIST parameter to OPEN with :DIRECTION :INPUT.
-
-ELEMENT-TYPE and EXTERNAL-FORMAT are passed on
-to your Lisp implementation, when applicable, for creation of the output stream.
-
-One and only one of the stream slurping or vomiting may or may not happen
-in parallel in parallel with the subprocess,
-depending on options and implementation,
-and with priority being given to output processing.
-Other streams are completely produced or consumed
-before or after the subprocess is spawned, using temporary files.
-
-RUN-PROGRAM returns 3 values:
-0- the result of the OUTPUT slurping if any, or NIL
-1- the result of the ERROR-OUTPUT slurping if any, or NIL
-2- either 0 if the subprocess exited with success status,
-or an indication of failure via the EXIT-CODE of the process"
- (declare (ignorable input output error-output if-input-does-not-exist if-output-exists
- if-error-output-exists element-type external-format ignore-error-status))
- #-(or abcl allegro clasp clisp clozure cmucl cormanlisp ecl gcl lispworks mcl mkcl sbcl scl xcl)
- (not-implemented-error 'run-program)
- (apply (if (or force-shell
- ;; Per doc string, set FORCE-SHELL to T if we get command as a string.
- ;; But don't override user's specified preference. [2015/06/29:rpg]
- (and (stringp command)
- (or (not force-shell-suppliedp)
- #-(or allegro clisp clozure sbcl) (os-cond ((os-windows-p) t))))
- #+(or clasp clisp cormanlisp gcl (and lispworks os-windows) mcl xcl) t
- ;; A race condition in ECL <= 16.0.0 prevents using ext:run-program
- #+ecl #.(if-let (ver (parse-version (lisp-implementation-version)))
- (lexicographic<= '< ver '(16 0 0)))
- #+(and lispworks os-unix) (%interactivep input output error-output))
- '%use-system '%use-launch-program)
- command keys)))
-
(DIR) diff --git a/3rdparties/software/uiop-3.3.2/stream.lisp b/3rdparties/software/uiop-3.3.2/stream.lisp
@@ -1,718 +0,0 @@
-;;;; ---------------------------------------------------------------------------
-;;;; Utilities related to streams
-
-(uiop/package:define-package :uiop/stream
- (:use :uiop/common-lisp :uiop/package :uiop/utility :uiop/os :uiop/pathname :uiop/filesystem)
- (:export
- #:*default-stream-element-type*
- #:*stdin* #:setup-stdin #:*stdout* #:setup-stdout #:*stderr* #:setup-stderr
- #:detect-encoding #:*encoding-detection-hook* #:always-default-encoding
- #:encoding-external-format #:*encoding-external-format-hook* #:default-encoding-external-format
- #:*default-encoding* #:*utf-8-external-format*
- #:with-safe-io-syntax #:call-with-safe-io-syntax #:safe-read-from-string
- #:with-output #:output-string #:with-input #:input-string
- #:with-input-file #:call-with-input-file #:with-output-file #:call-with-output-file
- #:null-device-pathname #:call-with-null-input #:with-null-input
- #:call-with-null-output #:with-null-output
- #:finish-outputs #:format! #:safe-format!
- #:copy-stream-to-stream #:concatenate-files #:copy-file
- #:slurp-stream-string #:slurp-stream-lines #:slurp-stream-line
- #:slurp-stream-forms #:slurp-stream-form
- #:read-file-string #:read-file-line #:read-file-lines #:safe-read-file-line
- #:read-file-forms #:read-file-form #:safe-read-file-form
- #:eval-input #:eval-thunk #:standard-eval-thunk
- #:println #:writeln
- #:file-stream-p #:file-or-synonym-stream-p
- ;; Temporary files
- #:*temporary-directory* #:temporary-directory #:default-temporary-directory
- #:setup-temporary-directory
- #:call-with-temporary-file #:with-temporary-file
- #:add-pathname-suffix #:tmpize-pathname
- #:call-with-staging-pathname #:with-staging-pathname))
-(in-package :uiop/stream)
-
-(with-upgradability ()
- (defvar *default-stream-element-type*
- (or #+(or abcl cmucl cormanlisp scl xcl) 'character
- #+lispworks 'lw:simple-char
- :default)
- "default element-type for open (depends on the current CL implementation)")
-
- (defvar *stdin* *standard-input*
- "the original standard input stream at startup")
-
- (defun setup-stdin ()
- (setf *stdin*
- #.(or #+clozure 'ccl::*stdin*
- #+(or cmucl scl) 'system:*stdin*
- #+(or clasp ecl) 'ext::+process-standard-input+
- #+sbcl 'sb-sys:*stdin*
- '*standard-input*)))
-
- (defvar *stdout* *standard-output*
- "the original standard output stream at startup")
-
- (defun setup-stdout ()
- (setf *stdout*
- #.(or #+clozure 'ccl::*stdout*
- #+(or cmucl scl) 'system:*stdout*
- #+(or clasp ecl) 'ext::+process-standard-output+
- #+sbcl 'sb-sys:*stdout*
- '*standard-output*)))
-
- (defvar *stderr* *error-output*
- "the original error output stream at startup")
-
- (defun setup-stderr ()
- (setf *stderr*
- #.(or #+allegro 'excl::*stderr*
- #+clozure 'ccl::*stderr*
- #+(or cmucl scl) 'system:*stderr*
- #+(or clasp ecl) 'ext::+process-error-output+
- #+sbcl 'sb-sys:*stderr*
- '*error-output*)))
-
- ;; Run them now. In image.lisp, we'll register them to be run at image restart.
- (setup-stdin) (setup-stdout) (setup-stderr))
-
-
-;;; Encodings (mostly hooks only; full support requires asdf-encodings)
-(with-upgradability ()
- (defparameter *default-encoding*
- ;; preserve explicit user changes to something other than the legacy default :default
- (or (if-let (previous (and (boundp '*default-encoding*) (symbol-value '*default-encoding*)))
- (unless (eq previous :default) previous))
- :utf-8)
- "Default encoding for source files.
-The default value :utf-8 is the portable thing.
-The legacy behavior was :default.
-If you (asdf:load-system :asdf-encodings) then
-you will have autodetection via *encoding-detection-hook* below,
-reading emacs-style -*- coding: utf-8 -*- specifications,
-and falling back to utf-8 or latin1 if nothing is specified.")
-
- (defparameter *utf-8-external-format*
- (if (featurep :asdf-unicode)
- (or #+clisp charset:utf-8 :utf-8)
- :default)
- "Default :external-format argument to pass to CL:OPEN and also
-CL:LOAD or CL:COMPILE-FILE to best process a UTF-8 encoded file.
-On modern implementations, this will decode UTF-8 code points as CL characters.
-On legacy implementations, it may fall back on some 8-bit encoding,
-with non-ASCII code points being read as several CL characters;
-hopefully, if done consistently, that won't affect program behavior too much.")
-
- (defun always-default-encoding (pathname)
- "Trivial function to use as *encoding-detection-hook*,
-always 'detects' the *default-encoding*"
- (declare (ignore pathname))
- *default-encoding*)
-
- (defvar *encoding-detection-hook* #'always-default-encoding
- "Hook for an extension to define a function to automatically detect a file's encoding")
-
- (defun detect-encoding (pathname)
- "Detects the encoding of a specified file, going through user-configurable hooks"
- (if (and pathname (not (directory-pathname-p pathname)) (probe-file* pathname))
- (funcall *encoding-detection-hook* pathname)
- *default-encoding*))
-
- (defun default-encoding-external-format (encoding)
- "Default, ignorant, function to transform a character ENCODING as a
-portable keyword to an implementation-dependent EXTERNAL-FORMAT specification.
-Load system ASDF-ENCODINGS to hook in a better one."
- (case encoding
- (:default :default) ;; for backward-compatibility only. Explicit usage discouraged.
- (:utf-8 *utf-8-external-format*)
- (otherwise
- (cerror "Continue using :external-format :default" (compatfmt "~@<Your ASDF component is using encoding ~S but it isn't recognized. Your system should :defsystem-depends-on (:asdf-encodings).~:>") encoding)
- :default)))
-
- (defvar *encoding-external-format-hook*
- #'default-encoding-external-format
- "Hook for an extension (e.g. ASDF-ENCODINGS) to define a better mapping
-from non-default encodings to and implementation-defined external-format's")
-
- (defun encoding-external-format (encoding)
- "Transform a portable ENCODING keyword to an implementation-dependent EXTERNAL-FORMAT,
-going through all the proper hooks."
- (funcall *encoding-external-format-hook* (or encoding *default-encoding*))))
-
-
-;;; Safe syntax
-(with-upgradability ()
- (defvar *standard-readtable* (with-standard-io-syntax *readtable*)
- "The standard readtable, implementing the syntax specified by the CLHS.
-It must never be modified, though only good implementations will even enforce that.")
-
- (defmacro with-safe-io-syntax ((&key (package :cl)) &body body)
- "Establish safe CL reader options around the evaluation of BODY"
- `(call-with-safe-io-syntax #'(lambda () (let ((*package* (find-package ,package))) ,@body))))
-
- (defun call-with-safe-io-syntax (thunk &key (package :cl))
- (with-standard-io-syntax
- (let ((*package* (find-package package))
- (*read-default-float-format* 'double-float)
- (*print-readably* nil)
- (*read-eval* nil))
- (funcall thunk))))
-
- (defun safe-read-from-string (string &key (package :cl) (eof-error-p t) eof-value (start 0) end preserve-whitespace)
- "Read from STRING using a safe syntax, as per WITH-SAFE-IO-SYNTAX"
- (with-safe-io-syntax (:package package)
- (read-from-string string eof-error-p eof-value :start start :end end :preserve-whitespace preserve-whitespace))))
-
-;;; Output helpers
-(with-upgradability ()
- (defun call-with-output-file (pathname thunk
- &key
- (element-type *default-stream-element-type*)
- (external-format *utf-8-external-format*)
- (if-exists :error)
- (if-does-not-exist :create))
- "Open FILE for input with given recognizes options, call THUNK with the resulting stream.
-Other keys are accepted but discarded."
- (with-open-file (s pathname :direction :output
- :element-type element-type
- :external-format external-format
- :if-exists if-exists
- :if-does-not-exist if-does-not-exist)
- (funcall thunk s)))
-
- (defmacro with-output-file ((var pathname &rest keys
- &key element-type external-format if-exists if-does-not-exist)
- &body body)
- (declare (ignore element-type external-format if-exists if-does-not-exist))
- `(call-with-output-file ,pathname #'(lambda (,var) ,@body) ,@keys))
-
- (defun call-with-output (output function &key keys)
- "Calls FUNCTION with an actual stream argument,
-behaving like FORMAT with respect to how stream designators are interpreted:
-If OUTPUT is a STREAM, use it as the stream.
-If OUTPUT is NIL, use a STRING-OUTPUT-STREAM as the stream, and return the resulting string.
-If OUTPUT is T, use *STANDARD-OUTPUT* as the stream.
-If OUTPUT is a STRING with a fill-pointer, use it as a string-output-stream.
-If OUTPUT is a PATHNAME, open the file and write to it, passing KEYS to WITH-OUTPUT-FILE
--- this latter as an extension since ASDF 3.1.
-Otherwise, signal an error."
- (etypecase output
- (null
- (with-output-to-string (stream) (funcall function stream)))
- ((eql t)
- (funcall function *standard-output*))
- (stream
- (funcall function output))
- (string
- (assert (fill-pointer output))
- (with-output-to-string (stream output) (funcall function stream)))
- (pathname
- (apply 'call-with-output-file output function keys))))
-
- (defmacro with-output ((output-var &optional (value output-var)) &body body)
- "Bind OUTPUT-VAR to an output stream, coercing VALUE (default: previous binding of OUTPUT-VAR)
-as per FORMAT, and evaluate BODY within the scope of this binding."
- `(call-with-output ,value #'(lambda (,output-var) ,@body)))
-
- (defun output-string (string &optional output)
- "If the desired OUTPUT is not NIL, print the string to the output; otherwise return the string"
- (if output
- (with-output (output) (princ string output))
- string)))
-
-
-;;; Input helpers
-(with-upgradability ()
- (defun call-with-input-file (pathname thunk
- &key
- (element-type *default-stream-element-type*)
- (external-format *utf-8-external-format*)
- (if-does-not-exist :error))
- "Open FILE for input with given recognizes options, call THUNK with the resulting stream.
-Other keys are accepted but discarded."
- (with-open-file (s pathname :direction :input
- :element-type element-type
- :external-format external-format
- :if-does-not-exist if-does-not-exist)
- (funcall thunk s)))
-
- (defmacro with-input-file ((var pathname &rest keys
- &key element-type external-format if-does-not-exist)
- &body body)
- (declare (ignore element-type external-format if-does-not-exist))
- `(call-with-input-file ,pathname #'(lambda (,var) ,@body) ,@keys))
-
- (defun call-with-input (input function &key keys)
- "Calls FUNCTION with an actual stream argument, interpreting
-stream designators like READ, but also coercing strings to STRING-INPUT-STREAM,
-and PATHNAME to FILE-STREAM.
-If INPUT is a STREAM, use it as the stream.
-If INPUT is NIL, use a *STANDARD-INPUT* as the stream.
-If INPUT is T, use *TERMINAL-IO* as the stream.
-If INPUT is a STRING, use it as a string-input-stream.
-If INPUT is a PATHNAME, open it, passing KEYS to WITH-INPUT-FILE
--- the latter is an extension since ASDF 3.1.
-Otherwise, signal an error."
- (etypecase input
- (null (funcall function *standard-input*))
- ((eql t) (funcall function *terminal-io*))
- (stream (funcall function input))
- (string (with-input-from-string (stream input) (funcall function stream)))
- (pathname (apply 'call-with-input-file input function keys))))
-
- (defmacro with-input ((input-var &optional (value input-var)) &body body)
- "Bind INPUT-VAR to an input stream, coercing VALUE (default: previous binding of INPUT-VAR)
-as per CALL-WITH-INPUT, and evaluate BODY within the scope of this binding."
- `(call-with-input ,value #'(lambda (,input-var) ,@body)))
-
- (defun input-string (&optional input)
- "If the desired INPUT is a string, return that string; otherwise slurp the INPUT into a string
-and return that"
- (if (stringp input)
- input
- (with-input (input) (funcall 'slurp-stream-string input)))))
-
-;;; Null device
-(with-upgradability ()
- (defun null-device-pathname ()
- "Pathname to a bit bucket device that discards any information written to it
-and always returns EOF when read from"
- (os-cond
- ((os-unix-p) #p"/dev/null")
- ((os-windows-p) #p"NUL") ;; Q: how many Lisps accept the #p"NUL:" syntax?
- (t (error "No /dev/null on your OS"))))
- (defun call-with-null-input (fun &rest keys &key element-type external-format if-does-not-exist)
- "Call FUN with an input stream from the null device; pass keyword arguments to OPEN."
- (declare (ignore element-type external-format if-does-not-exist))
- (apply 'call-with-input-file (null-device-pathname) fun keys))
- (defmacro with-null-input ((var &rest keys
- &key element-type external-format if-does-not-exist)
- &body body)
- (declare (ignore element-type external-format if-does-not-exist))
- "Evaluate BODY in a context when VAR is bound to an input stream accessing the null device.
-Pass keyword arguments to OPEN."
- `(call-with-null-input #'(lambda (,var) ,@body) ,@keys))
- (defun call-with-null-output (fun
- &key (element-type *default-stream-element-type*)
- (external-format *utf-8-external-format*)
- (if-exists :overwrite)
- (if-does-not-exist :error))
- "Call FUN with an output stream to the null device; pass keyword arguments to OPEN."
- (call-with-output-file
- (null-device-pathname) fun
- :element-type element-type :external-format external-format
- :if-exists if-exists :if-does-not-exist if-does-not-exist))
- (defmacro with-null-output ((var &rest keys
- &key element-type external-format if-does-not-exist if-exists)
- &body body)
- "Evaluate BODY in a context when VAR is bound to an output stream accessing the null device.
-Pass keyword arguments to OPEN."
- (declare (ignore element-type external-format if-exists if-does-not-exist))
- `(call-with-null-output #'(lambda (,var) ,@body) ,@keys)))
-
-;;; Ensure output buffers are flushed
-(with-upgradability ()
- (defun finish-outputs (&rest streams)
- "Finish output on the main output streams as well as any specified one.
-Useful for portably flushing I/O before user input or program exit."
- ;; CCL notably buffers its stream output by default.
- (dolist (s (append streams
- (list *stdout* *stderr* *error-output* *standard-output* *trace-output*
- *debug-io* *terminal-io* *query-io*)))
- (ignore-errors (finish-output s)))
- (values))
-
- (defun format! (stream format &rest args)
- "Just like format, but call finish-outputs before and after the output."
- (finish-outputs stream)
- (apply 'format stream format args)
- (finish-outputs stream))
-
- (defun safe-format! (stream format &rest args)
- "Variant of FORMAT that is safe against both
-dangerous syntax configuration and errors while printing."
- (with-safe-io-syntax ()
- (ignore-errors (apply 'format! stream format args))
- (finish-outputs stream)))) ; just in case format failed
-
-
-;;; Simple Whole-Stream processing
-(with-upgradability ()
- (defun copy-stream-to-stream (input output &key element-type buffer-size linewise prefix)
- "Copy the contents of the INPUT stream into the OUTPUT stream.
-If LINEWISE is true, then read and copy the stream line by line, with an optional PREFIX.
-Otherwise, using WRITE-SEQUENCE using a buffer of size BUFFER-SIZE."
- (with-open-stream (input input)
- (if linewise
- (loop* :for (line eof) = (multiple-value-list (read-line input nil nil))
- :while line :do
- (when prefix (princ prefix output))
- (princ line output)
- (unless eof (terpri output))
- (finish-output output)
- (when eof (return)))
- (loop
- :with buffer-size = (or buffer-size 8192)
- :with buffer = (make-array (list buffer-size) :element-type (or element-type 'character))
- :for end = (read-sequence buffer input)
- :until (zerop end)
- :do (write-sequence buffer output :end end)
- (when (< end buffer-size) (return))))))
-
- (defun concatenate-files (inputs output)
- "create a new OUTPUT file the contents of which a the concatenate of the INPUTS files."
- (with-open-file (o output :element-type '(unsigned-byte 8)
- :direction :output :if-exists :rename-and-delete)
- (dolist (input inputs)
- (with-open-file (i input :element-type '(unsigned-byte 8)
- :direction :input :if-does-not-exist :error)
- (copy-stream-to-stream i o :element-type '(unsigned-byte 8))))))
-
- (defun copy-file (input output)
- "Copy contents of the INPUT file to the OUTPUT file"
- ;; Not available on LW personal edition or LW 6.0 on Mac: (lispworks:copy-file i f)
- #+allegro
- (excl.osi:copy-file input output)
- #+ecl
- (ext:copy-file input output)
- #-(or allegro ecl)
- (concatenate-files (list input) output))
-
- (defun slurp-stream-string (input &key (element-type 'character) stripped)
- "Read the contents of the INPUT stream as a string"
- (let ((string
- (with-open-stream (input input)
- (with-output-to-string (output)
- (copy-stream-to-stream input output :element-type element-type)))))
- (if stripped (stripln string) string)))
-
- (defun slurp-stream-lines (input &key count)
- "Read the contents of the INPUT stream as a list of lines, return those lines.
-
-Note: relies on the Lisp's READ-LINE, but additionally removes any remaining CR
-from the line-ending if the file or stream had CR+LF but Lisp only removed LF.
-
-Read no more than COUNT lines."
- (check-type count (or null integer))
- (with-open-stream (input input)
- (loop :for n :from 0
- :for l = (and (or (not count) (< n count))
- (read-line input nil nil))
- ;; stripln: to remove CR when the OS sends CRLF and Lisp only remove LF
- :while l :collect (stripln l))))
-
- (defun slurp-stream-line (input &key (at 0))
- "Read the contents of the INPUT stream as a list of lines,
-then return the ACCESS-AT of that list of lines using the AT specifier.
-PATH defaults to 0, i.e. return the first line.
-PATH is typically an integer, or a list of an integer and a function.
-If PATH is NIL, it will return all the lines in the file.
-
-The stream will not be read beyond the Nth lines,
-where N is the index specified by path
-if path is either an integer or a list that starts with an integer."
- (access-at (slurp-stream-lines input :count (access-at-count at)) at))
-
- (defun slurp-stream-forms (input &key count)
- "Read the contents of the INPUT stream as a list of forms,
-and return those forms.
-
-If COUNT is null, read to the end of the stream;
-if COUNT is an integer, stop after COUNT forms were read.
-
-BEWARE: be sure to use WITH-SAFE-IO-SYNTAX, or some variant thereof"
- (check-type count (or null integer))
- (loop :with eof = '#:eof
- :for n :from 0
- :for form = (if (and count (>= n count))
- eof
- (read-preserving-whitespace input nil eof))
- :until (eq form eof) :collect form))
-
- (defun slurp-stream-form (input &key (at 0))
- "Read the contents of the INPUT stream as a list of forms,
-then return the ACCESS-AT of these forms following the AT.
-AT defaults to 0, i.e. return the first form.
-AT is typically a list of integers.
-If AT is NIL, it will return all the forms in the file.
-
-The stream will not be read beyond the Nth form,
-where N is the index specified by path,
-if path is either an integer or a list that starts with an integer.
-
-BEWARE: be sure to use WITH-SAFE-IO-SYNTAX, or some variant thereof"
- (access-at (slurp-stream-forms input :count (access-at-count at)) at))
-
- (defun read-file-string (file &rest keys)
- "Open FILE with option KEYS, read its contents as a string"
- (apply 'call-with-input-file file 'slurp-stream-string keys))
-
- (defun read-file-lines (file &rest keys)
- "Open FILE with option KEYS, read its contents as a list of lines
-BEWARE: be sure to use WITH-SAFE-IO-SYNTAX, or some variant thereof"
- (apply 'call-with-input-file file 'slurp-stream-lines keys))
-
- (defun read-file-line (file &rest keys &key (at 0) &allow-other-keys)
- "Open input FILE with option KEYS (except AT),
-and read its contents as per SLURP-STREAM-LINE with given AT specifier.
-BEWARE: be sure to use WITH-SAFE-IO-SYNTAX, or some variant thereof"
- (apply 'call-with-input-file file
- #'(lambda (input) (slurp-stream-line input :at at))
- (remove-plist-key :at keys)))
-
- (defun read-file-forms (file &rest keys &key count &allow-other-keys)
- "Open input FILE with option KEYS (except COUNT),
-and read its contents as per SLURP-STREAM-FORMS with given COUNT.
-BEWARE: be sure to use WITH-SAFE-IO-SYNTAX, or some variant thereof"
- (apply 'call-with-input-file file
- #'(lambda (input) (slurp-stream-forms input :count count))
- (remove-plist-key :count keys)))
-
- (defun read-file-form (file &rest keys &key (at 0) &allow-other-keys)
- "Open input FILE with option KEYS (except AT),
-and read its contents as per SLURP-STREAM-FORM with given AT specifier.
-BEWARE: be sure to use WITH-SAFE-IO-SYNTAX, or some variant thereof"
- (apply 'call-with-input-file file
- #'(lambda (input) (slurp-stream-form input :at at))
- (remove-plist-key :at keys)))
-
- (defun safe-read-file-line (pathname &rest keys &key (package :cl) &allow-other-keys)
- "Reads the specified line from the top of a file using a safe standardized syntax.
-Extracts the line using READ-FILE-LINE,
-within an WITH-SAFE-IO-SYNTAX using the specified PACKAGE."
- (with-safe-io-syntax (:package package)
- (apply 'read-file-line pathname (remove-plist-key :package keys))))
-
- (defun safe-read-file-form (pathname &rest keys &key (package :cl) &allow-other-keys)
- "Reads the specified form from the top of a file using a safe standardized syntax.
-Extracts the form using READ-FILE-FORM,
-within an WITH-SAFE-IO-SYNTAX using the specified PACKAGE."
- (with-safe-io-syntax (:package package)
- (apply 'read-file-form pathname (remove-plist-key :package keys))))
-
- (defun eval-input (input)
- "Portably read and evaluate forms from INPUT, return the last values."
- (with-input (input)
- (loop :with results :with eof ='#:eof
- :for form = (read input nil eof)
- :until (eq form eof)
- :do (setf results (multiple-value-list (eval form)))
- :finally (return (values-list results)))))
-
- (defun eval-thunk (thunk)
- "Evaluate a THUNK of code:
-If a function, FUNCALL it without arguments.
-If a constant literal and not a sequence, return it.
-If a cons or a symbol, EVAL it.
-If a string, repeatedly read and evaluate from it, returning the last values."
- (etypecase thunk
- ((or boolean keyword number character pathname) thunk)
- ((or cons symbol) (eval thunk))
- (function (funcall thunk))
- (string (eval-input thunk))))
-
- (defun standard-eval-thunk (thunk &key (package :cl))
- "Like EVAL-THUNK, but in a more standardized evaluation context."
- ;; Note: it's "standard-" not "safe-", because evaluation is never safe.
- (when thunk
- (with-safe-io-syntax (:package package)
- (let ((*read-eval* t))
- (eval-thunk thunk))))))
-
-(with-upgradability ()
- (defun println (x &optional (stream *standard-output*))
- "Variant of PRINC that also calls TERPRI afterwards"
- (princ x stream) (terpri stream) (finish-output stream) (values))
-
- (defun writeln (x &rest keys &key (stream *standard-output*) &allow-other-keys)
- "Variant of WRITE that also calls TERPRI afterwards"
- (apply 'write x keys) (terpri stream) (finish-output stream) (values)))
-
-
-;;; Using temporary files
-(with-upgradability ()
- (defun default-temporary-directory ()
- "Return a default directory to use for temporary files"
- (os-cond
- ((os-unix-p)
- (or (getenv-pathname "TMPDIR" :ensure-directory t)
- (parse-native-namestring "/tmp/")))
- ((os-windows-p)
- (getenv-pathname "TEMP" :ensure-directory t))
- (t (subpathname (user-homedir-pathname) "tmp/"))))
-
- (defvar *temporary-directory* nil "User-configurable location for temporary files")
-
- (defun temporary-directory ()
- "Return a directory to use for temporary files"
- (or *temporary-directory* (default-temporary-directory)))
-
- (defun setup-temporary-directory ()
- "Configure a default temporary directory to use."
- (setf *temporary-directory* (default-temporary-directory))
- #+gcl (setf system::*tmp-dir* *temporary-directory*))
-
- (defun call-with-temporary-file
- (thunk &key
- (want-stream-p t) (want-pathname-p t) (direction :io) keep after
- directory (type "tmp" typep) prefix (suffix (when typep "-tmp"))
- (element-type *default-stream-element-type*)
- (external-format *utf-8-external-format*))
- "Call a THUNK with stream and/or pathname arguments identifying a temporary file.
-
-The temporary file's pathname will be based on concatenating
-PREFIX (or \"tmp\" if it's NIL), a random alphanumeric string,
-and optional SUFFIX (defaults to \"-tmp\" if a type was provided)
-and TYPE (defaults to \"tmp\", using a dot as separator if not NIL),
-within DIRECTORY (defaulting to the TEMPORARY-DIRECTORY) if the PREFIX isn't absolute.
-
-The file will be open with specified DIRECTION (defaults to :IO),
-ELEMENT-TYPE (defaults to *DEFAULT-STREAM-ELEMENT-TYPE*) and
-EXTERNAL-FORMAT (defaults to *UTF-8-EXTERNAL-FORMAT*).
-If WANT-STREAM-P is true (the defaults to T), then THUNK will then be CALL-FUNCTION'ed
-with the stream and the pathname (if WANT-PATHNAME-P is true, defaults to T),
-and stream will be closed after the THUNK exits (either normally or abnormally).
-If WANT-STREAM-P is false, then WANT-PATHAME-P must be true, and then
-THUNK is only CALL-FUNCTION'ed after the stream is closed, with the pathname as argument.
-Upon exit of THUNK, the AFTER thunk if defined is CALL-FUNCTION'ed with the pathname as argument.
-If AFTER is defined, its results are returned, otherwise, the results of THUNK are returned.
-Finally, the file will be deleted, unless the KEEP argument when CALL-FUNCTION'ed returns true."
- #+xcl (declare (ignorable typep))
- (check-type direction (member :output :io))
- (assert (or want-stream-p want-pathname-p))
- (loop
- :with prefix-pn = (ensure-absolute-pathname
- (or prefix "tmp")
- (or (ensure-pathname
- directory
- :namestring :native
- :ensure-directory t
- :ensure-physical t)
- #'temporary-directory))
- :with prefix-nns = (native-namestring prefix-pn)
- :with results = (progn (ensure-directories-exist prefix-pn)
- ())
- :for counter :from (random (expt 36 #-gcl 8 #+gcl 5))
- :for pathname = (parse-native-namestring
- (format nil "~A~36R~@[~A~]~@[.~A~]"
- prefix-nns counter suffix (unless (eq type :unspecific) type)))
- :for okp = nil :do
- ;; TODO: on Unix, do something about umask
- ;; TODO: on Unix, audit the code so we make sure it uses O_CREAT|O_EXCL
- ;; TODO: on Unix, use CFFI and mkstemp --
- ;; except UIOP is precisely meant to not depend on CFFI or on anything! Grrrr.
- ;; Can we at least design some hook?
- (unwind-protect
- (progn
- (ensure-directories-exist pathname)
- (with-open-file (stream pathname
- :direction direction
- :element-type element-type
- :external-format external-format
- :if-exists nil :if-does-not-exist :create)
- (when stream
- (setf okp pathname)
- (when want-stream-p
- ;; Note: can't return directly from within with-open-file
- ;; or the non-local return causes the file creation to be undone.
- (setf results (multiple-value-list
- (if want-pathname-p
- (funcall thunk stream pathname)
- (funcall thunk stream)))))))
- (cond
- ((not okp) nil)
- (after (return (call-function after okp)))
- ((and want-pathname-p (not want-stream-p)) (return (call-function thunk okp)))
- (t (return (values-list results)))))
- (when (and okp (not (call-function keep)))
- (ignore-errors (delete-file-if-exists okp))))))
-
- (defmacro with-temporary-file ((&key (stream (gensym "STREAM") streamp)
- (pathname (gensym "PATHNAME") pathnamep)
- directory prefix suffix type
- keep direction element-type external-format)
- &body body)
- "Evaluate BODY where the symbols specified by keyword arguments
-STREAM and PATHNAME (if respectively specified) are bound corresponding
-to a newly created temporary file ready for I/O, as per CALL-WITH-TEMPORARY-FILE.
-At least one of STREAM or PATHNAME must be specified.
-If the STREAM is not specified, it will be closed before the BODY is evaluated.
-If STREAM is specified, then the :CLOSE-STREAM label if it appears in the BODY,
-separates forms run before and after the stream is closed.
-The values of the last form of the BODY (not counting the separating :CLOSE-STREAM) are returned.
-Upon success, the KEEP form is evaluated and the file is is deleted unless it evaluates to TRUE."
- (check-type stream symbol)
- (check-type pathname symbol)
- (assert (or streamp pathnamep))
- (let* ((afterp (position :close-stream body))
- (before (if afterp (subseq body 0 afterp) body))
- (after (when afterp (subseq body (1+ afterp))))
- (beforef (gensym "BEFORE"))
- (afterf (gensym "AFTER")))
- `(flet (,@(when before
- `((,beforef (,@(when streamp `(,stream)) ,@(when pathnamep `(,pathname)))
- ,@(when after `((declare (ignorable ,pathname))))
- ,@before)))
- ,@(when after
- (assert pathnamep)
- `((,afterf (,pathname) ,@after))))
- #-gcl (declare (dynamic-extent ,@(when before `(#',beforef)) ,@(when after `(#',afterf))))
- (call-with-temporary-file
- ,(when before `#',beforef)
- :want-stream-p ,streamp
- :want-pathname-p ,pathnamep
- ,@(when direction `(:direction ,direction))
- ,@(when directory `(:directory ,directory))
- ,@(when prefix `(:prefix ,prefix))
- ,@(when suffix `(:suffix ,suffix))
- ,@(when type `(:type ,type))
- ,@(when keep `(:keep ,keep))
- ,@(when after `(:after #',afterf))
- ,@(when element-type `(:element-type ,element-type))
- ,@(when external-format `(:external-format ,external-format))))))
-
- (defun get-temporary-file (&key directory prefix suffix type)
- (with-temporary-file (:pathname pn :keep t
- :directory directory :prefix prefix :suffix suffix :type type)
- pn))
-
- ;; Temporary pathnames in simple cases where no contention is assumed
- (defun add-pathname-suffix (pathname suffix &rest keys)
- "Add a SUFFIX to the name of a PATHNAME, return a new pathname.
-Further KEYS can be passed to MAKE-PATHNAME."
- (apply 'make-pathname :name (strcat (pathname-name pathname) suffix)
- :defaults pathname keys))
-
- (defun tmpize-pathname (x)
- "Return a new pathname modified from X by adding a trivial random suffix.
-A new empty file with said temporary pathname is created, to ensure there is no
-clash with any concurrent process attempting the same thing."
- (let* ((px (ensure-pathname x :ensure-physical t))
- (prefix (if-let (n (pathname-name px)) (strcat n "-tmp") "tmp"))
- (directory (pathname-directory-pathname px)))
- (get-temporary-file :directory directory :prefix prefix :type (pathname-type px))))
-
- (defun call-with-staging-pathname (pathname fun)
- "Calls FUN with a staging pathname, and atomically
-renames the staging pathname to the PATHNAME in the end.
-NB: this protects only against failure of the program, not against concurrent attempts.
-For the latter case, we ought pick a random suffix and atomically open it."
- (let* ((pathname (pathname pathname))
- (staging (tmpize-pathname pathname)))
- (unwind-protect
- (multiple-value-prog1
- (funcall fun staging)
- (rename-file-overwriting-target staging pathname))
- (delete-file-if-exists staging))))
-
- (defmacro with-staging-pathname ((pathname-var &optional (pathname-value pathname-var)) &body body)
- "Trivial syntax wrapper for CALL-WITH-STAGING-PATHNAME"
- `(call-with-staging-pathname ,pathname-value #'(lambda (,pathname-var) ,@body))))
-
-(with-upgradability ()
- (defun file-stream-p (stream)
- (typep stream 'file-stream))
- (defun file-or-synonym-stream-p (stream)
- (or (file-stream-p stream)
- (and (typep stream 'synonym-stream)
- (file-or-synonym-stream-p
- (symbol-value (synonym-stream-symbol stream)))))))
(DIR) diff --git a/3rdparties/software/uiop-3.3.2/uiop.asd b/3rdparties/software/uiop-3.3.2/uiop.asd
@@ -1,50 +0,0 @@
-;;; -*- mode: lisp -*-
-(in-package :asdf)
-
-#-asdf3
-(unless (or #+asdf2 (version-satisfies (asdf:asdf-version) "2.11.4"))
- (error "UIOP requires ASDF 2.011.4 or later."))
-
-(defun call-without-redefinition-warnings (thunk)
- (handler-bind (((or
- #+allegro simple-warning
- #+clozure ccl:compiler-warning
- #+cmucl kernel:simple-style-warning
- #-(or allegro clozure cmucl) warning)
- #'muffle-warning))
- (funcall thunk)))
-
-(defsystem "uiop"
- #+asdf3 :long-name #+asdf3 "Utilities for Implementation- and OS- Portability"
- :description "Portability library for Common Lisp programs"
- :long-description "UIOP provides runtime support for Common Lisp programs:
-Basic general-purpose utilities that are in such a need that you can't portably construct a
-complete program without using some of them. UIOP replaces ASDF/DRIVER and ASDF-UTILS, and offers a
-superset of the functionality provided by CL-FAD, EXTERNAL-PROGRAM, TRIVIAL-SHELL, TRIVIAL-BACKTRACE
-and a lot of the functionality formerly provided by CL-LAUNCH, XCVB-DRIVER, TRIVIAL-FEATURES,
-plus a tiny subset of functionality from ALEXANDRIA and FARE-UTILS.
-It is transcluded into asdf.lisp together with ASDF/DEFSYSTEM, so if you did (require \"asdf\")
-you already have a matching UIOP loaded."
- :author "Francois-Rene Rideau"
- :licence "MIT"
- :class #+asdf3.1 package-system #-asdf3.1 system
- #+asdf3.1 :version #+asdf3.1 (:read-file-form "version.lisp" :at (2 2 2))
- #+asdf3 :encoding #+asdf3 :utf-8
- #+asdf3 :around-compile #+asdf3 call-without-redefinition-warnings
- :components
- ((:static-file "contrib/debug.lisp")
- (:file "package")
- (:file "common-lisp" :depends-on ("package"))
- (:file "utility" :depends-on ("common-lisp"))
- (:file "version" :depends-on ("utility"))
- (:file "os" :depends-on ("utility"))
- (:file "pathname" :depends-on ("utility" "os"))
- (:file "filesystem" :depends-on ("os" "pathname"))
- (:file "stream" :depends-on ("filesystem"))
- (:file "image" :depends-on ("stream"))
- (:file "lisp-build" :depends-on ("image"))
- (:file "launch-program" :depends-on ("stream"))
- (:file "run-program" :depends-on ("launch-program" "version"))
- (:file "configuration" :depends-on ("image"))
- (:file "backward-driver" :depends-on ("lisp-build" "run-program" "configuration" "version"))
- (:file "driver" :depends-on ("backward-driver"))))
(DIR) diff --git a/3rdparties/software/uiop-3.3.2/utility.lisp b/3rdparties/software/uiop-3.3.2/utility.lisp
@@ -1,652 +0,0 @@
-;;;; -------------------------------------------------------------------------
-;;;; General Purpose Utilities for ASDF
-
-(uiop/package:define-package :uiop/utility
- (:use :uiop/common-lisp :uiop/package)
- ;; import and reexport a few things defined in :uiop/common-lisp
- (:import-from :uiop/common-lisp #:compatfmt #:loop* #:frob-substrings
- #+(or clasp ecl) #:use-ecl-byte-compiler-p #+mcl #:probe-posix)
- (:export #:compatfmt #:loop* #:frob-substrings #:compatfmt
- #+(or clasp ecl) #:use-ecl-byte-compiler-p #+mcl #:probe-posix)
- (:export
- ;; magic helper to define debugging functions:
- #:uiop-debug #:load-uiop-debug-utility #:*uiop-debug-utility*
- #:with-upgradability ;; (un)defining functions in an upgrade-friendly way
- #:defun* #:defgeneric*
- #:nest #:if-let ;; basic flow control
- #:parse-body ;; macro definition helper
- #:while-collecting #:appendf #:length=n-p #:ensure-list ;; lists
- #:remove-plist-keys #:remove-plist-key ;; plists
- #:emptyp ;; sequences
- #:+non-base-chars-exist-p+ ;; characters
- #:+max-character-type-index+ #:character-type-index #:+character-types+
- #:base-string-p #:strings-common-element-type #:reduce/strcat #:strcat ;; strings
- #:first-char #:last-char #:split-string #:stripln #:+cr+ #:+lf+ #:+crlf+
- #:string-prefix-p #:string-enclosed-p #:string-suffix-p
- #:standard-case-symbol-name #:find-standard-case-symbol ;; symbols
- #:coerce-class ;; CLOS
- #:timestamp< #:timestamps< #:timestamp*< #:timestamp<= ;; timestamps
- #:earlier-timestamp #:timestamps-earliest #:earliest-timestamp
- #:later-timestamp #:timestamps-latest #:latest-timestamp #:latest-timestamp-f
- #:list-to-hash-set #:ensure-gethash ;; hash-table
- #:ensure-function #:access-at #:access-at-count ;; functions
- #:call-function #:call-functions #:register-hook-function
- #:lexicographic< #:lexicographic<= ;; version
- #:simple-style-warning #:style-warn ;; simple style warnings
- #:match-condition-p #:match-any-condition-p ;; conditions
- #:call-with-muffled-conditions #:with-muffled-conditions
- #:not-implemented-error #:parameter-error))
-(in-package :uiop/utility)
-
-;;;; Defining functions in a way compatible with hot-upgrade:
-;; DEFUN* and DEFGENERIC* use FMAKUNBOUND to delete any previous fdefinition,
-;; thus replacing the function without warning or error
-;; even if the signature and/or generic-ness of the function has changed.
-;; For a generic function, this invalidates any previous DEFMETHOD.
-(eval-when (:load-toplevel :compile-toplevel :execute)
- (macrolet
- ((defdef (def* def)
- `(defmacro ,def* (name formals &rest rest)
- (destructuring-bind (name &key (supersede t))
- (if (or (atom name) (eq (car name) 'setf))
- (list name :supersede nil)
- name)
- (declare (ignorable supersede))
- `(progn
- ;; We usually try to do it only for the functions that need it,
- ;; which happens in asdf/upgrade - however, for ECL, we need this hammer.
- ,@(when supersede
- `((fmakunbound ',name)))
- ,@(when (and #+(or clasp ecl) (symbolp name)) ; fails for setf functions on ecl
- `((declaim (notinline ,name))))
- (,',def ,name ,formals ,@rest))))))
- (defdef defgeneric* defgeneric)
- (defdef defun* defun))
- (defmacro with-upgradability ((&optional) &body body)
- "Evaluate BODY at compile- load- and run- times, with DEFUN and DEFGENERIC modified
-to also declare the functions NOTINLINE and to accept a wrapping the function name
-specification into a list with keyword argument SUPERSEDE (which defaults to T if the name
-is not wrapped, and NIL if it is wrapped). If SUPERSEDE is true, call UNDEFINE-FUNCTION
-to supersede any previous definition."
- `(eval-when (:compile-toplevel :load-toplevel :execute)
- ,@(loop :for form :in body :collect
- (if (consp form)
- (destructuring-bind (car . cdr) form
- (case car
- ((defun) `(defun* ,@cdr))
- ((defgeneric) `(defgeneric* ,@cdr))
- (otherwise form)))
- form)))))
-
-;;; Magic debugging help. See contrib/debug.lisp
-(with-upgradability ()
- (defvar *uiop-debug-utility*
- '(or (ignore-errors
- (probe-file (symbol-call :asdf :system-relative-pathname :uiop "contrib/debug.lisp")))
- (probe-file (symbol-call :uiop/pathname :subpathname
- (user-homedir-pathname) "common-lisp/asdf/uiop/contrib/debug.lisp")))
- "form that evaluates to the pathname to your favorite debugging utilities")
-
- (defmacro uiop-debug (&rest keys)
- `(eval-when (:compile-toplevel :load-toplevel :execute)
- (load-uiop-debug-utility ,@keys)))
-
- (defun load-uiop-debug-utility (&key package utility-file)
- (let* ((*package* (if package (find-package package) *package*))
- (keyword (read-from-string
- (format nil ":DBG-~:@(~A~)" (package-name *package*)))))
- (unless (member keyword *features*)
- (let* ((utility-file (or utility-file *uiop-debug-utility*))
- (file (ignore-errors (probe-file (eval utility-file)))))
- (if file (load file)
- (error "Failed to locate debug utility file: ~S" utility-file)))))))
-
-;;; Flow control
-(with-upgradability ()
- (defmacro nest (&rest things)
- "Macro to keep code nesting and indentation under control." ;; Thanks to mbaringer
- (reduce #'(lambda (outer inner) `(,@outer ,inner))
- things :from-end t))
-
- (defmacro if-let (bindings &body (then-form &optional else-form)) ;; from alexandria
- ;; bindings can be (var form) or ((var1 form1) ...)
- (let* ((binding-list (if (and (consp bindings) (symbolp (car bindings)))
- (list bindings)
- bindings))
- (variables (mapcar #'car binding-list)))
- `(let ,binding-list
- (if (and ,@variables)
- ,then-form
- ,else-form)))))
-
-;;; Macro definition helper
-(with-upgradability ()
- (defun parse-body (body &key documentation whole) ;; from alexandria
- "Parses BODY into (values remaining-forms declarations doc-string).
-Documentation strings are recognized only if DOCUMENTATION is true.
-Syntax errors in body are signalled and WHOLE is used in the signal
-arguments when given."
- (let ((doc nil)
- (decls nil)
- (current nil))
- (tagbody
- :declarations
- (setf current (car body))
- (when (and documentation (stringp current) (cdr body))
- (if doc
- (error "Too many documentation strings in ~S." (or whole body))
- (setf doc (pop body)))
- (go :declarations))
- (when (and (listp current) (eql (first current) 'declare))
- (push (pop body) decls)
- (go :declarations)))
- (values body (nreverse decls) doc))))
-
-
-;;; List manipulation
-(with-upgradability ()
- (defmacro while-collecting ((&rest collectors) &body body)
- "COLLECTORS should be a list of names for collections. A collector
-defines a function that, when applied to an argument inside BODY, will
-add its argument to the corresponding collection. Returns multiple values,
-a list for each collection, in order.
- E.g.,
-\(while-collecting \(foo bar\)
- \(dolist \(x '\(\(a 1\) \(b 2\) \(c 3\)\)\)
- \(foo \(first x\)\)
- \(bar \(second x\)\)\)\)
-Returns two values: \(A B C\) and \(1 2 3\)."
- (let ((vars (mapcar #'(lambda (x) (gensym (symbol-name x))) collectors))
- (initial-values (mapcar (constantly nil) collectors)))
- `(let ,(mapcar #'list vars initial-values)
- (flet ,(mapcar #'(lambda (c v) `(,c (x) (push x ,v) (values))) collectors vars)
- ,@body
- (values ,@(mapcar #'(lambda (v) `(reverse ,v)) vars))))))
-
- (define-modify-macro appendf (&rest args)
- append "Append onto list") ;; only to be used on short lists.
-
- (defun length=n-p (x n) ;is it that (= (length x) n) ?
- (check-type n (integer 0 *))
- (loop
- :for l = x :then (cdr l)
- :for i :downfrom n :do
- (cond
- ((zerop i) (return (null l)))
- ((not (consp l)) (return nil)))))
-
- (defun ensure-list (x)
- (if (listp x) x (list x))))
-
-
-;;; Remove a key from a plist, i.e. for keyword argument cleanup
-(with-upgradability ()
- (defun remove-plist-key (key plist)
- "Remove a single key from a plist"
- (loop* :for (k v) :on plist :by #'cddr
- :unless (eq k key)
- :append (list k v)))
-
- (defun remove-plist-keys (keys plist)
- "Remove a list of keys from a plist"
- (loop* :for (k v) :on plist :by #'cddr
- :unless (member k keys)
- :append (list k v))))
-
-
-;;; Sequences
-(with-upgradability ()
- (defun emptyp (x)
- "Predicate that is true for an empty sequence"
- (or (null x) (and (vectorp x) (zerop (length x))))))
-
-
-;;; Characters
-(with-upgradability ()
- ;; base-char != character on ECL, LW, SBCL, Genera.
- ;; NB: We assume a total order on character types.
- ;; If that's not true... this code will need to be updated.
- (defparameter +character-types+ ;; assuming a simple hierarchy
- #.(coerce (loop* :for (type next) :on
- '(;; In SCL, all characters seem to be 16-bit base-char
- ;; Yet somehow character fails to be a subtype of base-char
- #-scl base-char
- ;; LW6 has BASE-CHAR < SIMPLE-CHAR < CHARACTER
- ;; LW7 has BASE-CHAR < BMP-CHAR < SIMPLE-CHAR = CHARACTER
- #+lispworks7+ lw:bmp-char
- #+lispworks lw:simple-char
- character)
- :unless (and next (subtypep next type))
- :collect type) 'vector))
- (defparameter +max-character-type-index+ (1- (length +character-types+)))
- (defconstant +non-base-chars-exist-p+ (plusp +max-character-type-index+))
- (when +non-base-chars-exist-p+ (pushnew :non-base-chars-exist-p *features*)))
-
-(with-upgradability ()
- (defun character-type-index (x)
- (declare (ignorable x))
- #.(case +max-character-type-index+
- (0 0)
- (1 '(etypecase x
- (character (if (typep x 'base-char) 0 1))
- (symbol (if (subtypep x 'base-char) 0 1))))
- (otherwise
- '(or (position-if (etypecase x
- (character #'(lambda (type) (typep x type)))
- (symbol #'(lambda (type) (subtypep x type))))
- +character-types+)
- (error "Not a character or character type: ~S" x))))))
-
-
-;;; Strings
-(with-upgradability ()
- (defun base-string-p (string)
- "Does the STRING only contain BASE-CHARs?"
- (declare (ignorable string))
- (and #+non-base-chars-exist-p (eq 'base-char (array-element-type string))))
-
- (defun strings-common-element-type (strings)
- "What least subtype of CHARACTER can contain all the elements of all the STRINGS?"
- (declare (ignorable strings))
- #.(if +non-base-chars-exist-p+
- `(aref +character-types+
- (loop :with index = 0 :for s :in strings :do
- (flet ((consider (i)
- (cond ((= i ,+max-character-type-index+) (return i))
- ,@(when (> +max-character-type-index+ 1) `(((> i index) (setf index i)))))))
- (cond
- ((emptyp s)) ;; NIL or empty string
- ((characterp s) (consider (character-type-index s)))
- ((stringp s) (let ((string-type-index
- (character-type-index (array-element-type s))))
- (unless (>= index string-type-index)
- (loop :for c :across s :for i = (character-type-index c)
- :do (consider i)
- ,@(when (> +max-character-type-index+ 1)
- `((when (= i string-type-index) (return))))))))
- (t (error "Invalid string designator ~S for ~S" s 'strings-common-element-type))))
- :finally (return index)))
- ''character))
-
- (defun reduce/strcat (strings &key key start end)
- "Reduce a list as if by STRCAT, accepting KEY START and END keywords like REDUCE.
-NIL is interpreted as an empty string. A character is interpreted as a string of length one."
- (when (or start end) (setf strings (subseq strings start end)))
- (when key (setf strings (mapcar key strings)))
- (loop :with output = (make-string (loop :for s :in strings
- :sum (if (characterp s) 1 (length s)))
- :element-type (strings-common-element-type strings))
- :with pos = 0
- :for input :in strings
- :do (etypecase input
- (null)
- (character (setf (char output pos) input) (incf pos))
- (string (replace output input :start1 pos) (incf pos (length input))))
- :finally (return output)))
-
- (defun strcat (&rest strings)
- "Concatenate strings.
-NIL is interpreted as an empty string, a character as a string of length one."
- (reduce/strcat strings))
-
- (defun first-char (s)
- "Return the first character of a non-empty string S, or NIL"
- (and (stringp s) (plusp (length s)) (char s 0)))
-
- (defun last-char (s)
- "Return the last character of a non-empty string S, or NIL"
- (and (stringp s) (plusp (length s)) (char s (1- (length s)))))
-
- (defun split-string (string &key max (separator '(#\Space #\Tab)))
- "Split STRING into a list of components separated by
-any of the characters in the sequence SEPARATOR.
-If MAX is specified, then no more than max(1,MAX) components will be returned,
-starting the separation from the end, e.g. when called with arguments
- \"a.b.c.d.e\" :max 3 :separator \".\" it will return (\"a.b.c\" \"d\" \"e\")."
- (block ()
- (let ((list nil) (words 0) (end (length string)))
- (when (zerop end) (return nil))
- (flet ((separatorp (char) (find char separator))
- (done () (return (cons (subseq string 0 end) list))))
- (loop
- :for start = (if (and max (>= words (1- max)))
- (done)
- (position-if #'separatorp string :end end :from-end t))
- :do (when (null start) (done))
- (push (subseq string (1+ start) end) list)
- (incf words)
- (setf end start))))))
-
- (defun string-prefix-p (prefix string)
- "Does STRING begin with PREFIX?"
- (let* ((x (string prefix))
- (y (string string))
- (lx (length x))
- (ly (length y)))
- (and (<= lx ly) (string= x y :end2 lx))))
-
- (defun string-suffix-p (string suffix)
- "Does STRING end with SUFFIX?"
- (let* ((x (string string))
- (y (string suffix))
- (lx (length x))
- (ly (length y)))
- (and (<= ly lx) (string= x y :start1 (- lx ly)))))
-
- (defun string-enclosed-p (prefix string suffix)
- "Does STRING begin with PREFIX and end with SUFFIX?"
- (and (string-prefix-p prefix string)
- (string-suffix-p string suffix)))
-
- (defvar +cr+ (coerce #(#\Return) 'string))
- (defvar +lf+ (coerce #(#\Linefeed) 'string))
- (defvar +crlf+ (coerce #(#\Return #\Linefeed) 'string))
-
- (defun stripln (x)
- "Strip a string X from any ending CR, LF or CRLF.
-Return two values, the stripped string and the ending that was stripped,
-or the original value and NIL if no stripping took place.
-Since our STRCAT accepts NIL as empty string designator,
-the two results passed to STRCAT always reconstitute the original string"
- (check-type x string)
- (block nil
- (flet ((c (end) (when (string-suffix-p x end)
- (return (values (subseq x 0 (- (length x) (length end))) end)))))
- (when x (c +crlf+) (c +lf+) (c +cr+) (values x nil)))))
-
- (defun standard-case-symbol-name (name-designator)
- "Given a NAME-DESIGNATOR for a symbol, if it is a symbol, convert it to a string using STRING;
-if it is a string, use STRING-UPCASE on an ANSI CL platform, or STRING on a so-called \"modern\"
-platform such as Allegro with modern syntax."
- (check-type name-designator (or string symbol))
- (cond
- ((or (symbolp name-designator) #+allegro (eq excl:*current-case-mode* :case-sensitive-lower))
- (string name-designator))
- ;; Should we be doing something on CLISP?
- (t (string-upcase name-designator))))
-
- (defun find-standard-case-symbol (name-designator package-designator &optional (error t))
- "Find a symbol designated by NAME-DESIGNATOR in a package designated by PACKAGE-DESIGNATOR,
-where STANDARD-CASE-SYMBOL-NAME is used to transform them if these designators are strings.
-If optional ERROR argument is NIL, return NIL instead of an error when the symbol is not found."
- (find-symbol* (standard-case-symbol-name name-designator)
- (etypecase package-designator
- ((or package symbol) package-designator)
- (string (standard-case-symbol-name package-designator)))
- error)))
-
-;;; timestamps: a REAL or a boolean where T=-infinity, NIL=+infinity
-(eval-when (#-lispworks :compile-toplevel :load-toplevel :execute)
- (deftype timestamp () '(or real boolean)))
-(with-upgradability ()
- (defun timestamp< (x y)
- (etypecase x
- ((eql t) (not (eql y t)))
- (real (etypecase y
- ((eql t) nil)
- (real (< x y))
- (null t)))
- (null nil)))
- (defun timestamps< (list) (loop :for y :in list :for x = nil :then y :always (timestamp< x y)))
- (defun timestamp*< (&rest list) (timestamps< list))
- (defun timestamp<= (x y) (not (timestamp< y x)))
- (defun earlier-timestamp (x y) (if (timestamp< x y) x y))
- (defun timestamps-earliest (list) (reduce 'earlier-timestamp list :initial-value nil))
- (defun earliest-timestamp (&rest list) (timestamps-earliest list))
- (defun later-timestamp (x y) (if (timestamp< x y) y x))
- (defun timestamps-latest (list) (reduce 'later-timestamp list :initial-value t))
- (defun latest-timestamp (&rest list) (timestamps-latest list))
- (define-modify-macro latest-timestamp-f (&rest timestamps) latest-timestamp))
-
-
-;;; Function designators
-(with-upgradability ()
- (defun ensure-function (fun &key (package :cl))
- "Coerce the object FUN into a function.
-
-If FUN is a FUNCTION, return it.
-If the FUN is a non-sequence literal constant, return constantly that,
-i.e. for a boolean keyword character number or pathname.
-Otherwise if FUN is a non-literally constant symbol, return its FDEFINITION.
-If FUN is a CONS, return the function that applies its CAR
-to the appended list of the rest of its CDR and the arguments,
-unless the CAR is LAMBDA, in which case the expression is evaluated.
-If FUN is a string, READ a form from it in the specified PACKAGE (default: CL)
-and EVAL that in a (FUNCTION ...) context."
- (etypecase fun
- (function fun)
- ((or boolean keyword character number pathname) (constantly fun))
- (hash-table #'(lambda (x) (gethash x fun)))
- (symbol (fdefinition fun))
- (cons (if (eq 'lambda (car fun))
- (eval fun)
- #'(lambda (&rest args) (apply (car fun) (append (cdr fun) args)))))
- (string (eval `(function ,(with-standard-io-syntax
- (let ((*package* (find-package package)))
- (read-from-string fun))))))))
-
- (defun access-at (object at)
- "Given an OBJECT and an AT specifier, list of successive accessors,
-call each accessor on the result of the previous calls.
-An accessor may be an integer, meaning a call to ELT,
-a keyword, meaning a call to GETF,
-NIL, meaning identity,
-a function or other symbol, meaning itself,
-or a list of a function designator and arguments, interpreted as per ENSURE-FUNCTION.
-As a degenerate case, the AT specifier may be an atom of a single such accessor
-instead of a list."
- (flet ((access (object accessor)
- (etypecase accessor
- (function (funcall accessor object))
- (integer (elt object accessor))
- (keyword (getf object accessor))
- (null object)
- (symbol (funcall accessor object))
- (cons (funcall (ensure-function accessor) object)))))
- (if (listp at)
- (dolist (accessor at object)
- (setf object (access object accessor)))
- (access object at))))
-
- (defun access-at-count (at)
- "From an AT specification, extract a COUNT of maximum number
-of sub-objects to read as per ACCESS-AT"
- (cond
- ((integerp at)
- (1+ at))
- ((and (consp at) (integerp (first at)))
- (1+ (first at)))))
-
- (defun call-function (function-spec &rest arguments)
- "Call the function designated by FUNCTION-SPEC as per ENSURE-FUNCTION,
-with the given ARGUMENTS"
- (apply (ensure-function function-spec) arguments))
-
- (defun call-functions (function-specs)
- "For each function in the list FUNCTION-SPECS, in order, call the function as per CALL-FUNCTION"
- (map () 'call-function function-specs))
-
- (defun register-hook-function (variable hook &optional call-now-p)
- "Push the HOOK function (a designator as per ENSURE-FUNCTION) onto the hook VARIABLE.
-When CALL-NOW-P is true, also call the function immediately."
- (pushnew hook (symbol-value variable) :test 'equal)
- (when call-now-p (call-function hook))))
-
-
-;;; CLOS
-(with-upgradability ()
- (defun coerce-class (class &key (package :cl) (super t) (error 'error))
- "Coerce CLASS to a class that is subclass of SUPER if specified,
-or invoke ERROR handler as per CALL-FUNCTION.
-
-A keyword designates the name a symbol, which when found in either PACKAGE, designates a class.
--- for backward compatibility, *PACKAGE* is also accepted for now, but this may go in the future.
-A string is read as a symbol while in PACKAGE, the symbol designates a class.
-
-A class object designates itself.
-NIL designates itself (no class).
-A symbol otherwise designates a class by name."
- (let* ((normalized
- (typecase class
- (keyword (or (find-symbol* class package nil)
- (find-symbol* class *package* nil)))
- (string (symbol-call :uiop :safe-read-from-string class :package package))
- (t class)))
- (found
- (etypecase normalized
- ((or standard-class built-in-class) normalized)
- ((or null keyword) nil)
- (symbol (find-class normalized nil nil))))
- (super-class
- (etypecase super
- ((or standard-class built-in-class) super)
- ((or null keyword) nil)
- (symbol (find-class super nil nil)))))
- #+allegro (when found (mop:finalize-inheritance found))
- (or (and found
- (or (eq super t) (#-cormanlisp subtypep #+cormanlisp cl::subclassp found super-class))
- found)
- (call-function error "Can't coerce ~S to a ~:[class~;subclass of ~:*~S~]" class super)))))
-
-
-;;; Hash-tables
-(with-upgradability ()
- (defun ensure-gethash (key table default)
- "Lookup the TABLE for a KEY as by GETHASH, but if not present,
-call the (possibly constant) function designated by DEFAULT as per CALL-FUNCTION,
-set the corresponding entry to the result in the table.
-Return two values: the entry after its optional computation, and whether it was found"
- (multiple-value-bind (value foundp) (gethash key table)
- (values
- (if foundp
- value
- (setf (gethash key table) (call-function default)))
- foundp)))
-
- (defun list-to-hash-set (list &aux (h (make-hash-table :test 'equal)))
- "Convert a LIST into hash-table that has the same elements when viewed as a set,
-up to the given equality TEST"
- (dolist (x list h) (setf (gethash x h) t))))
-
-
-;;; Lexicographic comparison of lists of numbers
-(with-upgradability ()
- (defun lexicographic< (element< x y)
- "Lexicographically compare two lists of using the function element< to compare elements.
-element< is a strict total order; the resulting order on X and Y will also be strict."
- (cond ((null y) nil)
- ((null x) t)
- ((funcall element< (car x) (car y)) t)
- ((funcall element< (car y) (car x)) nil)
- (t (lexicographic< element< (cdr x) (cdr y)))))
-
- (defun lexicographic<= (element< x y)
- "Lexicographically compare two lists of using the function element< to compare elements.
-element< is a strict total order; the resulting order on X and Y will be a non-strict total order."
- (not (lexicographic< element< y x))))
-
-
-;;; Simple style warnings
-(with-upgradability ()
- (define-condition simple-style-warning
- #+sbcl (sb-int:simple-style-warning) #-sbcl (simple-condition style-warning)
- ())
-
- (defun style-warn (datum &rest arguments)
- (etypecase datum
- (string (warn (make-condition 'simple-style-warning :format-control datum :format-arguments arguments)))
- (symbol (assert (subtypep datum 'style-warning)) (apply 'warn datum arguments))
- (style-warning (apply 'warn datum arguments)))))
-
-
-;;; Condition control
-
-(with-upgradability ()
- (defparameter +simple-condition-format-control-slot+
- #+abcl 'system::format-control
- #+allegro 'excl::format-control
- #+(or clasp ecl mkcl) 'si::format-control
- #+clisp 'system::$format-control
- #+clozure 'ccl::format-control
- #+(or cmucl scl) 'conditions::format-control
- #+(or gcl lispworks) 'conditions::format-string
- #+sbcl 'sb-kernel:format-control
- #-(or abcl allegro clasp clisp clozure cmucl ecl gcl lispworks mkcl sbcl scl) nil
- "Name of the slot for FORMAT-CONTROL in simple-condition")
-
- (defun match-condition-p (x condition)
- "Compare received CONDITION to some pattern X:
-a symbol naming a condition class,
-a simple vector of length 2, arguments to find-symbol* with result as above,
-or a string describing the format-control of a simple-condition."
- (etypecase x
- (symbol (typep condition x))
- ((simple-vector 2)
- (ignore-errors (typep condition (find-symbol* (svref x 0) (svref x 1) nil))))
- (function (funcall x condition))
- (string (and (typep condition 'simple-condition)
- ;; On SBCL, it's always set and the check triggers a warning
- #+(or allegro clozure cmucl lispworks scl)
- (slot-boundp condition +simple-condition-format-control-slot+)
- (ignore-errors (equal (simple-condition-format-control condition) x))))))
-
- (defun match-any-condition-p (condition conditions)
- "match CONDITION against any of the patterns of CONDITIONS supplied"
- (loop :for x :in conditions :thereis (match-condition-p x condition)))
-
- (defun call-with-muffled-conditions (thunk conditions)
- "calls the THUNK in a context where the CONDITIONS are muffled"
- (handler-bind ((t #'(lambda (c) (when (match-any-condition-p c conditions)
- (muffle-warning c)))))
- (funcall thunk)))
-
- (defmacro with-muffled-conditions ((conditions) &body body)
- "Shorthand syntax for CALL-WITH-MUFFLED-CONDITIONS"
- `(call-with-muffled-conditions #'(lambda () ,@body) ,conditions)))
-
-;;; Conditions
-
-(with-upgradability ()
- (define-condition not-implemented-error (error)
- ((functionality :initarg :functionality)
- (format-control :initarg :format-control)
- (format-arguments :initarg :format-arguments))
- (:report (lambda (condition stream)
- (format stream "Not (currently) implemented on ~A: ~S~@[ ~?~]"
- (nth-value 1 (symbol-call :uiop :implementation-type))
- (slot-value condition 'functionality)
- (slot-value condition 'format-control)
- (slot-value condition 'format-arguments)))))
-
- (defun not-implemented-error (functionality &optional format-control &rest format-arguments)
- "Signal an error because some FUNCTIONALITY is not implemented in the current version
-of the software on the current platform; it may or may not be implemented in different combinations
-of version of the software and of the underlying platform. Optionally, report a formatted error
-message."
- (error 'not-implemented-error
- :functionality functionality
- :format-control format-control
- :format-arguments format-arguments))
-
- (define-condition parameter-error (error)
- ((functionality :initarg :functionality)
- (format-control :initarg :format-control)
- (format-arguments :initarg :format-arguments))
- (:report (lambda (condition stream)
- (apply 'format stream
- (slot-value condition 'format-control)
- (slot-value condition 'functionality)
- (slot-value condition 'format-arguments)))))
-
- ;; Note that functionality MUST be passed as the second argument to parameter-error, just after
- ;; the format-control. If you want it to not appear in first position in actual message, use
- ;; ~* and ~:* to adjust parameter order.
- (defun parameter-error (format-control functionality &rest format-arguments)
- "Signal an error because some FUNCTIONALITY or its specific implementation on a given underlying
-platform does not accept a given parameter or combination of parameters. Report a formatted error
-message, that takes the functionality as its first argument (that can be skipped with ~*)."
- (error 'parameter-error
- :functionality functionality
- :format-control format-control
- :format-arguments format-arguments)))
-
(DIR) diff --git a/3rdparties/software/uiop-3.3.2/version.lisp b/3rdparties/software/uiop-3.3.2/version.lisp
@@ -1,181 +0,0 @@
-(uiop/package:define-package :uiop/version
- (:recycle :uiop/version :uiop/utility :asdf)
- (:use :uiop/common-lisp :uiop/package :uiop/utility)
- (:export
- #:*uiop-version*
- #:parse-version #:unparse-version #:version< #:version<= ;; version support, moved from uiop/utility
- #:next-version
- #:deprecated-function-condition #:deprecated-function-name ;; deprecation control
- #:deprecated-function-style-warning #:deprecated-function-warning
- #:deprecated-function-error #:deprecated-function-should-be-deleted
- #:version-deprecation #:with-deprecation))
-(in-package :uiop/version)
-
-(with-upgradability ()
- (defparameter *uiop-version* "3.3.2")
-
- (defun unparse-version (version-list)
- "From a parsed version (a list of natural numbers), compute the version string"
- (format nil "~{~D~^.~}" version-list))
-
- (defun parse-version (version-string &optional on-error)
- "Parse a VERSION-STRING as a series of natural numbers separated by dots.
-Return a (non-null) list of integers if the string is valid;
-otherwise return NIL.
-
-When invalid, ON-ERROR is called as per CALL-FUNCTION before to return NIL,
-with format arguments explaining why the version is invalid.
-ON-ERROR is also called if the version is not canonical
-in that it doesn't print back to itself, but the list is returned anyway."
- (block nil
- (unless (stringp version-string)
- (call-function on-error "~S: ~S is not a string" 'parse-version version-string)
- (return))
- (unless (loop :for prev = nil :then c :for c :across version-string
- :always (or (digit-char-p c)
- (and (eql c #\.) prev (not (eql prev #\.))))
- :finally (return (and c (digit-char-p c))))
- (call-function on-error "~S: ~S doesn't follow asdf version numbering convention"
- 'parse-version version-string)
- (return))
- (let* ((version-list
- (mapcar #'parse-integer (split-string version-string :separator ".")))
- (normalized-version (unparse-version version-list)))
- (unless (equal version-string normalized-version)
- (call-function on-error "~S: ~S contains leading zeros" 'parse-version version-string))
- version-list)))
-
- (defun next-version (version)
- "When VERSION is not nil, it is a string, then parse it as a version, compute the next version
-and return it as a string."
- (when version
- (let ((version-list (parse-version version)))
- (incf (car (last version-list)))
- (unparse-version version-list))))
-
- (defun version< (version1 version2)
- "Given two version strings, return T if the second is strictly newer"
- (let ((v1 (parse-version version1 nil))
- (v2 (parse-version version2 nil)))
- (lexicographic< '< v1 v2)))
-
- (defun version<= (version1 version2)
- "Given two version strings, return T if the second is newer or the same"
- (not (version< version2 version1))))
-
-
-(with-upgradability ()
- (define-condition deprecated-function-condition (condition)
- ((name :initarg :name :reader deprecated-function-name)))
- (define-condition deprecated-function-style-warning (deprecated-function-condition style-warning) ())
- (define-condition deprecated-function-warning (deprecated-function-condition warning) ())
- (define-condition deprecated-function-error (deprecated-function-condition error) ())
- (define-condition deprecated-function-should-be-deleted (deprecated-function-condition error) ())
-
- (defun deprecated-function-condition-kind (type)
- (ecase type
- ((deprecated-function-style-warning) :style-warning)
- ((deprecated-function-warning) :warning)
- ((deprecated-function-error) :error)
- ((deprecated-function-should-be-deleted) :delete)))
-
- (defmethod print-object ((c deprecated-function-condition) stream)
- (let ((name (deprecated-function-name c)))
- (cond
- (*print-readably*
- (let ((fmt "#.(make-condition '~S :name ~S)")
- (args (list (type-of c) name)))
- (if *read-eval*
- (apply 'format stream fmt args)
- (error "Can't print ~?" fmt args))))
- (*print-escape*
- (print-unreadable-object (c stream :type t) (format stream ":name ~S" name)))
- (t
- (let ((*package* (find-package :cl))
- (type (type-of c)))
- (format stream
- (if (eq type 'deprecated-function-should-be-deleted)
- "~A: Still defining deprecated function~:P ~{~S~^ ~} that promised to delete"
- "~A: Using deprecated function ~S -- please update your code to use a newer API.~
-~@[~%The docstring for this function says:~%~A~%~]")
- type name (when (symbolp name) (documentation name 'function))))))))
-
- (defun notify-deprecated-function (status name)
- (ecase status
- ((nil) nil)
- ((:style-warning) (style-warn 'deprecated-function-style-warning :name name))
- ((:warning) (warn 'deprecated-function-warning :name name))
- ((:error) (cerror "USE FUNCTION ANYWAY" 'deprecated-function-error :name name))))
-
- (defun version-deprecation (version &key (style-warning nil)
- (warning (next-version style-warning))
- (error (next-version warning))
- (delete (next-version error)))
- "Given a VERSION string, and the starting versions for notifying the programmer of
-various levels of deprecation, return the current level of deprecation as per WITH-DEPRECATION
-that is the highest level that has a declared version older than the specified version.
-Each start version for a level of deprecation can be specified by a keyword argument, or
-if left unspecified, will be the NEXT-VERSION of the immediate lower level of deprecation."
- (cond
- ((and delete (version<= delete version)) :delete)
- ((and error (version<= error version)) :error)
- ((and warning (version<= warning version)) :warning)
- ((and style-warning (version<= style-warning version)) :style-warning)))
-
- (defmacro with-deprecation ((level) &body definitions)
- "Given a deprecation LEVEL (a form to be EVAL'ed at macro-expansion time), instrument the
-DEFUN and DEFMETHOD forms in DEFINITIONS to notify the programmer of the deprecation of the function
-when it is compiled or called.
-
-Increasing levels (as result from evaluating LEVEL) are: NIL (not deprecated yet),
-:STYLE-WARNING (a style warning is issued when used), :WARNING (a full warning is issued when used),
-:ERROR (a continuable error instead), and :DELETE (it's an error if the code is still there while
-at that level).
-
-Forms other than DEFUN and DEFMETHOD are not instrumented, and you can protect a DEFUN or DEFMETHOD
-from instrumentation by enclosing it in a PROGN."
- (let ((level (eval level)))
- (check-type level (member nil :style-warning :warning :error :delete))
- (when (eq level :delete)
- (error 'deprecated-function-should-be-deleted :name
- (mapcar 'second
- (remove-if-not #'(lambda (x) (member x '(defun defmethod)))
- definitions :key 'first))))
- (labels ((instrument (name head body whole)
- (if level
- (let ((notifiedp
- (intern (format nil "*~A-~A-~A-~A*"
- :deprecated-function level name :notified-p))))
- (multiple-value-bind (remaining-forms declarations doc-string)
- (parse-body body :documentation t :whole whole)
- `(progn
- (defparameter ,notifiedp nil)
- ;; tell some implementations to use the compiler-macro
- (declaim (inline ,name))
- (define-compiler-macro ,name (&whole form &rest args)
- (declare (ignore args))
- (notify-deprecated-function ,level ',name)
- form)
- (,@head ,@(when doc-string (list doc-string)) ,@declarations
- (unless ,notifiedp
- (setf ,notifiedp t)
- (notify-deprecated-function ,level ',name))
- ,@remaining-forms))))
- `(progn
- (eval-when (:compile-toplevel :load-toplevel :execute)
- (setf (compiler-macro-function ',name) nil))
- (declaim (notinline ,name))
- (,@head ,@body)))))
- `(progn
- ,@(loop :for form :in definitions :collect
- (cond
- ((and (consp form) (eq (car form) 'defun))
- (instrument (second form) (subseq form 0 3) (subseq form 3) form))
- ((and (consp form) (eq (car form) 'defmethod))
- (let ((body-start (if (listp (third form)) 3 4)))
- (instrument (second form)
- (subseq form 0 body-start)
- (subseq form body-start)
- form)))
- (t
- form))))))))
(DIR) diff --git a/3rdparties/software/usocket-0.7.1/.gitignore b/3rdparties/software/usocket-0.7.1/.gitignore
@@ -1 +0,0 @@
-*~
(DIR) diff --git a/3rdparties/software/usocket-0.7.1/CHANGES b/3rdparties/software/usocket-0.7.1/CHANGES
@@ -1,187 +0,0 @@
--*- Mode: Change-Log; Coding: utf-8 -*-
-
-0.7.1: (Aug 31, 2018)
-
-* New feature: GET-(RANDOM)-HOST-BY-NAME (now exported) prefer IPv4 on mixed IPv4/IPv6 (suggested by Mark H. David)
-* New backend: Symbolics Open Genera (Lisp machine) (patch from @Symbolics, #33)
-* Bugfix: [CLISP] fixed issues in server sockets and error handling. (patch from @vibs29, #28, #29)
-* Bugfix: [SBCL, ECL] Fix wait-for-input on Windows SBCL and ECL. (patch from Stas Boukarev, #30)
-* Bugfix: [LW] fixed non-existing system calls in LW 5.0 (comm::socket-set-tcp-nodelay)
-
-0.7.0: (Oct 25, 2016)
-
-* General: Separated USOCKET and USOCKET-SERVER systems (only the server part depends on Portable-threads)
-* General: USOCKET now depends on SPLIT-SEQUENCE (the exactly same vendor code is removed from usocket code base)
-* New feature: [LW] (SOCKET-OPTION :TCP-NODELAY) and its SETF version now works on LispWorks 4/5/6/7.
-* New feature: [LW] SOCKET-CONNECT now supports setting "tcp_nodelay" in version 4.x and 5.0.
-* Bugfix: [CCL] fixed issues in SOCKET-SHUTDOWN
-* Bugfix: [CLISP] fixed issues in WAIT-FOR-INPUT (Thanks to a patch by @vibs29, #27)
-* Bugfix: [LW] fixed loading in version <= 6.0 (actually 0.6.5 only fixed loading in LW 6.1)
-* Bugfix: [ECL] all compilation warnings were checked and fixed.
-
-0.6.5: (Oct 19, 2016)
-
-* New feature: SOCKET-OPTION and (setf SOCKET-OPTION) for :SEND-TIMEOUT (thanks to John Pallister)
-* Bugfix: Let (WAIT-FOR-INPUT NIL &TIMEOUT) return NIL with respect to TIMEOUT.
-* Bugfix: [LW] fixed loading in LispWorks 5.x & 6.x.
-* Bugfix: [LW] fixed SOCKET-SHUTDOWN in all versions.
-* Bugfix: [ABCL] Fixed incorrect IPv6 addresses (#26), patch from Elias Mårtenson (lokedhs)
-
-0.6.4: (Mar 17, 2016)
-
-* New feature: [SBCL] IPv6 support (patch from Guillaume LE VAILLANT, #15)
-* New feature: [API] SOCKET-SHUTDOWN added (patch from Thayne McCombs #9)
-* New feature: [Corman] minimal initial support of this platform
-* Bugfix: [SBCL/win32] wait-for-input nil-timeout bug (patch from Michal Herda, #13)
-* Bugfix: [ECL] included unistd.h for gethostname() (patch from Daniel Kochmanski, #7)
-* Bugfix: [LispWorks] SOCKET-RECEIVE now updates %READ-P (patch from Frank James)
-
-0.6.3: (May 23, 2015)
-
-* Bugfix: [CCL] Further fixed CCL-1.11 compatibility and a typo in SOCKET-CONNECT for CCL-1.10.
-* Bugfix: [ECL] Fixed build in some versions.
-* Bugfix: [LispWorks] SOCKET-SEND and SOCKET-RECEIVE now throw conditions if something goes wrong.
-
-0.6.2: (Apr 20, 2015)
-
-* Bugfix: [CCL] Fixed CCL-1.11 compatibility.
-* Bugfix: [ECL] Fixed compatibility on recent versions.
-* Bugfix: [LispWorks] Added support address-in-use-error condition on LW/Win32. (patch from Sergey Katrevich).
-
-0.6.1: (Jun 21, 2013)
-
-* New feature: [MOCL] Initial MOCL support (TCP only, no W-F-I, patch from github.com/Wukix/usocket).
-* New feature: [MCL] Initial UDP support for Macintosh Common Lisp (MCL/RMCL).
-* New feature: Added TCP-NO-DELAY (TCP_NODELAY) support in SOCKET-OPTION, for TCP client
-* Bugfix: [CCL] Added (:external-format ccl:*default-external-format*) to SOCKET-CONNECT, to prevent it fallback to ISO-8859-1 on NIL. (Patch from Vsevolod Dyomkin)
-* Bugfix: [CCL] Performance improved WAIT-FOR-INPUT and other fixes. (patch from Faré <fahree@gmail.com>)
-
-0.6.0: (Dec 26, 2012)
-
-* New feature: SOCKET-OPTION and (setf SOCKET-OPTION) for seting and geting various socket options.
-* New feature: SOCKET-SEND now support an CCL-like OFFSET keyword for sending only parts of the whole buffer.
-* New feature: [ECL] Added support for ECL DFFI mode on Windows. (no need for C compilers now)
-* Bugfix: [ECL] ECL now list sb-bsd-sockets as a dependency but relies on REQUIRE. (patched by Juanjo)
-* Bugfix: [ABCL] Make USOCKET compile warning-free on ABCL again: MAKE-IMMEDIATE-OBJECT was deprecated a while ago in favor of 2 predefined constants.
-* Bugfix: [LispWorks] remove redundant call to hcl:flag-special-free-action. (reported by Kamil Shakirov)
-* Bugfix: [CLISP] improved HANDLE-CONDITION for more CLISP environments.
-
-0.5.5: (Feb 27, 2012)
-
-* Enhancement: SOCKET-CONNECT argument :nodelay can now set to :if-supported (patch from Anton Vodonosov).
-* Enhancement: [Server] adding *remote-host* *remote-port* to socket-server stream handler functions (suggested by Matthew Curry)
-* Bugfix: [LispWorks] Fixed UDP support for LispWorks 6.1 (patch from Camille Troillard by Martin Simmons).
-* Bugfix: [LispWorks] Stop using hcl:add-special-free-action for reclaiming unused UDP socket fds to improve multi-threading stablity (suggested by Camille Troillard).
-* Bugfix: [LispWorks] Fixed SOCKET-CONNECT on Windows, now LOCAL-PORT never have *auto-port* (0) as default value.
-
-0.5.4: (Oct 1, 2011)
-
-* Bugfix: [ECL] Fixed for ECL's MAKE-BUILD by removing some unecessary code (reported by Juan Jose Garcia-Ripoll, the ECL maintainer)
-* Bugfix: [ACL] Fixed for Allegro CL modern mode.
-* Bugfix: [SBCL] SOCKET-CONNECT on TCP won't call bind() when keyword arguments LOCAL-HOST or LOCAL-PORT is not set. (reported by Robert Brown)
-
-0.5.3: (Aug 13, 2011)
-
-* Bugfix: [MCL] Fixed SOCKET-LISTEN on vector addresses like #(0 0 0 0)
-* Bugfix: [MCL] Fixed WAIT-FOR-INPUT on passive sockets (stream-server-usocket)
-* Bugfix: [LispWorks] Fixed using OPEN-UDP-SOCKET in delivered applications (thanks to Camille Troillard and Martin Simmons, this fix is from LispWorks-UDP project).
-* Bugfix: [SBCL] Fixed for "SBCL data flush problem", reported by Robert Brown and confirmed by Nikodemus Siivola.
-
-0.5.2: (May 11, 2011)
-
-* General: [SBCL] SOCKET-CONNECT's TIMEOUT argument was limited on non-Windows platforms.
-* Bugfix: [CLISP] WAIT-FOR-INPUT now functions right (with/without READY-ONLY), this made Hunchentoot working on CLISP. (Thanks to Anton Vodonosov <avodonosov@yandex.ru>)
-* Bugfix: [ABCL] Fix SOCKET-ACCEPT to follow the documented API so that when called without an :ELEMENT-TYPE argument. (Thanks to Mark Evenson, the ABCL developer)
-* Bugfix: [LispWorks] Fixed SOCKET-ACCEPT (Windows only) on WAIT-FOR-INPUTed sockets.
-* Bugfix: [SBCL, ECL] Fixed wrongly STATE set/unset for WAIT-FOR-INPUT on Windows (report by Elliott Slaughter)
-* Enhancement: Additional NAME keyword argument for SOCKET-SERVER for setting the server thread name.
-* Enhancement: [ABCL] GET-ADDRESS now works with underlying IPv6 addresses.
-* Enhancement: [CLISP] missing GET-LOCAL-* methods for STREAM-SERVER-USOCKET was now added.
-
-0.5.1: (Apr 2, 2011)
-
-* New feature: [CLISP] UDP (Datagram) support based on FFI (Win/Mac/Linux), no RAWSOCK needed.
-* Enhancement: SOCKET-SERVER return a second value (socket) when calling in new-thread mode.
-* Enhancement: [CLISP] Full support of DNS helper functions (GET-HOST-BY-NAME, ...) added.
-* Enhancement: [CLISP] Better network error type detection based on OS error code.
-* Enhancement: [LispWorks] Better network error type detection based on OS error code.
-* Bugfix: Fixed wrong macro expansions of {IP|PORT}-{FROM|TO}-OCTET-BUFFER functions (since 0.4.0)
-* Bugfix: SOCKET-CONNECT didn't set CONNECTED-P for datagram usockets on most backends.
-* Bugfix: [SBCL] Fixes for "SBCL/Win32: finalizer problem, etc", by Anton Kovalenko <anton@sw4me.com>
-* Bugfix: [SBCL] Fixed SOCKET-SERVER (UDP) on SBCL due to a issue in SOCKET-CONNECT when HOST is NIL.
-* Bugfix: [SBCL] SOCKET-CONNECT's TIMEOUT argument now works as a "connection timeout".
-* Bugfix: [CMUCL] Fixed SOCKET-SEND on unconnected usockets under Unicode version of CMUCL.
-* Bugfix: [CLISP] Fixed and confirmed UDP (Datagram) support (RAWSOCK version).
-
-0.5.0: (Mar 12, 2011)
-
-* New supported platform: Macintosh Common Lisp (5.0 and up, plus RMCL)
-* Support for UDP (datagram-usocket) was added (for all supported platform except MCL)
-* Add WAIT-FOR-INPUT support for SBCL and ECL on win32.
-* Simple TCP and UDP server API: SOCKET-SERVER
-* Completely rewritten full-feature ABCL backends using latest Java interfaces
-* Lots of bug fixed since 0.4.1
-
-0.4.1: (Dec 27, 2008)
-
-* fixes for ECL, LispWorks, SBCL, SCL
-
-0.4.0: (Oct 28, 2008)
-
-* select()-like api: make a single thread wait for multiple sockets.
-* various socket options for socket-creation with SOCKET-CONNECT.
-
-0.3.6: (Jun 21, 2008)
-
-* Code fixups based on advice from the ECL and OpenMCL maintainers.
-* New exported symbols: WITH-MAPPED-CONDITIONS, NS-CONDITION, NS-ERROR, NS-UNKNOWN-ERROR and NS-UNKNOWN-CONDITION.
-
-0.3.4: (Jul 25, 2007)
-
-* Fix clisp get-host-name, multiple ECL fixes.
-
-0.3.3: (Jun 05, 2007)
-
-* Fix where host resolution routine was unable to resolve would return NIL instead of erroring.
-
-0.3.2: (Mar 04, 2007)
-
-* Fixes for many backends related to closing sockets.
-* LispWorks fix for broken server sockets.
-* API guarantee adjustments in preparation of porting Drakma.
-
-0.3.1: (Feb 28, 2007)
-
-* fixed with-server-socket; prevent creation of invalid sockets; 2 more convenience macros.
-
-0.3.0: (Jan 21, 2007)
-
-* Server sockets
-
-0.2.5: (Jan 19, 2007)
-
-* Allegro compilation fix.
-
-0.2.4: (Jan 17, 2007)
-
-* Various fixes for CMUCL, OpenMCL, Allegro and LispWorks.
-
-0.2.3: (Jan 04, 2007)
-
-* Add :element-type support to support stacking flexi-streams on socket streams for portable :external-format support.
-
-0.2.2: (Jan 03, 2007)
-
-* Add ECL support and a small SBCL bugfix.
-
-0.2.1: (Dec 21, 2006)
-
-* Remove 'open-stream' interface which is supposed to be provided by the 'trivial-usocket' package.
-
-0.2.0: (Dec 18, 2006)
-
-* Add support for Scieneer Common Lisp, fix issue #6 and API preparation for server side sockets (not in this release)
-
-0.1.0: (Feb 13, 2006)
-
-* Initial release
(DIR) diff --git a/3rdparties/software/usocket-0.7.1/CONTRIBUTORS b/3rdparties/software/usocket-0.7.1/CONTRIBUTORS
@@ -1,35 +0,0 @@
--*- Mode: outline -*-
-
-List of USOCKET Contributors (incomplete)
-
-* Attila Lendvai <attila.lendvai@gmail.com>
- - better handling of unsupported Lisps
-
-* Vladimir Sekissov <svg@surnet.ru>
- - fixes for CMUCL implementation
-
-* Pierre Thierry <nowhere.man@levallois.eu.org>
- - added license information
-
-* Stelian Ionescu <sionescu@cddr.org>
- - finished conversion from generic functions
- - enabled running thread-safe code in unthreaded lisps
-
-* Douglas Crosher <dtc@scieneer.com>
- - added Scieneer Common Lisp support
-
-* Frank James
- - UDP fixes and test cases
-
-* Mark H. David <mhd@yv.org>
- - UDP test cases
- - Suggestions on fixing GET-HOST-BY-NAME and HOST-TO-HBO
-
-* Elliott Slaughter <elliottslaughter@gmail.com>
- - Advanced WAIT-FOR-INPUT test case
-
-* Anton Vodonosov <avodonosov@yandex.ru>
- - CLISP fixes
-
-* Terje Norderhaug <terje@in-progress.com>
- - MCL vendor code
(DIR) diff --git a/3rdparties/software/usocket-0.7.1/LICENSE b/3rdparties/software/usocket-0.7.1/LICENSE
@@ -1,25 +0,0 @@
-(This is the MIT / X Consortium license as taken from
- http://www.opensource.org/licenses/mit-license.html)
-
-Copyright (c) 2003 Erik Enge
-Copyright (c) 2006-2007 Erik Huelsmann
-Copyright (c) 2008-2018 Hans Hueber and Chun Tian
-
-Permission is hereby granted, free of charge, to any person obtaining
-a copy of this software and associated documentation files (the
-"Software"), to deal in the Software without restriction, including
-without limitation the rights to use, copy, modify, merge, publish,
-distribute, sublicense, and/or sell copies of the Software, and to
-permit persons to whom the Software is furnished to do so, subject to
-the following conditions:
-
-The above copyright notice and this permission notice shall be
-included in all copies or substantial portions of the Software.
-
-THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
-EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
-MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
-NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
-LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
-OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
-WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
(DIR) diff --git a/3rdparties/software/usocket-0.7.1/README.md b/3rdparties/software/usocket-0.7.1/README.md
@@ -1,144 +0,0 @@
-# Introduction
-
-This is the usocket Common Lisp sockets library: a library to bring
-sockets access to the broadest of common lisp implementations as possible.
-
-## The library currently supports:
-
- 1. Allegro CL
- 2. ABCL (ArmedBear)
- 3. Clozure CL
- 4. Corman Lisp
- 5. GNU CLISP
- 6. CMUCL
- 7. ECL
- 8. LispWorks (4.3 and up)
- 9. Digitool MCL and RMCL (5.0 and up)
- 10. MOCL
- 11. SBCL
- 12. Scieneer CL
- 13. Symbolics Genera
-
-If your favorite common lisp misses in the list above, please contact
-usocket-devel@common-lisp.net and submit a request. Please include
-references to available sockets functions in your lisp implementation.
-
-The library has been ASDF (http://cliki.net/ASDF) enabled, meaning
-that you can tar up a checkout and use that to ASDF-INSTALL:INSTALL
-the package in your system package site. (Or use your usual ASDF
-tricks to use the checkout directly.)
-
-## Remarks on licensing
-
-Even though the source code has an MIT style license attached to it,
-when compiling this code with some of the supported lisp implementations
-you may not end up with an MIT style binary version due to the licensing
-of the implementations themselves. ECL is such an example and - when
-it will become supported - GCL is like that too.
-
-## Non-support of :external-format
-
-Because of its definition in the hyperspec, there's no common
-external-format between lisp implementations: every vendor has chosen
-a different way to solve the problem of newline translation or
-character set recoding.
-
-Because there's no way to avoid platform specific code in the application
-when using external-format, the purpose of a portability layer gets
-defeated. So, for now, usocket doesn't support external-format.
-
-The workaround to get reasonably portable external-format support is to
-layer a flexi-stream (from flexi-streams) on top of a usocket stream.
-
-## API definition
-
- - usocket (class)
- - stream-usocket (class; usocket derivative)
- - stream-server-usocket (class; usocket derivative)
- - socket-connect (function) [ to create an active/connected socket ]
- socket-connect host port &key element-type
- where `host' is a vectorized ip
- or a string representation of a dotted ip address
- or a hostname for lookup in the DNS system
- - socket-listen (function) [ to create a passive/listening socket ]
- socket-listen host port &key reuseaddress backlog element-type
- where `host' has the same definition as above
- - socket-accept (method) [ to create an active/connected socket ]
- socket-accept socket &key element-type
- returns (server side) a connected socket derived from a
- listening/passive socket.
- - socket-close (method)
- socket-close socket
- where socket a previously returned socket
- - socket (usocket slot accessor),
- the internal/implementation defined socket representation
- - socket-stream (usocket slot accessor),
- socket-stream socket
- the return value of which satisfies the normal stream interface
- - socket-shutdown
-
-### Errors:
- - address-in-use-error
- - address-not-available-error
- - bad-file-descriptor-error
- - connection-refused-error
- - connection-aborted-error
- - connection-reset-error
- - invalid-argument-error
- - no-buffers-error
- - operation-not-supported-error
- - operation-not-permitted-error
- - protocol-not-supported-error
- - socket-type-not-supported-error
- - network-unreachable-error
- - network-down-error
- - network-reset-error
- - host-down-error
- - host-unreachable-error
- - shutdown-error
- - timeout-error
- - unkown-error
-
-### Non-fatal conditions:
- - interrupted-condition
- - unkown-condition
-
-(for a description of the API methods and functions see
- https://common-lisp.net/project/usocket/api-docs.shtml)
-
-## Test suite
-
-The test suite unfortunately isn't mature enough yet to run without
-some manual configuration. Several elements are required which are
-hard to programatically detect. Please adjust the test file before
-running the tests, for these variables:
-
-- +non-existing-host+: The stringified IP address of a host on the
- same subnet. No physical host may be present.
-- +unused-local-port+: A port number of a port not in use on the
- machine the tests run on.
-- +common-lisp-net+: A vector with 4 integer elements which make up
- an IP address. This must be the IP "common-lisp.net" resolves to.
-
-## Known problems
-
-- CMUCL error reporting wrt sockets raises only simple-errors
- meaning there's no way to tell different error conditions apart.
- All errors are mapped to unknown-error on CMUCL.
-
-- The ArmedBear backend doesn't do any error mapping (yet). Java
- defines exceptions at the wrong level (IMO), since the exception
- reported bares a relation to the function failing, not the actual
- error that occurred: for example 'Address already in use' (when
- creating a passive socket) is reported as a BindException with
- an error text of 'Address already in use'. There's no way to sanely
- map 'BindException' to a meaningfull error in usocket. [This does not
- mean the backend should not at least map to 'unknown-error'!]
-
-- When using the library with ECL, you need the C compiler installed
- to be able to compile and load the Foreign Function Interface.
- Not all ECL targets support DFFI yet, so on some targets this would
- be the case anyway. By depending on this technique, usocket can
- reuse the FFI code on all platforms (including Windows). This benefit
- currently outweighs the additional requirement. (hey, it's *Embeddable*
- Common Lisp, so, you probably wanted to embed it all along, right?)
(DIR) diff --git a/3rdparties/software/usocket-0.7.1/TODO b/3rdparties/software/usocket-0.7.1/TODO
@@ -1,5 +0,0 @@
-- Fix condition systems (making all implementation generate same error)
-- Add INET6 support.
-- IOlib backend
-
-For more TODO items, see http://trac.common-lisp.net/usocket/report.
(DIR) diff --git a/3rdparties/software/usocket-0.7.1/backend/.gitignore b/3rdparties/software/usocket-0.7.1/backend/.gitignore
@@ -1 +0,0 @@
-*~
(DIR) diff --git a/3rdparties/software/usocket-0.7.1/backend/abcl.lisp b/3rdparties/software/usocket-0.7.1/backend/abcl.lisp
@@ -1,440 +0,0 @@
-;;;; New ABCL networking support (replacement to old armedbear.lisp)
-;;;; Author: Chun Tian (binghe)
-
-;;;; See LICENSE for licensing information.
-
-(in-package :usocket)
-
-;;; Java Classes ($*...)
-(defvar $*boolean (jclass "boolean"))
-(defvar $*byte (jclass "byte"))
-(defvar $*byte[] (jclass "[B"))
-(defvar $*int (jclass "int"))
-(defvar $*long (jclass "long"))
-(defvar $*|Byte| (jclass "java.lang.Byte"))
-(defvar $*DatagramChannel (jclass "java.nio.channels.DatagramChannel"))
-(defvar $*DatagramPacket (jclass "java.net.DatagramPacket"))
-(defvar $*DatagramSocket (jclass "java.net.DatagramSocket"))
-(defvar $*Inet4Address (jclass "java.net.Inet4Address"))
-(defvar $*InetAddress (jclass "java.net.InetAddress"))
-(defvar $*InetSocketAddress (jclass "java.net.InetSocketAddress"))
-(defvar $*Iterator (jclass "java.util.Iterator"))
-(defvar $*SelectableChannel (jclass "java.nio.channels.SelectableChannel"))
-(defvar $*SelectionKey (jclass "java.nio.channels.SelectionKey"))
-(defvar $*Selector (jclass "java.nio.channels.Selector"))
-(defvar $*ServerSocket (jclass "java.net.ServerSocket"))
-(defvar $*ServerSocketChannel (jclass "java.nio.channels.ServerSocketChannel"))
-(defvar $*Set (jclass "java.util.Set"))
-(defvar $*Socket (jclass "java.net.Socket"))
-(defvar $*SocketAddress (jclass "java.net.SocketAddress"))
-(defvar $*SocketChannel (jclass "java.nio.channels.SocketChannel"))
-(defvar $*String (jclass "java.lang.String"))
-
-;;; Java Constructor ($%.../n)
-(defvar $%Byte/0 (jconstructor $*|Byte| $*byte))
-(defvar $%DatagramPacket/3 (jconstructor $*DatagramPacket $*byte[] $*int $*int))
-(defvar $%DatagramPacket/5 (jconstructor $*DatagramPacket $*byte[] $*int $*int $*InetAddress $*int))
-(defvar $%DatagramSocket/0 (jconstructor $*DatagramSocket))
-(defvar $%DatagramSocket/1 (jconstructor $*DatagramSocket $*int))
-(defvar $%DatagramSocket/2 (jconstructor $*DatagramSocket $*int $*InetAddress))
-(defvar $%InetSocketAddress/1 (jconstructor $*InetSocketAddress $*int))
-(defvar $%InetSocketAddress/2 (jconstructor $*InetSocketAddress $*InetAddress $*int))
-(defvar $%ServerSocket/0 (jconstructor $*ServerSocket))
-(defvar $%ServerSocket/1 (jconstructor $*ServerSocket $*int))
-(defvar $%ServerSocket/2 (jconstructor $*ServerSocket $*int $*int))
-(defvar $%ServerSocket/3 (jconstructor $*ServerSocket $*int $*int $*InetAddress))
-(defvar $%Socket/0 (jconstructor $*Socket))
-(defvar $%Socket/2 (jconstructor $*Socket $*InetAddress $*int))
-(defvar $%Socket/4 (jconstructor $*Socket $*InetAddress $*int $*InetAddress $*int))
-
-;;; Java Methods ($@...[/Class]/n)
-(defvar $@accept/0 (jmethod $*ServerSocket "accept"))
-(defvar $@bind/DatagramSocket/1 (jmethod $*DatagramSocket "bind" $*SocketAddress))
-(defvar $@bind/ServerSocket/1 (jmethod $*ServerSocket "bind" $*SocketAddress))
-(defvar $@bind/ServerSocket/2 (jmethod $*ServerSocket "bind" $*SocketAddress $*int))
-(defvar $@bind/Socket/1 (jmethod $*Socket "bind" $*SocketAddress))
-(defvar $@byteValue/0 (jmethod $*|Byte| "byteValue"))
-(defvar $@channel/0 (jmethod $*SelectionKey "channel"))
-(defvar $@close/DatagramSocket/0 (jmethod $*DatagramSocket "close"))
-(defvar $@close/Selector/0 (jmethod $*Selector "close"))
-(defvar $@close/ServerSocket/0 (jmethod $*ServerSocket "close"))
-(defvar $@close/Socket/0 (jmethod $*Socket "close"))
-(defvar $@shutdownInput/Socket/0 (jmethod $*Socket "shutdownInput"))
-(defvar $@shutdownOutput/Socket/0 (jmethod $*Socket "shutdownOutput"))
-(defvar $@configureBlocking/1 (jmethod $*SelectableChannel "configureBlocking" $*boolean))
-(defvar $@connect/DatagramChannel/1 (jmethod $*DatagramChannel "connect" $*SocketAddress))
-(defvar $@connect/Socket/1 (jmethod $*Socket "connect" $*SocketAddress))
-(defvar $@connect/Socket/2 (jmethod $*Socket "connect" $*SocketAddress $*int))
-(defvar $@connect/SocketChannel/1 (jmethod $*SocketChannel "connect" $*SocketAddress))
-(defvar $@getAddress/0 (jmethod $*InetAddress "getAddress"))
-(defvar $@getAllByName/1 (jmethod $*InetAddress "getAllByName" $*String))
-(defvar $@getByName/1 (jmethod $*InetAddress "getByName" $*String))
-(defvar $@getChannel/DatagramSocket/0 (jmethod $*DatagramSocket "getChannel"))
-(defvar $@getChannel/ServerSocket/0 (jmethod $*ServerSocket "getChannel"))
-(defvar $@getChannel/Socket/0 (jmethod $*Socket "getChannel"))
-(defvar $@getAddress/DatagramPacket/0 (jmethod $*DatagramPacket "getAddress"))
-(defvar $@getHostName/0 (jmethod $*InetAddress "getHostName"))
-(defvar $@getInetAddress/DatagramSocket/0 (jmethod $*DatagramSocket "getInetAddress"))
-(defvar $@getInetAddress/ServerSocket/0 (jmethod $*ServerSocket "getInetAddress"))
-(defvar $@getInetAddress/Socket/0 (jmethod $*Socket "getInetAddress"))
-(defvar $@getLength/DatagramPacket/0 (jmethod $*DatagramPacket "getLength"))
-(defvar $@getLocalAddress/DatagramSocket/0 (jmethod $*DatagramSocket "getLocalAddress"))
-(defvar $@getLocalAddress/Socket/0 (jmethod $*Socket "getLocalAddress"))
-(defvar $@getLocalPort/DatagramSocket/0 (jmethod $*DatagramSocket "getLocalPort"))
-(defvar $@getLocalPort/ServerSocket/0 (jmethod $*ServerSocket "getLocalPort"))
-(defvar $@getLocalPort/Socket/0 (jmethod $*Socket "getLocalPort"))
-(defvar $@getOffset/DatagramPacket/0 (jmethod $*DatagramPacket "getOffset"))
-(defvar $@getPort/DatagramPacket/0 (jmethod $*DatagramPacket "getPort"))
-(defvar $@getPort/DatagramSocket/0 (jmethod $*DatagramSocket "getPort"))
-(defvar $@getPort/Socket/0 (jmethod $*Socket "getPort"))
-(defvar $@hasNext/0 (jmethod $*Iterator "hasNext"))
-(defvar $@iterator/0 (jmethod $*Set "iterator"))
-(defvar $@next/0 (jmethod $*Iterator "next"))
-(defvar $@open/DatagramChannel/0 (jmethod $*DatagramChannel "open"))
-(defvar $@open/Selector/0 (jmethod $*Selector "open"))
-(defvar $@open/ServerSocketChannel/0 (jmethod $*ServerSocketChannel "open"))
-(defvar $@open/SocketChannel/0 (jmethod $*SocketChannel "open"))
-(defvar $@receive/1 (jmethod $*DatagramSocket "receive" $*DatagramPacket))
-(defvar $@register/2 (jmethod $*SelectableChannel "register" $*Selector $*int))
-(defvar $@select/0 (jmethod $*Selector "select"))
-(defvar $@select/1 (jmethod $*Selector "select" $*long))
-(defvar $@selectedKeys/0 (jmethod $*Selector "selectedKeys"))
-(defvar $@send/1 (jmethod $*DatagramSocket "send" $*DatagramPacket))
-(defvar $@setReuseAddress/1 (jmethod $*ServerSocket "setReuseAddress" $*boolean))
-(defvar $@setSoTimeout/DatagramSocket/1 (jmethod $*DatagramSocket "setSoTimeout" $*int))
-(defvar $@setSoTimeout/Socket/1 (jmethod $*Socket "setSoTimeout" $*int))
-(defvar $@setTcpNoDelay/1 (jmethod $*Socket "setTcpNoDelay" $*boolean))
-(defvar $@socket/DatagramChannel/0 (jmethod $*DatagramChannel "socket"))
-(defvar $@socket/ServerSocketChannel/0 (jmethod $*ServerSocketChannel "socket"))
-(defvar $@socket/SocketChannel/0 (jmethod $*SocketChannel "socket"))
-(defvar $@validOps/0 (jmethod $*SelectableChannel "validOps"))
-
-;;; Java Field Variables ($+...)
-(defvar $+op-accept (jfield $*SelectionKey "OP_ACCEPT"))
-(defvar $+op-connect (jfield $*SelectionKey "OP_CONNECT"))
-(defvar $+op-read (jfield $*SelectionKey "OP_READ"))
-(defvar $+op-write (jfield $*SelectionKey "OP_WRITE"))
-
-
-;;; Wrapper functions (return-type: java-object)
-(defun %get-address (address)
- (jcall $@getAddress/0 address))
-(defun %get-all-by-name (string) ; return a simple vector
- (jstatic $@getAllByName/1 $*InetAddress string))
-(defun %get-by-name (string)
- (jstatic $@getByName/1 $*InetAddress string))
-
-(defun host-to-inet4 (host)
- "USOCKET host formats to Java Inet4Address, used internally."
- (%get-by-name (host-to-hostname host)))
-
-;;; HANDLE-CONTITION
-
-(defparameter +abcl-error-map+
- `(("java.net.BindException" . operation-not-permitted-error)
- ("java.net.ConnectException" . connection-refused-error)
- ("java.net.NoRouteToHostException" . network-unreachable-error) ; untested
- ("java.net.PortUnreachableException" . protocol-not-supported-error) ; untested
- ("java.net.ProtocolException" . protocol-not-supported-error) ; untested
- ("java.net.SocketException" . socket-type-not-supported-error) ; untested
- ("java.net.SocketTimeoutException" . timeout-error)))
-
-(defparameter +abcl-nameserver-error-map+
- `(("java.net.UnknownHostException" . ns-host-not-found-error)))
-
-(defun handle-condition (condition &optional (socket nil))
- (typecase condition
- (java-exception
- (let ((java-cause (java-exception-cause condition)))
- (let* ((usock-error (cdr (assoc (jclass-of java-cause) +abcl-error-map+
- :test #'string=)))
- (usock-error (if (functionp usock-error)
- (funcall usock-error condition)
- usock-error))
- (nameserver-error (cdr (assoc (jclass-of java-cause) +abcl-nameserver-error-map+
- :test #'string=))))
- (if nameserver-error
- (error nameserver-error :host-or-ip nil)
- (when usock-error
- (error usock-error :socket socket))))))))
-
-;;; GET-HOSTS-BY-NAME
-
-(defun get-address (address)
- (when address
- (let* ((array (%get-address address))
- (length (jarray-length array)))
- (labels ((jbyte (n)
- (let ((byte (jarray-ref array n)))
- (if (minusp byte) (+ 256 byte) byte))))
- (cond
- ((= 4 length)
- (vector (jbyte 0) (jbyte 1) (jbyte 2) (jbyte 3)))
- ((= 16 length)
- (vector (jbyte 0) (jbyte 1) (jbyte 2) (jbyte 3)
- (jbyte 4) (jbyte 5) (jbyte 6) (jbyte 7)
- (jbyte 8) (jbyte 9) (jbyte 10) (jbyte 11)
- (jbyte 12) (jbyte 13) (jbyte 14) (jbyte 15)))
- (t nil)))))) ; neither a IPv4 nor IPv6 address?!
-
-(defun get-hosts-by-name (name)
- (with-mapped-conditions ()
- (map 'list #'get-address (%get-all-by-name name))))
-
-;;; GET-HOST-BY-ADDRESS
-
-(defun get-host-by-address (host)
- (let ((inet4 (host-to-inet4 host)))
- (with-mapped-conditions ()
- (jcall $@getHostName/0 inet4))))
-
-;;; SOCKET-CONNECT
-
-(defun socket-connect (host port &key (protocol :stream) (element-type 'character)
- timeout deadline (nodelay t nodelay-supplied-p)
- local-host local-port)
- (when deadline (unsupported 'deadline 'socket-connect))
- (let (socket stream usocket)
- (ecase protocol
- (:stream ; TCP
- (let ((channel (jstatic $@open/SocketChannel/0 $*SocketChannel))
- (address (jnew $%InetSocketAddress/2 (host-to-inet4 host) port)))
- (setq socket (jcall $@socket/SocketChannel/0 channel))
- ;; bind to local address if needed
- (when (or local-host local-port)
- (let ((local-address (jnew $%InetSocketAddress/2 (host-to-inet4 local-host) (or local-port 0))))
- (with-mapped-conditions ()
- (jcall $@bind/Socket/1 socket local-address))))
- ;; connect to dest address
- (with-mapped-conditions ()
- (jcall $@connect/SocketChannel/1 channel address))
- (setq stream (ext:get-socket-stream socket :element-type element-type)
- usocket (make-stream-socket :stream stream :socket socket))
- (when nodelay-supplied-p
- (jcall $@setTcpNoDelay/1 socket (if nodelay ;; both t and :if-supported mean java:+true+
- java:+true+ java:+false+)))
- (when timeout
- (jcall $@setSoTimeout/Socket/1 socket (truncate (* 1000 timeout))))))
- (:datagram ; UDP
- (let ((channel (jstatic $@open/DatagramChannel/0 $*DatagramChannel)))
- (setq socket (jcall $@socket/DatagramChannel/0 channel))
- ;; bind to local address if needed
- (when (or local-host local-port)
- (let ((local-address (jnew $%InetSocketAddress/2 (host-to-inet4 local-host) (or local-port 0))))
- (with-mapped-conditions ()
- (jcall $@bind/DatagramSocket/1 socket local-address))))
- ;; connect to dest address if needed
- (when (and host port)
- (let ((address (jnew $%InetSocketAddress/2 (host-to-inet4 host) port)))
- (with-mapped-conditions ()
- (jcall $@connect/DatagramChannel/1 channel address))))
- (setq usocket (make-datagram-socket socket :connected-p (if (and host port) t nil)))
- (when timeout
- (jcall $@setSoTimeout/DatagramSocket/1 socket (truncate (* 1000 timeout)))))))
- usocket))
-
-;;; SOCKET-LISTEN
-
-(defun socket-listen (host port &key reuseaddress
- (reuse-address nil reuse-address-supplied-p)
- (backlog 5 backlog-supplied-p)
- (element-type 'character))
- (declare (type boolean reuse-address))
- (let* ((reuseaddress (if reuse-address-supplied-p reuse-address reuseaddress))
- (channel (jstatic $@open/ServerSocketChannel/0 $*ServerSocketChannel))
- (socket (jcall $@socket/ServerSocketChannel/0 channel))
- (endpoint (jnew $%InetSocketAddress/2 (host-to-inet4 host) (or port 0))))
- (jcall $@setReuseAddress/1 socket (if reuseaddress java:+true+ java:+false+))
- (with-mapped-conditions (socket)
- (if backlog-supplied-p
- (jcall $@bind/ServerSocket/2 socket endpoint backlog)
- (jcall $@bind/ServerSocket/1 socket endpoint)))
- (make-stream-server-socket socket :element-type element-type)))
-
-;;; SOCKET-ACCEPT
-
-(defmethod socket-accept ((usocket stream-server-usocket)
- &key (element-type 'character element-type-p))
- (with-mapped-conditions (usocket)
- (let* ((client-socket (jcall $@accept/0 (socket usocket)))
- (element-type (if element-type-p
- element-type
- (element-type usocket)))
- (stream (ext:get-socket-stream client-socket :element-type element-type)))
- (make-stream-socket :stream stream :socket client-socket))))
-
-;;; SOCKET-CLOSE
-
-(defmethod socket-close :before ((usocket usocket))
- (when (wait-list usocket)
- (remove-waiter (wait-list usocket) usocket)))
-
-(defmethod socket-close ((usocket stream-server-usocket))
- (with-mapped-conditions (usocket)
- (jcall $@close/ServerSocket/0 (socket usocket))))
-
-(defmethod socket-close ((usocket stream-usocket))
- (with-mapped-conditions (usocket)
- (close (socket-stream usocket))
- (jcall $@close/Socket/0 (socket usocket))))
-
-(defmethod socket-close ((usocket datagram-usocket))
- (with-mapped-conditions (usocket)
- (jcall $@close/DatagramSocket/0 (socket usocket))))
-
-(defmethod socket-shutdown ((usocket stream-usocket) direction)
- (with-mapped-conditions (usocket)
- (ecase direction
- (:input
- (jcall $@shutdownInput/Socket/0 (socket usocket)))
- (:output
- (jcall $@shutdownOutput/Socket/0 (socket usocket))))))
-
-;;; GET-LOCAL/PEER-NAME/ADDRESS/PORT
-
-(defmethod get-local-name ((usocket usocket))
- (values (get-local-address usocket)
- (get-local-port usocket)))
-
-(defmethod get-peer-name ((usocket usocket))
- (values (get-peer-address usocket)
- (get-peer-port usocket)))
-
-(defmethod get-local-address ((usocket stream-usocket))
- (get-address (jcall $@getLocalAddress/Socket/0 (socket usocket))))
-
-(defmethod get-local-address ((usocket stream-server-usocket))
- (get-address (jcall $@getInetAddress/ServerSocket/0 (socket usocket))))
-
-(defmethod get-local-address ((usocket datagram-usocket))
- (get-address (jcall $@getLocalAddress/DatagramSocket/0 (socket usocket))))
-
-(defmethod get-peer-address ((usocket stream-usocket))
- (get-address (jcall $@getInetAddress/Socket/0 (socket usocket))))
-
-(defmethod get-peer-address ((usocket datagram-usocket))
- (get-address (jcall $@getInetAddress/DatagramSocket/0 (socket usocket))))
-
-(defmethod get-local-port ((usocket stream-usocket))
- (jcall $@getLocalPort/Socket/0 (socket usocket)))
-
-(defmethod get-local-port ((usocket stream-server-usocket))
- (jcall $@getLocalPort/ServerSocket/0 (socket usocket)))
-
-(defmethod get-local-port ((usocket datagram-usocket))
- (jcall $@getLocalPort/DatagramSocket/0 (socket usocket)))
-
-(defmethod get-peer-port ((usocket stream-usocket))
- (jcall $@getPort/Socket/0 (socket usocket)))
-
-(defmethod get-peer-port ((usocket datagram-usocket))
- (jcall $@getPort/DatagramSocket/0 (socket usocket)))
-
-;;; SOCKET-SEND & SOCKET-RECEIVE
-
-(defun *->byte (data)
- (declare (type (unsigned-byte 8) data)) ; required by SOCKET-SEND
- (jnew $%Byte/0 (if (> data 127) (- data 256) data)))
-
-(defun byte->* (byte &optional (element-type '(unsigned-byte 8)))
- (let* ((ub8 (if (minusp byte) (+ 256 byte) byte)))
- (if (eq element-type 'character)
- (code-char ub8)
- ub8)))
-
-(defmethod socket-send ((usocket datagram-usocket) buffer size &key host port (offset 0))
- (let* ((socket (socket usocket))
- (byte-array (jnew-array $*byte size))
- (packet (if (and host port)
- (jnew $%DatagramPacket/5 byte-array 0 size (host-to-inet4 host) port)
- (jnew $%DatagramPacket/3 byte-array 0 size))))
- ;; prepare sending data
- (loop for i from offset below (+ size offset)
- do (setf (jarray-ref byte-array i) (*->byte (aref buffer i))))
- (with-mapped-conditions (usocket)
- (jcall $@send/1 socket packet))))
-
-;;; TODO: return-host and return-port cannot be get ...
-(defmethod socket-receive ((usocket datagram-usocket) buffer length
- &key (element-type '(unsigned-byte 8)))
- (declare (values (simple-array (unsigned-byte 8) (*)) ; buffer
- (integer 0) ; size
- (unsigned-byte 32) ; host
- (unsigned-byte 16))) ; port
- (let* ((socket (socket usocket))
- (real-length (or length +max-datagram-packet-size+))
- (byte-array (jnew-array $*byte real-length))
- (packet (jnew $%DatagramPacket/3 byte-array 0 real-length)))
- (with-mapped-conditions (usocket)
- (jcall $@receive/1 socket packet))
- (let* ((receive-length (jcall $@getLength/DatagramPacket/0 packet))
- (return-buffer (or buffer (make-array receive-length :element-type element-type))))
- (loop for i from 0 below receive-length
- do (setf (aref return-buffer i)
- (byte->* (jarray-ref byte-array i) element-type)))
- (let ((return-host (if (connected-p usocket)
- (get-peer-address usocket)
- (get-address (jcall $@getAddress/DatagramPacket/0 packet))))
- (return-port (if (connected-p usocket)
- (get-peer-port usocket)
- (jcall $@getPort/DatagramPacket/0 packet))))
- (values return-buffer
- receive-length
- return-host
- return-port)))))
-
-;;; WAIT-FOR-INPUT
-
-(defun socket-channel-class (usocket)
- (cond ((stream-usocket-p usocket) $*SocketChannel)
- ((stream-server-usocket-p usocket) $*ServerSocketChannel)
- ((datagram-usocket-p usocket) $*DatagramChannel)))
-
-(defun get-socket-channel (usocket)
- (let ((method (cond ((stream-usocket-p usocket) $@getChannel/Socket/0)
- ((stream-server-usocket-p usocket) $@getChannel/ServerSocket/0)
- ((datagram-usocket-p usocket) $@getChannel/DatagramSocket/0))))
- (jcall method (socket usocket))))
-
-(defun wait-for-input-internal (wait-list &key timeout)
- (let* ((sockets (wait-list-waiters wait-list))
- (ops (logior $+op-read $+op-accept))
- (selector (jstatic $@open/Selector/0 $*Selector))
- (channels (mapcar #'get-socket-channel sockets)))
- (unwind-protect
- (with-mapped-conditions ()
- (dolist (channel channels)
- (jcall $@configureBlocking/1 channel java:+false+)
- (jcall $@register/2 channel selector (logand ops (jcall $@validOps/0 channel))))
- (let ((ready-count (if timeout
- (jcall $@select/1 selector (truncate (* timeout 1000)))
- (jcall $@select/0 selector))))
- (when (plusp ready-count)
- (let* ((keys (jcall $@selectedKeys/0 selector))
- (iterator (jcall $@iterator/0 keys))
- (%wait (wait-list-%wait wait-list)))
- (loop while (jcall $@hasNext/0 iterator)
- do (let* ((key (jcall $@next/0 iterator))
- (channel (jcall $@channel/0 key)))
- (setf (state (gethash channel %wait)) :read)))))))
- (jcall $@close/Selector/0 selector)
- (dolist (channel channels)
- (jcall $@configureBlocking/1 channel java:+true+)))))
-
-;;; WAIT-LIST
-
-;;; NOTE from original worker (Erik):
-;;; Note that even though Java has the concept of the Selector class, which
-;;; remotely looks like a wait-list, it requires the sockets to be non-blocking.
-;;; usocket however doesn't make any such guarantees and is therefore unable to
-;;; use the concept outside of the waiting routine itself (blergh!).
-
-(defun %setup-wait-list (wl)
- (setf (wait-list-%wait wl)
- (make-hash-table :test #'equal :rehash-size 1.3d0)))
-
-(defun %add-waiter (wl w)
- (setf (gethash (get-socket-channel w) (wait-list-%wait wl)) w))
-
-(defun %remove-waiter (wl w)
- (remhash (get-socket-channel w) (wait-list-%wait wl)))
(DIR) diff --git a/3rdparties/software/usocket-0.7.1/backend/allegro.lisp b/3rdparties/software/usocket-0.7.1/backend/allegro.lisp
@@ -1,225 +0,0 @@
-;;;; See LICENSE for licensing information.
-
-(in-package :usocket)
-
-#+cormanlisp
-(eval-when (:compile-toplevel :load-toplevel :execute)
- (require :acl-socket))
-
-#+allegro
-(eval-when (:compile-toplevel :load-toplevel :execute)
- (require :sock)
- ;; for wait-for-input:
- (require :process)
- ;; note: the line below requires ACL 6.2+
- (require :osi))
-
-(defun get-host-name ()
- ;; note: the line below requires ACL 7.0+ to actually *work* on windows
- #+allegro (excl.osi:gethostname)
- #+cormanlisp "")
-
-(defparameter +allegro-identifier-error-map+
- '((:address-in-use . address-in-use-error)
- (:address-not-available . address-not-available-error)
- (:network-down . network-down-error)
- (:network-reset . network-reset-error)
- (:network-unreachable . network-unreachable-error)
- (:connection-aborted . connection-aborted-error)
- (:connection-reset . connection-reset-error)
- (:no-buffer-space . no-buffers-error)
- (:shutdown . shutdown-error)
- (:connection-timed-out . timeout-error)
- (:connection-refused . connection-refused-error)
- (:host-down . host-down-error)
- (:host-unreachable . host-unreachable-error)))
-
-(defun handle-condition (condition &optional (socket nil))
- "Dispatch correct usocket condition."
- (typecase condition
- #+allegro
- (excl:socket-error
- (let ((usock-err
- (cdr (assoc (excl:stream-error-identifier condition)
- +allegro-identifier-error-map+))))
- (if usock-err
- (error usock-err :socket socket)
- (error 'unknown-error
- :real-error condition
- :socket socket))))))
-
-(defun to-format (element-type)
- (if (subtypep element-type 'character)
- :text
- :binary))
-
-(defun socket-connect (host port &key (protocol :stream) (element-type 'character)
- timeout deadline
- (nodelay t) ;; nodelay == t is the ACL default
- local-host local-port)
- (when timeout (unsupported 'timeout 'socket-connect))
- (when deadline (unsupported 'deadline 'socket-connect))
- (when (eq nodelay :if-supported)
- (setf nodelay t))
-
- (let ((socket))
- (setf socket
- (with-mapped-conditions (socket)
- (ecase protocol
- (:stream
- (labels ((make-socket ()
- (socket:make-socket :remote-host (host-to-hostname host)
- :remote-port port
- :local-host (when local-host
- (host-to-hostname local-host))
- :local-port local-port
- :format (to-format element-type)
- :nodelay nodelay)))
- #+allegro
- (if timeout
- (mp:with-timeout (timeout nil)
- (make-socket))
- (make-socket))
- #+cormanlisp (make-socket)))
- (:datagram
- (apply #'socket:make-socket
- (nconc (list :type protocol
- :address-family :internet
- :local-host (when local-host
- (host-to-hostname local-host))
- :local-port local-port
- :format (to-format element-type))
- (if (and host port)
- (list :connect :active
- :remote-host (host-to-hostname host)
- :remote-port port)
- (list :connect :passive))))))))
- (ecase protocol
- (:stream
- (make-stream-socket :socket socket :stream socket))
- (:datagram
- (make-datagram-socket socket :connected-p (and host port t))))))
-
-;; One socket close method is sufficient,
-;; because socket-streams are also sockets.
-(defmethod socket-close ((usocket usocket))
- "Close socket."
- (when (wait-list usocket)
- (remove-waiter (wait-list usocket) usocket))
- (with-mapped-conditions (usocket)
- (close (socket usocket))))
-
-(defmethod socket-shutdown ((usocket stream-usocket) direction)
- (with-mapped-conditions (usocket)
- (socket:shutdown (socket usocket) :direction direction)))
-
-(defun socket-listen (host port
- &key reuseaddress
- (reuse-address nil reuse-address-supplied-p)
- (backlog 5)
- (element-type 'character))
- ;; Allegro and OpenMCL socket interfaces bear very strong resemblence
- ;; whatever you change here, change it also for OpenMCL
- (let* ((reuseaddress (if reuse-address-supplied-p reuse-address reuseaddress))
- (sock (with-mapped-conditions ()
- (apply #'socket:make-socket
- (append (list :connect :passive
- :reuse-address reuseaddress
- :local-port port
- :backlog backlog
- :format (to-format element-type)
- ;; allegro now ignores :format
- )
- (when (ip/= host *wildcard-host*)
- (list :local-host host)))))))
- (make-stream-server-socket sock :element-type element-type)))
-
-(defmethod socket-accept ((socket stream-server-usocket) &key element-type)
- (declare (ignore element-type)) ;; allegro streams are multivalent
- (let ((stream-sock
- (with-mapped-conditions (socket)
- (socket:accept-connection (socket socket)))))
- (make-stream-socket :socket stream-sock :stream stream-sock)))
-
-(defmethod get-local-address ((usocket usocket))
- (hbo-to-vector-quad (socket:local-host (socket usocket))))
-
-(defmethod get-peer-address ((usocket stream-usocket))
- (hbo-to-vector-quad (socket:remote-host (socket usocket))))
-
-(defmethod get-local-port ((usocket usocket))
- (socket:local-port (socket usocket)))
-
-(defmethod get-peer-port ((usocket stream-usocket))
- #+allegro
- (socket:remote-port (socket usocket)))
-
-(defmethod get-local-name ((usocket usocket))
- (values (get-local-address usocket)
- (get-local-port usocket)))
-
-(defmethod get-peer-name ((usocket stream-usocket))
- (values (get-peer-address usocket)
- (get-peer-port usocket)))
-
-#+allegro
-(defmethod socket-send ((usocket datagram-usocket) buffer size &key host port (offset 0))
- (with-mapped-conditions (usocket)
- (let ((s (socket usocket)))
- (socket:send-to s
- (if (zerop offset)
- buffer
- (subseq buffer offset (+ offset size)))
- size
- :remote-host host
- :remote-port port))))
-
-#+allegro
-(defmethod socket-receive ((socket datagram-usocket) buffer length &key)
- (declare (values (simple-array (unsigned-byte 8) (*)) ; buffer
- (integer 0) ; size
- (unsigned-byte 32) ; host
- (unsigned-byte 16))) ; port
- (with-mapped-conditions (socket)
- (let ((s (socket socket)))
- (socket:receive-from s length :buffer buffer :extract t))))
-
-(defun get-host-by-address (address)
- (with-mapped-conditions ()
- (socket:ipaddr-to-hostname (host-to-hbo address))))
-
-(defun get-hosts-by-name (name)
- ;;###FIXME: ACL has the acldns module which returns all A records
- ;; only problem: it doesn't fall back to tcp (from udp) if the returned
- ;; structure is too long.
- (with-mapped-conditions ()
- (list (hbo-to-vector-quad (socket:lookup-hostname
- (host-to-hostname name))))))
-
-(defun %setup-wait-list (wait-list)
- (declare (ignore wait-list)))
-
-(defun %add-waiter (wait-list waiter)
- (push (socket waiter) (wait-list-%wait wait-list)))
-
-(defun %remove-waiter (wait-list waiter)
- (setf (wait-list-%wait wait-list)
- (remove (socket waiter) (wait-list-%wait wait-list))))
-
-#+allegro
-(defun wait-for-input-internal (wait-list &key timeout)
- (with-mapped-conditions ()
- (let ((active-internal-sockets
- (if timeout
- (mp:wait-for-input-available (wait-list-%wait wait-list)
- :timeout timeout)
- (mp:wait-for-input-available (wait-list-%wait wait-list)))))
- ;; this is quadratic, but hey, the active-internal-sockets
- ;; list is very short and it's only quadratic in the length of that one.
- ;; When I have more time I could recode it to something of linear
- ;; complexity.
- ;; [Same code is also used in openmcl.lisp]
- (dolist (x active-internal-sockets)
- (setf (state (gethash x (wait-list-map wait-list)))
- :read))
- wait-list)))
(DIR) diff --git a/3rdparties/software/usocket-0.7.1/backend/clisp.lisp b/3rdparties/software/usocket-0.7.1/backend/clisp.lisp
@@ -1,716 +0,0 @@
-;;;; See LICENSE for licensing information.
-
-(in-package :usocket)
-
-(eval-when (:compile-toplevel :load-toplevel :execute)
- #-ffi
- (warn "This image doesn't contain FFI package, GET-HOST-NAME won't work.")
- #-(or ffi rawsock)
- (warn "This image doesn't contain either FFI or RAWSOCK package, no UDP support."))
-
-;; utility routine for looking up the current host name
-#+ffi
-(ffi:def-call-out get-host-name-internal
- (:name "gethostname")
- (:arguments (name (FFI:C-PTR (FFI:C-ARRAY-MAX ffi:character 256))
- :OUT :ALLOCA)
- (len ffi:int))
- #+win32 (:library "WS2_32")
- #-win32 (:library :default)
- (:language #-win32 :stdc
- #+win32 :stdc-stdcall)
- (:return-type ffi:int))
-
-(defun get-host-name ()
- #+ffi
- (multiple-value-bind (retcode name)
- (get-host-name-internal 256)
- (when (= retcode 0)
- name))
- #-ffi
- "localhost")
-
-(defun get-host-by-address (address)
- (with-mapped-conditions ()
- (let ((hostent (posix:resolve-host-ipaddr (host-to-hostname address))))
- (posix:hostent-name hostent))))
-
-(defun get-hosts-by-name (name)
- (with-mapped-conditions ()
- (let ((hostent (posix:resolve-host-ipaddr name)))
- (mapcar #'host-to-vector-quad
- (posix:hostent-addr-list hostent)))))
-
-;; Format: ((UNIX Windows) . CONDITION)
-(defparameter +clisp-error-map+
- #-win32
- `((:EADDRINUSE . address-in-use-error)
- (:EADDRNOTAVAIL . address-not-available-error)
- (:EBADF . bad-file-descriptor-error)
- (:ECONNREFUSED . connection-refused-error)
- (:ECONNRESET . connection-reset-error)
- (:ECONNABORTED . connection-aborted-error)
- (:EINVAL . invalid-argument-error)
- (:ENOBUFS . no-buffers-error)
- (:ENOMEM . out-of-memory-error)
- (:ENOTSUP . operation-not-supported-error)
- (:EPERM . operation-not-permitted-error)
- (:EPROTONOSUPPORT . protocol-not-supported-error)
- (:ESOCKTNOSUPPORT . socket-type-not-supported-error)
- (:ENETUNREACH . network-unreachable-error)
- (:ENETDOWN . network-down-error)
- (:ENETRESET . network-reset-error)
- (:ESHUTDOWN . already-shutdown-error)
- (:ETIMEDOUT . timeout-error)
- (:EHOSTDOWN . host-down-error)
- (:EHOSTUNREACH . host-unreachable-error)
- ;; when blocked reading, and we close our socket due to a timeout.
- ;; POSIX.1 says that EAGAIN and EWOULDBLOCK may have the same values.
- (:EAGAIN . timeout-error)
- (:EWOULDBLOCK . timeout-error)) ;linux
- #+win32
- `((:WSAEADDRINUSE . address-in-use-error)
- (:WSAEADDRNOTAVAIL . address-not-available-error)
- (:WSAEBADF . bad-file-descriptor-error)
- (:WSAECONNREFUSED . connection-refused-error)
- (:WSAECONNRESET . connection-reset-error)
- (:WSAECONNABORTED . connection-aborted-error)
- (:WSAEINVAL . invalid-argument-error)
- (:WSAENOBUFS . no-buffers-error)
- (:WSAENOMEM . out-of-memory-error)
- (:WSAENOTSUP . operation-not-supported-error)
- (:WSAEPERM . operation-not-permitted-error)
- (:WSAEPROTONOSUPPORT . protocol-not-supported-error)
- (:WSAESOCKTNOSUPPORT . socket-type-not-supported-error)
- (:WSAENETUNREACH . network-unreachable-error)
- (:WSAENETDOWN . network-down-error)
- (:WSAENETRESET . network-reset-error)
- (:WSAESHUTDOWN . already-shutdown-error)
- (:WSAETIMEDOUT . timeout-error)
- (:WSAEHOSTDOWN . host-down-error)
- (:WSAEHOSTUNREACH . host-unreachable-error)))
-
-(defun parse-errno (condition)
- "Returns a number or keyword if it can parse what is within parens, else NIL"
- (let ((s (princ-to-string condition)))
- (let ((pos1 (position #\( s))
- (pos2 (position #\) s)))
- ;mac: number, linux: keyword
- (ignore-errors
- (if (digit-char-p (char s (1+ pos1)))
- (parse-integer s :start (1+ pos1) :end pos2)
- (let ((*package* (find-package "KEYWORD")))
- (car (read-from-string s t nil :start pos1 :end (1+ pos2)))))))))
-
-(defun handle-condition (condition &optional (socket nil))
- "Dispatch a usocket condition instead of a CLISP specific one, if we can."
- (let ((errno
- (cond
- ;clisp 2.49+
- ((typep condition (find-symbol "OS-STREAM-ERROR" "EXT"))
- (parse-errno condition))
- ;clisp 2.49
- ((typep condition (find-symbol "SIMPLE-STREAM-ERROR" "SYSTEM"))
- (car (simple-condition-format-arguments condition))))))
- (when errno
- (let ((error-keyword (if (keywordp errno) errno #+ffi(os:errno errno))))
- (let ((usocket-error (cdr (assoc error-keyword +clisp-error-map+))))
- (when usocket-error
- (if (subtypep usocket-error 'error)
- (error usocket-error :socket socket)
- (signal usocket-error :socket socket))))))))
-
-(defun socket-connect (host port &key (protocol :stream) (element-type 'character)
- timeout deadline (nodelay t nodelay-specified)
- local-host local-port)
- (declare (ignorable timeout local-host local-port))
- (when deadline (unsupported 'deadline 'socket-connect))
- (when (and nodelay-specified
- (not (eq nodelay :if-supported)))
- (unsupported 'nodelay 'socket-connect))
- (case protocol
- (:stream
- (let ((socket)
- (hostname (host-to-hostname host)))
- (with-mapped-conditions (socket)
- (setf socket
- (if timeout
- (socket:socket-connect port hostname
- :element-type element-type
- :buffered t
- :timeout timeout)
- (socket:socket-connect port hostname
- :element-type element-type
- :buffered t))))
- (make-stream-socket :socket socket
- :stream socket))) ;; the socket is a stream too
- (:datagram
- #+(or rawsock ffi)
- (socket-create-datagram (or local-port *auto-port*)
- :local-host (or local-host *wildcard-host*)
- :remote-host (and host (host-to-vector-quad host))
- :remote-port port)
- #-(or rawsock ffi)
- (unsupported '(protocol :datagram) 'socket-connect))))
-
-(defun socket-listen (host port
- &key reuseaddress
- (reuse-address nil reuse-address-supplied-p)
- (backlog 5)
- (element-type 'character))
- ;; clisp 2.39 sets SO_REUSEADDRESS to 1 by default; no need to
- ;; to explicitly turn it on; unfortunately, there's no way to turn it off...
- (declare (ignore reuseaddress reuse-address reuse-address-supplied-p))
- (let ((sock (apply #'socket:socket-server
- (append (list port
- :backlog backlog)
- (when (ip/= host *wildcard-host*)
- (list :interface host))))))
- (with-mapped-conditions ()
- (make-stream-server-socket sock :element-type element-type))))
-
-(defmethod socket-accept ((socket stream-server-usocket) &key element-type)
- (let ((stream
- (with-mapped-conditions (socket)
- (socket:socket-accept (socket socket)
- :element-type (or element-type
- (element-type socket))))))
- (make-stream-socket :socket stream
- :stream stream)))
-
-;; Only one close method required:
-;; sockets and their associated streams
-;; are the same object
-(defmethod socket-close ((usocket usocket))
- "Close socket."
- (when (wait-list usocket)
- (remove-waiter (wait-list usocket) usocket))
- (with-mapped-conditions (usocket)
- (close (socket usocket))))
-
-(defmethod socket-close ((usocket stream-server-usocket))
- (when (wait-list usocket)
- (remove-waiter (wait-list usocket) usocket))
- (socket:socket-server-close (socket usocket)))
-
-(defmethod socket-shutdown ((usocket stream-usocket) direction)
- (with-mapped-conditions (usocket)
- (socket:socket-stream-shutdown (socket usocket) direction)))
-
-(defmethod get-local-name ((usocket stream-usocket))
- (multiple-value-bind
- (address port)
- (socket:socket-stream-local (socket usocket) t)
- (values (dotted-quad-to-vector-quad address) port)))
-
-(defmethod get-local-name ((usocket stream-server-usocket))
- (values (get-local-address usocket)
- (get-local-port usocket)))
-
-(defmethod get-peer-name ((usocket stream-usocket))
- (multiple-value-bind
- (address port)
- (socket:socket-stream-peer (socket usocket) t)
- (values (dotted-quad-to-vector-quad address) port)))
-
-(defmethod get-local-address ((usocket usocket))
- (nth-value 0 (get-local-name usocket)))
-
-(defmethod get-local-address ((usocket stream-server-usocket))
- (dotted-quad-to-vector-quad
- (socket:socket-server-host (socket usocket))))
-
-(defmethod get-peer-address ((usocket usocket))
- (nth-value 0 (get-peer-name usocket)))
-
-(defmethod get-local-port ((usocket usocket))
- (nth-value 1 (get-local-name usocket)))
-
-(defmethod get-local-port ((usocket stream-server-usocket))
- (socket:socket-server-port (socket usocket)))
-
-(defmethod get-peer-port ((usocket usocket))
- (nth-value 1 (get-peer-name usocket)))
-
-(defun %setup-wait-list (wait-list)
- (declare (ignore wait-list)))
-
-(defun %add-waiter (wait-list waiter)
- ;; clisp's #'socket-status takes a list whose elts look either like,
- ;; (socket-stream direction . x) or like,
- ;; (socket-server . x)
- ;; and it replaces the x's.
- (push (cons (socket waiter)
- (cond ((stream-usocket-p waiter) (cons NIL NIL))
- (t NIL)))
- (wait-list-%wait wait-list)))
-
-(defun %remove-waiter (wait-list waiter)
- (setf (wait-list-%wait wait-list)
- (remove (socket waiter) (wait-list-%wait wait-list) :key #'car)))
-
-(defmethod wait-for-input-internal (wait-list &key timeout)
- (with-mapped-conditions ()
- (multiple-value-bind
- (secs musecs)
- (split-timeout (or timeout 1))
- (dolist (x (wait-list-%wait wait-list))
- (when (consp (cdr x)) ;it's a socket-stream not socket-server
- (setf (cadr x) :INPUT)))
- (let* ((request-list (wait-list-%wait wait-list))
- (status-list (if timeout
- (socket:socket-status request-list secs musecs)
- (socket:socket-status request-list)))
- (sockets (wait-list-waiters wait-list)))
- (do* ((x (pop sockets) (pop sockets))
- (y (cdr (last (pop status-list))) (cdr (last (pop status-list)))))
- ((null x))
- (when (member y '(T :INPUT :EOF))
- (setf (state x) :READ)))
- wait-list))))
-
-;;;
-;;; UDP/Datagram sockets (RAWSOCK version)
-;;;
-
-#+rawsock
-(progn
- (defun make-sockaddr_in ()
- (make-array 16 :element-type '(unsigned-byte 8) :initial-element 0))
-
- (declaim (inline fill-sockaddr_in))
- (defun fill-sockaddr_in (sockaddr_in ip port)
- (port-to-octet-buffer port sockaddr_in)
- (ip-to-octet-buffer ip sockaddr_in :start 2)
- sockaddr_in)
-
- (defun socket-create-datagram (local-port
- &key (local-host *wildcard-host*)
- remote-host
- remote-port)
- (let ((sock (rawsock:socket :inet :dgram 0))
- (lsock_addr (fill-sockaddr_in (make-sockaddr_in)
- local-host local-port))
- (rsock_addr (when remote-host
- (fill-sockaddr_in (make-sockaddr_in)
- remote-host (or remote-port
- local-port)))))
- (rawsock:bind sock (rawsock:make-sockaddr :inet lsock_addr))
- (when rsock_addr
- (rawsock:connect sock (rawsock:make-sockaddr :inet rsock_addr)))
- (make-datagram-socket sock :connected-p (if rsock_addr t nil))))
-
- (defmethod socket-receive ((socket datagram-usocket) buffer length &key)
- "Returns the buffer, the number of octets copied into the buffer (received)
-and the address of the sender as values."
- (let* ((sock (socket socket))
- (sockaddr (rawsock:make-sockaddr :inet))
- (real-length (or length +max-datagram-packet-size+))
- (real-buffer (or buffer
- (make-array real-length
- :element-type '(unsigned-byte 8)))))
- (let ((rv (rawsock:recvfrom sock real-buffer sockaddr
- :start 0 :end real-length))
- (host 0) (port 0))
- (unless (connected-p socket)
- (let ((data (rawsock:sockaddr-data sockaddr)))
- (setq host (ip-from-octet-buffer data :start 4)
- port (port-from-octet-buffer data :start 2))))
- (values (if buffer real-buffer (subseq real-buffer 0 rv))
- rv
- host
- port))))
-
- (defmethod socket-send ((socket datagram-usocket) buffer size &key host port (offset 0))
- "Returns the number of octets sent."
- (let* ((sock (socket socket))
- (sockaddr (when (and host port)
- (rawsock:make-sockaddr :inet
- (fill-sockaddr_in
- (make-sockaddr_in)
- (host-byte-order host)
- port))))
- (real-size (min size +max-datagram-packet-size+))
- (real-buffer (if (typep buffer '(simple-array (unsigned-byte 8) (*)))
- buffer
- (make-array real-size
- :element-type '(unsigned-byte 8)
- :initial-contents (subseq buffer 0 real-size))))
- (rv (if (and host port)
- (rawsock:sendto sock real-buffer sockaddr
- :start offset
- :end (+ offset real-size))
- (rawsock:send sock real-buffer
- :start offset
- :end (+ offset real-size)))))
- rv))
-
- (defmethod socket-close ((usocket datagram-usocket))
- (when (wait-list usocket)
- (remove-waiter (wait-list usocket) usocket))
- (rawsock:sock-close (socket usocket)))
-
- (declaim (inline get-socket-name))
- (defun get-socket-name (socket function)
- (let ((sockaddr (rawsock:make-sockaddr :inet (make-sockaddr_in))))
- (funcall function socket sockaddr)
- (let ((data (rawsock:sockaddr-data sockaddr)))
- (values (hbo-to-vector-quad (ip-from-octet-buffer data :start 2))
- (port-from-octet-buffer data :start 0)))))
-
- (defmethod get-local-name ((usocket datagram-usocket))
- (get-socket-name (socket usocket) 'rawsock:getsockname))
-
- (defmethod get-peer-name ((usocket datagram-usocket))
- (get-socket-name (socket usocket) 'rawsock:getpeername))
-
-) ; progn
-
-;;;
-;;; UDP/Datagram sockets (FFI version)
-;;;
-
-#+(and ffi (not rawsock))
-(progn
- ;; C primitive types
- (ffi:def-c-type socklen_t ffi:uint32)
-
- ;; C structures
- (ffi:def-c-struct sockaddr
- #+macos (sa_len ffi:uint8)
- (sa_family #-macos ffi:ushort
- #+macos ffi:uint8)
- (sa_data (ffi:c-array ffi:char 14)))
-
- (ffi:def-c-struct sockaddr_in
- #+macos (sin_len ffi:uint8)
- (sin_family #-macos ffi:short
- #+macos ffi:uint8)
- (sin_port #-macos ffi:ushort
- #+macos ffi:uint16)
- (sin_addr ffi:uint32)
- (sin_zero (ffi:c-array ffi:char 8)))
-
- (ffi:def-c-struct timeval
- (tv_sec ffi:long)
- (tv_usec ffi:long))
-
- ;; foreign functions
- (ffi:def-call-out %sendto (:name "sendto")
- (:arguments (socket ffi:int)
- (buffer ffi:c-pointer)
- (length ffi:int)
- (flags ffi:int)
- (address (ffi:c-ptr sockaddr))
- (address-len ffi:int))
- #+win32 (:library "WS2_32")
- #-win32 (:library :default)
- (:language #-win32 :stdc
- #+win32 :stdc-stdcall)
- (:return-type ffi:int))
-
- (ffi:def-call-out %send (:name "send")
- (:arguments (socket ffi:int)
- (buffer ffi:c-pointer)
- (length ffi:int)
- (flags ffi:int))
- #+win32 (:library "WS2_32")
- #-win32 (:library :default)
- (:language #-win32 :stdc
- #+win32 :stdc-stdcall)
- (:return-type ffi:int))
-
- (ffi:def-call-out %recvfrom (:name "recvfrom")
- (:arguments (socket ffi:int)
- (buffer ffi:c-pointer)
- (length ffi:int)
- (flags ffi:int)
- (address (ffi:c-ptr sockaddr) :in-out)
- (address-len (ffi:c-ptr ffi:int) :in-out))
- #+win32 (:library "WS2_32")
- #-win32 (:library :default)
- (:language #-win32 :stdc
- #+win32 :stdc-stdcall)
- (:return-type ffi:int))
-
- (ffi:def-call-out %socket (:name "socket")
- (:arguments (family ffi:int)
- (type ffi:int)
- (protocol ffi:int))
- #+win32 (:library "WS2_32")
- #-win32 (:library :default)
- (:language #-win32 :stdc
- #+win32 :stdc-stdcall)
- (:return-type ffi:int))
-
- (ffi:def-call-out %connect (:name "connect")
- (:arguments (socket ffi:int)
- (address (ffi:c-ptr sockaddr) :in)
- (address_len socklen_t))
- #+win32 (:library "WS2_32")
- #-win32 (:library :default)
- (:language #-win32 :stdc
- #+win32 :stdc-stdcall)
- (:return-type ffi:int))
-
- (ffi:def-call-out %bind (:name "bind")
- (:arguments (socket ffi:int)
- (address (ffi:c-ptr sockaddr) :in)
- (address_len socklen_t))
- #+win32 (:library "WS2_32")
- #-win32 (:library :default)
- (:language #-win32 :stdc
- #+win32 :stdc-stdcall)
- (:return-type ffi:int))
-
- (ffi:def-call-out %close (:name #-win32 "close" #+win32 "closesocket")
- (:arguments (socket ffi:int))
- #+win32 (:library "WS2_32")
- #-win32 (:library :default)
- (:language #-win32 :stdc
- #+win32 :stdc-stdcall)
- (:return-type ffi:int))
-
- (ffi:def-call-out %getsockopt (:name "getsockopt")
- (:arguments (sockfd ffi:int)
- (level ffi:int)
- (optname ffi:int)
- (optval ffi:c-pointer)
- (optlen (ffi:c-ptr socklen_t) :out))
- #+win32 (:library "WS2_32")
- #-win32 (:library :default)
- (:language #-win32 :stdc
- #+win32 :stdc-stdcall)
- (:return-type ffi:int))
-
- (ffi:def-call-out %setsockopt (:name "setsockopt")
- (:arguments (sockfd ffi:int)
- (level ffi:int)
- (optname ffi:int)
- (optval ffi:c-pointer)
- (optlen socklen_t))
- #+win32 (:library "WS2_32")
- #-win32 (:library :default)
- (:language #-win32 :stdc
- #+win32 :stdc-stdcall)
- (:return-type ffi:int))
-
- (ffi:def-call-out %htonl (:name "htonl")
- (:arguments (hostlong ffi:uint32))
- #+win32 (:library "WS2_32")
- #-win32 (:library :default)
- (:language #-win32 :stdc
- #+win32 :stdc-stdcall)
- (:return-type ffi:uint32))
-
- (ffi:def-call-out %htons (:name "htons")
- (:arguments (hostshort ffi:uint16))
- #+win32 (:library "WS2_32")
- #-win32 (:library :default)
- (:language #-win32 :stdc
- #+win32 :stdc-stdcall)
- (:return-type ffi:uint16))
-
- (ffi:def-call-out %ntohl (:name "ntohl")
- (:arguments (netlong ffi:uint32))
- #+win32 (:library "WS2_32")
- #-win32 (:library :default)
- (:language #-win32 :stdc
- #+win32 :stdc-stdcall)
- (:return-type ffi:uint32))
-
- (ffi:def-call-out %ntohs (:name "ntohs")
- (:arguments (netshort ffi:uint16))
- #+win32 (:library "WS2_32")
- #-win32 (:library :default)
- (:language #-win32 :stdc
- #+win32 :stdc-stdcall)
- (:return-type ffi:uint16))
-
- (ffi:def-call-out %getsockname (:name "getsockname")
- (:arguments (sockfd ffi:int)
- (localaddr (ffi:c-ptr sockaddr) :in-out)
- (addrlen (ffi:c-ptr socklen_t) :in-out))
- #+win32 (:library "WS2_32")
- #-win32 (:library :default)
- (:language #-win32 :stdc
- #+win32 :stdc-stdcall)
- (:return-type ffi:int))
-
- (ffi:def-call-out %getpeername (:name "getpeername")
- (:arguments (sockfd ffi:int)
- (peeraddr (ffi:c-ptr sockaddr) :in-out)
- (addrlen (ffi:c-ptr socklen_t) :in-out))
- #+win32 (:library "WS2_32")
- #-win32 (:library :default)
- (:language #-win32 :stdc
- #+win32 :stdc-stdcall)
- (:return-type ffi:int))
-
- ;; socket constants
- (defconstant +socket-af-inet+ 2)
- (defconstant +socket-sock-dgram+ 2)
- (defconstant +socket-ip-proto-udp+ 17)
-
- (defconstant +sockopt-so-rcvtimeo+ #-linux #x1006 #+linux 20 "Socket receive timeout")
-
- (defparameter *length-of-sockaddr_in* (ffi:sizeof 'sockaddr_in))
-
- (declaim (inline fill-sockaddr_in))
- (defun fill-sockaddr_in (sockaddr host port)
- (let ((hbo (host-to-hbo host)))
- (ffi:with-c-place (place sockaddr)
- #+macos
- (setf (ffi:slot place 'sin_len) *length-of-sockaddr_in*)
- (setf (ffi:slot place 'sin_family) +socket-af-inet+
- (ffi:slot place 'sin_port) (%htons port)
- (ffi:slot place 'sin_addr) (%htonl hbo)))
- sockaddr))
-
- (defun socket-create-datagram (local-port
- &key (local-host *wildcard-host*)
- remote-host
- remote-port)
- (let ((sock (%socket +socket-af-inet+ +socket-sock-dgram+ +socket-ip-proto-udp+))
- (lsock_addr (fill-sockaddr_in (ffi:allocate-shallow 'sockaddr_in)
- local-host local-port))
- (rsock_addr (when remote-host
- (fill-sockaddr_in (ffi:allocate-shallow 'sockaddr_in)
- remote-host (or remote-port local-port)))))
- (unless (plusp sock)
- (error "SOCKET-CREATE-DATAGRAM ERROR (socket): ~A" (os:errno)))
- (unwind-protect
- (let ((rv (%bind sock (ffi:cast (ffi:foreign-value lsock_addr) 'sockaddr)
- *length-of-sockaddr_in*)))
- (unless (zerop rv)
- (error "SOCKET-CREATE-DATAGRAM ERROR (bind): ~A" (os:errno)))
- (when rsock_addr
- (let ((rv (%connect sock
- (ffi:cast (ffi:foreign-value rsock_addr) 'sockaddr)
- *length-of-sockaddr_in*)))
- (unless (zerop rv)
- (error "SOCKET-CREATE-DATAGRAM ERROR (connect): ~A" (os:errno))))))
- (ffi:foreign-free lsock_addr)
- (when remote-host
- (ffi:foreign-free rsock_addr)))
- (make-datagram-socket sock :connected-p (if rsock_addr t nil))))
-
- (defun finalize-datagram-usocket (object)
- (when (datagram-usocket-p object)
- (socket-close object)))
-
- (defmethod initialize-instance :after ((usocket datagram-usocket) &key)
- (setf (slot-value usocket 'recv-buffer)
- (ffi:allocate-shallow 'ffi:uint8 :count +max-datagram-packet-size+))
- ;; finalize the object
- (ext:finalize usocket 'finalize-datagram-usocket))
-
- (defmethod socket-close ((usocket datagram-usocket))
- (when (wait-list usocket)
- (remove-waiter (wait-list usocket) usocket))
- (with-slots (recv-buffer socket) usocket
- (ffi:foreign-free recv-buffer)
- (zerop (%close socket))))
-
- (defmethod socket-receive ((usocket datagram-usocket) buffer length &key)
- (let ((remote-address (ffi:allocate-shallow 'sockaddr_in))
- (remote-address-length (ffi:allocate-shallow 'ffi:int))
- nbytes (host 0) (port 0))
- (setf (ffi:foreign-value remote-address-length)
- *length-of-sockaddr_in*)
- (unwind-protect
- (multiple-value-bind (n address address-length)
- (%recvfrom (socket usocket)
- (ffi:foreign-address (slot-value usocket 'recv-buffer))
- +max-datagram-packet-size+
- 0 ; flags
- (ffi:cast (ffi:foreign-value remote-address) 'sockaddr)
- (ffi:foreign-value remote-address-length))
- (when (minusp n)
- (error "SOCKET-RECEIVE ERROR: ~A" (os:errno)))
- (setq nbytes n)
- (when (= address-length *length-of-sockaddr_in*)
- (let ((data (sockaddr-sa_data address)))
- (setq host (ip-from-octet-buffer data :start 2)
- port (port-from-octet-buffer data))))
- (cond ((plusp n)
- (let ((return-buffer (ffi:foreign-value (slot-value usocket 'recv-buffer))))
- (if buffer ; replace exist buffer of create new return buffer
- (let ((end-1 (min (or length (length buffer)) +max-datagram-packet-size+))
- (end-2 (min n +max-datagram-packet-size+)))
- (replace buffer return-buffer :end1 end-1 :end2 end-2))
- (setq buffer (subseq return-buffer 0 (min n +max-datagram-packet-size+))))))
- ((zerop n))))
- (ffi:foreign-free remote-address)
- (ffi:foreign-free remote-address-length))
- (values buffer nbytes host port)))
-
- ;; implementation note: different from socket-receive, we know how many bytes we want to send everytime,
- ;; so, a send buffer will not needed, and if there is a buffer, it's hard to fill its content like those
- ;; in LispWorks. So, we allocate new foreign buffer for holding data (unknown sequence subtype) every time.
- ;;
- ;; I don't know if anyone is watching my coding work, but I think this design is reasonable for CLISP.
- (defmethod socket-send ((usocket datagram-usocket) buffer size &key host port (offset 0))
- (declare (type sequence buffer)
- (type (integer 0 *) size offset))
- (let ((remote-address
- (when (and host port)
- (fill-sockaddr_in (ffi:allocate-shallow 'sockaddr_in) host port)))
- (send-buffer
- (ffi:allocate-deep 'ffi:uint8
- (if (zerop offset)
- buffer
- (subseq buffer offset (+ offset size)))
- :count size :read-only t))
- (real-size (min size +max-datagram-packet-size+))
- (nbytes 0))
- (unwind-protect
- (let ((n (if remote-address
- (%sendto (socket usocket)
- (ffi:foreign-address send-buffer)
- real-size
- 0 ; flags
- (ffi:cast (ffi:foreign-value remote-address) 'sockaddr)
- *length-of-sockaddr_in*)
- (%send (socket usocket)
- (ffi:foreign-address send-buffer)
- real-size
- 0))))
- (cond ((plusp n)
- (setq nbytes n))
- ((zerop n)
- (setq nbytes n))
- (t (error "SOCKET-SEND ERROR: ~A" (os:errno)))))
- (ffi:foreign-free send-buffer)
- (when remote-address
- (ffi:foreign-free remote-address))
- nbytes)))
-
- (declaim (inline get-socket-name))
- (defun get-socket-name (socket function)
- (let ((address (ffi:allocate-shallow 'sockaddr_in))
- (address-length (ffi:allocate-shallow 'ffi:int))
- (host 0) (port 0))
- (setf (ffi:foreign-value address-length) *length-of-sockaddr_in*)
- (unwind-protect
- (multiple-value-bind (rv return-address return-address-length)
- (funcall function socket
- (ffi:cast (ffi:foreign-value address) 'sockaddr)
- (ffi:foreign-value address-length))
- (declare (ignore return-address-length))
- (if (zerop rv)
- (let ((data (sockaddr-sa_data return-address)))
- (setq host (ip-from-octet-buffer data :start 2)
- port (port-from-octet-buffer data)))
- (error "GET-SOCKET-NAME ERROR: ~A" (os:errno))))
- (ffi:foreign-free address)
- (ffi:foreign-free address-length))
- (values (hbo-to-vector-quad host) port)))
-
- (defmethod get-local-name ((usocket datagram-usocket))
- (get-socket-name (socket usocket) '%getsockname))
-
- (defmethod get-peer-name ((usocket datagram-usocket))
- (get-socket-name (socket usocket) '%getpeername))
-
-) ; progn
(DIR) diff --git a/3rdparties/software/usocket-0.7.1/backend/clozure.lisp b/3rdparties/software/usocket-0.7.1/backend/clozure.lisp
@@ -1,73 +0,0 @@
-;;;; See LICENSE for licensing information.
-
-;;;; Functions for CCL 1.11 (IPv6) only, see openmcl.lisp for rest of functions.
-
-(in-package :usocket)
-
-#+ipv6
-(defun socket-connect (host port &key (protocol :stream) element-type
- timeout deadline nodelay
- local-host local-port)
- (when (eq nodelay :if-supported)
- (setf nodelay t))
- (with-mapped-conditions ()
- (let* ((remote (when (and host port)
- (openmcl-socket:resolve-address :host (host-to-hostname host)
- :port port
- :socket-type protocol)))
- (local (when (and local-host local-port)
- (openmcl-socket:resolve-address :host (host-to-hostname local-host)
- :port local-port
- :socket-type protocol)))
- (mcl-sock (apply #'openmcl-socket:make-socket
- `(:type ,protocol
- ,@(when (or remote local)
- `(:address-family ,(openmcl-socket:socket-address-family (or remote local))))
- ,@(when remote
- `(:remote-address ,remote))
- ,@(when local
- `(:local-address ,local))
- :format ,(to-format element-type protocol)
- :external-format ,ccl:*default-external-format*
- :deadline ,deadline
- :nodelay ,nodelay
- :connect-timeout ,timeout
- :input-timeout ,timeout))))
- (ecase protocol
- (:stream
- (make-stream-socket :stream mcl-sock :socket mcl-sock))
- (:datagram
- (make-datagram-socket mcl-sock :connected-p (and remote t)))))))
-
-#+ipv6
-(defun socket-listen (host port
- &key
- (reuse-address nil reuse-address-supplied-p)
- (reuseaddress (when reuse-address-supplied-p reuse-address))
- (backlog 5)
- (element-type 'character))
- (let ((local-address (openmcl-socket:resolve-address :host (host-to-hostname host)
- :port port :connect :passive)))
- (with-mapped-conditions ()
- (make-stream-server-socket
- (openmcl-socket:make-socket :connect :passive
- :address-family (openmcl-socket:socket-address-family local-address)
- :local-address local-address
- :reuse-address reuseaddress
- :backlog backlog
- :format (to-format element-type :stream))
- :element-type element-type))))
-
-#+ipv6
-(defmethod socket-send ((usocket datagram-usocket) buffer size &key host port (offset 0))
- (let* ((ccl-socket (socket usocket))
- (socket-keys (ccl::socket-keys ccl-socket)))
- (with-mapped-conditions (usocket)
- (if (and host port)
- (openmcl-socket:send-to ccl-socket buffer size
- :remote-host (host-to-hostname host)
- :remote-port port
- :offset offset)
- (openmcl-socket:send-to ccl-socket buffer size
- :remote-address (getf socket-keys :remote-address)
- :offset offset)))))
(DIR) diff --git a/3rdparties/software/usocket-0.7.1/backend/cmucl.lisp b/3rdparties/software/usocket-0.7.1/backend/cmucl.lisp
@@ -1,295 +0,0 @@
-;;;; See LICENSE for licensing information.
-
-(in-package :usocket)
-
-#+win32
-(defun remap-for-win32 (z)
- (mapcar #'(lambda (x)
- (cons (mapcar #'(lambda (y)
- (+ 10000 y))
- (car x))
- (cdr x)))
- z))
-
-(defparameter +cmucl-error-map+
- #+win32
- (append (remap-for-win32 +unix-errno-condition-map+)
- (remap-for-win32 +unix-errno-error-map+))
- #-win32
- (append +unix-errno-condition-map+
- +unix-errno-error-map+))
-
-(defun cmucl-map-socket-error (err &key condition socket)
- (let ((usock-err
- (cdr (assoc err +cmucl-error-map+ :test #'member))))
- (if usock-err
- (if (subtypep usock-err 'error)
- (error usock-err :socket socket)
- (signal usock-err :socket socket))
- (error 'unknown-error
- :socket socket
- :real-error condition))))
-
-;; CMUCL error handling is brain-dead: it doesn't preserve any
-;; information other than the OS error string from which the
-;; error can be determined. The OS error string isn't good enough
-;; given that it may have been localized (l10n).
-;;
-;; The above applies to versions pre 19b; 19d and newer are expected to
-;; contain even better error reporting.
-;;
-;;
-;; Just catch the errors and encapsulate them in an unknown-error
-(defun handle-condition (condition &optional (socket nil))
- "Dispatch correct usocket condition."
- (typecase condition
- (ext::socket-error (cmucl-map-socket-error (ext::socket-errno condition)
- :socket socket
- :condition condition))))
-
-(defun socket-connect (host port &key (protocol :stream) (element-type 'character)
- timeout deadline (nodelay t nodelay-specified)
- (local-host nil local-host-p)
- (local-port nil local-port-p)
- &aux
- (local-bind-p (fboundp 'ext::bind-inet-socket)))
- (when timeout (unsupported 'timeout 'socket-connect))
- (when deadline (unsupported 'deadline 'socket-connect))
- (when (and nodelay-specified
- (not (eq nodelay :if-supported)))
- (unsupported 'nodelay 'socket-connect))
- (when (and local-host-p (not local-bind-p))
- (unsupported 'local-host 'socket-connect :minimum "Snapshot 2008-08 (19E)"))
- (when (and local-port-p (not local-bind-p))
- (unsupported 'local-port 'socket-connect :minimum "Snapshot 2008-08 (19E)"))
-
- (let ((socket))
- (ecase protocol
- (:stream
- (setf socket
- (let ((args (list (host-to-hbo host) port protocol)))
- (when (and local-bind-p (or local-host-p local-port-p))
- (nconc args (list :local-host (when local-host
- (host-to-hbo local-host))
- :local-port local-port)))
- (with-mapped-conditions (socket)
- (apply #'ext:connect-to-inet-socket args))))
- (if socket
- (let* ((stream (sys:make-fd-stream socket :input t :output t
- :element-type element-type
- :buffering :full))
- ;;###FIXME the above line probably needs an :external-format
- (usocket (make-stream-socket :socket socket
- :stream stream)))
- usocket)
- (let ((err (unix:unix-errno)))
- (when err (cmucl-map-socket-error err)))))
- (:datagram
- (setf socket
- (if (and host port)
- (let ((args (list (host-to-hbo host) port protocol)))
- (when (and local-bind-p (or local-host-p local-port-p))
- (nconc args (list :local-host (when local-host
- (host-to-hbo local-host))
- :local-port local-port)))
- (with-mapped-conditions (socket)
- (apply #'ext:connect-to-inet-socket args)))
- (if (or local-host-p local-port-p)
- (with-mapped-conditions (socket)
- (apply #'ext:create-inet-listener
- (nconc (list (or local-port 0) protocol)
- (when (and local-host-p
- (ip/= local-host *wildcard-host*))
- (list :host (host-to-hbo local-host))))))
- (with-mapped-conditions (socket)
- (ext:create-inet-socket protocol)))))
- (if socket
- (let ((usocket (make-datagram-socket socket :connected-p (and host port t))))
- (ext:finalize usocket #'(lambda () (when (%open-p usocket)
- (ext:close-socket socket))))
- usocket)
- (let ((err (unix:unix-errno)))
- (when err (cmucl-map-socket-error err))))))))
-
-(defun socket-listen (host port
- &key reuseaddress
- (reuse-address nil reuse-address-supplied-p)
- (backlog 5)
- (element-type 'character))
- (let* ((reuseaddress (if reuse-address-supplied-p reuse-address reuseaddress))
- (server-sock
- (with-mapped-conditions ()
- (apply #'ext:create-inet-listener
- (nconc (list port :stream
- :backlog backlog
- :reuse-address reuseaddress)
- (when (ip/= host *wildcard-host*)
- (list :host
- (host-to-hbo host))))))))
- (make-stream-server-socket server-sock :element-type element-type)))
-
-(defmethod socket-accept ((usocket stream-server-usocket) &key element-type)
- (with-mapped-conditions (usocket)
- (let* ((sock (ext:accept-tcp-connection (socket usocket)))
- (stream (sys:make-fd-stream sock :input t :output t
- :element-type (or element-type
- (element-type usocket))
- :buffering :full)))
- (make-stream-socket :socket sock :stream stream))))
-
-;; Sockets and socket streams are represented
-;; by different objects. Be sure to close the
-;; socket stream when closing a stream socket.
-(defmethod socket-close ((usocket stream-usocket))
- "Close socket."
- (when (wait-list usocket)
- (remove-waiter (wait-list usocket) usocket))
- (with-mapped-conditions (usocket)
- (close (socket-stream usocket))))
-
-(defmethod socket-close ((usocket usocket))
- "Close socket."
- (when (wait-list usocket)
- (remove-waiter (wait-list usocket) usocket))
- (with-mapped-conditions (usocket)
- (ext:close-socket (socket usocket))))
-
-(defmethod socket-close :after ((socket datagram-usocket))
- (setf (%open-p socket) nil))
-
-#+unicode
-(defun %unix-send (fd buffer length flags)
- (alien:alien-funcall
- (alien:extern-alien "send"
- (function c-call:int
- c-call:int
- system:system-area-pointer
- c-call:int
- c-call:int))
- fd
- (system:vector-sap buffer)
- length
- flags))
-
-(defmethod socket-shutdown ((usocket usocket) direction)
- (with-mapped-conditions (usocket)
- (ext:inet-shutdown (socket usocket) (ecase direction
- (:input ext:shut-rd)
- (:output ext:shut-wr)))))
-
-(defmethod socket-send ((usocket datagram-usocket) buffer size &key host port (offset 0)
- &aux (real-buffer (if (zerop offset)
- buffer
- (subseq buffer offset (+ offset size)))))
- (with-mapped-conditions (usocket)
- (if (and host port)
- (ext:inet-sendto (socket usocket) real-buffer size (host-to-hbo host) port)
- #-unicode
- (unix:unix-send (socket usocket) real-buffer size 0)
- #+unicode
- (%unix-send (socket usocket) real-buffer size 0))))
-
-(defmethod socket-receive ((usocket datagram-usocket) buffer length &key)
- (declare (values (simple-array (unsigned-byte 8) (*)) ; buffer
- (integer 0) ; size
- (unsigned-byte 32) ; host
- (unsigned-byte 16))) ; port
- (let ((real-buffer (or buffer
- (make-array length :element-type '(unsigned-byte 8))))
- (real-length (or length
- (length buffer))))
- (multiple-value-bind (nbytes remote-host remote-port)
- (with-mapped-conditions (usocket)
- (ext:inet-recvfrom (socket usocket) real-buffer real-length))
- (values real-buffer nbytes remote-host remote-port))))
-
-(defmethod get-local-name ((usocket usocket))
- (multiple-value-bind
- (address port)
- (ext:get-socket-host-and-port (socket usocket))
- (values (hbo-to-vector-quad address) port)))
-
-(defmethod get-peer-name ((usocket stream-usocket))
- (multiple-value-bind
- (address port)
- (ext:get-peer-host-and-port (socket usocket))
- (values (hbo-to-vector-quad address) port)))
-
-(defmethod get-local-address ((usocket usocket))
- (nth-value 0 (get-local-name usocket)))
-
-(defmethod get-peer-address ((usocket stream-usocket))
- (nth-value 0 (get-peer-name usocket)))
-
-(defmethod get-local-port ((usocket usocket))
- (nth-value 1 (get-local-name usocket)))
-
-(defmethod get-peer-port ((usocket stream-usocket))
- (nth-value 1 (get-peer-name usocket)))
-
-
-(defun lookup-host-entry (host)
- (multiple-value-bind
- (entry errno)
- (ext:lookup-host-entry host)
- (if entry
- entry
- ;;###The constants below work on *most* OSes, but are defined as the
- ;; constants mentioned in C
- (let ((exception
- (second (assoc errno
- '((1 ns-host-not-found-error) ;; HOST_NOT_FOUND
- (2 ns-no-recovery-error) ;; NO_DATA
- (3 ns-no-recovery-error) ;; NO_RECOVERY
- (4 ns-try-again-condition)))))) ;; TRY_AGAIN
- (when exception
- (error exception))))))
-
-
-(defun get-host-by-address (address)
- (handler-case (ext:host-entry-name
- (lookup-host-entry (host-byte-order address)))
- (condition (condition) (handle-condition condition))))
-
-(defun get-hosts-by-name (name)
- (handler-case (mapcar #'hbo-to-vector-quad
- (ext:host-entry-addr-list
- (lookup-host-entry name)))
- (condition (condition) (handle-condition condition))))
-
-(defun get-host-name ()
- (unix:unix-gethostname))
-
-(defun %setup-wait-list (wait-list)
- (declare (ignore wait-list)))
-
-(defun %add-waiter (wait-list waiter)
- (push (socket waiter) (wait-list-%wait wait-list)))
-
-(defun %remove-waiter (wait-list waiter)
- (setf (wait-list-%wait wait-list)
- (remove (socket waiter) (wait-list-%wait wait-list))))
-
-(defun wait-for-input-internal (wait-list &key timeout)
- (with-mapped-conditions ()
- (alien:with-alien ((rfds (alien:struct unix:fd-set)))
- (unix:fd-zero rfds)
- (dolist (socket (wait-list-%wait wait-list))
- (unix:fd-set socket rfds))
- (multiple-value-bind
- (secs musecs)
- (split-timeout (or timeout 1))
- (multiple-value-bind (count err)
- (unix:unix-fast-select (1+ (reduce #'max
- (wait-list-%wait wait-list)))
- (alien:addr rfds) nil nil
- (when timeout secs) musecs)
- (declare (ignore err))
- (if (<= 0 count)
- ;; process the result...
- (dolist (x (wait-list-waiters wait-list))
- (when (unix:fd-isset (socket x) rfds)
- (setf (state x) :READ)))
- (progn
- ;;###FIXME generate an error, except for EINTR
- )))))))
(DIR) diff --git a/3rdparties/software/usocket-0.7.1/backend/ecl.lisp b/3rdparties/software/usocket-0.7.1/backend/ecl.lisp
@@ -1,152 +0,0 @@
-;;;; -*- Mode: Lisp -*-
-
-;;;; Foreign functions defined by ECL's DFFI, used for #+ecl-bytecmp only.
-;;;; See LICENSE for licensing information.
-
-(in-package :usocket)
-
-#+(and ecl-bytecmp windows)
-(eval-when (:load-toplevel :execute)
- (ffi:load-foreign-library "ws2_32.dll" :module "ws2_32"))
-
-#+(and ecl-bytecmp windows)
-(progn
- (ffi:def-function ("gethostname" c-gethostname)
- ((name (* :unsigned-char))
- (len :int))
- :returning :int
- :module "ws2_32")
-
- (defun get-host-name ()
- "Returns the hostname"
- (ffi:with-foreign-object (name '(:array :unsigned-char 256))
- (when (zerop (c-gethostname (ffi:char-array-to-pointer name) 256))
- (ffi:convert-from-foreign-string name))))
-
- (ffi:def-foreign-type ws-socket :unsigned-int)
- (ffi:def-foreign-type ws-dword :unsigned-long)
- (ffi:def-foreign-type ws-event :unsigned-int)
-
- (ffi:def-struct wsa-network-events
- (network-events :long)
- (error-code (:array :int 10)))
-
- (ffi:def-function ("WSACreateEvent" wsa-event-create)
- ()
- :returning ws-event
- :module "ws2_32")
-
- (ffi:def-function ("WSACloseEvent" c-wsa-event-close)
- ((event-object ws-event))
- :returning :int
- :module "ws2_32")
-
- (defun wsa-event-close (ws-event)
- (not (zerop (c-wsa-event-close ws-event))))
-
- (ffi:def-function ("WSAEnumNetworkEvents" wsa-enum-network-events)
- ((socket ws-socket)
- (event-object ws-event)
- (network-events (* wsa-network-events)))
- :returning :int
- :module "ws2_32")
-
- (ffi:def-function ("WSAEventSelect" wsa-event-select)
- ((socket ws-socket)
- (event-object ws-event)
- (network-events :long))
- :returning :int
- :module "ws2_32")
-
- (ffi:def-function ("WSAWaitForMultipleEvents" c-wsa-wait-for-multiple-events)
- ((number-of-events ws-dword)
- (events (* ws-event))
- (wait-all-p :int)
- (timeout ws-dword)
- (alertable-p :int))
- :returning ws-dword
- :module "ws2_32")
-
- (defun wsa-wait-for-multiple-events (number-of-events events wait-all-p timeout alertable-p)
- (c-wsa-wait-for-multiple-events number-of-events
- events
- (if wait-all-p -1 0)
- timeout
- (if alertable-p -1 0)))
-
- (ffi:def-function ("ioctlsocket" wsa-ioctlsocket)
- ((socket ws-socket)
- (cmd :long)
- (argp (* :unsigned-long)))
- :returning :int
- :module "ws2_32")
-
- (ffi:def-function ("WSAGetLastError" wsa-get-last-error)
- ()
- :returning :int
- :module "ws2_32")
-
- (defun maybe-wsa-error (rv &optional socket)
- (unless (zerop rv)
- (raise-usock-err (wsa-get-last-error) socket)))
-
- (defun bytes-available-for-read (socket)
- (ffi:with-foreign-object (int-ptr :unsigned-long)
- (maybe-wsa-error (wsa-ioctlsocket (socket-handle socket) fionread int-ptr)
- socket)
- (let ((int (ffi:deref-pointer int-ptr :unsigned-long)))
- (prog1 int
- (when (plusp int)
- (setf (state socket) :read))))))
-
- (defun map-network-events (func network-events)
- (let ((event-map (ffi:get-slot-value network-events 'wsa-network-events 'network-events))
- (error-array (ffi:get-slot-pointer network-events 'wsa-network-events 'error-code)))
- (unless (zerop event-map)
- (dotimes (i fd-max-events)
- (unless (zerop (ldb (byte 1 i) event-map))
- (funcall func (ffi:deref-array error-array '(:array :int 10) i)))))))
-
- (defun update-ready-and-state-slots (sockets)
- (dolist (socket sockets)
- (if (%ready-p socket)
- (progn
- (setf (state socket) :READ))
- (ffi:with-foreign-object (network-events 'wsa-network-events)
- (let ((rv (wsa-enum-network-events (socket-handle socket) 0 network-events)))
- (if (zerop rv)
- (map-network-events
- #'(lambda (err-code)
- (if (zerop err-code)
- (progn
- (setf (state socket) :READ)
- (when (stream-server-usocket-p socket)
- (setf (%ready-p socket) t)))
- (raise-usock-err err-code socket)))
- network-events)
- (maybe-wsa-error rv socket)))))))
-
- (defun os-wait-list-%wait (wait-list)
- (ffi:deref-pointer (wait-list-%wait wait-list) 'ws-event))
-
- (defun (setf os-wait-list-%wait) (value wait-list)
- (setf (ffi:deref-pointer (wait-list-%wait wait-list) 'ws-event) value))
-
- (defun free-wait-list (wl)
- (when (wait-list-p wl)
- (unless (null (wait-list-%wait wl))
- (wsa-event-close (os-wait-list-%wait wl))
- (ffi:free-foreign-object (wait-list-%wait wl))
- (setf (wait-list-%wait wl) nil))))
-
- (defun %setup-wait-list (wait-list)
- (setf (wait-list-%wait wait-list)
- (ffi:allocate-foreign-object 'ws-event))
- (setf (os-wait-list-%wait wait-list)
- (wsa-event-create))
- (ext:set-finalizer wait-list #'free-wait-list))
-
- (defun os-socket-handle (usocket)
- (socket-handle usocket))
-
-) ; #+(and ecl-bytecmp windows)
(DIR) diff --git a/3rdparties/software/usocket-0.7.1/backend/genera.lisp b/3rdparties/software/usocket-0.7.1/backend/genera.lisp
@@ -1,265 +0,0 @@
-;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Package: USOCKET; Base: 10 -*-
-
-;;;; See LICENSE for licensing information.
-
-(in-package :usocket)
-
-(defclass genera-socket ()
- ((foreign-address :initform 0 :initarg :foreign-address :accessor gs-foreign-address)
- (foreign-port :initform 0 :initarg :foreign-port :accessor gs-foreign-port)
- (local-address :initform 0 :initarg :local-address :accessor gs-local-address)
- (local-port :initform 0 :initarg :local-port :accessor gs-local-port))
- )
-
-(defclass genera-stream-socket (genera-socket)
- ((stream :initform nil :initarg :stream :accessor gs-stream))
- )
-
-(defclass genera-stream-server-socket (genera-socket)
- ((backlog :initform nil :initarg :backlog :accessor gs-backlog)
- (element-type :initform nil :initarg :element-type :accessor gs-element-type)
- (pending-connections :initform nil :accessor gs-pending-connections))
- )
-
-(defclass genera-datagram-socket (genera-socket)
- ((connection :initform nil :initarg :connection :accessor gs-connection))
- )
-
-(defun host-to-host-object (host)
- (let ((host (host-to-hostname host)))
- (cond ((string-equal host "localhost")
- net:*local-host*)
- ((ip-address-string-p host)
- (let ((quad (dotted-quad-to-vector-quad host)))
- ;;---*** NOTE: This test is temporary until we have a loopback interface
- (if (= (aref quad 0) 127)
- net:*local-host*
- (net:parse-host (format nil "INTERNET|~A" host)))))
- (t
- (net:parse-host host)))))
-
-(defun element-type-to-format (element-type protocol)
- (cond ((null element-type)
- (ecase protocol
- (:stream :text)
- (:datagram :binary)))
- ((subtypep element-type 'character)
- :text)
- (t :binary)))
-
-(defun handle-condition (condition &optional (socket nil))
- (typecase condition
- ;;---*** TODO: Add additional conditions as appropriate
- (sys:connection-refused
- (error 'connection-refused-error :socket socket))
- ((or tcp::tcp-destination-unreachable-during-connection tcp::udp-destination-unreachable)
- (error 'host-unreachable-error :socket socket))
- (sys:host-not-responding-during-connection
- (error 'timeout-error :socket socket))
- (sys:unknown-host-name
- (error 'ns-host-not-found-error :host-or-ip nil))
- (sys:network-error
- (error 'unknown-error :socket socket :real-error condition :errno -1))))
-
-(defun socket-connect (host port &key (protocol :stream) element-type
- timeout deadline (nodelay nil nodelay-p)
- local-host local-port)
- (declare (ignore local-host))
- (when deadline
- (unsupported 'deadline 'socket-connect))
- (when (and nodelay-p (not (eq nodelay :if-supported)))
- (unsupported 'nodelay 'socket-connect))
- (with-mapped-conditions ()
- (ecase protocol
- (:stream
- (let* ((host-object (host-to-host-object host))
- (format (element-type-to-format element-type protocol))
- (characters (eq format :text))
- (timeout (if timeout
- (* 60 timeout)
- tcp:*tcp-connect-timeout*))
- (stream (tcp:open-tcp-stream host-object port local-port
- :characters characters
- :ascii-translation characters
- :timeout timeout))
- (gs (make-instance 'genera-stream-socket
- :stream stream)))
- (setf (gs-foreign-address gs) (scl:send stream :foreign-address))
- (setf (gs-foreign-port gs) (scl:send stream :foreign-port))
- (setf (gs-local-address gs) (scl:send stream :local-address))
- (setf (gs-local-port gs) (scl:send stream :local-port))
- (make-stream-socket :socket gs :stream stream)))
- (:datagram
- ;;---*** TODO
- (unsupported 'datagram 'socket-connect)))))
-
-(defmethod socket-close ((usocket usocket))
- (when (wait-list usocket)
- (remove-waiter (wait-list usocket) usocket))
- (with-mapped-conditions (usocket)
- (socket-close (socket usocket))))
-
-(defmethod socket-close ((socket genera-stream-socket))
- (with-slots (stream) socket
- (when stream
- (scl:send (shiftf stream nil) :close nil))))
-
-(defmethod socket-close ((socket genera-stream-server-socket))
- (with-slots (local-port pending-connections) socket
- (when local-port
- (tcp:remove-tcp-port-listener local-port))
- (dolist (tcb pending-connections)
- (tcp::reject-tcb tcb))))
-
-(defmethod socket-close ((socket genera-datagram-socket))
- (with-slots (connection) socket
- (when connection
- (scl:send (shiftf connection nil) :close nil))
- ;;---*** TODO: listening?
- ))
-
-;;; Cribbed from TCP::MAKE-TCB
-(defun gensym-tcp-port ()
- (loop as number = (incf tcp::*last-gensym-port-number*) then tcp::*last-gensym-port-number*
- do (cond ((loop for existing-tcb in tcp::*tcb-list*
- thereis (= number (tcp::tcb-local-port existing-tcb))))
- ((and (<= #.(expt 2 10) number) (< number #.(expt 2 16)))
- (return number))
- (t
- (setq tcp::*last-gensym-port-number* #.(expt 2 10))))))
-
-(defun socket-listen (host port &key (reuse-address nil reuse-address-p)
- (reuseaddress nil reuseaddress-p)
- (backlog 5) (element-type 'character))
- (let ((host-object (host-to-host-object host))
- (port (if (zerop port) (gensym-tcp-port) port))
- (reuse-address (cond (reuse-address-p reuse-address)
- (reuseaddress-p reuseaddress)
- (t nil))))
- (when (<= port 1024)
- ;; Don't allow listening on "privileged" ports to mimic Unix/Linux semantics
- (error 'operation-not-permitted-error :socket nil))
- (when (tcp:tcp-port-protocol-name port)
- ;; Can't replace a Genera server
- (error 'address-in-use-error :socket nil))
- (when (tcp:tcp-port-listener port)
- (unless reuse-address
- (error 'address-in-use-error :socket nil)))
- (let ((gs (make-instance 'genera-stream-server-socket
- :backlog backlog
- :element-type element-type)))
- (setf (gs-local-address gs)
- (loop for (network address) in (scl:send host-object :network-addresses)
- when (typep network 'tcp:internet-network)
- return address))
- (setf (gs-local-port gs) port)
- (flet ((add-to-queue (tcb)
- (cond ((and (not (zerop (gs-local-address gs)))
- (not (= (gs-local-address gs) (tcp::tcb-local-address tcb))))
- ;; Reject if not destined for the proper address
- (tcp::reject-tcb tcb))
- ((<= (length (gs-pending-connections gs)) (gs-backlog gs))
- (tcp::accept-tcb tcb)
- (tcp::tcb-travel-through-states tcb "Accept" nil :listen :syn-received)
- (setf (gs-pending-connections gs)
- (append (gs-pending-connections gs) (list tcb))))
- (t
- ;; Reject if backlog is full
- (tcp::reject-tcb tcb)))))
- (tcp:add-tcp-port-listener port #'add-to-queue))
- (make-stream-server-socket gs :element-type element-type))))
-
-(defmethod socket-accept ((socket stream-server-usocket) &key element-type)
- (with-slots (pending-connections) (socket socket)
- (loop
- (process:process-block "Wait for connection" #'(lambda ()
- (not (null pending-connections))))
- (let ((tcb (pop pending-connections)))
- (when tcb
- (let* ((format (element-type-to-format (or element-type (element-type socket))
- :stream))
- (characters (eq format :text))
- (stream (tcp::make-tcp-stream tcb
- :characters characters
- :ascii-translation characters))
- (gs (make-instance 'genera-stream-socket
- :stream stream)))
- (setf (gs-foreign-address gs) (scl:send stream :foreign-address))
- (setf (gs-foreign-port gs) (scl:send stream :foreign-port))
- (setf (gs-local-address gs) (scl:send stream :local-address))
- (setf (gs-local-port gs) (scl:send stream :local-port))
- (return (make-stream-socket :socket gs :stream stream))))))))
-
-(defmethod get-local-address ((usocket usocket))
- (hbo-to-vector-quad (gs-local-address (socket usocket))))
-
-(defmethod get-peer-address ((usocket stream-usocket))
- (hbo-to-vector-quad (gs-foreign-address (socket usocket))))
-
-(defmethod get-local-port ((usocket usocket))
- (gs-local-port (socket usocket)))
-
-(defmethod get-peer-port ((usocket stream-usocket))
- (gs-foreign-port (socket usocket)))
-
-(defmethod get-local-name ((usocket usocket))
- (values (get-local-address usocket)
- (get-local-port usocket)))
-
-(defmethod get-peer-name ((usocket stream-usocket))
- (values (get-peer-address usocket)
- (get-peer-port usocket)))
-
-(defmethod socket-send ((usocket datagram-usocket) buffer size &key host port (offset 0))
- ;;---*** TODO
- (unsupported 'datagram 'socket-send))
-
-(defmethod socket-receive ((socket datagram-usocket) buffer length &key)
- ;;---*** TODO
- (unsupported 'datagram 'socket-receive))
-
-(defun get-host-by-address (address)
- )
-
-(defun get-hosts-by-name (name)
- (with-mapped-conditions ()
- (let ((host-object (host-to-host-object name)))
- (loop for (network address) in (scl:send host-object :network-addresses)
- when (typep network 'tcp:internet-network)
- collect (hbo-to-vector-quad address)))))
-
-(defun %setup-wait-list (wait-list)
- (declare (ignore wait-list)))
-
-(defun %add-waiter (wait-list waiter)
- (declare (ignore wait-list waiter)))
-
-(defun %remove-waiter (wait-list waiter)
- (declare (ignore wait-list waiter)))
-
-(defun wait-for-input-internal (wait-list &key timeout)
- (with-mapped-conditions ()
- (process:process-block-with-timeout timeout "Wait for input"
- #'(lambda (wait-list)
- (let ((ready-sockets nil))
- (dolist (waiter (wait-list-waiters wait-list) ready-sockets)
- (setf (state waiter)
- (cond ((stream-usocket-p waiter)
- (if (listen (socket-stream waiter))
- :read
- nil))
- ((datagram-usocket-p waiter)
- (let ((connection (gs-connection (socket waiter))))
- (if (and connection
- (not (scl:send connection :connection-pending-p)))
- :read
- nil)))
- ((stream-server-usocket-p waiter)
- (if (gs-pending-connections (socket waiter))
- :read
- nil))))
- (when (not (null (state waiter)))
- (setf ready-sockets t)))))
- wait-list)
- wait-list))
-
(DIR) diff --git a/3rdparties/software/usocket-0.7.1/backend/lispworks.lisp b/3rdparties/software/usocket-0.7.1/backend/lispworks.lisp
@@ -1,986 +0,0 @@
-;;;; See LICENSE for licensing information.
-
-(in-package :usocket)
-
-(eval-when (:compile-toplevel :load-toplevel :execute)
- (require "comm")
-
- #+lispworks3
- (error "LispWorks 3 is not supported"))
-
-;;; ---------------------------------------------------------------------------
-;;; Warn if multiprocessing is not running on Lispworks
-
-(defun check-for-multiprocessing-started (&optional errorp)
- (unless mp:*current-process*
- (funcall (if errorp 'error 'warn)
- "You must start multiprocessing on Lispworks by calling~
- ~%~3t(~s)~
- ~%for ~s function properly."
- 'mp:initialize-multiprocessing
- 'wait-for-input)))
-
-(eval-when (:load-toplevel :execute)
- (check-for-multiprocessing-started))
-
-#+win32
-(eval-when (:load-toplevel :execute)
- (fli:register-module "ws2_32"))
-
-(fli:define-foreign-function (get-host-name-internal "gethostname" :source)
- ((return-string (:reference-return (:ef-mb-string :limit 257)))
- (namelen :int))
- :lambda-list (&aux (namelen 256) return-string)
- :result-type :int
- #+win32 :module
- #+win32 "ws2_32")
-
-(defun get-host-name ()
- (multiple-value-bind (return-code name)
- (get-host-name-internal)
- (when (zerop return-code)
- name)))
-
-#+win32
-(defun remap-maybe-for-win32 (z)
- (mapcar #'(lambda (x)
- (cons (mapcar #'(lambda (y) (+ 10000 y)) (car x))
- (cdr x)))
- z))
-
-(defparameter +lispworks-error-map+
- #+win32
- (append (remap-maybe-for-win32 +unix-errno-condition-map+)
- (remap-maybe-for-win32 +unix-errno-error-map+))
- #-win32
- (append +unix-errno-condition-map+
- +unix-errno-error-map+))
-
-(defun raise-usock-err (errno socket &optional condition)
- (let ((usock-err
- (cdr (assoc errno +lispworks-error-map+ :test #'member))))
- (if usock-err
- (if (subtypep usock-err 'error)
- (error usock-err :socket socket)
- (signal usock-err))
- (error 'unknown-error
- :socket socket
- :real-error condition
- :errno errno))))
-
-(defun handle-condition (condition &optional (socket nil))
- "Dispatch correct usocket condition."
- (typecase condition
- (condition (let ((errno #-win32 (lw:errno-value)
- #+win32 (wsa-get-last-error)))
- (unless (zerop errno)
- (raise-usock-err errno socket condition))))))
-
-(defconstant *socket_sock_dgram* 2
- "Connectionless, unreliable datagrams of fixed maximum length.")
-
-(defconstant *socket_ip_proto_udp* 17)
-
-(defconstant *sockopt_so_rcvtimeo*
- #-linux #x1006
- #+linux 20
- "Socket receive timeout")
-
-(defconstant *sockopt_so_sndtimeo*
- #-linux #x1007
- #+linux 21
- "Socket send timeout")
-
-(fli:define-c-struct timeval
- (tv-sec :long)
- (tv-usec :long))
-
-;;; ssize_t
-;;; recvfrom(int socket, void *restrict buffer, size_t length, int flags,
-;;; struct sockaddr *restrict address, socklen_t *restrict address_len);
-(fli:define-foreign-function (%recvfrom "recvfrom" :source)
- ((socket :int)
- (buffer (:pointer (:unsigned :byte)))
- (length :int)
- (flags :int)
- (address (:pointer (:struct comm::sockaddr)))
- (address-len (:pointer :int)))
- :result-type :int
- #+win32 :module
- #+win32 "ws2_32")
-
-;;; ssize_t
-;;; sendto(int socket, const void *buffer, size_t length, int flags,
-;;; const struct sockaddr *dest_addr, socklen_t dest_len);
-(fli:define-foreign-function (%sendto "sendto" :source)
- ((socket :int)
- (buffer (:pointer (:unsigned :byte)))
- (length :int)
- (flags :int)
- (address (:pointer (:struct comm::sockaddr)))
- (address-len :int))
- :result-type :int
- #+win32 :module
- #+win32 "ws2_32")
-
-#-win32
-(defun set-socket-receive-timeout (socket-fd seconds)
- "Set socket option: RCVTIMEO, argument seconds can be a float number"
- (declare (type integer socket-fd)
- (type number seconds))
- (multiple-value-bind (sec usec) (truncate seconds)
- (fli:with-dynamic-foreign-objects ((timeout (:struct timeval)))
- (fli:with-foreign-slots (tv-sec tv-usec) timeout
- (setf tv-sec sec
- tv-usec (truncate (* 1000000 usec)))
- (if (zerop (comm::setsockopt socket-fd
- comm::*sockopt_sol_socket*
- *sockopt_so_rcvtimeo*
- (fli:copy-pointer timeout
- :type '(:pointer :void))
- (fli:size-of '(:struct timeval))))
- seconds)))))
-
-#-win32
-(defun set-socket-send-timeout (socket-fd seconds)
- "Set socket option: SNDTIMEO, argument seconds can be a float number"
- (declare (type integer socket-fd)
- (type number seconds))
- (multiple-value-bind (sec usec) (truncate seconds)
- (fli:with-dynamic-foreign-objects ((timeout (:struct timeval)))
- (fli:with-foreign-slots (tv-sec tv-usec) timeout
- (setf tv-sec sec
- tv-usec (truncate (* 1000000 usec)))
- (if (zerop (comm::setsockopt socket-fd
- comm::*sockopt_sol_socket*
- *sockopt_so_sndtimeo*
- (fli:copy-pointer timeout
- :type '(:pointer :void))
- (fli:size-of '(:struct timeval))))
- seconds)))))
-
-#+win32
-(defun set-socket-receive-timeout (socket-fd seconds)
- "Set socket option: RCVTIMEO, argument seconds can be a float number.
- On win32, you must bind the socket before use this function."
- (declare (type integer socket-fd)
- (type number seconds))
- (fli:with-dynamic-foreign-objects ((timeout :int))
- (setf (fli:dereference timeout)
- (truncate (* 1000 seconds)))
- (if (zerop (comm::setsockopt socket-fd
- comm::*sockopt_sol_socket*
- *sockopt_so_rcvtimeo*
- (fli:copy-pointer timeout
- :type '(:pointer :char))
- (fli:size-of :int)))
- seconds)))
-
-#+win32
-(defun set-socket-send-timeout (socket-fd seconds)
- "Set socket option: SNDTIMEO, argument seconds can be a float number.
- On win32, you must bind the socket before use this function."
- (declare (type integer socket-fd)
- (type number seconds))
- (fli:with-dynamic-foreign-objects ((timeout :int))
- (setf (fli:dereference timeout)
- (truncate (* 1000 seconds)))
- (if (zerop (comm::setsockopt socket-fd
- comm::*sockopt_sol_socket*
- *sockopt_so_sndtimeo*
- (fli:copy-pointer timeout
- :type '(:pointer :char))
- (fli:size-of :int)))
- seconds)))
-
-#-win32
-(defun get-socket-receive-timeout (socket-fd)
- "Get socket option: RCVTIMEO, return value is a float number"
- (declare (type integer socket-fd))
- (fli:with-dynamic-foreign-objects ((timeout (:struct timeval))
- (len :int))
- (comm::getsockopt socket-fd
- comm::*sockopt_sol_socket*
- *sockopt_so_rcvtimeo*
- (fli:copy-pointer timeout
- :type '(:pointer :void))
- len)
- (fli:with-foreign-slots (tv-sec tv-usec) timeout
- (float (+ tv-sec (/ tv-usec 1000000))))))
-
-#-win32
-(defun get-socket-send-timeout (socket-fd)
- "Get socket option: SNDTIMEO, return value is a float number"
- (declare (type integer socket-fd))
- (fli:with-dynamic-foreign-objects ((timeout (:struct timeval))
- (len :int))
- (comm::getsockopt socket-fd
- comm::*sockopt_sol_socket*
- *sockopt_so_sndtimeo*
- (fli:copy-pointer timeout
- :type '(:pointer :void))
- len)
- (fli:with-foreign-slots (tv-sec tv-usec) timeout
- (float (+ tv-sec (/ tv-usec 1000000))))))
-
-#+win32
-(defun get-socket-receive-timeout (socket-fd)
- "Get socket option: RCVTIMEO, return value is a float number"
- (declare (type integer socket-fd))
- (fli:with-dynamic-foreign-objects ((timeout :int)
- (len :int))
- (comm::getsockopt socket-fd
- comm::*sockopt_sol_socket*
- *sockopt_so_rcvtimeo*
- (fli:copy-pointer timeout
- :type '(:pointer :void))
- len)
- (float (/ (fli:dereference timeout) 1000))))
-
-#+win32
-(defun get-socket-send-timeout (socket-fd)
- "Get socket option: SNDTIMEO, return value is a float number"
- (declare (type integer socket-fd))
- (fli:with-dynamic-foreign-objects ((timeout :int)
- (len :int))
- (comm::getsockopt socket-fd
- comm::*sockopt_sol_socket*
- *sockopt_so_sndtimeo*
- (fli:copy-pointer timeout
- :type '(:pointer :void))
- len)
- (float (/ (fli:dereference timeout) 1000))))
-
-#+(or lispworks4 lispworks5.0)
-(defun set-socket-tcp-nodelay (socket-fd new-value)
- "Set socket option: TCP_NODELAY, argument is a fixnum (0 or 1)"
- (declare (type integer socket-fd)
- (type (integer 0 1) new-value))
- (fli:with-dynamic-foreign-objects ((zero-or-one :int))
- (setf (fli:dereference zero-or-one) new-value)
- (when (zerop (comm::setsockopt socket-fd
- comm::*sockopt_sol_socket*
- comm::*sockopt_tcp_nodelay*
- (fli:copy-pointer zero-or-one
- :type '(:pointer #+win32 :char #-win32 :void))
- (fli:size-of :int)))
- new-value)))
-
-(defun get-socket-tcp-nodelay (socket-fd)
- "Get socket option: TCP_NODELAY, return value is a fixnum (0 or 1)"
- (declare (type integer socket-fd))
- (fli:with-dynamic-foreign-objects ((zero-or-one :int)
- (len :int))
- (if (zerop (comm::getsockopt socket-fd
- comm::*sockopt_sol_socket*
- comm::*sockopt_tcp_nodelay*
- (fli:copy-pointer zero-or-one
- :type '(:pointer #+win32 :char #-win32 :void))
- len))
- zero-or-one 0))) ; on error, return 0
-
-(defun initialize-dynamic-sockaddr (hostname service protocol &aux (original-hostname hostname))
- (declare (ignorable original-hostname))
- #+(or lispworks4 lispworks5 lispworks6.0)
- (let ((server-addr (fli:allocate-dynamic-foreign-object
- :type '(:struct comm::sockaddr_in))))
- (values (comm::initialize-sockaddr_in
- server-addr
- comm::*socket_af_inet*
- hostname
- service protocol)
- comm::*socket_af_inet*
- server-addr
- (fli:pointer-element-size server-addr)))
- #-(or lispworks4 lispworks5 lispworks6.0) ; version>=6.1
- (progn
- (when (stringp hostname)
- (setq hostname (comm:string-ip-address hostname))
- (unless hostname
- (let ((resolved-hostname (comm:get-host-entry original-hostname :fields '(:address))))
- (unless resolved-hostname
- (return-from initialize-dynamic-sockaddr :unknown-host))
- (setq hostname resolved-hostname))))
- (if (or (null hostname)
- (integerp hostname)
- (comm:ipv6-address-p hostname))
- (let ((server-addr (fli:allocate-dynamic-foreign-object
- :type '(:struct comm::lw-sockaddr))))
- (multiple-value-bind (error family)
- (comm::initialize-sockaddr_in
- server-addr
- hostname
- service protocol)
- (values error family
- server-addr
- (if (eql family comm::*socket_af_inet*)
- (fli:size-of '(:struct comm::sockaddr_in))
- (fli:size-of '(:struct comm::sockaddr_in6))))))
- :bad-host)))
-
-(defun open-udp-socket (&key local-address local-port read-timeout
- (address-family comm::*socket_af_inet*))
- "Open a unconnected UDP socket.
- For binding on address ANY(*), just not set LOCAL-ADDRESS (NIL),
- for binding on random free unused port, set LOCAL-PORT to 0."
-
- ;; Note: move (ensure-sockets) here to make sure delivered applications
- ;; correctly have networking support initialized.
- ;;
- ;; Following words was from Martin Simmons, forwarded by Camille Troillard:
-
- ;; Calling comm::ensure-sockets at load time looks like a bug in Lispworks-udp
- ;; (it is too early and also unnecessary).
-
- ;; The LispWorks comm package calls comm::ensure-sockets when it is needed, so I
- ;; think open-udp-socket should probably do it too. Calling it more than once is
- ;; safe and it will be very fast after the first time.
- #+win32 (comm::ensure-sockets)
-
- (let ((socket-fd (comm::socket address-family *socket_sock_dgram* *socket_ip_proto_udp*)))
- (if socket-fd
- (progn
- (when read-timeout (set-socket-receive-timeout socket-fd read-timeout))
- (if local-port
- (fli:with-dynamic-foreign-objects ()
- (multiple-value-bind (error local-address-family
- client-addr client-addr-length)
- (initialize-dynamic-sockaddr local-address local-port "udp")
- (if (or error (not (eql address-family local-address-family)))
- (progn
- (comm::close-socket socket-fd)
- (error "cannot resolve hostname ~S, service ~S: ~A"
- local-address local-port (or error "address family mismatch")))
- (if (comm::bind socket-fd client-addr client-addr-length)
- ;; success, return socket fd
- socket-fd
- (progn
- (comm::close-socket socket-fd)
- (error "cannot bind"))))))
- socket-fd))
- (error "cannot create socket"))))
-
-(defun connect-to-udp-server (hostname service
- &key local-address local-port read-timeout)
- "Something like CONNECT-TO-TCP-SERVER"
- (fli:with-dynamic-foreign-objects ()
- (multiple-value-bind (error address-family server-addr server-addr-length)
- (initialize-dynamic-sockaddr hostname service "udp")
- (when error
- (error "cannot resolve hostname ~S, service ~S: ~A"
- hostname service error))
- (let ((socket-fd (open-udp-socket :local-address local-address
- :local-port local-port
- :read-timeout read-timeout
- :address-family address-family)))
- (if socket-fd
- (if (comm::connect socket-fd server-addr server-addr-length)
- ;; success, return socket fd
- socket-fd
- ;; fail, close socket and return nil
- (progn
- (comm::close-socket socket-fd)
- (error "cannot connect")))
- (error "cannot create socket"))))))
-
-(defun socket-connect (host port &key (protocol :stream) (element-type 'base-char)
- timeout deadline (nodelay t)
- local-host local-port)
- ;; What's the meaning of this keyword?
- (when deadline
- (unimplemented 'deadline 'socket-connect))
-
- #+(and lispworks4 (not lispworks4.4)) ; < 4.4.5
- (when timeout
- (unsupported 'timeout 'socket-connect :minimum "LispWorks 4.4.5"))
-
- #+lispworks4
- (when local-host
- (unsupported 'local-host 'socket-connect :minimum "LispWorks 5.0"))
- #+lispworks4
- (when local-port
- (unsupported 'local-port 'socket-connect :minimum "LispWorks 5.0"))
-
- (ecase protocol
- (:stream
- (let ((hostname (host-to-hostname host))
- (stream))
- (setq stream
- (with-mapped-conditions ()
- (comm:open-tcp-stream hostname port
- :element-type element-type
- #-(and lispworks4 (not lispworks4.4)) ; >= 4.4.5
- #-(and lispworks4 (not lispworks4.4))
- :timeout timeout
- #-lispworks4 #-lispworks4
- #-lispworks4 #-lispworks4
- :local-address (when local-host (host-to-hostname local-host))
- :local-port local-port
- #-(or lispworks4 lispworks5.0) ; >= 5.1
- #-(or lispworks4 lispworks5.0)
- :nodelay nodelay)))
-
- ;; Then handle `nodelay' separately for older versions <= 5.0
- #+(or lispworks4 lispworks5.0)
- (when (and stream nodelay)
- (set-socket-tcp-nodelay
- (comm:socket-stream-socket stream)
- (bool->int nodelay))) ; ":if-supported" maps to 1 too.
-
- (if stream
- (make-stream-socket :socket (comm:socket-stream-socket stream)
- :stream stream)
- ;; if no other error catched by above with-mapped-conditions and still fails, then it's a timeout
- (error 'timeout-error))))
- (:datagram
- (let ((usocket (make-datagram-socket
- (if (and host port)
- (with-mapped-conditions ()
- (connect-to-udp-server (host-to-hostname host) port
- :local-address (and local-host (host-to-hostname local-host))
- :local-port local-port
- :read-timeout timeout))
- (with-mapped-conditions ()
- (open-udp-socket :local-address (and local-host (host-to-hostname local-host))
- :local-port local-port
- :read-timeout timeout)))
- :connected-p (and host port t))))
- usocket))))
-
-(defun socket-listen (host port
- &key reuseaddress
- (reuse-address nil reuse-address-supplied-p)
- (backlog 5)
- (element-type 'base-char))
- #+lispworks4.1
- (unsupported 'host 'socket-listen :minimum "LispWorks 4.0 or newer than 4.1")
- #+lispworks4.1
- (unsupported 'backlog 'socket-listen :minimum "LispWorks 4.0 or newer than 4.1")
-
- (let* ((reuseaddress (if reuse-address-supplied-p reuse-address reuseaddress))
- (comm::*use_so_reuseaddr* reuseaddress)
- (hostname (host-to-hostname host))
- (socket-res-list (with-mapped-conditions ()
- (multiple-value-list
- #-lispworks4.1 (comm::create-tcp-socket-for-service
- port :address hostname :backlog backlog)
- #+lispworks4.1 (comm::create-tcp-socket-for-service port))))
- (sock (if (not (or (second socket-res-list) (third socket-res-list)))
- (first socket-res-list)
- (when (eq (second socket-res-list) :bind)
- (error 'address-in-use-error)))))
- (make-stream-server-socket sock :element-type element-type)))
-
-;; Note: COMM::GET-FD-FROM-SOCKET contains addition socket wait operations, which
-;; should NOT be applied on socket FDs who have already been called on W-F-I,
-;; so we have to check the %READY-P slot to decide if this waiting is necessary,
-;; or SOCKET-ACCEPT will just hang. -- Chun Tian (binghe), May 1, 2011
-
-(defmethod socket-accept ((usocket stream-server-usocket) &key element-type)
- (let* ((socket (with-mapped-conditions (usocket)
- #+win32
- (if (%ready-p usocket)
- (comm::accept-connection-to-socket (socket usocket))
- (comm::get-fd-from-socket (socket usocket)))
- #-win32
- (comm::get-fd-from-socket (socket usocket))))
- (stream (make-instance 'comm:socket-stream
- :socket socket
- :direction :io
- :element-type (or element-type
- (element-type usocket)))))
- #+win32
- (when socket
- (setf (%ready-p usocket) nil))
- (make-stream-socket :socket socket :stream stream)))
-
-;; Sockets and their streams are different objects
-;; close the stream in order to make sure buffers
-;; are correctly flushed and the socket closed.
-(defmethod socket-close ((usocket stream-usocket))
- "Close socket."
- (when (wait-list usocket)
- (remove-waiter (wait-list usocket) usocket))
- (close (socket-stream usocket)))
-
-(defmethod socket-close ((usocket usocket))
- (when (wait-list usocket)
- (remove-waiter (wait-list usocket) usocket))
- (with-mapped-conditions (usocket)
- (comm::close-socket (socket usocket))))
-
-(defmethod socket-close :after ((socket datagram-usocket))
- "Additional socket-close method for datagram-usocket"
- (setf (%open-p socket) nil))
-
-(defconstant +shutdown-read+ 0)
-(defconstant +shutdown-write+ 1)
-(defconstant +shutdown-read-write+ 2)
-
-;;; int
-;;; shutdown(int socket, int what);
-(fli:define-foreign-function (%shutdown "shutdown" :source)
- ((socket :int)
- (what :int))
- :result-type :int
- #+win32 :module
- #+win32 "ws2_32")
-
-(defmethod socket-shutdown ((usocket datagram-usocket) direction)
- (unless (member direction '(:input :output :io))
- (error 'invalid-argument-error))
- (let ((what (case direction
- (:input +shutdown-read+)
- (:output +shutdown-write+)
- (:io +shutdown-read-write+))))
- (with-mapped-conditions (usocket)
- #-(or lispworks4 lispworks5 lispworks6) ; lispworks 7.0+
- (comm::shutdown (socket usocket) what)
- #+(or lispworks4 lispworks5 lispworks6)
- (= 0 (%shutdown (socket usocket) what)))))
-
-(defmethod socket-shutdown ((usocket stream-usocket) direction)
- (unless (member direction '(:input :output :io))
- (error 'invalid-argument-error))
- (with-mapped-conditions (usocket)
- #-(or lispworks4 lispworks5 lispworks6)
- (comm:socket-stream-shutdown (socket usocket) direction)
- #+(or lispworks4 lispworks5 lispworks6)
- (let ((what (case direction
- (:input +shutdown-read+)
- (:output +shutdown-write+)
- (:io +shutdown-read-write+))))
- (= 0 (%shutdown (comm:socket-stream-socket (socket usocket)) what)))))
-
-(defmethod initialize-instance :after ((socket datagram-usocket) &key)
- (setf (slot-value socket 'send-buffer)
- (make-array +max-datagram-packet-size+
- :element-type '(unsigned-byte 8)
- :allocation :static))
- (setf (slot-value socket 'recv-buffer)
- (make-array +max-datagram-packet-size+
- :element-type '(unsigned-byte 8)
- :allocation :static)))
-
-(defvar *length-of-sockaddr_in*
- (fli:size-of '(:struct comm::sockaddr_in)))
-
-(defmethod socket-send ((usocket datagram-usocket) buffer size &key host port (offset 0)
- &aux (socket-fd (socket usocket))
- (message (slot-value usocket 'send-buffer))) ; TODO: multiple threads send together?
- "Send message to a socket, using sendto()/send()"
- (declare (type integer socket-fd)
- (type sequence buffer))
- (when host (setq host (host-to-hostname host)))
- (fli:with-dynamic-lisp-array-pointer (ptr message :type '(:unsigned :byte))
- (replace message buffer :start2 offset :end2 (+ offset size))
- (let ((n (if (and host port)
- (fli:with-dynamic-foreign-objects ()
- (multiple-value-bind (error family client-addr client-addr-length)
- (initialize-dynamic-sockaddr host port "udp")
- (declare (ignore family))
- (when error
- (error "cannot resolve hostname ~S, port ~S: ~A"
- host port error))
- (%sendto socket-fd ptr (min size +max-datagram-packet-size+) 0
- (fli:copy-pointer client-addr :type '(:struct comm::sockaddr))
- client-addr-length)))
- (comm::%send socket-fd ptr (min size +max-datagram-packet-size+) 0))))
- (declare (type fixnum n))
- (if (plusp n)
- n
- (let ((errno #-win32 (lw:errno-value)
- #+win32 (wsa-get-last-error)))
- (if (zerop errno)
- n
- (raise-usock-err errno socket-fd)))))))
-
-(defmethod socket-receive ((socket datagram-usocket) buffer length &key timeout (max-buffer-size +max-datagram-packet-size+))
- "Receive message from socket, read-timeout is a float number in seconds.
-
- This function will return 4 values:
- 1. receive buffer
- 2. number of receive bytes
- 3. remote address
- 4. remote port"
- (declare (values (simple-array (unsigned-byte 8) (*)) ; buffer
- (integer 0) ; size
- (unsigned-byte 32) ; host
- (unsigned-byte 16)) ; port
- (type sequence buffer))
- (let ((socket-fd (socket socket))
- (message (slot-value socket 'recv-buffer)) ; TODO: how multiple threads do this in parallel?
- (read-timeout timeout)
- old-timeout)
- (declare (type integer socket-fd))
- (fli:with-dynamic-foreign-objects ((client-addr (:struct comm::sockaddr_in))
- (len :int
- #-(or lispworks4 lispworks5.0) ; <= 5.0
- :initial-element *length-of-sockaddr_in*))
- #+(or lispworks4 lispworks5.0) ; <= 5.0
- (setf (fli:dereference len) *length-of-sockaddr_in*)
- (fli:with-dynamic-lisp-array-pointer (ptr message :type '(:unsigned :byte))
- ;; setup new read timeout
- (when read-timeout
- (setf old-timeout (get-socket-receive-timeout socket-fd))
- (set-socket-receive-timeout socket-fd read-timeout))
- (let ((n (%recvfrom socket-fd ptr max-buffer-size 0
- (fli:copy-pointer client-addr :type '(:struct comm::sockaddr))
- len)))
- (declare (type fixnum n))
- ;; restore old read timeout
- (when (and read-timeout (/= old-timeout read-timeout))
- (set-socket-receive-timeout socket-fd old-timeout))
- ;; Frank James' patch: reset the %read-p for WAIT-FOR-INPUT
- #+win32 (setf (%ready-p socket) nil)
- (if (plusp n)
- (values (if buffer
- (replace buffer message
- :end1 (min length max-buffer-size)
- :end2 (min n max-buffer-size))
- (subseq message 0 (min n max-buffer-size)))
- (min n max-buffer-size)
- (comm::ntohl (fli:foreign-slot-value
- (fli:foreign-slot-value client-addr
- 'comm::sin_addr
- :object-type '(:struct comm::sockaddr_in)
- :type '(:struct comm::in_addr)
- :copy-foreign-object nil)
- 'comm::s_addr
- :object-type '(:struct comm::in_addr)))
- (comm::ntohs (fli:foreign-slot-value client-addr
- 'comm::sin_port
- :object-type '(:struct comm::sockaddr_in)
- :type '(:unsigned :short)
- :copy-foreign-object nil)))
- (let ((errno #-win32 (lw:errno-value)
- #+win32 (wsa-get-last-error)))
- (if (zerop errno)
- (values nil n 0 0)
- (raise-usock-err errno socket-fd)))))))))
-
-(defmethod get-local-name ((usocket usocket))
- (multiple-value-bind
- (address port)
- (comm:get-socket-address (socket usocket))
- (values (hbo-to-vector-quad address) port)))
-
-(defmethod get-peer-name ((usocket stream-usocket))
- (multiple-value-bind
- (address port)
- (comm:get-socket-peer-address (socket usocket))
- (values (hbo-to-vector-quad address) port)))
-
-(defmethod get-local-address ((usocket usocket))
- (nth-value 0 (get-local-name usocket)))
-
-(defmethod get-peer-address ((usocket stream-usocket))
- (nth-value 0 (get-peer-name usocket)))
-
-(defmethod get-local-port ((usocket usocket))
- (nth-value 1 (get-local-name usocket)))
-
-(defmethod get-peer-port ((usocket stream-usocket))
- (nth-value 1 (get-peer-name usocket)))
-
-#-(or lispworks4 lispworks5 lispworks6.0) ; version>= 6.1
-(defun ipv6-address-p (hostname)
- (when (stringp hostname)
- (setq hostname (comm:string-ip-address hostname))
- (unless hostname
- (let ((resolved-hostname (comm:get-host-entry hostname :fields '(:address))))
- (unless resolved-hostname
- (return-from ipv6-address-p nil))
- (setq hostname resolved-hostname))))
- (comm:ipv6-address-p hostname))
-
-(defun lw-hbo-to-vector-quad (hbo)
- #+(or lispworks4 lispworks5 lispworks6.0)
- (hbo-to-vector-quad hbo)
- #-(or lispworks4 lispworks5 lispworks6.0) ; version>= 6.1
- (if (comm:ipv6-address-p hbo)
- (ipv6-host-to-vector (comm:ipv6-address-string hbo))
- (hbo-to-vector-quad hbo)))
-
-(defun get-hosts-by-name (name)
- (with-mapped-conditions ()
- (mapcar #'lw-hbo-to-vector-quad
- (comm:get-host-entry name :fields '(:addresses)))))
-
-(defun os-socket-handle (usocket)
- (socket usocket))
-
-(defun usocket-listen (usocket)
- (if (stream-usocket-p usocket)
- (when (listen (socket-stream usocket))
- usocket)
- (when (comm::socket-listen (socket usocket))
- usocket)))
-
-;;;
-;;; Non Windows implementation
-;;; The Windows implementation needs to resort to the Windows API in order
-;;; to achieve what we want (what we want is waiting without busy-looping)
-;;;
-
-#-win32
-(progn
-
- (defun %setup-wait-list (wait-list)
- (declare (ignore wait-list)))
-
- (defun %add-waiter (wait-list waiter)
- (declare (ignore wait-list waiter)))
-
- (defun %remove-waiter (wait-list waiter)
- (declare (ignore wait-list waiter)))
-
- (defun wait-for-input-internal (wait-list &key timeout)
- (with-mapped-conditions ()
- ;; unfortunately, it's impossible to share code between
- ;; non-win32 and win32 platforms...
- ;; Can we have a sane -pref. complete [UDP!?]- API next time, please?
- (dolist (x (wait-list-waiters wait-list))
- (mp:notice-fd (os-socket-handle x)))
- (labels ((wait-function (socks)
- (let (rv)
- (dolist (x socks rv)
- (when (usocket-listen x)
- (setf (state x) :READ
- rv t))))))
- (if timeout
- (mp:process-wait-with-timeout "Waiting for a socket to become active"
- (truncate timeout)
- #'wait-function
- (wait-list-waiters wait-list))
- (mp:process-wait "Waiting for a socket to become active"
- #'wait-function
- (wait-list-waiters wait-list))))
- (dolist (x (wait-list-waiters wait-list))
- (mp:unnotice-fd (os-socket-handle x)))
- wait-list))
-
-) ; end of block
-
-
-;;;
-;;; The Windows side of the story
-;;; We want to wait without busy looping
-;;; This code only works in threads which don't have (hidden)
-;;; windows which need to receive messages. There are workarounds in the Windows API
-;;; but are those available to 'us'.
-;;;
-
-
-#+win32
-(progn
-
- ;; LispWorks doesn't provide an interface to wait for a socket
- ;; to become ready (under Win32, that is) meaning that we need
- ;; to resort to system calls to achieve the same thing.
- ;; Luckily, it provides us access to the raw socket handles (as we
- ;; wrote the code above.
-
- (defconstant fd-read 1)
- (defconstant fd-read-bit 0)
- (defconstant fd-write 2)
- (defconstant fd-write-bit 1)
- (defconstant fd-oob 4)
- (defconstant fd-oob-bit 2)
- (defconstant fd-accept 8)
- (defconstant fd-accept-bit 3)
- (defconstant fd-connect 16)
- (defconstant fd-connect-bit 4)
- (defconstant fd-close 32)
- (defconstant fd-close-bit 5)
- (defconstant fd-qos 64)
- (defconstant fd-qos-bit 6)
- (defconstant fd-group-qos 128)
- (defconstant fd-group-qos-bit 7)
- (defconstant fd-routing-interface 256)
- (defconstant fd-routing-interface-bit 8)
- (defconstant fd-address-list-change 512)
- (defconstant fd-address-list-change-bit 9)
-
- (defconstant fd-max-events 10)
-
- (defconstant fionread 1074030207)
-
-
- ;; Note:
- ;;
- ;; If special finalization has to occur for a given
- ;; system resource (handle), an associated object should
- ;; be created. A special cleanup action should be added
- ;; to the system and a special cleanup action should
- ;; be flagged on all objects created for resources like it
- ;;
- ;; We have 2 functions to do so:
- ;; * hcl:add-special-free-action (function-symbol)
- ;; * hcl:flag-special-free-action (object)
- ;;
- ;; Note that the special free action will be called on all
- ;; objects which have been flagged for special free, so be
- ;; sure to check for the right argument type!
-
- (fli:define-foreign-type ws-socket () '(:unsigned :int))
- (fli:define-foreign-type win32-handle () '(:unsigned :int))
- (fli:define-c-struct wsa-network-events
- (network-events :long)
- (error-code (:c-array :int 10)))
-
- (fli:define-foreign-function (wsa-event-create "WSACreateEvent" :source)
- ()
- :lambda-list nil
- :result-type :int
- :module "ws2_32")
-
- (fli:define-foreign-function (wsa-event-close "WSACloseEvent" :source)
- ((event-object win32-handle))
- :result-type :int
- :module "ws2_32")
-
- (fli:define-foreign-function (wsa-enum-network-events "WSAEnumNetworkEvents" :source)
- ((socket ws-socket)
- (event-object win32-handle)
- (network-events (:reference-return wsa-network-events)))
- :result-type :int
- :module "ws2_32")
-
- (fli:define-foreign-function (wsa-event-select "WSAEventSelect" :source)
- ((socket ws-socket)
- (event-object win32-handle)
- (network-events :long))
- :result-type :int
- :module "ws2_32")
-
- (fli:define-foreign-function (wsa-get-last-error "WSAGetLastError" :source)
- ()
- :result-type :int
- :module "ws2_32")
-
- (fli:define-foreign-function (wsa-ioctlsocket "ioctlsocket" :source)
- ((socket :long) (cmd :long) (argp (:ptr :long)))
- :result-type :int
- :module "ws2_32")
-
-
- ;; The Windows system
-
-
- ;; Now that we have access to the system calls, this is the plan:
-
- ;; 1. Receive a wait-list with associated sockets to wait for
- ;; 2. Add all those sockets to an event handle
- ;; 3. Listen for an event on that handle (we have a LispWorks system:: internal for that)
- ;; 4. After listening, detect if there are errors
- ;; (this step is different from Unix, where we can have only one error)
- ;; 5. If so, raise one of them
- ;; 6. If not so, return the sockets which have input waiting for them
-
-
- (defun maybe-wsa-error (rv &optional socket)
- (unless (zerop rv)
- (raise-usock-err (wsa-get-last-error) socket)))
-
- (defun bytes-available-for-read (socket)
- (fli:with-dynamic-foreign-objects ((int-ptr :long))
- (let ((rv (wsa-ioctlsocket (os-socket-handle socket) fionread int-ptr)))
- (if (= 0 rv)
- (fli:dereference int-ptr)
- 0))))
-
- (defun socket-ready-p (socket)
- (if (typep socket 'stream-usocket)
- (< 0 (bytes-available-for-read socket))
- (%ready-p socket)))
-
- (defun waiting-required (sockets)
- (notany #'socket-ready-p sockets))
-
- (defun wait-for-input-internal (wait-list &key timeout)
- (when (waiting-required (wait-list-waiters wait-list))
- (system:wait-for-single-object (wait-list-%wait wait-list)
- "Waiting for socket activity" timeout))
- (update-ready-and-state-slots (wait-list-waiters wait-list)))
-
- (defun map-network-events (func network-events)
- (let ((event-map (fli:foreign-slot-value network-events 'network-events))
- (error-array (fli:foreign-slot-pointer network-events 'error-code)))
- (unless (zerop event-map)
- (dotimes (i fd-max-events)
- (unless (zerop (ldb (byte 1 i) event-map)) ;;### could be faster with ash and logand?
- (funcall func (fli:foreign-aref error-array i)))))))
-
- (defun update-ready-and-state-slots (sockets)
- (dolist (socket sockets)
- (if (or (and (stream-usocket-p socket)
- (listen (socket-stream socket)))
- (%ready-p socket))
- (setf (state socket) :READ)
- (multiple-value-bind
- (rv network-events)
- (wsa-enum-network-events (os-socket-handle socket) 0 t)
- (if (zerop rv)
- (map-network-events #'(lambda (err-code)
- (if (zerop err-code)
- (setf (%ready-p socket) t
- (state socket) :READ)
- (raise-usock-err err-code socket)))
- network-events)
- (maybe-wsa-error rv socket))))))
-
- ;; The wait-list part
-
- (defun free-wait-list (wl)
- (when (wait-list-p wl)
- (unless (null (wait-list-%wait wl))
- (wsa-event-close (wait-list-%wait wl))
- (setf (wait-list-%wait wl) nil))))
-
- (eval-when (:load-toplevel :execute)
- (hcl:add-special-free-action 'free-wait-list))
-
- (defun %setup-wait-list (wait-list)
- (hcl:flag-special-free-action wait-list)
- (setf (wait-list-%wait wait-list) (wsa-event-create)))
-
- (defun %add-waiter (wait-list waiter)
- (let ((events (etypecase waiter
- (stream-server-usocket (logior fd-connect fd-accept fd-close))
- (stream-usocket (logior fd-connect fd-read fd-oob fd-close))
- (datagram-usocket (logior fd-read)))))
- (maybe-wsa-error
- (wsa-event-select (os-socket-handle waiter) (wait-list-%wait wait-list) events)
- waiter)))
-
- (defun %remove-waiter (wait-list waiter)
- (maybe-wsa-error
- (wsa-event-select (os-socket-handle waiter) (wait-list-%wait wait-list) 0)
- waiter))
-
-) ; end of WIN32-block
-
-(defun set-socket-reuse-address (socket-fd reuse-address-p)
- (declare (type integer socket-fd)
- (type boolean reuse-address-p))
- (fli:with-dynamic-foreign-objects ((value :int))
- (setf (fli:dereference value) (if reuse-address-p 1 0))
- (if (zerop (comm::setsockopt socket-fd
- comm::*sockopt_sol_socket*
- comm::*sockopt_so_reuseaddr*
- (fli:copy-pointer value
- :type '(:pointer :void))
- (fli:size-of :int)))
- reuse-address-p)))
-
-(defun get-socket-reuse-address (socket-fd)
- (declare (type integer socket-fd))
- (fli:with-dynamic-foreign-objects ((value :int) (len :int))
- (if (zerop (comm::getsockopt socket-fd
- comm::*sockopt_sol_socket*
- comm::*sockopt_so_reuseaddr*
- (fli:copy-pointer value
- :type '(:pointer :void))
- len))
- (= 1 (fli:dereference value)))))
(DIR) diff --git a/3rdparties/software/usocket-0.7.1/backend/mcl.lisp b/3rdparties/software/usocket-0.7.1/backend/mcl.lisp
@@ -1,269 +0,0 @@
-;; MCL backend for USOCKET 0.4.1
-;; Terje Norderhaug <terje@in-progress.com>, January 1, 2009
-
-(in-package :usocket)
-
-(defun handle-condition (condition &optional socket)
- ; incomplete, needs to handle additional conditions
- (flet ((raise-error (&optional socket-condition)
- (if socket-condition
- (error socket-condition :socket socket)
- (error 'unknown-error :socket socket :real-error condition))))
- (typecase condition
- (ccl:host-stopped-responding
- (raise-error 'host-down-error))
- (ccl:host-not-responding
- (raise-error 'host-unreachable-error))
- (ccl:connection-reset
- (raise-error 'connection-reset-error))
- (ccl:connection-timed-out
- (raise-error 'timeout-error))
- (ccl:opentransport-protocol-error
- (raise-error 'protocol-not-supported-error))
- (otherwise
- (raise-error)))))
-
-(defun socket-connect (host port &key (element-type 'character) timeout deadline nodelay
- local-host local-port (protocol :stream))
- (when (eq nodelay :if-supported)
- (setf nodelay t))
- (ecase protocol
- (:stream
- (with-mapped-conditions ()
- (let* ((socket
- (make-instance 'active-socket
- :remote-host (when host (host-to-hostname host))
- :remote-port port
- :local-host (when local-host (host-to-hostname local-host))
- :local-port local-port
- :deadline deadline
- :nodelay nodelay
- :connect-timeout (and timeout (round (* timeout 60)))
- :element-type element-type))
- (stream (socket-open-stream socket)))
- (make-stream-socket :socket socket :stream stream))))
- (:datagram
- (with-mapped-conditions ()
- (make-datagram-socket
- (ccl::open-udp-socket :local-address (and local-host (host-to-hbo local-host))
- :local-port local-port))))))
-
-(defun socket-listen (host port
- &key reuseaddress
- (reuse-address nil reuse-address-supplied-p)
- (backlog 5)
- (element-type 'character))
- (let* ((reuseaddress (if reuse-address-supplied-p reuse-address reuseaddress))
- (socket (with-mapped-conditions ()
- (make-instance 'passive-socket
- :local-port port
- :local-host (host-to-hbo host)
- :reuse-address reuseaddress
- :backlog backlog))))
- (make-stream-server-socket socket :element-type element-type)))
-
-(defmethod socket-accept ((usocket stream-server-usocket) &key element-type)
- (let* ((socket (socket usocket))
- (stream (with-mapped-conditions (usocket)
- (socket-accept socket :element-type element-type))))
- (make-stream-socket :socket socket :stream stream)))
-
-(defmethod socket-close ((usocket usocket))
- (with-mapped-conditions (usocket)
- (socket-close (socket usocket))))
-
-(defmethod socket-shutdown ((usocket usocket) direction)
- (declare (ignore usocket direction))
- ;; As far as I can tell there isn't a way to shutdown a socket in mcl.
- (unsupported "shutdown" 'socket-shutdown))
-
-(defmethod ccl::stream-close ((usocket usocket))
- (socket-close usocket))
-
-(defun get-hosts-by-name (name)
- (with-mapped-conditions ()
- (list (hbo-to-vector-quad (ccl::get-host-address
- (host-to-hostname name))))))
-
-(defun get-host-by-address (address)
- (with-mapped-conditions ()
- (ccl::inet-host-name (host-to-hbo address))))
-
-(defmethod get-local-name ((usocket usocket))
- (values (get-local-address usocket)
- (get-local-port usocket)))
-
-(defmethod get-peer-name ((usocket stream-usocket))
- (values (get-peer-address usocket)
- (get-peer-port usocket)))
-
-(defmethod get-local-address ((usocket usocket))
- (hbo-to-vector-quad (ccl::get-host-address (or (local-host (socket usocket)) ""))))
-
-(defmethod get-local-port ((usocket usocket))
- (local-port (socket usocket)))
-
-(defmethod get-peer-address ((usocket stream-usocket))
- (hbo-to-vector-quad (ccl::get-host-address (remote-host (socket usocket)))))
-
-(defmethod get-peer-port ((usocket stream-usocket))
- (remote-port (socket usocket)))
-
-
-(defun %setup-wait-list (wait-list)
- (declare (ignore wait-list)))
-
-(defun %add-waiter (wait-list waiter)
- (declare (ignore wait-list waiter)))
-
-(defun %remove-waiter (wait-list waiter)
- (declare (ignore wait-list waiter)))
-
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; BASIC MCL SOCKET IMPLEMENTATION
-
-(defclass socket ()
- ((local-port :reader local-port :initarg :local-port)
- (local-host :reader local-host :initarg :local-host)
- (element-type :reader element-type :initform 'ccl::base-character :initarg :element-type)))
-
-(defclass active-socket (socket)
- ((remote-host :reader remote-host :initarg :remote-host)
- (remote-port :reader remote-port :initarg :remote-port)
- (deadline :initarg :deadline)
- (nodelay :initarg :nodelay)
- (connect-timeout :reader connect-timeout :initform NIL :initarg :connect-timeout
- :type (or null fixnum) :documentation "ticks (60th of a second)")))
-
-(defmethod socket-open-stream ((socket active-socket))
- (ccl::open-tcp-stream (or (remote-host socket)(ccl::local-interface-ip-address)) (remote-port socket)
- :element-type (if (subtypep (element-type socket) 'character) 'ccl::base-character 'unsigned-byte)
- :connect-timeout (connect-timeout socket)))
-
-(defmethod socket-close ((socket active-socket))
- NIL)
-
-(defclass passive-socket (socket)
- ((streams :accessor socket-streams :type list :initform NIL
- :documentation "Circular list of streams with first element the next to open")
- (reuse-address :reader reuse-address :initarg :reuse-address)
- (lock :reader socket-lock :initform (ccl:make-lock "Socket"))))
-
-(defmethod initialize-instance :after ((socket passive-socket) &key backlog)
- (loop repeat backlog
- collect (socket-open-listener socket) into streams
- finally (setf (socket-streams socket)
- (cdr (rplacd (last streams) streams))))
- (when (zerop (local-port socket))
- (setf (slot-value socket 'local-port)
- (or (ccl::process-wait-with-timeout "binding port" (* 10 60)
- #'ccl::stream-local-port (car (socket-streams socket)))
- (error "timeout")))))
-
-(defmethod socket-accept ((socket passive-socket) &key element-type &aux (lock (socket-lock socket)))
- (flet ((connection-established-p (stream)
- (ccl::with-io-buffer-locked ((ccl::stream-io-buffer stream nil))
- (let ((state (ccl::opentransport-stream-connection-state stream)))
- (not (eq :unbnd state))))))
- (with-mapped-conditions ()
- (ccl:with-lock-grabbed (lock nil "Socket Lock")
- (let ((connection (shiftf (car (socket-streams socket))
- (socket-open-listener socket element-type))))
- (pop (socket-streams socket))
- (ccl:process-wait "Accepting" #'connection-established-p connection)
- connection)))))
-
-(defmethod socket-close ((socket passive-socket))
- (loop
- with streams = (socket-streams socket)
- for (stream tail) on streams
- do (close stream :abort T)
- until (eq tail streams)
- finally (setf (socket-streams socket) NIL)))
-
-(defmethod socket-open-listener (socket &optional element-type)
- ; see http://code.google.com/p/mcl/issues/detail?id=28
- (let* ((ccl::*passive-interface-address* (local-host socket))
- (new (ccl::open-tcp-stream NIL (or (local-port socket) #$kOTAnyInetAddress)
- :reuse-local-port-p (reuse-address socket)
- :element-type (if (subtypep (or element-type (element-type socket))
- 'character)
- 'ccl::base-character
- 'unsigned-byte))))
- (declare (special ccl::*passive-interface-address*))
- new))
-
-(defmethod input-available-p ((stream ccl::opentransport-stream))
- (macrolet ((when-io-buffer-lock-grabbed ((lock &optional multiple-value-p) &body body)
- "Evaluates the body if and only if the lock is successfully grabbed"
- ;; like with-io-buffer-lock-grabbed but returns immediately instead of polling the lock
- (let ((needs-unlocking-p (gensym))
- (lock-var (gensym)))
- `(let* ((,lock-var ,lock)
- (ccl::*grabbed-io-buffer-locks* (cons ,lock-var ccl::*grabbed-io-buffer-locks*))
- (,needs-unlocking-p (needs-unlocking-p ,lock-var)))
- (declare (dynamic-extent ccl::*grabbed-io-buffer-locks*))
- (when ,needs-unlocking-p
- (,(if multiple-value-p 'multiple-value-prog1 'prog1)
- (progn ,@body)
- (ccl::%release-io-buffer-lock ,lock-var)))))))
- (labels ((needs-unlocking-p (lock)
- (declare (type ccl::lock lock))
- ;; crucial - clears bogus lock.value as in grab-io-buffer-lock-out-of-line:
- (ccl::%io-buffer-lock-really-grabbed-p lock)
- (ccl:store-conditional lock nil ccl:*current-process*)))
- "similar to stream-listen on buffered-input-stream-mixin but without waiting for lock"
- (let ((io-buffer (ccl::stream-io-buffer stream)))
- (or (not (eql 0 (ccl::io-buffer-incount io-buffer)))
- (ccl::io-buffer-untyi-char io-buffer)
- (locally (declare (optimize (speed 3) (safety 0)))
- (when-io-buffer-lock-grabbed ((ccl::io-buffer-lock io-buffer))
- (funcall (ccl::io-buffer-listen-function io-buffer) stream io-buffer))))))))
-
-(defmethod connection-established-p ((stream ccl::opentransport-stream))
- (ccl::with-io-buffer-locked ((ccl::stream-io-buffer stream nil))
- (let ((state (ccl::opentransport-stream-connection-state stream)))
- (not (eq :unbnd state)))))
-
-(defun wait-for-input-internal (wait-list &key timeout &aux result)
- (labels ((ready-sockets (sockets)
- (dolist (sock sockets result)
- (when (cond ((stream-usocket-p sock)
- (input-available-p (socket-stream sock)))
- ((stream-server-usocket-p sock)
- (let ((ot-stream (first (socket-streams (socket sock)))))
- (or (input-available-p ot-stream)
- (connection-established-p ot-stream)))))
- (push sock result)))))
- (with-mapped-conditions ()
- (ccl:process-wait-with-timeout
- "socket input"
- (when timeout (truncate (* timeout 60)))
- #'ready-sockets
- (wait-list-waiters wait-list)))
- (nreverse result)))
-
-;;; datagram socket methods
-
-(defmethod initialize-instance :after ((usocket datagram-usocket) &key)
- (with-slots (socket send-buffer recv-buffer) usocket
- (setq send-buffer
- (ccl::make-TUnitData (ccl::ot-conn-endpoint socket)))
- (setq recv-buffer
- (ccl::make-TUnitData (ccl::ot-conn-endpoint socket)))))
-
-(defmethod socket-send ((usocket datagram-usocket) buffer size &key host port (offset 0))
- (with-mapped-conditions (usocket)
- (with-slots (socket send-buffer) usocket
- (unless (and host port)
- (unsupported 'host 'socket-send))
- (ccl::send-message socket send-buffer buffer size host port offset))))
-
-(defmethod socket-receive ((usocket datagram-usocket) buffer length &key)
- (with-mapped-conditions (usocket)
- (with-slots (socket recv-buffer) usocket
- (ccl::receive-message socket recv-buffer buffer length))))
-
-(defmethod socket-close ((socket datagram-usocket))
- nil) ; TODO
(DIR) diff --git a/3rdparties/software/usocket-0.7.1/backend/mocl.lisp b/3rdparties/software/usocket-0.7.1/backend/mocl.lisp
@@ -1,159 +0,0 @@
-;;;; See LICENSE for licensing information.
-
-(in-package :usocket)
-
-(defun handle-condition (condition &optional (socket nil))
- "Dispatch correct usocket condition."
- (declare (ignore socket))
- (signal condition))
-
-(defun socket-connect (host port &key (protocol :stream) (element-type 'character)
- timeout deadline (nodelay t nodelay-specified)
- (local-host nil local-host-p)
- (local-port nil local-port-p))
- (when (and nodelay-specified
- (not (eq nodelay :if-supported)))
- (unsupported 'nodelay 'socket-connect))
- (when deadline (unsupported 'deadline 'socket-connect))
- (when timeout (unimplemented 'timeout 'socket-connect))
- (when local-host-p
- (unimplemented 'local-host 'socket-connect))
- (when local-port-p
- (unimplemented 'local-port 'socket-connect))
-
- (let (socket)
- (ecase protocol
- (:stream
- (setf socket (rt::socket-connect host port))
- (let ((stream (rt::make-socket-stream socket :binaryp (not (eq element-type 'character)))))
- (make-stream-socket :socket socket :stream stream)))
- (:datagram
- (error 'unsupported
- :feature '(protocol :datagram)
- :context 'socket-connect)))))
-
-(defun socket-listen (host port
- &key reuseaddress
- (reuse-address nil reuse-address-supplied-p)
- (backlog 5)
- (element-type 'character))
- (unimplemented 'socket-listen 'mocl))
-
-(defmethod socket-accept ((usocket stream-server-usocket) &key element-type)
- (unimplemented 'socket-accept 'mocl))
-
-;; Sockets and their associated streams are modelled as
-;; different objects. Be sure to close the socket stream
-;; when closing stream-sockets; it makes sure buffers
-;; are flushed and the socket is closed correctly afterwards.
-(defmethod socket-close ((usocket usocket))
- "Close socket."
- (when (wait-list usocket)
- (remove-waiter (wait-list usocket) usocket))
- (rt::socket-shutdown usocket)
- (rt::c-fclose usocket))
-
-(defmethod socket-close ((usocket stream-usocket))
- "Close socket."
- (when (wait-list usocket)
- (remove-waiter (wait-list usocket) usocket))
- (close (socket-stream usocket)))
-
-;; (defmethod socket-close :after ((socket datagram-usocket))
-;; (setf (%open-p socket) nil))
-
-(defmethod socket-shutdown ((usocket stream-usocket) direction)
- (declare (ignore usocket direction))
- ;; sure would be nice if there was some documentation for mocl...
- (unimplemented "shutdown" 'socket-shutdown))
-
-;; (defmethod socket-send ((usocket datagram-usocket) buffer size &key host port)
-;; (let ((s (socket usocket))
-;; (host (if host (host-to-hbo host)))
-;; (real-buffer (if (zerop offset)
-;; buffer
-;; (subseq buffer offset (+ offset size)))))
-;; (multiple-value-bind (result errno)
-;; (ext:inet-socket-send-to s real-buffer size
-;; :remote-host host :remote-port port)
-;; (or result
-;; (mocl-map-socket-error errno :socket usocket)))))
-
-;; (defmethod socket-receive ((socket datagram-usocket) buffer length &key)
-;; (declare (values (simple-array (unsigned-byte 8) (*)) ; buffer
-;; (integer 0) ; size
-;; (unsigned-byte 32) ; host
-;; (unsigned-byte 16))) ; port
-;; (let ((s (socket socket)))
-;; (let ((real-buffer (or buffer
-;; (make-array length :element-type '(unsigned-byte 8))))
-;; (real-length (or length
-;; (length buffer))))
-;; (multiple-value-bind (result errno remote-host remote-port)
-;; (ext:inet-socket-receive-from s real-buffer real-length)
-;; (if result
-;; (values real-buffer result remote-host remote-port)
-;; (mocl-map-socket-error errno :socket socket))))))
-
-;; (defmethod get-local-name ((usocket usocket))
-;; (multiple-value-bind (address port)
-;; (with-mapped-conditions (usocket)
-;; (ext:get-socket-host-and-port (socket usocket)))
-;; (values (hbo-to-vector-quad address) port)))
-
-;; (defmethod get-peer-name ((usocket stream-usocket))
-;; (multiple-value-bind (address port)
-;; (with-mapped-conditions (usocket)
-;; (ext:get-peer-host-and-port (socket usocket)))
-;; (values (hbo-to-vector-quad address) port)))
-
-;; (defmethod get-local-address ((usocket usocket))
-;; (nth-value 0 (get-local-name usocket)))
-
-;; (defmethod get-peer-address ((usocket stream-usocket))
-;; (nth-value 0 (get-peer-name usocket)))
-
-;; (defmethod get-local-port ((usocket usocket))
-;; (nth-value 1 (get-local-name usocket)))
-
-;; (defmethod get-peer-port ((usocket stream-usocket))
-;; (nth-value 1 (get-peer-name usocket)))
-
-
-;; (defun get-host-by-address (address)
-;; (multiple-value-bind (host errno)
-;; (ext:lookup-host-entry (host-byte-order address))
-;; (cond (host
-;; (ext:host-entry-name host))
-;; (t
-;; (let ((condition (cdr (assoc errno +unix-ns-error-map+))))
-;; (cond (condition
-;; (error condition :host-or-ip address))
-;; (t
-;; (error 'ns-unknown-error :host-or-ip address
-;; :real-error errno))))))))
-
-(defun get-hosts-by-name (name)
- (rt::lookup-host name))
-
-;; (defun get-host-name ()
-;; (unix:unix-gethostname))
-
-
-;;
-;;
-;; WAIT-LIST part
-;;
-
-
-(defun %add-waiter (wl waiter)
- (declare (ignore wl waiter)))
-
-(defun %remove-waiter (wl waiter)
- (declare (ignore wl waiter)))
-
-(defun %setup-wait-list (wl)
- (declare (ignore wl)))
-
-(defun wait-for-input-internal (wait-list &key timeout)
- (unimplemented 'wait-for-input-internal 'mocl))
(DIR) diff --git a/3rdparties/software/usocket-0.7.1/backend/openmcl.lisp b/3rdparties/software/usocket-0.7.1/backend/openmcl.lisp
@@ -1,270 +0,0 @@
-;;;; See LICENSE for licensing information.
-
-(in-package :usocket)
-
-(defun get-host-name ()
- (ccl::%stack-block ((resultbuf 256))
- (when (zerop (#_gethostname resultbuf 256))
- (ccl::%get-cstring resultbuf))))
-
-(defparameter +openmcl-error-map+
- '((:address-in-use . address-in-use-error)
- (:connection-aborted . connection-aborted-error)
- (:no-buffer-space . no-buffers-error)
- (:connection-timed-out . timeout-error)
- (:connection-refused . connection-refused-error)
- (:host-unreachable . host-unreachable-error)
- (:host-down . host-down-error)
- (:network-down . network-down-error)
- (:address-not-available . address-not-available-error)
- (:network-reset . network-reset-error)
- (:connection-reset . connection-reset-error)
- (:shutdown . shutdown-error)
- (:access-denied . operation-not-permitted-error)))
-
-(defparameter +openmcl-nameserver-error-map+
- '((:no-recovery . ns-no-recovery-error)
- (:try-again . ns-try-again-condition)
- (:host-not-found . ns-host-not-found-error)))
-
-;; we need something which the openmcl implementors 'forgot' to do:
-;; wait for more than one socket-or-fd
-
-(defun input-available-p (sockets &optional ticks-to-wait)
- (ccl::rletZ ((tv :timeval))
- (ccl::ticks-to-timeval ticks-to-wait tv)
- ;;### The trickery below can be moved to the wait-list now...
- (ccl::%stack-block ((infds ccl::*fd-set-size*))
- (ccl::fd-zero infds)
- (let ((max-fd -1))
- (dolist (sock sockets)
- (let ((fd (openmcl-socket:socket-os-fd (socket sock))))
- (when fd ;; may be NIL if closed
- (setf max-fd (max max-fd fd))
- (ccl::fd-set fd infds))))
- (let ((res (#_select (1+ max-fd)
- infds (ccl::%null-ptr) (ccl::%null-ptr)
- (if ticks-to-wait tv (ccl::%null-ptr)))))
- (when (> res 0)
- (dolist (sock sockets)
- (let ((fd (openmcl-socket:socket-os-fd (socket sock))))
- (when (and fd (ccl::fd-is-set fd infds))
- (setf (state sock) :READ)))))
- sockets)))))
-
-(defun raise-error-from-id (condition-id socket real-condition)
- (let ((usock-err (cdr (assoc condition-id +openmcl-error-map+))))
- (if usock-err
- (error usock-err :socket socket)
- (error 'unknown-error :socket socket :real-error real-condition))))
-
-(defun handle-condition (condition &optional socket)
- (typecase condition
- (openmcl-socket:socket-error
- (raise-error-from-id (openmcl-socket:socket-error-identifier condition)
- socket condition))
- (ccl:input-timeout
- (error 'timeout-error :socket socket))
- (ccl:communication-deadline-expired
- (error 'deadline-timeout-error :socket socket))
- (ccl::socket-creation-error #| ugh! |#
- (let* ((condition-id (ccl::socket-creation-error-identifier condition))
- (nameserver-error (cdr (assoc condition-id
- +openmcl-nameserver-error-map+))))
- (if nameserver-error
- (if (typep nameserver-error 'serious-condition)
- (error nameserver-error :host-or-ip nil)
- (signal nameserver-error :host-or-ip nil))
- (raise-error-from-id condition-id socket condition))))))
-
-(defun to-format (element-type protocol)
- (cond ((null element-type)
- (ecase protocol ; default value of different protocol
- (:stream :text)
- (:datagram :binary)))
- ((subtypep element-type 'character)
- :text)
- (t :binary)))
-
-#-ipv6
-(defun socket-connect (host port &key (protocol :stream) element-type
- timeout deadline nodelay
- local-host local-port)
- (when (eq nodelay :if-supported)
- (setf nodelay t))
- (with-mapped-conditions ()
- (ecase protocol
- (:stream
- (let ((mcl-sock
- (openmcl-socket:make-socket :remote-host (host-to-hostname host)
- :remote-port port
- :local-host local-host
- :local-port local-port
- :format (to-format element-type protocol)
- :external-format ccl:*default-external-format*
- :deadline deadline
- :nodelay nodelay
- :connect-timeout timeout)))
- (make-stream-socket :stream mcl-sock :socket mcl-sock)))
- (:datagram
- (let* ((mcl-sock
- (openmcl-socket:make-socket :address-family :internet
- :type :datagram
- :local-host local-host
- :local-port local-port
- :input-timeout timeout
- :format (to-format element-type protocol)
- :external-format ccl:*default-external-format*))
- (usocket (make-datagram-socket mcl-sock)))
- (when (and host port)
- (ccl::inet-connect (ccl::socket-device mcl-sock)
- (ccl::host-as-inet-host host)
- (ccl::port-as-inet-port port "udp")))
- (setf (connected-p usocket) t)
- usocket)))))
-
-#-ipv6
-(defun socket-listen (host port
- &key reuseaddress
- (reuse-address nil reuse-address-supplied-p)
- (backlog 5)
- (element-type 'character))
- (let* ((reuseaddress (if reuse-address-supplied-p reuse-address reuseaddress))
- (real-host (host-to-hostname host))
- (sock (with-mapped-conditions ()
- (apply #'openmcl-socket:make-socket
- (append (list :connect :passive
- :reuse-address reuseaddress
- :local-port port
- :backlog backlog
- :format (to-format element-type :stream))
- (unless (eq host *wildcard-host*)
- (list :local-host real-host)))))))
- (make-stream-server-socket sock :element-type element-type)))
-
-(defmethod socket-accept ((usocket stream-server-usocket) &key element-type)
- (declare (ignore element-type)) ;; openmcl streams are bi/multivalent
- (let ((sock (with-mapped-conditions (usocket)
- (openmcl-socket:accept-connection (socket usocket)))))
- (make-stream-socket :socket sock :stream sock)))
-
-;; One close method is sufficient because sockets
-;; and their associated objects are represented
-;; by the same object.
-(defmethod socket-close ((usocket usocket))
- (when (wait-list usocket)
- (remove-waiter (wait-list usocket) usocket))
- (with-mapped-conditions (usocket)
- (close (socket usocket))))
-
-(defmethod socket-shutdown ((usocket usocket) direction)
- (with-mapped-conditions (usocket)
- (openmcl-socket:shutdown (socket usocket) :direction direction)))
-
-#-ipv6
-(defmethod socket-send ((usocket datagram-usocket) buffer size &key host port (offset 0))
- (with-mapped-conditions (usocket)
- (if (and host port)
- (openmcl-socket:send-to (socket usocket) buffer size
- :remote-host (host-to-hbo host)
- :remote-port port
- :offset offset)
- ;; Clozure CL's socket function SEND-TO doesn't support operations on connected UDP sockets,
- ;; so we have to define our own.
- (let* ((socket (socket usocket))
- (fd (ccl::socket-device socket)))
- (multiple-value-setq (buffer offset)
- (ccl::verify-socket-buffer buffer offset size))
- (ccl::%stack-block ((bufptr size))
- (ccl::%copy-ivector-to-ptr buffer offset bufptr 0 size)
- (ccl::socket-call socket "send"
- (ccl::with-eagain fd :output
- (ccl::ignoring-eintr
- (ccl::check-socket-error (#_send fd bufptr size 0))))))))))
-
-(defmethod socket-receive ((usocket datagram-usocket) buffer length &key)
- (with-mapped-conditions (usocket)
- (openmcl-socket:receive-from (socket usocket) length :buffer buffer)))
-
-(defun usocket-host-address (address)
- (cond
- ((integerp address)
- (hbo-to-vector-quad address))
- ((and (arrayp address)
- (= (length address) 16)
- (every #'= address #(0 0 0 0 0 0 0 0 0 0 #xff #xff)))
- (make-array 4 :displaced-to address :displaced-index-offset 12))
- (t
- address)))
-
-(defmethod get-local-address ((usocket usocket))
- (usocket-host-address (openmcl-socket:local-host (socket usocket))))
-
-(defmethod get-peer-address ((usocket stream-usocket))
- (usocket-host-address (openmcl-socket:remote-host (socket usocket))))
-
-(defmethod get-local-port ((usocket usocket))
- (openmcl-socket:local-port (socket usocket)))
-
-(defmethod get-peer-port ((usocket stream-usocket))
- (openmcl-socket:remote-port (socket usocket)))
-
-(defmethod get-local-name ((usocket usocket))
- (values (get-local-address usocket)
- (get-local-port usocket)))
-
-(defmethod get-peer-name ((usocket stream-usocket))
- (values (get-peer-address usocket)
- (get-peer-port usocket)))
-
-(defun get-host-by-address (address)
- (with-mapped-conditions ()
- (openmcl-socket:ipaddr-to-hostname (host-to-hbo address))))
-
-(defun get-hosts-by-name (name)
- (with-mapped-conditions ()
- (list (hbo-to-vector-quad (openmcl-socket:lookup-hostname
- (host-to-hostname name))))))
-
-(defun %setup-wait-list (wait-list)
- (declare (ignore wait-list)))
-
-(defun %add-waiter (wait-list waiter)
- (declare (ignore wait-list waiter)))
-
-(defun %remove-waiter (wait-list waiter)
- (declare (ignore wait-list waiter)))
-
-(defun wait-for-input-internal (wait-list &key timeout)
- (with-mapped-conditions ()
- (let* ((ticks-timeout (truncate (* (or timeout 1)
- ccl::*ticks-per-second*))))
- (input-available-p (wait-list-waiters wait-list)
- (when timeout ticks-timeout))
- wait-list)))
-
-;;; Helper functions for option.lisp
-
-(defun get-socket-option-reuseaddr (socket)
- (ccl::int-getsockopt (ccl::socket-device socket)
- #$SOL_SOCKET #$SO_REUSEADDR))
-
-(defun set-socket-option-reuseaddr (socket value)
- (ccl::int-setsockopt (ccl::socket-device socket)
- #$SOL_SOCKET #$SO_REUSEADDR value))
-
-(defun get-socket-option-broadcast (socket)
- (ccl::int-getsockopt (ccl::socket-device socket)
- #$SOL_SOCKET #$SO_BROADCAST))
-
-(defun set-socket-option-broadcast (socket value)
- (ccl::int-setsockopt (ccl::socket-device socket)
- #$SOL_SOCKET #$SO_BROADCAST value))
-
-(defun get-socket-option-tcp-nodelay (socket)
- (ccl::int-getsockopt (ccl::socket-device socket)
- #$IPPROTO_TCP #$TCP_NODELAY))
-
-(defun set-socket-option-tcp-nodelay (socket value)
- (ccl::int-setsockopt (ccl::socket-device socket)
- #$IPPROTO_TCP #$TCP_NODELAY value))
(DIR) diff --git a/3rdparties/software/usocket-0.7.1/backend/sbcl.lisp b/3rdparties/software/usocket-0.7.1/backend/sbcl.lisp
@@ -1,876 +0,0 @@
-;;;; -*- Mode: Common-Lisp -*-
-
-;;;; See LICENSE for licensing information.
-
-(in-package :usocket)
-
-#+sbcl
-(progn
- #-win32
- (defun get-host-name ()
- (sb-unix:unix-gethostname))
-
- ;; we assume winsock has already been loaded, after all,
- ;; we already loaded sb-bsd-sockets and sb-alien
- #+win32
- (defun get-host-name ()
- (sb-alien:with-alien ((buf (sb-alien:array sb-alien:char 256)))
- (let ((result (sb-alien:alien-funcall
- (sb-alien:extern-alien "gethostname"
- (sb-alien:function sb-alien:int
- (* sb-alien:char)
- sb-alien:int))
- (sb-alien:cast buf (* sb-alien:char))
- 256)))
- (when (= result 0)
- (sb-alien:cast buf sb-alien:c-string))))))
-
-#+(and ecl (not ecl-bytecmp))
-(progn
- #-:wsock
- (ffi:clines
- "#include <errno.h>"
- "#include <sys/socket.h>"
- "#include <unistd.h>")
- #+:wsock
- (ffi:clines
- "#ifndef FD_SETSIZE"
- "#define FD_SETSIZE 1024"
- "#endif"
- "#include <winsock2.h>")
-
- (ffi:clines
- #+:msvc "#include <time.h>"
- #-:msvc "#include <sys/time.h>"
- "#include <ecl/ecl-inl.h>")
-#|
- #+:prefixed-api
- (ffi:clines
- "#define CONS(x, y) ecl_cons((x), (y))"
- "#define MAKE_INTEGER(x) ecl_make_integer((x))")
- #-:prefixed-api
- (ffi:clines
- "#define CONS(x, y) make_cons((x), (y))"
- "#define MAKE_INTEGER(x) make_integer((x))")
-|#
-
- (defun cerrno ()
- (ffi:c-inline () () :int
- "errno" :one-liner t))
-
- (defun fd-setsize ()
- (ffi:c-inline () () :fixnum
- "FD_SETSIZE" :one-liner t))
-
- (defun fdset-alloc ()
- (ffi:c-inline () () :pointer-void
- "ecl_alloc_atomic(sizeof(fd_set))" :one-liner t))
-
- (defun fdset-zero (fdset)
- (ffi:c-inline (fdset) (:pointer-void) :void
- "FD_ZERO((fd_set*)#0)" :one-liner t))
-
- (defun fdset-set (fdset fd)
- (ffi:c-inline (fdset fd) (:pointer-void :fixnum) :void
- "FD_SET(#1,(fd_set*)#0)" :one-liner t))
-
- (defun fdset-clr (fdset fd)
- (ffi:c-inline (fdset fd) (:pointer-void :fixnum) :void
- "FD_CLR(#1,(fd_set*)#0)" :one-liner t))
-
- (defun fdset-fd-isset (fdset fd)
- (ffi:c-inline (fdset fd) (:pointer-void :fixnum) :bool
- "FD_ISSET(#1,(fd_set*)#0)" :one-liner t))
-
- (declaim (inline cerrno
- fd-setsize
- fdset-alloc
- fdset-zero
- fdset-set
- fdset-clr
- fdset-fd-isset))
-
- (defun get-host-name ()
- (ffi:c-inline
- () () :object
- "{ char *buf = (char *) ecl_alloc_atomic(257);
-
- if (gethostname(buf,256) == 0)
- @(return) = make_simple_base_string(buf);
- else
- @(return) = Cnil;
- }" :one-liner nil :side-effects nil))
-
- (defun read-select (wl to-secs &optional (to-musecs 0))
- (let* ((sockets (wait-list-waiters wl))
- (rfds (wait-list-%wait wl))
- (max-fd (reduce #'(lambda (x y)
- (let ((sy (sb-bsd-sockets:socket-file-descriptor
- (socket y))))
- (if (< x sy) sy x)))
- (cdr sockets)
- :initial-value (sb-bsd-sockets:socket-file-descriptor
- (socket (car sockets))))))
- (fdset-zero rfds)
- (dolist (sock sockets)
- (fdset-set rfds (sb-bsd-sockets:socket-file-descriptor
- (socket sock))))
- (let ((count
- (ffi:c-inline (to-secs to-musecs rfds max-fd)
- (t :unsigned-int :pointer-void :int)
- :int
- "
- int count;
- struct timeval tv;
-
- if (#0 != Cnil) {
- tv.tv_sec = fixnnint(#0);
- tv.tv_usec = #1;
- }
- @(return) = select(#3 + 1, (fd_set*)#2, NULL, NULL,
- (#0 != Cnil) ? &tv : NULL);
-" :one-liner nil)))
- (cond
- ((= 0 count)
- (values nil nil))
- ((< count 0)
- ;; check for EINTR and EAGAIN; these should not err
- (values nil (cerrno)))
- (t
- (dolist (sock sockets)
- (when (fdset-fd-isset rfds (sb-bsd-sockets:socket-file-descriptor
- (socket sock)))
- (setf (state sock) :READ))))))))
-) ; progn
-
-(defun map-socket-error (sock-err)
- (map-errno-error (sb-bsd-sockets::socket-error-errno sock-err)))
-
-(defparameter +sbcl-condition-map+
- '((interrupted-error . interrupted-condition)))
-
-(defparameter +sbcl-error-map+
- `((sb-bsd-sockets:address-in-use-error . address-in-use-error)
- (sb-bsd-sockets::no-address-error . address-not-available-error)
- (sb-bsd-sockets:bad-file-descriptor-error . bad-file-descriptor-error)
- (sb-bsd-sockets:connection-refused-error . connection-refused-error)
- (sb-bsd-sockets:invalid-argument-error . invalid-argument-error)
- (sb-bsd-sockets:no-buffers-error . no-buffers-error)
- (sb-bsd-sockets:operation-not-supported-error
- . operation-not-supported-error)
- (sb-bsd-sockets:operation-not-permitted-error
- . operation-not-permitted-error)
- (sb-bsd-sockets:protocol-not-supported-error
- . protocol-not-supported-error)
- #-ecl
- (sb-bsd-sockets:unknown-protocol
- . protocol-not-supported-error)
- (sb-bsd-sockets:socket-type-not-supported-error
- . socket-type-not-supported-error)
- (sb-bsd-sockets:network-unreachable-error . network-unreachable-error)
- (sb-bsd-sockets:operation-timeout-error . timeout-error)
- #-ecl
- (sb-sys:io-timeout . timeout-error)
- #+sbcl
- (sb-ext:timeout . timeout-error)
- (sb-bsd-sockets:socket-error . ,#'map-socket-error)
-
- ;; Nameservice errors: mapped to unknown-error
- #-ecl
- (sb-bsd-sockets:no-recovery-error . ns-no-recovery-error)
- #-ecl
- (sb-bsd-sockets:try-again-error . ns-try-again-condition)
- #-ecl
- (sb-bsd-sockets:host-not-found-error . ns-host-not-found-error)))
-
-(defun handle-condition (condition &optional (socket nil))
- "Dispatch correct usocket condition."
- (typecase condition
- (serious-condition
- (let* ((usock-error (cdr (assoc (type-of condition) +sbcl-error-map+)))
- (usock-error (if (functionp usock-error)
- (funcall usock-error condition)
- usock-error)))
- (when usock-error
- (error usock-error :socket socket))))
- (condition (let* ((usock-cond (cdr (assoc (type-of condition)
- +sbcl-condition-map+)))
- (usock-cond (if (functionp usock-cond)
- (funcall usock-cond condition)
- usock-cond)))
- (if usock-cond
- (signal usock-cond :socket socket))))))
-
-;;; "The socket stream ends up with a bogus name as it is created before
-;;; the socket is connected, making things harder to debug than they need
-;;; to be." -- Nikodemus Siivola <nikodemus@random-state.net>
-
-(defvar *dummy-stream*
- (let ((stream (make-broadcast-stream)))
- (close stream)
- stream))
-
-;;; Amusingly, neither SBCL's own, nor GBBopen's WITH-TIMEOUT is asynch
-;;; unwind safe. The one I posted is -- that's what the WITHOUT-INTERRUPTS
-;;; and WITH-LOCAL-INTERRUPTS were for. :) But yeah, it's miles saner than
-;;; the SB-EXT:WITH-TIMEOUT. -- Nikodemus Siivola <nikodemus@random-state.net>
-
-#+(and sbcl (not win32))
-(defmacro %with-timeout ((seconds timeout-form) &body body)
- "Runs BODY as an implicit PROGN with timeout of SECONDS. If
-timeout occurs before BODY has finished, BODY is unwound and
-TIMEOUT-FORM is executed with its values returned instead.
-
-Note that BODY is unwound asynchronously when a timeout occurs,
-so unless all code executed during it -- including anything
-down the call chain -- is asynch unwind safe, bad things will
-happen. Use with care."
- (let ((exec (gensym)) (unwind (gensym)) (timer (gensym))
- (timeout (gensym)) (block (gensym)))
- `(block ,block
- (tagbody
- (flet ((,unwind ()
- (go ,timeout))
- (,exec ()
- ,@body))
- (declare (dynamic-extent #',exec #',unwind))
- (let ((,timer (sb-ext:make-timer #',unwind)))
- (declare (dynamic-extent ,timer))
- (sb-sys:without-interrupts
- (unwind-protect
- (progn
- (sb-ext:schedule-timer ,timer ,seconds)
- (return-from ,block
- (sb-sys:with-local-interrupts
- (,exec))))
- (sb-ext:unschedule-timer ,timer)))))
- ,timeout
- (return-from ,block ,timeout-form)))))
-
-(defun get-hosts-by-name (name)
- (with-mapped-conditions ()
- (multiple-value-bind (host4 host6)
- (sb-bsd-sockets:get-host-by-name name)
- (let ((addr4 (when host4
- (sb-bsd-sockets::host-ent-addresses host4)))
- (addr6 (when host6
- (sb-bsd-sockets::host-ent-addresses host6))))
- (append addr4 addr6)))))
-
-(defun socket-connect (host port &key (protocol :stream) (element-type 'character)
- timeout deadline (nodelay t nodelay-specified)
- local-host local-port
- &aux
- (sockopt-tcp-nodelay-p
- (fboundp 'sb-bsd-sockets::sockopt-tcp-nodelay)))
- (when deadline (unsupported 'deadline 'socket-connect))
- #+ecl
- (when timeout (unsupported 'timeout 'socket-connect))
- (when (and nodelay-specified
- ;; 20080802: ECL added this function to its sockets
- ;; package today. There's no guarantee the functions
- ;; we need are available, but we can make sure not to
- ;; call them if they aren't
- (not (eq nodelay :if-supported))
- (not sockopt-tcp-nodelay-p))
- (unsupported 'nodelay 'socket-connect))
- (when (eq nodelay :if-supported)
- (setf nodelay t))
-
- (let* ((remote (when host
- (car (get-hosts-by-name (host-to-hostname host)))))
- (local (when local-host
- (car (get-hosts-by-name (host-to-hostname local-host)))))
- (ipv6 (or (and remote (= 16 (length remote)))
- (and local (= 16 (length local)))))
- (socket (make-instance #+sbcl (if ipv6
- 'sb-bsd-sockets::inet6-socket
- 'sb-bsd-sockets:inet-socket)
- #+ecl 'sb-bsd-sockets:inet-socket
- :type protocol
- :protocol (case protocol
- (:stream :tcp)
- (:datagram :udp))))
- usocket
- ok)
-
- (unwind-protect
- (progn
- (ecase protocol
- (:stream
- ;; If make a real socket stream before the socket is
- ;; connected, it gets a misleading name so supply a
- ;; dummy value to start with.
- (setf usocket (make-stream-socket :socket socket :stream *dummy-stream*))
- ;; binghe: use SOCKOPT-TCP-NODELAY as internal symbol
- ;; to pass compilation on ECL without it.
- (when (and nodelay-specified sockopt-tcp-nodelay-p)
- (setf (sb-bsd-sockets::sockopt-tcp-nodelay socket) nodelay))
- (when (or local-host local-port)
- (sb-bsd-sockets:socket-bind socket
- (if ipv6
- (or local (ipv6-host-to-vector "::0"))
- (or local (host-to-vector-quad *wildcard-host*)))
- (or local-port *auto-port*)))
-
- (with-mapped-conditions (usocket)
- #+(and sbcl (not win32))
- (labels ((connect ()
- (sb-bsd-sockets:socket-connect socket remote port)))
- (if timeout
- (%with-timeout (timeout (error 'sb-ext:timeout)) (connect))
- (connect)))
- #+(or ecl (and sbcl win32))
- (sb-bsd-sockets:socket-connect socket remote port)
- ;; Now that we're connected make the stream.
- (setf (socket-stream usocket)
- (sb-bsd-sockets:socket-make-stream socket
- :input t :output t :buffering :full
- :element-type element-type
- ;; Robert Brown <robert.brown@gmail.com> said on Aug 4, 2011:
- ;; ... This means that SBCL streams created by usocket have a true
- ;; serve-events property. When writing large amounts of data to several
- ;; streams, the kernel will eventually stop accepting data from SBCL.
- ;; When this happens, SBCL either waits for I/O to be possible on
- ;; the file descriptor it's writing to or queues the data to be flushed later.
- ;; Because usocket streams specify serve-events as true, SBCL
- ;; always queues. Instead, it should wait for I/O to be available and
- ;; write the remaining data to the socket. That's what serve-events
- ;; equal to NIL gets you.
- ;;
- ;; Nikodemus Siivola <nikodemus@random-state.net> said on Aug 8, 2011:
- ;; It's set to T for purely historical reasons, and will soon change to
- ;; NIL in SBCL. (The docstring has warned of T being a temporary default
- ;; for as long as the :SERVE-EVENTS keyword argument has existed.)
- :serve-events nil))))
- (:datagram
- (when (or local-host local-port)
- (sb-bsd-sockets:socket-bind socket
- (if ipv6
- (or local (ipv6-host-to-vector "::0"))
- (or local (host-to-vector-quad *wildcard-host*)))
- (or local-port *auto-port*)))
- (setf usocket (make-datagram-socket socket))
- (when (and host port)
- (with-mapped-conditions (usocket)
- (sb-bsd-sockets:socket-connect socket remote port)
- (setf (connected-p usocket) t)))))
- (setf ok t))
- ;; Clean up in case of an error.
- (unless ok
- (sb-bsd-sockets:socket-close socket :abort t)))
- usocket))
-
-(defun socket-listen (host port
- &key reuseaddress
- (reuse-address nil reuse-address-supplied-p)
- (backlog 5)
- (element-type 'character))
- (let* (#+sbcl
- (local (when host
- (car (get-hosts-by-name (host-to-hostname host)))))
- #+sbcl
- (ipv6 (and local (= 16 (length local))))
- (reuseaddress (if reuse-address-supplied-p reuse-address reuseaddress))
- (ip #+sbcl (if (and local (not (eq host *wildcard-host*)))
- local
- (hbo-to-vector-quad sb-bsd-sockets-internal::inaddr-any))
- #+ecl (host-to-vector-quad host))
- (sock (make-instance #+sbcl (if ipv6
- 'sb-bsd-sockets::inet6-socket
- 'sb-bsd-sockets:inet-socket)
- #+ecl 'sb-bsd-sockets:inet-socket
- :type :stream
- :protocol :tcp)))
- (handler-case
- (with-mapped-conditions ()
- (setf (sb-bsd-sockets:sockopt-reuse-address sock) reuseaddress)
- (sb-bsd-sockets:socket-bind sock ip port)
- (sb-bsd-sockets:socket-listen sock backlog)
- (make-stream-server-socket sock :element-type element-type))
- (t (c)
- ;; Make sure we don't leak filedescriptors
- (sb-bsd-sockets:socket-close sock)
- (error c)))))
-
-;;; "2. SB-BSD-SOCKETS:SOCKET-ACCEPT method returns NIL for EAGAIN/EINTR,
-;;; instead of raising a condition. It's always possible for
-;;; SOCKET-ACCEPT on non-blocking socket to fail, even after the socket
-;;; was detected to be ready: connection might be reset, for example.
-;;;
-;;; "I had to redefine SOCKET-ACCEPT method of STREAM-SERVER-USOCKET to
-;;; handle this situation. Here is the redefinition:" -- Anton Kovalenko <anton@sw4me.com>
-
-(defmethod socket-accept ((usocket stream-server-usocket) &key element-type)
- (with-mapped-conditions (usocket)
- (let ((socket (sb-bsd-sockets:socket-accept (socket usocket))))
- (when socket
- (prog1
- (make-stream-socket
- :socket socket
- :stream (sb-bsd-sockets:socket-make-stream
- socket
- :input t :output t :buffering :full
- :element-type (or element-type
- (element-type usocket))))
-
- ;; next time wait for event again if we had EAGAIN/EINTR
- ;; or else we'd enter a tight loop of failed accepts
- #+win32
- (setf (%ready-p usocket) nil))))))
-
-;; Sockets and their associated streams are modelled as
-;; different objects. Be sure to close the stream (which
-;; closes the socket too) when closing a stream-socket.
-(defmethod socket-close ((usocket usocket))
- (when (wait-list usocket)
- (remove-waiter (wait-list usocket) usocket))
- (with-mapped-conditions (usocket)
- (sb-bsd-sockets:socket-close (socket usocket))))
-
-(defmethod socket-close ((usocket stream-usocket))
- (when (wait-list usocket)
- (remove-waiter (wait-list usocket) usocket))
- (with-mapped-conditions (usocket)
- (close (socket-stream usocket))))
-
-#+sbcl
-(defmethod socket-shutdown ((usocket stream-usocket) direction)
- (with-mapped-conditions (usocket)
- (sb-bsd-sockets::socket-shutdown (socket usocket) :direction direction)))
-
-#+ecl
-(defmethod socket-shutdown ((usocket stream-usocket) direction)
- (let ((sock-fd (sb-bsd-sockets:socket-file-descriptor (socket usocket)))
- (direction-flag (ecase direction
- (:input 0)
- (:output 1))))
- (unless (zerop (ffi:c-inline (sock-fd direction-flag) (:int :int) :int
- "shutdown(#0, #1)" :one-liner t))
- (error (map-errno-error (cerrno))))))
-
-(defmethod socket-send ((usocket datagram-usocket) buffer size &key host port (offset 0))
- (let ((remote (when host
- (car (get-hosts-by-name (host-to-hostname host))))))
- (with-mapped-conditions (usocket)
- (let* ((s (socket usocket))
- (dest (if (and host port) (list remote port) nil))
- (real-buffer (if (zerop offset)
- buffer
- (subseq buffer offset (+ offset size)))))
- (sb-bsd-sockets:socket-send s real-buffer size :address dest)))))
-
-(defmethod socket-receive ((socket datagram-usocket) buffer length
- &key (element-type '(unsigned-byte 8)))
- #+sbcl
- (declare (values (simple-array (unsigned-byte 8) (*)) ; buffer
- (integer 0) ; size
- (simple-array (unsigned-byte 8) (*)) ; host
- (unsigned-byte 16))) ; port
- (with-mapped-conditions (socket)
- (let ((s (socket socket)))
- (sb-bsd-sockets:socket-receive s buffer length :element-type element-type))))
-
-(defmethod get-local-name ((usocket usocket))
- (sb-bsd-sockets:socket-name (socket usocket)))
-
-(defmethod get-peer-name ((usocket stream-usocket))
- (sb-bsd-sockets:socket-peername (socket usocket)))
-
-(defmethod get-local-address ((usocket usocket))
- (nth-value 0 (get-local-name usocket)))
-
-(defmethod get-peer-address ((usocket stream-usocket))
- (nth-value 0 (get-peer-name usocket)))
-
-(defmethod get-local-port ((usocket usocket))
- (nth-value 1 (get-local-name usocket)))
-
-(defmethod get-peer-port ((usocket stream-usocket))
- (nth-value 1 (get-peer-name usocket)))
-
-(defun get-host-by-address (address)
- (with-mapped-conditions ()
- (sb-bsd-sockets::host-ent-name
- (sb-bsd-sockets:get-host-by-address address))))
-
-#+(and sbcl (not win32))
-(progn
- (defun %setup-wait-list (wait-list)
- (declare (ignore wait-list)))
-
- (defun %add-waiter (wait-list waiter)
- (push (socket waiter) (wait-list-%wait wait-list)))
-
- (defun %remove-waiter (wait-list waiter)
- (setf (wait-list-%wait wait-list)
- (remove (socket waiter) (wait-list-%wait wait-list))))
-
- (defun wait-for-input-internal (sockets &key timeout)
- (with-mapped-conditions ()
- (sb-alien:with-alien ((rfds (sb-alien:struct sb-unix:fd-set)))
- (sb-unix:fd-zero rfds)
- (dolist (socket (wait-list-%wait sockets))
- (sb-unix:fd-set
- (sb-bsd-sockets:socket-file-descriptor socket)
- rfds))
- (multiple-value-bind
- (secs musecs)
- (split-timeout (or timeout 1))
- (multiple-value-bind
- (count err)
- (sb-unix:unix-fast-select
- (1+ (reduce #'max (wait-list-%wait sockets)
- :key #'sb-bsd-sockets:socket-file-descriptor))
- (sb-alien:addr rfds) nil nil
- (when timeout secs) (when timeout musecs))
- (if (null count)
- (unless (= err sb-unix:EINTR)
- (error (map-errno-error err)))
- (when (< 0 count)
- ;; process the result...
- (dolist (x (wait-list-waiters sockets))
- (when (sb-unix:fd-isset
- (sb-bsd-sockets:socket-file-descriptor
- (socket x))
- rfds)
- (setf (state x) :READ))))))))))
-) ; progn
-
-;;; WAIT-FOR-INPUT support for SBCL on Windows platform (Chun Tian (binghe))
-;;; Based on LispWorks version written by Erik Huelsmann.
-
-#+win32 ; shared by ECL and SBCL
-(eval-when (:compile-toplevel :load-toplevel :execute)
- (defconstant +wsa-wait-failed+ #xffffffff)
- (defconstant +wsa-infinite+ #xffffffff)
- (defconstant +wsa-wait-event-0+ 0)
- (defconstant +wsa-wait-timeout+ 258))
-
-#+win32 ; shared by ECL and SBCL
-(progn
- (defconstant fd-read 1)
- (defconstant fd-read-bit 0)
- (defconstant fd-write 2)
- (defconstant fd-write-bit 1)
- (defconstant fd-oob 4)
- (defconstant fd-oob-bit 2)
- (defconstant fd-accept 8)
- (defconstant fd-accept-bit 3)
- (defconstant fd-connect 16)
- (defconstant fd-connect-bit 4)
- (defconstant fd-close 32)
- (defconstant fd-close-bit 5)
- (defconstant fd-qos 64)
- (defconstant fd-qos-bit 6)
- (defconstant fd-group-qos 128)
- (defconstant fd-group-qos-bit 7)
- (defconstant fd-routing-interface 256)
- (defconstant fd-routing-interface-bit 8)
- (defconstant fd-address-list-change 512)
- (defconstant fd-address-list-change-bit 9)
- (defconstant fd-max-events 10)
- (defconstant fionread 1074030207)
-
- ;; Note: for ECL, socket-handle will return raw Windows Handle,
- ;; while SBCL returns OSF Handle instead.
- (defun socket-handle (usocket)
- (sb-bsd-sockets:socket-file-descriptor (socket usocket)))
-
- (defun socket-ready-p (socket)
- (if (typep socket 'stream-usocket)
- (plusp (bytes-available-for-read socket))
- (%ready-p socket)))
-
- (defun waiting-required (sockets)
- (notany #'socket-ready-p sockets))
-
- (defun raise-usock-err (errno &optional socket)
- (error 'unknown-error
- :socket socket
- :real-error errno))
-
- (defun wait-for-input-internal (wait-list &key timeout)
- (when (waiting-required (wait-list-waiters wait-list))
- (let ((rv (wsa-wait-for-multiple-events 1 (wait-list-%wait wait-list)
- nil
- (if timeout
- (truncate (* 1000 timeout))
- +wsa-infinite+)
- nil)))
- (ecase rv
- ((#.+wsa-wait-event-0+)
- (update-ready-and-state-slots (wait-list-waiters wait-list)))
- ((#.+wsa-wait-timeout+)) ; do nothing here
- ((#.+wsa-wait-failed+)
- (maybe-wsa-error rv))))))
-
- (defun %add-waiter (wait-list waiter)
- (let ((events (etypecase waiter
- (stream-server-usocket (logior fd-connect fd-accept fd-close))
- (stream-usocket (logior fd-read))
- (datagram-usocket (logior fd-read)))))
- (maybe-wsa-error
- (wsa-event-select (os-socket-handle waiter) (os-wait-list-%wait wait-list) events)
- waiter)))
-
- (defun %remove-waiter (wait-list waiter)
- (maybe-wsa-error
- (wsa-event-select (os-socket-handle waiter) (os-wait-list-%wait wait-list) 0)
- waiter))
-) ; progn
-
-#+(and sbcl win32)
-(progn
- ;; "SOCKET is defined as intptr_t in Windows headers; however, WS-SOCKET
- ;; is defined as unsigned-int, i.e. 32-bit even on 64-bit platform. It
- ;; seems to be a good thing to redefine WS-SOCKET as SB-ALIEN:SIGNED,
- ;; which is always machine word-sized (exactly as intptr_t;
- ;; N.B. as of Windows/x64, long and signed-long are 32-bit, and thus not
- ;; enough -- potentially)."
- ;; -- Anton Kovalenko <anton@sw4me.com>, Mar 22, 2011
- (sb-alien:define-alien-type ws-socket sb-alien:signed)
-
- (sb-alien:define-alien-type ws-dword sb-alien:unsigned-long)
- (sb-alien:define-alien-type ws-event sb-alien::hinstance)
-
- (sb-alien:define-alien-type nil
- (sb-alien:struct wsa-network-events
- (network-events sb-alien:long)
- (error-code (array sb-alien:int 10)))) ; 10 = fd-max-events
-
- (sb-alien:define-alien-routine ("WSACreateEvent" wsa-event-create)
- ws-event) ; return type only
-
- (sb-alien:define-alien-routine ("WSACloseEvent" wsa-event-close)
- (boolean #.sb-vm::n-machine-word-bits)
- (event-object ws-event))
-
- (sb-alien:define-alien-routine ("WSAEnumNetworkEvents" wsa-enum-network-events)
- sb-alien:int
- (socket ws-socket)
- (event-object ws-event)
- (network-events (* (sb-alien:struct wsa-network-events))))
-
- (sb-alien:define-alien-routine ("WSAEventSelect" wsa-event-select)
- sb-alien:int
- (socket ws-socket)
- (event-object ws-event)
- (network-events sb-alien:long))
-
- (sb-alien:define-alien-routine ("WSAWaitForMultipleEvents" wsa-wait-for-multiple-events)
- ws-dword
- (number-of-events ws-dword)
- (events (* ws-event))
- (wait-all-p (boolean #.sb-vm::n-machine-word-bits))
- (timeout ws-dword)
- (alertable-p (boolean #.sb-vm::n-machine-word-bits)))
-
- (sb-alien:define-alien-routine ("ioctlsocket" wsa-ioctlsocket)
- sb-alien:int
- (socket ws-socket)
- (cmd sb-alien:long)
- (argp (* sb-alien:unsigned-long)))
-
- (defun maybe-wsa-error (rv &optional socket)
- (unless (zerop rv)
- (raise-usock-err (sockint::wsa-get-last-error) socket)))
-
- (defun os-socket-handle (usocket)
- (sb-bsd-sockets:socket-file-descriptor (socket usocket)))
-
- (defun bytes-available-for-read (socket)
- (sb-alien:with-alien ((int-ptr sb-alien:unsigned-long))
- (maybe-wsa-error (wsa-ioctlsocket (os-socket-handle socket) fionread (sb-alien:addr int-ptr))
- socket)
- (prog1 int-ptr
- (when (plusp int-ptr)
- (setf (state socket) :read)))))
-
- (defun map-network-events (func network-events)
- (let ((event-map (sb-alien:slot network-events 'network-events))
- (error-array (sb-alien:slot network-events 'error-code)))
- (unless (zerop event-map)
- (dotimes (i fd-max-events)
- (unless (zerop (ldb (byte 1 i) event-map)) ;;### could be faster with ash and logand?
- (funcall func (sb-alien:deref error-array i)))))))
-
- (defun update-ready-and-state-slots (sockets)
- (dolist (socket sockets)
- (if (%ready-p socket)
- (progn
- (setf (state socket) :READ))
- (sb-alien:with-alien ((network-events (sb-alien:struct wsa-network-events)))
- (let ((rv (wsa-enum-network-events (os-socket-handle socket) 0
- (sb-alien:addr network-events))))
- (if (zerop rv)
- (map-network-events
- #'(lambda (err-code)
- (if (zerop err-code)
- (progn
- (setf (state socket) :READ)
- (when (stream-server-usocket-p socket)
- (setf (%ready-p socket) t)))
- (raise-usock-err err-code socket)))
- network-events)
- (maybe-wsa-error rv socket)))))))
-
- (defun os-wait-list-%wait (wait-list)
- (sb-alien:deref (wait-list-%wait wait-list)))
-
- (defun (setf os-wait-list-%wait) (value wait-list)
- (setf (sb-alien:deref (wait-list-%wait wait-list)) value))
-
- ;; "Event handles are leaking in current SBCL backend implementation,
- ;; because of SBCL-unfriendly usage of finalizers.
- ;;
- ;; "SBCL never calls a finalizer that closes over a finalized object: a
- ;; reference from that closure prevents its collection forever. That's
- ;; the case with USOCKET in %SETUP-WAIT-LIST.
- ;;
- ;; "I use the following redefinition of %SETUP-WAIT-LIST:
- ;;
- ;; "Of course it may be rewritten with more clarity, but you can see the
- ;; core idea: I'm closing over those components of WAIT-LIST that I need
- ;; for finalization, not the wait-list itself. With the original
- ;; %SETUP-WAIT-LIST, hunchentoot stops working after ~100k accepted
- ;; connections; it doesn't happen with redefined %SETUP-WAIT-LIST."
- ;;
- ;; -- Anton Kovalenko <anton@sw4me.com>, Mar 22, 2011
-
- (defun %setup-wait-list (wait-list)
- (setf (wait-list-%wait wait-list) (sb-alien:make-alien ws-event))
- (setf (os-wait-list-%wait wait-list) (wsa-event-create))
- (sb-ext:finalize wait-list
- (let ((event-handle (os-wait-list-%wait wait-list))
- (alien (wait-list-%wait wait-list)))
- #'(lambda ()
- (wsa-event-close event-handle)
- (unless (null alien)
- (sb-alien:free-alien alien))))))
-
-) ; progn
-
-#+(and ecl (not win32))
-(progn
- (defun wait-for-input-internal (wl &key timeout)
- (with-mapped-conditions ()
- (multiple-value-bind (secs usecs)
- (split-timeout (or timeout 1))
- (multiple-value-bind (result-fds err)
- (read-select wl (when timeout secs) usecs)
- (declare (ignore result-fds))
- (unless (null err)
- (error (map-errno-error err)))))))
-
- (defun %setup-wait-list (wl)
- (setf (wait-list-%wait wl)
- (fdset-alloc)))
-
- (defun %add-waiter (wl w)
- (declare (ignore wl w)))
-
- (defun %remove-waiter (wl w)
- (declare (ignore wl w)))
-) ; progn
-
-#+(and ecl win32 (not ecl-bytecmp))
-(progn
- (defun maybe-wsa-error (rv &optional syscall)
- (unless (zerop rv)
- (sb-bsd-sockets::socket-error syscall)))
-
- (defun %setup-wait-list (wl)
- (setf (wait-list-%wait wl)
- (ffi:c-inline () () :int
- "WSAEVENT event;
- event = WSACreateEvent();
- @(return) = event;")))
-
- (defun %add-waiter (wait-list waiter)
- (let ((events (etypecase waiter
- (stream-server-usocket (logior fd-connect fd-accept fd-close))
- (stream-usocket (logior fd-read))
- (datagram-usocket (logior fd-read)))))
- (maybe-wsa-error
- (ffi:c-inline ((socket-handle waiter) (wait-list-%wait wait-list) events)
- (:fixnum :fixnum :fixnum) :fixnum
- "int result;
- result = WSAEventSelect((SOCKET)#0, (WSAEVENT)#1, (long)#2);
- @(return) = result;")
- '%add-waiter)))
-
- (defun %remove-waiter (wait-list waiter)
- (maybe-wsa-error
- (ffi:c-inline ((socket-handle waiter) (wait-list-%wait wait-list))
- (:fixnum :fixnum) :fixnum
- "int result;
- result = WSAEventSelect((SOCKET)#0, (WSAEVENT)#1, 0L);
- @(return) = result;")
- '%remove-waiter))
-
- ;; TODO: how to handle error (result) in this call?
- (declaim (inline %bytes-available-for-read))
- (defun %bytes-available-for-read (socket)
- (ffi:c-inline ((socket-handle socket)) (:fixnum) :fixnum
- "u_long nbytes;
- int result;
- nbytes = 0L;
- result = ioctlsocket((SOCKET)#0, FIONREAD, &nbytes);
- @(return) = nbytes;"))
-
- (defun bytes-available-for-read (socket)
- (let ((nbytes (%bytes-available-for-read socket)))
- (when (plusp nbytes)
- (setf (state socket) :read))
- nbytes))
-
- (defun update-ready-and-state-slots (sockets)
- (dolist (socket sockets)
- (if (%ready-p socket)
- (setf (state socket) :READ)
- (let ((events (etypecase socket
- (stream-server-usocket (logior fd-connect fd-accept fd-close))
- (stream-usocket (logior fd-read))
- (datagram-usocket (logior fd-read)))))
- ;; TODO: check the iErrorCode array
- (multiple-value-bind (valid-p ready-p)
- (ffi:c-inline ((socket-handle socket) events) (:fixnum :fixnum)
- (values :bool :bool)
- "WSANETWORKEVENTS network_events;
- int i, result;
- result = WSAEnumNetworkEvents((SOCKET)#0, 0, &network_events);
- if (!result) {
- @(return 0) = Ct;
- @(return 1) = (#1 & network_events.lNetworkEvents)? Ct : Cnil;
- } else {
- @(return 0) = Cnil;
- @(return 1) = Cnil;
- }")
- (if valid-p
- (when ready-p
- (setf (state socket) :READ)
- (when (stream-server-usocket-p socket)
- (setf (%ready-p socket) t)))
- (sb-bsd-sockets::socket-error 'update-ready-and-state-slots)))))))
-
- (defun wait-for-input-internal (wait-list &key timeout)
- (when (waiting-required (wait-list-waiters wait-list))
- (let ((rv (ffi:c-inline ((wait-list-%wait wait-list)
- (if timeout
- (truncate (* 1000 timeout))
- +wsa-infinite+))
- (:fixnum :fixnum) :fixnum
- "DWORD result;
- WSAEVENT events[1];
- events[0] = (WSAEVENT)#0;
- result = WSAWaitForMultipleEvents(1, events, NULL, #1, NULL);
- @(return) = result;")))
- (ecase rv
- ((#.+wsa-wait-event-0+)
- (update-ready-and-state-slots (wait-list-waiters wait-list)))
- ((#.+wsa-wait-timeout+)) ; do nothing here
- ((#.+wsa-wait-failed+)
- (sb-bsd-sockets::socket-error 'wait-for-input-internal))))))
-
-) ; progn
(DIR) diff --git a/3rdparties/software/usocket-0.7.1/backend/scl.lisp b/3rdparties/software/usocket-0.7.1/backend/scl.lisp
@@ -1,270 +0,0 @@
-;;;; See LICENSE for licensing information.
-
-(in-package :usocket)
-
-(defparameter +scl-error-map+
- (append +unix-errno-condition-map+
- +unix-errno-error-map+))
-
-(defun scl-map-socket-error (err &key condition socket)
- (let ((usock-err (cdr (assoc err +scl-error-map+ :test #'member))))
- (cond (usock-err
- (if (subtypep usock-err 'error)
- (error usock-err :socket socket)
- (signal usock-err :socket socket)))
- (t
- (error 'unknown-error
- :socket socket
- :real-error condition)))))
-
-(defun handle-condition (condition &optional (socket nil))
- "Dispatch correct usocket condition."
- (typecase condition
- (ext::socket-error
- (scl-map-socket-error (ext::socket-errno condition)
- :socket socket
- :condition condition))))
-
-(defun socket-connect (host port &key (protocol :stream) (element-type 'character)
- timeout deadline (nodelay t nodelay-specified)
- (local-host nil local-host-p)
- (local-port nil local-port-p)
- &aux
- (patch-udp-p (fboundp 'ext::inet-socket-send-to)))
- (when (and nodelay-specified
- (not (eq nodelay :if-supported)))
- (unsupported 'nodelay 'socket-connect))
- (when deadline (unsupported 'deadline 'socket-connect))
- (when timeout (unsupported 'timeout 'socket-connect))
- (when (and local-host-p (not patch-udp-p))
- (unsupported 'local-host 'socket-connect :minimum "1.3.9"))
- (when (and local-port-p (not patch-udp-p))
- (unsupported 'local-port 'socket-connect :minimum "1.3.9"))
-
- (let ((socket))
- (ecase protocol
- (:stream
- (setf socket (let ((args (list (host-to-hbo host) port :kind protocol)))
- (when (and patch-udp-p (or local-host-p local-port-p))
- (nconc args (list :local-host (when local-host
- (host-to-hbo local-host))
- :local-port local-port)))
- (with-mapped-conditions (socket)
- (apply #'ext:connect-to-inet-socket args))))
- (let ((stream (sys:make-fd-stream socket :input t :output t
- :element-type element-type
- :buffering :full)))
- (make-stream-socket :socket socket :stream stream)))
- (:datagram
- (when (not patch-udp-p)
- (error 'unsupported
- :feature '(protocol :datagram)
- :context 'socket-connect
- :minumum "1.3.9"))
- (setf socket
- (if (and host port)
- (let ((args (list (host-to-hbo host) port :kind protocol)))
- (when (and patch-udp-p (or local-host-p local-port-p))
- (nconc args (list :local-host (when local-host
- (host-to-hbo local-host))
- :local-port local-port)))
- (with-mapped-conditions (socket)
- (apply #'ext:connect-to-inet-socket args)))
- (if (or local-host-p local-port-p)
- (with-mapped-conditions ()
- (ext:create-inet-listener (or local-port 0)
- protocol
- :host (when local-host
- (if (ip= local-host *wildcard-host*)
- 0
- (host-to-hbo local-host)))))
- (with-mapped-conditions ()
- (ext:create-inet-socket protocol)))))
- (let ((usocket (make-datagram-socket socket :connected-p (and host port t))))
- (ext:finalize usocket #'(lambda ()
- (when (%open-p usocket)
- (ext:close-socket socket))))
- usocket)))))
-
-(defun socket-listen (host port
- &key reuseaddress
- (reuse-address nil reuse-address-supplied-p)
- (backlog 5)
- (element-type 'character))
- (let* ((reuseaddress (if reuse-address-supplied-p reuse-address reuseaddress))
- (host (if (ip= host *wildcard-host*)
- 0
- (host-to-hbo host)))
- (server-sock
- (with-mapped-conditions ()
- (ext:create-inet-listener port :stream
- :host host
- :reuse-address reuseaddress
- :backlog backlog))))
- (make-stream-server-socket server-sock :element-type element-type)))
-
-(defmethod socket-accept ((usocket stream-server-usocket) &key element-type)
- (with-mapped-conditions (usocket)
- (let* ((sock (ext:accept-tcp-connection (socket usocket)))
- (stream (sys:make-fd-stream sock :input t :output t
- :element-type (or element-type
- (element-type usocket))
- :buffering :full)))
- (make-stream-socket :socket sock :stream stream))))
-
-;; Sockets and their associated streams are modelled as
-;; different objects. Be sure to close the socket stream
-;; when closing stream-sockets; it makes sure buffers
-;; are flushed and the socket is closed correctly afterwards.
-(defmethod socket-close ((usocket usocket))
- "Close socket."
- (when (wait-list usocket)
- (remove-waiter (wait-list usocket) usocket))
- (with-mapped-conditions (usocket)
- (ext:close-socket (socket usocket))))
-
-(defmethod socket-close ((usocket stream-usocket))
- "Close socket."
- (when (wait-list usocket)
- (remove-waiter (wait-list usocket) usocket))
- (with-mapped-conditions (usocket)
- (close (socket-stream usocket))))
-
-(defmethod socket-close :after ((socket datagram-usocket))
- (setf (%open-p socket) nil))
-
-(defmethod socket-shutdown ((usocket usocket) direction)
- (declare (ignore usocket direction))
- (unsupported "shutdown" 'socket-shutdown))
-
-(defmethod socket-send ((usocket datagram-usocket) buffer size &key host port)
- (let ((s (socket usocket))
- (host (if host (host-to-hbo host)))
- (real-buffer (if (zerop offset)
- buffer
- (subseq buffer offset (+ offset size)))))
- (multiple-value-bind (result errno)
- (ext:inet-socket-send-to s real-buffer size
- :remote-host host :remote-port port)
- (or result
- (scl-map-socket-error errno :socket usocket)))))
-
-(defmethod socket-receive ((socket datagram-usocket) buffer length &key)
- (declare (values (simple-array (unsigned-byte 8) (*)) ; buffer
- (integer 0) ; size
- (unsigned-byte 32) ; host
- (unsigned-byte 16))) ; port
- (let ((s (socket socket)))
- (let ((real-buffer (or buffer
- (make-array length :element-type '(unsigned-byte 8))))
- (real-length (or length
- (length buffer))))
- (multiple-value-bind (result errno remote-host remote-port)
- (ext:inet-socket-receive-from s real-buffer real-length)
- (if result
- (values real-buffer result remote-host remote-port)
- (scl-map-socket-error errno :socket socket))))))
-
-(defmethod get-local-name ((usocket usocket))
- (multiple-value-bind (address port)
- (with-mapped-conditions (usocket)
- (ext:get-socket-host-and-port (socket usocket)))
- (values (hbo-to-vector-quad address) port)))
-
-(defmethod get-peer-name ((usocket stream-usocket))
- (multiple-value-bind (address port)
- (with-mapped-conditions (usocket)
- (ext:get-peer-host-and-port (socket usocket)))
- (values (hbo-to-vector-quad address) port)))
-
-(defmethod get-local-address ((usocket usocket))
- (nth-value 0 (get-local-name usocket)))
-
-(defmethod get-peer-address ((usocket stream-usocket))
- (nth-value 0 (get-peer-name usocket)))
-
-(defmethod get-local-port ((usocket usocket))
- (nth-value 1 (get-local-name usocket)))
-
-(defmethod get-peer-port ((usocket stream-usocket))
- (nth-value 1 (get-peer-name usocket)))
-
-
-(defun get-host-by-address (address)
- (multiple-value-bind (host errno)
- (ext:lookup-host-entry (host-byte-order address))
- (cond (host
- (ext:host-entry-name host))
- (t
- (let ((condition (cdr (assoc errno +unix-ns-error-map+))))
- (cond (condition
- (error condition :host-or-ip address))
- (t
- (error 'ns-unknown-error :host-or-ip address
- :real-error errno))))))))
-
-(defun get-hosts-by-name (name)
- (multiple-value-bind (host errno)
- (ext:lookup-host-entry name)
- (cond (host
- (mapcar #'hbo-to-vector-quad
- (ext:host-entry-addr-list host)))
- (t
- (let ((condition (cdr (assoc errno +unix-ns-error-map+))))
- (cond (condition
- (error condition :host-or-ip name))
- (t
- (error 'ns-unknown-error :host-or-ip name
- :real-error errno))))))))
-
-(defun get-host-name ()
- (unix:unix-gethostname))
-
-
-;;
-;;
-;; WAIT-LIST part
-;;
-
-
-(defun %add-waiter (wl waiter)
- (declare (ignore wl waiter)))
-
-(defun %remove-waiter (wl waiter)
- (declare (ignore wl waiter)))
-
-(defun %setup-wait-list (wl)
- (declare (ignore wl)))
-
-(defun wait-for-input-internal (wait-list &key timeout)
- (let* ((sockets (wait-list-waiters wait-list))
- (pollfd-size (alien:alien-size (alien:struct unix::pollfd) :bytes))
- (nfds (length sockets))
- (bytes (* nfds pollfd-size)))
- (alien:with-bytes (fds-sap bytes)
- (do ((sockets sockets (rest sockets))
- (base 0 (+ base 8)))
- ((endp sockets))
- (let ((fd (socket (first sockets))))
- (setf (sys:sap-ref-32 fds-sap base) fd)
- (setf (sys:sap-ref-16 fds-sap (+ base 4)) unix::pollin)))
- (multiple-value-bind (result errno)
- (let ((thread:*thread-whostate* "Poll wait")
- (timeout (if timeout
- (truncate (* timeout 1000))
- -1)))
- (declare (inline unix:unix-poll))
- (unix:unix-poll (alien:sap-alien fds-sap
- (* (alien:struct unix::pollfd)))
- nfds timeout))
- (cond ((not result)
- (error "~@<Polling error: ~A~:@>"
- (unix:get-unix-error-msg errno)))
- (t
- (do ((sockets sockets (rest sockets))
- (base 0 (+ base 8)))
- ((endp sockets))
- (let ((flags (sys:sap-ref-16 fds-sap (+ base 6))))
- (unless (zerop (logand flags unix::pollin))
- (setf (state (first sockets)) :READ))))))))))
-
(DIR) diff --git a/3rdparties/software/usocket-0.7.1/condition.lisp b/3rdparties/software/usocket-0.7.1/condition.lisp
@@ -1,234 +0,0 @@
-;;;; See LICENSE for licensing information.
-
-(in-package :usocket)
-
-;; Condition signalled by operations with unsupported arguments
-;; For trivial-sockets compatibility.
-
-(define-condition insufficient-implementation (error)
- ((feature :initarg :feature :reader feature)
- (context :initarg :context :reader context
- :documentation "String designator of the public API function which
-the feature belongs to."))
- (:documentation "The ancestor of all errors usocket may generate
-because of insufficient support from the underlying implementation
-with respect to the arguments given to `function'.
-
-One call may signal several errors, if the caller allows processing
-to continue.
-"))
-
-(define-condition unsupported (insufficient-implementation)
- ((minimum :initarg :minimum :reader minimum
- :documentation "Indicates the minimal version of the
-implementation required to support the requested feature."))
- (:report (lambda (c stream)
- (format stream "~A in ~A is unsupported."
- (feature c) (context c))
- (when (minimum c)
- (format stream " Minimum version (~A) is required."
- (minimum c)))))
- (:documentation "Signalled when the underlying implementation
-doesn't allow supporting the requested feature.
-
-When you see this error, go bug your vendor/implementation developer!"))
-
-(define-condition unimplemented (insufficient-implementation)
- ()
- (:report (lambda (c stream)
- (format stream "~A in ~A is unimplemented."
- (feature c) (context c))))
- (:documentation "Signalled if a certain feature might be implemented,
-based on the features of the underlying implementation, but hasn't
-been implemented yet."))
-
-;; Conditions raised by sockets operations
-
-(define-condition socket-condition (condition)
- ((socket :initarg :socket
- :accessor usocket-socket))
- ;;###FIXME: no slots (yet); should at least be the affected usocket...
- (:documentation "Parent condition for all socket related conditions."))
-
-(define-condition socket-error (socket-condition error)
- () ;; no slots (yet)
- (:documentation "Parent error for all socket related errors"))
-
-(define-condition ns-condition (condition)
- ((host-or-ip :initarg :host-or-ip
- :accessor host-or-ip))
- (:documentation "Parent condition for all name resolution conditions."))
-
-(define-condition ns-error (ns-condition error)
- ()
- (:documentation "Parent error for all name resolution errors."))
-
-(eval-when (:compile-toplevel :load-toplevel :execute)
- (defun define-usocket-condition-class (class &rest parents)
- `(progn
- (define-condition ,class ,parents ())
- (export ',class))))
-
-(defmacro define-usocket-condition-classes (class-list parents)
- `(progn ,@(mapcar #'(lambda (x)
- (apply #'define-usocket-condition-class
- x parents))
- class-list)))
-
-;; Mass define and export our conditions
-(define-usocket-condition-classes
- (interrupted-condition)
- (socket-condition))
-
-(define-condition unknown-condition (socket-condition)
- ((real-condition :initarg :real-condition
- :accessor usocket-real-condition))
- (:documentation "Condition raised when there's no other - more applicable -
-condition available."))
-
-
-;; Mass define and export our errors
-(define-usocket-condition-classes
- (address-in-use-error
- address-not-available-error
- bad-file-descriptor-error
- connection-refused-error
- connection-aborted-error
- connection-reset-error
- invalid-argument-error
- no-buffers-error
- operation-not-supported-error
- operation-not-permitted-error
- protocol-not-supported-error
- socket-type-not-supported-error
- network-unreachable-error
- network-down-error
- network-reset-error
- host-down-error
- host-unreachable-error
- shutdown-error
- timeout-error
- deadline-timeout-error
- invalid-socket-error
- invalid-socket-stream-error)
- (socket-error))
-
-(define-condition unknown-error (socket-error)
- ((real-error :initarg :real-error
- :accessor usocket-real-error
- :initform nil)
- (errno :initarg :errno
- :reader usocket-errno
- :initform 0))
- (:report (lambda (c stream)
- (typecase c
- (simple-condition
- (format stream
- (simple-condition-format-control (usocket-real-error c))
- (simple-condition-format-arguments (usocket-real-error c))))
- (otherwise
- (format stream "The condition ~A occurred with errno: ~D."
- (usocket-real-error c)
- (usocket-errno c))))))
- (:documentation "Error raised when there's no other - more applicable -
-error available."))
-
-(define-usocket-condition-classes
- (ns-try-again-condition)
- (ns-condition))
-
-(define-condition ns-unknown-condition (ns-condition)
- ((real-condition :initarg :real-condition
- :accessor ns-real-condition
- :initform nil))
- (:documentation "Condition raised when there's no other - more applicable -
-condition available."))
-
-(define-usocket-condition-classes
- ;; the no-data error code in the Unix 98 api
- ;; isn't really an error: there's just no data to return.
- ;; with lisp, we just return NIL (indicating no data) instead of
- ;; raising an exception...
- (ns-host-not-found-error
- ns-no-recovery-error)
- (ns-error))
-
-(define-condition ns-unknown-error (ns-error)
- ((real-error :initarg :real-error
- :accessor ns-real-error
- :initform nil))
- (:report (lambda (c stream)
- (typecase c
- (simple-condition
- (format stream
- (simple-condition-format-control (usocket-real-error c))
- (simple-condition-format-arguments (usocket-real-error c))))
- (otherwise
- (format stream "The condition ~A occurred." (usocket-real-error c))))))
- (:documentation "Error raised when there's no other - more applicable -
-error available."))
-
-(defmacro with-mapped-conditions ((&optional socket) &body body)
- `(handler-bind ((condition #'(lambda (c) (handle-condition c ,socket))))
- ,@body))
-
-(defparameter +unix-errno-condition-map+
- `(((11) . ns-try-again-condition) ;; EAGAIN
- ((35) . ns-try-again-condition) ;; EDEADLCK
- ((4) . interrupted-condition))) ;; EINTR
-
-(defparameter +unix-errno-error-map+
- ;;### the first column is for non-(linux or srv4) systems
- ;; the second for linux
- ;; the third for srv4
- ;;###FIXME: How do I determine on which Unix we're running
- ;; (at least in clisp and sbcl; I know about cmucl...)
- ;; The table below works under the assumption we'll *only* see
- ;; socket associated errors...
- `(((48 98) . address-in-use-error)
- ((49 99) . address-not-available-error)
- ((9) . bad-file-descriptor-error)
- ((61 111) . connection-refused-error)
- ((54 104) . connection-reset-error)
- ((53 103) . connection-aborted-error)
- ((22) . invalid-argument-error)
- ((55 105) . no-buffers-error)
- ((12) . out-of-memory-error)
- ((45 95) . operation-not-supported-error)
- ((1) . operation-not-permitted-error)
- ((43 92) . protocol-not-supported-error)
- ((44 93) . socket-type-not-supported-error)
- ((51 101) . network-unreachable-error)
- ((50 100) . network-down-error)
- ((52 102) . network-reset-error)
- ((58 108) . already-shutdown-error)
- ((60 110) . timeout-error)
- ((64 112) . host-down-error)
- ((65 113) . host-unreachable-error)))
-
-(defun map-errno-condition (errno)
- (cdr (assoc errno +unix-errno-error-map+ :test #'member)))
-
-(defun map-errno-error (errno)
- (cdr (assoc errno +unix-errno-error-map+ :test #'member)))
-
-(defparameter +unix-ns-error-map+
- `((1 . ns-host-not-found-error)
- (2 . ns-try-again-condition)
- (3 . ns-no-recovery-error)))
-
-(defmacro unsupported (feature context &key minimum)
- `(cerror "Ignore it and continue" 'unsupported
- :feature ,feature
- :context ,context
- :minimum ,minimum))
-
-(defmacro unimplemented (feature context)
- `(signal 'unimplemented :feature ,feature :context ,context))
-
-;;; People may want to ignore all unsupported warnings, here it is.
-(defmacro ignore-unsupported-warnings (&body body)
- `(handler-bind ((unsupported
- #'(lambda (c)
- (declare (ignore c)) (continue))))
- (progn ,@body)))
(DIR) diff --git a/3rdparties/software/usocket-0.7.1/notes/abcl-socket.txt b/3rdparties/software/usocket-0.7.1/notes/abcl-socket.txt
@@ -1,18 +0,0 @@
-
-ABCL provides a callback interface to java objects, next to these calls:
-
- - ext:make-socket
- - ext:socket-close
- - ext:make-server-socket
- - ext:socket-accept
- - ext:get-socket-stream (returning an io-stream)
-
-abcl-swank (see SLIME) shows how to call directly into java.
-
-
-See for the sockets implementation:
-
- - src/org/armedbear/lisp
- * socket.lisp
- * socket_stream.java
- * SocketStream.java
(DIR) diff --git a/3rdparties/software/usocket-0.7.1/notes/active-sockets-apis.txt b/3rdparties/software/usocket-0.7.1/notes/active-sockets-apis.txt
@@ -1,75 +0,0 @@
- -*- text -*-
-
-A document to summarizing which API's of the different implementations
-are associated with 'Step 1'.
-
-Interface to be implemented in step 1:
-
- - socket-connect
- - socket-close
- - get-host-by-address
- - get-hosts-by-name
-
-(and something to do with errors; maybe move this to step 1a?)
-
-SBCL
-====
-
- sockets:
- - socket-bind
- - make-instance 'inet-socket
- - socket-make-stream
- - socket-connect (ip vector-quad) port
- - socket-close
-
- DNS name resolution:
- - get-host-by-name
- - get-host-by-address
- - ::host-ent-addresses
- - host-ent-name
-
-
-CMUCL
-=====
-
- sockets:
- - ext:connect-to-inet-socket (ip integer) port
- - sys:make-fd-stream
- - ext:close-socket
-
- DNS name resolution:
- - ext:host-entry-name
- - ext::lookup-host-entry
- - ext:host-entry-addr-list
- - ext:lookup-host-entry
-
-
-ABCL
-====
-
- sockets
- - ext:socket-connect (hostname string) port
- - ext:get-socket-stream
- - ext:socket-close
-
-
-clisp
-=====
-
- sockets
- - socket-connect port (hostname string)
- - close (socket)
-
-
-Allegro
-=======
-
- sockets
- - make-socket
- - socket-connect
- - close
-
- DNS resolution
- - lookup-hostname
- - ipaddr-to-hostname
-
(DIR) diff --git a/3rdparties/software/usocket-0.7.1/notes/address-apis.txt b/3rdparties/software/usocket-0.7.1/notes/address-apis.txt
@@ -1,73 +0,0 @@
-
- -*- text -*-
-
-Step 2 of the master plan: Implementing (get-local-address sock) and
-(get-peer-address sock).
-
-
-Step 2 is about implementing:
-
- (get-local-address sock) -> ip
- (get-peer-address sock) -> ip
- (get-local-port sock) -> port
- (get-peer-port sock) -> port
- (get-local-name sock) -> ip, port
- (get-peer-name sock) -> ip, port
-
-
-ABCL
-====
-
- FFI / J-calls to "getLocalAddress"+"getAddress", "getLocalPort" (local)
- FFI / J-calls to "getInetAddress"+"getAddress", "getPort" (peer)
-
- (see SLIME / swank-abcl.lisp for an example on how to do that)
-
-
-Allegro
-=======
-
- (values (socket:remote-host sock)
- (socket:remote-port)) -> 32bit ip, port
-
- (values (socket:local-host sock)
- (socket:local-port sock)) -> 32bit ip, port
-
-CLISP
-=====
-
- (socket:socket-stream-local sock nil) -> address (as dotted quad), port
- (socket:socket-stream-peer sock nil) -> address (as dotted quad), port
-
-
-CMUCL
-=====
-
- (ext:get-peer-host-and-port sock-fd) -> 32-bit-addr, port (peer)
- (ext:get-socket-host-and-port sock-fd) -> 32-bit-addr, port (local)
-
-
-LispWorks
-=========
-
- (comm:socket-stream-address sock-stream) -> 32-bit-addr, port
- or: (comm:get-socket-address sock) -> 32-bit-addr, port
-
- (comm:socket-stream-peer-address sock-stream) -> 32-bit-addr, port
- or: (comm:get-socket-peer-address sock) -> 32-bit-addr, port
-
-
-OpenMCL
-=======
-
- (values (ccl:local-host sock) (ccl:local-port sock)) -> 32-bit ip, port
- (values (ccl:remote-host sock) (ccl:remote-port sock)) -> 32-bit ip, port
-
-
-SBCL
-====
-
- (sb-bsd-sockets:socket-name sock) -> vector-quad, port
- (sb-bsd-sockets:socket-peer-name sock) -> vector-quad, port
-
-
(DIR) diff --git a/3rdparties/software/usocket-0.7.1/notes/allegro-socket.txt b/3rdparties/software/usocket-0.7.1/notes/allegro-socket.txt
@@ -1,46 +0,0 @@
-
-
-(require :sock)
-
-accept-connection (sock passive-socket) &key wait Generic function.
-dotted-to-ipaddr dotted &key errorp Function.
-ipaddr-to-dotted ipaddr &key values Function.
-ipaddr-to-hostname ipaddr Function.
-lookup-hostname hostname
-lookup-port portname protocol Function.
-make-socket &key type format address-family connect &allow-other-keys Function.
-with-pending-connect &body body Macro.
-receive-from (sock datagram-socket) size &key buffer extract Generic function.
-send-to sock &key
-shutdown sock &key direction
-socket-control stream &key output-chunking output-chunking-eof input-chunking
-socket-os-fd sock Generic function.
-
-remote-host socket Generic function.
-local-host socket Generic function.
-local-port socket
-
-remote-filename socket
-local-filename socket
-remote-port socket
-socket-address-family socket
-socket-connect socket
-socket-format socket
-socket-type socket
-
-errors
-
-:address-in-use Local socket address already in use
-:address-not-available Local socket address not available
-:network-down Network is down
-:network-reset Network has been reset
-:connection-aborted Connection aborted
-:connection-reset Connection reset by peer
-:no-buffer-space No buffer space
-:shutdown Connection shut down
-:connection-timed-out Connection timed out
-:connection-refused Connection refused
-:host-down Host is down
-:host-unreachable Host is unreachable
-:unknown Unknown error
-
(DIR) diff --git a/3rdparties/software/usocket-0.7.1/notes/backends.txt b/3rdparties/software/usocket-0.7.1/notes/backends.txt
@@ -1,60 +0,0 @@
- -*- text -*-
-
-$Id$
-
-A document to describe which APIs a backend should implement.
-
-
-Each backend should implement:
-
-Functions:
-
- - handle-condition
- - socket-connect
- - socket-listen
- - get-hosts-by-name [ optional ]
- - get-host-by-address [ optional ]
-
- - wait-for-input-internal (new in 0.4.x)
-
-Methods:
-
- - socket-close
- - socket-accept
- - get-local-name
- - get-peer-name
-
- and - for ip sockets - these methods:
-
- - get-local-address
- - get-local-port
- - get-peer-address
- - get-peer-port
-
-
-An error-handling function, resolving implementation specific errors
-to this list of errors:
-
- - address-in-use-error
- - address-not-available-error
- - bad-file-descriptor-error
- - connection-refused-error
- - invalid-argument-error
- - no-buffers-error
- - operation-not-supported-error
- - operation-not-permitted-error
- - protocol-not-supported-error
- - socket-type-not-supported-error
- - network-unreachable-error
- - network-down-error
- - network-reset-error
- - host-down-error
- - host-unreachable-error
- - shutdown-error
- - timeout-error
- - unkown-error
-
-and these conditions:
-
- - interrupted-condition
- - unkown-condition
(DIR) diff --git a/3rdparties/software/usocket-0.7.1/notes/clisp-sockets.txt b/3rdparties/software/usocket-0.7.1/notes/clisp-sockets.txt
@@ -1,38 +0,0 @@
-http://clisp.cons.org/impnotes.html#socket
-
-(SOCKET:SOCKET-SERVER &OPTIONAL [port-or-socket])
-(SOCKET:SOCKET-SERVER-HOST socket-server)
-(SOCKET:SOCKET-SERVER-PORT socket-server)
-(SOCKET:SOCKET-WAIT socket-server &OPTIONAL [seconds [microseconds]])
-(SOCKET:SOCKET-ACCEPT socket-server &KEY :ELEMENT-TYPE :EXTERNAL-FORMAT :BUFFERED :TIMEOUT)
-(SOCKET:SOCKET-CONNECT port &OPTIONAL [host] &KEY :ELEMENT-TYPE :EXTERNAL-FORMAT :BUFFERED :TIMEOUT)
-(SOCKET:SOCKET-STATUS socket-stream-or-list &OPTIONAL [seconds [microseconds]])
-(SOCKET:SOCKET-STREAM-HOST socket-stream)
-(SOCKET:SOCKET-STREAM-PORT socket-stream)
-(SOCKET:SOCKET-SERVICE-PORT &OPTIONAL service-name (protocol "tcp"))
-(SOCKET:SOCKET-STREAM-PEER socket-stream [do-not-resolve-p])
-(SOCKET:SOCKET-STREAM-LOCAL socket-stream [do-not-resolve-p])
-(SOCKET:SOCKET-STREAM-SHUTDOWN socket-stream direction)
-(SOCKET:SOCKET-OPTIONS socket-server &REST {option}*)
-
-
-(posix:resolve-host-ipaddr &optional host)
-
-with the host-ent structure:
-
- name - host name
- aliases - LIST of aliases
- addr-list - LIST of IPs as dotted quads (IPv4) or coloned octets (IPv6)
- addrtype - INTEGER address type IPv4 or IPv6
-
-
-Errors are of type
-
-SYSTEM::SIMPLE-OS-ERROR
- with a 1 element (integer) SYSTEM::$FORMAT-ARGUMENTS list
-
-This integer stores the OS error reported; meaning WSA* codes on Win32
-and E* codes on *nix, only: unix.lisp in CMUCL shows
-BSD, Linux and SRV4 have different number assignments for the same
-E* constant names :-(
-
(DIR) diff --git a/3rdparties/software/usocket-0.7.1/notes/cmucl-sockets.txt b/3rdparties/software/usocket-0.7.1/notes/cmucl-sockets.txt
@@ -1,69 +0,0 @@
-http://cvs2.cons.org/ftp-area/cmucl/doc/cmu-user/internet.html
-
-$Id$
-
-extensions:lookup-host-entry host
-
-[structure]
-host-entry
-
- name aliases addr-type addr-list
-
-[Function]
-extensions:create-inet-listener port &optional kind &key :reuse-address :backlog :interface
- => socket fd
-
-[Function]
-extensions:accept-tcp-connection unconnected
- => socket fd, address
-
-[Function]
-extensions:connect-to-inet-socket host port &optional kind
- => socket fd
-
-[Function]
-extensions:close-socket socket
-
-
-
-[Private function]
-extensions::get-peer-host-and-port socket-fd
-
-[Private function]
-extentsions::get-socket-host-and-port socket-fd
-
-
-
-There's currently only 1 condition to be raised:
-
- SOCKET-ERROR (derived from SIMPLE-ERROR)
- which has a SOCKET-ERRNO slot containing the unix error number.
-
-
-
-
-[Function]
-extensions:add-oob-handler fd char handler
-
-[Function]
-extensions:remove-oob-handler fd char
-
-[Function]
-extensions:remove-all-oob-handlers fd
-
-[Function]
-extensions:send-character-out-of-band fd char
-
-[Function]
-extensions:create-inet-socket &optional type
- => socket fd
-
-[Function]
-extensions:get-socket-option socket level optname
-
-[Function]
-extensions:set-socket-option socket level optname optval
-
-[Function]
-extensions:ip-string addr
-
(DIR) diff --git a/3rdparties/software/usocket-0.7.1/notes/design.txt b/3rdparties/software/usocket-0.7.1/notes/design.txt
@@ -1,136 +0,0 @@
-
- -*- text -*-
-
-$Id$
-
-
- usocket: Universal sockets library
- ==================================
-
-Contents
-========
-
- * Motivation
- * Design goal
- * Functional requirements
- * Class structure
-
-
-
-Motivation
-==========
-
-There are 2 other portability sockets packages [that I know of]
-out there:
-
- 1) trivial-sockets
- 2) acl-compat (which is a *lot* broader, but contains sockets too)
-
-The first misses some functionality which is fundamental when
-the requirements stop being 'trivial', such as finding out the
-addresses of either side connected to the tcp/ip stream.
-
-The second, being a complete compatibility library for Allegro,
-contains much more than only sockets. Next to that, as the docs
-say, is it mainly directed at providing the functionality required
-to port portable-allegroserve - meaning it may be (very) incomplete
-on some platforms.
-
-So, that's why I decided to inherit Erik Enge's project to build
-a library with the intention to provide portability code in only
-1 area of programming, targeted at 'not so trivial' programming.
-
-Also, I need this library to extend cl-irc with full DCC functionality.
-
-
-
-Design goal
-===========
-
-To provide a portable TCP/IP socket interface for as many
-implementations as possible, while keeping the portability layer
-as thin as possible.
-
-
-
-Functional requirements
-=======================
-
-The interface provided should allow:
- - 'client'/active sockets
- - 'server'/listening sockets
- - provide the usual stream methods to operate on the connection stream
- (not necessarily the socket itself; maybe a socket slot too)
-
-For now, as long as there are no possibilities to have UDP sockets
-to write a DNS client library: (which in the end may work better,
-because in this respect all implementations are different...)
- - retrieve IP addresses/ports for both sides of the connection
-
-Several relevant support functionalities will have to be provided too:
- - long <-> quad-vector operators
- - quad-vector <-> string operators
- - hostname <-> quad-vector operators (hostname resolution)
-
-
-Minimally, I'd like to support:
- - SBCL
- - CMUCL
- - ABCL (ArmedBear)
- - clisp
- - Allegro
- - LispWorks
- - OpenMCL
-
-
-Comments on the design above
-============================
-
-I don't think it's a good idea to implement name lookup in the
-very first of steps: we'll see if this is required to get the
-package accepted; not all implementations support it.
-
-Name resolution errors ...
-Since there is no name resolution library (yet), nor standardized
-hooks into the standard C library to do it the same way on
-all platforms, name resolution errors can manifest themselves
-in a lot of different ways. How to marshall these to the
-library users?
-
-Several solutions come to mind:
-
-1) Map them to 'unknown-error
-2) Give them their own errors and map to those
- ... which implies that they are actually supported atm.
-3) ...
-
-Given that the library doesn't now, but may in the future,
-include name resolution officially, I tend to think (1) is the
-right answer: it leaves it all undecided.
-
-These errors can be raised by the nameresolution service
-(netdb.h) as values for 'int h_errno':
-
-- HOST_NOT_FOUND (1)
-- TRY_AGAIN (2) /* Server fail or non-authoritive Host not found */
-- NO_RECOVERY (3) /* Failed permanently */
-- NO_DATA (4) /* Valid address, no data for requested record */
-
-int *__h_errno_location(void) points to thread local h_errno on
-threaded glibc2 systems.
-
-
-Class structure
-===============
-
- usocket
- |
- +- datagram-usocket
- +- stream-usocket
- \- stream-server-usocket
-
-The usocket class will have methods to query local properties, such
-as:
-
- - get-local-name: to query to which interface the socket is bound
- - <other socket and protocol options such as SO_REUSEADDRESS>
(DIR) diff --git a/3rdparties/software/usocket-0.7.1/notes/errors.txt b/3rdparties/software/usocket-0.7.1/notes/errors.txt
@@ -1,20 +0,0 @@
-EADDRINUSE 48 address-in-use-error
-EADDRNOTAVAIL 49 address-not-available-error
-EAGAIN interrupted-error ;; not 1 error code: bsd == 11; non-bsd == 35
-EBADF 9 bad-file-descriptor-error
-ECONNREFUSED 61 connection-refused-error
-EINTR 4 interrupted-error
-EINVAL 22 invalid-argument-error
-ENOBUFS 55 no-buffers-error
-ENOMEM 12 out-of-memory-error
-EOPNOTSUPP 45 operation-not-supported-error
-EPERM 1 operation-not-permitted-error
-EPROTONOSUPPORT 43 protocol-not-supported-error
-ESOCKTNOSUPPORT 44 socket-type-not-supported-error
-ENETUNREACH 51 network-unreachable-error
-ENETDOWN 50 network-down-error
-ENETRESET 52 network-reset-error
-ESHUTDOWN 58 already-shutdown-error
-ETIMEDOUT 60 connection-timeout-error
-EHOSTDOWN 64 host-down-error
-EHOSTUNREACH 65 host-unreachable-error
(DIR) diff --git a/3rdparties/software/usocket-0.7.1/notes/lw-sockets.txt b/3rdparties/software/usocket-0.7.1/notes/lw-sockets.txt
@@ -1,41 +0,0 @@
-
-$Id$
-
-http://www.lispworks.com/reference/lwu41/lwref/LWRM_37.HTM
-
-Package: COMM
-
-ip-address-string
-socket-stream-address
-socket-stream-peer-address
-start-up-server
-start-up-server-and-mp
-string-ip-address
-with-noticed-socket-stream
-
-Needed components for usocket:
-
-comm::get-fd-from-socket socket-fd
- => socket-fd
-
-comm::accept-connection-to-socket socket-fd
- => socket-fd
-
-comm::close-socket
-comm::create-tcp-socket-for-service
- => socket-fd
-
-open-tcp-stream peer-host peer-port &key direction element-type
- => socket-stream
-
-get-host-entry (see http://www.lispworks.com/documentation/lw445/LWRM/html/lwref-30.htm#pgfId-897837)
-get-socket-address
-
-get-socket-peer-address
- => address, port
-
-socket-stream socket-fd
- => stream
-
-socket socket-stream (guessed from http://www.lispworks.com/documentation/lw445/LWRM/html/lwref-43.htm)
- => socket-fd
(DIR) diff --git a/3rdparties/software/usocket-0.7.1/notes/openmcl-sockets.txt b/3rdparties/software/usocket-0.7.1/notes/openmcl-sockets.txt
@@ -1,27 +0,0 @@
-http://openmcl.clozure.com/Doc/sockets.html
-
- make-socket [Function]
- accept-connection [Function]
- dotted-to-ipaddr [Function]
- ipaddr-to-dotted [Function]
- ipaddr-to-hostname [Function]
- lookup-hostname [Function]
- lookup-port [Function]
- receive-from [Function]
- send-to [Function]
- shutdown [Function]
- socket-os-fd [Function]
- remote-port [Function]
- local-host [Function]
- local-port [Function]
-
- socket-address-family [Function]
-
- socket-connect [Function]
- socket-format [Function]
- socket-type [Function]
- socket-error [Class]
- socket-error-code [Function]
- socket-error-identifier [Function]
- socket-error-situation [Function]
- close [method]
(DIR) diff --git a/3rdparties/software/usocket-0.7.1/notes/sb-bsd-sockets.txt b/3rdparties/software/usocket-0.7.1/notes/sb-bsd-sockets.txt
@@ -1,114 +0,0 @@
-http://www.xach.com/sbcl/sb-bsd-sockets.html
-
-$Id$
-
-package: sb-bsd-sockets
-
-class: socket
-
-slots:
-
- * file-descriptor :
- * family :
- * protocol :
- * type :
- * stream :
-
-operators:
-
- (socket-bind (s socket) &rest address) Generic Function
- (socket-accept (socket socket)) Method
- (socket-connect (s socket) &rest address) Generic Function
- (socket-peername (socket socket)) Method
- (socket-name (socket socket)) Method
- (socket-receive (socket socket) buffer length &key oob peek waitall (element-type 'character)) Method
- (socket-listen (socket socket) backlog) Method
- (socket-close (socket socket)) Method
- (socket-make-stream (socket socket) &rest args) Method
-
- (sockopt-reuse-address (socket socket) argument) Accessor
- (sockopt-keep-alive (socket socket) argument) Accessor
- (sockopt-oob-inline (socket socket) argument) Accessor
- (sockopt-bsd-compatible (socket socket) argument) Accessor
- (sockopt-pass-credentials (socket socket) argument) Accessor
- (sockopt-debug (socket socket) argument) Accessor
- (sockopt-dont-route (socket socket) argument) Accessor
- (sockopt-broadcast (socket socket) argument) Accessor
- (sockopt-tcp-nodelay (socket socket) argument) Accessor
-
-inet-domain sockets
-
-class: inet-socket
-
-slots:
-
- * family :
-
-operators:
-
- (make-inet-address dotted-quads) Function
- (get-protocol-by-name name) Function
- (make-inet-socket type protocol) Function
-
-file-domain sockets
-
-class: unix-socket
-
-slots:
-
- * family :
-
-class: host-ent
-
-Slots:
-
- * name :
- * aliases :
- * address-type :
- * addresses :
-
- (host-ent-address (host-ent host-ent)) Method
- (get-host-by-name host-name) Function
- (get-host-by-address address) Function
- (name-service-error where) Function
- (non-blocking-mode (socket socket)) Method
-
-(define-socket-condition sockint::EADDRINUSE address-in-use-error)
-(define-socket-condition sockint::EAGAIN interrupted-error)
-(define-socket-condition sockint::EBADF bad-file-descriptor-error)
-(define-socket-condition sockint::ECONNREFUSED connection-refused-error)
-(define-socket-condition sockint::EINTR interrupted-error)
-(define-socket-condition sockint::EINVAL invalid-argument-error)
-(define-socket-condition sockint::ENOBUFS no-buffers-error)
-(define-socket-condition sockint::ENOMEM out-of-memory-error)
-(define-socket-condition sockint::EOPNOTSUPP operation-not-supported-error)
-(define-socket-condition sockint::EPERM operation-not-permitted-error)
-(define-socket-condition sockint::EPROTONOSUPPORT protocol-not-supported-error)
-(define-socket-condition sockint::ESOCKTNOSUPPORT socket-type-not-supported-error)
-(define-socket-condition sockint::ENETUNREACH network-unreachable-error)
-
-Exported errors:
-* (apropos "ERROR" :sb-bsd-sockets)
-
-SB-BSD-SOCKETS:INTERRUPTED-ERROR
-SB-BSD-SOCKETS:TRY-AGAIN-ERROR
-* SB-BSD-SOCKETS:NO-RECOVERY-ERROR (EFAIL?)
-SB-BSD-SOCKETS:CONNECTION-REFUSED-ERROR
-SB-BSD-SOCKETS:INVALID-ARGUMENT-ERROR
-* SB-BSD-SOCKETS:HOST-NOT-FOUND-ERROR
-SB-BSD-SOCKETS:OPERATION-NOT-PERMITTED-ERROR
-SB-BSD-SOCKETS:OPERATION-NOT-SUPPORTED-ERROR
-SB-BSD-SOCKETS:PROTOCOL-NOT-SUPPORTED-ERROR
-SB-BSD-SOCKETS:OPERATION-TIMEOUT-ERROR
-SB-BSD-SOCKETS:SOCKET-TYPE-NOT-SUPPORTED-ERROR
-SB-BSD-SOCKETS:NO-BUFFERS-ERROR
-SB-BSD-SOCKETS:NETWORK-UNREACHABLE-ERROR
-SB-BSD-SOCKETS:BAD-FILE-DESCRIPTOR-ERROR
-SB-BSD-SOCKETS:ADDRESS-IN-USE-ERROR
-SB-BSD-SOCKETS:OUT-OF-MEMORY-ERROR
-
-And 1 non-exported error:
-
-SB-BSD-SOCKETS::NO-ADDRESS-ERROR
-
-*-ed errors aren't yet addressed in the errorlist supported by usocket
(DIR) diff --git a/3rdparties/software/usocket-0.7.1/notes/usock-sockets.txt b/3rdparties/software/usocket-0.7.1/notes/usock-sockets.txt
@@ -1,28 +0,0 @@
-Package:
-
- clisp : socket
- cmucl : extensions
- sbcl : sb-bsd-sockets
- lw : comm
- openmcl: openmcl-socket
- allegro: sock
-
-Connecting (TCP/inet only)
-
- clisp : socket-connect port &optional [host] &key :element-type :external-format :buffered :timeout = > socket-stream
- cmucl : connect-to-inet-socket host port &optional kind => file descriptor
- sbcl : sb-socket-connect socket &rest address => socket
- lw : open-tcp-stream hostname service &key direction element-type buffered => stream-object
- openmcl: socket-connect socket => :active, :passive or nil
- allegro: make-socket (&rest args &key type format connect address-family eol) => socket
-
-Closing
-
- clisp : close socket
- cmucl : close-socket socket
- sbcl : socket-close socket
- lw : close socket
- openmcl: close socket
- allegro: close socket
-
-Errors
-\ No newline at end of file
(DIR) diff --git a/3rdparties/software/usocket-0.7.1/option.lisp b/3rdparties/software/usocket-0.7.1/option.lisp
@@ -1,347 +0,0 @@
-;;;; SOCKET-OPTION, a high-level socket option get/set framework
-
-;;;; See LICENSE for licensing information.
-
-(in-package :usocket)
-
-;;; Interface definition
-
-(defgeneric socket-option (socket option &key)
- (:documentation
- "Get a socket's internal options"))
-
-(defgeneric (setf socket-option) (new-value socket option &key)
- (:documentation
- "Set a socket's internal options"))
-
-;;; Handling of wrong type of arguments
-
-(defmethod socket-option ((socket usocket) (option t) &key)
- (error 'type-error :datum option :expected-type 'keyword))
-
-(defmethod (setf socket-option) (new-value (socket usocket) (option t) &key)
- (declare (ignore new-value))
- (socket-option socket option))
-
-(defmethod socket-option ((socket usocket) (option symbol) &key)
- (if (keywordp option)
- (error 'unimplemented :feature option :context 'socket-option)
- (error 'type-error :datum option :expected-type 'keyword)))
-
-(defmethod (setf socket-option) (new-value (socket usocket) (option symbol) &key)
- (declare (ignore new-value))
- (socket-option socket option))
-
-;;; Socket option: RECEIVE-TIMEOUT (SO_RCVTIMEO)
-
-(defmethod socket-option ((usocket stream-usocket)
- (option (eql :receive-timeout)) &key)
- (declare (ignorable option))
- (let ((socket (socket usocket)))
- (declare (ignorable socket))
- #+abcl
- () ; TODO
- #+allegro
- () ; TODO
- #+clisp
- (socket:socket-options socket :so-rcvtimeo)
- #+clozure
- (ccl:stream-input-timeout socket)
- #+cmu
- (lisp::fd-stream-timeout (socket-stream usocket))
- #+ecl
- (sb-bsd-sockets:sockopt-receive-timeout socket)
- #+lispworks
- (get-socket-receive-timeout socket)
- #+mcl
- () ; TODO
- #+mocl
- () ; unknown
- #+sbcl
- (sb-impl::fd-stream-timeout (socket-stream usocket))
- #+scl
- ())) ; TODO
-
-(defmethod (setf socket-option) (new-value (usocket stream-usocket)
- (option (eql :receive-timeout)) &key)
- (declare (type number new-value) (ignorable new-value option))
- (let ((socket (socket usocket))
- (timeout new-value))
- (declare (ignorable socket timeout))
- #+abcl
- () ; TODO
- #+allegro
- () ; TODO
- #+clisp
- (socket:socket-options socket :so-rcvtimeo timeout)
- #+clozure
- (setf (ccl:stream-input-timeout socket) timeout)
- #+cmu
- (setf (lisp::fd-stream-timeout (socket-stream usocket))
- (coerce timeout 'integer))
- #+ecl
- (setf (sb-bsd-sockets:sockopt-receive-timeout socket) timeout)
- #+lispworks
- (set-socket-receive-timeout socket timeout)
- #+mcl
- () ; TODO
- #+mocl
- () ; unknown
- #+sbcl
- (setf (sb-impl::fd-stream-timeout (socket-stream usocket))
- (coerce timeout 'single-float))
- #+scl
- () ; TODO
- new-value))
-
-;;; Socket option: SEND-TIMEOUT (SO_SNDTIMEO)
-
-(defmethod socket-option ((usocket stream-usocket)
- (option (eql :send-timeout)) &key)
- (declare (ignorable option))
- (let ((socket (socket usocket)))
- (declare (ignorable socket))
- #+abcl
- () ; TODO
- #+allegro
- () ; TODO
- #+clisp
- (socket:socket-options socket :so-sndtimeo)
- #+clozure
- (ccl:stream-output-timeout socket)
- #+cmu
- (lisp::fd-stream-timeout (socket-stream usocket))
- #+ecl
- (sb-bsd-sockets:sockopt-send-timeout socket)
- #+lispworks
- (get-socket-send-timeout socket)
- #+mcl
- () ; TODO
- #+mocl
- () ; unknown
- #+sbcl
- (sb-impl::fd-stream-timeout (socket-stream usocket))
- #+scl
- ())) ; TODO
-
-(defmethod (setf socket-option) (new-value (usocket stream-usocket)
- (option (eql :send-timeout)) &key)
- (declare (type number new-value) (ignorable new-value option))
- (let ((socket (socket usocket))
- (timeout new-value))
- (declare (ignorable socket timeout))
- #+abcl
- () ; TODO
- #+allegro
- () ; TODO
- #+clisp
- (socket:socket-options socket :so-sndtimeo timeout)
- #+clozure
- (setf (ccl:stream-output-timeout socket) timeout)
- #+cmu
- (setf (lisp::fd-stream-timeout (socket-stream usocket))
- (coerce timeout 'integer))
- #+ecl
- (setf (sb-bsd-sockets:sockopt-send-timeout socket) timeout)
- #+lispworks
- (set-socket-send-timeout socket timeout)
- #+mcl
- () ; TODO
- #+mocl
- () ; unknown
- #+sbcl
- (setf (sb-impl::fd-stream-timeout (socket-stream usocket))
- (coerce timeout 'single-float))
- #+scl
- () ; TODO
- new-value))
-
-;;; Socket option: REUSE-ADDRESS (SO_REUSEADDR), for TCP server
-
-(defmethod socket-option ((usocket stream-server-usocket)
- (option (eql :reuse-address)) &key)
- (declare (ignorable option))
- (let ((socket (socket usocket)))
- (declare (ignorable socket))
- #+abcl
- () ; TODO
- #+allegro
- () ; TODO
- #+clisp
- (int->bool (socket:socket-options socket :so-reuseaddr))
- #+clozure
- (int->bool (get-socket-option-reuseaddr socket))
- #+cmu
- () ; TODO
- #+lispworks
- (get-socket-reuse-address socket)
- #+mcl
- () ; TODO
- #+mocl
- () ; unknown
- #+(or ecl sbcl)
- (sb-bsd-sockets:sockopt-reuse-address socket)
- #+scl
- ())) ; TODO
-
-(defmethod (setf socket-option) (new-value (usocket stream-server-usocket)
- (option (eql :reuse-address)) &key)
- (declare (type boolean new-value) (ignorable new-value option))
- (let ((socket (socket usocket)))
- (declare (ignorable socket))
- #+abcl
- () ; TODO
- #+allegro
- (socket:set-socket-options socket option new-value)
- #+clisp
- (socket:socket-options socket :so-reuseaddr (bool->int new-value))
- #+clozure
- (set-socket-option-reuseaddr socket (bool->int new-value))
- #+cmu
- () ; TODO
- #+lispworks
- (set-socket-reuse-address socket new-value)
- #+mcl
- () ; TODO
- #+mocl
- () ; unknown
- #+(or ecl sbcl)
- (setf (sb-bsd-sockets:sockopt-reuse-address socket) new-value)
- #+scl
- () ; TODO
- new-value))
-
-;;; Socket option: BROADCAST (SO_BROADCAST), for UDP client
-
-(defmethod socket-option ((usocket datagram-usocket)
- (option (eql :broadcast)) &key)
- (declare (ignorable option))
- (let ((socket (socket usocket)))
- (declare (ignorable socket))
- #+abcl
- () ; TODO
- #+allegro
- () ; TODO
- #+clisp
- (int->bool (socket:socket-options socket :so-broadcast))
- #+clozure
- (int->bool (get-socket-option-broadcast socket))
- #+cmu
- () ; TODO
- #+ecl
- () ; TODO
- #+lispworks
- () ; TODO
- #+mcl
- () ; TODO
- #+mocl
- () ; unknown
- #+sbcl
- (sb-bsd-sockets:sockopt-broadcast socket)
- #+scl
- ())) ; TODO
-
-(defmethod (setf socket-option) (new-value (usocket datagram-usocket)
- (option (eql :broadcast)) &key)
- (declare (type boolean new-value) (ignorable new-value option))
- (let ((socket (socket usocket)))
- (declare (ignorable socket))
- #+abcl
- () ; TODO
- #+allegro
- (socket:set-socket-options socket option new-value)
- #+clisp
- (socket:socket-options socket :so-broadcast (bool->int new-value))
- #+clozure
- (set-socket-option-broadcast socket (bool->int new-value))
- #+cmu
- () ; TODO
- #+ecl
- () ; TODO
- #+lispworks
- () ; TODO
- #+mcl
- () ; TODO
- #+mocl
- () ; unknown
- #+sbcl
- (setf (sb-bsd-sockets:sockopt-broadcast socket) new-value)
- #+scl
- () ; TODO
- new-value))
-
-;;; Socket option: TCP-NODELAY (TCP_NODELAY), for TCP client
-
-(defmethod socket-option ((usocket stream-usocket)
- (option (eql :tcp-no-delay)) &key)
- (declare (ignore option))
- (socket-option usocket :tcp-nodelay))
-
-(defmethod socket-option ((usocket stream-usocket)
- (option (eql :tcp-nodelay)) &key)
- (declare (ignorable option))
- (let ((socket (socket usocket)))
- (declare (ignorable socket))
- #+abcl
- () ; TODO
- #+allegro
- () ; TODO
- #+clisp
- (int->bool (socket:socket-options socket :tcp-nodelay))
- #+clozure
- (int->bool (get-socket-option-tcp-nodelay socket))
- #+cmu
- ()
- #+ecl
- (sb-bsd-sockets::sockopt-tcp-nodelay socket)
- #+lispworks
- (int->bool (get-socket-tcp-nodelay socket))
- #+mcl
- () ; TODO
- #+mocl
- () ; unknown
- #+sbcl
- (sb-bsd-sockets::sockopt-tcp-nodelay socket)
- #+scl
- ())) ; TODO
-
-(defmethod (setf socket-option) (new-value (usocket stream-usocket)
- (option (eql :tcp-no-delay)) &key)
- (declare (ignore option))
- (setf (socket-option usocket :tcp-nodelay) new-value))
-
-(defmethod (setf socket-option) (new-value (usocket stream-usocket)
- (option (eql :tcp-nodelay)) &key)
- (declare (type boolean new-value) (ignorable new-value option))
- (let ((socket (socket usocket)))
- (declare (ignorable socket))
- #+abcl
- () ; TODO
- #+allegro
- (socket:set-socket-options socket :no-delay new-value)
- #+clisp
- (socket:socket-options socket :tcp-nodelay (bool->int new-value))
- #+clozure
- (set-socket-option-tcp-nodelay socket (bool->int new-value))
- #+cmu
- ()
- #+ecl
- (setf (sb-bsd-sockets::sockopt-tcp-nodelay socket) new-value)
- #+lispworks
- (progn
- #-(or lispworks4 lispworks5.0)
- (comm::set-socket-tcp-nodelay socket new-value)
- #+(or lispworks4 lispworks5.0)
- (set-socket-tcp-nodelay socket (bool->int new-value)))
- #+mcl
- () ; TODO
- #+mocl
- () ; unknown
- #+sbcl
- (setf (sb-bsd-sockets::sockopt-tcp-nodelay socket) new-value)
- #+scl
- () ; TODO
- new-value))
-
-(eval-when (:load-toplevel :execute)
- (export 'socket-option))
(DIR) diff --git a/3rdparties/software/usocket-0.7.1/package.lisp b/3rdparties/software/usocket-0.7.1/package.lisp
@@ -1,103 +0,0 @@
-;;;; See the LICENSE file for licensing information.
-
-(defpackage :usocket
- (:use #-genera :common-lisp
- #+genera :future-common-lisp
- #+abcl :java
- :split-sequence)
- (:export #:*version*
- #:*wildcard-host*
- #:*auto-port*
-
- #:+max-datagram-packet-size+
-
- #:socket-connect ; socket constructors and methods
- #:socket-listen
- #:socket-accept
- #:socket-close
- #:socket-shutdown
- #:get-local-address
- #:get-peer-address
- #:get-local-port
- #:get-peer-port
- #:get-local-name
- #:get-peer-name
-
- #:socket-send ; udp function (send)
- #:socket-receive ; udp function (receive)
-
- #:wait-for-input ; waiting for input-ready state (select() like)
- #:make-wait-list
- #:add-waiter
- #:remove-waiter
- #:remove-all-waiters
-
- #:with-connected-socket ; convenience macros
- #:with-server-socket
- #:with-client-socket
- #:with-socket-listener
-
- #:usocket ; socket object and accessors
- #:stream-usocket
- #:stream-server-usocket
- #:socket
- #:socket-stream
- #:datagram-usocket
- #:socket-state ; 0.6.4
-
- ;; predicates (for version 0.6 or 1.0 ?)
- #:usocket-p
- #:stream-usocket-p
- #:stream-server-usocket-p
- #:datagram-usocket-p
-
- #:host-byte-order ; IPv4 utility functions
- #:hbo-to-dotted-quad
- #:hbo-to-vector-quad
- #:vector-quad-to-dotted-quad
- #:dotted-quad-to-vector-quad
-
- #:vector-to-ipv6-host ; IPv6 utility functions
- #:ipv6-host-to-vector
-
- #:ip= ; IPv4+IPv6 utility function
- #:ip/=
-
- #:integer-to-octet-buffer ; Network utility functions
- #:octet-buffer-to-integer
- #:port-to-octet-buffer
- #:port-from-octet-buffer
- #:ip-to-octet-buffer
- #:ip-from-octet-buffer
-
- #:with-mapped-conditions
-
- #:socket-condition ; conditions
- #:ns-condition
- #:socket-error ; errors
- #:ns-error
- #:unknown-condition
- #:ns-unknown-condition
- #:unknown-error
- #:ns-unknown-error
- #:socket-warning ; warnings (udp)
-
- #:insufficient-implementation ; conditions regarding usocket support level
- #:unsupported
- #:unimplemented
-
- #:socket-server
- #:*remote-host*
- #:*remote-port*
-
- ;; added in 0.7.1
- #:get-host-by-name
- #:get-hosts-by-name
- #:get-random-host-by-name
- #:ns-host-not-found-error
- #:ns-no-recovery-error
- #:ns-try-again-condition
- #:default-udp-handler
- #:default-tcp-handler
- #:echo-tcp-handler ;; server handlers
- ))
(DIR) diff --git a/3rdparties/software/usocket-0.7.1/server.lisp b/3rdparties/software/usocket-0.7.1/server.lisp
@@ -1,111 +0,0 @@
-;;;; See LICENSE for licensing information.
-
-(in-package :usocket)
-
-(defvar *server*)
-
-(defun socket-server (host port function &optional arguments
- &key in-new-thread (protocol :stream)
- ;; for udp
- (timeout 1) (max-buffer-size +max-datagram-packet-size+)
- ;; for tcp
- element-type (reuse-address t) multi-threading
- name)
- (let* ((real-host (or host *wildcard-host*))
- (socket (ecase protocol
- (:stream
- (apply #'socket-listen
- `(,real-host ,port
- ,@(when element-type `(:element-type ,element-type))
- ,@(when reuse-address `(:reuse-address ,reuse-address)))))
- (:datagram
- (socket-connect nil nil :protocol :datagram
- :local-host real-host
- :local-port port)))))
- (labels ((real-call ()
- (ecase protocol
- (:stream
- (tcp-event-loop socket function arguments
- :element-type element-type
- :multi-threading multi-threading))
- (:datagram
- (udp-event-loop socket function arguments
- :timeout timeout
- :max-buffer-size max-buffer-size)))))
- (if in-new-thread
- (values (portable-threads:spawn-thread (or name "USOCKET Server") #'real-call) socket)
- (progn
- (setq *server* socket)
- (real-call))))))
-
-(defvar *remote-host*)
-(defvar *remote-port*)
-
-(defun default-udp-handler (buffer) ; echo
- (declare (type (simple-array (unsigned-byte 8) *) buffer))
- buffer)
-
-(defun udp-event-loop (socket function &optional arguments
- &key timeout max-buffer-size)
- (let ((buffer (make-array max-buffer-size :element-type '(unsigned-byte 8) :initial-element 0))
- (sockets (list socket)))
- (unwind-protect
- (loop do
- (multiple-value-bind (return-sockets real-time)
- (wait-for-input sockets :timeout timeout)
- (declare (ignore return-sockets))
- (when real-time
- (multiple-value-bind (recv n *remote-host* *remote-port*)
- (socket-receive socket buffer max-buffer-size)
- (declare (ignore recv))
- (if (plusp n)
- (progn
- (let ((reply
- (apply function (subseq buffer 0 n) arguments)))
- (when reply
- (replace buffer reply)
- (let ((n (socket-send socket buffer (length reply)
- :host *remote-host*
- :port *remote-port*)))
- (when (minusp n)
- (error "send error: ~A~%" n))))))
- (error "receive error: ~A" n))))
- #+scl (when thread:*quitting-lisp* (return))
- #+(and cmu mp) (mp:process-yield)))
- (socket-close socket)
- (values))))
-
-(defun default-tcp-handler (stream) ; null
- (declare (type stream stream))
- (format stream "Hello world!~%"))
-
-(defun echo-tcp-handler (stream)
- (loop
- (when (listen stream)
- (let ((line (read-line stream nil)))
- (write-line line stream)
- (force-output stream)))))
-
-(defun tcp-event-loop (socket function &optional arguments
- &key element-type multi-threading)
- (let ((real-function #'(lambda (client-socket &rest arguments)
- (unwind-protect
- (multiple-value-bind (*remote-host* *remote-port*) (get-peer-name client-socket)
- (apply function (socket-stream client-socket) arguments))
- (close (socket-stream client-socket))
- (socket-close client-socket)
- nil))))
- (unwind-protect
- (loop do
- (let* ((client-socket (apply #'socket-accept
- `(,socket ,@(when element-type `(:element-type ,element-type)))))
- (client-stream (socket-stream client-socket)))
- (if multi-threading
- (apply #'portable-threads:spawn-thread "USOCKET Client" real-function client-socket arguments)
- (prog1 (apply real-function client-socket arguments)
- (close client-stream)
- (socket-close client-socket)))
- #+scl (when thread:*quitting-lisp* (return))
- #+(and cmu mp) (mp:process-yield)))
- (socket-close socket)
- (values))))
(DIR) diff --git a/3rdparties/software/usocket-0.7.1/test/package.lisp b/3rdparties/software/usocket-0.7.1/test/package.lisp
@@ -1,10 +0,0 @@
-;;;; See the LICENSE file for licensing information.
-
-(in-package :cl-user)
-
-(defpackage :usocket-test
- (:use :common-lisp
- :usocket
- :regression-test)
- (:export #:do-tests
- #:run-usocket-tests))
(DIR) diff --git a/3rdparties/software/usocket-0.7.1/test/test-condition.lisp b/3rdparties/software/usocket-0.7.1/test/test-condition.lisp
@@ -1,27 +0,0 @@
-;;;; See LICENSE for licensing information.
-
-(in-package :usocket-test)
-
-(deftest ns-host-not-found-error.1
- (with-caught-conditions (usocket:ns-host-not-found-error nil)
- (usocket:socket-connect "xxx" 123)
- t)
- nil)
-
-(deftest timeout-error.1
- (with-caught-conditions (usocket:timeout-error nil)
- (usocket:socket-connect "common-lisp.net" 81 :timeout 0)
- t)
- nil)
-
-(deftest connection-refused-error.1
- (with-caught-conditions (usocket:connection-refused-error nil)
- (usocket:socket-connect "common-lisp.net" 81)
- t)
- nil)
-
-(deftest operation-not-permitted-error.1
- (with-caught-conditions (usocket:operation-not-permitted-error nil)
- (usocket:socket-listen "0.0.0.0" 81)
- t)
- nil)
(DIR) diff --git a/3rdparties/software/usocket-0.7.1/test/test-datagram.lisp b/3rdparties/software/usocket-0.7.1/test/test-datagram.lisp
@@ -1,123 +0,0 @@
-;;;; See LICENSE for licensing information.
-
-(in-package :usocket-test)
-
-(defvar *echo-server*)
-(defvar *echo-server-port*)
-
-(defun start-server ()
- (multiple-value-bind (thread socket)
- (socket-server "127.0.0.1" 0 #'identity nil
- :in-new-thread t
- :protocol :datagram)
- (setq *echo-server* thread
- *echo-server-port* (get-local-port socket))))
-
-(defparameter *max-buffer-size* 32)
-
-(defvar *send-buffer*
- (make-array *max-buffer-size* :element-type '(unsigned-byte 8) :initial-element 0))
-
-(defvar *receive-buffer*
- (make-array *max-buffer-size* :element-type '(unsigned-byte 8) :initial-element 0))
-
-(defun clean-buffers ()
- (fill *send-buffer* 0)
- (fill *receive-buffer* 0))
-
-;;; UDP Send Test #1: connected socket
-(deftest udp-send.1
- (progn
- (unless (and *echo-server* *echo-server-port*)
- (start-server))
- (let ((s (socket-connect "127.0.0.1" *echo-server-port* :protocol :datagram)))
- (clean-buffers)
- (replace *send-buffer* #(1 2 3 4 5))
- (socket-send s *send-buffer* 5)
- (wait-for-input s :timeout 3)
- (multiple-value-bind (buffer size host port)
- (socket-receive s *receive-buffer* *max-buffer-size*)
- (declare (ignore buffer size host port))
- (reduce #'+ *receive-buffer* :start 0 :end 5))))
- 15)
-
-;;; UDP Send Test #2: unconnected socket
-(deftest udp-send.2
- (progn
- (unless (and *echo-server* *echo-server-port*)
- (start-server))
- (let ((s (socket-connect nil nil :protocol :datagram)))
- (clean-buffers)
- (replace *send-buffer* #(1 2 3 4 5))
- (socket-send s *send-buffer* 5 :host "127.0.0.1" :port *echo-server-port*)
- (wait-for-input s :timeout 3)
- (multiple-value-bind (buffer size host port)
- (socket-receive s *receive-buffer* *max-buffer-size*)
- (declare (ignore buffer size host port))
- (reduce #'+ *receive-buffer* :start 0 :end 5))))
- 15)
-
-(deftest mark-h-david ; Mark H. David's remarkable UDP test code
- (let* ((host "localhost")
- (port 1111)
- (server-sock
- (socket-connect nil nil :protocol ':datagram :local-host host :local-port port))
- (client-sock
- (socket-connect host port :protocol ':datagram))
- (octet-vector
- (make-array 2 :element-type '(unsigned-byte 8) :initial-contents `(,(char-code #\O) ,(char-code #\K))))
- (recv-octet-vector
- (make-array 2 :element-type '(unsigned-byte 8))))
- (socket-send client-sock octet-vector 2)
- (socket-receive server-sock recv-octet-vector 2)
- (prog1 (and (equalp octet-vector recv-octet-vector)
- recv-octet-vector)
- (socket-close server-sock)
- (socket-close client-sock)))
- #(79 75))
-
-(deftest frank-james ; Frank James' test code for LispWorks/UDP
- (with-caught-conditions (#+win32 CONNECTION-RESET-ERROR
- #-win32 CONNECTION-REFUSED-ERROR
- nil)
- (let ((sock (socket-connect "localhost" 1234
- :protocol ':datagram :element-type '(unsigned-byte 8))))
- (unwind-protect
- (progn
- (socket-send sock (make-array 16 :element-type '(unsigned-byte 8) :initial-element 0) 16)
- (let ((buffer (make-array 16 :element-type '(unsigned-byte 8) :initial-element 0)))
- (socket-receive sock buffer 16)))
- (socket-close sock))))
- nil)
-
-(defun frank-wfi-test ()
- (let ((s (socket-connect nil nil :protocol :datagram
- :element-type '(unsigned-byte 8)
- :local-port 8001)))
- (unwind-protect
- (do ((i 0 (1+ i))
- (buffer (make-array 1024 :element-type '(unsigned-byte 8)
- :initial-element 0))
- (now (get-universal-time))
- (done nil))
- ((or done (= i 4))
- nil)
- (format t "~Ds ~D Waiting state ~S~%" (- (get-universal-time) now) i (usocket::state s))
- (when (wait-for-input s :ready-only t :timeout 5)
- (format t "~D state ~S~%" i (usocket::state s))
- (handler-bind
- ((error (lambda (c)
- (format t "socket-receive error: ~A~%" c)
- (break)
- nil)))
- (multiple-value-bind (buffer count remote-host remote-port)
- (socket-receive s buffer 1024)
- (handler-bind
- ((error (lambda (c)
- (format t "socket-send error: ~A~%" c)
- (break))))
- (when buffer
- (socket-send s (subseq buffer 0 count) count
- :host remote-host
- :port remote-port)))))))
- (socket-close s))))
(DIR) diff --git a/3rdparties/software/usocket-0.7.1/test/test-usocket.lisp b/3rdparties/software/usocket-0.7.1/test/test-usocket.lisp
@@ -1,178 +0,0 @@
-;;;; See LICENSE for licensing information.
-
-;;;; Usage: (usoct:run-usocket-tests) or (usoct:do-tests)
-
-(in-package :usocket-test)
-
-(defparameter +non-existing-host+ "1.2.3.4")
-(defparameter +unused-local-port+ 15213)
-
-(defparameter *fake-usocket*
- (usocket::make-stream-socket :socket :my-socket
- :stream :my-stream))
-
-(eval-when (:compile-toplevel :load-toplevel :execute)
- (defvar *common-lisp-net*
- (get-host-by-name "common-lisp.net")))
-
-(defvar *local-ip*)
-
-(defmacro with-caught-conditions ((expect throw) &body body)
- `(catch 'caught-error
- (handler-case
- (handler-bind ((unsupported
- #'(lambda (c)
- (declare (ignore c)) (continue))))
- (progn ,@body))
- (unknown-error (c) (if (typep c ',expect)
- (throw 'caught-error ,throw)
- (progn
- (describe c)
- (describe
- (usocket::usocket-real-error c))
- c)))
- (error (c) (if (typep c ',expect)
- (throw 'caught-error ,throw)
- (progn
- (describe c)
- c)))
- (unknown-condition (c) (if (typep c ',expect)
- (throw 'caught-error ,throw)
- (progn
- (describe c)
- (describe
- (usocket::usocket-real-condition c))
- c)))
- (condition (c) (if (typep c ',expect)
- (throw 'caught-error ,throw)
- (progn
- (describe c)
- c))))))
-
-(deftest make-socket.1 (socket *fake-usocket*) :my-socket)
-(deftest make-socket.2 (socket-stream *fake-usocket*) :my-stream)
-
-(deftest socket-no-connect.1
- (with-caught-conditions (socket-error nil)
- (socket-connect "127.0.0.1" +unused-local-port+ :timeout 1)
- t)
- nil)
-
-(deftest socket-no-connect.2
- (with-caught-conditions (socket-error nil)
- (socket-connect #(127 0 0 1) +unused-local-port+ :timeout 1)
- t)
- nil)
-
-(deftest socket-no-connect.3
- (with-caught-conditions (socket-error nil)
- (socket-connect 2130706433 +unused-local-port+ :timeout 1) ;; == #(127 0 0 1)
- t)
- nil)
-
-(deftest socket-failure.1
- (with-caught-conditions (timeout-error nil)
- (socket-connect 2130706433 +unused-local-port+ :timeout 1) ;; == #(127 0 0 1)
- :unreach)
- nil)
-
-(deftest socket-failure.2
- (with-caught-conditions (timeout-error nil)
- (socket-connect +non-existing-host+ 80 :timeout 1) ;; 80 = just a port
- :unreach)
- nil)
-
-;; let's hope c-l.net doesn't move soon, or that people start to
-;; test usocket like crazy..
-(deftest socket-connect.1
- (with-caught-conditions (nil nil)
- (let ((sock (socket-connect "common-lisp.net" 80)))
- (unwind-protect
- (when (typep sock 'usocket) t)
- (socket-close sock))))
- t)
-
-(deftest socket-connect.2
- (with-caught-conditions (nil nil)
- (let ((sock (socket-connect *common-lisp-net* 80)))
- (unwind-protect
- (when (typep sock 'usocket) t)
- (socket-close sock))))
- t)
-
-(deftest socket-connect.3
- (with-caught-conditions (nil nil)
- (let ((sock (socket-connect (usocket::host-byte-order *common-lisp-net*) 80)))
- (unwind-protect
- (when (typep sock 'usocket) t)
- (socket-close sock))))
- t)
-
-;; let's hope c-l.net doesn't change its software any time soon
-(deftest socket-stream.1
- (with-caught-conditions (nil nil)
- (let ((sock (socket-connect "common-lisp.net" 80)))
- (unwind-protect
- (progn
- (format (socket-stream sock)
- "GET / HTTP/1.0~2%")
- (force-output (socket-stream sock))
- (subseq (read-line (socket-stream sock)) 0 4))
- (socket-close sock))))
- "HTTP")
-
-(deftest socket-name.1
- (with-caught-conditions (nil nil)
- (let ((sock (socket-connect *common-lisp-net* 80)))
- (unwind-protect
- (get-peer-address sock)
- (socket-close sock))))
- #.*common-lisp-net*)
-
-(deftest socket-name.2
- (with-caught-conditions (nil nil)
- (let ((sock (socket-connect *common-lisp-net* 80)))
- (unwind-protect
- (get-peer-port sock)
- (socket-close sock))))
- 80)
-
-(deftest socket-name.3
- (with-caught-conditions (nil nil)
- (let ((sock (socket-connect *common-lisp-net* 80)))
- (unwind-protect
- (get-peer-name sock)
- (socket-close sock))))
- #.*common-lisp-net* 80)
-
-#+ignore
-(deftest socket-name.4
- (with-caught-conditions (nil nil)
- (let ((sock (socket-connect *common-lisp-net* 80)))
- (unwind-protect
- (equal (get-local-address sock) *local-ip*)
- (socket-close sock))))
- t)
-
-(deftest socket-shutdown.1
- (with-caught-conditions (nil nil)
- (let ((sock (socket-connect *common-lisp-net* 80)))
- (unwind-protect
- (usocket::ignore-unsupported-warnings
- (socket-shutdown sock :input))
- (socket-close sock))
- t))
- t)
-
-(deftest socket-shutdown.2
- (with-caught-conditions (nil nil)
- (let ((sock (socket-connect *common-lisp-net* 80)))
- (unwind-protect
- (usocket::ignore-unsupported-warnings
- (socket-shutdown sock :output))
- (socket-close sock))
- t))
- t)
-
-(defun run-usocket-tests ()
- (do-tests))
(DIR) diff --git a/3rdparties/software/usocket-0.7.1/test/wait-for-input.lisp b/3rdparties/software/usocket-0.7.1/test/wait-for-input.lisp
@@ -1,139 +0,0 @@
-;;;; See LICENSE for licensing information.
-
-(in-package :usocket-test)
-
-(eval-when (:compile-toplevel :load-toplevel :execute)
- (defparameter *wait-for-input-timeout* 2))
-
-(deftest wait-for-input.1
- (with-caught-conditions (nil nil)
- (let ((sock (usocket:socket-connect *common-lisp-net* 80))
- (time (get-universal-time)))
- (unwind-protect
- (progn (usocket:wait-for-input sock :timeout *wait-for-input-timeout*)
- (- (get-universal-time) time))
- (usocket:socket-close sock))))
- #.*wait-for-input-timeout*)
-
-(deftest wait-for-input.2
- (with-caught-conditions (nil nil)
- (let ((sock (usocket:socket-connect *common-lisp-net* 80))
- (time (get-universal-time)))
- (unwind-protect
- (progn (usocket:wait-for-input sock :timeout *wait-for-input-timeout* :ready-only t)
- (- (get-universal-time) time))
- (usocket:socket-close sock))))
- #.*wait-for-input-timeout*)
-
-(deftest wait-for-input.3
- (with-caught-conditions (nil nil)
- (let ((sock (usocket:socket-connect *common-lisp-net* 80)))
- (unwind-protect
- (progn
- (format (usocket:socket-stream sock)
- "GET / HTTP/1.0~2%")
- (force-output (usocket:socket-stream sock))
- (usocket:wait-for-input sock :timeout *wait-for-input-timeout*)
- (subseq (read-line (usocket:socket-stream sock)) 0 4))
- (usocket:socket-close sock))))
- "HTTP")
-
-;;; Advanced W-F-I tests by Elliott Slaughter <elliottslaughter@gmail.com>
-
-(defvar *socket-server-port* 0)
-(defvar *socket-server-listen* nil)
-(defvar *socket-server-connection*)
-(defvar *socket-client-connection*)
-(defvar *output-p* t)
-
-(defun stage-1 ()
- (unless *socket-server-listen*
- (setf *socket-server-listen*
- (socket-listen *wildcard-host* 0 :element-type '(unsigned-byte 8)))
- (setf *socket-server-port* (get-local-port *socket-server-listen*)))
-
- (setf *socket-server-connection*
- (when (wait-for-input *socket-server-listen* :timeout 0 :ready-only t)
- (socket-accept *socket-server-listen*)))
-
- (when *output-p* ; should be NIL
- (format t "First time (before client connects) is ~s.~%"
- *socket-server-connection*))
-
- *socket-server-connection*)
-
-;; TODO: original test code have addition (:TIMEOUT 0) when doing the SOCKET-CONNECT,
-;; it seems cannot work on SBCL/Windows, need to investigate, but here we ignore it.
-
-(defun stage-2 ()
- (setf *socket-client-connection*
- (socket-connect "localhost" *socket-server-port* :protocol :stream
- :element-type '(unsigned-byte 8)))
- (setf *socket-server-connection*
- (when (wait-for-input *socket-server-listen* :timeout 0 :ready-only t)
- #+(and win32 (or lispworks ecl sbcl))
- (when *output-p*
- (format t "%READY-P: ~D~%" (usocket::%ready-p *socket-server-listen*)))
- (socket-accept *socket-server-listen*)))
-
- (when *output-p* ; should be a usocket object
- (format t "Second time (after client connects) is ~s.~%"
- *socket-server-connection*))
-
- *socket-server-connection*)
-
-(defun stage-3 ()
- (setf *socket-server-connection*
- (when (wait-for-input *socket-server-listen* :timeout 0 :ready-only t)
- #+(and win32 (or lispworks ecl sbcl))
- (when *output-p*
- (format t "%READY-P: ~D~%" (usocket::%ready-p *socket-server-listen*)))
- (socket-accept *socket-server-listen*)))
-
- (when *output-p* ; should be NIL again
- (format t "Third time (before second client) is ~s.~%"
- *socket-server-connection*))
-
- *socket-server-connection*)
-
-(deftest elliott-slaughter.1
- (let ((*output-p* nil))
- (let* ((s-1 (stage-1)) (s-2 (stage-2)) (s-3 (stage-3)))
- (prog1 (and (null s-1) (usocket::usocket-p s-2) (null s-3))
- (socket-close *socket-server-listen*)
- (setf *socket-server-listen* nil))))
- t)
-
-#|
-
-Issue elliott-slaughter.2 (WAIT-FOR-INPUT/win32 on TCP socket)
-
-W-F-I correctly found the inputs, but :READY-ONLY didn't work.
-
-|#
-(defun receive-each (connections)
- (let ((ready (usocket:wait-for-input connections :timeout 0 :ready-only t)))
- (loop for connection in ready
- collect (read-line (usocket:socket-stream connection)))))
-
-(defun receive-all (connections)
- (loop for messages = (receive-each connections)
- then (receive-each connections)
- while messages append messages))
-
-(defun send (connection message)
- (format (usocket:socket-stream connection) "~a~%" message)
- (force-output (usocket:socket-stream connection)))
-
-(defun server ()
- (let* ((listen (usocket:socket-listen usocket:*wildcard-host* 12345))
- (connection (usocket:socket-accept listen)))
- (loop for messages = (receive-all connection) then (receive-all connection)
- do (format t "Got messages:~%~s~%" messages)
- do (sleep 1/50))))
-
-(defun client ()
- (let ((connection (usocket:socket-connect "localhost" 12345)))
- (loop for i from 0
- do (send connection (format nil "This is message ~a." i))
- do (sleep 1/100))))
(DIR) diff --git a/3rdparties/software/usocket-0.7.1/usocket-server.asd b/3rdparties/software/usocket-0.7.1/usocket-server.asd
@@ -1,14 +0,0 @@
-;;;; -*- Mode: Lisp -*-
-;;;;
-;;;; See the LICENSE file for licensing information.
-
-(in-package :asdf)
-
-(defsystem #:usocket-server
- :name "usocket (server)"
- :author "Chun Tian (binghe)"
- :version (:read-file-form "version.sexp")
- :licence "MIT"
- :description "Universal socket library for Common Lisp (server side)"
- :depends-on (:usocket :portable-threads)
- :components ((:file "server")))
(DIR) diff --git a/3rdparties/software/usocket-0.7.1/usocket-test.asd b/3rdparties/software/usocket-0.7.1/usocket-test.asd
@@ -1,25 +0,0 @@
-;;;; -*- Mode: Lisp -*-
-;;;; $Id: usocket-test.asd 46 2006-02-06 20:50:07Z ehuelsmann $
-;;;; $URL: svn+ssh://common-lisp.net/project/usocket/svn/usocket/trunk/test/usocket-test.asd $
-
-;;;; See the LICENSE file for licensing information.
-
-(defsystem usocket-test
- :name "usocket test"
- :author "Erik Enge"
- :maintainer "Chun Tian (binghe)"
- :version (:read-file-form "version.sexp")
- :licence "MIT"
- :description "Tests for usocket"
- :depends-on (:usocket-server
- :rt)
- :components ((:module "test"
- :serial t
- :components ((:file "package")
- (:file "test-usocket")
- (:file "test-condition")
- (:file "test-datagram")
- (:file "wait-for-input")))))
-
-(defmethod perform ((op test-op) (c (eql (find-system :usocket-test))))
- (funcall (intern "DO-TESTS" "USOCKET-TEST")))
(DIR) diff --git a/3rdparties/software/usocket-0.7.1/usocket.asd b/3rdparties/software/usocket-0.7.1/usocket.asd
@@ -1,45 +0,0 @@
-;;;; -*- Mode: Lisp -*-
-;;;;
-;;;; See the LICENSE file for licensing information.
-
-(in-package :asdf)
-
-(defsystem #:usocket
- :name "usocket (client, with server symbols)"
- :author "Erik Enge & Erik Huelsmann"
- :maintainer "Chun Tian (binghe) & Hans Huebner"
- :version (:read-file-form "version.sexp")
- :licence "MIT"
- :description "Universal socket library for Common Lisp"
- :depends-on (:split-sequence
- #+(or sbcl ecl) :sb-bsd-sockets
- )
- :components ((:file "package")
- (:module "vendor" :depends-on ("package")
- :components (#+mcl (:file "kqueue")
- #+mcl (:file "OpenTransportUDP")))
- (:file "usocket" :depends-on ("vendor"))
- (:file "condition" :depends-on ("usocket"))
- (:module "backend" :depends-on ("condition")
- :components (#+abcl (:file "abcl")
- #+(or allegro cormanlisp)
- (:file "allegro")
- #+clisp (:file "clisp")
- #+(or openmcl clozure)
- (:file "openmcl")
- #+clozure (:file "clozure" :depends-on ("openmcl"))
- #+cmu (:file "cmucl")
- #+(or sbcl ecl) (:file "sbcl")
- #+ecl (:file "ecl" :depends-on ("sbcl"))
- #+lispworks (:file "lispworks")
- #+mcl (:file "mcl")
- #+mocl (:file "mocl")
- #+scl (:file "scl")
- #+genera (:file "genera")))
- (:file "option" :depends-on ("backend"))
- ))
-
-(defmethod perform ((op test-op) (c (eql (find-system :usocket))))
- (oos 'load-op :usocket-server)
- (oos 'load-op :usocket-test)
- (oos 'test-op :usocket-test))
(DIR) diff --git a/3rdparties/software/usocket-0.7.1/usocket.lisp b/3rdparties/software/usocket-0.7.1/usocket.lisp
@@ -1,705 +0,0 @@
-;;;; See LICENSE for licensing information.
-
-(in-package :usocket)
-
-(defparameter *wildcard-host* #(0 0 0 0)
- "Hostname to pass when all interfaces in the current system are to
- be bound. If this variable is passed to socket-listen, IPv6 capable
- systems will also listen for IPv6 connections.")
-
-(defparameter *auto-port* 0
- "Port number to pass when an auto-assigned port number is wanted.")
-
-(defparameter *version* #.(asdf:component-version (asdf:find-system :usocket))
- "usocket version string")
-
-(defconstant +max-datagram-packet-size+ 65507
- "The theoretical maximum amount of data in a UDP datagram.
-
-The IPv4 UDP packets have a 16-bit length constraint, and IP+UDP header has 28-byte.
-
-IP_MAXPACKET = 65535, /* netinet/ip.h */
-sizeof(struct ip) = 20, /* netinet/ip.h */
-sizeof(struct udphdr) = 8, /* netinet/udp.h */
-
-65535 - 20 - 8 = 65507
-
-(But for UDP broadcast, the maximum message size is limited by the MTU size of the underlying link)")
-
-(defclass usocket ()
- ((socket
- :initarg :socket
- :accessor socket
- :documentation "Implementation specific socket object instance.'")
- (wait-list
- :initform nil
- :accessor wait-list
- :documentation "WAIT-LIST the object is associated with.")
- (state
- :initform nil
- :accessor state
- :documentation "Per-socket return value for the `wait-for-input' function.
-
-The value stored in this slot can be any of
- NIL - not ready
- :READ - ready to read
- :READ-WRITE - ready to read and write
- :WRITE - ready to write
-
-The last two remain unused in the current version.
-")
- #+(and win32 (or sbcl ecl lispworks))
- (%ready-p
- :initform nil
- :accessor %ready-p
- :documentation "Indicates whether the socket has been signalled
-as ready for reading a new connection.
-
-The value will be set to T by `wait-for-input-internal' (given the
-right conditions) and reset to NIL by `socket-accept'.
-
-Don't modify this slot or depend on it as it is really intended
-to be internal only.
-
-Note: Accessed, but not used for 'stream-usocket'.
-"
- ))
- (:documentation
-"The main socket class.
-
-Sockets should be closed using the `socket-close' method."))
-
-(defgeneric socket-state (socket)
- (:documentation "NIL - not ready
-:READ - ready to read
-:READ-WRITE - ready to read and write
-:WRITE - ready to write"))
-
-(defmethod socket-state ((socket usocket))
- (state socket))
-
-(defclass stream-usocket (usocket)
- ((stream
- :initarg :stream
- :accessor socket-stream
- :documentation "Stream instance associated with the socket."
-;;
-;;Iff an external-format was passed to `socket-connect' or `socket-listen'
-;;the stream is a flexi-stream. Otherwise the stream is implementation
-;;specific."
-))
- (:documentation
-"Stream socket class.
-'
-Contrary to other sockets, these sockets may be closed either
-with the `socket-close' method or by closing the associated stream
-(which can be retrieved with the `socket-stream' accessor)."))
-
-(defclass stream-server-usocket (usocket)
- ((element-type
- :initarg :element-type
- :initform #-lispworks 'character
- #+lispworks 'base-char
- :reader element-type
- :documentation "Default element type for streams created by
-`socket-accept'."))
- (:documentation "Socket which listens for stream connections to
-be initiated from remote sockets."))
-
-(defclass datagram-usocket (usocket)
- ((connected-p :type boolean
- :accessor connected-p
- :initarg :connected-p)
- #+(or cmu scl lispworks mcl
- (and clisp ffi (not rawsock)))
- (%open-p :type boolean
- :accessor %open-p
- :initform t
- :documentation "Flag to indicate if usocket is open,
-for GC on implementions operate on raw socket fd.")
- #+(or lispworks mcl
- (and clisp ffi (not rawsock)))
- (recv-buffer :documentation "Private RECV buffer.")
- #+(or lispworks mcl)
- (send-buffer :documentation "Private SEND buffer."))
- (:documentation "UDP (inet-datagram) socket"))
-
-(defun usocket-p (socket)
- (typep socket 'usocket))
-
-(defun stream-usocket-p (socket)
- (typep socket 'stream-usocket))
-
-(defun stream-server-usocket-p (socket)
- (typep socket 'stream-server-usocket))
-
-(defun datagram-usocket-p (socket)
- (typep socket 'datagram-usocket))
-
-(defun make-socket (&key socket)
- "Create a usocket socket type from implementation specific socket."
- (unless socket
- (error 'invalid-socket-error))
- (make-stream-socket :socket socket))
-
-(defun make-stream-socket (&key socket stream)
- "Create a usocket socket type from implementation specific socket
-and stream objects.
-
-Sockets returned should be closed using the `socket-close' method or
-by closing the stream associated with the socket.
-"
- (unless socket
- (error 'invalid-socket-error))
- (unless stream
- (error 'invalid-socket-stream-error))
- (make-instance 'stream-usocket
- :socket socket
- :stream stream))
-
-(defun make-stream-server-socket (socket &key (element-type
- #-lispworks 'character
- #+lispworks 'base-char))
- "Create a usocket-server socket type from an
-implementation-specific socket object.
-
-The returned value is a subtype of `stream-server-usocket'.
-"
- (unless socket
- (error 'invalid-socket-error))
- (make-instance 'stream-server-usocket
- :socket socket
- :element-type element-type))
-
-(defun make-datagram-socket (socket &key connected-p)
- (unless socket
- (error 'invalid-socket-error))
- (make-instance 'datagram-usocket
- :socket socket
- :connected-p connected-p))
-
-(defgeneric socket-accept (socket &key element-type)
- (:documentation
- "Accepts a connection from `socket', returning a `stream-socket'.
-
-The stream associated with the socket returned has `element-type' when
-explicitly specified, or the element-type passed to `socket-listen' otherwise."))
-
-(defgeneric socket-close (usocket)
- (:documentation "Close a previously opened `usocket'."))
-
-;; also see http://stackoverflow.com/questions/4160347/close-vs-shutdown-socket
-(defgeneric socket-shutdown (usocket direction)
- (:documentation "Shutdown communication on the socket in DIRECTION.
-
-After a shutdown no input and/or output of the indicated DIRECTION
-can be performed on the `usocket'.
-
-DIRECTION should be either :INPUT or :OUTPUT or :IO"))
-
-(defgeneric socket-send (usocket buffer length &key host port)
- (:documentation "Send packets through a previously opend `usocket'."))
-
-(defgeneric socket-receive (usocket buffer length &key)
- (:documentation "Receive packets from a previously opend `usocket'.
-
-Returns 4 values: (values buffer size host port)"))
-
-(defgeneric get-local-address (socket)
- (:documentation "Returns the IP address of the socket."))
-
-(defgeneric get-peer-address (socket)
- (:documentation
- "Returns the IP address of the peer the socket is connected to."))
-
-(defgeneric get-local-port (socket)
- (:documentation "Returns the IP port of the socket.
-
-This function applies to both `stream-usocket' and `server-stream-usocket'
-type objects."))
-
-(defgeneric get-peer-port (socket)
- (:documentation "Returns the IP port of the peer the socket to."))
-
-(defgeneric get-local-name (socket)
- (:documentation "Returns the IP address and port of the socket as values.
-
-This function applies to both `stream-usocket' and `server-stream-usocket'
-type objects."))
-
-(defgeneric get-peer-name (socket)
- (:documentation
- "Returns the IP address and port of the peer
-the socket is connected to as values."))
-
-(defmacro with-connected-socket ((var socket) &body body)
- "Bind `socket' to `var', ensuring socket destruction on exit.
-
-`body' is only evaluated when `var' is bound to a non-null value.
-
-The `body' is an implied progn form."
- `(let ((,var ,socket))
- (unwind-protect
- (when ,var
- (with-mapped-conditions (,var)
- ,@body))
- (when ,var
- (socket-close ,var)))))
-
-(defmacro with-client-socket ((socket-var stream-var &rest socket-connect-args)
- &body body)
- "Bind the socket resulting from a call to `socket-connect' with
-the arguments `socket-connect-args' to `socket-var' and if `stream-var' is
-non-nil, bind the associated socket stream to it."
- `(with-connected-socket (,socket-var (socket-connect ,@socket-connect-args))
- ,(if (null stream-var)
- `(progn ,@body)
- `(let ((,stream-var (socket-stream ,socket-var)))
- ,@body))))
-
-(defmacro with-server-socket ((var server-socket) &body body)
- "Bind `server-socket' to `var', ensuring socket destruction on exit.
-
-`body' is only evaluated when `var' is bound to a non-null value.
-
-The `body' is an implied progn form."
- `(with-connected-socket (,var ,server-socket)
- ,@body))
-
-(defmacro with-socket-listener ((socket-var &rest socket-listen-args)
- &body body)
- "Bind the socket resulting from a call to `socket-listen' with arguments
-`socket-listen-args' to `socket-var'."
- `(with-server-socket (,socket-var (socket-listen ,@socket-listen-args))
- ,@body))
-
-(defstruct (wait-list (:constructor %make-wait-list))
- %wait ;; implementation specific
- waiters ;; the list of all usockets
- map) ;; maps implementation sockets to usockets
-
-;; Implementation specific:
-;;
-;; %setup-wait-list
-;; %add-waiter
-;; %remove-waiter
-
-(defun make-wait-list (waiters)
- (let ((wl (%make-wait-list)))
- (setf (wait-list-map wl) (make-hash-table))
- (%setup-wait-list wl)
- (dolist (x waiters wl)
- (add-waiter wl x))))
-
-(defun add-waiter (wait-list input)
- (setf (gethash (socket input) (wait-list-map wait-list)) input
- (wait-list input) wait-list)
- (pushnew input (wait-list-waiters wait-list))
- (%add-waiter wait-list input))
-
-(defun remove-waiter (wait-list input)
- (%remove-waiter wait-list input)
- (setf (wait-list-waiters wait-list)
- (remove input (wait-list-waiters wait-list))
- (wait-list input) nil)
- (remhash (socket input) (wait-list-map wait-list)))
-
-(defun remove-all-waiters (wait-list)
- (dolist (waiter (wait-list-waiters wait-list))
- (%remove-waiter wait-list waiter))
- (setf (wait-list-waiters wait-list) nil)
- (clrhash (wait-list-map wait-list)))
-
-(defun wait-for-input (socket-or-sockets &key timeout ready-only)
- "Waits for one or more streams to become ready for reading from
-the socket. When `timeout' (a non-negative real number) is
-specified, wait `timeout' seconds, or wait indefinitely when
-it isn't specified. A `timeout' value of 0 (zero) means polling.
-
-Returns two values: the first value is the list of streams which
-are readable (or in case of server streams acceptable). NIL may
-be returned for this value either when waiting timed out or when
-it was interrupted (EINTR). The second value is a real number
-indicating the time remaining within the timeout period or NIL if
-none.
-
-Without the READY-ONLY arg, WAIT-FOR-INPUT will return all sockets in
-the original list you passed it. This prevents a new list from being
-consed up. Some users of USOCKET were reluctant to use it if it
-wouldn't behave that way, expecting it to cost significant performance
-to do the associated garbage collection.
-
-Without the READY-ONLY arg, you need to check the socket STATE slot for
-the values documented in usocket.lisp in the usocket class."
-
- ;; for NULL sockets, return NIL with respect of TIMEOUT.
- (when (null socket-or-sockets)
- (when timeout
- (sleep timeout))
- (return-from wait-for-input nil))
-
- (unless (wait-list-p socket-or-sockets)
- (let ((wl (make-wait-list (if (listp socket-or-sockets)
- socket-or-sockets (list socket-or-sockets)))))
- (multiple-value-bind
- (socks to)
- (wait-for-input wl :timeout timeout :ready-only ready-only)
- ;; NOTE: in case waiter is not created by the user, it should be removed here.
- (remove-all-waiters wl)
- (return-from wait-for-input
- (values (if ready-only socks socket-or-sockets) to)))))
- (let* ((start (get-internal-real-time))
- (sockets-ready 0))
- (dolist (x (wait-list-waiters socket-or-sockets))
- (when (setf (state x)
- #+(and win32 (or sbcl ecl)) nil ; they cannot rely on LISTEN
- #-(and win32 (or sbcl ecl))
- (if (and (stream-usocket-p x)
- (listen (socket-stream x)))
- :read
- nil))
- (incf sockets-ready)))
- ;; the internal routine is responsibe for
- ;; making sure the wait doesn't block on socket-streams of
- ;; which theready- socket isn't ready, but there's space left in the
- ;; buffer
- (wait-for-input-internal socket-or-sockets
- :timeout (if (zerop sockets-ready) timeout 0))
- (let ((to-result (when timeout
- (let ((elapsed (/ (- (get-internal-real-time) start)
- internal-time-units-per-second)))
- (when (< elapsed timeout)
- (- timeout elapsed))))))
- (values (if ready-only
- (remove-if #'null (wait-list-waiters socket-or-sockets) :key #'state)
- socket-or-sockets)
- to-result))))
-
-;;
-;; Data utility functions
-;;
-
-(defun integer-to-octet-buffer (integer buffer octets &key (start 0))
- (do ((b start (1+ b))
- (i (ash (1- octets) 3) ;; * 8
- (- i 8)))
- ((> 0 i) buffer)
- (setf (aref buffer b)
- (ldb (byte 8 i) integer))))
-
-(defun octet-buffer-to-integer (buffer octets &key (start 0))
- (let ((integer 0))
- (do ((b start (1+ b))
- (i (ash (1- octets) 3) ;; * 8
- (- i 8)))
- ((> 0 i)
- integer)
- (setf (ldb (byte 8 i) integer)
- (aref buffer b)))))
-
-(defmacro port-to-octet-buffer (port buffer &key (start 0))
- `(integer-to-octet-buffer ,port ,buffer 2 :start ,start))
-
-(defmacro ip-to-octet-buffer (ip buffer &key (start 0))
- `(integer-to-octet-buffer (host-byte-order ,ip) ,buffer 4 :start ,start))
-
-(defmacro port-from-octet-buffer (buffer &key (start 0))
- `(octet-buffer-to-integer ,buffer 2 :start ,start))
-
-(defmacro ip-from-octet-buffer (buffer &key (start 0))
- `(octet-buffer-to-integer ,buffer 4 :start ,start))
-
-;;
-;; IPv4 utility functions
-;;
-
-(defun list-of-strings-to-integers (list)
- "Take a list of strings and return a new list of integers (from
-parse-integer) on each of the string elements."
- (let ((new-list nil))
- (dolist (element (reverse list))
- (push (parse-integer element) new-list))
- new-list))
-
-(defun ip-address-string-p (string)
- "Return a true value if the given string could be an IP address."
- (every (lambda (char)
- (or (digit-char-p char)
- (eql char #\.)))
- string))
-
-(defun hbo-to-dotted-quad (integer) ; exported
- "Host-byte-order integer to dotted-quad string conversion utility."
- (let ((first (ldb (byte 8 24) integer))
- (second (ldb (byte 8 16) integer))
- (third (ldb (byte 8 8) integer))
- (fourth (ldb (byte 8 0) integer)))
- (format nil "~A.~A.~A.~A" first second third fourth)))
-
-(defun hbo-to-vector-quad (integer) ; exported
- "Host-byte-order integer to dotted-quad string conversion utility."
- (let ((first (ldb (byte 8 24) integer))
- (second (ldb (byte 8 16) integer))
- (third (ldb (byte 8 8) integer))
- (fourth (ldb (byte 8 0) integer)))
- (vector first second third fourth)))
-
-(defun vector-quad-to-dotted-quad (vector) ; exported
- (format nil "~A.~A.~A.~A"
- (aref vector 0)
- (aref vector 1)
- (aref vector 2)
- (aref vector 3)))
-
-(defun dotted-quad-to-vector-quad (string) ; exported
- (let ((list (list-of-strings-to-integers (split-sequence #\. string))))
- (vector (first list) (second list) (third list) (fourth list))))
-
-(defgeneric host-byte-order (address)) ; exported
-
-(defmethod host-byte-order ((string string))
- "Convert a string, such as 192.168.1.1, to host-byte-order,
-such as 3232235777."
- (let ((list (list-of-strings-to-integers (split-sequence #\. string))))
- (+ (* (first list) 256 256 256) (* (second list) 256 256)
- (* (third list) 256) (fourth list))))
-
-(defmethod host-byte-order ((vector vector)) ; IPv4 only
- "Convert a vector, such as #(192 168 1 1), to host-byte-order, such as
-3232235777."
- (+ (* (aref vector 0) 256 256 256) (* (aref vector 1) 256 256)
- (* (aref vector 2) 256) (aref vector 3)))
-
-(defmethod host-byte-order ((int integer))
- int) ; this assume input integer is already host-byte-order
-
-;;
-;; IPv6 utility functions
-;;
-
-(defun vector-to-ipv6-host (vector) ; exported
- (with-output-to-string (*standard-output*)
- (loop with zeros-collapsed-p
- with collapsing-zeros-p
- for i below 16 by 2
- for word = (+ (ash (aref vector i) 8)
- (aref vector (1+ i)))
- do (cond
- ((and (zerop word)
- (not collapsing-zeros-p)
- (not zeros-collapsed-p))
- (setf collapsing-zeros-p t))
- ((or (not (zerop word))
- zeros-collapsed-p)
- (when collapsing-zeros-p
- (write-string ":")
- (setf collapsing-zeros-p nil
- zeros-collapsed-p t))
- (format t "~:[~;:~]~X" (plusp i) word)))
- finally (when collapsing-zeros-p
- (write-string "::")))))
-
-(defun split-ipv6-address (string)
- (let ((pos 0)
- word
- double-colon-seen-p
- words-before-double-colon
- words-after-double-colon)
- (loop
- (multiple-value-setq (word pos) (parse-integer string :radix 16 :junk-allowed t :start pos))
- (labels ((at-end-p ()
- (= pos (length string)))
- (looking-at-colon-p ()
- (char= (char string pos) #\:))
- (ensure-colon ()
- (unless (looking-at-colon-p)
- (error "unsyntactic IPv6 address string ~S, expected a colon at position ~D"
- string pos))
- (incf pos)))
- (cond
- ((null word)
- (when double-colon-seen-p
- (error "unsyntactic IPv6 address string ~S, can only have one double-colon filler mark"
- string))
- (setf double-colon-seen-p t))
- (double-colon-seen-p
- (push word words-after-double-colon))
- (t
- (push word words-before-double-colon)))
- (if (at-end-p)
- (return (list (nreverse words-before-double-colon) (nreverse words-after-double-colon)))
- (ensure-colon))))))
-
-(defun ipv6-host-to-vector (string) ; exported
- (assert (> (length string) 2) ()
- "Unsyntactic IPv6 address literal ~S, expected at least three characters" string)
- (destructuring-bind (words-before-double-colon words-after-double-colon)
- (split-ipv6-address (concatenate 'string
- (when (eql (char string 0) #\:)
- "0")
- string
- (when (eql (char string (1- (length string))) #\:)
- "0")))
- (let ((number-of-words-specified (+ (length words-before-double-colon) (length words-after-double-colon))))
- (assert (<= number-of-words-specified 8) ()
- "Unsyntactic IPv6 address literal ~S, too many colon separated address components" string)
- (assert (or (= number-of-words-specified 8) words-after-double-colon) ()
- "Unsyntactic IPv6 address literal ~S, too few address components and no double-colon filler found" string)
- (loop with vector = (make-array 16 :element-type '(unsigned-byte 8))
- for i below 16 by 2
- for word in (append words-before-double-colon
- (make-list (- 8 number-of-words-specified) :initial-element 0)
- words-after-double-colon)
- do (setf (aref vector i) (ldb (byte 8 8) word)
- (aref vector (1+ i)) (ldb (byte 8 0) word))
- finally (return vector)))))
-
-(defun host-to-hostname (host) ; host -> string
- "Translate a string, vector quad or 16 byte IPv6 address to a
-stringified hostname."
- (etypecase host
- (string host) ; IPv4 or IPv6
- ((or (vector t 4) ; IPv4
- (array (unsigned-byte 8) (4)))
- (vector-quad-to-dotted-quad host))
- ((or (vector t 16) ; IPv6
- (array (unsigned-byte 8) (16)))
- (vector-to-ipv6-host host))
- (integer (hbo-to-dotted-quad host)) ; integer input is IPv4 only
- (null "0.0.0.0"))) ; null is IPv4
-
-(defun ip= (ip1 ip2) ; exported
- (etypecase ip1
- (string (string= ip1 ; IPv4 or IPv6
- (host-to-hostname ip2)))
- ((or (vector t 4) ; IPv4
- (array (unsigned-byte 8) (4)) ; IPv4
- (vector t 16) ; IPv6
- (array (unsigned-byte 8) (16))) ; IPv6
- (equalp ip1 ip2))
- (integer (= ip1 ; IPv4 only
- (host-byte-order ip2))))) ; convert ip2 to integer (hbo)
-
-(defun ip/= (ip1 ip2) ; exported
- (not (ip= ip1 ip2)))
-
-;;
-;; DNS helper functions
-;;
-
-(defun get-host-by-name (name)
- "0.7.1+: if there're IPv4 addresses, return the first IPv4 address."
- (let* ((hosts (get-hosts-by-name name))
- (pos (position-if #'(lambda (ip) (= 4 (length ip))) hosts)))
- (if pos (elt hosts pos)
- (car hosts))))
-
-(defun get-random-host-by-name (name)
- "0.7.1+: if there're IPv4 addresses, only return a random IPv4 address."
- (let* ((hosts (get-hosts-by-name name))
- (ipv4-hosts (remove-if-not #'(lambda (ip) (= 4 (length ip))) hosts)))
- (cond (ipv4-hosts
- (elt ipv4-hosts (random (length ipv4-hosts))))
- (hosts
- (elt hosts (random (length hosts)))))))
-
-(defun host-to-vector-quad (host) ; internal
- "Translate a host specification (vector quad, dotted quad or domain name)
-to a vector quad."
- (etypecase host
- (string (let* ((ip (when (ip-address-string-p host)
- (dotted-quad-to-vector-quad host))))
- (if (and ip (= 4 (length ip)))
- ;; valid IP dotted quad? not sure
- ip
- (get-random-host-by-name host))))
- ((or (vector t 4)
- (array (unsigned-byte 8) (4)))
- host)
- (integer (hbo-to-vector-quad host))))
-
-(defun host-to-hbo (host) ; internal
- (etypecase host
- (string (let ((ip (when (ip-address-string-p host)
- (dotted-quad-to-vector-quad host))))
- (if (and ip (= 4 (length ip)))
- (host-byte-order ip)
- (host-to-hbo (get-host-by-name host)))))
- ((or (vector t 4)
- (array (unsigned-byte 8) (4)))
- (host-byte-order host))
- (integer host)))
-
-;;
-;; Other utility functions
-;;
-
-(defun split-timeout (timeout &optional (fractional 1000000))
- "Split real value timeout into seconds and microseconds.
-Optionally, a different fractional part can be specified."
- (multiple-value-bind
- (secs sec-frac)
- (truncate timeout 1)
- (values secs
- (truncate (* fractional sec-frac) 1))))
-
-;;
-;; Setting of documentation for backend defined functions
-;;
-
-;; Documentation for the function
-;;
-;; (defun SOCKET-CONNECT (host port &key element-type nodelay some-other-keys...) ..)
-;;
-(setf (documentation 'socket-connect 'function)
- "Connect to `host' on `port'. `host' is assumed to be a string or
-an IP address represented in vector notation, such as #(192 168 1 1).
-`port' is assumed to be an integer.
-
-`element-type' specifies the element type to use when constructing the
-stream associated with the socket. The default is 'character.
-
-`nodelay' Allows to disable/enable Nagle's algorithm (http://en.wikipedia.org/wiki/Nagle%27s_algorithm).
-If this parameter is omitted, the behaviour is inherited from the
-CL implementation (in most cases, Nagle's algorithm is
-enabled by default, but for example in ACL it is disabled).
-If the parameter is specified, one of these three values is possible:
- T - Disable Nagle's algorithm; signals an UNSUPPORTED
- condition if the implementation does not support explicit
- manipulation with that option.
- NIL - Leave Nagle's algorithm enabled on the socket;
- signals an UNSUPPORTED condition if the implementation does
- not support explicit manipulation with that option.
- :IF-SUPPORTED - Disables Nagle's algorithm if the implementation
- allows this, otherwises just ignore this option.
-
-Returns a usocket object.")
-
-;; Documentation for the function
-;;
-;; (defun SOCKET-LISTEN (host port &key reuseaddress backlog element-type) ..)
-;;###FIXME: extend with default-element-type
-(setf (documentation 'socket-listen 'function)
- "Bind to interface `host' on `port'. `host' should be the
-representation of an ready-interface address. The implementation is
-not required to do an address lookup, making no guarantees that
-hostnames will be correctly resolved. If `*wildcard-host*' or NIL is
-passed for `host', the socket will be bound to all available
-interfaces for the system. `port' can be selected by the IP stack by
-passing `*auto-port*'.
-
-Returns an object of type `stream-server-usocket'.
-
-`reuse-address' and `backlog' are advisory parameters for setting socket
-options at creation time. `element-type' is the element type of the
-streams to be created by `socket-accept'. `reuseaddress' is supported for
-backward compatibility (but deprecated); when both `reuseaddress' and
-`reuse-address' have been specified, the latter takes precedence.
-")
-
-;;; Small utility functions mapping true/false to 1/0, moved here from option.lisp
-
-(proclaim '(inline bool->int int->bool))
-
-(defun bool->int (bool) (if bool 1 0))
-(defun int->bool (int) (= 1 int))
(DIR) diff --git a/3rdparties/software/usocket-0.7.1/vendor/OpenTransportUDP.lisp b/3rdparties/software/usocket-0.7.1/vendor/OpenTransportUDP.lisp
@@ -1,146 +0,0 @@
-;;;-*-Mode: LISP; Package: CCL -*-
-;;
-;;; OpenTransportUDP.lisp
-;;; Copyright 2012 Chun Tian (binghe) <binghe.lisp@gmail.com>
-
-;;; UDP extension to OpenTransport.lisp (with some TCP patches)
-
-(in-package "CCL")
-
-(eval-when (:compile-toplevel :load-toplevel :execute)
- (require :opentransport))
-
-;; MCL Issue 28: Passive TCP streams should be able to listen to the loopback interface
-;; see http://code.google.com/p/mcl/issues/detail?id=28 for details
-
-(defparameter *passive-interface-address* NIL
- "Address to use for passive connections - optionally bind to loopback address while opening a tcp stream")
-
-(advise local-interface-ip-address
- (or *passive-interface-address* (:do-it))
- :when :around :name 'override-local-interface-ip-address)
-
-;; MCL Issue 29: Passive TCP connections on OS assigned ports
-;; see http://code.google.com/p/mcl/issues/detail?id=29 for details
-(advise ot-conn-tcp-passive-connect
- (destructuring-bind (conn port &optional (allow-reuse t)) arglist
- (declare (ignore allow-reuse))
- (if (eql port #$kOTAnyInetAddress)
- ;; Avoids registering a proxy for port 0 but instead registers one for the true port:
- (multiple-value-bind (proxy result)
- (let* ((*opentransport-class-proxies* NIL) ; makes ot-find-proxy return NIL
- (result (:do-it)) ;; pushes onto *opentransport-class-proxies*
- (proxy (prog1
- (pop *opentransport-class-proxies*)
- (assert (not *opentransport-class-proxies*))))
- (context (cdr proxy))
- (tmpconn (make-ot-conn :context context
- :endpoint (pref context :ot-context.ref)))
- (localaddress (ot-conn-tcp-get-addresses tmpconn)))
- (declare (dynamic-extent tmpconn))
- ;; replace original set in body of function
- (setf (ot-conn-local-address conn) localaddress)
- (values
- (cons localaddress context)
- result))
- ;; need to be outside local binding of *opentransport-class-proxies*
- (without-interrupts
- (push proxy *opentransport-class-proxies*))
- result)
- (:do-it)))
- :when :around :name 'ot-conn-tcp-passive-connect-any-address)
-
-(defun open-udp-socket (&key local-address local-port)
- (init-opentransport)
- (let (endpoint ; TODO: opentransport-alloc-endpoint-from-freelist
- (err #$kOTNoError)
- (configptr (ot-cloned-configuration traps::$kUDPName)))
- (rlet ((errP :osstatus))
- (setq endpoint #+carbon-compat (#_OTOpenEndpointInContext configptr 0 (%null-ptr) errP *null-ptr*)
- #-carbon-compat (#_OTOpenEndpoint configptr 0 (%null-ptr) errP)
- err (pref errP :osstatus))
- (if (eql err #$kOTNoError)
- (let* ((context (ot-make-endpoint-context endpoint nil nil)) ; no notifier, not minimal
- (conn (make-ot-conn :context context :endpoint endpoint)))
- (macrolet ((check-ot-error-return (error-context)
- `(unless (eql (setq err (pref errP :osstatus)) #$kOTNoError)
- (values (ot-error err ,error-context)))))
- (setf (ot-conn-bindreq conn)
- #-carbon-compat (#_OTAlloc endpoint #$T_BIND #$T_ADDR errP)
- #+carbon-compat (#_OTAllocInContext endpoint #$T_BIND #$T_ADDR errP *null-ptr*)
- )
- (check-ot-error-return :alloc)
- (setf (ot-conn-bindret conn)
- #-carbon-compat (#_OTAlloc endpoint #$T_BIND #$T_ADDR errP)
- #+carbon-compat (#_OTAllocInContext endpoint #$T_BIND #$T_ADDR errP *null-ptr*)
- )
- (check-ot-error-return :alloc)
- (setf (ot-conn-options conn)
- #-carbon-compat (#_OTAlloc endpoint #$T_OPTMGMT #$T_OPT errP)
- #+carbon-compat (#_OTAllocInContext endpoint #$T_OPTMGMT #$T_OPT errP *null-ptr*)
- )
- (check-ot-error-return :alloc))
- ;; BIND to local address (for UDP server)
- (when local-port ; local-address
- (let* ((host (or local-address (local-interface-ip-address)))
- (port (tcp-service-port-number local-port))
- (localaddress `(:tcp ,host ,port))
- (bindreq (ot-conn-bindreq conn))
- (bindret (ot-conn-bindret conn)))
- (let* ((netbuf (pref bindreq :tbind.addr)))
- (declare (dynamic-extent netbuf))
- (setf (pref netbuf :tnetbuf.len) (record-length :inetaddress)
- (pref bindreq :tbind.qlen) 5) ; arbitrary qlen
- (#_OTInitInetAddress (pref netbuf :tnetbuf.buf) port host)
- (setf (pref context :ot-context.completed) nil)
- (unless (= (setq err (#_OTBind endpoint bindreq bindret)) #$kOTNoError)
- (ot-error err :bind)))
- (setf (ot-conn-local-address conn) localaddress)))
- conn)
- (ot-error err :create)))))
-
-(defun make-TUnitData (endpoint)
- "create the send/recv buffer for UDP sockets"
- (let ((err #$kOTNoError))
- (rlet ((errP :osstatus))
- (macrolet ((check-ot-error-return (error-context)
- `(unless (eql (setq err (pref errP :osstatus)) #$kOTNoError)
- (values (ot-error err ,error-context)))))
- (let ((udata #-carbon-compat (#_OTAlloc endpoint #$T_UNITDATA #$T_ALL errP)
- #+carbon-compat (#_OTAllocInContext endpoint #$T_UNITDATA #$T_ALL errP *null-ptr*)))
- (check-ot-error-return :alloc)
- udata)))))
-
-(defun send-message (conn data buffer size host port &optional (offset 0))
- ;; prepare dest address
- (let ((addr (pref data :tunitdata.addr)))
- (declare (dynamic-extent addr))
- (setf (pref addr :tnetbuf.len) (record-length :inetaddress))
- (#_OTInitInetAddress (pref addr :tnetbuf.buf) port host))
- ;; prepare data buffer
- (let* ((udata (pref data :tunitdata.udata))
- (outptr (pref udata :tnetbuf.buf)))
- (declare (dynamic-extent udata))
- (%copy-ivector-to-ptr buffer offset outptr 0 size)
- (setf (pref udata :tnetbuf.len) size))
- ;; send the packet
- (let* ((endpoint (ot-conn-endpoint conn))
- (result (#_OTSndUData endpoint data)))
- (the fixnum result)))
-
-(defun receive-message (conn data buffer length)
- (let* ((endpoint (ot-conn-endpoint conn))
- (err (#_OTRcvUData endpoint data *null-ptr*)))
- (if (eql err #$kOTNoError)
- (let* (;(addr (pref data :tunitdata.addr))
- (udata (pref data :tunitdata.udata))
- (inptr (pref udata :tnetbuf.buf))
- (read-bytes (pref udata :tnetbuf.len))
- (buffer (or buffer (make-array read-bytes :element-type '(unsigned-byte 8))))
- (length (or length (length buffer)))
- (actual-size (min read-bytes length)))
- (%copy-ptr-to-ivector inptr 0 buffer 0 actual-size)
- (values buffer
- actual-size
- 0 0)) ; TODO: retrieve address and port
- (ot-error err :receive)))) ; TODO: use OTRcvUDErr instead
(DIR) diff --git a/3rdparties/software/usocket-0.7.1/vendor/kqueue.lisp b/3rdparties/software/usocket-0.7.1/vendor/kqueue.lisp
@@ -1,506 +0,0 @@
-;;;-*-Mode: LISP; Package: CCL -*-
-;;
-;; KQUEUE.LISP
-;;
-;; KQUEUE - BSD kernel event notification mechanism support for Common LISP.
-;; Copyright (C) 2007 Terje Norderhaug <terje@in-progress.com>
-;; Released under LGPL - see <http://www.gnu.org>.
-;; Alternative licensing available upon request.
-;;
-;; DISCLAIMER: The user of this module should understand that executing code is a potentially hazardous
-;; activity, and that many dangers and obstacles, marked or unmarked, may exist within this code.
-;; As a condition of your use of the module, you assume all risk of personal injury, death, or property
-;; loss, and all other bad things that may happen, even if caused by negligence, ignorance or stupidity.
-;; The author is is no way responsible, and besides, does not have "deep pockets" nor any spare change.
-;;
-;; Version: 0.20 alpha (July 26, 2009) - subject to major revisions, so consider yourself warned.
-;; Tested with Macintosh Common LISP 5.1 and 5.2, but is intended to be platform and system independent in the future.
-;;
-;; Email feedback and improvements to <terje@in-progress.com>.
-;; Updated versions will be available from <http://www.in-progress.com/src/>.
-;;
-;; RELATED IMPLEMENTATIONS
-;; There is another kevent.lisp for other platforms by Risto Laakso (merge?).
-;; Also a Scheme kevent.ss by Jose Antonio Ortega.
-;;
-;; SEE ALSO:
-;; http://people.freebsd.org/~jlemon/papers/kqueue.pdf
-;; http://developer.apple.com/samplecode/FileNotification/index.html
-;; The Man page for kqueue() or kevent().
-;; PyKQueue - Python OO interface to KQueue.
-;; LibEvent - an event notification library in C by Niels Provos.
-;; Liboop - another abstract library in C on top of kevent or other kernel notification.
-
-#| HISTORY:
-
-2007-Oct-18 terje version 0.1 released on the Info-MCL mailing list.
-2008-Aug-21 terje load-framework-bundle is not needed under MCL 5.2
-2008-Aug-21 terje rename get-addr to lookup-function-in-bundle (only for pre MCL 5.2)
-2009-Jul-19 terje uses kevent-error condition and strerror.
-2009-Jul-24 terje reports errors unless nil-if-not-found in lookup-function-in-bundle.
-2009-Jul-24 terje kevent :variant for C's intptr_t type for 64bit (and osx 10.5) compatibility.
-2009-Jul-25 terje 64bit support, dynamically determined for PPC. Kudos to Glen Foy for helping out.
-2009-Jul-25 terje make-kevent function.
-|#
-
-#| IMPLEMENTATION NOTES:
-
-kevents are copied into and from the kernel, so the records don't have to be kept in the app!
-kevents does not work in OSX before 10.3.
-*kevent-record* has to be explcitly set to :kevent64 to work on 64bit intel macs.
-Consider using sysctlbyname() to test for 64bit,
- combining hw.cpu64bit_capable, hw.optional.x86_64 and hw.optional.64bitops
-|#
-
-(in-package :ccl)
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-#-ccl-5.2 ; has been added to MCL 5.2
-(defmethod load-framework-bundle ((framework-name string) &key (load-executable t))
- ;; FRAMWORK CALL FUNCTIONALITY FROM BSD.LISP
- ;; (C) 2003 Brendan Burns <bburns@cs.umass.edu>
- ;; Released under LGPL.
- (with-cfstrs ((framework framework-name))
- (let ((err 0)
- (baseURL nil)
- (bundleURL nil)
- (result nil))
- (rlet ((folder :fsref))
- ;; Find the folder holding the bundle
- (setf err (#_FSFindFolder #$kOnAppropriateDisk #$kFrameworksFolderType
- t folder))
-
- ;; if everything's cool, make a URL for it
- (when (zerop err)
- (setf baseURL (#_CFURLCreateFromFSRef (%null-ptr) folder))
- (if (%null-ptr-p baseURL)
- (setf err #$coreFoundationUnknownErr)))
-
- ;; if everything's cool, make a URL for the bundle
- (when (zerop err)
- (setf bundleURL (#_CFURLCreateCopyAppendingPathComponent (%null-ptr)
- baseURL framework nil))
- (if (%null-ptr-p bundleURL)
- (setf err #$coreFoundationUnknownErr)))
-
- ;; if everything's cool, load it
- (when (zerop err)
- (setf result (#_CFBundleCreate (%null-ptr) bundleURL))
- (if (%null-ptr-p result)
- (setf err #$coreFoundationUnknownErr)))
-
- ;; if everything's cool, and the user wants it loaded, load it
- (when (and load-executable (zerop err))
- (if (not (#_CFBundleLoadExecutable result))
- (setf err #$coreFoundationUnknownErr)))
-
- ;; if there's an error, but we've got a pointer, free it and clear result
- (when (and (not (zerop err)) (not (%null-ptr-p result)))
- (#_CFRelease result)
- (setf result nil))
-
- ;; free the URLs if there non-null
- (when (not (%null-ptr-p bundleURL))
- (#_CFRelease bundleURL))
- (when (not (%null-ptr-p baseURL))
- (#_CFRelease baseURL))
-
- ;; return pointer + error value
- (values result err)))))
-
-#+ignore
-(defun get-addr (bundle name)
- (let* ((addr (#_CFBundleGetFunctionPointerForName bundle name)))
- (rlet ((buf :long))
- (setf (%get-ptr buf) addr)
- (ash (%get-signed-long buf) -2))))
-
-#-ccl-5.2
-(defun lookup-function-in-bundle (name bundle &optional nil-if-not-found)
- (with-cfstrs ((str name))
- (let* ((addr (#_CFBundleGetFunctionPointerForName bundle str)))
- (if (%null-ptr-p addr)
- (unless nil-if-not-found
- (error "Couldn't resolve address of foreign function ~s" name))
- (rlet ((buf :long)) ;; mcl 5.2 uses %fixnum-from-macptr here
- (setf (%get-ptr buf) addr)
- (ash (%get-signed-long buf) -2))))))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Convenient way to declare BSD system calls
-
-#+ignore
-(defparameter *system-bundle*
- #+ccl-5.2 (get-bundle-for-framework-name "System.framework")
- #-ccl-5.2
- (let ((bundle (load-framework-bundle "System.framework")))
- (terminate-when-unreachable bundle (lambda (b)(#_CFRelease b)))
- bundle))
-
-(defmacro declare-bundle-ff (name name-string &rest arglist &aux (fn (gensym (format nil "ff_~A_" (string name)))))
- ;; Is there an existing define-trap like macro for this? or could one be modified for use with bundles?
- `(progn
- (defloadvar ,fn
- (let* ((bundle #+ccl-5.2 (get-bundle-for-framework-name "System.framework")
- #-ccl-5.2
- (let ((bundle (load-framework-bundle "System.framework")))
- (terminate-when-unreachable bundle (lambda (b)(#_CFRelease b)))
- bundle)))
- (lookup-function-in-bundle ,name-string bundle)))
- ,(let ((args (do ((arglist arglist (cddr arglist))
- (result))
- ((not (cdr arglist)) (nreverse result))
- (push (second arglist) result))))
- `(defun ,name ,args
- (ppc-ff-call ,fn ,@arglist)))))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(declare-bundle-ff %system-kqueue "kqueue"
- :signed-fullword) ;; returns a file descriptor no!
-
-(defun system-kqueue ()
- (let ((kq (%system-kqueue)))
- (if (= kq -1)
- (ecase (%system-errno)
- (12 (error "The kernel failed to allocate enough memory for the kernel queue")) ; ENOMEM
- (24 (error "The per-process descriptor table is full")) ; EMFILE
- (23 (error "The system file table is full"))) ; ENFILE
- kq)))
-
-(declare-bundle-ff %system-kevent "kevent"
- :unsigned-fullword kq
- :address ke
- :unsigned-fullword nke
- :address ko
- :unsigned-fullword nko
- :address timeout
- :signed-fullword)
-
-(declare-bundle-ff %system-open "open"
- :address name
- :unsigned-fullword mode
- :unsigned-fullword arg
- :signed-fullword)
-
-(declare-bundle-ff %system-close "close"
- :unsigned-fullword fd
- :signed-fullword)
-
-(declare-bundle-ff %system-errno* "__error"
- :signed-fullword)
-
-(declare-bundle-ff %system-strerror "strerror"
- :signed-fullword errno
- :address)
-
-(defun %system-errno ()
- (%get-fixnum (%int-to-ptr (%system-errno*))))
-
-; (%system-errno)
-
-(defconstant $O-EVTONLY #x8000)
-; (defconstant $O-NONBLOCK #x800 "Non blocking mode")
-
-(defun system-open (posix-namestring)
- "Low level open function, as in C, returns an fd number"
- (with-cstrs ((name posix-namestring))
- (%system-open name $O-EVTONLY 0)))
-
-(defun system-close (fd)
- (%system-close fd))
-
-(defrecord timespec
- (sec :unsigned-long)
- (usec :unsigned-long))
-
-(defVar *kevent-record* nil)
-
-(def-ccl-pointers determine-64bit-kevents ()
- (setf *kevent-record*
- (if (ccl::gestalt #$gestaltPowerPCProcessorFeatures
- #+ccl-5.2 #$gestaltPowerPCHas64BitSupport #-ccl-5.2 6)
- :kevent32
- :kevent64)))
-
-(defrecord :kevent32
- (ident :unsigned-long) ; uintptr_t
- (filter :short)
- (flags :unsigned-short)
- (fflags :unsigned-long)
- (data :long) ; intptr_t
- (udata :pointer))
-
-(defrecord :kevent64
- (:variant ; uintptr_t
- ((ident64 :uint64))
- ((ident :unsigned-long)))
- (filter :short)
- (flags :unsigned-short)
- (fflags :unsigned-long)
- (:variant ; intptr_t
- ((data64 :sint64))
- ((data :long)))
- (:variant ; RMCL :pointer is 32bit
- ((udata64 :uint64))
- ((udata :pointer))))
-
-(defun make-kevent (&key (ident 0) (filter 0) (flags 0) (fflags 0) (data 0) (udata *null-ptr*))
- (ecase *kevent-record*
- (:kevent64
- (make-record kevent64
- :ident ident
- :filter filter
- :flags flags
- :fflags fflags
- :data data
- :udata udata))
- (:kevent32
- (make-record kevent32
- :ident ident
- :filter filter
- :flags flags
- :fflags fflags
- :data data
- :udata udata))))
-
-(defun kevent-rref (ke field)
- (ecase *kevent-record*
- (:kevent32
- (ecase field
- (:ident (rref ke :kevent32.ident))
- (:filter (rref ke :kevent32.filter))
- (:flags (rref ke :kevent32.flags))
- (:fflags (rref ke :kevent32.fflags))
- (:data (rref ke :kevent32.data))
- (:udata (rref ke :kevent32.udata))))
- (:kevent64
- (ecase field
- (:ident (rref ke :kevent64.ident))
- (:filter (rref ke :kevent64.filter))
- (:flags (rref ke :kevent64.flags))
- (:fflags (rref ke :kevent64.fflags))
- (:data (rref ke :kevent64.data))
- (:udata (rref ke :kevent64.udata))))))
-
-(defun kevent-filter (ke)
- (kevent-rref ke :filter))
-
-(defun kevent-flags (ke)
- (kevent-rref ke :flags))
-
-(defun kevent-data (ke)
- (kevent-rref ke :data))
-
-
-;; FILTER TYPES:
-
-(eval-when (:compile-toplevel :load-toplevel :execute) ; added by binghe
-
-(defconstant $kevent-read-filter -1 "Data available to read")
-(defconstant $kevent-write-filter -2 "Writing is possible")
-(defconstant $kevent-aio-filter -3 "AIO system call has been made")
-(defconstant $kevent-vnode-filter -4 "Event occured on a file descriptor")
-(defconstant $kevent-proc-filter -5 "Process performed one or more of the requested events")
-(defconstant $kevent-signal-filter -6 "Attempted to deliver a signal to a process")
-(defconstant $kevent-timer-filter -7 "Establishes an arbitrary timer")
-(defconstant $kevent-netdev-filter -8 "Event occured on a network device")
-(defconstant $kevent-filesystem-filter -9)
-
-) ; eval-when
-
-; FLAGS:
-
-(defconstant $kevent-add #x01)
-(defconstant $kevent-delete #x02)
-(defconstant $kevent-enable #x04)
-(defconstant $kevent-disable #x08)
-(defconstant $kevent-oneshot #x10)
-(defconstant $kevent-clear #x20)
-(defconstant $kevent-error #x4000)
-(defconstant $kevent-eof #x8000 "EV_EOF")
-
-;; FFLAGS:
-
-(defconstant $kevent-file-delete #x01 "The file was unlinked from the file system")
-(defconstant $kevent-file-write #x02 "A write occurred on the file")
-(defconstant $kevent-file-extend #x04 "The file was extended")
-(defconstant $kevent-file-attrib #x08 "The file had its attributes changed")
-(defconstant $kevent-file-link #x10 "The link count on the file changed")
-(defconstant $kevent-file-rename #x20 "The file was renamed")
-(defconstant $kevent-file-revoke #x40 "Access to the file was revoked or the file system was unmounted")
-(defconstant $kevent-file-all (logior $kevent-file-delete $kevent-file-write $kevent-file-extend
- $kevent-file-attrib $kevent-file-link $kevent-file-rename $kevent-file-revoke))
-
-
-(defconstant $kevent-net-linkup #x01 "Link is up")
-(defconstant $kevent-net-linkdown #x02 "Link is down")
-(defconstant $kevent-net-linkinvalid #x04 "Link state is invalid")
-(defconstant $kevent-net-added #x08 "IP adress added")
-(defconstant $kevent-net-deleted #x10 "IP adress deleted")
-
-(define-condition kevent-error (simple-error)
- ((errno :initform NIL :initarg :errno)
- (ko :initform nil :type (or null kevent) :initarg :ko)
- (syserr :initform (%system-errno)))
- (:report
- (lambda (c s)
- (with-slots (errno ko syserr) c
- (format s "kevent system call error ~A [~A]" errno syserr)
- (when errno
- (format s "(~A)" (%get-cstring (%system-strerror errno))))
- (when ko
- (format s " for ")
- (let ((*standard-output* s))
- (print-record ko *kevent-record*)))))))
-
-(defun %kevent (kq &optional ke ko (timeout 0))
- (check-type kq integer)
- (rlet ((&timeout :timespec :sec timeout :usec 1))
- (let ((num (with-timer ;; does not seem to make a difference...
- (%system-kevent kq (or ke (%null-ptr))(if ke 1 0)(or ko (%null-ptr))(if ko 1 0) &timeout))))
- ; "If an error occurs while processing an element of the changelist and there
- ; is enough room in the eventlist, then the event will be placed in the eventlist with
- ; EV_ERROR set in flags and the system error in data."
- (when (and ko (plusp (logand $kevent-error (kevent-flags ko))))
- (error 'kevent-error
- :errno (kevent-data ko)
- :ko ko))
- ; "Otherwise, -1 will be returned, and errno will be set to indicate the error condition."
- (when (= num -1)
- ;; hack - opentransport provides the constants for the errors documented for the call
- (case (%system-errno)
- (0 (error "kevent system call failed with an unspecified error")) ;; should not happen!
- (13 (error "The process does not have permission to register a filter"))
- (14 (error "There was an error reading or writing the kevent structure")) ; EFAULT
- (9 (error "The specified descriptor is invalid")) ; EBADF
- (4 (error "A signal was delivered before the timeout expired and before any events were placed on the kqueue for return.")) ; EINTR
- (22 (error "The specified time limit or filter is invalid")) ; EINVAL
- (2 (error "The event could not be found to be modified or deleted")) ; ENOENT
- (12 (error "No memory was available to register the event")) ; ENOMEM
- (78 (error "The specified process to attach to does not exist"))) ; ESRCH
- ;; shouldn't get here...
- (errchk (%system-errno))
- (error "error ~A" (%system-errno)))
- (unless (zerop num)
- (values ko num)))))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; CLOS INTERFACE
-
-(defclass kqueue ()
- ((kq :initform (system-kqueue)
- :documentation "file descriptor referencing the kqueue")
- (fds :initform NIL)) ;; ## better if kept on top level, perhaps as a hash table...
- (:documentation "A kernal event notification channel"))
-
-(defmethod initialize-instance :after ((q kqueue) &rest rest)
- (declare (ignore rest))
- (terminate-when-unreachable q 'kqueue-close))
-
-(defmethod kqueue-close ((q kqueue))
- (with-slots (kq fds) q
- (when (or kq fds) ;; allow repeated close
- (system-close kq)
- (setf fds NIL)
- (setf kq NIL))))
-
-(defmethod kqueue-poll ((q kqueue))
- "Polls a kqueue for kevents"
- ;; may not have to be cleared, but just in case:
- (flet ((kqueue-poll2 (ko)
- (let ((result (with-slots (kq) q
- (without-interrupts
- (%kevent kq NIL ko)))))
- (when result
- (let ((type (kevent-filter result)))
- (ecase type
- (0 (values))
- (#.$kevent-read-filter
- (values
- :read
- (kevent-rref result :ident)
- (kevent-rref result :flags)
- (kevent-rref result :fflags)
- (kevent-rref result :data)
- (kevent-rref result :udata)))
- (#.$kevent-write-filter :write)
- (#.$kevent-aio-filter :aio)
- (#.$kevent-vnode-filter
- (values
- :vnode
- (cdr (assoc (kevent-rref result :ident) (slot-value q 'fds)))
- (kevent-rref result :flags)
- (kevent-rref result :fflags)
- (kevent-rref result :data)
- (kevent-rref result :udata)))
- (#.$kevent-filesystem-filter :filesystem)))))))
- (ecase *kevent-record*
- (:kevent64
- (rlet ((ko :kevent64 :ident 0 :filter 0 :flags 0 :fflags 0 :data 0 :udata (%null-ptr)))
- (kqueue-poll2 ko)))
- (:kevent32
- (rlet ((ko :kevent32 :ident 0 :filter 0 :flags 0 :fflags 0 :data 0 :udata (%null-ptr)))
- (kqueue-poll2 ko))))))
-
-(defmethod kqueue-subscribe ((q kqueue) &key ident filter (flags 0) (fflags 0) (data 0) (udata (%null-ptr)))
- (let ((ke (make-kevent :ident ident
- :filter filter
- :flags flags
- :fflags fflags
- :data data
- :udata udata)))
- (with-slots (kq) q
- (without-interrupts
- (%kevent kq ke)))))
-
-(defmethod kqueue-vnode-subscribe ((q kqueue) pathname)
- "Makes the queue report an event when there is a change to a directory or file"
- (let* ((namestring (posix-namestring (full-pathname pathname)))
- (fd (system-open namestring)))
- (with-slots (fds) q
- (push (cons fd pathname) fds))
- (kqueue-subscribe q
- :ident fd
- :filter $kevent-vnode-filter
- :flags (logior $kevent-add $kevent-clear)
- :fflags $kevent-file-all)
- namestring))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-#+test
-(defun kevent-d (pathname &optional (*standard-output* (fred)))
- "Report changes to a file or directory"
- (loop
- with kqueue = (make-instance 'kqueue)
- with sub = (kqueue-vnode-subscribe kqueue pathname)
- for i from 1 to 60
- for result = (multiple-value-list (kqueue-poll kqueue))
- unless (equal result '(NIL))
- do (progn
- (format T "~A~%" result)
- (force-output))
- ; do (process-allow-schedule)
- do (sleep 1)
- finally (write-line "Done")
- ))
-
-#|
-
-; Report changes to this file in a fred window (save this document to see what happens):
-
-(process-run-function "kevent-d" #'kevent-d *loading-file-source-file*
- (fred))
-
-; Reports files added or removed from the directory of this file:
-
-(process-run-function "kevent-d" #'kevent-d
- (make-pathname :directory (pathname-directory *loading-file-source-file*))
- (fred))
-|#
-
-
-
-
(DIR) diff --git a/3rdparties/software/usocket-0.7.1/version.sexp b/3rdparties/software/usocket-0.7.1/version.sexp
@@ -1 +0,0 @@
-"0.7.1"
(DIR) diff --git a/3rdparties/system-index.txt b/3rdparties/system-index.txt
@@ -1,27 +1,27 @@
-software/alexandria-20181210-git/alexandria-tests.asd
-software/alexandria-20181210-git/alexandria.asd
-software/babel-20171227-git/babel-streams.asd
-software/babel-20171227-git/babel-tests.asd
-software/babel-20171227-git/babel.asd
-software/bordeaux-threads-v0.8.6/bordeaux-threads.asd
-software/cffi_0.20.0/cffi-examples.asd
-software/cffi_0.20.0/cffi-grovel.asd
-software/cffi_0.20.0/cffi-libffi.asd
-software/cffi_0.20.0/cffi-tests.asd
-software/cffi_0.20.0/cffi-toolchain.asd
-software/cffi_0.20.0/cffi-uffi-compat.asd
-software/cffi_0.20.0/cffi.asd
-software/cl+ssl-20190202-git/cl+ssl.asd
-software/cl+ssl-20190202-git/cl+ssl.test.asd
-software/flexi-streams-20190107-git/flexi-streams.asd
-software/split-sequence-v1.5.0/split-sequence.asd
-software/trivial-features-20161204-git/trivial-features-tests.asd
-software/trivial-features-20161204-git/trivial-features.asd
-software/trivial-garbage-20181018-git/trivial-garbage.asd
+software/alexandria-20200427-git/alexandria-tests.asd
+software/alexandria-20200427-git/alexandria.asd
+software/babel-20200218-git/babel-streams.asd
+software/babel-20200218-git/babel-tests.asd
+software/babel-20200218-git/babel.asd
+software/bordeaux-threads-v0.8.7/bordeaux-threads.asd
+software/cffi_0.21.0/cffi-examples.asd
+software/cffi_0.21.0/cffi-grovel.asd
+software/cffi_0.21.0/cffi-libffi.asd
+software/cffi_0.21.0/cffi-tests.asd
+software/cffi_0.21.0/cffi-toolchain.asd
+software/cffi_0.21.0/cffi-uffi-compat.asd
+software/cffi_0.21.0/cffi.asd
+software/cl+ssl-20200427-git/cl+ssl.asd
+software/cl+ssl-20200427-git/cl+ssl.test.asd
+software/flexi-streams-20200427-git/flexi-streams.asd
+software/split-sequence-v2.0.0/split-sequence.asd
+software/trivial-features-20200427-git/trivial-features-tests.asd
+software/trivial-features-20200427-git/trivial-features.asd
+software/trivial-garbage-20200325-git/trivial-garbage.asd
software/trivial-gray-streams-20181018-git/trivial-gray-streams-test.asd
software/trivial-gray-streams-20181018-git/trivial-gray-streams.asd
-software/uiop-3.3.2/asdf-driver.asd
-software/uiop-3.3.2/uiop.asd
-software/usocket-0.7.1/usocket-server.asd
-software/usocket-0.7.1/usocket-test.asd
-software/usocket-0.7.1/usocket.asd
+software/uiop-3.3.4/asdf-driver.asd
+software/uiop-3.3.4/uiop.asd
+software/usocket-0.8.3/usocket-server.asd
+software/usocket-0.8.3/usocket-test.asd
+software/usocket-0.8.3/usocket.asd